{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}

module Unison.Referent
  ( Referent,
    pattern Ref,
    pattern Con,
    Id,
    pattern RefId,
    pattern ConId,
    fold,
    toId,
    toReference,
    toReferenceId,
    toConstructorReference,
    toConstructorReferenceId,
    toTermReference,
    toTermReferenceId,
    fromId,
    fromTermReference,
    fromTermReferenceId,
    fromText,

    -- * Lenses
    reference_,

    -- * ShortHash helpers
    isPrefixOf,
    toShortHash,
    toText,
    toString,
  )
where

import Data.Char qualified as Char
import Data.Text qualified as Text
import Unison.ConstructorReference (ConstructorReference, ConstructorReferenceId, GConstructorReference (..))
import Unison.ConstructorReference qualified as ConstructorReference
import Unison.ConstructorType (ConstructorType)
import Unison.ConstructorType qualified as CT
import Unison.DataDeclaration.ConstructorId (ConstructorId)
import Unison.Prelude hiding (fold)
import Unison.Reference (Reference, TermReference, TermReferenceId)
import Unison.Reference qualified as R
import Unison.Reference qualified as Reference
import Unison.ReferentPrime (Referent' (..), reference_, toReference')
import Unison.ShortHash (ShortHash)
import Unison.ShortHash qualified as SH

-- | Specifies a term.
--
-- Either a term 'Reference', a data constructor, or an effect constructor.
--
-- Slightly odd naming. This is the "referent of term name in the codebase",
-- rather than the target of a Reference.
type Referent = Referent' Reference

pattern Ref :: TermReference -> Referent
pattern $mRef :: forall {r}. Referent -> (TermReference -> r) -> ((# #) -> r) -> r
$bRef :: TermReference -> Referent
Ref r = Ref' r

pattern Con :: ConstructorReference -> ConstructorType -> Referent
pattern $mCon :: forall {r}.
Referent
-> (ConstructorReference -> ConstructorType -> r)
-> ((# #) -> r)
-> r
$bCon :: ConstructorReference -> ConstructorType -> Referent
Con r t = Con' r t

{-# COMPLETE Ref, Con #-}

-- | By definition, cannot be a builtin.
type Id = Referent' R.Id

pattern RefId :: R.Id -> Unison.Referent.Id
pattern $mRefId :: forall {r}. Id -> (Id -> r) -> ((# #) -> r) -> r
$bRefId :: Id -> Id
RefId r = Ref' r

pattern ConId :: ConstructorReferenceId -> ConstructorType -> Unison.Referent.Id
pattern $mConId :: forall {r}.
Id
-> (ConstructorReferenceId -> ConstructorType -> r)
-> ((# #) -> r)
-> r
$bConId :: ConstructorReferenceId -> ConstructorType -> Id
ConId r t = Con' r t

{-# COMPLETE RefId, ConId #-}

-- referentToTerm moved to Term.fromReferent
-- termToReferent moved to Term.toReferent

toId :: Referent -> Maybe Id
toId :: Referent -> Maybe Id
toId = \case
  Ref (Reference.ReferenceDerived Id
r) ->
    Id -> Maybe Id
forall a. a -> Maybe a
Just (Id -> Id
RefId Id
r)
  Con (ConstructorReference (Reference.ReferenceDerived Id
r) ConstructorId
i) ConstructorType
t ->
    Id -> Maybe Id
forall a. a -> Maybe a
Just (ConstructorReferenceId -> ConstructorType -> Id
ConId (Id -> ConstructorId -> ConstructorReferenceId
forall r. r -> ConstructorId -> GConstructorReference r
ConstructorReference Id
r ConstructorId
i) ConstructorType
t)
  Referent
_ -> Maybe Id
forall a. Maybe a
Nothing

fromId :: Id -> Referent
fromId :: Id -> Referent
fromId = \case
  RefId Id
r -> TermReference -> Referent
Ref (Id -> TermReference
forall t h. Id' h -> Reference' t h
Reference.ReferenceDerived Id
r)
  ConId (ConstructorReference Id
r ConstructorId
i) ConstructorType
t ->
    ConstructorReference -> ConstructorType -> Referent
Con (TermReference -> ConstructorId -> ConstructorReference
forall r. r -> ConstructorId -> GConstructorReference r
ConstructorReference (Id -> TermReference
forall t h. Id' h -> Reference' t h
Reference.ReferenceDerived Id
r) ConstructorId
i) ConstructorType
t

-- todo: move these to ShortHash module
toShortHash :: Referent -> ShortHash
toShortHash :: Referent -> ShortHash
toShortHash = \case
  Ref TermReference
r -> TermReference -> ShortHash
R.toShortHash TermReference
r
  Con ConstructorReference
r ConstructorType
_ -> ConstructorReference -> ShortHash
ConstructorReference.toShortHash ConstructorReference
r

toText :: Referent -> Text
toText :: Referent -> Text
toText = \case
  Ref TermReference
r -> TermReference -> Text
R.toText TermReference
r
  Con (ConstructorReference TermReference
r ConstructorId
cid) ConstructorType
ct -> TermReference -> Text
R.toText TermReference
r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ConstructorType -> Text
ctorTypeText ConstructorType
ct Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (ConstructorId -> String
forall a. Show a => a -> String
show ConstructorId
cid)

ctorTypeText :: CT.ConstructorType -> Text
ctorTypeText :: ConstructorType -> Text
ctorTypeText ConstructorType
CT.Effect = Text
forall a. (Eq a, IsString a) => a
EffectCtor
ctorTypeText ConstructorType
CT.Data = Text
forall a. (Eq a, IsString a) => a
DataCtor

pattern EffectCtor :: (Eq a, IsString a) => a
pattern $mEffectCtor :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bEffectCtor :: forall a. (Eq a, IsString a) => a
EffectCtor = "a"

pattern DataCtor :: (Eq a, IsString a) => a
pattern $mDataCtor :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bDataCtor :: forall a. (Eq a, IsString a) => a
DataCtor = "d"

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

toReference :: Referent -> Reference
toReference :: Referent -> TermReference
toReference = Referent -> TermReference
forall r. Referent' r -> r
toReference'

toReferenceId :: Referent -> Maybe Reference.Id
toReferenceId :: Referent -> Maybe Id
toReferenceId = TermReference -> Maybe Id
Reference.toId (TermReference -> Maybe Id)
-> (Referent -> TermReference) -> Referent -> Maybe Id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Referent -> TermReference
toReference

toConstructorReference :: Referent' r -> Maybe (GConstructorReference r)
toConstructorReference :: forall r. Referent' r -> Maybe (GConstructorReference r)
toConstructorReference = \case
  Con' GConstructorReference r
r ConstructorType
_ -> GConstructorReference r -> Maybe (GConstructorReference r)
forall a. a -> Maybe a
Just GConstructorReference r
r
  Ref' r
_ -> Maybe (GConstructorReference r)
forall a. Maybe a
Nothing

toConstructorReferenceId :: Referent -> Maybe ConstructorReferenceId
toConstructorReferenceId :: Referent -> Maybe ConstructorReferenceId
toConstructorReferenceId =
  Referent -> Maybe ConstructorReference
forall r. Referent' r -> Maybe (GConstructorReference r)
toConstructorReference (Referent -> Maybe ConstructorReference)
-> (ConstructorReference -> Maybe ConstructorReferenceId)
-> Referent
-> Maybe ConstructorReferenceId
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ConstructorReference -> Maybe ConstructorReferenceId
ConstructorReference.toId

toTermReference :: Referent' r -> Maybe r
toTermReference :: forall r. Referent' r -> Maybe r
toTermReference = \case
  Con' GConstructorReference r
_ ConstructorType
_ -> Maybe r
forall a. Maybe a
Nothing
  Ref' r
reference -> r -> Maybe r
forall a. a -> Maybe a
Just r
reference

toTermReferenceId :: Referent -> Maybe TermReferenceId
toTermReferenceId :: Referent -> Maybe Id
toTermReferenceId Referent
r = Referent -> Maybe TermReference
forall r. Referent' r -> Maybe r
toTermReference Referent
r Maybe TermReference -> (TermReference -> Maybe Id) -> Maybe Id
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TermReference -> Maybe Id
Reference.toId

-- | Inject a Term Reference into a Referent
fromTermReference :: TermReference -> Referent
fromTermReference :: TermReference -> Referent
fromTermReference = TermReference -> Referent
Ref

fromTermReferenceId :: TermReferenceId -> Referent
fromTermReferenceId :: Id -> Referent
fromTermReferenceId = TermReference -> Referent
fromTermReference (TermReference -> Referent)
-> (Id -> TermReference) -> Id -> Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> TermReference
Reference.fromId

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

-- #abc[.xy][#<T>cid]
--
-- >>> fromText "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg#d0"
-- Just (Con' (ConstructorReference #nirp5 0) Data)
--
-- >>> fromText "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg"
-- Just (Ref' #nirp5)
--
-- >>> fromText "##Text.uncons"
-- Just (Ref' ##Text.uncons)
fromText :: Text -> Maybe Referent
fromText :: Text -> Maybe Referent
fromText Text
t =
  (String -> Maybe Referent)
-> (Referent -> Maybe Referent)
-> Either String Referent
-> Maybe Referent
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Referent -> String -> Maybe Referent
forall a b. a -> b -> a
const Maybe Referent
forall a. Maybe a
Nothing) Referent -> Maybe Referent
forall a. a -> Maybe a
Just (Either String Referent -> Maybe Referent)
-> Either String Referent -> Maybe Referent
forall a b. (a -> b) -> a -> b
$
    -- if the string has just one hash at the start, it's just a reference
    if Text
refPart Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"#" Bool -> Bool -> Bool
|| Text
refPart Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"##"
      then TermReference -> Referent
Ref (TermReference -> Referent)
-> Either String TermReference -> Either String Referent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either String TermReference
R.fromText Text
t
      else
        if (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
Char.isDigit Text
cidPart Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null) Text
cidPart
          then do
            TermReference
r <- Text -> Either String TermReference
R.fromText (Int -> Text -> Text
Text.dropEnd Int
1 Text
refPart)
            ConstructorType
ctorType <- Either String ConstructorType
ctorType
            let maybeCid :: Maybe ConstructorId
maybeCid = String -> Maybe ConstructorId
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
cidPart)
            case Maybe ConstructorId
maybeCid of
              Maybe ConstructorId
Nothing -> String -> Either String Referent
forall a b. a -> Either a b
Left (String
"invalid constructor id: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
cidPart)
              Just ConstructorId
cid -> Referent -> Either String Referent
forall a b. b -> Either a b
Right (Referent -> Either String Referent)
-> Referent -> Either String Referent
forall a b. (a -> b) -> a -> b
$ ConstructorReference -> ConstructorType -> Referent
Con (TermReference -> ConstructorId -> ConstructorReference
forall r. r -> ConstructorId -> GConstructorReference r
ConstructorReference TermReference
r ConstructorId
cid) ConstructorType
ctorType
          else String -> Either String Referent
forall a b. a -> Either a b
Left (String
"invalid constructor id: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
cidPart)
  where
    ctorType :: Either String ConstructorType
ctorType = case Int -> Text -> Text
Text.take Int
1 Text
cidPart' of
      Text
EffectCtor -> ConstructorType -> Either String ConstructorType
forall a b. b -> Either a b
Right ConstructorType
CT.Effect
      Text
DataCtor -> ConstructorType -> Either String ConstructorType
forall a b. b -> Either a b
Right ConstructorType
CT.Data
      Text
_otherwise ->
        String -> Either String ConstructorType
forall a b. a -> Either a b
Left
          ( String
"invalid constructor type (expected '"
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
forall a. (Eq a, IsString a) => a
EffectCtor
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' or '"
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
forall a. (Eq a, IsString a) => a
DataCtor
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'): "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
cidPart'
          )
    refPart :: Text
refPart = (Char -> Bool) -> Text -> Text
Text.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#') Text
t
    cidPart' :: Text
cidPart' = (Char -> Bool) -> Text -> Text
Text.takeWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#') Text
t
    cidPart :: Text
cidPart = Int -> Text -> Text
Text.drop Int
1 Text
cidPart'

fold :: (r -> a) -> (r -> ConstructorId -> ConstructorType -> a) -> Referent' r -> a
fold :: forall r a.
(r -> a)
-> (r -> ConstructorId -> ConstructorType -> a) -> Referent' r -> a
fold r -> a
fr r -> ConstructorId -> ConstructorType -> a
fc = \case
  Ref' r
r -> r -> a
fr r
r
  Con' (ConstructorReference r
r ConstructorId
i) ConstructorType
ct -> r -> ConstructorId -> ConstructorType -> a
fc r
r ConstructorId
i ConstructorType
ct