{-# LANGUAGE UndecidableSuperClasses #-}
module Lorentz.Annotation
( HasAnnotation (..)
, GHasAnnotation (..)
, gGetAnnotationNoField
, insertTypeAnn
) where
import qualified GHC.Generics as G
import Named (NamedF)
import Lorentz.Entrypoints.Helpers (ctorNameToAnn)
import Michelson.Text
import Michelson.Typed
(BigMap, ContractRef(..), EpAddress, KnownIsoT, Notes(..), Operation, ToT, insertTypeAnn,
starNotes)
import Michelson.Typed.Haskell.Value (GValueType)
import Michelson.Untyped (FieldAnn, TypeAnn, ann, noAnn)
import Tezos.Address
import Tezos.Core
import Tezos.Crypto
import Util.TypeLits
gGetAnnotationNoField
:: forall a. (GHasAnnotation (G.Rep a), GValueType (G.Rep a) ~ ToT a) => Notes (ToT a)
gGetAnnotationNoField :: Notes (ToT a)
gGetAnnotationNoField = (Notes (ToT a), FieldAnn) -> Notes (ToT a)
forall a b. (a, b) -> a
fst ((Notes (ToT a), FieldAnn) -> Notes (ToT a))
-> (Notes (ToT a), FieldAnn) -> Notes (ToT a)
forall a b. (a -> b) -> a -> b
$ Bool -> (Notes (GValueType (Rep a)), FieldAnn)
forall (a :: * -> *).
GHasAnnotation a =>
Bool -> (Notes (GValueType a), FieldAnn)
gGetAnnotation @(G.Rep a) Bool
False
class HasAnnotation a where
getAnnotation :: Notes (ToT a)
default getAnnotation
:: (GHasAnnotation (G.Rep a), GValueType (G.Rep a) ~ ToT a) => Notes (ToT a)
getAnnotation = (Notes (ToT a), FieldAnn) -> Notes (ToT a)
forall a b. (a, b) -> a
fst ((Notes (ToT a), FieldAnn) -> Notes (ToT a))
-> (Notes (ToT a), FieldAnn) -> Notes (ToT a)
forall a b. (a -> b) -> a -> b
$ Bool -> (Notes (GValueType (Rep a)), FieldAnn)
forall (a :: * -> *).
GHasAnnotation a =>
Bool -> (Notes (GValueType a), FieldAnn)
gGetAnnotation @(G.Rep a) Bool
True
instance (HasAnnotation a, KnownSymbol name)
=> HasAnnotation (NamedF Identity a name) where
getAnnotation :: Notes (ToT (NamedF Identity a name))
getAnnotation = TypeAnn -> Notes (ToT a) -> Notes (ToT a)
forall (b :: T). TypeAnn -> Notes b -> Notes b
insertTypeAnn (KnownSymbol name => TypeAnn
forall (s :: Symbol). KnownSymbol s => TypeAnn
symbolAnn @name) (Notes (ToT a) -> Notes (ToT (NamedF Identity a name)))
-> Notes (ToT a) -> Notes (ToT (NamedF Identity a name))
forall a b. (a -> b) -> a -> b
$ HasAnnotation a => Notes (ToT a)
forall a. HasAnnotation a => Notes (ToT a)
getAnnotation @a
where
symbolAnn :: forall s. KnownSymbol s => TypeAnn
symbolAnn :: TypeAnn
symbolAnn = Text -> TypeAnn
forall k (a :: k). HasCallStack => Text -> Annotation a
ann (Text -> TypeAnn) -> Text -> TypeAnn
forall a b. (a -> b) -> a -> b
$ KnownSymbol s => Text
forall (s :: Symbol). KnownSymbol s => Text
symbolValT' @s
instance (HasAnnotation (Maybe a), KnownSymbol name)
=> HasAnnotation (NamedF Maybe a name) where
getAnnotation :: Notes (ToT (NamedF Maybe a name))
getAnnotation = HasAnnotation (NamedF Identity (Maybe a) name) =>
Notes (ToT (NamedF Identity (Maybe a) name))
forall a. HasAnnotation a => Notes (ToT a)
getAnnotation @(NamedF Identity (Maybe a) name)
instance (HasAnnotation a) => HasAnnotation (Maybe a) where
getAnnotation :: Notes (ToT (Maybe a))
getAnnotation = TypeAnn -> Notes (ToT a) -> Notes ('TOption (ToT a))
forall (t1 :: T). TypeAnn -> Notes t1 -> Notes ('TOption t1)
NTOption TypeAnn
forall k (a :: k). Annotation a
noAnn (HasAnnotation a => Notes (ToT a)
forall a. HasAnnotation a => Notes (ToT a)
getAnnotation @a)
instance HasAnnotation ()
instance HasAnnotation Integer where
getAnnotation :: Notes (ToT Integer)
getAnnotation = Notes (ToT Integer)
forall (t :: T). SingI t => Notes t
starNotes
instance HasAnnotation Natural where
getAnnotation :: Notes (ToT Natural)
getAnnotation = Notes (ToT Natural)
forall (t :: T). SingI t => Notes t
starNotes
instance HasAnnotation MText where
getAnnotation :: Notes (ToT MText)
getAnnotation = Notes (ToT MText)
forall (t :: T). SingI t => Notes t
starNotes
instance HasAnnotation Bool where
getAnnotation :: Notes (ToT Bool)
getAnnotation = Notes (ToT Bool)
forall (t :: T). SingI t => Notes t
starNotes
instance HasAnnotation ByteString where
getAnnotation :: Notes (ToT ByteString)
getAnnotation = Notes (ToT ByteString)
forall (t :: T). SingI t => Notes t
starNotes
instance HasAnnotation Mutez where
getAnnotation :: Notes (ToT Mutez)
getAnnotation = Notes (ToT Mutez)
forall (t :: T). SingI t => Notes t
starNotes
instance HasAnnotation Address where
getAnnotation :: Notes (ToT Address)
getAnnotation = Notes (ToT Address)
forall (t :: T). SingI t => Notes t
starNotes
instance HasAnnotation EpAddress where
getAnnotation :: Notes (ToT EpAddress)
getAnnotation = Notes (ToT EpAddress)
forall (t :: T). SingI t => Notes t
starNotes
instance HasAnnotation KeyHash where
getAnnotation :: Notes (ToT KeyHash)
getAnnotation = Notes (ToT KeyHash)
forall (t :: T). SingI t => Notes t
starNotes
instance HasAnnotation Timestamp where
getAnnotation :: Notes (ToT Timestamp)
getAnnotation = Notes (ToT Timestamp)
forall (t :: T). SingI t => Notes t
starNotes
instance HasAnnotation PublicKey where
getAnnotation :: Notes (ToT PublicKey)
getAnnotation = Notes (ToT PublicKey)
forall (t :: T). SingI t => Notes t
starNotes
instance HasAnnotation Signature where
getAnnotation :: Notes (ToT Signature)
getAnnotation = Notes (ToT Signature)
forall (t :: T). SingI t => Notes t
starNotes
instance (HasAnnotation a) => HasAnnotation (ContractRef a) where
getAnnotation :: Notes (ToT (ContractRef a))
getAnnotation = TypeAnn -> Notes (ToT a) -> Notes ('TContract (ToT a))
forall (t1 :: T). TypeAnn -> Notes t1 -> Notes ('TContract t1)
NTContract TypeAnn
forall k (a :: k). Annotation a
noAnn (HasAnnotation a => Notes (ToT a)
forall a. HasAnnotation a => Notes (ToT a)
getAnnotation @a)
instance (HasAnnotation k, HasAnnotation v) => HasAnnotation (Map k v) where
getAnnotation :: Notes (ToT (Map k v))
getAnnotation = TypeAnn
-> Notes (ToT k) -> Notes (ToT v) -> Notes ('TMap (ToT k) (ToT v))
forall (k :: T) (v :: T).
TypeAnn -> Notes k -> Notes v -> Notes ('TMap k v)
NTMap TypeAnn
forall k (a :: k). Annotation a
noAnn (HasAnnotation k => Notes (ToT k)
forall a. HasAnnotation a => Notes (ToT a)
getAnnotation @k) (HasAnnotation v => Notes (ToT v)
forall a. HasAnnotation a => Notes (ToT a)
getAnnotation @v)
instance (HasAnnotation k, HasAnnotation v) => HasAnnotation (BigMap k v) where
getAnnotation :: Notes (ToT (BigMap k v))
getAnnotation = TypeAnn
-> Notes (ToT k)
-> Notes (ToT v)
-> Notes ('TBigMap (ToT k) (ToT v))
forall (k :: T) (v :: T).
TypeAnn -> Notes k -> Notes v -> Notes ('TBigMap k v)
NTBigMap TypeAnn
forall k (a :: k). Annotation a
noAnn (HasAnnotation k => Notes (ToT k)
forall a. HasAnnotation a => Notes (ToT a)
getAnnotation @k) (HasAnnotation v => Notes (ToT v)
forall a. HasAnnotation a => Notes (ToT a)
getAnnotation @v)
instance (KnownIsoT v) => HasAnnotation (Set v) where
getAnnotation :: Notes (ToT (Set v))
getAnnotation = Notes (ToT (Set v))
forall (t :: T). SingI t => Notes t
starNotes
instance (HasAnnotation a) => HasAnnotation [a] where
getAnnotation :: Notes (ToT [a])
getAnnotation = TypeAnn -> Notes (ToT a) -> Notes ('TList (ToT a))
forall (t1 :: T). TypeAnn -> Notes t1 -> Notes ('TList t1)
NTList TypeAnn
forall k (a :: k). Annotation a
noAnn (HasAnnotation a => Notes (ToT a)
forall a. HasAnnotation a => Notes (ToT a)
getAnnotation @a)
instance HasAnnotation Operation where
getAnnotation :: Notes (ToT Operation)
getAnnotation = Notes (ToT Operation)
forall (t :: T). SingI t => Notes t
starNotes
instance (HasAnnotation a, HasAnnotation b) => HasAnnotation (a, b)
instance (HasAnnotation a, HasAnnotation b, HasAnnotation c) => HasAnnotation (a, b, c)
instance (HasAnnotation a, HasAnnotation b, HasAnnotation c, HasAnnotation d) => HasAnnotation (a, b, c, d)
instance (HasAnnotation a, HasAnnotation b, HasAnnotation c, HasAnnotation d, HasAnnotation e)
=> HasAnnotation (a, b, c, d, e)
instance (HasAnnotation a, HasAnnotation b, HasAnnotation c, HasAnnotation d, HasAnnotation e, HasAnnotation f)
=> HasAnnotation (a, b, c, d, e, f)
instance
( HasAnnotation a, HasAnnotation b, HasAnnotation c, HasAnnotation d, HasAnnotation e
, HasAnnotation f, HasAnnotation g)
=> HasAnnotation (a, b, c, d, e, f, g)
class GHasAnnotation a where
gGetAnnotation :: Bool -> (Notes (GValueType a), FieldAnn)
instance GHasAnnotation G.U1 where
gGetAnnotation :: Bool -> (Notes (GValueType U1), FieldAnn)
gGetAnnotation _ = (Notes (GValueType U1)
forall (t :: T). SingI t => Notes t
starNotes, FieldAnn
forall k (a :: k). Annotation a
noAnn)
instance (GHasAnnotation x)
=> GHasAnnotation (G.M1 G.S ('G.MetaSel 'Nothing b c d) x)
where
gGetAnnotation :: Bool
-> (Notes (GValueType (M1 S ('MetaSel 'Nothing b c d) x)),
FieldAnn)
gGetAnnotation b :: Bool
b = Bool -> (Notes (GValueType x), FieldAnn)
forall (a :: * -> *).
GHasAnnotation a =>
Bool -> (Notes (GValueType a), FieldAnn)
gGetAnnotation @x Bool
b
instance (GHasAnnotation x, KnownSymbol a)
=> GHasAnnotation (G.M1 G.S ('G.MetaSel ('Just a) b c d) x)
where
gGetAnnotation :: Bool
-> (Notes (GValueType (M1 S ('MetaSel ('Just a) b c d) x)),
FieldAnn)
gGetAnnotation b :: Bool
b = case Bool
b of
True -> ((Notes (GValueType x), FieldAnn)
-> Notes (GValueType (M1 S ('MetaSel ('Just a) b c d) x))
forall a b. (a, b) -> a
fst ((Notes (GValueType x), FieldAnn)
-> Notes (GValueType (M1 S ('MetaSel ('Just a) b c d) x)))
-> (Notes (GValueType x), FieldAnn)
-> Notes (GValueType (M1 S ('MetaSel ('Just a) b c d) x))
forall a b. (a -> b) -> a -> b
$ Bool -> (Notes (GValueType x), FieldAnn)
forall (a :: * -> *).
GHasAnnotation a =>
Bool -> (Notes (GValueType a), FieldAnn)
gGetAnnotation @x Bool
b, (KnownSymbol a, HasCallStack) => FieldAnn
forall (ctor :: Symbol).
(KnownSymbol ctor, HasCallStack) =>
FieldAnn
ctorNameToAnn @a)
False -> ((Notes (GValueType x), FieldAnn)
-> Notes (GValueType (M1 S ('MetaSel ('Just a) b c d) x))
forall a b. (a, b) -> a
fst ((Notes (GValueType x), FieldAnn)
-> Notes (GValueType (M1 S ('MetaSel ('Just a) b c d) x)))
-> (Notes (GValueType x), FieldAnn)
-> Notes (GValueType (M1 S ('MetaSel ('Just a) b c d) x))
forall a b. (a -> b) -> a -> b
$ Bool -> (Notes (GValueType x), FieldAnn)
forall (a :: * -> *).
GHasAnnotation a =>
Bool -> (Notes (GValueType a), FieldAnn)
gGetAnnotation @x Bool
b, FieldAnn
forall k (a :: k). Annotation a
noAnn)
instance (GHasAnnotation x) => GHasAnnotation (G.M1 G.C i1 x) where
gGetAnnotation :: Bool -> (Notes (GValueType (M1 C i1 x)), FieldAnn)
gGetAnnotation b :: Bool
b = Bool -> (Notes (GValueType x), FieldAnn)
forall (a :: * -> *).
GHasAnnotation a =>
Bool -> (Notes (GValueType a), FieldAnn)
gGetAnnotation @x Bool
b
instance (GHasAnnotation x) => GHasAnnotation (G.M1 G.D i1 x) where
gGetAnnotation :: Bool -> (Notes (GValueType (M1 D i1 x)), FieldAnn)
gGetAnnotation b :: Bool
b = Bool -> (Notes (GValueType x), FieldAnn)
forall (a :: * -> *).
GHasAnnotation a =>
Bool -> (Notes (GValueType a), FieldAnn)
gGetAnnotation @x Bool
b
instance
( GHasAnnotation x
, GHasAnnotation y
)
=>
GHasAnnotation (x G.:+: y)
where
gGetAnnotation :: Bool -> (Notes (GValueType (x :+: y)), FieldAnn)
gGetAnnotation b :: Bool
b =
( TypeAnn
-> FieldAnn
-> FieldAnn
-> Notes (GValueType x)
-> Notes (GValueType y)
-> Notes ('TOr (GValueType x) (GValueType y))
forall (p :: T) (q :: T).
TypeAnn
-> FieldAnn -> FieldAnn -> Notes p -> Notes q -> Notes ('TOr p q)
NTOr TypeAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
forall k (a :: k). Annotation a
noAnn
((Notes (GValueType x), FieldAnn) -> Notes (GValueType x)
forall a b. (a, b) -> a
fst ((Notes (GValueType x), FieldAnn) -> Notes (GValueType x))
-> (Notes (GValueType x), FieldAnn) -> Notes (GValueType x)
forall a b. (a -> b) -> a -> b
$ Bool -> (Notes (GValueType x), FieldAnn)
forall (a :: * -> *).
GHasAnnotation a =>
Bool -> (Notes (GValueType a), FieldAnn)
gGetAnnotation @x Bool
b)
((Notes (GValueType y), FieldAnn) -> Notes (GValueType y)
forall a b. (a, b) -> a
fst ((Notes (GValueType y), FieldAnn) -> Notes (GValueType y))
-> (Notes (GValueType y), FieldAnn) -> Notes (GValueType y)
forall a b. (a -> b) -> a -> b
$ Bool -> (Notes (GValueType y), FieldAnn)
forall (a :: * -> *).
GHasAnnotation a =>
Bool -> (Notes (GValueType a), FieldAnn)
gGetAnnotation @y Bool
b )
, FieldAnn
forall k (a :: k). Annotation a
noAnn
)
instance
( GHasAnnotation x
, GHasAnnotation y
)
=>
GHasAnnotation (x G.:*: y)
where
gGetAnnotation :: Bool -> (Notes (GValueType (x :*: y)), FieldAnn)
gGetAnnotation b :: Bool
b =
let (xTypeAnn :: Notes (GValueType x)
xTypeAnn, xFieldAnn :: FieldAnn
xFieldAnn) = Bool -> (Notes (GValueType x), FieldAnn)
forall (a :: * -> *).
GHasAnnotation a =>
Bool -> (Notes (GValueType a), FieldAnn)
gGetAnnotation @x Bool
b
(yTypeAnn :: Notes (GValueType y)
yTypeAnn, yFieldAnn :: FieldAnn
yFieldAnn) = Bool -> (Notes (GValueType y), FieldAnn)
forall (a :: * -> *).
GHasAnnotation a =>
Bool -> (Notes (GValueType a), FieldAnn)
gGetAnnotation @y Bool
b
in
( TypeAnn
-> FieldAnn
-> FieldAnn
-> Notes (GValueType x)
-> Notes (GValueType y)
-> Notes ('TPair (GValueType x) (GValueType y))
forall (p :: T) (q :: T).
TypeAnn
-> FieldAnn -> FieldAnn -> Notes p -> Notes q -> Notes ('TPair p q)
NTPair TypeAnn
forall k (a :: k). Annotation a
noAnn
FieldAnn
xFieldAnn FieldAnn
yFieldAnn
Notes (GValueType x)
xTypeAnn Notes (GValueType y)
yTypeAnn
, FieldAnn
forall k (a :: k). Annotation a
noAnn
)
instance (HasAnnotation x) => GHasAnnotation (G.Rec0 x) where
gGetAnnotation :: Bool -> (Notes (GValueType (Rec0 x)), FieldAnn)
gGetAnnotation _ = (HasAnnotation x => Notes (ToT x)
forall a. HasAnnotation a => Notes (ToT a)
getAnnotation @x, FieldAnn
forall k (a :: k). Annotation a
noAnn)