{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveDataTypeable  #-}
{-# LANGUAGE DerivingStrategies  #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE TypeApplications    #-}

module PlutusTx.Blueprint.Definition.Id
  ( DefinitionId
  , definitionIdFromType
  , definitionIdFromTypeK
  , definitionIdToText
  , definitionIdUnit
  , definitionIdList
  , definitionIdTuple2
  , definitionIdTuple3
  ) where

import Prelude

import Data.Aeson (ToJSON, ToJSONKey)
import Data.Data (Data)
import Data.Kind (Type)
import Data.Proxy (Proxy (..))
import Data.Text (Text, pack)
import Data.Typeable (Typeable, typeRep)
import GHC.Generics (Generic)

-- | A reference to a Schema definition.
newtype DefinitionId = MkDefinitionId {DefinitionId -> Text
definitionIdToText :: Text}
  deriving stock (Int -> DefinitionId -> ShowS
[DefinitionId] -> ShowS
DefinitionId -> String
(Int -> DefinitionId -> ShowS)
-> (DefinitionId -> String)
-> ([DefinitionId] -> ShowS)
-> Show DefinitionId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DefinitionId -> ShowS
showsPrec :: Int -> DefinitionId -> ShowS
$cshow :: DefinitionId -> String
show :: DefinitionId -> String
$cshowList :: [DefinitionId] -> ShowS
showList :: [DefinitionId] -> ShowS
Show, (forall x. DefinitionId -> Rep DefinitionId x)
-> (forall x. Rep DefinitionId x -> DefinitionId)
-> Generic DefinitionId
forall x. Rep DefinitionId x -> DefinitionId
forall x. DefinitionId -> Rep DefinitionId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DefinitionId -> Rep DefinitionId x
from :: forall x. DefinitionId -> Rep DefinitionId x
$cto :: forall x. Rep DefinitionId x -> DefinitionId
to :: forall x. Rep DefinitionId x -> DefinitionId
Generic, Typeable DefinitionId
Typeable DefinitionId =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> DefinitionId -> c DefinitionId)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DefinitionId)
-> (DefinitionId -> Constr)
-> (DefinitionId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DefinitionId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DefinitionId))
-> ((forall b. Data b => b -> b) -> DefinitionId -> DefinitionId)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DefinitionId -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DefinitionId -> r)
-> (forall u. (forall d. Data d => d -> u) -> DefinitionId -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DefinitionId -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DefinitionId -> m DefinitionId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DefinitionId -> m DefinitionId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DefinitionId -> m DefinitionId)
-> Data DefinitionId
DefinitionId -> Constr
DefinitionId -> DataType
(forall b. Data b => b -> b) -> DefinitionId -> DefinitionId
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DefinitionId -> u
forall u. (forall d. Data d => d -> u) -> DefinitionId -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DefinitionId -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DefinitionId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DefinitionId -> m DefinitionId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DefinitionId -> m DefinitionId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DefinitionId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DefinitionId -> c DefinitionId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DefinitionId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DefinitionId)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DefinitionId -> c DefinitionId
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DefinitionId -> c DefinitionId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DefinitionId
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DefinitionId
$ctoConstr :: DefinitionId -> Constr
toConstr :: DefinitionId -> Constr
$cdataTypeOf :: DefinitionId -> DataType
dataTypeOf :: DefinitionId -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DefinitionId)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DefinitionId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DefinitionId)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DefinitionId)
$cgmapT :: (forall b. Data b => b -> b) -> DefinitionId -> DefinitionId
gmapT :: (forall b. Data b => b -> b) -> DefinitionId -> DefinitionId
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DefinitionId -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DefinitionId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DefinitionId -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DefinitionId -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DefinitionId -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> DefinitionId -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DefinitionId -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DefinitionId -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DefinitionId -> m DefinitionId
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DefinitionId -> m DefinitionId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DefinitionId -> m DefinitionId
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DefinitionId -> m DefinitionId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DefinitionId -> m DefinitionId
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DefinitionId -> m DefinitionId
Data)
  deriving newtype (DefinitionId -> DefinitionId -> Bool
(DefinitionId -> DefinitionId -> Bool)
-> (DefinitionId -> DefinitionId -> Bool) -> Eq DefinitionId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DefinitionId -> DefinitionId -> Bool
== :: DefinitionId -> DefinitionId -> Bool
$c/= :: DefinitionId -> DefinitionId -> Bool
/= :: DefinitionId -> DefinitionId -> Bool
Eq, Eq DefinitionId
Eq DefinitionId =>
(DefinitionId -> DefinitionId -> Ordering)
-> (DefinitionId -> DefinitionId -> Bool)
-> (DefinitionId -> DefinitionId -> Bool)
-> (DefinitionId -> DefinitionId -> Bool)
-> (DefinitionId -> DefinitionId -> Bool)
-> (DefinitionId -> DefinitionId -> DefinitionId)
-> (DefinitionId -> DefinitionId -> DefinitionId)
-> Ord DefinitionId
DefinitionId -> DefinitionId -> Bool
DefinitionId -> DefinitionId -> Ordering
DefinitionId -> DefinitionId -> DefinitionId
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 :: DefinitionId -> DefinitionId -> Ordering
compare :: DefinitionId -> DefinitionId -> Ordering
$c< :: DefinitionId -> DefinitionId -> Bool
< :: DefinitionId -> DefinitionId -> Bool
$c<= :: DefinitionId -> DefinitionId -> Bool
<= :: DefinitionId -> DefinitionId -> Bool
$c> :: DefinitionId -> DefinitionId -> Bool
> :: DefinitionId -> DefinitionId -> Bool
$c>= :: DefinitionId -> DefinitionId -> Bool
>= :: DefinitionId -> DefinitionId -> Bool
$cmax :: DefinitionId -> DefinitionId -> DefinitionId
max :: DefinitionId -> DefinitionId -> DefinitionId
$cmin :: DefinitionId -> DefinitionId -> DefinitionId
min :: DefinitionId -> DefinitionId -> DefinitionId
Ord, [DefinitionId] -> Encoding
[DefinitionId] -> Value
DefinitionId -> Bool
DefinitionId -> Encoding
DefinitionId -> Value
(DefinitionId -> Value)
-> (DefinitionId -> Encoding)
-> ([DefinitionId] -> Value)
-> ([DefinitionId] -> Encoding)
-> (DefinitionId -> Bool)
-> ToJSON DefinitionId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: DefinitionId -> Value
toJSON :: DefinitionId -> Value
$ctoEncoding :: DefinitionId -> Encoding
toEncoding :: DefinitionId -> Encoding
$ctoJSONList :: [DefinitionId] -> Value
toJSONList :: [DefinitionId] -> Value
$ctoEncodingList :: [DefinitionId] -> Encoding
toEncodingList :: [DefinitionId] -> Encoding
$comitField :: DefinitionId -> Bool
omitField :: DefinitionId -> Bool
ToJSON, ToJSONKeyFunction [DefinitionId]
ToJSONKeyFunction DefinitionId
ToJSONKeyFunction DefinitionId
-> ToJSONKeyFunction [DefinitionId] -> ToJSONKey DefinitionId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction DefinitionId
toJSONKey :: ToJSONKeyFunction DefinitionId
$ctoJSONKeyList :: ToJSONKeyFunction [DefinitionId]
toJSONKeyList :: ToJSONKeyFunction [DefinitionId]
ToJSONKey)

instance Semigroup DefinitionId where
  <> :: DefinitionId -> DefinitionId -> DefinitionId
(<>) DefinitionId
l DefinitionId
r = Text -> DefinitionId
MkDefinitionId (Text -> DefinitionId) -> Text -> DefinitionId
forall a b. (a -> b) -> a -> b
$ DefinitionId -> Text
definitionIdToText DefinitionId
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DefinitionId -> Text
definitionIdToText DefinitionId
r

-- | Creates a 'DefinitionId' from a type with a kind 'Type'.
definitionIdFromType :: forall (t :: Type). (Typeable t) => DefinitionId
definitionIdFromType :: forall t. Typeable t => DefinitionId
definitionIdFromType = Text -> DefinitionId
MkDefinitionId (Text -> DefinitionId)
-> (Proxy t -> Text) -> Proxy t -> DefinitionId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (Proxy t -> String) -> Proxy t -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> (Proxy t -> TypeRep) -> Proxy t -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy t -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy t -> DefinitionId) -> Proxy t -> DefinitionId
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @t

{- | Creates a 'DefinitionId' from a type with a kind other than 'Type'.
Example:
> definitionIdFromTypeK @(Type -> Type) @Maybe
-}
definitionIdFromTypeK :: forall k (t :: k). (Typeable (t :: k)) => DefinitionId
definitionIdFromTypeK :: forall k (t :: k). Typeable t => DefinitionId
definitionIdFromTypeK = Text -> DefinitionId
MkDefinitionId (Text -> DefinitionId)
-> (Proxy t -> Text) -> Proxy t -> DefinitionId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (Proxy t -> String) -> Proxy t -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> (Proxy t -> TypeRep) -> Proxy t -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy t -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy t -> DefinitionId) -> Proxy t -> DefinitionId
forall a b. (a -> b) -> a -> b
$ forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(t :: k)

-- Special cases that we want to be alphanumeric instead of symbolic,
-- E.g. "Unit" instead of "()", "List" instead of "[]" etc.

definitionIdUnit :: DefinitionId
definitionIdUnit :: DefinitionId
definitionIdUnit = Text -> DefinitionId
MkDefinitionId Text
"Unit"

definitionIdList :: DefinitionId
definitionIdList :: DefinitionId
definitionIdList = Text -> DefinitionId
MkDefinitionId Text
"List"

definitionIdTuple2 :: DefinitionId
definitionIdTuple2 :: DefinitionId
definitionIdTuple2 = Text -> DefinitionId
MkDefinitionId Text
"Tuple2"

definitionIdTuple3 :: DefinitionId
definitionIdTuple3 :: DefinitionId
definitionIdTuple3 = Text -> DefinitionId
MkDefinitionId Text
"Tuple3"