{-# LANGUAGE DataKinds #-}

module Unison.Reference
  ( Reference,
    Reference'
      ( ReferenceBuiltin,
        ReferenceDerived,
        Builtin,
        DerivedId,
        Derived
      ),
    _DerivedId,
    Id,
    Id' (..),
    Pos,
    CycleSize,
    Size,
    TermReference,
    TermReferenceId,
    TypeReference,
    TypeReferenceId,
    derivedBase32Hex,
    component,
    components,
    groupByComponent,
    componentFor,
    componentFromLength,
    unsafeFromText,
    isPrefixOf,
    fromText,
    readSuffix,
    showShort,
    showSuffix,
    toHash,
    toId,
    fromId,
    toText,
    idToText,
    unsafeId,
    toShortHash,
    idToHash,
    idToShortHash,
    isBuiltin,
  )
where

import Control.Lens (Prism')
import Data.Char (isDigit)
import Data.Generics.Sum (_Ctor)
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import U.Codebase.Reference
  ( Id,
    Id' (..),
    Reference,
    Reference' (..),
    TermReference,
    TermReferenceId,
    TypeReference,
    TypeReferenceId,
    idToHash,
    idToShortHash,
    isBuiltin,
    toId,
    toShortHash,
    unsafeId,
    pattern Derived,
  )
import Unison.Hash qualified as H
import Unison.Prelude
import Unison.ShortHash (ShortHash)
import Unison.ShortHash qualified as SH

pattern Builtin :: t -> Reference' t h
pattern $mBuiltin :: forall {r} {t} {h}. Reference' t h -> (t -> r) -> ((# #) -> r) -> r
$bBuiltin :: forall t h. t -> Reference' t h
Builtin x = ReferenceBuiltin x

pattern DerivedId :: Id' h -> Reference' t h
pattern $mDerivedId :: forall {r} {h} {t}.
Reference' t h -> (Id' h -> r) -> ((# #) -> r) -> r
$bDerivedId :: forall h t. Id' h -> Reference' t h
DerivedId x = ReferenceDerived x

{-# COMPLETE Builtin, DerivedId #-}

{-# COMPLETE Builtin, Derived #-}

{-# COMPLETE Builtin, ReferenceDerived #-}

{-# COMPLETE ReferenceBuiltin, DerivedId #-}

_DerivedId :: Prism' Reference Id
_DerivedId :: Prism' Reference Id
_DerivedId = forall (ctor :: Symbol) s t a b.
AsConstructor ctor s t a b =>
Prism s t a b
_Ctor @"ReferenceDerived"

showSuffix :: Pos -> Text
showSuffix :: CycleSize -> Text
showSuffix = String -> Text
Text.pack (String -> Text) -> (CycleSize -> String) -> CycleSize -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CycleSize -> String
forall a. Show a => a -> String
show

readSuffix :: Text -> Either String Pos
readSuffix :: Text -> Either String CycleSize
readSuffix = \case
  Text
pos
    | (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
isDigit Text
pos,
      Just CycleSize
pos' <- String -> Maybe CycleSize
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
pos) ->
        CycleSize -> Either String CycleSize
forall a b. b -> Either a b
Right CycleSize
pos'
  Text
t -> String -> Either String CycleSize
forall a b. a -> Either a b
Left (String -> Either String CycleSize)
-> String -> Either String CycleSize
forall a b. (a -> b) -> a -> b
$ String
"Invalid reference suffix: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
t

isPrefixOf :: ShortHash -> Reference -> Bool
isPrefixOf :: ShortHash -> Reference -> Bool
isPrefixOf ShortHash
sh Reference
r = ShortHash -> ShortHash -> Bool
SH.isPrefixOf ShortHash
sh (Reference -> ShortHash
toShortHash Reference
r)

toText :: Reference -> Text
toText :: Reference -> Text
toText = ShortHash -> Text
SH.toText (ShortHash -> Text)
-> (Reference -> ShortHash) -> Reference -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShortHash
toShortHash

idToText :: Id -> Text
idToText :: Id -> Text
idToText = Reference -> Text
toText (Reference -> Text) -> (Id -> Reference) -> Id -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Reference
forall t h. Id' h -> Reference' t h
ReferenceDerived

showShort :: Int -> Reference -> Text
showShort :: Int -> Reference -> Text
showShort Int
numHashChars = ShortHash -> Text
SH.toText (ShortHash -> Text)
-> (Reference -> ShortHash) -> Reference -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShortHash -> ShortHash
SH.shortenTo Int
numHashChars (ShortHash -> ShortHash)
-> (Reference -> ShortHash) -> Reference -> ShortHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShortHash
toShortHash

type Pos = Word64

type Size = CycleSize

type CycleSize = Word64

-- enumerate the `a`s and associates them with corresponding `Reference.Id`s
componentFor :: H.Hash -> [a] -> [(Id, a)]
componentFor :: forall a. Hash -> [a] -> [(Id, a)]
componentFor Hash
h [a]
as = [(Hash -> CycleSize -> Id
forall h. h -> CycleSize -> Id' h
Id Hash
h CycleSize
i, a
a) | (CycleSize
i, a
a) <- [CycleSize] -> [a] -> [(CycleSize, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CycleSize
0 ..] [a]
as]

componentFromLength :: H.Hash -> CycleSize -> Set Id
componentFromLength :: Hash -> CycleSize -> Set Id
componentFromLength Hash
h CycleSize
size = [Id] -> Set Id
forall a. Ord a => [a] -> Set a
Set.fromList [Hash -> CycleSize -> Id
forall h. h -> CycleSize -> Id' h
Id Hash
h CycleSize
i | CycleSize
i <- [CycleSize
0 .. CycleSize
size CycleSize -> CycleSize -> CycleSize
forall a. Num a => a -> a -> a
- CycleSize
1]]

derivedBase32Hex :: Text -> Pos -> Maybe Reference
derivedBase32Hex :: Text -> CycleSize -> Maybe Reference
derivedBase32Hex Text
b32Hex CycleSize
i = Maybe Hash
mayH Maybe Hash -> (Hash -> Reference) -> Maybe Reference
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Hash
h -> Hash -> CycleSize -> Reference
forall h t. h -> CycleSize -> Reference' t h
Derived Hash
h CycleSize
i
  where
    mayH :: Maybe Hash
mayH = Text -> Maybe Hash
H.fromBase32HexText Text
b32Hex

unsafeFromText :: Text -> Reference
unsafeFromText :: Text -> Reference
unsafeFromText = (String -> Reference)
-> (Reference -> Reference) -> Either String Reference -> Reference
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Reference
forall a. HasCallStack => String -> a
error Reference -> Reference
forall a. a -> a
id (Either String Reference -> Reference)
-> (Text -> Either String Reference) -> Text -> Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String Reference
fromText

fromId :: Id -> Reference
fromId :: Id -> Reference
fromId = Id -> Reference
forall t h. Id' h -> Reference' t h
ReferenceDerived

toHash :: Reference -> Maybe H.Hash
toHash :: Reference -> Maybe Hash
toHash Reference
r = Id -> Hash
idToHash (Id -> Hash) -> Maybe Id -> Maybe Hash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reference -> Maybe Id
toId Reference
r

-- |
-- todo: take a (Reference -> CycleSize) so that `readSuffix` doesn't have to parse the size from the text.
-- examples:
--
-- builtins don’t have cycles
-- >>> fromText "##Text.take"
-- Right ##Text.take
--
-- derived, no cycle
-- >>> fromText "#dqp2oi4iderlrgp2h11sgkff6drk92omo4c84dncfhg9o0jn21cli4lhga72vlchmrb2jk0b3bdc2gie1l06sqdli8ego4q0akm3au8"
-- Right #dqp2o
--
-- derived, part of cycle
-- >>> fromText "#dqp2oi4iderlrgp2h11sgkff6drk92omo4c84dncfhg9o0jn21cli4lhga72vlchmrb2jk0b3bdc2gie1l06sqdli8ego4q0akm3au8.12345"
-- Right #dqp2o.12345
--
-- Errors with 'Left' on invalid hashes
-- >>> fromText "#invalid_hash.12345"
-- Left "Invalid hash: \"invalid_hash\""
fromText :: Text -> Either String Reference
fromText :: Text -> Either String Reference
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] -> Reference -> Either String Reference
forall a b. b -> Either a b
Right (Text -> Reference
forall t h. t -> Reference' t h
ReferenceBuiltin Text
b)
  [Text
_, Text
h] -> case (Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Text
h of
    [Text
hash] ->
      case Text -> CycleSize -> Maybe Reference
derivedBase32Hex Text
hash CycleSize
0 of
        Maybe Reference
Nothing -> String -> Either String Reference
forall a b. a -> Either a b
Left (String -> Either String Reference)
-> String -> Either String Reference
forall a b. (a -> b) -> a -> b
$ String
"Invalid hash: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
hash
        Just Reference
r -> Reference -> Either String Reference
forall a b. b -> Either a b
Right Reference
r
    [Text
hash, Text
suffix] -> do
      CycleSize
pos <- Text -> Either String CycleSize
readSuffix Text
suffix
      Either String Reference
-> (Reference -> Either String Reference)
-> Maybe Reference
-> Either String Reference
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String Reference
forall a b. a -> Either a b
Left (String -> Either String Reference)
-> String -> Either String Reference
forall a b. (a -> b) -> a -> b
$ String
"Invalid hash: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
hash) Reference -> Either String Reference
forall a b. b -> Either a b
Right (Text -> CycleSize -> Maybe Reference
derivedBase32Hex Text
hash CycleSize
pos)
    [Text]
_ -> Either String Reference
bail
  [Text]
_ -> Either String Reference
bail
  where
    bail :: Either String Reference
bail = String -> Either String Reference
forall a b. a -> Either a b
Left (String -> Either String Reference)
-> String -> Either String Reference
forall a b. (a -> b) -> a -> b
$ String
"couldn't parse a Reference from " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
t

component :: H.Hash -> [k] -> [(k, Id)]
component :: forall k. Hash -> [k] -> [(k, Id)]
component Hash
h [k]
ks =
  let
   in [(k
k, (Hash -> CycleSize -> Id
forall h. h -> CycleSize -> Id' h
Id Hash
h CycleSize
i)) | (k
k, CycleSize
i) <- [k]
ks [k] -> [CycleSize] -> [(k, CycleSize)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [CycleSize
0 ..]]

components :: [(H.Hash, [k])] -> [(k, Id)]
components :: forall k. [(Hash, [k])] -> [(k, Id)]
components [(Hash, [k])]
sccs = (Hash -> [k] -> [(k, Id)]) -> (Hash, [k]) -> [(k, Id)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Hash -> [k] -> [(k, Id)]
forall k. Hash -> [k] -> [(k, Id)]
component ((Hash, [k]) -> [(k, Id)]) -> [(Hash, [k])] -> [(k, Id)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [(Hash, [k])]
sccs

groupByComponent :: [(k, Reference)] -> [[(k, Reference)]]
groupByComponent :: forall k. [(k, Reference)] -> [[(k, Reference)]]
groupByComponent [(k, Reference)]
refs = Map (Either Reference Hash) [(k, Reference)] -> [[(k, Reference)]]
forall {b} {t :: * -> *} {a}.
(Ord b, Foldable t) =>
t [(a, b)] -> [[(a, b)]]
done (Map (Either Reference Hash) [(k, Reference)]
 -> [[(k, Reference)]])
-> Map (Either Reference Hash) [(k, Reference)]
-> [[(k, Reference)]]
forall a b. (a -> b) -> a -> b
$ (Map (Either Reference Hash) [(k, Reference)]
 -> (k, Reference) -> Map (Either Reference Hash) [(k, Reference)])
-> Map (Either Reference Hash) [(k, Reference)]
-> [(k, Reference)]
-> Map (Either Reference Hash) [(k, Reference)]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map (Either Reference Hash) [(k, Reference)]
-> (k, Reference) -> Map (Either Reference Hash) [(k, Reference)]
forall {t} {b} {a}.
(Ord t, Ord b) =>
Map (Either (Reference' t b) b) [(a, Reference' t b)]
-> (a, Reference' t b)
-> Map (Either (Reference' t b) b) [(a, Reference' t b)]
insert Map (Either Reference Hash) [(k, Reference)]
forall k a. Map k a
Map.empty [(k, Reference)]
refs
  where
    insert :: Map (Either (Reference' t b) b) [(a, Reference' t b)]
-> (a, Reference' t b)
-> Map (Either (Reference' t b) b) [(a, Reference' t b)]
insert Map (Either (Reference' t b) b) [(a, Reference' t b)]
m (a
k, r :: Reference' t b
r@(Derived b
h CycleSize
_)) =
      ([(a, Reference' t b)]
 -> [(a, Reference' t b)] -> [(a, Reference' t b)])
-> Map (Either (Reference' t b) b) [(a, Reference' t b)]
-> Map (Either (Reference' t b) b) [(a, Reference' t b)]
-> Map (Either (Reference' t b) b) [(a, Reference' t b)]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [(a, Reference' t b)]
-> [(a, Reference' t b)] -> [(a, Reference' t b)]
forall a. Semigroup a => a -> a -> a
(<>) Map (Either (Reference' t b) b) [(a, Reference' t b)]
m ([(Either (Reference' t b) b, [(a, Reference' t b)])]
-> Map (Either (Reference' t b) b) [(a, Reference' t b)]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(b -> Either (Reference' t b) b
forall a b. b -> Either a b
Right b
h, [(a
k, Reference' t b
r)])])
    insert Map (Either (Reference' t b) b) [(a, Reference' t b)]
m (a
k, Reference' t b
r) =
      ([(a, Reference' t b)]
 -> [(a, Reference' t b)] -> [(a, Reference' t b)])
-> Map (Either (Reference' t b) b) [(a, Reference' t b)]
-> Map (Either (Reference' t b) b) [(a, Reference' t b)]
-> Map (Either (Reference' t b) b) [(a, Reference' t b)]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [(a, Reference' t b)]
-> [(a, Reference' t b)] -> [(a, Reference' t b)]
forall a. Semigroup a => a -> a -> a
(<>) Map (Either (Reference' t b) b) [(a, Reference' t b)]
m ([(Either (Reference' t b) b, [(a, Reference' t b)])]
-> Map (Either (Reference' t b) b) [(a, Reference' t b)]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Reference' t b -> Either (Reference' t b) b
forall a b. a -> Either a b
Left Reference' t b
r, [(a
k, Reference' t b
r)])])
    done :: t [(a, b)] -> [[(a, b)]]
done t [(a, b)]
m = ((a, b) -> b) -> [(a, b)] -> [(a, b)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (a, b) -> b
forall a b. (a, b) -> b
snd ([(a, b)] -> [(a, b)]) -> [[(a, b)]] -> [[(a, b)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t [(a, b)] -> [[(a, b)]]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t [(a, b)]
m