module Unison.Codebase.ShortCausalHash
  ( toString,
    toHash,
    fromHash,
    fromFullHash,
    fromText,
    ShortCausalHash (..),
  )
where

import Data.Set qualified as Set
import Data.Text qualified as Text
import U.Codebase.HashTags (CausalHash (unCausalHash))
import U.Util.Base32Hex qualified as Base32Hex
import Unison.Hash qualified as Hash
import Unison.Prelude

-- | Causal Hash Prefix
newtype ShortCausalHash = ShortCausalHash {ShortCausalHash -> Text
toText :: Text} -- base32hex characters
  deriving stock (ShortCausalHash -> ShortCausalHash -> Bool
(ShortCausalHash -> ShortCausalHash -> Bool)
-> (ShortCausalHash -> ShortCausalHash -> Bool)
-> Eq ShortCausalHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShortCausalHash -> ShortCausalHash -> Bool
== :: ShortCausalHash -> ShortCausalHash -> Bool
$c/= :: ShortCausalHash -> ShortCausalHash -> Bool
/= :: ShortCausalHash -> ShortCausalHash -> Bool
Eq, Eq ShortCausalHash
Eq ShortCausalHash =>
(ShortCausalHash -> ShortCausalHash -> Ordering)
-> (ShortCausalHash -> ShortCausalHash -> Bool)
-> (ShortCausalHash -> ShortCausalHash -> Bool)
-> (ShortCausalHash -> ShortCausalHash -> Bool)
-> (ShortCausalHash -> ShortCausalHash -> Bool)
-> (ShortCausalHash -> ShortCausalHash -> ShortCausalHash)
-> (ShortCausalHash -> ShortCausalHash -> ShortCausalHash)
-> Ord ShortCausalHash
ShortCausalHash -> ShortCausalHash -> Bool
ShortCausalHash -> ShortCausalHash -> Ordering
ShortCausalHash -> ShortCausalHash -> ShortCausalHash
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ShortCausalHash -> ShortCausalHash -> Ordering
compare :: ShortCausalHash -> ShortCausalHash -> Ordering
$c< :: ShortCausalHash -> ShortCausalHash -> Bool
< :: ShortCausalHash -> ShortCausalHash -> Bool
$c<= :: ShortCausalHash -> ShortCausalHash -> Bool
<= :: ShortCausalHash -> ShortCausalHash -> Bool
$c> :: ShortCausalHash -> ShortCausalHash -> Bool
> :: ShortCausalHash -> ShortCausalHash -> Bool
$c>= :: ShortCausalHash -> ShortCausalHash -> Bool
>= :: ShortCausalHash -> ShortCausalHash -> Bool
$cmax :: ShortCausalHash -> ShortCausalHash -> ShortCausalHash
max :: ShortCausalHash -> ShortCausalHash -> ShortCausalHash
$cmin :: ShortCausalHash -> ShortCausalHash -> ShortCausalHash
min :: ShortCausalHash -> ShortCausalHash -> ShortCausalHash
Ord, (forall x. ShortCausalHash -> Rep ShortCausalHash x)
-> (forall x. Rep ShortCausalHash x -> ShortCausalHash)
-> Generic ShortCausalHash
forall x. Rep ShortCausalHash x -> ShortCausalHash
forall x. ShortCausalHash -> Rep ShortCausalHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ShortCausalHash -> Rep ShortCausalHash x
from :: forall x. ShortCausalHash -> Rep ShortCausalHash x
$cto :: forall x. Rep ShortCausalHash x -> ShortCausalHash
to :: forall x. Rep ShortCausalHash x -> ShortCausalHash
Generic)

toString :: ShortCausalHash -> String
toString :: ShortCausalHash -> String
toString = Text -> String
Text.unpack (Text -> String)
-> (ShortCausalHash -> Text) -> ShortCausalHash -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortCausalHash -> Text
toText

toHash :: (Coercible Hash.Hash h) => ShortCausalHash -> Maybe h
toHash :: forall h. Coercible Hash h => ShortCausalHash -> Maybe h
toHash = (Hash -> h) -> Maybe Hash -> Maybe h
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Hash -> h
forall a b. Coercible a b => a -> b
coerce (Maybe Hash -> Maybe h)
-> (ShortCausalHash -> Maybe Hash) -> ShortCausalHash -> Maybe h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Hash
Hash.fromBase32HexText (Text -> Maybe Hash)
-> (ShortCausalHash -> Text) -> ShortCausalHash -> Maybe Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortCausalHash -> Text
toText

fromHash :: Int -> CausalHash -> ShortCausalHash
fromHash :: Int -> CausalHash -> ShortCausalHash
fromHash Int
len =
  Text -> ShortCausalHash
ShortCausalHash (Text -> ShortCausalHash)
-> (CausalHash -> Text) -> CausalHash -> ShortCausalHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Text.take Int
len (Text -> Text) -> (CausalHash -> Text) -> CausalHash -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> Text
Hash.toBase32HexText (Hash -> Text) -> (CausalHash -> Hash) -> CausalHash -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CausalHash -> Hash
unCausalHash

-- | This allows a full hash to be preserved as a `ShortCausalHash`.
--
--  `ShortCausalHash` is used for input when we expect a user to enter a hash on the command line, so they aren’t
--   required to enter the full hash. However, these inputs may also come from an internal source, and in such cases,
--   there is no reason to truncate the hash.
fromFullHash :: (Coercible h Hash.Hash) => h -> ShortCausalHash
fromFullHash :: forall h. Coercible h Hash => h -> ShortCausalHash
fromFullHash = Text -> ShortCausalHash
ShortCausalHash (Text -> ShortCausalHash) -> (h -> Text) -> h -> ShortCausalHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> Text
Hash.toBase32HexText (Hash -> Text) -> (h -> Hash) -> h -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. h -> Hash
forall a b. Coercible a b => a -> b
coerce

-- abc -> SCH abc
-- #abc -> SCH abc
fromText :: Text -> Maybe ShortCausalHash
fromText :: Text -> Maybe ShortCausalHash
fromText ((Char -> Bool) -> Text -> Text
Text.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#') -> Text
t)
  | (Char -> Bool) -> Text -> Bool
Text.all (Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Char
Base32Hex.validChars) Text
t =
      ShortCausalHash -> Maybe ShortCausalHash
forall a. a -> Maybe a
Just (ShortCausalHash -> Maybe ShortCausalHash)
-> ShortCausalHash -> Maybe ShortCausalHash
forall a b. (a -> b) -> a -> b
$
        Text -> ShortCausalHash
ShortCausalHash Text
t
fromText Text
_ = Maybe ShortCausalHash
forall a. Maybe a
Nothing

instance Show ShortCausalHash where
  show :: ShortCausalHash -> String
show (ShortCausalHash Text
h) = Char
'#' Char -> ShowS
forall a. a -> [a] -> [a]
: Text -> String
Text.unpack Text
h

instance From ShortCausalHash Text where
  from :: ShortCausalHash -> Text
from = ShortCausalHash -> Text
toText