-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Michelson types represented in untyped model.

{-# LANGUAGE DeriveLift #-}

module Morley.Michelson.Untyped.Type
  ( Ty (..)
  , T (..)
  , ParameterType (..)
  , toption
  , tpair
  , tor
  , tyint
  , tynat
  , tyunit
  , tybool
  , typair
  , tyor
  , tyImplicitAccountParam
  , isAtomicType
  , isKey
  , isSignature
  , isComparable
  , isMutez
  , isKeyHash
  , isBool
  , isString
  , isInteger
  , isTimestamp
  , isNat
  , isInt
  , isBytes
  , renderType
  , unwrapT
  ) where

import Data.Aeson.TH (deriveJSON)
import Data.Data (Data(..))
import Data.List.NonEmpty ((<|))
import Fmt (Buildable(..), Doc, isEmpty, (<+>))
import Language.Haskell.TH.Syntax (Lift)
import Prelude hiding ((<$>))
import Prettyprinter qualified as PP

import Morley.Michelson.Printer.Util
import Morley.Michelson.Untyped.Annotation
  (AnnotationSet, FieldAnn, RootAnn, TypeAnn, VarAnn, emptyAnnSet, fullAnnSet, noAnn,
  pattern Annotation, singleAnnSet)
import Morley.Util.Aeson
import Morley.Util.MismatchError

-- | Annotated Michelson type.
-- We don't name it 'Type' to avoid conflicts with 'Data.Kind.Type'.
data Ty
  = Ty ~T TypeAnn
  deriving stock (Ty -> Ty -> Bool
(Ty -> Ty -> Bool) -> (Ty -> Ty -> Bool) -> Eq Ty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ty -> Ty -> Bool
== :: Ty -> Ty -> Bool
$c/= :: Ty -> Ty -> Bool
/= :: Ty -> Ty -> Bool
Eq, Int -> Ty -> ShowS
[Ty] -> ShowS
Ty -> String
(Int -> Ty -> ShowS)
-> (Ty -> String) -> ([Ty] -> ShowS) -> Show Ty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ty -> ShowS
showsPrec :: Int -> Ty -> ShowS
$cshow :: Ty -> String
show :: Ty -> String
$cshowList :: [Ty] -> ShowS
showList :: [Ty] -> ShowS
Show, Typeable Ty
Typeable Ty
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Ty -> c Ty)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Ty)
-> (Ty -> Constr)
-> (Ty -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Ty))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ty))
-> ((forall b. Data b => b -> b) -> Ty -> Ty)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ty -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ty -> r)
-> (forall u. (forall d. Data d => d -> u) -> Ty -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Ty -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Ty -> m Ty)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Ty -> m Ty)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Ty -> m Ty)
-> Data Ty
Ty -> Constr
Ty -> DataType
(forall b. Data b => b -> b) -> Ty -> Ty
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) -> Ty -> u
forall u. (forall d. Data d => d -> u) -> Ty -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ty -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ty -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ty -> m Ty
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ty -> m Ty
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ty
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ty -> c Ty
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ty)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ty)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ty -> c Ty
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ty -> c Ty
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ty
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ty
$ctoConstr :: Ty -> Constr
toConstr :: Ty -> Constr
$cdataTypeOf :: Ty -> DataType
dataTypeOf :: Ty -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ty)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ty)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ty)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ty)
$cgmapT :: (forall b. Data b => b -> b) -> Ty -> Ty
gmapT :: (forall b. Data b => b -> b) -> Ty -> Ty
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ty -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ty -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ty -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ty -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Ty -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Ty -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ty -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ty -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ty -> m Ty
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ty -> m Ty
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ty -> m Ty
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ty -> m Ty
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ty -> m Ty
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ty -> m Ty
Data, (forall x. Ty -> Rep Ty x)
-> (forall x. Rep Ty x -> Ty) -> Generic Ty
forall x. Rep Ty x -> Ty
forall x. Ty -> Rep Ty x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Ty -> Rep Ty x
from :: forall x. Ty -> Rep Ty x
$cto :: forall x. Rep Ty x -> Ty
to :: forall x. Rep Ty x -> Ty
Generic, (forall (m :: * -> *). Quote m => Ty -> m Exp)
-> (forall (m :: * -> *). Quote m => Ty -> Code m Ty) -> Lift Ty
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Ty -> m Exp
forall (m :: * -> *). Quote m => Ty -> Code m Ty
$clift :: forall (m :: * -> *). Quote m => Ty -> m Exp
lift :: forall (m :: * -> *). Quote m => Ty -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Ty -> Code m Ty
liftTyped :: forall (m :: * -> *). Quote m => Ty -> Code m Ty
Lift)
  deriving anyclass Ty -> ()
(Ty -> ()) -> NFData Ty
forall a. (a -> ()) -> NFData a
$crnf :: Ty -> ()
rnf :: Ty -> ()
NFData

-- | Extract a raw Michelson type from an annotated one
unwrapT :: Ty -> T
unwrapT :: Ty -> T
unwrapT (Ty T
t TypeAnn
_) = T
t

instance RenderDoc Ty where
  renderDoc :: RenderContext -> Ty -> Doc
renderDoc RenderContext
pn (Ty T
t TypeAnn
ta) = T -> RenderContext -> AnnotationSet -> Doc
renderType T
t RenderContext
pn (TypeAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
singleAnnSet TypeAnn
ta)

instance Buildable (MismatchError Ty) where
  build :: MismatchError Ty -> Doc
build = MismatchError Ty -> Doc
forall a. Buildable a => MismatchError a -> Doc
buildDocDiff

instance RenderDoc T where
  renderDoc :: RenderContext -> T -> Doc
renderDoc RenderContext
pn T
t = T -> RenderContext -> AnnotationSet -> Doc
renderType T
t RenderContext
pn AnnotationSet
emptyAnnSet

-- | Since Babylon parameter type can have special root annotation.
data ParameterType = ParameterType Ty RootAnn
  deriving stock (ParameterType -> ParameterType -> Bool
(ParameterType -> ParameterType -> Bool)
-> (ParameterType -> ParameterType -> Bool) -> Eq ParameterType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParameterType -> ParameterType -> Bool
== :: ParameterType -> ParameterType -> Bool
$c/= :: ParameterType -> ParameterType -> Bool
/= :: ParameterType -> ParameterType -> Bool
Eq, Int -> ParameterType -> ShowS
[ParameterType] -> ShowS
ParameterType -> String
(Int -> ParameterType -> ShowS)
-> (ParameterType -> String)
-> ([ParameterType] -> ShowS)
-> Show ParameterType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParameterType -> ShowS
showsPrec :: Int -> ParameterType -> ShowS
$cshow :: ParameterType -> String
show :: ParameterType -> String
$cshowList :: [ParameterType] -> ShowS
showList :: [ParameterType] -> ShowS
Show, Typeable ParameterType
Typeable ParameterType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ParameterType -> c ParameterType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ParameterType)
-> (ParameterType -> Constr)
-> (ParameterType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ParameterType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ParameterType))
-> ((forall b. Data b => b -> b) -> ParameterType -> ParameterType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ParameterType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ParameterType -> r)
-> (forall u. (forall d. Data d => d -> u) -> ParameterType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ParameterType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ParameterType -> m ParameterType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ParameterType -> m ParameterType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ParameterType -> m ParameterType)
-> Data ParameterType
ParameterType -> Constr
ParameterType -> DataType
(forall b. Data b => b -> b) -> ParameterType -> ParameterType
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) -> ParameterType -> u
forall u. (forall d. Data d => d -> u) -> ParameterType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParameterType -> m ParameterType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParameterType -> m ParameterType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParameterType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParameterType -> c ParameterType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParameterType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParameterType)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParameterType -> c ParameterType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParameterType -> c ParameterType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParameterType
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParameterType
$ctoConstr :: ParameterType -> Constr
toConstr :: ParameterType -> Constr
$cdataTypeOf :: ParameterType -> DataType
dataTypeOf :: ParameterType -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParameterType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParameterType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParameterType)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParameterType)
$cgmapT :: (forall b. Data b => b -> b) -> ParameterType -> ParameterType
gmapT :: (forall b. Data b => b -> b) -> ParameterType -> ParameterType
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterType -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterType -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ParameterType -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ParameterType -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ParameterType -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ParameterType -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParameterType -> m ParameterType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParameterType -> m ParameterType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParameterType -> m ParameterType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParameterType -> m ParameterType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParameterType -> m ParameterType
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParameterType -> m ParameterType
Data, (forall x. ParameterType -> Rep ParameterType x)
-> (forall x. Rep ParameterType x -> ParameterType)
-> Generic ParameterType
forall x. Rep ParameterType x -> ParameterType
forall x. ParameterType -> Rep ParameterType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ParameterType -> Rep ParameterType x
from :: forall x. ParameterType -> Rep ParameterType x
$cto :: forall x. Rep ParameterType x -> ParameterType
to :: forall x. Rep ParameterType x -> ParameterType
Generic, (forall (m :: * -> *). Quote m => ParameterType -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ParameterType -> Code m ParameterType)
-> Lift ParameterType
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ParameterType -> m Exp
forall (m :: * -> *).
Quote m =>
ParameterType -> Code m ParameterType
$clift :: forall (m :: * -> *). Quote m => ParameterType -> m Exp
lift :: forall (m :: * -> *). Quote m => ParameterType -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ParameterType -> Code m ParameterType
liftTyped :: forall (m :: * -> *).
Quote m =>
ParameterType -> Code m ParameterType
Lift)

instance NFData ParameterType

instance RenderDoc ParameterType where
  renderDoc :: RenderContext -> ParameterType -> Doc
renderDoc RenderContext
pn (ParameterType (Ty T
t TypeAnn
ta) RootAnn
ra) =
    T -> RenderContext -> AnnotationSet -> Doc
renderType T
t RenderContext
pn ([TypeAnn] -> [RootAnn] -> [VarAnn] -> AnnotationSet
fullAnnSet [TypeAnn
ta] [RootAnn
ra] [])

-- | Render a type representation
--
-- Ordering between different kinds of annotations is not significant,
-- but ordering among annotations of the same kind is. Annotations
-- of a same kind must be grouped together.
--
-- > (prim @v :t %x arg1 arg2 ...)
--
-- these are equivalent
--
-- > PAIR :t @my_pair %x %y
-- > PAIR %x %y :t @my_pair
renderType
  :: T
  -> RenderContext
  -> AnnotationSet
  -> Doc
renderType :: T -> RenderContext -> AnnotationSet -> Doc
renderType T
t RenderContext
pn AnnotationSet
annSet =
  let annDoc :: Doc
annDoc = RenderContext -> AnnotationSet -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
doesntNeedParens AnnotationSet
annSet
      recRenderer :: T -> AnnotationSet -> Doc
recRenderer T
t' AnnotationSet
annSet' = T -> RenderContext -> AnnotationSet -> Doc
renderType T
t' RenderContext
needsParens AnnotationSet
annSet'
      renderParametric :: Text -> [Doc] -> Doc
      renderParametric :: Text -> [Doc] -> Doc
renderParametric Text
name [Doc]
args = Doc -> Doc
forall ann. Doc ann -> Doc ann
PP.group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        if Doc -> Bool
isEmpty Doc
annDoc Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Text -> Int
forall i a.
(Integral i, Container a,
 DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length Text
name Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3
        then RenderContext -> Doc -> Doc
addParens RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Text -> Doc
forall a. Buildable a => a -> Doc
build Text
name Doc -> Doc -> Doc
<+> Doc -> Doc
forall ann. Doc ann -> Doc ann
PP.align ([Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
PP.vsep [Doc]
args)
        else Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
PP.hang Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ RenderContext -> Doc -> Doc
addParens RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
PP.vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Text -> Doc
forall a. Buildable a => a -> Doc
build Text
name Doc -> Doc -> Doc
<+> Doc
annDoc Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc]
args

      collectBranches :: T -> TypeAnn -> FieldAnn -> NonEmpty Doc
      collectBranches :: T -> TypeAnn -> RootAnn -> NonEmpty Doc
collectBranches (TPair RootAnn
fa1 RootAnn
fa2 VarAnn
va1 VarAnn
_ (Ty T
t1 TypeAnn
ta1) (Ty T
t2 TypeAnn
ta2)) TypeAnn
_ (Annotation Text
"")
        = (T -> AnnotationSet -> Doc
recRenderer T
t1 (AnnotationSet -> Doc) -> AnnotationSet -> Doc
forall a b. (a -> b) -> a -> b
$ ([TypeAnn] -> [RootAnn] -> [VarAnn] -> AnnotationSet
fullAnnSet [TypeAnn
ta1] [RootAnn
fa1] [VarAnn
va1])) Doc -> NonEmpty Doc -> NonEmpty Doc
forall a. a -> NonEmpty a -> NonEmpty a
<| T -> TypeAnn -> RootAnn -> NonEmpty Doc
collectBranches T
t2 TypeAnn
ta2 RootAnn
fa2
      collectBranches T
t' TypeAnn
ta RootAnn
fa = (T -> AnnotationSet -> Doc
recRenderer T
t' (AnnotationSet -> Doc) -> AnnotationSet -> Doc
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [RootAnn] -> [VarAnn] -> AnnotationSet
fullAnnSet [TypeAnn
ta] [RootAnn
fa] []) Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| []

  in
  case T
t of
    T
TInt              -> RenderContext -> NonEmpty Doc -> Doc
wrapInParens RenderContext
pn (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"int" Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| [Doc
annDoc]
    T
TNat              -> RenderContext -> NonEmpty Doc -> Doc
wrapInParens RenderContext
pn (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"nat" Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| [Doc
annDoc]
    T
TString           -> RenderContext -> NonEmpty Doc -> Doc
wrapInParens RenderContext
pn (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"string" Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| [Doc
annDoc]
    T
TMutez            -> RenderContext -> NonEmpty Doc -> Doc
wrapInParens RenderContext
pn (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"mutez" Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| [Doc
annDoc]
    T
TBool             -> RenderContext -> NonEmpty Doc -> Doc
wrapInParens RenderContext
pn (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"bool" Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| [Doc
annDoc]
    T
TKeyHash          -> RenderContext -> NonEmpty Doc -> Doc
wrapInParens RenderContext
pn (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"key_hash" Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| [Doc
annDoc]
    T
TTimestamp        -> RenderContext -> NonEmpty Doc -> Doc
wrapInParens RenderContext
pn (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"timestamp" Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| [Doc
annDoc]
    T
TBytes            -> RenderContext -> NonEmpty Doc -> Doc
wrapInParens RenderContext
pn (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"bytes" Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| [Doc
annDoc]
    T
TAddress          -> RenderContext -> NonEmpty Doc -> Doc
wrapInParens RenderContext
pn (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"address" Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| [Doc
annDoc]
    T
TKey              -> RenderContext -> NonEmpty Doc -> Doc
wrapInParens RenderContext
pn (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"key" Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| [Doc
annDoc]
    T
TBls12381Fr       -> RenderContext -> NonEmpty Doc -> Doc
wrapInParens RenderContext
pn (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"bls12_381_fr" Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| [Doc
annDoc]
    T
TBls12381G1       -> RenderContext -> NonEmpty Doc -> Doc
wrapInParens RenderContext
pn (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"bls12_381_g1" Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| [Doc
annDoc]
    T
TBls12381G2       -> RenderContext -> NonEmpty Doc -> Doc
wrapInParens RenderContext
pn (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"bls12_381_g2" Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| [Doc
annDoc]
    T
TUnit             -> RenderContext -> NonEmpty Doc -> Doc
wrapInParens RenderContext
pn (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"unit" Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| [Doc
annDoc]
    T
TSignature        -> RenderContext -> NonEmpty Doc -> Doc
wrapInParens RenderContext
pn (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"signature" Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| [Doc
annDoc]
    T
TChainId          -> RenderContext -> NonEmpty Doc -> Doc
wrapInParens RenderContext
pn (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"chain_id" Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| [Doc
annDoc]
    T
TOperation        -> RenderContext -> NonEmpty Doc -> Doc
wrapInParens RenderContext
pn (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"operation" Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| [Doc
annDoc]
    T
TChest            -> RenderContext -> NonEmpty Doc -> Doc
wrapInParens RenderContext
pn (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"chest" Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| [Doc
annDoc]
    T
TChestKey         -> RenderContext -> NonEmpty Doc -> Doc
wrapInParens RenderContext
pn (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"chest_key" Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| [Doc
annDoc]
    T
TNever            -> RenderContext -> NonEmpty Doc -> Doc
wrapInParens RenderContext
pn (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"never" Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| [Doc
annDoc]
    TSaplingState Natural
n   -> RenderContext -> Doc -> Doc
addParens RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"sapling_state" Doc -> Doc -> Doc
<+> Doc
annDoc Doc -> Doc -> Doc
<+> Natural -> Doc
forall a. Buildable a => a -> Doc
build Natural
n
    TSaplingTransaction Natural
n -> RenderContext -> Doc -> Doc
addParens RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"sapling_transaction" Doc -> Doc -> Doc
<+> Doc
annDoc Doc -> Doc -> Doc
<+> Natural -> Doc
forall a. Buildable a => a -> Doc
build Natural
n

    TOption (Ty T
t1 TypeAnn
ta1) ->
      Text -> [Doc] -> Doc
renderParametric Text
"option" [T -> AnnotationSet -> Doc
recRenderer T
t1 (TypeAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
singleAnnSet TypeAnn
ta1)]

    TList (Ty T
t1 TypeAnn
ta1) ->
      Text -> [Doc] -> Doc
renderParametric Text
"list" [T -> AnnotationSet -> Doc
recRenderer T
t1 (TypeAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
singleAnnSet TypeAnn
ta1)]

    TSet (Ty T
t1 TypeAnn
ta1) ->
      Text -> [Doc] -> Doc
renderParametric Text
"set" [T -> AnnotationSet -> Doc
recRenderer T
t1 (TypeAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
singleAnnSet TypeAnn
ta1)]

    TContract (Ty T
t1 TypeAnn
ta1) ->
      Text -> [Doc] -> Doc
renderParametric Text
"contract" [T -> AnnotationSet -> Doc
recRenderer T
t1 (TypeAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
singleAnnSet TypeAnn
ta1)]

    TTicket (Ty T
t1 TypeAnn
ta1) ->
      Text -> [Doc] -> Doc
renderParametric Text
"ticket" [T -> AnnotationSet -> Doc
recRenderer T
t1 (TypeAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
singleAnnSet TypeAnn
ta1)]

    -- Optimize in comb pair rendering: `pair x y z` instead of `pair x (pair y z)`
    -- Works only if there is no field annotation on nested pair
    p :: T
p@(TPair RootAnn
_ (Annotation Text
"") VarAnn
_ VarAnn
_ (Ty T
_ TypeAnn
_) (Ty (TPair {}) TypeAnn
_)) ->
      Text -> [Doc] -> Doc
renderParametric Text
"pair" ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ NonEmpty Doc -> [Element (NonEmpty Doc)]
forall t. Container t => t -> [Element t]
toList (NonEmpty Doc -> [Element (NonEmpty Doc)])
-> NonEmpty Doc -> [Element (NonEmpty Doc)]
forall a b. (a -> b) -> a -> b
$ T -> TypeAnn -> RootAnn -> NonEmpty Doc
collectBranches T
p TypeAnn
forall {k} (a :: k). Annotation a
noAnn RootAnn
forall {k} (a :: k). Annotation a
noAnn

    TPair RootAnn
fa1 RootAnn
fa2 VarAnn
va1 VarAnn
va2 (Ty T
t1 TypeAnn
ta1) (Ty T
t2 TypeAnn
ta2) ->
      Text -> [Doc] -> Doc
renderParametric Text
"pair"
        [ T -> AnnotationSet -> Doc
recRenderer T
t1 (AnnotationSet -> Doc) -> AnnotationSet -> Doc
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [RootAnn] -> [VarAnn] -> AnnotationSet
fullAnnSet [TypeAnn
ta1] [RootAnn
fa1] [VarAnn
va1]
        , T -> AnnotationSet -> Doc
recRenderer T
t2 (AnnotationSet -> Doc) -> AnnotationSet -> Doc
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [RootAnn] -> [VarAnn] -> AnnotationSet
fullAnnSet [TypeAnn
ta2] [RootAnn
fa2] [VarAnn
va2]
        ]

    TOr RootAnn
fa1 RootAnn
fa2 (Ty T
t1 TypeAnn
ta1) (Ty T
t2 TypeAnn
ta2) ->
      Text -> [Doc] -> Doc
renderParametric Text
"or"
        [ T -> AnnotationSet -> Doc
recRenderer T
t1 (AnnotationSet -> Doc) -> AnnotationSet -> Doc
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [RootAnn] -> [VarAnn] -> AnnotationSet
fullAnnSet [TypeAnn
ta1] [RootAnn
fa1] []
        , T -> AnnotationSet -> Doc
recRenderer T
t2 (AnnotationSet -> Doc) -> AnnotationSet -> Doc
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [RootAnn] -> [VarAnn] -> AnnotationSet
fullAnnSet [TypeAnn
ta2] [RootAnn
fa2] []
        ]

    TLambda (Ty T
t1 TypeAnn
ta1) (Ty T
t2 TypeAnn
ta2) ->
      Text -> [Doc] -> Doc
renderParametric Text
"lambda"
        [ T -> AnnotationSet -> Doc
recRenderer T
t1 (AnnotationSet -> Doc) -> AnnotationSet -> Doc
forall a b. (a -> b) -> a -> b
$ TypeAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
singleAnnSet TypeAnn
ta1
        , T -> AnnotationSet -> Doc
recRenderer T
t2 (AnnotationSet -> Doc) -> AnnotationSet -> Doc
forall a b. (a -> b) -> a -> b
$ TypeAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
singleAnnSet TypeAnn
ta2
        ]

    TMap (Ty T
t1 TypeAnn
ta1) (Ty T
t2 TypeAnn
ta2) ->
      Text -> [Doc] -> Doc
renderParametric Text
"map"
        [ T -> AnnotationSet -> Doc
recRenderer T
t1 (AnnotationSet -> Doc) -> AnnotationSet -> Doc
forall a b. (a -> b) -> a -> b
$ TypeAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
singleAnnSet TypeAnn
ta1
        , T -> AnnotationSet -> Doc
recRenderer T
t2 (AnnotationSet -> Doc) -> AnnotationSet -> Doc
forall a b. (a -> b) -> a -> b
$ TypeAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
singleAnnSet TypeAnn
ta2
        ]

    TBigMap (Ty T
t1 TypeAnn
ta1) (Ty T
t2 TypeAnn
ta2) ->
      Text -> [Doc] -> Doc
renderParametric Text
"big_map"
        [ T -> AnnotationSet -> Doc
recRenderer T
t1 (AnnotationSet -> Doc) -> AnnotationSet -> Doc
forall a b. (a -> b) -> a -> b
$ TypeAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
singleAnnSet TypeAnn
ta1
        , T -> AnnotationSet -> Doc
recRenderer T
t2 (AnnotationSet -> Doc) -> AnnotationSet -> Doc
forall a b. (a -> b) -> a -> b
$ TypeAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
singleAnnSet TypeAnn
ta2
        ]

-- | Michelson Type
data T =
    TKey
  | TUnit
  | TSignature
  | TChainId
  | TOption Ty
  | TList Ty
  | TSet Ty
  | TOperation
  | TContract Ty
  | TTicket Ty
  | TPair FieldAnn FieldAnn VarAnn VarAnn Ty Ty
  | TOr FieldAnn FieldAnn Ty Ty
  | TLambda Ty Ty
  | TMap Ty Ty
  | TBigMap Ty Ty
  | TInt
  | TNat
  | TString
  | TBytes
  | TMutez
  | TBool
  | TKeyHash
  | TBls12381Fr
  | TBls12381G1
  | TBls12381G2
  | TTimestamp
  | TAddress
  | TChest
  | TChestKey
  | TSaplingState Natural
  | TSaplingTransaction Natural
  | TNever
  deriving stock (T -> T -> Bool
(T -> T -> Bool) -> (T -> T -> Bool) -> Eq T
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: T -> T -> Bool
== :: T -> T -> Bool
$c/= :: T -> T -> Bool
/= :: T -> T -> Bool
Eq, Int -> T -> ShowS
[T] -> ShowS
T -> String
(Int -> T -> ShowS) -> (T -> String) -> ([T] -> ShowS) -> Show T
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> T -> ShowS
showsPrec :: Int -> T -> ShowS
$cshow :: T -> String
show :: T -> String
$cshowList :: [T] -> ShowS
showList :: [T] -> ShowS
Show, Typeable T
Typeable T
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> T -> c T)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c T)
-> (T -> Constr)
-> (T -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c T))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c T))
-> ((forall b. Data b => b -> b) -> T -> T)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> T -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> T -> r)
-> (forall u. (forall d. Data d => d -> u) -> T -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> T -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> T -> m T)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> T -> m T)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> T -> m T)
-> Data T
T -> Constr
T -> DataType
(forall b. Data b => b -> b) -> T -> T
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) -> T -> u
forall u. (forall d. Data d => d -> u) -> T -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> T -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> T -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> T -> m T
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> T -> m T
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c T
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> T -> c T
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c T)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c T)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> T -> c T
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> T -> c T
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c T
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c T
$ctoConstr :: T -> Constr
toConstr :: T -> Constr
$cdataTypeOf :: T -> DataType
dataTypeOf :: T -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c T)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c T)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c T)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c T)
$cgmapT :: (forall b. Data b => b -> b) -> T -> T
gmapT :: (forall b. Data b => b -> b) -> T -> T
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> T -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> T -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> T -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> T -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> T -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> T -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> T -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> T -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> T -> m T
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> T -> m T
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> T -> m T
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> T -> m T
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> T -> m T
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> T -> m T
Data, (forall x. T -> Rep T x) -> (forall x. Rep T x -> T) -> Generic T
forall x. Rep T x -> T
forall x. T -> Rep T x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. T -> Rep T x
from :: forall x. T -> Rep T x
$cto :: forall x. Rep T x -> T
to :: forall x. Rep T x -> T
Generic, (forall (m :: * -> *). Quote m => T -> m Exp)
-> (forall (m :: * -> *). Quote m => T -> Code m T) -> Lift T
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => T -> m Exp
forall (m :: * -> *). Quote m => T -> Code m T
$clift :: forall (m :: * -> *). Quote m => T -> m Exp
lift :: forall (m :: * -> *). Quote m => T -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => T -> Code m T
liftTyped :: forall (m :: * -> *). Quote m => T -> Code m T
Lift)
  deriving anyclass T -> ()
(T -> ()) -> NFData T
forall a. (a -> ()) -> NFData a
$crnf :: T -> ()
rnf :: T -> ()
NFData

-- | Construct non-annotated @option@ type from an annotated type
toption :: Ty -> T
toption :: Ty -> T
toption Ty
t = Ty -> T
TOption Ty
t

-- | Construct non-annotated @pair@ type from two annotated types
tpair :: Ty -> Ty -> T
tpair :: Ty -> Ty -> T
tpair Ty
l Ty
r = RootAnn -> RootAnn -> VarAnn -> VarAnn -> Ty -> Ty -> T
TPair RootAnn
forall {k} (a :: k). Annotation a
noAnn RootAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
forall {k} (a :: k). Annotation a
noAnn Ty
l Ty
r

-- | Construct non-annotated @or@ type from two annotated types
tor :: Ty -> Ty -> T
tor :: Ty -> Ty -> T
tor Ty
l Ty
r = RootAnn -> RootAnn -> Ty -> Ty -> T
TOr RootAnn
forall {k} (a :: k). Annotation a
noAnn RootAnn
forall {k} (a :: k). Annotation a
noAnn Ty
l Ty
r

-- | Construct annotated @int@ type with an empty annotation
tyint :: Ty
tyint :: Ty
tyint = T -> TypeAnn -> Ty
Ty T
TInt TypeAnn
forall {k} (a :: k). Annotation a
noAnn

-- | Construct annotated @nat@ type with an empty annotation
tynat :: Ty
tynat :: Ty
tynat = T -> TypeAnn -> Ty
Ty T
TNat TypeAnn
forall {k} (a :: k). Annotation a
noAnn

-- | Construct annotated @unit@ type with an empty annotation
tyunit :: Ty
tyunit :: Ty
tyunit = T -> TypeAnn -> Ty
Ty T
TUnit TypeAnn
forall {k} (a :: k). Annotation a
noAnn

-- | Construct annotated @bool@ type with an empty annotation
tybool :: Ty
tybool :: Ty
tybool = T -> TypeAnn -> Ty
Ty T
TBool TypeAnn
forall {k} (a :: k). Annotation a
noAnn

-- | Construct annotated @pair@ type with an empty annotation
typair :: Ty -> Ty -> Ty
typair :: Ty -> Ty -> Ty
typair Ty
l Ty
r = T -> TypeAnn -> Ty
Ty (Ty -> Ty -> T
tpair Ty
l Ty
r) TypeAnn
forall {k} (a :: k). Annotation a
noAnn

-- | Construct annotated @or@ type with an empty annotation
tyor :: Ty -> Ty -> Ty
tyor :: Ty -> Ty -> Ty
tyor Ty
l Ty
r = T -> TypeAnn -> Ty
Ty (Ty -> Ty -> T
tor Ty
l Ty
r) TypeAnn
forall {k} (a :: k). Annotation a
noAnn

-- | For implicit account, which Ty its parameter seems to have
-- from outside.
tyImplicitAccountParam :: Ty
tyImplicitAccountParam :: Ty
tyImplicitAccountParam = T -> TypeAnn -> Ty
Ty T
TUnit TypeAnn
forall {k} (a :: k). Annotation a
noAnn

-- | Check if type is atomic.
isAtomicType :: Ty -> Bool
isAtomicType :: Ty -> Bool
isAtomicType t :: Ty
t@(Ty T
_ TypeAnn
tAnn) | TypeAnn
tAnn TypeAnn -> TypeAnn -> Bool
forall a. Eq a => a -> a -> Bool
== TypeAnn
forall {k} (a :: k). Annotation a
noAnn =
    Ty -> Bool
isComparable Ty
t Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| Ty -> Bool
isKey Ty
t Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| Ty -> Bool
isUnit Ty
t Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| Ty -> Bool
isSignature Ty
t Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| Ty -> Bool
isOperation Ty
t
isAtomicType Ty
_ = Bool
False

-- | Predicate checking if type is @key@
isKey :: Ty -> Bool
isKey :: Ty -> Bool
isKey (Ty T
TKey TypeAnn
_) = Bool
True
isKey Ty
_ = Bool
False

-- | Predicate checking if type is @unit@
isUnit :: Ty -> Bool
isUnit :: Ty -> Bool
isUnit (Ty T
TUnit TypeAnn
_) = Bool
True
isUnit Ty
_ = Bool
False

-- | Predicate checking if type is @signature@
isSignature :: Ty -> Bool
isSignature :: Ty -> Bool
isSignature (Ty T
TSignature TypeAnn
_) = Bool
True
isSignature Ty
_ = Bool
False

-- | Predicate checking if type is @operation@
isOperation :: Ty -> Bool
isOperation :: Ty -> Bool
isOperation (Ty T
TOperation TypeAnn
_) = Bool
True
isOperation Ty
_ = Bool
False

-- | Predicate checking if type is comparable, i.e. true for @int@, @nat@, @string@, etc.
-- see <https://tezos.gitlab.io/michelson-reference/> for a complete list of comparable types.
isComparable :: Ty -> Bool
isComparable :: Ty -> Bool
isComparable (Ty T
t TypeAnn
_) = case T
t of
  T
TInt -> Bool
True
  T
TNat -> Bool
True
  T
TString -> Bool
True
  T
TBytes -> Bool
True
  T
TMutez -> Bool
True
  T
TBool -> Bool
True
  T
TKeyHash -> Bool
True
  T
TTimestamp -> Bool
True
  T
TAddress -> Bool
True
  T
_ -> Bool
False

-- | Predicate checking if type is @mutez@
isMutez :: Ty -> Bool
isMutez :: Ty -> Bool
isMutez (Ty T
TMutez TypeAnn
_) = Bool
True
isMutez Ty
_ = Bool
False

-- | Predicate checking if type is @timestamp@
isTimestamp :: Ty -> Bool
isTimestamp :: Ty -> Bool
isTimestamp (Ty T
TTimestamp TypeAnn
_) = Bool
True
isTimestamp Ty
_ = Bool
False

-- | Predicate checking if type is @keyhash@
isKeyHash :: Ty -> Bool
isKeyHash :: Ty -> Bool
isKeyHash (Ty T
TKeyHash TypeAnn
_) = Bool
True
isKeyHash Ty
_ = Bool
False

-- | Predicate checking if type is @bool@
isBool :: Ty -> Bool
isBool :: Ty -> Bool
isBool (Ty T
TBool TypeAnn
_) = Bool
True
isBool Ty
_ = Bool
False

-- | Predicate checking if type is @string@
isString :: Ty -> Bool
isString :: Ty -> Bool
isString (Ty T
TString TypeAnn
_) = Bool
True
isString Ty
_ = Bool
False

-- | Predicate checking if type is integral, i.e. @nat@, @int@, @mutez@, or @timestamp@
isInteger :: Ty -> Bool
isInteger :: Ty -> Bool
isInteger Ty
a = Ty -> Bool
isNat Ty
a Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| Ty -> Bool
isInt Ty
a Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| Ty -> Bool
isMutez Ty
a Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| Ty -> Bool
isTimestamp Ty
a

-- | Predicate checking if type is @nat@
isNat :: Ty -> Bool
isNat :: Ty -> Bool
isNat (Ty T
TNat TypeAnn
_) = Bool
True
isNat Ty
_ = Bool
False

-- | Predicate checking if type is @int@
isInt :: Ty -> Bool
isInt :: Ty -> Bool
isInt (Ty T
TInt TypeAnn
_) = Bool
True
isInt Ty
_ = Bool
False

-- | Predicate checking if type is @bytes@
isBytes :: Ty -> Bool
isBytes :: Ty -> Bool
isBytes (Ty T
TBytes TypeAnn
_) = Bool
True
isBytes Ty
_ = Bool
False

----------------------------------------------------------------------------
-- TH derivations
----------------------------------------------------------------------------

-- T and Ty are mutually recursive, so their derivation quotes need to be aware of each other
$(mconcat
  [ deriveJSON morleyAesonOptions ''Ty
  , deriveJSON morleyAesonOptions ''T
  ])

deriveJSON morleyAesonOptions ''ParameterType