-- 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, align, integer, softbreak, (<$>), (<+>))

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'
      renderBranches :: NonEmpty Doc -> Doc
      renderBranches :: NonEmpty Doc -> Doc
renderBranches NonEmpty Doc
ds =
        if Bool
forceSingleLine
        then (Doc -> Doc -> Doc) -> NonEmpty Doc -> Doc
forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1 Doc -> Doc -> Doc
(<+>) NonEmpty Doc
ds
        else Doc -> Doc
align (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
softbreak Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (Doc -> Doc -> Doc) -> NonEmpty Doc -> Doc
forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1 Doc -> Doc -> Doc
(<$>) NonEmpty Doc
ds

      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)
    T
TTxRollupL2Address    -> RenderContext -> NonEmpty Doc -> Doc
wrapInParens RenderContext
pn (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"tx_rollup_l2_address" Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| [Doc
annDoc]

    TOption (Ty T
t1 TypeAnn
ta1) ->
      RenderContext -> Doc -> Doc
addParens RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      Doc
"option" Doc -> Doc -> Doc
<+> Doc
annDoc Doc -> Doc -> Doc
<+> T -> AnnotationSet -> Doc
recRenderer T
t1 (TypeAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
singleAnnSet TypeAnn
ta1)

    TList (Ty T
t1 TypeAnn
ta1) ->
      RenderContext -> Doc -> Doc
addParens RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      Doc
"list" Doc -> Doc -> Doc
<+> Doc
annDoc Doc -> Doc -> Doc
<+> T -> AnnotationSet -> Doc
recRenderer T
t1 (TypeAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
singleAnnSet TypeAnn
ta1)

    TSet (Ty T
t1 TypeAnn
ta1) ->
      RenderContext -> Doc -> Doc
addParens RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      Doc
"set" Doc -> Doc -> Doc
<+> Doc
annDoc Doc -> Doc -> Doc
<+> T -> AnnotationSet -> Doc
recRenderer T
t1 (TypeAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
singleAnnSet TypeAnn
ta1)

    TContract (Ty T
t1 TypeAnn
ta1) ->
      RenderContext -> Doc -> Doc
addParens RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      Doc
"contract" Doc -> Doc -> Doc
<+> Doc
annDoc Doc -> Doc -> Doc
<+> T -> AnnotationSet -> Doc
recRenderer T
t1 (TypeAnn -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
singleAnnSet TypeAnn
ta1)

    TTicket (Ty T
t1 TypeAnn
ta1) ->
      RenderContext -> Doc -> Doc
addParens RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      Doc
"ticket" Doc -> Doc -> Doc
<+> Doc
annDoc Doc -> Doc -> Doc
<+> 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
_)) ->
       let branches :: NonEmpty Doc
branches = T -> TypeAnn -> RootAnn -> NonEmpty Doc
collectBranches T
p TypeAnn
forall {k} (a :: k). Annotation a
noAnn RootAnn
forall {k} (a :: k). Annotation a
noAnn
       in
        RenderContext -> Doc -> Doc
addParens RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
          Doc
"pair" Doc -> Doc -> Doc
<+> Doc
annDoc Doc -> Doc -> Doc
<+>
            NonEmpty Doc -> Doc
renderBranches NonEmpty Doc
branches

    TPair RootAnn
fa1 RootAnn
fa2 VarAnn
va1 VarAnn
va2 (Ty T
t1 TypeAnn
ta1) (Ty T
t2 TypeAnn
ta2) ->
      RenderContext -> Doc -> Doc
addParens RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        Doc
"pair" Doc -> Doc -> Doc
<+> Doc
annDoc Doc -> Doc -> Doc
<+>
          NonEmpty Doc -> Doc
renderBranches (
            (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 -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:|
            [ 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) ->
      RenderContext -> Doc -> Doc
addParens RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        Doc
"or" Doc -> Doc -> Doc
<+> Doc
annDoc Doc -> Doc -> Doc
<+>
          NonEmpty Doc -> Doc
renderBranches (
            (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] []) Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:|
            [ 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) ->
      RenderContext -> Doc -> Doc
addParens RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        Doc
"lambda" Doc -> Doc -> Doc
<+> Doc
annDoc Doc -> Doc -> Doc
<+>
          NonEmpty Doc -> Doc
renderBranches (
            (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) Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:|
            [ 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) ->
      RenderContext -> Doc -> Doc
addParens RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        Doc
"map" Doc -> Doc -> Doc
<+> Doc
annDoc Doc -> Doc -> Doc
<+>
          NonEmpty Doc -> Doc
renderBranches (
            (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) Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:|
            [ 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) ->
      RenderContext -> Doc -> Doc
addParens RenderContext
pn (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        Doc
"big_map" Doc -> Doc -> Doc
<+> Doc
annDoc Doc -> Doc -> Doc
<+>
          NonEmpty Doc -> Doc
renderBranches (
            (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) Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:|
            [ 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
  | TTxRollupL2Address
  | 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