{-# LANGUAGE RecordWildCards #-}

module Unison.ShortHash
  ( ShortHash (..),
    ShortCausalHash (..),
    ShortNamespaceHash (..),
    isPrefixOf,
    shortenTo,

    -- * String conversions
    fromText,
    toText,
  )
where

import Data.Text qualified as Text
import Unison.Prelude

-- A ShortHash is used to query the Codebase for anonymous definitions. The prefix should look like base32hex, but is
-- not decoded here because the prefix doesn't correspond to anything useful - we'll just compare strings against the
-- codebase later.
--
-- ##Text.++
--   ^^^^^^^
--   |
--   builtin
--
-- #abc123.1#2
--  ^^^^^^ ^ ^
--  |      | |
--  |      | cid
--  |      cycle
--  prefix
data ShortHash
  = Builtin Text
  | ShortHash {ShortHash -> Text
prefix :: Text, ShortHash -> Maybe Word64
cycle :: Maybe Word64, ShortHash -> Maybe Word64
cid :: Maybe Word64}
  deriving (ShortHash -> ShortHash -> Bool
(ShortHash -> ShortHash -> Bool)
-> (ShortHash -> ShortHash -> Bool) -> Eq ShortHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShortHash -> ShortHash -> Bool
== :: ShortHash -> ShortHash -> Bool
$c/= :: ShortHash -> ShortHash -> Bool
/= :: ShortHash -> ShortHash -> Bool
Eq, Eq ShortHash
Eq ShortHash =>
(ShortHash -> ShortHash -> Ordering)
-> (ShortHash -> ShortHash -> Bool)
-> (ShortHash -> ShortHash -> Bool)
-> (ShortHash -> ShortHash -> Bool)
-> (ShortHash -> ShortHash -> Bool)
-> (ShortHash -> ShortHash -> ShortHash)
-> (ShortHash -> ShortHash -> ShortHash)
-> Ord ShortHash
ShortHash -> ShortHash -> Bool
ShortHash -> ShortHash -> Ordering
ShortHash -> ShortHash -> ShortHash
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 :: ShortHash -> ShortHash -> Ordering
compare :: ShortHash -> ShortHash -> Ordering
$c< :: ShortHash -> ShortHash -> Bool
< :: ShortHash -> ShortHash -> Bool
$c<= :: ShortHash -> ShortHash -> Bool
<= :: ShortHash -> ShortHash -> Bool
$c> :: ShortHash -> ShortHash -> Bool
> :: ShortHash -> ShortHash -> Bool
$c>= :: ShortHash -> ShortHash -> Bool
>= :: ShortHash -> ShortHash -> Bool
$cmax :: ShortHash -> ShortHash -> ShortHash
max :: ShortHash -> ShortHash -> ShortHash
$cmin :: ShortHash -> ShortHash -> ShortHash
min :: ShortHash -> ShortHash -> ShortHash
Ord, Int -> ShortHash -> ShowS
[ShortHash] -> ShowS
ShortHash -> String
(Int -> ShortHash -> ShowS)
-> (ShortHash -> String)
-> ([ShortHash] -> ShowS)
-> Show ShortHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShortHash -> ShowS
showsPrec :: Int -> ShortHash -> ShowS
$cshow :: ShortHash -> String
show :: ShortHash -> String
$cshowList :: [ShortHash] -> ShowS
showList :: [ShortHash] -> ShowS
Show)

newtype ShortCausalHash = ShortCausalHash {ShortCausalHash -> Text
shortCausalHashToText :: Text}
  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, Int -> ShortCausalHash -> ShowS
[ShortCausalHash] -> ShowS
ShortCausalHash -> String
(Int -> ShortCausalHash -> ShowS)
-> (ShortCausalHash -> String)
-> ([ShortCausalHash] -> ShowS)
-> Show ShortCausalHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShortCausalHash -> ShowS
showsPrec :: Int -> ShortCausalHash -> ShowS
$cshow :: ShortCausalHash -> String
show :: ShortCausalHash -> String
$cshowList :: [ShortCausalHash] -> ShowS
showList :: [ShortCausalHash] -> ShowS
Show)

newtype ShortNamespaceHash = ShortNamespaceHash {ShortNamespaceHash -> Text
shortNamespaceHashToText :: Text}
  deriving stock (ShortNamespaceHash -> ShortNamespaceHash -> Bool
(ShortNamespaceHash -> ShortNamespaceHash -> Bool)
-> (ShortNamespaceHash -> ShortNamespaceHash -> Bool)
-> Eq ShortNamespaceHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShortNamespaceHash -> ShortNamespaceHash -> Bool
== :: ShortNamespaceHash -> ShortNamespaceHash -> Bool
$c/= :: ShortNamespaceHash -> ShortNamespaceHash -> Bool
/= :: ShortNamespaceHash -> ShortNamespaceHash -> Bool
Eq, Eq ShortNamespaceHash
Eq ShortNamespaceHash =>
(ShortNamespaceHash -> ShortNamespaceHash -> Ordering)
-> (ShortNamespaceHash -> ShortNamespaceHash -> Bool)
-> (ShortNamespaceHash -> ShortNamespaceHash -> Bool)
-> (ShortNamespaceHash -> ShortNamespaceHash -> Bool)
-> (ShortNamespaceHash -> ShortNamespaceHash -> Bool)
-> (ShortNamespaceHash -> ShortNamespaceHash -> ShortNamespaceHash)
-> (ShortNamespaceHash -> ShortNamespaceHash -> ShortNamespaceHash)
-> Ord ShortNamespaceHash
ShortNamespaceHash -> ShortNamespaceHash -> Bool
ShortNamespaceHash -> ShortNamespaceHash -> Ordering
ShortNamespaceHash -> ShortNamespaceHash -> ShortNamespaceHash
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 :: ShortNamespaceHash -> ShortNamespaceHash -> Ordering
compare :: ShortNamespaceHash -> ShortNamespaceHash -> Ordering
$c< :: ShortNamespaceHash -> ShortNamespaceHash -> Bool
< :: ShortNamespaceHash -> ShortNamespaceHash -> Bool
$c<= :: ShortNamespaceHash -> ShortNamespaceHash -> Bool
<= :: ShortNamespaceHash -> ShortNamespaceHash -> Bool
$c> :: ShortNamespaceHash -> ShortNamespaceHash -> Bool
> :: ShortNamespaceHash -> ShortNamespaceHash -> Bool
$c>= :: ShortNamespaceHash -> ShortNamespaceHash -> Bool
>= :: ShortNamespaceHash -> ShortNamespaceHash -> Bool
$cmax :: ShortNamespaceHash -> ShortNamespaceHash -> ShortNamespaceHash
max :: ShortNamespaceHash -> ShortNamespaceHash -> ShortNamespaceHash
$cmin :: ShortNamespaceHash -> ShortNamespaceHash -> ShortNamespaceHash
min :: ShortNamespaceHash -> ShortNamespaceHash -> ShortNamespaceHash
Ord, Int -> ShortNamespaceHash -> ShowS
[ShortNamespaceHash] -> ShowS
ShortNamespaceHash -> String
(Int -> ShortNamespaceHash -> ShowS)
-> (ShortNamespaceHash -> String)
-> ([ShortNamespaceHash] -> ShowS)
-> Show ShortNamespaceHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShortNamespaceHash -> ShowS
showsPrec :: Int -> ShortNamespaceHash -> ShowS
$cshow :: ShortNamespaceHash -> String
show :: ShortNamespaceHash -> String
$cshowList :: [ShortNamespaceHash] -> ShowS
showList :: [ShortNamespaceHash] -> ShowS
Show)

-- x `isPrefixOf` y is True iff x might be a shorter version of y
-- if a constructor id is provided on the right-hand side, the left-hand side
-- needs to match exactly (as of this commit).
isPrefixOf :: ShortHash -> ShortHash -> Bool
isPrefixOf :: ShortHash -> ShortHash -> Bool
isPrefixOf (Builtin Text
t) (Builtin Text
t2) = Text
t Text -> Text -> Bool
`Text.isPrefixOf` Text
t2
isPrefixOf (ShortHash Text
h Maybe Word64
n Maybe Word64
cid) (ShortHash Text
h2 Maybe Word64
n2 Maybe Word64
cid2) =
  Text -> Text -> Bool
Text.isPrefixOf Text
h Text
h2 Bool -> Bool -> Bool
&& Maybe Word64 -> Maybe Word64 -> Bool
forall {a}. Eq a => Maybe a -> Maybe a -> Bool
maybePrefixOf Maybe Word64
n Maybe Word64
n2 Bool -> Bool -> Bool
&& Maybe Word64 -> Maybe Word64 -> Bool
forall {a}. Eq a => Maybe a -> Maybe a -> Bool
maybePrefixOf Maybe Word64
cid Maybe Word64
cid2
  where
    Maybe a
Nothing maybePrefixOf :: Maybe a -> Maybe a -> Bool
`maybePrefixOf` Maybe a
Nothing = Bool
True
    Maybe a
Nothing `maybePrefixOf` Just a
_ = Bool
False
    Just a
_ `maybePrefixOf` Maybe a
Nothing = Bool
False
    Just a
a `maybePrefixOf` Just a
b = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b
isPrefixOf ShortHash
_ ShortHash
_ = Bool
False

shortenTo :: Int -> ShortHash -> ShortHash
shortenTo :: Int -> ShortHash -> ShortHash
shortenTo Int
_ b :: ShortHash
b@(Builtin Text
_) = ShortHash
b
shortenTo Int
i s :: ShortHash
s@ShortHash {Maybe Word64
Text
prefix :: ShortHash -> Text
cycle :: ShortHash -> Maybe Word64
cid :: ShortHash -> Maybe Word64
prefix :: Text
cycle :: Maybe Word64
cid :: Maybe Word64
..} = ShortHash
s {prefix = Text.take i prefix}

-- Parse a string like those described in Referent.fromText:
-- examples:
--
-- builtins don’t have cycles or cids
-- >>> fromText "##Text.take"
-- Just (Builtin "Text.take")
--
-- term ref, no cycle
-- >>> fromText "#2tWjVAuc7"
-- Just (ShortHash {prefix = "2tWjVAuc7", cycle = Nothing, cid = Nothing})
--
-- term ref, part of cycle
-- >>> fromText "#y9ycWkiC1.y9"
-- Just (ShortHash {prefix = "y9ycWkiC1", cycle = Just "y9", cid = Nothing})
--
-- constructor
-- >>> fromText "#cWkiC1x89#1"
-- Just (ShortHash {prefix = "cWkiC1x89", cycle = Nothing, cid = Just "1"})
--
-- constructor of a type in a cycle
-- >>> fromText "#DCxrnCAPS.WD#0"
-- Just (ShortHash {prefix = "DCxrnCAPS", cycle = Just "WD", cid = Just "0"})
--
-- A constructor ID on a builtin is ignored:
-- >>> fromText "##FileIO#2"
-- Just (Builtin "FileIO")
--
-- Anything to the left of the first # is
-- >>> fromText "foo#abc "
-- Just (ShortHash {prefix = "abc ", cycle = Nothing, cid = Nothing})
--
-- Anything including and following a third # is ignored.
-- >>> fromText "foo#abc#2#hello"
-- Just (ShortHash {prefix = "abc", cycle = Nothing, cid = Just "2"})
--
-- Anything after a second . before a second # is ignored.
-- >>> fromText "foo#abc.1f.x"
-- Just (ShortHash {prefix = "abc", cycle = Just "1f", cid = Nothing})
fromText :: Text -> Maybe ShortHash
fromText :: Text -> Maybe ShortHash
fromText Text
t =
  case (Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#') Text
t of
    [Text
_, Text
"", Text
b] -> ShortHash -> Maybe ShortHash
forall a. a -> Maybe a
Just (ShortHash -> Maybe ShortHash) -> ShortHash -> Maybe ShortHash
forall a b. (a -> b) -> a -> b
$ Text -> ShortHash
Builtin Text
b -- builtin starts with ##
    Text
_ : Text
"" : Text
b : [Text]
_ ->
      -- builtin with a CID todo: could be rejected
      ShortHash -> Maybe ShortHash
forall a. a -> Maybe a
Just (ShortHash -> Maybe ShortHash) -> ShortHash -> Maybe ShortHash
forall a b. (a -> b) -> a -> b
$ Text -> ShortHash
Builtin Text
b
    [Text
_, Text
h0] -> do
      (Text
h, Maybe Word64
cid) <- Text -> Maybe (Text, Maybe Word64)
getCycle Text
h0
      ShortHash -> Maybe ShortHash
forall a. a -> Maybe a
Just (Text -> Maybe Word64 -> Maybe Word64 -> ShortHash
ShortHash Text
h Maybe Word64
cid Maybe Word64
forall a. Maybe a
Nothing)
    [Text
_, Text
h0, String -> Maybe Word64
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Word64)
-> (Text -> String) -> Text -> Maybe Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack -> Just Word64
c] -> do
      (Text
h, Maybe Word64
cid) <- Text -> Maybe (Text, Maybe Word64)
getCycle Text
h0
      ShortHash -> Maybe ShortHash
forall a. a -> Maybe a
Just (Text -> Maybe Word64 -> Maybe Word64 -> ShortHash
ShortHash Text
h Maybe Word64
cid (Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
c))
    Text
_ : Text
h0 : (String -> Maybe Word64
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Word64)
-> (Text -> String) -> Text -> Maybe Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack -> Just Word64
c) : [Text]
_garbage -> do
      -- CID with more hash after todo: could be rejected
      (Text
h, Maybe Word64
cid) <- Text -> Maybe (Text, Maybe Word64)
getCycle Text
h0
      ShortHash -> Maybe ShortHash
forall a. a -> Maybe a
Just (Text -> Maybe Word64 -> Maybe Word64 -> ShortHash
ShortHash Text
h Maybe Word64
cid (Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
c))
    [Text]
_ -> Maybe ShortHash
forall a. Maybe a
Nothing
  where
    getCycle :: Text -> Maybe (Text, Maybe Word64)
    getCycle :: Text -> Maybe (Text, Maybe Word64)
getCycle Text
h =
      case (Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Text
h of
        [] -> (Text, Maybe Word64) -> Maybe (Text, Maybe Word64)
forall a. a -> Maybe a
Just (Text
"", Maybe Word64
forall a. Maybe a
Nothing) -- e.g. foo#.1j
        [Text
hash] -> (Text, Maybe Word64) -> Maybe (Text, Maybe Word64)
forall a. a -> Maybe a
Just (Text
hash, Maybe Word64
forall a. Maybe a
Nothing)
        Text
hash : Text
suffix : [Text]
_garbage -> do
          Word64
cid <- String -> Maybe Word64
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
suffix)
          (Text, Maybe Word64) -> Maybe (Text, Maybe Word64)
forall a. a -> Maybe a
Just (Text
hash, Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
cid)

toText :: ShortHash -> Text
toText :: ShortHash -> Text
toText (Builtin Text
b) = Text
"##" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b
toText (ShortHash Text
p Maybe Word64
i Maybe Word64
cid) = Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
i' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c'
  where
    i', c' :: Text
    i' :: Text
i' = Text -> (Word64 -> Text) -> Maybe Word64 -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Word64 -> Text) -> Word64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Text
forall a. Show a => a -> Text
tShow) Maybe Word64
i
    c' :: Text
c' = Text -> (Word64 -> Text) -> Maybe Word64 -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Word64 -> Text) -> Word64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Text
forall a. Show a => a -> Text
tShow) Maybe Word64
cid