-- 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(build))
import Language.Haskell.TH.Syntax (Lift)
import Prelude hiding ((<$>))
import Text.PrettyPrint.Leijen.Text (Doc, integer, (<+>))
import Text.PrettyPrint.Leijen.Text qualified as PP

import Morley.Michelson.Printer.Util
  (Prettier(..), RenderContext, RenderDoc(..), addParens, buildRenderDoc, buildRenderDocExtended,
  doesntNeedParens, needsParens, wrapInParens)
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
/= :: Ty -> Ty -> Bool
$c/= :: Ty -> Ty -> Bool
== :: Ty -> Ty -> Bool
$c== :: 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
showList :: [Ty] -> ShowS
$cshowList :: [Ty] -> ShowS
show :: Ty -> String
$cshow :: Ty -> String
showsPrec :: Int -> Ty -> ShowS
$cshowsPrec :: Int -> 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 -> DataType
Ty -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ty -> m Ty
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ty -> m Ty
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ty -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ty -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Ty -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Ty -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ty -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ty -> r
gmapT :: (forall b. Data b => b -> b) -> Ty -> Ty
$cgmapT :: (forall b. Data b => b -> b) -> Ty -> Ty
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ty)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ty)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ty)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ty)
dataTypeOf :: Ty -> DataType
$cdataTypeOf :: Ty -> DataType
toConstr :: Ty -> Constr
$ctoConstr :: Ty -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ty
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ty
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ty -> c Ty
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ty -> c 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
$cto :: forall x. Rep Ty x -> Ty
$cfrom :: forall x. Ty -> Rep Ty x
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
liftTyped :: forall (m :: * -> *). Quote m => Ty -> Code m Ty
$cliftTyped :: forall (m :: * -> *). Quote m => Ty -> Code m Ty
lift :: forall (m :: * -> *). Quote m => Ty -> m Exp
$clift :: forall (m :: * -> *). Quote m => Ty -> m Exp
Lift)

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

instance NFData Ty

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

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

instance RenderDoc (MismatchError Ty) where
  renderDoc :: RenderContext -> MismatchError Ty -> Doc
renderDoc RenderContext
ctx = RenderContext -> MismatchError (Prettier Ty) -> Doc
forall a. RenderDoc a => RenderContext -> MismatchError a -> Doc
renderDocDiff RenderContext
ctx (MismatchError (Prettier Ty) -> Doc)
-> (MismatchError Ty -> MismatchError (Prettier Ty))
-> MismatchError Ty
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ty -> Prettier Ty)
-> MismatchError Ty -> MismatchError (Prettier Ty)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ty -> Prettier Ty
forall a. a -> Prettier a
Prettier

instance RenderDoc T where
  renderDoc :: RenderContext -> T -> Doc
renderDoc RenderContext
pn T
t = T -> Bool -> RenderContext -> AnnotationSet -> Doc
renderType T
t Bool
True 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
/= :: ParameterType -> ParameterType -> Bool
$c/= :: ParameterType -> ParameterType -> Bool
== :: ParameterType -> ParameterType -> Bool
$c== :: 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
showList :: [ParameterType] -> ShowS
$cshowList :: [ParameterType] -> ShowS
show :: ParameterType -> String
$cshow :: ParameterType -> String
showsPrec :: Int -> ParameterType -> ShowS
$cshowsPrec :: Int -> 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 -> DataType
ParameterType -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParameterType -> m ParameterType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParameterType -> m ParameterType
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ParameterType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ParameterType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ParameterType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ParameterType -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParameterType -> r
gmapT :: (forall b. Data b => b -> b) -> ParameterType -> ParameterType
$cgmapT :: (forall b. Data b => b -> b) -> ParameterType -> ParameterType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParameterType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParameterType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParameterType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParameterType)
dataTypeOf :: ParameterType -> DataType
$cdataTypeOf :: ParameterType -> DataType
toConstr :: ParameterType -> Constr
$ctoConstr :: ParameterType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParameterType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParameterType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParameterType -> c ParameterType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParameterType -> c 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
$cto :: forall x. Rep ParameterType x -> ParameterType
$cfrom :: forall x. ParameterType -> Rep ParameterType x
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
liftTyped :: forall (m :: * -> *).
Quote m =>
ParameterType -> Code m ParameterType
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ParameterType -> Code m ParameterType
lift :: forall (m :: * -> *). Quote m => ParameterType -> m Exp
$clift :: forall (m :: * -> *). Quote m => ParameterType -> m Exp
Lift)

instance NFData ParameterType

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

instance RenderDoc ParameterType where
  renderDoc :: RenderContext -> ParameterType -> Doc
renderDoc RenderContext
pn (ParameterType (Ty T
t TypeAnn
ta) RootAnn
ra) =
    T -> Bool -> RenderContext -> AnnotationSet -> Doc
renderType T
t Bool
True 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
  -> Bool
  -> RenderContext
  -> AnnotationSet
  -> Doc
renderType :: T -> Bool -> RenderContext -> AnnotationSet -> Doc
renderType T
t Bool
forceSingleLine 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 -> Bool -> RenderContext -> AnnotationSet -> Doc
renderType T
t' Bool
forceSingleLine RenderContext
needsParens AnnotationSet
annSet'
      renderParametric :: Text -> [Doc] -> Doc
      renderParametric :: Text -> [Doc] -> Doc
renderParametric Text
name [Doc]
args = Doc -> Doc
PP.group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        if Doc -> Bool
PP.isEmpty Doc
annDoc Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Text -> Int
forall t. Container t => t -> Int
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
PP.textStrict Text
name Doc -> Doc -> Doc
<+> Doc -> Doc
PP.align ([Doc] -> Doc
PP.vsep [Doc]
args)
        else Int -> Doc -> Doc
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
PP.vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Text -> Doc
PP.textStrict 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
<+> (Integer -> Doc
integer (Integer -> Doc) -> Integer -> Doc
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
forall a. Integral a => a -> Integer
toInteger 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
<+> (Integer -> Doc
integer (Integer -> Doc) -> Integer -> Doc
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
forall a. Integral a => a -> Integer
toInteger 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
        ]

instance Buildable Ty where
  build :: Ty -> Builder
build = Ty -> Builder
forall a. RenderDoc a => a -> Builder
buildRenderDoc

instance Buildable (MismatchError Ty) where
  build :: MismatchError Ty -> Builder
build = MismatchError Ty -> Builder
forall a. RenderDoc a => a -> Builder
buildRenderDocExtended

instance Buildable ParameterType where
  build :: ParameterType -> Builder
build = ParameterType -> Builder
forall a. RenderDoc a => a -> Builder
buildRenderDoc

-- | 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
/= :: T -> T -> Bool
$c/= :: T -> T -> Bool
== :: T -> T -> Bool
$c== :: 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
showList :: [T] -> ShowS
$cshowList :: [T] -> ShowS
show :: T -> String
$cshow :: T -> String
showsPrec :: Int -> T -> ShowS
$cshowsPrec :: Int -> 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 -> DataType
T -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> T -> m T
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> T -> m T
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> T -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> T -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> T -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> T -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> T -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> T -> r
gmapT :: (forall b. Data b => b -> b) -> T -> T
$cgmapT :: (forall b. Data b => b -> b) -> T -> T
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c T)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c T)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c T)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c T)
dataTypeOf :: T -> DataType
$cdataTypeOf :: T -> DataType
toConstr :: T -> Constr
$ctoConstr :: T -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c T
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c T
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> T -> c T
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> T -> c 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
$cto :: forall x. Rep T x -> T
$cfrom :: forall x. T -> Rep T x
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
liftTyped :: forall (m :: * -> *). Quote m => T -> Code m T
$cliftTyped :: forall (m :: * -> *). Quote m => T -> Code m T
lift :: forall (m :: * -> *). Quote m => T -> m Exp
$clift :: forall (m :: * -> *). Quote m => T -> m Exp
Lift)

instance Buildable T where
  build :: T -> Builder
build = T -> Builder
forall a. RenderDoc a => a -> Builder
buildRenderDoc

instance NFData T

-- | 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