-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | Developer tools for the Michelson Language -- -- A library to make writing smart contracts in Michelson — the smart -- contract language of the Tezos blockchain — pleasant and effective. @package morley @version 1.2.0 module Michelson.Printer.Util -- | Generalize converting a type into a Text.PrettyPrint.Leijen.Text.Doc. -- Used to pretty print Michelson code and define Fmt.Buildable -- instances. class RenderDoc a renderDoc :: RenderDoc a => RenderContext -> a -> Doc -- | Whether a value can be represented in Michelson code. Normally either -- all values of some type are renderable or not renderable. However, in -- case of instructions we have extra instructions which should not be -- rendered. Note: it's not suficcient to just return mempty for -- such instructions, because sometimes we want to print lists of -- instructions and we need to ignore them complete (to avoid putting -- redundant separators). isRenderable :: RenderDoc a => a -> Bool -- | A new type that can wrap values so that the RenderDoc instances of the -- combined value can have a different behavior for the pretty printer. newtype Prettier a Prettier :: a -> Prettier a -- | Convert Doc to Text with a line width of 80. printDoc :: Bool -> Doc -> Text -- | Convert Doc to Builder in the same maner as -- printDoc. printDocB :: Bool -> Doc -> Builder -- | Convert Doc to String in the same maner as -- printDoc. printDocS :: Bool -> Doc -> String -- | Generic way to render the different op types that get passed to a -- contract. renderOps :: RenderDoc op => Bool -> NonEmpty op -> Doc renderOpsList :: RenderDoc op => Bool -> [op] -> Doc -- | Create a specific number of spaces. spaces :: Int -> Doc -- | Wrap documents in parentheses if there are two or more in the list. wrapInParens :: RenderContext -> NonEmpty Doc -> Doc -- | Turn something that is instance of RenderDoc into a -- Builder. It's formatted the same way as printDoc formats -- docs. buildRenderDoc :: RenderDoc a => a -> Builder -- | Environment carried during recursive rendering. data RenderContext -- | ParensNeeded constant. needsParens :: RenderContext -- | ParensNeeded constant. doesntNeedParens :: RenderContext -- | Add parentheses if needed. addParens :: RenderContext -> Doc -> Doc -- | Ensure parentheses are not required, for case when you cannot sensibly -- wrap your expression into them. assertParensNotNeeded :: RenderContext -> a -> a -- | Testing utility functions used by testing framework itself or intended -- to be used by test writers. module Michelson.Test.Util leftToShowPanic :: (Show e, HasCallStack) => Either e a -> a leftToPrettyPanic :: (Buildable e, HasCallStack) => Either e a -> a -- | A Property that always failes with given message. failedProp :: Text -> Property -- | A Property that always succeeds. succeededProp :: Property -- | The Property holds on `Left a`. qcIsLeft :: Show b => Either a b -> Property -- | The Property holds on `Right b`. qcIsRight :: Show a => Either a b -> Property -- | This TestTree contains a property based test for conversion -- from some x to some y and back to x (it -- should successfully return the initial x). roundtripTest :: forall x y err. (Show x, Show err, Typeable x, Arbitrary x, Eq x, Eq err) => (x -> y) -> (y -> Either err x) -> TestTree module Michelson.Typed.Haskell.Instr.Helpers -- | Which branch to choose in generic tree representation: left, straight -- or right. S is used when there is one constructor with one -- field (something newtype-like). -- -- The reason why we need S can be explained by this example: data -- A = A1 B | A2 Integer data B = B Bool Now we may search for A1 -- constructor or B constructor. Without S in both cases path will -- be the same ([L]). data Branch L :: Branch S :: Branch R :: Branch -- | Path to a leaf (some field or constructor) in generic tree -- representation. type Path = [Branch] -- | Cryptographic primitives related to hashing. module Tezos.Crypto.Hash -- | Compute a cryptographic hash of a bytestring using the Blake2b_256 -- cryptographic hash function. It's used by the BLAKE2B instruction in -- Michelson. blake2b :: ByteString -> ByteString -- | Compute a cryptographic hash of a bytestring using the Blake2b_160 -- cryptographic hash function. blake2b160 :: ByteString -> ByteString -- | Compute a cryptographic hash of a bytestring using the Sha256 -- cryptographic hash function. sha256 :: ByteString -> ByteString -- | Compute a cryptographic hash of a bytestring using the Sha512 -- cryptographic hash function. sha512 :: ByteString -> ByteString -- | Utilities shared by multiple cryptographic primitives. module Tezos.Crypto.Util -- | Error that can happen during parsing of cryptographic primitive types. data CryptoParseError CryptoParseWrongBase58Check :: CryptoParseError CryptoParseWrongTag :: ByteString -> CryptoParseError CryptoParseCryptoError :: CryptoError -> CryptoParseError CryptoParseUnexpectedLength :: Builder -> Int -> CryptoParseError -- | Encode a bytestring in Base58Check format. encodeBase58Check :: ByteString -> Text -- | Decode a bytestring from Base58Check format. decodeBase58Check :: Text -> Maybe ByteString data B58CheckWithPrefixError B58CheckWithPrefixWrongPrefix :: ByteString -> B58CheckWithPrefixError B58CheckWithPrefixWrongEncoding :: B58CheckWithPrefixError -- | Parse a base58check encoded value expecting some prefix. If the actual -- prefix matches the expected one, it's stripped of and the resulting -- payload is returned. decodeBase58CheckWithPrefix :: ByteString -> Text -> Either B58CheckWithPrefixError ByteString -- | Template for 'format*' functions. formatImpl :: ByteArrayAccess x => ByteString -> x -> Text -- | Template for 'parse*' functions. parseImpl :: ByteString -> (ByteString -> Either CryptoParseError res) -> Text -> Either CryptoParseError res -- | Returns first encountered Right in a list. If there are none, -- returns arbitrary Left. It is useful to implement parsing. firstRight :: NonEmpty (Either e a) -> Either e a -- | Do randomized action using specified seed. deterministic :: ByteString -> MonadPseudoRandom ChaChaDRG a -> a instance GHC.Show.Show Tezos.Crypto.Util.B58CheckWithPrefixError instance GHC.Classes.Eq Tezos.Crypto.Util.CryptoParseError instance GHC.Show.Show Tezos.Crypto.Util.CryptoParseError instance Control.DeepSeq.NFData Tezos.Crypto.Util.CryptoParseError instance Formatting.Buildable.Buildable Tezos.Crypto.Util.CryptoParseError -- | Utilities related to the aeson package. module Util.Aeson -- | Options that we use in morley-based packages (including -- morley) by default. morleyAesonOptions :: Options -- | Michelson annotations in untyped model. module Michelson.Untyped.Annotation -- | Generic TypeFieldVariable Annotation -- -- As per Michelson documentation, this type has an invariant: (except -- for the first character, here parametrized in the type tag) -- the allowed character set is the one matching the following regexp: -- %|%%|%|[:%][_a-zA-Z][_0-9a-zA-Z.%@]* newtype Annotation tag AnnotationUnsafe :: Text -> Annotation tag [unAnnotation] :: Annotation tag -> Text pattern Annotation :: Text -> Annotation tag pattern WithAnn :: Annotation tag -> Annotation tag -- | An AnnotationSet contains all the typefieldvariable -- Annotations , with each group in order, associated with an -- entity. Note that in its rendering/show instances the unnecessary -- annotations will be omitted, as well as in some of the functions -- operating with it. Necessary Annotations are the ones strictly -- required for a consistent representation. In particular, for each -- group (tfv): - if all annotations are noAnn they are all -- omitted - if one or more noAnn follow a non-empty ann, -- they are omitted - if one or more noAnn precede a non-empty -- ann, they are kept - every non-empty ann is obviously -- kept This is why order for each group is important as well as -- separation of different groups of Annotations. data AnnotationSet -- | An AnnotationSet without any Annotation. emptyAnnSet :: AnnotationSet -- | An AnnotationSet built from all 3 kinds of Annotation. fullAnnSet :: [TypeAnn] -> [FieldAnn] -> [VarAnn] -> AnnotationSet -- | Returns True if all Annotations in the Set are -- unnecessaryemptynoAnn. False otherwise. isNoAnnSet :: AnnotationSet -> Bool -- | Returns the amount of Annotations that are necessary for a -- consistent representation. See AnnotationSet. minAnnSetSize :: AnnotationSet -> Int -- | An AnnotationSet with only a single Annotation (of any -- kind). singleAnnSet :: forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet -- | An AnnotationSet with several Annotations of the same -- kind. singleGroupAnnSet :: forall tag. KnownAnnTag tag => [Annotation tag] -> AnnotationSet class Typeable (tag :: Type) => KnownAnnTag tag annPrefix :: KnownAnnTag tag => Text type TypeAnn = Annotation TypeTag type FieldAnn = Annotation FieldTag type VarAnn = Annotation VarTag type SomeAnn = Annotation SomeTag -- | Root annotation was added in the Babylon, it looks the same as field -- annotation, but has slightly different semantic and can be used only -- in parameter ParameterType. type RootAnn = Annotation RootTag noAnn :: Annotation a -- | Makes an Annotation from its textual value, prefix (%@:) -- excluded Throws an error if the given Text contains invalid -- characters ann :: HasCallStack => Text -> Annotation a -- | Makes an Annotation from its textual value, prefix (%@:) -- excluded Returns a Text error message if the given Text -- contains invalid characters mkAnnotation :: Text -> Either Text (Annotation a) -- | List of all the special Variable Annotations, only allowed in -- CAR and CDR instructions, prefix (@) excluded. These -- do not respect the rules of isValidAnnStart and -- isValidAnnBodyChar. specialVarAnns :: [Text] -- | The only special Field Annotation, only allowed in PAIR, -- LEFT and RIGHT instructions, prefix (%) excluded. -- This does not respect the rules of isValidAnnStart and -- isValidAnnBodyChar. specialFieldAnn :: Text -- | Checks if a Char is valid to be the first of an annotation, -- prefix (%@:) excluded, the ones following should be checked -- with isValidAnnBodyChar instead. Note that this does not check -- Special Annotations, see specialVarAnns and -- specialFieldAnn isValidAnnStart :: Char -> Bool -- | Checks if a Char is valid to be part of an annotation, -- following a valid first character (see isValidAnnStart) and the -- prefix (%@:). Note that this does not check Special -- Annotations, see specialVarAnns and specialFieldAnn isValidAnnBodyChar :: Char -> Bool unifyAnn :: Annotation tag -> Annotation tag -> Maybe (Annotation tag) ifAnnUnified :: Annotation tag -> Annotation tag -> Bool disjoinVn :: VarAnn -> (VarAnn, VarAnn) convAnn :: Annotation tag1 -> Annotation tag2 instance forall k (tag :: k). Language.Haskell.TH.Syntax.Lift (Michelson.Untyped.Annotation.Annotation tag) instance forall k (tag :: k). Data.Aeson.Types.ToJSON.ToJSON (Michelson.Untyped.Annotation.Annotation tag) instance forall k (tag :: k). Data.Aeson.Types.FromJSON.FromJSON (Michelson.Untyped.Annotation.Annotation tag) instance GHC.Classes.Eq Michelson.Untyped.Annotation.AnnotationSet instance forall k (tag :: k). Data.String.IsString (Michelson.Untyped.Annotation.Annotation tag) instance forall k (tag :: k). GHC.Generics.Generic (Michelson.Untyped.Annotation.Annotation tag) instance GHC.Base.Functor Michelson.Untyped.Annotation.Annotation instance forall k (tag :: k). (Data.Typeable.Internal.Typeable tag, Data.Typeable.Internal.Typeable k) => Data.Data.Data (Michelson.Untyped.Annotation.Annotation tag) instance forall k (tag :: k). GHC.Classes.Eq (Michelson.Untyped.Annotation.Annotation tag) instance GHC.Base.Semigroup Michelson.Untyped.Annotation.AnnotationSet instance GHC.Base.Monoid Michelson.Untyped.Annotation.AnnotationSet instance GHC.Show.Show Michelson.Untyped.Annotation.AnnotationSet instance Michelson.Printer.Util.RenderDoc Michelson.Untyped.Annotation.AnnotationSet instance Formatting.Buildable.Buildable Michelson.Untyped.Annotation.AnnotationSet instance GHC.Base.Semigroup Michelson.Untyped.Annotation.VarAnn instance GHC.Base.Monoid Michelson.Untyped.Annotation.VarAnn instance Michelson.Untyped.Annotation.KnownAnnTag Michelson.Untyped.Annotation.RootTag instance Michelson.Untyped.Annotation.KnownAnnTag Michelson.Untyped.Annotation.VarTag instance Michelson.Untyped.Annotation.KnownAnnTag Michelson.Untyped.Annotation.FieldTag instance Michelson.Untyped.Annotation.KnownAnnTag Michelson.Untyped.Annotation.TypeTag instance Michelson.Untyped.Annotation.KnownAnnTag tag => GHC.Show.Show (Michelson.Untyped.Annotation.Annotation tag) instance Michelson.Untyped.Annotation.KnownAnnTag tag => Michelson.Printer.Util.RenderDoc (Michelson.Untyped.Annotation.Annotation tag) instance Michelson.Untyped.Annotation.KnownAnnTag tag => Formatting.Buildable.Buildable (Michelson.Untyped.Annotation.Annotation tag) instance forall k (tag :: k). Control.DeepSeq.NFData (Michelson.Untyped.Annotation.Annotation tag) instance forall k (tag :: k). Data.Default.Class.Default (Michelson.Untyped.Annotation.Annotation tag) -- | Michelson types represented in untyped model. module Michelson.Untyped.Type data Type Type :: ~T -> TypeAnn -> Type data T TKey :: T TUnit :: T TSignature :: T TChainId :: T TOption :: Type -> T TList :: Type -> T TSet :: Type -> T TOperation :: T TContract :: Type -> T TPair :: FieldAnn -> FieldAnn -> Type -> Type -> T TOr :: FieldAnn -> FieldAnn -> Type -> Type -> T TLambda :: Type -> Type -> T TMap :: Type -> Type -> T TBigMap :: Type -> Type -> T TInt :: T TNat :: T TString :: T TBytes :: T TMutez :: T TBool :: T TKeyHash :: T TTimestamp :: T TAddress :: T -- | Since Babylon parameter type can have special root annotation. data ParameterType ParameterType :: Type -> RootAnn -> ParameterType tint :: T tnat :: T tstring :: T tbytes :: T tmutez :: T tbool :: T tkeyHash :: T ttimestamp :: T taddress :: T toption :: Type -> T tpair :: Type -> Type -> T tor :: Type -> Type -> T tyint :: Type tynat :: Type tyunit :: Type tybool :: Type typair :: Type -> Type -> Type tyor :: Type -> Type -> Type -- | For implicit account, which type its parameter seems to have from -- outside. tyImplicitAccountParam :: Type isAtomicType :: Type -> Bool isKey :: Type -> Bool isSignature :: Type -> Bool isComparable :: Type -> Bool isMutez :: Type -> Bool isKeyHash :: Type -> Bool isBool :: Type -> Bool isString :: Type -> Bool isInteger :: Type -> Bool isTimestamp :: Type -> Bool isNat :: Type -> Bool isInt :: Type -> Bool isBytes :: Type -> Bool renderType :: T -> Bool -> RenderContext -> AnnotationSet -> Doc unwrapT :: Type -> T instance Language.Haskell.TH.Syntax.Lift Michelson.Untyped.Type.ParameterType instance Language.Haskell.TH.Syntax.Lift Michelson.Untyped.Type.T instance Language.Haskell.TH.Syntax.Lift Michelson.Untyped.Type.Type instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Type.ParameterType instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Type.ParameterType instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Type.T instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Type.T instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Type.Type instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Type.Type instance GHC.Generics.Generic Michelson.Untyped.Type.ParameterType instance Data.Data.Data Michelson.Untyped.Type.ParameterType instance GHC.Show.Show Michelson.Untyped.Type.ParameterType instance GHC.Classes.Eq Michelson.Untyped.Type.ParameterType instance GHC.Generics.Generic Michelson.Untyped.Type.Type instance Data.Data.Data Michelson.Untyped.Type.Type instance GHC.Show.Show Michelson.Untyped.Type.Type instance GHC.Classes.Eq Michelson.Untyped.Type.Type instance GHC.Generics.Generic Michelson.Untyped.Type.T instance Data.Data.Data Michelson.Untyped.Type.T instance GHC.Show.Show Michelson.Untyped.Type.T instance GHC.Classes.Eq Michelson.Untyped.Type.T instance Control.DeepSeq.NFData Michelson.Untyped.Type.ParameterType instance Michelson.Printer.Util.RenderDoc (Michelson.Printer.Util.Prettier Michelson.Untyped.Type.ParameterType) instance Michelson.Printer.Util.RenderDoc Michelson.Untyped.Type.ParameterType instance Formatting.Buildable.Buildable Michelson.Untyped.Type.ParameterType instance Control.DeepSeq.NFData Michelson.Untyped.Type.Type instance Michelson.Printer.Util.RenderDoc (Michelson.Printer.Util.Prettier Michelson.Untyped.Type.Type) instance Michelson.Printer.Util.RenderDoc Michelson.Untyped.Type.Type instance Michelson.Printer.Util.RenderDoc Michelson.Untyped.Type.T instance Formatting.Buildable.Buildable Michelson.Untyped.Type.Type instance Formatting.Buildable.Buildable Michelson.Untyped.Type.T instance Control.DeepSeq.NFData Michelson.Untyped.Type.T module Michelson.Untyped.Ext -- | Implementation-specific instructions embedded in a NOP -- primitive, which mark a specific point during a contract's -- typechecking or execution. -- -- These instructions are not allowed to modify the contract's stack, but -- may impose additional constraints that can cause a contract to report -- errors in type-checking or testing. -- -- Additionaly, some implementation-specific language features such as -- type-checking of LetMacros are implemented using this -- mechanism (specifically FN and FN_END). data ExtInstrAbstract op -- | Matches current stack against a type-pattern STACKTYPE :: StackTypePattern -> ExtInstrAbstract op -- | A typed stack function (push and pop a TcExtFrame) FN :: Text -> StackFn -> [op] -> ExtInstrAbstract op -- | Copy the current stack and run an inline assertion on it UTEST_ASSERT :: TestAssert op -> ExtInstrAbstract op -- | Print a comment with optional embedded StackRefs UPRINT :: PrintComment -> ExtInstrAbstract op -- | A comment in Michelson code UCOMMENT :: Text -> ExtInstrAbstract op -- | A reference into the stack. newtype StackRef StackRef :: Natural -> StackRef newtype PrintComment PrintComment :: [Either Text StackRef] -> PrintComment [unUPrintComment] :: PrintComment -> [Either Text StackRef] data TestAssert op TestAssert :: Text -> PrintComment -> [op] -> TestAssert op [tassName] :: TestAssert op -> Text [tassComment] :: TestAssert op -> PrintComment [tassInstrs] :: TestAssert op -> [op] newtype Var Var :: Text -> Var -- | A type-variable or a type-constant data TyVar VarID :: Var -> TyVar TyCon :: Type -> TyVar -- | A stack pattern-match data StackTypePattern StkEmpty :: StackTypePattern StkRest :: StackTypePattern StkCons :: TyVar -> StackTypePattern -> StackTypePattern -- | A stack function that expresses the type signature of a -- LetMacro data StackFn StackFn :: Maybe (Set Var) -> StackTypePattern -> StackTypePattern -> StackFn [quantifiedVars] :: StackFn -> Maybe (Set Var) [inPattern] :: StackFn -> StackTypePattern [outPattern] :: StackFn -> StackTypePattern -- | Get the set of variables in a stack pattern varSet :: StackTypePattern -> Set Var -- | Convert StackTypePattern to a list of types. Also returns -- Bool which is True if the pattern is a fixed list of -- types and False if it's a pattern match on the head of the -- stack. stackTypePatternToList :: StackTypePattern -> ([TyVar], Bool) instance Data.Aeson.Types.ToJSON.ToJSON op => Data.Aeson.Types.ToJSON.ToJSON (Michelson.Untyped.Ext.TestAssert op) instance Data.Aeson.Types.FromJSON.FromJSON op => Data.Aeson.Types.FromJSON.FromJSON (Michelson.Untyped.Ext.TestAssert op) instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Ext.TyVar instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Ext.TyVar instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Ext.Var instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Ext.Var instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Ext.StackFn instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Ext.StackFn instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Ext.StackRef instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Ext.StackRef instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Ext.StackTypePattern instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Ext.StackTypePattern instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Ext.PrintComment instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Ext.PrintComment instance Data.Aeson.Types.ToJSON.ToJSON op => Data.Aeson.Types.ToJSON.ToJSON (Michelson.Untyped.Ext.ExtInstrAbstract op) instance Data.Aeson.Types.FromJSON.FromJSON op => Data.Aeson.Types.FromJSON.FromJSON (Michelson.Untyped.Ext.ExtInstrAbstract op) instance GHC.Base.Functor Michelson.Untyped.Ext.ExtInstrAbstract instance GHC.Generics.Generic (Michelson.Untyped.Ext.ExtInstrAbstract op) instance Data.Data.Data op => Data.Data.Data (Michelson.Untyped.Ext.ExtInstrAbstract op) instance GHC.Show.Show op => GHC.Show.Show (Michelson.Untyped.Ext.ExtInstrAbstract op) instance GHC.Classes.Eq op => GHC.Classes.Eq (Michelson.Untyped.Ext.ExtInstrAbstract op) instance GHC.Generics.Generic (Michelson.Untyped.Ext.TestAssert op) instance Data.Data.Data op => Data.Data.Data (Michelson.Untyped.Ext.TestAssert op) instance GHC.Base.Functor Michelson.Untyped.Ext.TestAssert instance GHC.Show.Show op => GHC.Show.Show (Michelson.Untyped.Ext.TestAssert op) instance GHC.Classes.Eq op => GHC.Classes.Eq (Michelson.Untyped.Ext.TestAssert op) instance GHC.Generics.Generic Michelson.Untyped.Ext.PrintComment instance Data.Data.Data Michelson.Untyped.Ext.PrintComment instance GHC.Show.Show Michelson.Untyped.Ext.PrintComment instance GHC.Classes.Eq Michelson.Untyped.Ext.PrintComment instance GHC.Generics.Generic Michelson.Untyped.Ext.StackFn instance Data.Data.Data Michelson.Untyped.Ext.StackFn instance GHC.Show.Show Michelson.Untyped.Ext.StackFn instance GHC.Classes.Eq Michelson.Untyped.Ext.StackFn instance GHC.Generics.Generic Michelson.Untyped.Ext.StackTypePattern instance Data.Data.Data Michelson.Untyped.Ext.StackTypePattern instance GHC.Show.Show Michelson.Untyped.Ext.StackTypePattern instance GHC.Classes.Eq Michelson.Untyped.Ext.StackTypePattern instance GHC.Generics.Generic Michelson.Untyped.Ext.TyVar instance Data.Data.Data Michelson.Untyped.Ext.TyVar instance GHC.Show.Show Michelson.Untyped.Ext.TyVar instance GHC.Classes.Eq Michelson.Untyped.Ext.TyVar instance GHC.Generics.Generic Michelson.Untyped.Ext.Var instance Data.Data.Data Michelson.Untyped.Ext.Var instance GHC.Classes.Ord Michelson.Untyped.Ext.Var instance GHC.Show.Show Michelson.Untyped.Ext.Var instance GHC.Classes.Eq Michelson.Untyped.Ext.Var instance GHC.Generics.Generic Michelson.Untyped.Ext.StackRef instance Data.Data.Data Michelson.Untyped.Ext.StackRef instance GHC.Show.Show Michelson.Untyped.Ext.StackRef instance GHC.Classes.Eq Michelson.Untyped.Ext.StackRef instance Control.DeepSeq.NFData op => Control.DeepSeq.NFData (Michelson.Untyped.Ext.ExtInstrAbstract op) instance Michelson.Printer.Util.RenderDoc op => Michelson.Printer.Util.RenderDoc (Michelson.Untyped.Ext.ExtInstrAbstract op) instance Formatting.Buildable.Buildable op => Formatting.Buildable.Buildable (Michelson.Untyped.Ext.ExtInstrAbstract op) instance Control.DeepSeq.NFData op => Control.DeepSeq.NFData (Michelson.Untyped.Ext.TestAssert op) instance Formatting.Buildable.Buildable code => Formatting.Buildable.Buildable (Michelson.Untyped.Ext.TestAssert code) instance Control.DeepSeq.NFData Michelson.Untyped.Ext.PrintComment instance Formatting.Buildable.Buildable Michelson.Untyped.Ext.PrintComment instance Control.DeepSeq.NFData Michelson.Untyped.Ext.StackFn instance Formatting.Buildable.Buildable Michelson.Untyped.Ext.StackFn instance Control.DeepSeq.NFData Michelson.Untyped.Ext.StackTypePattern instance Formatting.Buildable.Buildable Michelson.Untyped.Ext.StackTypePattern instance Control.DeepSeq.NFData Michelson.Untyped.Ext.TyVar instance Formatting.Buildable.Buildable Michelson.Untyped.Ext.TyVar instance Control.DeepSeq.NFData Michelson.Untyped.Ext.Var instance Formatting.Buildable.Buildable Michelson.Untyped.Ext.Var instance Control.DeepSeq.NFData Michelson.Untyped.Ext.StackRef instance Formatting.Buildable.Buildable Michelson.Untyped.Ext.StackRef -- | Michelson contract in untyped model. module Michelson.Untyped.Contract type Storage = Type data Contract' op Contract :: ParameterType -> Storage -> [op] -> Contract' op [contractParameter] :: Contract' op -> ParameterType [contractStorage] :: Contract' op -> Storage [contractCode] :: Contract' op -> [op] instance Data.Aeson.Types.ToJSON.ToJSON op => Data.Aeson.Types.ToJSON.ToJSON (Michelson.Untyped.Contract.Contract' op) instance Data.Aeson.Types.FromJSON.FromJSON op => Data.Aeson.Types.FromJSON.FromJSON (Michelson.Untyped.Contract.Contract' op) instance GHC.Generics.Generic (Michelson.Untyped.Contract.Contract' op) instance Data.Data.Data op => Data.Data.Data (Michelson.Untyped.Contract.Contract' op) instance GHC.Base.Functor Michelson.Untyped.Contract.Contract' instance GHC.Show.Show op => GHC.Show.Show (Michelson.Untyped.Contract.Contract' op) instance GHC.Classes.Eq op => GHC.Classes.Eq (Michelson.Untyped.Contract.Contract' op) instance Control.DeepSeq.NFData op => Control.DeepSeq.NFData (Michelson.Untyped.Contract.Contract' op) instance Michelson.Printer.Util.RenderDoc op => Michelson.Printer.Util.RenderDoc (Michelson.Untyped.Contract.Contract' op) instance Michelson.Printer.Util.RenderDoc op => Formatting.Buildable.Buildable (Michelson.Untyped.Contract.Contract' op) -- | Module, providing T data type, representing Michelson language -- types without annotations. module Michelson.Typed.T -- | Michelson language type with annotations stripped off. data T TKey :: T TUnit :: T TSignature :: T TChainId :: T TOption :: T -> T TList :: T -> T TSet :: T -> T TOperation :: T TContract :: T -> T TPair :: T -> T -> T TOr :: T -> T -> T TLambda :: T -> T -> T TMap :: T -> T -> T TBigMap :: T -> T -> T TInt :: T TNat :: T TString :: T TBytes :: T TMutez :: T TBool :: T TKeyHash :: T TTimestamp :: T TAddress :: T -- | Converts from T to Type. toUType :: T -> Type -- | Format type stack in a pretty way. buildStack :: [T] -> Builder instance GHC.Generics.Generic Michelson.Typed.T.T instance GHC.Show.Show Michelson.Typed.T.T instance GHC.Classes.Eq Michelson.Typed.T.T instance Control.DeepSeq.NFData Michelson.Typed.T.T instance Formatting.Buildable.Buildable Michelson.Typed.T.T -- | Module, providing singleton boilerplate for T data types. -- -- Some functions from Data.Singletons are provided alternative version -- here. Some instances which are usually generated with TH are manually -- implemented as they require some specific constraints, namely -- Typeable and/or Converge, not provided in instances -- generated by TH. module Michelson.Typed.Sing -- | Instance of data family Sing for T. Custom instance is -- implemented in order to inject Typeable constraint for some of -- constructors. data SingT :: T -> Type [STKey] :: SingT 'TKey [STUnit] :: SingT 'TUnit [STSignature] :: SingT 'TSignature [STChainId] :: SingT 'TChainId [STOption] :: (SingI a, Typeable a) => Sing a -> SingT ('TOption a) [STList] :: (SingI a, Typeable a) => Sing a -> SingT ('TList a) [STSet] :: (SingI a, Typeable a) => Sing a -> SingT ('TSet a) [STOperation] :: SingT 'TOperation [STContract] :: (SingI a, Typeable a) => Sing a -> SingT ('TContract a) [STPair] :: (SingI a, SingI b, Typeable a, Typeable b) => Sing a -> Sing b -> SingT ('TPair a b) [STOr] :: (SingI a, SingI b, Typeable a, Typeable b) => Sing a -> Sing b -> SingT ('TOr a b) [STLambda] :: (SingI a, SingI b, Typeable a, Typeable b) => Sing a -> Sing b -> SingT ('TLambda a b) [STMap] :: (SingI a, SingI b, Typeable a, Typeable b) => Sing a -> Sing b -> SingT ('TMap a b) [STBigMap] :: (SingI a, SingI b, Typeable a, Typeable b) => Sing a -> Sing b -> SingT ('TBigMap a b) [STInt] :: SingT 'TInt [STNat] :: SingT 'TNat [STString] :: SingT 'TString [STBytes] :: SingT 'TBytes [STMutez] :: SingT 'TMutez [STBool] :: SingT 'TBool [STKeyHash] :: SingT 'TKeyHash [STTimestamp] :: SingT 'TTimestamp [STAddress] :: SingT 'TAddress -- | Version of withSomeSing with Typeable constraint -- provided to processing function. -- -- Required for not to erase these useful constraints when doing -- conversion from value of type T to its singleton -- representation. withSomeSingT :: T -> (forall (a :: T). (Typeable a, SingI a) => Sing a -> r) -> r -- | Version of fromSing specialized for use with data instance -- Sing :: T -> Type which requires Typeable constraint -- for some of its constructors fromSingT :: Sing (a :: T) -> T instance Data.Singletons.Internal.SingKind Michelson.Typed.T.T instance Data.Singletons.Internal.SingI 'Michelson.Typed.T.TKey instance Data.Singletons.Internal.SingI 'Michelson.Typed.T.TUnit instance Data.Singletons.Internal.SingI 'Michelson.Typed.T.TSignature instance Data.Singletons.Internal.SingI 'Michelson.Typed.T.TChainId instance (Data.Singletons.Internal.SingI a, Data.Typeable.Internal.Typeable a) => Data.Singletons.Internal.SingI ('Michelson.Typed.T.TOption a) instance (Data.Singletons.Internal.SingI a, Data.Typeable.Internal.Typeable a) => Data.Singletons.Internal.SingI ('Michelson.Typed.T.TList a) instance (Data.Singletons.Internal.SingI a, Data.Typeable.Internal.Typeable a) => Data.Singletons.Internal.SingI ('Michelson.Typed.T.TSet a) instance Data.Singletons.Internal.SingI 'Michelson.Typed.T.TOperation instance (Data.Singletons.Internal.SingI a, Data.Typeable.Internal.Typeable a) => Data.Singletons.Internal.SingI ('Michelson.Typed.T.TContract a) instance (Data.Singletons.Internal.SingI a, Data.Typeable.Internal.Typeable a, Data.Typeable.Internal.Typeable b, Data.Singletons.Internal.SingI b) => Data.Singletons.Internal.SingI ('Michelson.Typed.T.TPair a b) instance (Data.Singletons.Internal.SingI a, Data.Typeable.Internal.Typeable a, Data.Typeable.Internal.Typeable b, Data.Singletons.Internal.SingI b) => Data.Singletons.Internal.SingI ('Michelson.Typed.T.TOr a b) instance (Data.Singletons.Internal.SingI a, Data.Typeable.Internal.Typeable a, Data.Typeable.Internal.Typeable b, Data.Singletons.Internal.SingI b) => Data.Singletons.Internal.SingI ('Michelson.Typed.T.TLambda a b) instance (Data.Singletons.Internal.SingI a, Data.Typeable.Internal.Typeable a, Data.Typeable.Internal.Typeable b, Data.Singletons.Internal.SingI b) => Data.Singletons.Internal.SingI ('Michelson.Typed.T.TMap a b) instance (Data.Singletons.Internal.SingI a, Data.Typeable.Internal.Typeable a, Data.Typeable.Internal.Typeable b, Data.Singletons.Internal.SingI b) => Data.Singletons.Internal.SingI ('Michelson.Typed.T.TBigMap a b) instance Data.Singletons.Internal.SingI 'Michelson.Typed.T.TInt instance Data.Singletons.Internal.SingI 'Michelson.Typed.T.TNat instance Data.Singletons.Internal.SingI 'Michelson.Typed.T.TString instance Data.Singletons.Internal.SingI 'Michelson.Typed.T.TBytes instance Data.Singletons.Internal.SingI 'Michelson.Typed.T.TMutez instance Data.Singletons.Internal.SingI 'Michelson.Typed.T.TBool instance Data.Singletons.Internal.SingI 'Michelson.Typed.T.TKeyHash instance Data.Singletons.Internal.SingI 'Michelson.Typed.T.TTimestamp instance Data.Singletons.Internal.SingI 'Michelson.Typed.T.TAddress -- | Module, containing restrictions imposed by instruction or value scope. -- -- Michelson have multiple restrictions on values, examples: * -- operation type cannot appear in parameter. * big_map -- type cannot appear in PUSH-able constants. * -- contract type cannot appear in type we UNPACK to. -- -- Thus we declare multiple "scopes" - constraints applied in -- corresponding situations, for instance * ParameterScope; * -- StorageScope; * ConstantScope. -- -- Also we separate multiple "classes" of scope-related constraints. -- --
-- Ord a -- ins / \ cls -- v v -- Ord [a] Eq a -- cls \ / ins -- v v -- Eq [a] ---- -- This safety net ensures that pretty much anything you can write with -- this library is sensible and can't break any assumptions on the behalf -- of library authors. newtype a :- b Sub :: (a => Dict b) -> (:-) a b infixr 9 :- data BadTypeForScope BtNotComparable :: BadTypeForScope BtIsOperation :: BadTypeForScope BtHasBigMap :: BadTypeForScope BtHasNestedBigMap :: BadTypeForScope BtHasContract :: BadTypeForScope -- | Should be present for common scopes. class CheckScope (c :: Constraint) -- | Check that constraint hold for a given type. checkScope :: CheckScope c => Either BadTypeForScope (Dict c) -- | Constraint which ensures that bigmap does not appear in a given type. class (ContainsBigMap t ~ 'False) => HasNoBigMap t -- | Constraint which ensures that there are no nested bigmaps. class (ContainsNestedBigMaps t ~ 'False) => HasNoNestedBigMaps t -- | Constraint which ensures that operation type does not appear in a -- given type. -- -- Not just a type alias in order to be able to partially apply it (e.g. -- in Each). class (ContainsOp t ~ 'False) => HasNoOp t -- | Constraint which ensures that contract type does not appear in a given -- type. class (ContainsContract t ~ 'False) => HasNoContract t -- | Whether this type contains TBigMap type. type family ContainsBigMap (t :: T) :: Bool -- | Whether this type contains a type with nested TBigMaps . -- -- Nested big_maps (i.e. big_map which contains another big_map inside of -- it's value type). Are prohibited in all contexts. Some context such as -- PUSH, APPLY, PACK/UNPACK instructions are more strict because they -- doesn't work with big_map at all. type family ContainsNestedBigMaps (t :: T) :: Bool -- | This is like HasNoOp, it raises a more human-readable error -- when t type is concrete, but GHC cannot make any conclusions -- from such constraint as it can for HasNoOp. Though, hopefully, -- it will someday: #11503. -- -- Use this constraint in our eDSL. type ForbidOp t = FailOnOperationFound (ContainsOp t) type ForbidContract t = FailOnContractFound (ContainsContract t) type ForbidBigMap t = FailOnBigMapFound (ContainsBigMap t) type ForbidNestedBigMaps t = FailOnNestedBigMapsFound (ContainsNestedBigMaps t) -- | Report a human-readable error about TBigMap at a wrong place. type family FailOnBigMapFound (enabled :: Bool) :: Constraint -- | Report a human-readable error that TBigMap contains another -- TBigMap type family FailOnNestedBigMapsFound (enabled :: Bool) :: Constraint -- | Report a human-readable error about TOperation at a wrong -- place. type family FailOnOperationFound (enabled :: Bool) :: Constraint -- | Whether the type contains TOperation, with proof. data OpPresence (t :: T) OpPresent :: OpPresence (t :: T) OpAbsent :: OpPresence (t :: T) data ContractPresence (t :: T) ContractPresent :: ContractPresence (t :: T) ContractAbsent :: ContractPresence (t :: T) data BigMapPresence (t :: T) BigMapPresent :: BigMapPresence (t :: T) BigMapAbsent :: BigMapPresence (t :: T) data NestedBigMapsPresence (t :: T) NestedBigMapsPresent :: NestedBigMapsPresence (t :: T) NestedBigMapsAbsent :: NestedBigMapsPresence (t :: T) -- | Check at runtime whether the given type contains TOperation. checkOpPresence :: Sing (ty :: T) -> OpPresence ty -- | Check at runtime whether the given type contains TContract. checkContractTypePresence :: Sing (ty :: T) -> ContractPresence ty -- | Check at runtime whether the given type contains TBigMap. checkBigMapPresence :: Sing (ty :: T) -> BigMapPresence ty -- | Check at runtime whether the given type contains TBigMap. checkNestedBigMapsPresence :: Sing (ty :: T) -> NestedBigMapsPresence ty -- | Check at runtime that the given type does not contain -- TOperation. opAbsense :: Sing (t :: T) -> Maybe (Dict $ HasNoOp t) -- | Check at runtime that the given type does not contain -- TContract. contractTypeAbsense :: Sing (t :: T) -> Maybe (Dict $ HasNoContract t) -- | Check at runtime that the given type does not containt TBigMap bigMapAbsense :: Sing (t :: T) -> Maybe (Dict $ HasNoBigMap t) -- | Check at runtime that the given type does not contain nested -- TBigMap nestedBigMapsAbsense :: Sing (t :: T) -> Maybe (Dict $ HasNoNestedBigMaps t) -- | Reify HasNoOp contraint from ForbidOp. -- -- Left for backward compatibility. forbiddenOp :: forall t a. (SingI t, ForbidOp t) => (HasNoOp t => a) -> a -- | Reify HasNoContract contraint from ForbidContract. forbiddenContractType :: forall t a. (SingI t, ForbidContract t) => (HasNoContract t => a) -> a forbiddenBigMap :: forall t a. (SingI t, ForbidBigMap t) => (HasNoBigMap t => a) -> a forbiddenNestedBigMaps :: forall t a. (SingI t, ForbidNestedBigMaps t) => (HasNoNestedBigMaps t => a) -> a -- | From a Dict, takes a value in an environment where the instance -- witnessed by the Dict is in scope, and evaluates it. -- -- Essentially a deconstruction of a Dict into its -- continuation-style form. -- -- Can also be used to deconstruct an entailment, a :- b, -- using a context a. -- --
-- withDict :: Dict c -> (c => r) -> r -- withDict :: a => (a :- c) -> (c => r) -> r --withDict :: HasDict c e => e -> (c => r) -> r -- | A SingI constraint is essentially an implicitly-passed -- singleton. If you need to satisfy this constraint with an explicit -- singleton, please see withSingI or the Sing pattern -- synonym. class SingI (a :: k) -- | Produce the singleton explicitly. You will likely need the -- ScopedTypeVariables extension to use this method the way you -- want. sing :: SingI a => Sing a instance Control.DeepSeq.NFData Michelson.Typed.Scope.BadTypeForScope instance GHC.Generics.Generic Michelson.Typed.Scope.BadTypeForScope instance GHC.Classes.Eq Michelson.Typed.Scope.BadTypeForScope instance GHC.Show.Show Michelson.Typed.Scope.BadTypeForScope instance Data.Singletons.Internal.SingI t => Michelson.Typed.Scope.CheckScope (Michelson.Typed.Scope.HasNoOp t) instance Data.Singletons.Internal.SingI t => Michelson.Typed.Scope.CheckScope (Michelson.Typed.Scope.HasNoBigMap t) instance Data.Singletons.Internal.SingI t => Michelson.Typed.Scope.CheckScope (Michelson.Typed.Scope.HasNoNestedBigMaps t) instance Data.Singletons.Internal.SingI t => Michelson.Typed.Scope.CheckScope (Michelson.Typed.Scope.HasNoContract t) instance (Data.Typeable.Internal.Typeable t, Data.Singletons.Internal.SingI t) => Michelson.Typed.Scope.CheckScope (Michelson.Typed.Scope.ParameterScope t) instance (Data.Typeable.Internal.Typeable t, Data.Singletons.Internal.SingI t) => Michelson.Typed.Scope.CheckScope (Michelson.Typed.Scope.StorageScope t) instance (Data.Typeable.Internal.Typeable t, Data.Singletons.Internal.SingI t) => Michelson.Typed.Scope.CheckScope (Michelson.Typed.Scope.ConstantScope t) instance (Data.Typeable.Internal.Typeable t, Data.Singletons.Internal.SingI t) => Michelson.Typed.Scope.CheckScope (Michelson.Typed.Scope.PackedValScope t) instance (Data.Typeable.Internal.Typeable t, Data.Singletons.Internal.SingI t) => Michelson.Typed.Scope.CheckScope (Michelson.Typed.Scope.UnpackedValScope t) instance Formatting.Buildable.Buildable Michelson.Typed.Scope.BadTypeForScope instance (Michelson.Typed.Scope.ContainsNestedBigMaps t GHC.Types.~ 'GHC.Types.False) => Michelson.Typed.Scope.HasNoNestedBigMaps t instance (Michelson.Typed.Scope.ContainsBigMap t GHC.Types.~ 'GHC.Types.False) => Michelson.Typed.Scope.HasNoBigMap t instance (Michelson.Typed.Scope.ContainsContract t GHC.Types.~ 'GHC.Types.False) => Michelson.Typed.Scope.HasNoContract t instance (Michelson.Typed.Scope.ContainsOp t GHC.Types.~ 'GHC.Types.False) => Michelson.Typed.Scope.HasNoOp t module Michelson.ErrorPos mkPos :: Int -> Pos newtype Pos Pos :: Word -> Pos data SrcPos SrcPos :: Pos -> Pos -> SrcPos srcPos :: Word -> Word -> SrcPos data InstrCallStack InstrCallStack :: LetCallStack -> SrcPos -> InstrCallStack [icsCallStack] :: InstrCallStack -> LetCallStack [icsSrcPos] :: InstrCallStack -> SrcPos type LetCallStack = [LetName] newtype LetName LetName :: Text -> LetName instance Data.Aeson.Types.ToJSON.ToJSON Michelson.ErrorPos.InstrCallStack instance Data.Aeson.Types.FromJSON.FromJSON Michelson.ErrorPos.InstrCallStack instance Data.Aeson.Types.ToJSON.ToJSON Michelson.ErrorPos.LetName instance Data.Aeson.Types.FromJSON.FromJSON Michelson.ErrorPos.LetName instance Data.Aeson.Types.ToJSON.ToJSON Michelson.ErrorPos.SrcPos instance Data.Aeson.Types.FromJSON.FromJSON Michelson.ErrorPos.SrcPos instance Data.Aeson.Types.ToJSON.ToJSON Michelson.ErrorPos.Pos instance Data.Aeson.Types.FromJSON.FromJSON Michelson.ErrorPos.Pos instance Data.Data.Data Michelson.ErrorPos.InstrCallStack instance GHC.Generics.Generic Michelson.ErrorPos.InstrCallStack instance GHC.Show.Show Michelson.ErrorPos.InstrCallStack instance GHC.Classes.Ord Michelson.ErrorPos.InstrCallStack instance GHC.Classes.Eq Michelson.ErrorPos.InstrCallStack instance GHC.Generics.Generic Michelson.ErrorPos.LetName instance Data.Data.Data Michelson.ErrorPos.LetName instance GHC.Show.Show Michelson.ErrorPos.LetName instance GHC.Classes.Ord Michelson.ErrorPos.LetName instance GHC.Classes.Eq Michelson.ErrorPos.LetName instance Data.Data.Data Michelson.ErrorPos.SrcPos instance GHC.Generics.Generic Michelson.ErrorPos.SrcPos instance GHC.Show.Show Michelson.ErrorPos.SrcPos instance GHC.Classes.Ord Michelson.ErrorPos.SrcPos instance GHC.Classes.Eq Michelson.ErrorPos.SrcPos instance Data.Data.Data Michelson.ErrorPos.Pos instance GHC.Generics.Generic Michelson.ErrorPos.Pos instance GHC.Show.Show Michelson.ErrorPos.Pos instance GHC.Classes.Ord Michelson.ErrorPos.Pos instance GHC.Classes.Eq Michelson.ErrorPos.Pos instance Control.DeepSeq.NFData Michelson.ErrorPos.InstrCallStack instance Data.Default.Class.Default Michelson.ErrorPos.InstrCallStack instance Control.DeepSeq.NFData Michelson.ErrorPos.LetName instance Control.DeepSeq.NFData Michelson.ErrorPos.SrcPos instance Data.Default.Class.Default Michelson.ErrorPos.SrcPos instance Control.DeepSeq.NFData Michelson.ErrorPos.Pos instance Data.Default.Class.Default Michelson.ErrorPos.Pos -- | Utilities related to Alternative. module Util.Alternative -- | This function is the same as some except that it returns -- NonEmpty, because some is guaranteed to return non-empty -- list, but it's not captured in types. someNE :: Alternative f => f a -> f (NonEmpty a) module Util.ByteString -- | Newtype wrapper for ByteString which uses hexadecimal representation -- for JSON serialization. newtype HexJSONByteString HexJSONByteString :: ByteString -> HexJSONByteString [unHexJSONByteString] :: HexJSONByteString -> ByteString instance Data.Aeson.Types.ToJSON.ToJSON Util.ByteString.HexJSONByteString instance Data.Aeson.Types.FromJSON.FromJSON Util.ByteString.HexJSONByteString module Util.Default permute2Def :: (Default a, Default b, Monad f, Alternative f) => f a -> f b -> f (a, b) permute3Def :: (Default a, Default b, Default c, Monad f, Alternative f) => f a -> f b -> f c -> f (a, b, c) -- | A class for types with a default value. class Default a -- | The default value for this type. def :: Default a => a module Util.Exception data TextException TextException :: Text -> TextException -- | Customise default uncaught exception handling. The problem with the -- default handler is that it uses show to display uncaught -- exceptions, but displayException may provide more reasonable -- output. We do not modify uncaught exception handler, but simply wrap -- uncaught exceptions (only synchronous ones) into -- DisplayExceptionInShow. -- -- Some exceptions (currently we are aware only of ExitCode) are -- handled specially by default exception handler, so we don't wrap them. displayUncaughtException :: IO () -> IO () instance GHC.Show.Show Util.Exception.DisplayExceptionInShow instance GHC.Exception.Type.Exception Util.Exception.DisplayExceptionInShow instance GHC.Exception.Type.Exception Util.Exception.TextException instance Formatting.Buildable.Buildable Util.Exception.TextException instance GHC.Show.Show Util.Exception.TextException module Util.Fcf data Over2 :: (a -> b -> Exp r) -> (x -> Exp a) -> (x -> Exp b) -> x -> Exp r data (<|>) :: f a -> f a -> Exp (f a) -- | Similar to TyEq, but compares types via DefaultEq used -- in singletons comparisons (see Data.Singletons.Prelude.Eq -- module). data TyEqSing :: a -> b -> Exp Bool data ApplyConstraints :: [a -> Constraint] -> a -> Exp Constraint -- | Expression evaluator. type family Eval (e :: Exp a) :: a -- | Generic-related utils. module Util.Generic -- | Rebuild a list into a binary tree of exactly the same form which -- Generic uses to represent datatypes. -- -- Along with the original list you have to provide constructor for -- intermediate nodes - it accepts zero-based index of the leftmost -- element of the right tree and merged trees themselves. mkGenericTree :: (Natural -> a -> a -> a) -> NonEmpty a -> a mkGenericTreeVec :: HasCallStack => (a -> b) -> (Natural -> b -> b -> b) -> Vector a -> b -- | Extract datatype name via its Generic representation. -- -- For polymorphic types this throws away all type arguments. type GenericTypeName a = GTypeName (Rep a) module Util.IO readFileUtf8 :: FilePath -> IO Text writeFileUtf8 :: Print text => FilePath -> text -> IO () appendFileUtf8 :: Print text => FilePath -> text -> IO () withEncoding :: Handle -> TextEncoding -> IO () -> IO () -- | Change the character encoding of the given Handle to transliterate on -- unsupported characters instead of throwing an exception. hSetTranslit :: Handle -> IO () -- | Missing instances from libraries. module Util.Instances instance Data.Default.Class.Default GHC.Natural.Natural instance Formatting.Buildable.Buildable GHC.Natural.Natural instance Formatting.Buildable.Buildable a => Formatting.Buildable.Buildable (Data.Functor.Identity.Identity a) module Util.Lens -- | For datatype with "myNyan" field it will create "myNyanL" lens. postfixLFields :: LensRules -- | Build lenses with a custom configuration. makeLensesWith :: LensRules -> Name -> DecsQ -- | A small Markdown eDSL. module Util.Markdown -- | A piece of markdown document. -- -- This is opposed to Text type, which in turn is not supposed to -- contain markup elements. type Markdown = Builder -- | Level of header, starting from 1. newtype HeaderLevel HeaderLevel :: Int -> HeaderLevel -- | Anchor with given text. newtype Anchor Anchor :: Text -> Anchor [unAnchor] :: Anchor -> Text -- | Picking anchor for various things. class ToAnchor anchor toAnchor :: ToAnchor anchor => anchor -> Anchor nextHeaderLevel :: HeaderLevel -> HeaderLevel mdHeader :: HeaderLevel -> Markdown -> Markdown mdSubsection :: Markdown -> Markdown -> Markdown mdSubsectionTitle :: Markdown -> Markdown mdBold :: Markdown -> Markdown mdItalic :: Markdown -> Markdown mdTicked :: Markdown -> Markdown mdRef :: Markdown -> Markdown -> Markdown mdLocalRef :: ToAnchor anchor => Markdown -> anchor -> Markdown mdAnchor :: ToAnchor anchor => anchor -> Markdown mdSeparator :: Markdown -- | Text which is hidden until clicked. mdSpoiler :: Markdown -> Markdown -> Markdown mdComment :: Builder -> Builder -- | Quasi quoter for Markdown. -- -- This supports interpolation via #{expression} syntax. md :: QuasiQuoter instance Util.Markdown.ToAnchor Util.Markdown.Anchor instance Util.Markdown.ToAnchor Data.Text.Internal.Text instance Data.String.IsString Util.Markdown.Anchor -- | Type-nat utilities. -- -- We take Peano numbers as base for operations because they make it much -- easer to prove things to compiler. Their performance does not seem to -- introduce a problem, because we use nats primarily along with stack -- which is a linked list with similar performance characteristics. -- -- Many of things we introduce here are covered in type-natural -- package, but unfortunatelly it does not work with GHC 8.6 at the -- moment of writing this module. We use Vinyl as source of Peano -- Nat for now. module Util.Peano -- | A convenient alias. -- -- We are going to use Peano numbers for type-dependent logic and -- normal Nats in user API, need to distinguish them somehow. type Peano = Nat -- | A mere approximation of the natural numbers. And their image as lifted -- by -XDataKinds corresponds to the actual natural numbers. data Nat Z :: Nat S :: !Nat -> Nat type family ToPeano (n :: Nat) :: Peano type family FromPeano (n :: Peano) :: Nat class KnownPeano (n :: Peano) peanoVal :: KnownPeano n => proxy n -> Natural data SingNat (n :: Nat) [SZ] :: SingNat 'Z [SS] :: (SingI n, KnownPeano n) => SingNat n -> SingNat ('S n) peanoVal' :: forall n. KnownPeano n => Natural -- | Get runtime value from singleton. peanoValSing :: forall n. KnownPeano n => Sing n -> Natural type family Length l :: Peano type family At (n :: Peano) s type family Drop (n :: Peano) (s :: [k]) :: [k] type family Take (n :: Peano) (s :: [k]) :: [k] -- | Comparison of type-level naturals, as a function. -- -- It is as lazy on the list argument as possible - there is no need to -- know the whole list if the natural argument is small enough. This -- property is important if we want to be able to extract reusable parts -- of code which are aware only of relevant part of stack. type family IsLongerThan (l :: [k]) (a :: Peano) :: Bool -- | Comparison of type-level naturals, as a constraint. type LongerThan l a = IsLongerThan l a ~ 'True class (RequireLongerThan' l a, LongerThan l a) => RequireLongerThan (l :: [k]) (a :: Peano) -- | Similar to IsLongerThan, but returns True when list -- length equals to the passed number. type family IsLongerOrSameLength (l :: [k]) (a :: Peano) :: Bool -- | IsLongerOrSameLength in form of constraint that gives most -- information to GHC. type LongerOrSameLength l a = IsLongerOrSameLength l a ~ 'True -- | We can have `RequireLongerOrSameLength = (RequireLongerOrSameLength' l -- a, LongerOrSameLength l a)`, but apparently the printed error message -- can be caused by LongerOrSameLength rather than -- RequireLongerOrSameLength`. We do not know for sure how it all -- works, but we think that if we require constraint X before Y (using -- multiple `=>`s) then X will always be evaluated first. class (RequireLongerOrSameLength' l a, LongerOrSameLength l a) => RequireLongerOrSameLength (l :: [k]) (a :: Peano) requireLongerThan :: Rec any stk -> Sing n -> Maybe (Dict (RequireLongerThan stk n)) requireLongerOrSameLength :: Rec any stk -> Sing n -> Maybe (Dict (RequireLongerOrSameLength stk n)) instance GHC.Show.Show (Util.Peano.SingNat n) instance GHC.Classes.Eq (Util.Peano.SingNat n) instance forall k (l :: [k]) (a :: Util.Peano.Peano). (Util.Peano.RequireLongerOrSameLength' l a, Util.Peano.LongerOrSameLength l a) => Util.Peano.RequireLongerOrSameLength l a instance forall k (l :: [k]) (a :: Data.Vinyl.TypeLevel.Nat). (Util.Peano.RequireLongerThan' l a, Util.Peano.LongerThan l a) => Util.Peano.RequireLongerThan l a instance Control.DeepSeq.NFData (Util.Peano.SingNat n) instance Data.Singletons.Internal.SingI 'Data.Vinyl.TypeLevel.Z instance (Data.Singletons.Internal.SingI n, Util.Peano.KnownPeano n) => Data.Singletons.Internal.SingI ('Data.Vinyl.TypeLevel.S n) instance Util.Peano.KnownPeano 'Data.Vinyl.TypeLevel.Z instance Util.Peano.KnownPeano a => Util.Peano.KnownPeano ('Data.Vinyl.TypeLevel.S a) -- | Definition of Positive type and related utilities. module Util.Positive -- | Integer values starting from 1. -- -- We define our own datatype in order to have Data instance for -- it, which can not be derived for third-party types without exported -- constructor. newtype Positive PositiveUnsafe :: Natural -> Positive [unPositive] :: Positive -> Natural mkPositive :: (Integral i, Buildable i) => i -> Either Text Positive -- | Count length of non-empty list. lengthNE :: NonEmpty a -> Positive -- | Produce a non empty list consisting of the given value. replicateNE :: Positive -> a -> NonEmpty a instance Data.Aeson.Types.FromJSON.FromJSON Util.Positive.Positive instance Data.Aeson.Types.ToJSON.ToJSON Util.Positive.Positive instance Formatting.Buildable.Buildable Util.Positive.Positive instance GHC.Show.Show Util.Positive.Positive instance GHC.Generics.Generic Util.Positive.Positive instance Data.Data.Data Util.Positive.Positive instance GHC.Classes.Ord Util.Positive.Positive instance GHC.Classes.Eq Util.Positive.Positive instance Control.DeepSeq.NFData Util.Positive.Positive module Util.TH -- | Generates an NFData instance for a GADT. Note: This will not -- generate additional constraints to the generated instance if those are -- required. deriveGADTNFData :: Name -> Q [Dec] -- | Ingridients that we use in our test suite. module Util.Test.Ingredients -- | This is the default set of ingredients extended with the -- antXMLRunner which is used to generate xml reports for CI. ourIngredients :: [Ingredient] module Util.Text -- | Leads first character of text to lower case. -- -- For empty text this will throw an error. headToLower :: HasCallStack => Text -> Text surround :: Semigroup a => a -> a -> a -> a -- | General type utilities. module Util.Type -- | A type family to compute Boolean equality. type family (a :: k) == (b :: k) :: Bool infix 4 == -- | Type-level If. If True a b ==> a; If -- False a b ==> b type family If (cond :: Bool) (tru :: k) (fls :: k) :: k -- | Append for type-level lists. type family (as :: [k]) ++ (bs :: [k]) :: [k] type family IsElem (a :: k) (l :: [k]) :: Bool -- | Remove all occurences of the given element. type family (l :: [k]) / (a :: k) -- | Difference between two lists. type family (l1 :: [k]) // (l2 :: [k]) :: [k] type family Guard (cond :: Bool) (a :: k) :: Maybe k -- | Fail with given error if the condition holds. type FailWhen cond msg = FailUnless (Not cond) msg -- | Fail with given error if the condition does not hold. type family FailUnless (cond :: Bool) (msg :: ErrorMessage) :: Constraint -- | A natural conclusion from the fact that error have not occured. failUnlessEvi :: forall cond msg. FailUnless cond msg :- (cond ~ 'True) failWhenEvi :: forall cond msg. FailWhen cond msg :- (cond ~ 'False) type family AllUnique (l :: [k]) :: Bool type RequireAllUnique desc l = RequireAllUnique' desc l l -- | Bring type-level list at term-level using given function to demote its -- individual elements. class ReifyList (c :: k -> Constraint) (l :: [k]) reifyList :: ReifyList c l => (forall a. c a => Proxy a -> r) -> [r] -- | Make sure given type is evaluated. This type family fits only for -- types of Type kind. type family PatternMatch (a :: Type) :: Constraint type family PatternMatchL (l :: [k]) :: Constraint -- | Similar to SingI [], but does not require individual elements -- to be also instance of SingI. class KnownList l klist :: KnownList l => KList l -- | SList analogy for KnownList. data KList (l :: [k]) [KNil] :: KList '[] [KCons] :: KnownList xs => Proxy x -> Proxy xs -> KList (x : xs) type RSplit l r = KnownList l -- | Split a record into two pieces. rsplit :: forall k (l :: [k]) (r :: [k]) f. RSplit l r => Rec f (l ++ r) -> (Rec f l, Rec f r) -- | A value of type parametrized with some type parameter. data Some1 (f :: k -> Type) Some1 :: f a -> Some1 (f :: k -> Type) recordToSomeList :: Rec f l -> [Some1 f] -- | Reify type equality from boolean equality. reifyTypeEquality :: forall a b x. (a == b) ~ 'True => (a ~ b => x) -> x type ConcatListOfTypesAssociativity a b c = ((a ++ b) ++ c) ~ (a ++ (b ++ c)) -- | GHC can't deduce this itself because in general a type family might be -- not associative, what brings extra difficulties and redundant -- constraints, especially if you have complex types. But (++) type -- family is associative, so let's define this small hack. listOfTypesConcatAssociativityAxiom :: forall a b c. Dict (ConcatListOfTypesAssociativity a b c) instance forall k (f :: k -> *). (forall (a :: k). GHC.Show.Show (f a)) => GHC.Show.Show (Util.Type.Some1 f) instance Util.Type.KnownList '[] instance forall k (xs :: [k]) (x :: k). Util.Type.KnownList xs => Util.Type.KnownList (x : xs) instance forall k (c :: k -> GHC.Types.Constraint). Util.Type.ReifyList c '[] instance forall a (c :: a -> GHC.Types.Constraint) (x :: a) (xs :: [a]). (c x, Util.Type.ReifyList c xs) => Util.Type.ReifyList c (x : xs) -- | Re-exports TypeLits, modifying it considering our practices. module Util.TypeLits -- | (Kind) This is the kind of type-level symbols. Declared here because -- class IP needs it data Symbol -- | This class gives the string associated with a type-level symbol. There -- are instances of the class for every concrete literal: "hello", etc. class KnownSymbol (n :: Symbol) -- | Concatenation of type-level symbols. type family AppendSymbol (a :: Symbol) (b :: Symbol) :: Symbol symbolVal :: forall (n :: Symbol) proxy. KnownSymbol n => proxy n -> String symbolValT :: forall s. KnownSymbol s => Proxy s -> Text symbolValT' :: forall s. KnownSymbol s => Text -- | The type-level equivalent of error. -- -- The polymorphic kind of this type allows it to be used in several -- settings. For instance, it can be used as a constraint, e.g. to -- provide a better error message for a non-existent instance, -- --
-- -- in a context -- instance TypeError (Text "Cannot Show functions." :$$: -- Text "Perhaps there is a missing argument?") -- => Show (a -> b) where -- showsPrec = error "unreachable" ---- -- It can also be placed on the right-hand side of a type-level function -- to provide an error for an invalid case, -- --
-- type family ByteSize x where -- ByteSize Word16 = 2 -- ByteSize Word8 = 1 -- ByteSize a = TypeError (Text "The type " :<>: ShowType a :<>: -- Text " is not exportable.") --type family TypeError (a :: ErrorMessage) :: b -- | A description of a custom type error. data ErrorMessage -- | Show the text as is. Text :: Symbol -> ErrorMessage -- | Pretty print the type. ShowType :: k -> ErrorMessage ShowType :: t -> ErrorMessage -- | Put two pieces of error message next to each other. (:<>:) :: ErrorMessage -> ErrorMessage -> ErrorMessage -- | Stack two pieces of error message on top of each other. (:$$:) :: ErrorMessage -> ErrorMessage -> ErrorMessage infixl 6 :<>: infixl 5 :$$: -- | Conditional type error. -- -- Note that TypeErrorUnless cond err is the same as If cond -- () (TypeError err), but does not produce type-level error when -- one of its arguments cannot be deduced. type family TypeErrorUnless (cond :: Bool) (err :: ErrorMessage) :: Constraint -- | Reify the fact that condition under TypeErrorUnless constraint -- can be assumed to always hold. inTypeErrorUnless :: forall cond err a. TypeErrorUnless cond err => (cond ~ 'True => a) -> a -- | Definition of the Label type and utilities module Util.Label -- | Proxy for a label type that includes the KnownSymbol constraint data Label (name :: Symbol) [Label] :: KnownSymbol name => Label name -- | Utility function to get the Text representation of a -- Label labelToText :: Label name -> Text class IsLabel (x :: Symbol) a fromLabel :: IsLabel x a => a instance GHC.Classes.Eq (Util.Label.Label name) instance GHC.Show.Show (Util.Label.Label name) instance (GHC.TypeLits.KnownSymbol name, s GHC.Types.~ name) => GHC.OverloadedLabels.IsLabel s (Util.Label.Label name) instance Formatting.Buildable.Buildable (Util.Label.Label name) -- | Additional functionality for named package. module Util.Named -- | Infix notation for the type of a named parameter. type (name :: Symbol) :! a = NamedF Identity a name -- | Infix notation for the type of an optional named parameter. type (name :: Symbol) :? a = NamedF Maybe a name (.!) :: Name name -> a -> NamedF Identity a name (.?) :: Name name -> Maybe a -> NamedF Maybe a name (<.!>) :: Functor m => Name name -> m a -> m (NamedF Identity a name) (<.?>) :: Functor m => Name name -> m (Maybe a) -> m (NamedF Maybe a name) type family ApplyNamedFunctor (f :: Type -> Type) (a :: Type) type family NamedInner (n :: Type) class KnownNamedFunctor f -- | Isomorphism between named entity and the entity itself. namedL :: KnownNamedFunctor f => Label name -> Iso' (NamedF f a name) (ApplyNamedFunctor f a) instance GHC.Classes.Eq (f a) => GHC.Classes.Eq (Named.Internal.NamedF f a name) instance GHC.Classes.Ord (f a) => GHC.Classes.Ord (Named.Internal.NamedF f a name) instance (Data.Typeable.Internal.Typeable f, Data.Typeable.Internal.Typeable a, GHC.TypeLits.KnownSymbol name, Data.Data.Data (f a)) => Data.Data.Data (Named.Internal.NamedF f a name) instance Data.Aeson.Types.ToJSON.ToJSON a => Data.Aeson.Types.ToJSON.ToJSON (Named.Internal.NamedF Data.Functor.Identity.Identity a name) instance Data.Aeson.Types.ToJSON.ToJSON a => Data.Aeson.Types.ToJSON.ToJSON (Named.Internal.NamedF GHC.Maybe.Maybe a name) instance Data.Aeson.Types.FromJSON.FromJSON a => Data.Aeson.Types.FromJSON.FromJSON (Named.Internal.NamedF Data.Functor.Identity.Identity a name) instance Data.Aeson.Types.FromJSON.FromJSON a => Data.Aeson.Types.FromJSON.FromJSON (Named.Internal.NamedF GHC.Maybe.Maybe a name) instance Util.Named.KnownNamedFunctor Data.Functor.Identity.Identity instance Util.Named.KnownNamedFunctor GHC.Maybe.Maybe instance Control.Lens.Wrapped.Wrapped (Named.Internal.NamedF Data.Functor.Identity.Identity a name) instance Control.Lens.Wrapped.Wrapped (Named.Internal.NamedF GHC.Maybe.Maybe a name) instance (GHC.Show.Show a, GHC.TypeLits.KnownSymbol name) => GHC.Show.Show (Named.Internal.NamedF Data.Functor.Identity.Identity a name) instance (GHC.TypeLits.KnownSymbol name, Formatting.Buildable.Buildable (f a)) => Formatting.Buildable.Buildable (Named.Internal.NamedF f a name) -- | Utilities for command line options parsing (we use -- optparse-applicative). -- -- Some names exported from this module are quite general when if you do -- not assume optparse-applicative usage, so consider using -- explicit imports for it. module Util.CLI -- | Maybe add the default value and make sure it will be shown in help -- message. maybeAddDefault :: HasValue f => (a -> String) -> Maybe a -> Mod f a -- | Parser for path to a file where output will be writen. outputOption :: Parser (Maybe FilePath) -- | Supporting typeclass for namedParser. It specifies how a value -- should be parsed from command line. Even though the main purpose of -- this class is to implement helpers below, feel free to use it for -- other goals. class HasCLReader a getReader :: HasCLReader a => ReadM a -- | This string will be passed to the metavar function, hence we -- use String type rather Text (even though we use -- Text almost everywhere). getMetavar :: HasCLReader a => String -- | Create a Parser for a value using HasCLReader instance -- (hence CL in the name). It uses reader and metavar from that -- class, the rest should be supplied as arguments. -- -- We expect some common modifiers to be always provided, a list of extra -- modifies can be provided as well. mkCLOptionParser :: forall a. (Buildable a, HasCLReader a) => Maybe a -> ("name" :! String) -> ("help" :! String) -> Parser a -- | A more general version of mkCLOptionParser which takes a list -- of extra (not as widely used) modifiers. mkCLOptionParserExt :: forall a. (Buildable a, HasCLReader a) => Maybe a -> ("name" :! String) -> ("help" :! String) -> [Mod OptionFields a] -> Parser a -- | Akin to mkCLOptionParser, but for arguments rather than -- options. mkCLArgumentParser :: forall a. (Buildable a, HasCLReader a) => Maybe a -> ("help" :! String) -> Parser a -- | Akin to mkCLOptionParserExt, but for arguments rather than -- options. mkCLArgumentParserExt :: forall a. (Buildable a, HasCLReader a) => Maybe a -> ("help" :! String) -> [Mod ArgumentFields a] -> Parser a -- | Create a Parser for a value using its type-level name. namedParser :: forall (a :: Type) (name :: Symbol). (Buildable a, HasCLReader a, KnownSymbol name) => Maybe a -> String -> Parser (name :! a) -- | Convert a function producing an Either into a reader. -- -- As an example, one can create a ReadM from an attoparsec Parser easily -- with -- --
-- import qualified Data.Attoparsec.Text as A -- import qualified Data.Text as T -- attoparsecReader :: A.Parser a -> ReadM a -- attoparsecReader p = eitherReader (A.parseOnly p . T.pack) --eitherReader :: (String -> Either String a) -> ReadM a -- | Abort option reader by exiting with an error message. readerError :: String -> ReadM a instance Util.CLI.HasCLReader GHC.Natural.Natural instance Util.CLI.HasCLReader GHC.Word.Word64 instance Util.CLI.HasCLReader GHC.Integer.Type.Integer instance Util.CLI.HasCLReader GHC.Types.Int instance Util.CLI.HasCLReader Data.Text.Internal.Text module Michelson.Untyped.EntryPoints -- | Entrypoint name. -- -- Empty if this entrypoint is default one. Cannot be equal to "default", -- the reference implementation forbids that. Also, set of allowed -- characters should be the same as in annotations. newtype EpName EpNameUnsafe :: Text -> EpName [unEpName] :: EpName -> Text pattern DefEpName :: EpName -- | Make up EpName from annotation in parameter type declaration. -- -- Returns Nothing if no entrypoint is assigned here. epNameFromParamAnn :: FieldAnn -> Maybe EpName -- | Turn entrypoint name into annotation for contract parameter -- declaration. epNameToParamAnn :: EpName -> FieldAnn -- | Make up EpName from annotation which is reference to an -- entrypoint (e.g. annotation in CONTRACT instruction). -- -- Fails if annotation is invalid. epNameFromRefAnn :: FieldAnn -> Either EpNameFromRefAnnError EpName -- | Turn entrypoint name into annotation used as reference to entrypoint. epNameToRefAnn :: EpName -> FieldAnn data EpNameFromRefAnnError InEpNameBadAnnotation :: FieldAnn -> EpNameFromRefAnnError -- | Given an untyped type, extract a map that maps entrypoint names to the -- their parameter types. If there are duplicate entrypoints in the given -- Type then the duplicate entrypoints at a deeper nesting level will get -- overwritten with the ones that are on top. mkEntrypointsMap :: Type -> Map EpName Type instance GHC.Generics.Generic Michelson.Untyped.EntryPoints.EpNameFromRefAnnError instance GHC.Classes.Eq Michelson.Untyped.EntryPoints.EpNameFromRefAnnError instance GHC.Show.Show Michelson.Untyped.EntryPoints.EpNameFromRefAnnError instance GHC.Generics.Generic Michelson.Untyped.EntryPoints.EpName instance GHC.Classes.Ord Michelson.Untyped.EntryPoints.EpName instance GHC.Classes.Eq Michelson.Untyped.EntryPoints.EpName instance GHC.Show.Show Michelson.Untyped.EntryPoints.EpName instance Control.DeepSeq.NFData Michelson.Untyped.EntryPoints.EpNameFromRefAnnError instance Formatting.Buildable.Buildable Michelson.Untyped.EntryPoints.EpNameFromRefAnnError instance Control.DeepSeq.NFData Michelson.Untyped.EntryPoints.EpName instance Formatting.Buildable.Buildable Michelson.Untyped.EntryPoints.EpName instance Data.Default.Class.Default Michelson.Untyped.EntryPoints.EpName instance Test.QuickCheck.Arbitrary.Arbitrary Michelson.Untyped.Annotation.FieldAnn => Test.QuickCheck.Arbitrary.Arbitrary Michelson.Untyped.EntryPoints.EpName instance Util.CLI.HasCLReader Michelson.Untyped.EntryPoints.EpName -- | Custom exceptions that can happen during parsing. module Michelson.Parser.Error data CustomParserException UnknownTypeException :: CustomParserException StringLiteralException :: StringLiteralParserException -> CustomParserException OddNumberBytesException :: CustomParserException WrongTagArgs :: Natural -> Positive -> CustomParserException WrongAccessArgs :: Natural -> Positive -> CustomParserException WrongSetArgs :: Natural -> Positive -> CustomParserException ExcessFieldAnnotation :: CustomParserException data StringLiteralParserException InvalidEscapeSequence :: Char -> StringLiteralParserException InvalidChar :: Char -> StringLiteralParserException -- | A non-empty collection of ParseErrors equipped with -- PosState that allows to pretty-print the errors efficiently and -- correctly. data ParseErrorBundle s e data ParserException ParserException :: ParseErrorBundle Text CustomParserException -> ParserException instance GHC.Classes.Eq Michelson.Parser.Error.ParserException instance GHC.Generics.Generic Michelson.Parser.Error.CustomParserException instance GHC.Show.Show Michelson.Parser.Error.CustomParserException instance GHC.Classes.Ord Michelson.Parser.Error.CustomParserException instance Data.Data.Data Michelson.Parser.Error.CustomParserException instance GHC.Classes.Eq Michelson.Parser.Error.CustomParserException instance GHC.Generics.Generic Michelson.Parser.Error.StringLiteralParserException instance GHC.Show.Show Michelson.Parser.Error.StringLiteralParserException instance GHC.Classes.Ord Michelson.Parser.Error.StringLiteralParserException instance Data.Data.Data Michelson.Parser.Error.StringLiteralParserException instance GHC.Classes.Eq Michelson.Parser.Error.StringLiteralParserException instance GHC.Show.Show Michelson.Parser.Error.ParserException instance GHC.Exception.Type.Exception Michelson.Parser.Error.ParserException instance Formatting.Buildable.Buildable Michelson.Parser.Error.ParserException instance Control.DeepSeq.NFData Michelson.Parser.Error.CustomParserException instance Text.Megaparsec.Error.ShowErrorComponent Michelson.Parser.Error.CustomParserException instance Control.DeepSeq.NFData Michelson.Parser.Error.StringLiteralParserException instance Text.Megaparsec.Error.ShowErrorComponent Michelson.Parser.Error.StringLiteralParserException -- | Strings compliant with Michelson constraints. -- -- When writting a Michelson contract, you can only mention characters -- with codes from [32 .. 126] range in string literals. Same -- restriction applies to string literals passed to alphanet.sh. -- -- However, Michelson allows some control sequences: "n". You -- have to write it exactly in this form, and internally it will be -- transformed to line feed character (this behaviour can be observed -- when looking at Packed data). -- -- See tests for examples of good and bad strings. module Michelson.Text -- | Michelson string value. -- -- This is basically a mere text with limits imposed by the language: -- https://tezos.gitlab.io/whitedoc/michelson.html#constants -- Although, this document seems to be not fully correct, and thus we -- applied constraints deduced empirically. -- -- You construct an item of this type using one of the following ways: -- --
-- >>> [mt|Some text|]
-- MTextUnsafe { unMText = "Some text" }
--
--
-- -- >>> formatTimestamp [timestampQuote| 2019-02-21T16:54:12.2344523Z |] -- "2019-02-21T16:54:12Z" ---- -- Inspired by 'time-quote' library. timestampQuote :: QuasiQuoter -- | Return current time as Timestamp. getCurrentTime :: IO Timestamp -- | Timestamp which is always greater than result of -- getCurrentTime. farFuture :: Timestamp -- | Timestamp which is always less than result of getCurrentTime. farPast :: Timestamp -- | Identifier of a network (babylonnet, mainnet, test network or other). -- Evaluated as hash of the genesis block. -- -- The only operation supported for this type is packing. Use case: -- multisig contract, for instance, now includes chain ID into signed -- data "in order to add extra replay protection between the main chain -- and the test chain". newtype ChainId ChainIdUnsafe :: ByteString -> ChainId [unChainId] :: ChainId -> ByteString -- | Construct chain ID from raw bytes. mkChainId :: ByteString -> Maybe ChainId -- | Construct chain ID from raw bytes or fail otherwise. Expects exactly 4 -- bytes. mkChainIdUnsafe :: HasCallStack => ByteString -> ChainId -- | Identifier of a pseudo network. dummyChainId :: ChainId -- | Pretty print ChainId as it is displayed e.g. in -- ./babylonnet.sh head call. -- -- Example of produced value: NetXUdfLh6Gm88t. formatChainId :: ChainId -> Text mformatChainId :: ChainId -> MText parseChainId :: Text -> Either ParseChainIdError ChainId chainIdLength :: Int instance Data.Aeson.Types.ToJSON.ToJSON Tezos.Core.Timestamp instance Data.Aeson.Types.FromJSON.FromJSON Tezos.Core.Timestamp instance Data.Aeson.Types.ToJSON.ToJSON Tezos.Core.ChainId instance Data.Aeson.Types.FromJSON.FromJSON Tezos.Core.ChainId instance Data.Aeson.Types.ToJSON.ToJSON Tezos.Core.Mutez instance Data.Aeson.Types.FromJSON.FromJSON Tezos.Core.Mutez instance GHC.Classes.Eq Tezos.Core.ParseChainIdError instance GHC.Show.Show Tezos.Core.ParseChainIdError instance GHC.Generics.Generic Tezos.Core.ChainId instance GHC.Classes.Eq Tezos.Core.ChainId instance GHC.Show.Show Tezos.Core.ChainId instance GHC.Generics.Generic Tezos.Core.Timestamp instance Data.Data.Data Tezos.Core.Timestamp instance GHC.Classes.Ord Tezos.Core.Timestamp instance GHC.Classes.Eq Tezos.Core.Timestamp instance GHC.Show.Show Tezos.Core.Timestamp instance Formatting.Buildable.Buildable Tezos.Core.Mutez instance GHC.Enum.Enum Tezos.Core.Mutez instance GHC.Generics.Generic Tezos.Core.Mutez instance Data.Data.Data Tezos.Core.Mutez instance GHC.Classes.Ord Tezos.Core.Mutez instance GHC.Classes.Eq Tezos.Core.Mutez instance GHC.Show.Show Tezos.Core.Mutez instance Formatting.Buildable.Buildable Tezos.Core.ParseChainIdError instance Control.DeepSeq.NFData Tezos.Core.ChainId instance Formatting.Buildable.Buildable Tezos.Core.ChainId instance Test.QuickCheck.Arbitrary.Arbitrary Tezos.Core.ChainId instance Control.DeepSeq.NFData Tezos.Core.Timestamp instance Formatting.Buildable.Buildable Tezos.Core.Timestamp instance GHC.Enum.Bounded Tezos.Core.Mutez instance Util.CLI.HasCLReader Tezos.Core.Mutez instance Control.DeepSeq.NFData Tezos.Core.Mutez -- | Address in Tezos. module Tezos.Address -- | Hash of origination command for some contract. newtype ContractHash ContractHash :: ByteString -> ContractHash -- | Data type corresponding to address structure in Tezos. data Address -- | tz address which is a hash of a public key. KeyAddress :: KeyHash -> Address -- | KT address which corresponds to a callable contract. ContractAddress :: ContractHash -> Address -- | Smart constructor for KeyAddress. mkKeyAddress :: PublicKey -> Address -- | Deterministically generate a random KeyAddress and discard its -- secret key. detGenKeyAddress :: ByteString -> Address -- | Smart constructor for ContractAddress. Its argument is -- serialized origination operation. -- -- Note: it's quite unsafe to pass ByteString, because we can pass -- some garbage which is not a serialized origination operation, but this -- operation includes contract itself and necessary types are defined in -- *. So we have to serialize this data outside this module and -- pass it here as a ByteString. Alternatively we could add some -- constraint, but it would be almost as unsafe as passing a -- ByteString. For this reason we add Raw suffix to this -- function and provide a safer function in Instr. We may -- reconsider it later. mkContractAddressRaw :: ByteString -> Address -- | Create a dummy ContractHash value. mkContractHashRaw :: ByteString -> ContractHash -- | Errors that can happen during address parsing. data ParseAddressError -- | Address is not in Base58Check format. ParseAddressWrongBase58Check :: ParseAddressError -- | Both address parsers failed with some error. ParseAddressBothFailed :: CryptoParseError -> ParseContractAddressError -> ParseAddressError data ParseContractAddressError formatAddress :: Address -> Text mformatAddress :: Address -> MText -- | Parse an address from its human-readable textual representation used -- by Tezos (e. g. "tz1faswCTDciRzE4oJ9jn2Vm2dvjeyA9fUzU"). Or fail if -- it's invalid. parseAddress :: Text -> Either ParseAddressError Address -- | Partial version of parseAddress which assumes that the address -- is correct. Can be used in tests. unsafeParseAddress :: HasCallStack => Text -> Address -- | Parse a TK contract address, fail if address does not match -- the expected format. unsafeParseContractHash :: HasCallStack => Text -> ContractHash instance GHC.Generics.Generic Tezos.Address.ParseAddressError instance GHC.Classes.Eq Tezos.Address.ParseAddressError instance GHC.Show.Show Tezos.Address.ParseAddressError instance GHC.Generics.Generic Tezos.Address.ParseContractAddressError instance GHC.Classes.Eq Tezos.Address.ParseContractAddressError instance GHC.Show.Show Tezos.Address.ParseContractAddressError instance GHC.Generics.Generic Tezos.Address.Address instance GHC.Classes.Ord Tezos.Address.Address instance GHC.Classes.Eq Tezos.Address.Address instance GHC.Show.Show Tezos.Address.Address instance GHC.Generics.Generic Tezos.Address.ContractHash instance GHC.Classes.Ord Tezos.Address.ContractHash instance GHC.Classes.Eq Tezos.Address.ContractHash instance GHC.Show.Show Tezos.Address.ContractHash instance Control.DeepSeq.NFData Tezos.Address.ParseAddressError instance Formatting.Buildable.Buildable Tezos.Address.ParseAddressError instance Control.DeepSeq.NFData Tezos.Address.ParseContractAddressError instance Formatting.Buildable.Buildable Tezos.Address.ParseContractAddressError instance Control.DeepSeq.NFData Tezos.Address.Address instance Formatting.Buildable.Buildable Tezos.Address.Address instance Util.CLI.HasCLReader Tezos.Address.Address instance Data.Aeson.Types.ToJSON.ToJSON Tezos.Address.Address instance Data.Aeson.Types.ToJSON.ToJSONKey Tezos.Address.Address instance Data.Aeson.Types.FromJSON.FromJSON Tezos.Address.Address instance Data.Aeson.Types.FromJSON.FromJSONKey Tezos.Address.Address instance Test.QuickCheck.Arbitrary.Arbitrary Tezos.Address.Address instance Control.DeepSeq.NFData Tezos.Address.ContractHash instance Data.Aeson.Types.ToJSON.ToJSON Tezos.Address.ContractHash instance Data.Aeson.Types.ToJSON.ToJSONKey Tezos.Address.ContractHash instance Data.Aeson.Types.FromJSON.FromJSON Tezos.Address.ContractHash instance Data.Aeson.Types.FromJSON.FromJSONKey Tezos.Address.ContractHash -- | Untyped Michelson values (i. e. type of a value is not statically -- known). module Michelson.Untyped.Value data Value' op ValueInt :: Integer -> Value' op ValueString :: MText -> Value' op ValueBytes :: InternalByteString -> Value' op ValueUnit :: Value' op ValueTrue :: Value' op ValueFalse :: Value' op ValuePair :: Value' op -> Value' op -> Value' op ValueLeft :: Value' op -> Value' op ValueRight :: Value' op -> Value' op ValueSome :: Value' op -> Value' op ValueNone :: Value' op ValueNil :: Value' op -- | A sequence of elements: can be a list or a set. We can't distinguish -- lists and sets during parsing. ValueSeq :: (NonEmpty $ Value' op) -> Value' op ValueMap :: (NonEmpty $ Elt op) -> Value' op ValueLambda :: NonEmpty op -> Value' op data Elt op Elt :: Value' op -> Value' op -> Elt op -- | ByteString does not have an instance for ToJSON and FromJSON, to avoid -- orphan type class instances, make a new type wrapper around it. newtype InternalByteString InternalByteString :: ByteString -> InternalByteString unInternalByteString :: InternalByteString -> ByteString instance Data.Aeson.Types.ToJSON.ToJSON op => Data.Aeson.Types.ToJSON.ToJSON (Michelson.Untyped.Value.Elt op) instance Data.Aeson.Types.FromJSON.FromJSON op => Data.Aeson.Types.FromJSON.FromJSON (Michelson.Untyped.Value.Elt op) instance Data.Aeson.Types.ToJSON.ToJSON op => Data.Aeson.Types.ToJSON.ToJSON (Michelson.Untyped.Value.Value' op) instance Data.Aeson.Types.FromJSON.FromJSON op => Data.Aeson.Types.FromJSON.FromJSON (Michelson.Untyped.Value.Value' op) instance GHC.Generics.Generic (Michelson.Untyped.Value.Elt op) instance Data.Data.Data op => Data.Data.Data (Michelson.Untyped.Value.Elt op) instance GHC.Base.Functor Michelson.Untyped.Value.Elt instance GHC.Show.Show op => GHC.Show.Show (Michelson.Untyped.Value.Elt op) instance GHC.Classes.Eq op => GHC.Classes.Eq (Michelson.Untyped.Value.Elt op) instance GHC.Generics.Generic (Michelson.Untyped.Value.Value' op) instance Data.Data.Data op => Data.Data.Data (Michelson.Untyped.Value.Value' op) instance GHC.Base.Functor Michelson.Untyped.Value.Value' instance GHC.Show.Show op => GHC.Show.Show (Michelson.Untyped.Value.Value' op) instance GHC.Classes.Eq op => GHC.Classes.Eq (Michelson.Untyped.Value.Value' op) instance GHC.Generics.Generic Michelson.Untyped.Value.InternalByteString instance GHC.Show.Show Michelson.Untyped.Value.InternalByteString instance GHC.Classes.Eq Michelson.Untyped.Value.InternalByteString instance Data.Data.Data Michelson.Untyped.Value.InternalByteString instance Control.DeepSeq.NFData op => Control.DeepSeq.NFData (Michelson.Untyped.Value.Value' op) instance Control.DeepSeq.NFData op => Control.DeepSeq.NFData (Michelson.Untyped.Value.Elt op) instance Michelson.Printer.Util.RenderDoc op => Michelson.Printer.Util.RenderDoc (Michelson.Untyped.Value.Value' op) instance Michelson.Printer.Util.RenderDoc op => Michelson.Printer.Util.RenderDoc (Michelson.Untyped.Value.Elt op) instance Michelson.Printer.Util.RenderDoc op => Formatting.Buildable.Buildable (Michelson.Untyped.Value.Value' op) instance Michelson.Printer.Util.RenderDoc op => Formatting.Buildable.Buildable (Michelson.Untyped.Value.Elt op) instance Control.DeepSeq.NFData Michelson.Untyped.Value.InternalByteString instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Value.InternalByteString instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Value.InternalByteString -- | Michelson instructions in untyped model. module Michelson.Untyped.Instr -- | Michelson instruction with abstract parameter op. This -- parameter is necessary, because at different stages of our pipeline it -- will be different. Initially it can contain macros and non-flattened -- instructions, but then it contains only vanilla Michelson -- instructions. data InstrAbstract op EXT :: ExtInstrAbstract op -> InstrAbstract op -- | "DROP n" instruction. Note: reference implementation permits int16 -- here. Negative numbers are parsed successfully there, but rejected -- later. Morley is more permissive, so we use Word here, i. e. -- permit more positive numbers. We do not permit negative numbers at -- type level. In practice, probably nobody will ever have numbers -- greater than ≈1000 here, at least due to gas limits. Same reasoning -- applies to other instructions which have a numeric parameter -- representing number of elements on stack. DROPN :: Word -> InstrAbstract op -- | DROP is essentially as special case for DROPN, but we -- need both because they are packed differently. DROP :: InstrAbstract op DUP :: VarAnn -> InstrAbstract op SWAP :: InstrAbstract op DIG :: Word -> InstrAbstract op DUG :: Word -> InstrAbstract op PUSH :: VarAnn -> Type -> Value' op -> InstrAbstract op SOME :: TypeAnn -> VarAnn -> InstrAbstract op NONE :: TypeAnn -> VarAnn -> Type -> InstrAbstract op UNIT :: TypeAnn -> VarAnn -> InstrAbstract op IF_NONE :: [op] -> [op] -> InstrAbstract op PAIR :: TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op CAR :: VarAnn -> FieldAnn -> InstrAbstract op CDR :: VarAnn -> FieldAnn -> InstrAbstract op LEFT :: TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> Type -> InstrAbstract op RIGHT :: TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> Type -> InstrAbstract op IF_LEFT :: [op] -> [op] -> InstrAbstract op NIL :: TypeAnn -> VarAnn -> Type -> InstrAbstract op CONS :: VarAnn -> InstrAbstract op IF_CONS :: [op] -> [op] -> InstrAbstract op SIZE :: VarAnn -> InstrAbstract op EMPTY_SET :: TypeAnn -> VarAnn -> Type -> InstrAbstract op EMPTY_MAP :: TypeAnn -> VarAnn -> Type -> Type -> InstrAbstract op EMPTY_BIG_MAP :: TypeAnn -> VarAnn -> Type -> Type -> InstrAbstract op MAP :: VarAnn -> [op] -> InstrAbstract op ITER :: [op] -> InstrAbstract op MEM :: VarAnn -> InstrAbstract op GET :: VarAnn -> InstrAbstract op UPDATE :: VarAnn -> InstrAbstract op IF :: [op] -> [op] -> InstrAbstract op LOOP :: [op] -> InstrAbstract op LOOP_LEFT :: [op] -> InstrAbstract op LAMBDA :: VarAnn -> Type -> Type -> [op] -> InstrAbstract op EXEC :: VarAnn -> InstrAbstract op APPLY :: VarAnn -> InstrAbstract op DIP :: [op] -> InstrAbstract op DIPN :: Word -> [op] -> InstrAbstract op FAILWITH :: InstrAbstract op CAST :: VarAnn -> Type -> InstrAbstract op RENAME :: VarAnn -> InstrAbstract op PACK :: VarAnn -> InstrAbstract op UNPACK :: TypeAnn -> VarAnn -> Type -> InstrAbstract op CONCAT :: VarAnn -> InstrAbstract op SLICE :: VarAnn -> InstrAbstract op ISNAT :: VarAnn -> InstrAbstract op ADD :: VarAnn -> InstrAbstract op SUB :: VarAnn -> InstrAbstract op MUL :: VarAnn -> InstrAbstract op EDIV :: VarAnn -> InstrAbstract op ABS :: VarAnn -> InstrAbstract op NEG :: VarAnn -> InstrAbstract op LSL :: VarAnn -> InstrAbstract op LSR :: VarAnn -> InstrAbstract op OR :: VarAnn -> InstrAbstract op AND :: VarAnn -> InstrAbstract op XOR :: VarAnn -> InstrAbstract op NOT :: VarAnn -> InstrAbstract op COMPARE :: VarAnn -> InstrAbstract op EQ :: VarAnn -> InstrAbstract op NEQ :: VarAnn -> InstrAbstract op LT :: VarAnn -> InstrAbstract op GT :: VarAnn -> InstrAbstract op LE :: VarAnn -> InstrAbstract op GE :: VarAnn -> InstrAbstract op INT :: VarAnn -> InstrAbstract op SELF :: VarAnn -> FieldAnn -> InstrAbstract op CONTRACT :: VarAnn -> FieldAnn -> Type -> InstrAbstract op TRANSFER_TOKENS :: VarAnn -> InstrAbstract op SET_DELEGATE :: VarAnn -> InstrAbstract op CREATE_CONTRACT :: VarAnn -> VarAnn -> Contract' op -> InstrAbstract op IMPLICIT_ACCOUNT :: VarAnn -> InstrAbstract op NOW :: VarAnn -> InstrAbstract op AMOUNT :: VarAnn -> InstrAbstract op BALANCE :: VarAnn -> InstrAbstract op CHECK_SIGNATURE :: VarAnn -> InstrAbstract op SHA256 :: VarAnn -> InstrAbstract op SHA512 :: VarAnn -> InstrAbstract op BLAKE2B :: VarAnn -> InstrAbstract op HASH_KEY :: VarAnn -> InstrAbstract op SOURCE :: VarAnn -> InstrAbstract op SENDER :: VarAnn -> InstrAbstract op ADDRESS :: VarAnn -> InstrAbstract op CHAIN_ID :: VarAnn -> InstrAbstract op data ExpandedOp PrimEx :: ExpandedInstr -> ExpandedOp SeqEx :: [ExpandedOp] -> ExpandedOp WithSrcEx :: InstrCallStack -> ExpandedOp -> ExpandedOp type ExpandedInstr = InstrAbstract ExpandedOp -- | Flatten all SeqEx in ExpandedOp. This function is mostly -- for testing. It returns instructions with the same logic, but they are -- not strictly equivalent, because they are serialized differently -- (grouping instructions into sequences affects the way they are -- PACK'ed). flattenExpandedOp :: ExpandedOp -> [ExpandedInstr] -- | Data necessary to originate a contract. data OriginationOperation OriginationOperation :: Address -> Maybe KeyHash -> Mutez -> Value' ExpandedOp -> Contract' ExpandedOp -> OriginationOperation -- | Originator of the contract. [ooOriginator] :: OriginationOperation -> Address -- | Optional delegate. [ooDelegate] :: OriginationOperation -> Maybe KeyHash -- | Initial balance of the contract. [ooBalance] :: OriginationOperation -> Mutez -- | Initial storage value of the contract. [ooStorage] :: OriginationOperation -> Value' ExpandedOp -- | The contract itself. [ooContract] :: OriginationOperation -> Contract' ExpandedOp -- | Compute address of a contract from its origination operation. -- -- TODO [TM-62] It's certainly imprecise, real Tezos implementation -- doesn't use JSON, but we don't need precise format yet, so we just use -- some serialization format (JSON because we have necessary instances -- already). mkContractAddress :: OriginationOperation -> Address instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Instr.OriginationOperation instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Instr.OriginationOperation instance Data.Aeson.Types.ToJSON.ToJSON op => Data.Aeson.Types.ToJSON.ToJSON (Michelson.Untyped.Instr.InstrAbstract op) instance Data.Aeson.Types.FromJSON.FromJSON op => Data.Aeson.Types.FromJSON.FromJSON (Michelson.Untyped.Instr.InstrAbstract op) instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Instr.ExpandedOp instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Instr.ExpandedOp instance GHC.Generics.Generic Michelson.Untyped.Instr.OriginationOperation instance GHC.Show.Show Michelson.Untyped.Instr.OriginationOperation instance GHC.Generics.Generic Michelson.Untyped.Instr.ExpandedOp instance Data.Data.Data Michelson.Untyped.Instr.ExpandedOp instance GHC.Classes.Eq Michelson.Untyped.Instr.ExpandedOp instance GHC.Show.Show Michelson.Untyped.Instr.ExpandedOp instance GHC.Generics.Generic (Michelson.Untyped.Instr.InstrAbstract op) instance Data.Data.Data op => Data.Data.Data (Michelson.Untyped.Instr.InstrAbstract op) instance GHC.Base.Functor Michelson.Untyped.Instr.InstrAbstract instance GHC.Classes.Eq op => GHC.Classes.Eq (Michelson.Untyped.Instr.InstrAbstract op) instance Control.DeepSeq.NFData Michelson.Untyped.Instr.ExpandedOp instance Michelson.Printer.Util.RenderDoc Michelson.Untyped.Instr.ExpandedOp instance Formatting.Buildable.Buildable Michelson.Untyped.Instr.ExpandedOp instance Michelson.Printer.Util.RenderDoc (Michelson.Untyped.Instr.InstrAbstract op) => GHC.Show.Show (Michelson.Untyped.Instr.InstrAbstract op) instance Control.DeepSeq.NFData op => Control.DeepSeq.NFData (Michelson.Untyped.Instr.InstrAbstract op) instance Michelson.Printer.Util.RenderDoc op => Michelson.Printer.Util.RenderDoc (Michelson.Untyped.Instr.InstrAbstract op) instance (Michelson.Printer.Util.RenderDoc op, Formatting.Buildable.Buildable op) => Formatting.Buildable.Buildable (Michelson.Untyped.Instr.InstrAbstract op) -- | Some simple aliases for Michelson types. module Michelson.Untyped.Aliases type Contract = Contract' ExpandedOp type Value = Value' ExpandedOp type ExpandedExtInstr = ExtInstrAbstract ExpandedOp module Michelson.Untyped -- | TxData type and associated functionality. module Michelson.Runtime.TxData -- | Data associated with a particular transaction. data TxData TxData :: Address -> Value -> EpName -> Mutez -> TxData [tdSenderAddress] :: TxData -> Address [tdParameter] :: TxData -> Value [tdEntrypoint] :: TxData -> EpName [tdAmount] :: TxData -> Mutez tdSenderAddressL :: Lens' TxData Address tdParameterL :: Lens' TxData Value tdEntrypointL :: Lens' TxData EpName tdAmountL :: Lens' TxData Mutez instance GHC.Classes.Eq Michelson.Runtime.TxData.TxData instance GHC.Show.Show Michelson.Runtime.TxData.TxData module Util.TypeTuple.Class -- | Building a record from tuple. -- -- It differs from similar typeclass in FromTuple module in that -- it allows type inference outside-in - knowing desired Rec you -- know which tuple should be provided - this improves error messages -- when constructing concrete Rec objects. class RecFromTuple r where { type family IsoRecTuple r :: Type; } recFromTuple :: RecFromTuple r => IsoRecTuple r -> r -- | Template haskell generator for RecFromTuple, in a separate -- module because of staging restrictions. module Util.TypeTuple.TH -- | Produce RecFromTuple instance for tuple of the given length. deriveRecFromTuple :: Word -> Q [Dec] module Util.TypeTuple.Instances instance forall u (f :: u -> *). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[]) instance forall u (f :: u -> *) (x :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u) (x11 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u) (x11 :: u) (x12 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u) (x11 :: u) (x12 :: u) (x13 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u) (x11 :: u) (x12 :: u) (x13 :: u) (x14 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u) (x11 :: u) (x12 :: u) (x13 :: u) (x14 :: u) (x15 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u) (x11 :: u) (x12 :: u) (x13 :: u) (x14 :: u) (x15 :: u) (x16 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u) (x11 :: u) (x12 :: u) (x13 :: u) (x14 :: u) (x15 :: u) (x16 :: u) (x17 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u) (x11 :: u) (x12 :: u) (x13 :: u) (x14 :: u) (x15 :: u) (x16 :: u) (x17 :: u) (x18 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u) (x11 :: u) (x12 :: u) (x13 :: u) (x14 :: u) (x15 :: u) (x16 :: u) (x17 :: u) (x18 :: u) (x19 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u) (x11 :: u) (x12 :: u) (x13 :: u) (x14 :: u) (x15 :: u) (x16 :: u) (x17 :: u) (x18 :: u) (x19 :: u) (x20 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u) (x11 :: u) (x12 :: u) (x13 :: u) (x14 :: u) (x15 :: u) (x16 :: u) (x17 :: u) (x18 :: u) (x19 :: u) (x20 :: u) (x21 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u) (x11 :: u) (x12 :: u) (x13 :: u) (x14 :: u) (x15 :: u) (x16 :: u) (x17 :: u) (x18 :: u) (x19 :: u) (x20 :: u) (x21 :: u) (x22 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u) (x11 :: u) (x12 :: u) (x13 :: u) (x14 :: u) (x15 :: u) (x16 :: u) (x17 :: u) (x18 :: u) (x19 :: u) (x20 :: u) (x21 :: u) (x22 :: u) (x23 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u) (x11 :: u) (x12 :: u) (x13 :: u) (x14 :: u) (x15 :: u) (x16 :: u) (x17 :: u) (x18 :: u) (x19 :: u) (x20 :: u) (x21 :: u) (x22 :: u) (x23 :: u) (x24 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u) (x11 :: u) (x12 :: u) (x13 :: u) (x14 :: u) (x15 :: u) (x16 :: u) (x17 :: u) (x18 :: u) (x19 :: u) (x20 :: u) (x21 :: u) (x22 :: u) (x23 :: u) (x24 :: u) (x25 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25]) -- | Conversions between tuples and list-like types. module Util.TypeTuple -- | Building a record from tuple. -- -- It differs from similar typeclass in FromTuple module in that -- it allows type inference outside-in - knowing desired Rec you -- know which tuple should be provided - this improves error messages -- when constructing concrete Rec objects. class RecFromTuple r where { type family IsoRecTuple r :: Type; } recFromTuple :: RecFromTuple r => IsoRecTuple r -> r -- | Utility for Typeable. module Util.Typeable -- | Like gcast, casts some container's elements, producing -- informative error on mismatch. gcastE :: forall a b t. (Typeable a, Typeable b) => t a -> Either Text (t b) -- | Proxy version of eqT. eqP :: (Typeable a, Typeable b) => Proxy a -> Proxy b -> Maybe (a :~: b) -- | Suppose you have a data type X with parameter a and -- you have two values: `x1 :: X a1` and `x2 :: X a2`. You can't compare -- them using ==, because they have different types. However, you -- can compare them using eqParam1 as long as both parameters are -- Typeable. eqParam1 :: forall a1 a2 t. (Typeable a1, Typeable a2, Eq (t a1)) => t a1 -> t a2 -> Bool -- | Version of eqParam1 for types with 2 parameters. eqParam2 :: forall a1 a2 b1 b2 t. (Typeable a1, Typeable a2, Typeable b1, Typeable b2, Eq (t a1 b2)) => t a1 b1 -> t a2 b2 -> Bool -- | Version of eqParam1 for types with 3 parameters. eqParam3 :: forall a1 a2 b1 b2 c1 c2 t. (Typeable a1, Typeable a2, Typeable b1, Typeable b2, Typeable c1, Typeable c2, Eq (t a1 b1 c1)) => t a1 b1 c1 -> t a2 b2 c2 -> Bool -- | Compare two entries of completely different types. eqExt :: forall a1 a2. (Typeable a1, Typeable a2, Eq a1) => a1 -> a2 -> Bool -- | Extension of eqExt to compare function. compareExt :: forall a1 a2. (Typeable a1, Typeable a2, Ord a1) => a1 -> a2 -> Ordering -- | Cast to a type with phantom type argument without matching this -- argument. The phantom type must be the last type argument of the type. -- -- Example of use: imagine a type -- --
-- data MyType a = MyType ---- -- Normally, if object of this type was hidden under existential -- quantification with Typeable constraint, then in order to get -- it back with cast you need to know the exact type of the -- hidden object, including its phantom type parameter. With -- castIgnoringPhantom you get a way to extract this object no -- matter which phantom argument it had. castIgnoringPhantom :: forall c x. (Typeable x, Typeable c, forall phantom1 phantom2. Coercible (c phantom1) (c phantom2)) => x -> Maybe (c DummyPhantomType) -- | Match given type against another type of * -> * kind -- without caring about its type argument. eqTypeIgnoringPhantom :: forall c x r. (Typeable x, Typeable c) => (forall a. Typeable a => (c a :~: x) -> Proxy a -> r) -> Maybe r -- | Propositional equality. If a :~: b is inhabited by some -- terminating value, then the type a is the same as the type -- b. To use this equality in practice, pattern-match on the -- a :~: b to get out the Refl constructor; in the body -- of the pattern-match, the compiler knows that a ~ b. data (a :: k) :~: (b :: k) [Refl] :: forall k (a :: k). a :~: a infix 4 :~: -- | Extract a witness of equality of two types eqT :: forall k (a :: k) (b :: k). (Typeable a, Typeable b) => Maybe (a :~: b) -- | Module, providing Notes t data type, which holds annotations -- for a given type t. -- -- Annotation type Notes t is a tree, each leaf is either a star -- (*) or a constructor holding some annotation data for a given -- type t. Star corresponds to the case when given Michelson -- type contains no annotations. -- -- This module also provides type class Converge along with some -- utility functions which are used to combine two annotations trees -- a and b into a new one c in such a way that -- c can be obtained from both a and b by -- replacing some * leafs with type or/and field annotations. module Michelson.Typed.Annotation -- | Data type, holding annotation data for a given Michelson type -- t. -- -- Each constructor corresponds to exactly one constructor of T -- and holds all type and field annotations that can be attributed to a -- Michelson type corrspoding to t. data Notes t [NTKey] :: TypeAnn -> Notes 'TKey [NTUnit] :: TypeAnn -> Notes 'TUnit [NTSignature] :: TypeAnn -> Notes 'TSignature [NTChainId] :: TypeAnn -> Notes 'TChainId [NTOption] :: TypeAnn -> Notes t -> Notes ('TOption t) [NTList] :: TypeAnn -> Notes t -> Notes ('TList t) [NTSet] :: TypeAnn -> TypeAnn -> Notes ('TSet ct) [NTOperation] :: TypeAnn -> Notes 'TOperation [NTContract] :: TypeAnn -> Notes t -> Notes ('TContract t) [NTPair] :: TypeAnn -> FieldAnn -> FieldAnn -> Notes p -> Notes q -> Notes ('TPair p q) [NTOr] :: TypeAnn -> FieldAnn -> FieldAnn -> Notes p -> Notes q -> Notes ('TOr p q) [NTLambda] :: TypeAnn -> Notes p -> Notes q -> Notes ('TLambda p q) [NTMap] :: TypeAnn -> TypeAnn -> Notes v -> Notes ('TMap k v) [NTBigMap] :: TypeAnn -> TypeAnn -> Notes v -> Notes ('TBigMap k v) [NTInt] :: TypeAnn -> Notes 'TInt [NTNat] :: TypeAnn -> Notes 'TNat [NTString] :: TypeAnn -> Notes 'TString [NTBytes] :: TypeAnn -> Notes 'TBytes [NTMutez] :: TypeAnn -> Notes 'TMutez [NTBool] :: TypeAnn -> Notes 'TBool [NTKeyHash] :: TypeAnn -> Notes 'TKeyHash [NTTimestamp] :: TypeAnn -> Notes 'TTimestamp [NTAddress] :: TypeAnn -> Notes 'TAddress data AnnConvergeError [AnnConvergeError] :: forall (tag :: Type). (Buildable (Annotation tag), Show (Annotation tag), Typeable tag) => Annotation tag -> Annotation tag -> AnnConvergeError -- | Combines two annotations trees a and b into a new -- one c in such a way that c can be obtained from both -- a and b by replacing some empty leaves with type -- or/and field annotations. converge :: Notes t -> Notes t -> Either AnnConvergeError (Notes t) -- | Converge two type or field notes (which may be wildcards). convergeAnns :: forall (tag :: Type). (Buildable (Annotation tag), Show (Annotation tag), Typeable tag) => Annotation tag -> Annotation tag -> Either AnnConvergeError (Annotation tag) -- | Insert the provided type annotation into the provided notes. insertTypeAnn :: forall (b :: T). TypeAnn -> Notes b -> Notes b orAnn :: Annotation t -> Annotation t -> Annotation t -- | Checks if no annotations are present. isStar :: SingI t => Notes t -> Bool -- | In memory of NStar constructor. Generates notes with no -- annotations. starNotes :: forall t. SingI t => Notes t -- | Forget information about annotations, pick singleton with the same -- type. -- -- Note: currently we cannot derive Sing from Notes without -- SingI because for comparable types notes do not remember which -- exact comparable was used. notesSing :: SingI t => Notes t -> Sing t -- | Get term-level type of notes. notesT :: SingI t => Notes t -> T instance Control.DeepSeq.NFData Michelson.Typed.Annotation.AnnConvergeError instance GHC.Show.Show Michelson.Typed.Annotation.AnnConvergeError instance GHC.Classes.Eq Michelson.Typed.Annotation.AnnConvergeError instance Formatting.Buildable.Buildable Michelson.Typed.Annotation.AnnConvergeError instance Control.DeepSeq.NFData (Michelson.Typed.Annotation.Notes t) instance GHC.Show.Show (Michelson.Typed.Annotation.Notes t) instance Formatting.Buildable.Buildable (Michelson.Typed.Annotation.Notes t) instance Michelson.Printer.Util.RenderDoc (Michelson.Typed.Annotation.Notes t) instance GHC.Classes.Eq (Michelson.Typed.Annotation.Notes t) -- | Module, containing functions to convert -- Michelson.Untyped.Type to Michelson.Typed.T.T -- Michelson type representation (type stripped off all annotations) and -- to Michelson.Typed.Annotation.Notes value (which contains -- field and type annotations for a given Michelson type). -- -- I.e. Michelson.Untyped.Type is split to value t :: T -- and value of type Notes t for which t is a type -- representation of value t. module Michelson.Typed.Extract fromUType :: Type -> T mkUType :: SingI x => Notes x -> Type -- | Converts from T to Type. toUType :: T -> Type -- | Convert Type to the isomorphic set of information from typed -- world. withUType :: Type -> (forall t. (Typeable t, SingI t) => Notes t -> r) -> r -- | Transparently represent untyped Type as wrapper over -- Notes t from typed world with SingI t constraint. -- -- As expression this carries logic of mkUType, and as pattern it -- performs withUType but may make code a bit cleaner. -- -- Note about constraints: pattern signatures usually require two -- constraints - one they require and another one which they provide. In -- our case we require nothing (thus first constraint is ()) and -- provide some knowledge about t. pattern AsUType :: () => (Typeable t, SingI t) => Notes t -> Type -- | Similar to AsUType, but also gives Sing for given type. pattern AsUTypeExt :: () => (Typeable t, SingI t) => Sing t -> Notes t -> Type -- | Utilities for lightweight entrypoints support. module Michelson.Typed.EntryPoints -- | Address with optional entrypoint name attached to it. TODO: come up -- with better name? data EpAddress EpAddress :: Address -> EpName -> EpAddress -- | Address itself [eaAddress] :: EpAddress -> Address -- | Entrypoint name (might be empty) [eaEntryPoint] :: EpAddress -> EpName data ParseEpAddressError ParseEpAddressBadAddress :: ParseAddressError -> ParseEpAddressError ParseEpAddressBadRefAnn :: Text -> ParseEpAddressError ParseEpAddressRefAnnError :: EpNameFromRefAnnError -> ParseEpAddressError formatEpAddress :: EpAddress -> Text mformatEpAddress :: EpAddress -> MText -- | Parse an address which can be suffixed with entrypoint name (e.g. -- "tz1faswCTDciRzE4oJ9jn2Vm2dvjeyA9fUzU%entrypoint"). parseEpAddress :: Text -> Either ParseEpAddressError EpAddress unsafeParseEpAddress :: HasCallStack => Text -> EpAddress -- | Annotations for contract parameter declaration. -- -- Following the Michelson specification, this type has the following -- invariants: 1. No entrypoint name is duplicated. 2. If -- default entrypoint is explicitly assigned, no "arm" remains -- uncallable. data ParamNotes (t :: T) ParamNotesUnsafe :: Notes t -> RootAnn -> ParamNotes (t :: T) [pnNotes] :: ParamNotes (t :: T) -> Notes t [pnRootAnn] :: ParamNotes (t :: T) -> RootAnn pattern ParamNotes :: Notes t -> RootAnn -> ParamNotes t -- | Parameter without annotations. starParamNotes :: SingI t => ParamNotes t data ArmCoord AcLeft :: ArmCoord AcRight :: ArmCoord -- | Coordinates of "arm" in Or tree, used solely in error messages. type ArmCoords = [ArmCoord] -- | Errors specific to parameter type declaration (entrypoints). data ParamEpError ParamEpDuplicatedNames :: NonEmpty EpName -> ParamEpError ParamEpUncallableArm :: ArmCoords -> ParamEpError -- | Construct ParamNotes performing all necessary checks. mkParamNotes :: Notes t -> RootAnn -> Either ParamEpError (ParamNotes t) -- | Describes how to construct full contract parameter from given -- entrypoint argument. -- -- This could be just wrapper over Value arg -> Value param, -- but we cannot use Value type in this module easily. data EpLiftSequence (arg :: T) (param :: T) [EplArgHere] :: EpLiftSequence arg arg [EplWrapLeft] :: EpLiftSequence arg subparam -> EpLiftSequence arg ('TOr subparam r) [EplWrapRight] :: EpLiftSequence arg subparam -> EpLiftSequence arg ('TOr l subparam) -- | Reference for calling a specific entrypoint of type arg. data EntryPointCallT (param :: T) (arg :: T) EntryPointCall :: EpName -> Proxy param -> EpLiftSequence arg param -> EntryPointCallT (param :: T) (arg :: T) -- | Name of entrypoint. [epcName] :: EntryPointCallT (param :: T) (arg :: T) -> EpName -- | Proxy of parameter, to make parameter type more easily fetchable. [epcParamProxy] :: EntryPointCallT (param :: T) (arg :: T) -> Proxy param -- | How to call this entrypoint in the corresponding contract. [epcLiftSequence] :: EntryPointCallT (param :: T) (arg :: T) -> EpLiftSequence arg param -- | Call parameter which has no entrypoints, always safe. epcPrimitive :: forall p. (ParameterScope p, ForbidOr p) => EntryPointCallT p p -- | Construct EntryPointCallT which calls no entrypoint and assumes -- that there is no explicit "default" one. -- -- Validity of such operation is not ensured. epcCallRootUnsafe :: ParameterScope param => EntryPointCallT param param -- | EntryPointCallT with hidden parameter type. -- -- This requires argument to satisfy ParameterScope constraint. -- Strictly speaking, entrypoint argument may one day start having -- different set of constraints comparing to ones applied to parameter, -- but this seems unlikely. data SomeEntryPointCallT (arg :: T) SomeEpc :: EntryPointCallT param arg -> SomeEntryPointCallT (arg :: T) -- | Construct SomeEntryPointCallT which calls no entrypoint and -- assumes that there is no explicit "default" one. -- -- Validity of such operation is not ensured. sepcCallRootUnsafe :: ParameterScope param => SomeEntryPointCallT param -- | Call parameter which has no entrypoints, always safe. sepcPrimitive :: forall t. (ParameterScope t, ForbidOr t) => SomeEntryPointCallT t sepcName :: SomeEntryPointCallT arg -> EpName type family ForbidOr (t :: T) :: Constraint data MkEntryPointCallRes param [MkEntryPointCallRes] :: ParameterScope arg => Notes arg -> EntryPointCallT param arg -> MkEntryPointCallRes param -- | Build EntryPointCallT. -- -- Here we accept entrypoint name and type information for the parameter -- of target contract. -- -- Returns Nothing if entrypoint is not found. mkEntryPointCall :: ParameterScope param => EpName -> ParamNotes param -> Maybe (MkEntryPointCallRes param) -- | Parameter type of implicit account. tyImplicitAccountParam :: ParamNotes 'TUnit -- | Flatten a provided list of notes to a map of its entrypoints and its -- corresponding utype. Please refer to mkEntrypointsMap in -- regards to how duplicate entrypoints are handled. flattenEntryPoints :: SingI t => ParamNotes t -> Map EpName Type -- | Entrypoint name. -- -- Empty if this entrypoint is default one. Cannot be equal to "default", -- the reference implementation forbids that. Also, set of allowed -- characters should be the same as in annotations. newtype EpName EpNameUnsafe :: Text -> EpName [unEpName] :: EpName -> Text pattern DefEpName :: EpName -- | Make up EpName from annotation in parameter type declaration. -- -- Returns Nothing if no entrypoint is assigned here. epNameFromParamAnn :: FieldAnn -> Maybe EpName -- | Turn entrypoint name into annotation for contract parameter -- declaration. epNameToParamAnn :: EpName -> FieldAnn -- | Make up EpName from annotation which is reference to an -- entrypoint (e.g. annotation in CONTRACT instruction). -- -- Fails if annotation is invalid. epNameFromRefAnn :: FieldAnn -> Either EpNameFromRefAnnError EpName -- | Turn entrypoint name into annotation used as reference to entrypoint. epNameToRefAnn :: EpName -> FieldAnn data EpNameFromRefAnnError InEpNameBadAnnotation :: FieldAnn -> EpNameFromRefAnnError instance GHC.Classes.Eq (Michelson.Typed.EntryPoints.EntryPointCallT param arg) instance GHC.Show.Show (Michelson.Typed.EntryPoints.EntryPointCallT param arg) instance GHC.Show.Show (Michelson.Typed.EntryPoints.SomeEntryPointCallT arg) instance GHC.Classes.Eq (Michelson.Typed.EntryPoints.SomeEntryPointCallT arg) instance Control.DeepSeq.NFData (Michelson.Typed.EntryPoints.SomeEntryPointCallT arg) instance Formatting.Buildable.Buildable (Michelson.Typed.EntryPoints.SomeEntryPointCallT arg) instance Control.DeepSeq.NFData (Michelson.Typed.EntryPoints.EntryPointCallT param arg) instance Formatting.Buildable.Buildable (Michelson.Typed.EntryPoints.EntryPointCallT param arg) instance Control.DeepSeq.NFData (Michelson.Typed.EntryPoints.EpLiftSequence param arg) instance Formatting.Buildable.Buildable (Michelson.Typed.EntryPoints.EpLiftSequence arg param) instance GHC.Generics.Generic Michelson.Typed.EntryPoints.ParamEpError instance GHC.Classes.Eq Michelson.Typed.EntryPoints.ParamEpError instance GHC.Show.Show Michelson.Typed.EntryPoints.ParamEpError instance GHC.Generics.Generic Michelson.Typed.EntryPoints.ArmCoord instance GHC.Classes.Eq Michelson.Typed.EntryPoints.ArmCoord instance GHC.Show.Show Michelson.Typed.EntryPoints.ArmCoord instance Control.DeepSeq.NFData (Michelson.Typed.EntryPoints.ParamNotes t) instance GHC.Generics.Generic (Michelson.Typed.EntryPoints.ParamNotes t) instance GHC.Classes.Eq (Michelson.Typed.EntryPoints.ParamNotes t) instance GHC.Show.Show (Michelson.Typed.EntryPoints.ParamNotes t) instance GHC.Generics.Generic Michelson.Typed.EntryPoints.ParseEpAddressError instance GHC.Classes.Eq Michelson.Typed.EntryPoints.ParseEpAddressError instance GHC.Show.Show Michelson.Typed.EntryPoints.ParseEpAddressError instance GHC.Generics.Generic Michelson.Typed.EntryPoints.EpAddress instance GHC.Classes.Ord Michelson.Typed.EntryPoints.EpAddress instance GHC.Classes.Eq Michelson.Typed.EntryPoints.EpAddress instance GHC.Show.Show Michelson.Typed.EntryPoints.EpAddress instance GHC.Classes.Eq (Michelson.Typed.EntryPoints.EpLiftSequence arg param) instance GHC.Show.Show (Michelson.Typed.EntryPoints.EpLiftSequence arg param) instance Control.DeepSeq.NFData Michelson.Typed.EntryPoints.ParamEpError instance Formatting.Buildable.Buildable Michelson.Typed.EntryPoints.ParamEpError instance Control.DeepSeq.NFData Michelson.Typed.EntryPoints.ArmCoord instance Formatting.Buildable.Buildable Michelson.Typed.EntryPoints.ArmCoord instance Control.DeepSeq.NFData Michelson.Typed.EntryPoints.ParseEpAddressError instance Formatting.Buildable.Buildable Michelson.Typed.EntryPoints.ParseEpAddressError instance Formatting.Buildable.Buildable Michelson.Typed.EntryPoints.EpAddress instance Control.DeepSeq.NFData Michelson.Typed.EntryPoints.EpAddress instance Test.QuickCheck.Arbitrary.Arbitrary Michelson.Untyped.Annotation.FieldAnn => Test.QuickCheck.Arbitrary.Arbitrary Michelson.Typed.EntryPoints.EpAddress -- | Module, containing data types for Michelson value. module Michelson.Typed.Value data SomeValue' instr [SomeValue] :: (Typeable t, SingI t) => Value' instr t -> SomeValue' instr data SomeConstrainedValue' instr (c :: T -> Constraint) [SomeConstrainedValue] :: forall (t :: T) (c :: T -> Constraint) instr. c t => Value' instr t -> SomeConstrainedValue' instr c data Comparability t [CanBeCompared] :: Comparable t => Comparability t [CannotBeCompared] :: IsComparable t ~ 'False => Comparability t class (IsComparable t ~ 'True) => Comparable t -- | Alias for comparable types. type ComparabilityScope t = (Typeable t, SingI t, Comparable t) type ContractInp1 param st = 'TPair param st type ContractInp param st = '[ContractInp1 param st] type ContractOut1 st = 'TPair ('TList 'TOperation) st type ContractOut st = '[ContractOut1 st] data CreateContract instr cp st CreateContract :: Address -> Maybe KeyHash -> Mutez -> Value' instr st -> instr (ContractInp cp st) (ContractOut st) -> CreateContract instr cp st [ccOriginator] :: CreateContract instr cp st -> Address [ccDelegate] :: CreateContract instr cp st -> Maybe KeyHash [ccBalance] :: CreateContract instr cp st -> Mutez [ccStorageVal] :: CreateContract instr cp st -> Value' instr st [ccContractCode] :: CreateContract instr cp st -> instr (ContractInp cp st) (ContractOut st) -- | Data type, representing operation, list of which is returned by -- Michelson contract (according to calling convention). -- -- These operations are to be further executed against system state after -- the contract execution. data Operation' instr [OpTransferTokens] :: ParameterScope p => TransferTokens instr p -> Operation' instr [OpSetDelegate] :: SetDelegate -> Operation' instr [OpCreateContract] :: (Show (instr (ContractInp cp st) (ContractOut st)), NFData (instr (ContractInp cp st) (ContractOut st)), Typeable instr, ParameterScope cp, StorageScope st) => CreateContract instr cp st -> Operation' instr data SetDelegate SetDelegate :: Maybe KeyHash -> SetDelegate [sdMbKeyHash] :: SetDelegate -> Maybe KeyHash data TransferTokens instr p TransferTokens :: Value' instr p -> Mutez -> Value' instr ('TContract p) -> TransferTokens instr p [ttTransferArgument] :: TransferTokens instr p -> Value' instr p [ttAmount] :: TransferTokens instr p -> Mutez [ttContract] :: TransferTokens instr p -> Value' instr ('TContract p) -- | Representation of Michelson value. -- -- Type parameter instr stands for Michelson instruction type, -- i.e. data type to represent an instruction of language. data Value' instr t [VKey] :: PublicKey -> Value' instr 'TKey [VUnit] :: Value' instr 'TUnit [VSignature] :: Signature -> Value' instr 'TSignature [VChainId] :: ChainId -> Value' instr 'TChainId [VOption] :: forall t instr. Maybe (Value' instr t) -> Value' instr ('TOption t) [VList] :: forall t instr. [Value' instr t] -> Value' instr ('TList t) [VSet] :: forall t instr. Comparable t => Set (Value' instr t) -> Value' instr ('TSet t) [VOp] :: Operation' instr -> Value' instr 'TOperation [VContract] :: forall arg instr. Address -> SomeEntryPointCallT arg -> Value' instr ('TContract arg) [VPair] :: forall l r instr. (Value' instr l, Value' instr r) -> Value' instr ('TPair l r) [VOr] :: forall l r instr. Either (Value' instr l) (Value' instr r) -> Value' instr ('TOr l r) [VLam] :: forall inp out instr. (forall i o. Show (instr i o), forall i o. Eq (instr i o), forall i o. NFData (instr i o)) => RemFail instr (inp : '[]) (out : '[]) -> Value' instr ('TLambda inp out) [VMap] :: forall k v instr. Comparable k => Map (Value' instr k) (Value' instr v) -> Value' instr ('TMap k v) [VBigMap] :: forall k v instr. Comparable k => Map (Value' instr k) (Value' instr v) -> Value' instr ('TBigMap k v) [VInt] :: Integer -> Value' instr 'TInt [VNat] :: Natural -> Value' instr 'TNat [VString] :: MText -> Value' instr 'TString [VBytes] :: ByteString -> Value' instr 'TBytes [VMutez] :: Mutez -> Value' instr 'TMutez [VBool] :: Bool -> Value' instr 'TBool [VKeyHash] :: KeyHash -> Value' instr 'TKeyHash [VTimestamp] :: Timestamp -> Value' instr 'TTimestamp [VAddress] :: EpAddress -> Value' instr 'TAddress -- | Wrapper over instruction which remembers whether this instruction -- always fails or not. data RemFail (instr :: k -> k -> Type) (i :: k) (o :: k) [RfNormal] :: instr i o -> RemFail instr i o [RfAlwaysFails] :: (forall o'. instr i o') -> RemFail instr i o -- | Merge two execution branches. rfMerge :: (forall o'. instr i1 o' -> instr i2 o' -> instr i3 o') -> RemFail instr i1 o -> RemFail instr i2 o -> RemFail instr i3 o -- | Get code disregard whether it always fails or not. rfAnyInstr :: RemFail instr i o -> instr i o -- | Modify inner code. rfMapAnyInstr :: (forall o'. instr i1 o' -> instr i2 o') -> RemFail instr i1 o -> RemFail instr i2 o -- | Make value of contract type which refers to the given address -- and does not call any entrypoint. addressToVContract :: forall t instr. (ParameterScope t, ForbidOr t) => Address -> Value' instr ('TContract t) buildVContract :: Value' instr ('TContract arg) -> Builder checkComparability :: Sing t -> Comparability t -- | Turn EpLiftSequence into actual function on Values. compileEpLiftSequence :: EpLiftSequence arg param -> Value' instr arg -> Value' instr param comparabilityPresence :: Sing t -> Maybe (Dict $ Comparable t) getComparableProofS :: Sing (a :: T) -> Maybe (Dict (Comparable a)) -- | Lift entrypoint argument to full parameter. liftCallArg :: EntryPointCallT param arg -> Value' instr arg -> Value' instr param instance Control.DeepSeq.NFData (Michelson.Typed.Value.Value' t instr) instance Control.DeepSeq.NFData (Michelson.Typed.Value.Operation' instr) instance GHC.Generics.Generic (Michelson.Typed.Value.TransferTokens instr p) instance GHC.Classes.Eq (Michelson.Typed.Value.TransferTokens instr p) instance GHC.Show.Show (Michelson.Typed.Value.TransferTokens instr p) instance GHC.Generics.Generic Michelson.Typed.Value.SetDelegate instance GHC.Classes.Eq Michelson.Typed.Value.SetDelegate instance GHC.Show.Show Michelson.Typed.Value.SetDelegate instance GHC.Show.Show (Michelson.Typed.Value.Operation' instr) instance GHC.Show.Show (Michelson.Typed.Value.CreateContract instr cp st) instance GHC.Classes.Eq (Michelson.Typed.Value.CreateContract instr cp st) instance forall k (instr :: k -> k -> *) (i :: k) (o :: k). (forall (o' :: k). GHC.Show.Show (instr i o')) => GHC.Show.Show (Michelson.Typed.Value.RemFail instr i o) instance GHC.Show.Show (Michelson.Typed.Value.Value' instr t) instance GHC.Classes.Eq (Michelson.Typed.Value.Value' instr t) instance GHC.Show.Show (Michelson.Typed.Value.SomeValue' instr) instance GHC.Show.Show (Michelson.Typed.Value.SomeConstrainedValue' instr c) instance GHC.Classes.Eq (Michelson.Typed.Value.SomeValue' instr) instance (Data.Typeable.Internal.Typeable t, Data.Singletons.Internal.SingI t) => Michelson.Typed.Scope.CheckScope (Michelson.Typed.Value.ComparabilityScope t) instance Formatting.Buildable.Buildable (Michelson.Typed.Value.Operation' instr) instance GHC.Classes.Eq (Michelson.Typed.Value.Operation' instr) instance Control.DeepSeq.NFData (Michelson.Typed.Value.TransferTokens instr p) instance Formatting.Buildable.Buildable (Michelson.Typed.Value.TransferTokens instr p) instance Control.DeepSeq.NFData (instr (Michelson.Typed.Value.ContractInp cp st) (Michelson.Typed.Value.ContractOut st)) => Control.DeepSeq.NFData (Michelson.Typed.Value.CreateContract instr cp st) instance Formatting.Buildable.Buildable (Michelson.Typed.Value.CreateContract instr cp st) instance (Michelson.Typed.Value.Comparable e1, Michelson.Typed.Value.Comparable e2) => Michelson.Typed.Value.Comparable ('Michelson.Typed.T.TPair e1 e2) instance Michelson.Typed.Value.Comparable 'Michelson.Typed.T.TInt instance Michelson.Typed.Value.Comparable 'Michelson.Typed.T.TNat instance Michelson.Typed.Value.Comparable 'Michelson.Typed.T.TString instance Michelson.Typed.Value.Comparable 'Michelson.Typed.T.TBytes instance Michelson.Typed.Value.Comparable 'Michelson.Typed.T.TMutez instance Michelson.Typed.Value.Comparable 'Michelson.Typed.T.TBool instance Michelson.Typed.Value.Comparable 'Michelson.Typed.T.TKeyHash instance Michelson.Typed.Value.Comparable 'Michelson.Typed.T.TTimestamp instance Michelson.Typed.Value.Comparable 'Michelson.Typed.T.TAddress instance Michelson.Typed.Value.Comparable e => GHC.Classes.Ord (Michelson.Typed.Value.Value' instr e) instance Data.Singletons.Internal.SingI t => Michelson.Typed.Scope.CheckScope (Michelson.Typed.Value.Comparable t) instance forall k (instr :: k -> k -> *) (i :: k) (o :: k). (forall (o' :: k). Control.DeepSeq.NFData (instr i o')) => Control.DeepSeq.NFData (Michelson.Typed.Value.RemFail instr i o) instance forall k (instr :: k -> k -> *) (i :: k) (o :: k). GHC.Classes.Eq (instr i o) => GHC.Classes.Eq (Michelson.Typed.Value.RemFail instr i o) instance Control.DeepSeq.NFData Michelson.Typed.Value.SetDelegate instance Formatting.Buildable.Buildable Michelson.Typed.Value.SetDelegate -- | Module, containing type classes for operating with Michelson values in -- the context of polymorphic stack type operations. module Michelson.Typed.Polymorphic class EDivOp (n :: T) (m :: T) where { type family EDivOpRes n m :: T; type family EModOpRes n m :: T; } evalEDivOp :: EDivOp n m => Value' instr n -> Value' instr m -> Value' instr ('TOption ('TPair (EDivOpRes n m) (EModOpRes n m))) class MemOp (c :: T) where { type family MemOpKey c :: T; } evalMem :: MemOp c => Value' instr (MemOpKey c) -> Value' instr c -> Bool class MapOp (c :: T) where { type family MapOpInp c :: T; type family MapOpRes c :: T -> T; } mapOpToList :: MapOp c => Value' instr c -> [Value' instr (MapOpInp c)] mapOpFromList :: MapOp c => Value' instr c -> [Value' instr b] -> Value' instr (MapOpRes c b) class IterOp (c :: T) where { type family IterOpEl c :: T; } iterOpDetachOne :: IterOp c => Value' instr c -> (Maybe (Value' instr (IterOpEl c)), Value' instr c) class SizeOp (c :: T) evalSize :: SizeOp c => Value' instr c -> Int class GetOp (c :: T) where { type family GetOpKey c :: T; type family GetOpVal c :: T; } evalGet :: GetOp c => Value' instr (GetOpKey c) -> Value' instr c -> Maybe (Value' instr (GetOpVal c)) class UpdOp (c :: T) where { type family UpdOpKey c :: T; type family UpdOpParams c :: T; } evalUpd :: UpdOp c => Value' instr (UpdOpKey c) -> Value' instr (UpdOpParams c) -> Value' instr c -> Value' instr c class SliceOp (c :: T) evalSlice :: SliceOp c => Natural -> Natural -> Value' instr c -> Maybe (Value' instr c) class ConcatOp (c :: T) evalConcat :: ConcatOp c => Value' instr c -> Value' instr c -> Value' instr c evalConcat' :: ConcatOp c => [Value' instr c] -> Value' instr c instance Michelson.Typed.Polymorphic.EDivOp 'Michelson.Typed.T.TInt 'Michelson.Typed.T.TInt instance Michelson.Typed.Polymorphic.EDivOp 'Michelson.Typed.T.TInt 'Michelson.Typed.T.TNat instance Michelson.Typed.Polymorphic.EDivOp 'Michelson.Typed.T.TNat 'Michelson.Typed.T.TInt instance Michelson.Typed.Polymorphic.EDivOp 'Michelson.Typed.T.TNat 'Michelson.Typed.T.TNat instance Michelson.Typed.Polymorphic.EDivOp 'Michelson.Typed.T.TMutez 'Michelson.Typed.T.TMutez instance Michelson.Typed.Polymorphic.EDivOp 'Michelson.Typed.T.TMutez 'Michelson.Typed.T.TNat instance Michelson.Typed.Polymorphic.SliceOp 'Michelson.Typed.T.TString instance Michelson.Typed.Polymorphic.SliceOp 'Michelson.Typed.T.TBytes instance Michelson.Typed.Polymorphic.ConcatOp 'Michelson.Typed.T.TString instance Michelson.Typed.Polymorphic.ConcatOp 'Michelson.Typed.T.TBytes instance Michelson.Typed.Polymorphic.GetOp ('Michelson.Typed.T.TBigMap k v) instance Michelson.Typed.Polymorphic.GetOp ('Michelson.Typed.T.TMap k v) instance Michelson.Typed.Polymorphic.UpdOp ('Michelson.Typed.T.TMap k v) instance Michelson.Typed.Polymorphic.UpdOp ('Michelson.Typed.T.TBigMap k v) instance Michelson.Typed.Polymorphic.UpdOp ('Michelson.Typed.T.TSet a) instance Michelson.Typed.Polymorphic.SizeOp 'Michelson.Typed.T.TString instance Michelson.Typed.Polymorphic.SizeOp 'Michelson.Typed.T.TBytes instance Michelson.Typed.Polymorphic.SizeOp ('Michelson.Typed.T.TSet a) instance Michelson.Typed.Polymorphic.SizeOp ('Michelson.Typed.T.TList a) instance Michelson.Typed.Polymorphic.SizeOp ('Michelson.Typed.T.TMap k v) instance Michelson.Typed.Polymorphic.IterOp ('Michelson.Typed.T.TMap k v) instance Michelson.Typed.Polymorphic.IterOp ('Michelson.Typed.T.TList e) instance Michelson.Typed.Polymorphic.IterOp ('Michelson.Typed.T.TSet e) instance Michelson.Typed.Polymorphic.MapOp ('Michelson.Typed.T.TMap k v) instance Michelson.Typed.Polymorphic.MapOp ('Michelson.Typed.T.TList e) instance Michelson.Typed.Polymorphic.MemOp ('Michelson.Typed.T.TSet e) instance Michelson.Typed.Polymorphic.MemOp ('Michelson.Typed.T.TMap k v) instance Michelson.Typed.Polymorphic.MemOp ('Michelson.Typed.T.TBigMap k v) -- | Module, containing some boilerplate for support of arithmetic -- operations in Michelson language. module Michelson.Typed.Arith -- | Class for binary arithmetic operation. -- -- Takes binary operation marker as op parameter, types of left -- operand n and right operand m. class ArithOp aop (n :: T) (m :: T) where { -- | Type family ArithRes denotes the type resulting from -- computing operation op from operands of types n and -- m. -- -- For instance, adding integer to natural produces integer, which is -- reflected in following instance of type family: ArithRes Add CNat -- CInt = CInt. type family ArithRes aop n m :: T; } -- | Evaluate arithmetic operation on given operands. evalOp :: ArithOp aop n m => proxy aop -> Value' instr n -> Value' instr m -> Either (ArithError (Value' instr n) (Value' instr m)) (Value' instr (ArithRes aop n m)) -- | Marker data type for add operation. class UnaryArithOp aop (n :: T) where { type family UnaryArithRes aop n :: T; } evalUnaryArithOp :: UnaryArithOp aop n => proxy aop -> Value' instr n -> Value' instr (UnaryArithRes aop n) -- | Represents an arithmetic error of the operation. data ArithError n m MutezArithError :: ArithErrorType -> n -> m -> ArithError n m ShiftArithError :: ArithErrorType -> n -> m -> ArithError n m -- | Denotes the error type occured in the arithmetic operation. data ArithErrorType AddOverflow :: ArithErrorType MulOverflow :: ArithErrorType SubUnderflow :: ArithErrorType LslOverflow :: ArithErrorType LsrUnderflow :: ArithErrorType data Add data Sub data Mul data Abs data Neg data Or data And data Xor data Not data Lsl data Lsr data Compare data Eq' data Neq data Lt data Gt data Le data Ge compareOp :: forall t i. (Comparable t, SingI t) => Value' i t -> Value' i t -> Integer instance GHC.Generics.Generic (Michelson.Typed.Arith.ArithError n m) instance (GHC.Classes.Ord n, GHC.Classes.Ord m) => GHC.Classes.Ord (Michelson.Typed.Arith.ArithError n m) instance (GHC.Classes.Eq n, GHC.Classes.Eq m) => GHC.Classes.Eq (Michelson.Typed.Arith.ArithError n m) instance (GHC.Show.Show n, GHC.Show.Show m) => GHC.Show.Show (Michelson.Typed.Arith.ArithError n m) instance GHC.Generics.Generic Michelson.Typed.Arith.ArithErrorType instance GHC.Classes.Ord Michelson.Typed.Arith.ArithErrorType instance GHC.Classes.Eq Michelson.Typed.Arith.ArithErrorType instance GHC.Show.Show Michelson.Typed.Arith.ArithErrorType instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Ge 'Michelson.Typed.T.TInt instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Le 'Michelson.Typed.T.TInt instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Gt 'Michelson.Typed.T.TInt instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Lt 'Michelson.Typed.T.TInt instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Neq 'Michelson.Typed.T.TInt instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Eq' 'Michelson.Typed.T.TInt instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Lsr 'Michelson.Typed.T.TNat 'Michelson.Typed.T.TNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Lsl 'Michelson.Typed.T.TNat 'Michelson.Typed.T.TNat instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Not 'Michelson.Typed.T.TInt instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Not 'Michelson.Typed.T.TNat instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Not 'Michelson.Typed.T.TBool instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Xor 'Michelson.Typed.T.TNat 'Michelson.Typed.T.TNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Xor 'Michelson.Typed.T.TBool 'Michelson.Typed.T.TBool instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.And 'Michelson.Typed.T.TInt 'Michelson.Typed.T.TNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.And 'Michelson.Typed.T.TNat 'Michelson.Typed.T.TNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.And 'Michelson.Typed.T.TBool 'Michelson.Typed.T.TBool instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Or 'Michelson.Typed.T.TNat 'Michelson.Typed.T.TNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Or 'Michelson.Typed.T.TBool 'Michelson.Typed.T.TBool instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Neg 'Michelson.Typed.T.TInt instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Neg 'Michelson.Typed.T.TNat instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Abs 'Michelson.Typed.T.TInt instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Mul 'Michelson.Typed.T.TNat 'Michelson.Typed.T.TInt instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Mul 'Michelson.Typed.T.TInt 'Michelson.Typed.T.TNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Mul 'Michelson.Typed.T.TNat 'Michelson.Typed.T.TNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Mul 'Michelson.Typed.T.TInt 'Michelson.Typed.T.TInt instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Mul 'Michelson.Typed.T.TNat 'Michelson.Typed.T.TMutez instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Mul 'Michelson.Typed.T.TMutez 'Michelson.Typed.T.TNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Sub 'Michelson.Typed.T.TNat 'Michelson.Typed.T.TInt instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Sub 'Michelson.Typed.T.TInt 'Michelson.Typed.T.TNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Sub 'Michelson.Typed.T.TNat 'Michelson.Typed.T.TNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Sub 'Michelson.Typed.T.TInt 'Michelson.Typed.T.TInt instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Sub 'Michelson.Typed.T.TTimestamp 'Michelson.Typed.T.TInt instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Sub 'Michelson.Typed.T.TTimestamp 'Michelson.Typed.T.TTimestamp instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Sub 'Michelson.Typed.T.TMutez 'Michelson.Typed.T.TMutez instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Add 'Michelson.Typed.T.TNat 'Michelson.Typed.T.TInt instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Add 'Michelson.Typed.T.TInt 'Michelson.Typed.T.TNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Add 'Michelson.Typed.T.TNat 'Michelson.Typed.T.TNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Add 'Michelson.Typed.T.TInt 'Michelson.Typed.T.TInt instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Add 'Michelson.Typed.T.TTimestamp 'Michelson.Typed.T.TInt instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Add 'Michelson.Typed.T.TInt 'Michelson.Typed.T.TTimestamp instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Add 'Michelson.Typed.T.TMutez 'Michelson.Typed.T.TMutez instance (Control.DeepSeq.NFData n, Control.DeepSeq.NFData m) => Control.DeepSeq.NFData (Michelson.Typed.Arith.ArithError n m) instance (GHC.Show.Show n, GHC.Show.Show m) => Formatting.Buildable.Buildable (Michelson.Typed.Arith.ArithError n m) instance Control.DeepSeq.NFData Michelson.Typed.Arith.ArithErrorType instance Formatting.Buildable.Buildable Michelson.Typed.Arith.ArithErrorType -- | Renderable documentation injected to contract code. module Michelson.Doc -- | A piece of documentation describing one property of a thing, be it a -- name or description of a contract, or an error throwable by given -- endpoint. -- -- Items of the same type appear close to each other in a rendered -- documentation and form a section. -- -- Doc items are later injected into a contract code via a dedicated -- nop-like instruction. Normally doc items which belong to one section -- appear in resulting doc in the same order in which they appeared in -- the contract. -- -- While documentation framework grows, this typeclass acquires more and -- more methods for fine tuning of existing rendering logic because we -- don't want to break backward compatibility, hope one day we will make -- everything concise :( E.g. all rendering and reording stuff could be -- merged in one method, and we could have several template -- implementations for it which would allow user to specify only stuff -- relevant to his case. class (Typeable d, DOrd d, KnownNat (DocItemPosition d)) => DocItem d where { -- | Position of this item in the resulting documentation; the smaller the -- value, the higher the section with this element will be placed. -- -- Documentation structure is not necessarily flat. If some doc item -- consolidates a whole documentation block within it, this block will -- have its own placement of items independent from outer parts of the -- doc. type family DocItemPosition d = (pos :: Nat) | pos -> d; -- | Defines where given doc item should be put. There are two options: 1. -- Inline right here (default behaviour); 2. Put into definitions -- section. -- -- Note that we require all doc items with "in definitions" placement to -- have Eq and Ord instances which comply the following -- law: if two documentation items describe the same entity or property, -- they should be considered equal. type family DocItemPlacement d :: DocItemPlacementKind; type DocItemPlacement d = 'DocItemInlined; } -- | When multiple items of the same type belong to one section, how this -- section will be called. -- -- If not provided, section will contain just untitled content. docItemSectionName :: DocItem d => Maybe Text -- | Description of a section. -- -- Can be used to mention some common things about all elements of this -- section. Markdown syntax is permitted here. docItemSectionDescription :: DocItem d => Maybe Markdown -- | How to render section name. -- -- Takes effect only if section name is set. docItemSectionNameStyle :: DocItem d => DocSectionNameStyle -- | Defines a function which constructs an unique identifier of given doc -- item, if it has been decided to put the doc item into definitions -- section. -- -- Identifier should be unique both among doc items of the same type and -- items of other types. Thus, consider using "typeId-contentId" pattern. docItemRef :: DocItem d => d -> DocItemRef (DocItemPlacement d) -- | Defines a function which constructs an unique identifier of given doc -- item, if it has been decided to put the doc item into definitions -- section. -- -- Identifier should be unique both among doc items of the same type and -- items of other types. Thus, consider using "typeId-contentId" pattern. docItemRef :: (DocItem d, DocItemPlacement d ~ 'DocItemInlined) => d -> DocItemRef (DocItemPlacement d) -- | Render given doc item to Markdown, preferably one line, optionally -- with header. -- -- Accepts the smallest allowed level of header. (Using smaller value -- than provided one will interfere with existing headers thus delivering -- mess). docItemToMarkdown :: DocItem d => HeaderLevel -> d -> Markdown -- | All doc items which this doc item refers to. -- -- They will automatically be put to definitions as soon as given doc -- item is detected. docItemDependencies :: DocItem d => d -> [SomeDocDefinitionItem] -- | This function accepts doc items put under the same section in the -- order in which they appeared in the contract and returns their new -- desired order. It's also fine to use this function for filtering or -- merging doc items. -- -- Default implementation * leaves inlined items as is; * for items put -- to definitions, lexicographically sorts them by their id. docItemsOrder :: DocItem d => [d] -> [d] -- | Get doc item position at term-level. docItemPosition :: forall d. DocItem d => DocItemPos -- | Some unique identifier of a doc item. -- -- All doc items which should be refer-able need to have this identifier. newtype DocItemId DocItemId :: Text -> DocItemId -- | Where do we place given doc item. data DocItemPlacementKind -- | Placed in the document content itself. DocItemInlined :: DocItemPlacementKind -- | Placed in dedicated definitions section; can later be referenced. DocItemInDefinitions :: DocItemPlacementKind -- | Defines an identifier which given doc item can be referenced with. data DocItemRef (p :: DocItemPlacementKind) [DocItemRef] :: DocItemId -> DocItemRef 'DocItemInDefinitions [DocItemNoRef] :: DocItemRef 'DocItemInlined -- | How to render section name. data DocSectionNameStyle -- | Suitable for block name. DocSectionNameBig :: DocSectionNameStyle -- | Suitable for subsection title within block. DocSectionNameSmall :: DocSectionNameStyle -- | Hides some documentation item. data SomeDocItem [SomeDocItem] :: DocItem d => d -> SomeDocItem -- | Hides some documentation item which is put to "definitions" section. data SomeDocDefinitionItem [SomeDocDefinitionItem] :: (DocItem d, DocItemPlacement d ~ 'DocItemInDefinitions) => d -> SomeDocDefinitionItem -- | A doc item which we store, along with related information. data DocElem d DocElem :: d -> Maybe SubDoc -> DocElem d -- | Doc item itself. [deItem] :: DocElem d -> d -- | Subdocumentation, if given item is a group. [deSub] :: DocElem d -> Maybe SubDoc -- | Several doc items of the same type. data DocSection DocSection :: (NonEmpty $ DocElem d) -> DocSection -- | A map from positions to document elements. -- -- This form effeciently keeps documentation for its incremental -- building. Doc items here appear close to how they were located in the -- contract; for instance, docItemsOrder is not yet applied at -- this stage. You only can be sure that items within each group are -- splitted across sections correctly. type DocBlock = Map DocItemPos DocSection -- | A part of documentation to be grouped. Essentially incapsulates -- DocBlock. newtype SubDoc SubDoc :: DocBlock -> SubDoc -- | Keeps documentation gathered for some piece of contract code. -- -- Used for building documentation of a contract. data ContractDoc ContractDoc :: DocBlock -> DocBlock -> Set SomeDocDefinitionItem -> Set DocItemId -> ContractDoc -- | All inlined doc items. [cdContents] :: ContractDoc -> DocBlock -- | Definitions used in document. -- -- Usually you put some large and repetitive descriptions here. This -- differs from the document content in that it contains sections which -- are always at top-level, disregard the nesting. -- -- All doc items which define docItemId method go here, and only -- they. [cdDefinitions] :: ContractDoc -> DocBlock -- | We remember all already declared entries to avoid cyclic dependencies -- in documentation items discovery. [cdDefinitionsSet] :: ContractDoc -> Set SomeDocDefinitionItem -- | We remember all already used identifiers. (Documentation naturally -- should not declare multiple items with the same identifier because -- that would make references to the respective anchors ambiguous). [cdDefinitionIds] :: ContractDoc -> Set DocItemId -- | A function which groups a piece of doc under one doc item. type DocGrouping = SubDoc -> SomeDocItem cdContentsL :: Lens' ContractDoc DocBlock cdDefinitionsL :: Lens' ContractDoc DocBlock cdDefinitionsSetL :: Lens' ContractDoc (Set SomeDocDefinitionItem) cdDefinitionIdsL :: Lens' ContractDoc (Set DocItemId) -- | Whether given DocElem is atomic. -- -- Normally, atomic DocElems are ones appearing in -- DOC_ITEM instruction, and non-atomic ones are put to -- DocGroup. deIsAtomic :: DocElem d -> Bool -- | Render documentation for SubDoc. subDocToMarkdown :: HeaderLevel -> SubDoc -> Markdown -- | Lift an atomic doc item to a block. docItemToBlock :: forall di. DocItem di => di -> DocBlock -- | Find all doc items of the given type. lookupDocBlockSection :: forall d. DocItem d => DocBlock -> Maybe (NonEmpty d) -- | Render given contract documentation to markdown document. contractDocToMarkdown :: ContractDoc -> LText -- | Apply given grouping to documentation being built. docGroupContent :: DocGrouping -> ContractDoc -> ContractDoc -- | Make a reference to doc item in definitions. docDefinitionRef :: (DocItem d, DocItemPlacement d ~ 'DocItemInDefinitions) => Markdown -> d -> Markdown -- | General (meta-)information about the contract such as git revision, -- contract's authors, etc. Should be relatively short (not several -- pages) because it is put somewhere close to the beginning of -- documentation. newtype DGeneralInfoSection DGeneralInfoSection :: SubDoc -> DGeneralInfoSection -- | Give a name to document block. data DName DName :: Text -> SubDoc -> DName -- | Description of something. data DDescription DDescription :: Markdown -> DDescription data DGitRevision DGitRevisionKnown :: DGitRevisionInfo -> DGitRevision DGitRevisionUnknown :: DGitRevision -- | Repository settings for DGitRevision. newtype GitRepoSettings GitRepoSettings :: (Text -> Text) -> GitRepoSettings -- | By commit sha make up a url to that commit in remote repository. [grsMkGitRevision] :: GitRepoSettings -> Text -> Text -- | Make DGitRevision. -- --
-- >>> :t $mkDGitRevision -- GitRepoSettings -> DGitRevision --mkDGitRevision :: ExpQ morleyRepoSettings :: GitRepoSettings -- | Comment in the doc (mostly used for licenses) data DComment DComment :: Text -> DComment -- | A hand-made anchor. data DAnchor DAnchor :: Anchor -> DAnchor instance Michelson.Doc.DocItem Michelson.Doc.DAnchor instance Michelson.Doc.DocItem Michelson.Doc.DComment instance Michelson.Doc.DocItem Michelson.Doc.DGitRevision instance Michelson.Doc.DocItem Michelson.Doc.DDescription instance Michelson.Doc.DocItem Michelson.Doc.DName instance Michelson.Doc.DocItem Michelson.Doc.DGeneralInfoSection instance GHC.Show.Show Michelson.Doc.DocGrouping instance GHC.Base.Semigroup Michelson.Doc.ContractDoc instance GHC.Base.Monoid Michelson.Doc.ContractDoc instance Formatting.Buildable.Buildable Michelson.Doc.DocItemPos instance GHC.Show.Show Michelson.Doc.DocItemPos instance GHC.Classes.Ord Michelson.Doc.DocItemPos instance GHC.Classes.Eq Michelson.Doc.DocItemPos instance Util.Markdown.ToAnchor Michelson.Doc.DocItemId instance GHC.Show.Show Michelson.Doc.DocItemId instance GHC.Classes.Ord Michelson.Doc.DocItemId instance GHC.Classes.Eq Michelson.Doc.DocItemId instance GHC.Show.Show Michelson.Doc.DocSection instance Control.DeepSeq.NFData Michelson.Doc.SomeDocItem instance GHC.Show.Show Michelson.Doc.SomeDocItem instance GHC.Classes.Eq Michelson.Doc.SomeDocDefinitionItem instance GHC.Classes.Ord Michelson.Doc.SomeDocDefinitionItem -- | Module, containing data types for Michelson value. module Michelson.Typed.Instr -- | Representation of Michelson instruction or sequence of instructions. -- -- Each Michelson instruction is represented by exactly one constructor -- of this data type. Sequence of instructions is represented with use of -- Seq constructor in following way: SWAP; DROP ; DUP; -- -> SWAP Seq DROP Seq DUP. Special case where -- there are no instructions is represented by constructor Nop, -- e.g. IF_NONE {} { SWAP; DROP; } -> IF_NONE Nop (SWAP -- Seq DROP). -- -- Type parameter inp states for input stack type. That is, type -- of the stack that is required for operation to execute. -- -- Type parameter out states for output stack type or type of -- stack that will be left after instruction's execution. data Instr (inp :: [T]) (out :: [T]) -- | A wrapper for instruction that also contain annotations for the top -- type on the result stack. -- -- As of now, when converting from untyped representation, we only -- preserve field annotations and type annotations. Variable annotations -- are not preserved. -- -- This can wrap only instructions with at least one non-failing -- execution branch. [InstrWithNotes] :: PackedNotes b -> Instr a b -> Instr a b -- | A wrapper for instruction with variable annotations. [InstrWithVarNotes] :: NonEmpty VarAnn -> Instr a b -> Instr a b -- | Execute given instruction on truncated stack. -- -- This can wrap only instructions with at least one non-failing -- execution branch. -- -- Morley has no such instruction, it is used solely in eDSLs. This -- instruction is sound because for all Michelson instructions the -- following property holds: if some code accepts stack i and -- produces stack o, when it can also be run on stack i + -- s producing stack o + s; and also because Michelson -- never makes implicit assumptions on types, rather you have to express -- all "yet ambiguous" type information in code. We could make this not -- an instruction but rather a function which modifies an instruction -- (this would also automatically prove soundness of used -- transformation), but it occured to be tricky (in particular for -- TestAssert and DipN and family), so let's leave this for future work. [FrameInstr] :: forall a b s. (KnownList a, KnownList b) => Proxy s -> Instr a b -> Instr (a ++ s) (b ++ s) [Seq] :: Instr a b -> Instr b c -> Instr a c -- | Nop operation. Missing in Michelson spec, added to parse construction -- like `IF {} { SWAP; DROP; }`. [Nop] :: Instr s s [Ext] :: ExtInstr s -> Instr s s -- | Nested wrapper is going to wrap a sequence of instructions with { }. -- It is crucial because serialisation of a contract depends on precise -- structure of its code. [Nested] :: Instr inp out -> Instr inp out -- | Places documentation generated for given instruction under some group. -- This is not part of ExtInstr because it does not behave like -- Nop; instead, it inherits behaviour of instruction put within -- it. [DocGroup] :: DocGrouping -> Instr inp out -> Instr inp out -- | Variants of CAR/CDR to retain field annotations as they relate to the -- input stack, and hence won't be available from the annotation notes -- from the result stack we pack with the instructions during type check. [AnnCAR] :: FieldAnn -> Instr ('TPair a b : s) (a : s) [AnnCDR] :: FieldAnn -> Instr ('TPair a b : s) (b : s) [DROP] :: Instr (a : s) s [DROPN] :: forall (n :: Peano) s. (SingI n, KnownPeano n, RequireLongerOrSameLength s n, NFData (Sing n)) => Sing n -> Instr s (Drop n s) [DUP] :: Instr (a : s) (a : (a : s)) [SWAP] :: Instr (a : (b : s)) (b : (a : s)) [DIG] :: forall (n :: Peano) inp out a. (ConstraintDIG n inp out a, NFData (Sing n)) => Sing n -> Instr inp out [DUG] :: forall (n :: Peano) inp out a. (ConstraintDUG n inp out a, NFData (Sing n)) => Sing n -> Instr inp out [PUSH] :: forall t s. ConstantScope t => Value' Instr t -> Instr s (t : s) [SOME] :: Instr (a : s) ('TOption a : s) [NONE] :: forall a s. SingI a => Instr s ('TOption a : s) [UNIT] :: Instr s ('TUnit : s) [IF_NONE] :: Instr s s' -> Instr (a : s) s' -> Instr ('TOption a : s) s' [PAIR] :: Instr (a : (b : s)) ('TPair a b : s) [LEFT] :: forall b a s. SingI b => Instr (a : s) ('TOr a b : s) [RIGHT] :: forall a b s. SingI a => Instr (b : s) ('TOr a b : s) [IF_LEFT] :: Instr (a : s) s' -> Instr (b : s) s' -> Instr ('TOr a b : s) s' [NIL] :: SingI p => Instr s ('TList p : s) [CONS] :: Instr (a : ('TList a : s)) ('TList a : s) [IF_CONS] :: Instr (a : ('TList a : s)) s' -> Instr s s' -> Instr ('TList a : s) s' [SIZE] :: SizeOp c => Instr (c : s) ('TNat : s) [EMPTY_SET] :: (Typeable e, SingI e, Comparable e) => Instr s ('TSet e : s) [EMPTY_MAP] :: (Typeable a, Typeable b, Comparable a, SingI a, SingI b) => Instr s ('TMap a b : s) [EMPTY_BIG_MAP] :: (Typeable a, Typeable b, Comparable a, SingI a, SingI b) => Instr s ('TBigMap a b : s) [MAP] :: MapOp c => Instr (MapOpInp c : s) (b : s) -> Instr (c : s) (MapOpRes c b : s) [ITER] :: IterOp c => Instr (IterOpEl c : s) s -> Instr (c : s) s [MEM] :: MemOp c => Instr (MemOpKey c : (c : s)) ('TBool : s) [GET] :: GetOp c => Instr (GetOpKey c : (c : s)) ('TOption (GetOpVal c) : s) [UPDATE] :: UpdOp c => Instr (UpdOpKey c : (UpdOpParams c : (c : s))) (c : s) [IF] :: Instr s s' -> Instr s s' -> Instr ('TBool : s) s' [LOOP] :: Instr s ('TBool : s) -> Instr ('TBool : s) s [LOOP_LEFT] :: Instr (a : s) ('TOr a b : s) -> Instr ('TOr a b : s) (b : s) [LAMBDA] :: forall i o s. Each [Typeable, SingI] [i, o] => Value' Instr ('TLambda i o) -> Instr s ('TLambda i o : s) [EXEC] :: Instr (t1 : ('TLambda t1 t2 : s)) (t2 : s) [APPLY] :: forall a b c s. ConstantScope a => Instr (a : ('TLambda ('TPair a b) c : s)) ('TLambda b c : s) [DIP] :: Instr a c -> Instr (b : a) (b : c) [DIPN] :: forall (n :: Peano) inp out s s'. (ConstraintDIPN n inp out s s', NFData (Sing n)) => Sing n -> Instr s s' -> Instr inp out [FAILWITH] :: (Typeable a, SingI a) => Instr (a : s) t [CAST] :: forall a s. SingI a => Instr (a : s) (a : s) [RENAME] :: Instr (a : s) (a : s) [PACK] :: PackedValScope a => Instr (a : s) ('TBytes : s) [UNPACK] :: UnpackedValScope a => Instr ('TBytes : s) ('TOption a : s) [CONCAT] :: ConcatOp c => Instr (c : (c : s)) (c : s) [CONCAT'] :: ConcatOp c => Instr ('TList c : s) (c : s) [SLICE] :: SliceOp c => Instr ('TNat : ('TNat : (c : s))) ('TOption c : s) [ISNAT] :: Instr ('TInt : s) ('TOption 'TNat : s) [ADD] :: (ArithOp Add n m, Typeable n, Typeable m) => Instr (n : (m : s)) (ArithRes Add n m : s) [SUB] :: (ArithOp Sub n m, Typeable n, Typeable m) => Instr (n : (m : s)) (ArithRes Sub n m : s) [MUL] :: (ArithOp Mul n m, Typeable n, Typeable m) => Instr (n : (m : s)) (ArithRes Mul n m : s) [EDIV] :: EDivOp n m => Instr (n : (m : s)) ('TOption ('TPair (EDivOpRes n m) (EModOpRes n m)) : s) [ABS] :: UnaryArithOp Abs n => Instr (n : s) (UnaryArithRes Abs n : s) [NEG] :: UnaryArithOp Neg n => Instr (n : s) (UnaryArithRes Neg n : s) [LSL] :: (ArithOp Lsl n m, Typeable n, Typeable m) => Instr (n : (m : s)) (ArithRes Lsl n m : s) [LSR] :: (ArithOp Lsr n m, Typeable n, Typeable m) => Instr (n : (m : s)) (ArithRes Lsr n m : s) [OR] :: (ArithOp Or n m, Typeable n, Typeable m) => Instr (n : (m : s)) (ArithRes Or n m : s) [AND] :: (ArithOp And n m, Typeable n, Typeable m) => Instr (n : (m : s)) (ArithRes And n m : s) [XOR] :: (ArithOp Xor n m, Typeable n, Typeable m) => Instr (n : (m : s)) (ArithRes Xor n m : s) [NOT] :: UnaryArithOp Not n => Instr (n : s) (UnaryArithRes Not n : s) [COMPARE] :: (Comparable n, Typeable n, SingI n) => Instr (n : (n : s)) ('TInt : s) [EQ] :: UnaryArithOp Eq' n => Instr (n : s) (UnaryArithRes Eq' n : s) [NEQ] :: UnaryArithOp Neq n => Instr (n : s) (UnaryArithRes Neq n : s) [LT] :: UnaryArithOp Lt n => Instr (n : s) (UnaryArithRes Lt n : s) [GT] :: UnaryArithOp Gt n => Instr (n : s) (UnaryArithRes Gt n : s) [LE] :: UnaryArithOp Le n => Instr (n : s) (UnaryArithRes Le n : s) [GE] :: UnaryArithOp Ge n => Instr (n : s) (UnaryArithRes Ge n : s) [INT] :: Instr ('TNat : s) ('TInt : s) [SELF] :: forall (arg :: T) s. ParameterScope arg => SomeEntryPointCallT arg -> Instr s ('TContract arg : s) [CONTRACT] :: ParameterScope p => Notes p -> EpName -> Instr ('TAddress : s) ('TOption ('TContract p) : s) [TRANSFER_TOKENS] :: ParameterScope p => Instr (p : ('TMutez : ('TContract p : s))) ('TOperation : s) [SET_DELEGATE] :: Instr ('TOption 'TKeyHash : s) ('TOperation : s) [CREATE_CONTRACT] :: (ParameterScope p, StorageScope g) => FullContract p g -> Instr ('TOption 'TKeyHash : ('TMutez : (g : s))) ('TOperation : ('TAddress : s)) [IMPLICIT_ACCOUNT] :: Instr ('TKeyHash : s) ('TContract 'TUnit : s) [NOW] :: Instr s ('TTimestamp : s) [AMOUNT] :: Instr s ('TMutez : s) [BALANCE] :: Instr s ('TMutez : s) [CHECK_SIGNATURE] :: Instr ('TKey : ('TSignature : ('TBytes : s))) ('TBool : s) [SHA256] :: Instr ('TBytes : s) ('TBytes : s) [SHA512] :: Instr ('TBytes : s) ('TBytes : s) [BLAKE2B] :: Instr ('TBytes : s) ('TBytes : s) [HASH_KEY] :: Instr ('TKey : s) ('TKeyHash : s) [SOURCE] :: Instr s ('TAddress : s) [SENDER] :: Instr s ('TAddress : s) [ADDRESS] :: Instr ('TContract a : s) ('TAddress : s) [CHAIN_ID] :: Instr s ('TChainId : s) data ExtInstr s TEST_ASSERT :: TestAssert s -> ExtInstr s PRINT :: PrintComment s -> ExtInstr s DOC_ITEM :: SomeDocItem -> ExtInstr s COMMENT_ITEM :: CommentType -> ExtInstr s data CommentType FunctionStarts :: Text -> CommentType FunctionEnds :: Text -> CommentType StatementStarts :: Text -> CommentType StatementEnds :: Text -> CommentType JustComment :: Text -> CommentType -- | A reference into the stack of a given type. data StackRef (st :: [T]) -- | Keeps 0-based index to a stack element counting from the top. [StackRef] :: (KnownPeano idx, SingI idx, RequireLongerThan st idx) => Sing (idx :: Peano) -> StackRef st -- | Create a stack reference, performing checks at compile time. mkStackRef :: forall (gn :: Nat) st n. (n ~ ToPeano gn, SingI n, KnownPeano n, RequireLongerThan st n) => StackRef st -- | A print format with references into the stack newtype PrintComment (st :: [T]) PrintComment :: [Either Text (StackRef st)] -> PrintComment (st :: [T]) [unPrintComment] :: PrintComment (st :: [T]) -> [Either Text (StackRef st)] data TestAssert (s :: [T]) [TestAssert] :: Typeable out => Text -> PrintComment inp -> Instr inp ('TBool : out) -> TestAssert inp type ContractCode cp st = Instr (ContractInp cp st) (ContractOut st) -- | Typed contract and information about annotations which is not present -- in the contract code. TODO [#12]: rename this to Contract data FullContract cp st FullContract :: ContractCode cp st -> ParamNotes cp -> Notes st -> FullContract cp st [fcCode] :: FullContract cp st -> ContractCode cp st [fcParamNotes] :: FullContract cp st -> ParamNotes cp [fcStoreNotes] :: FullContract cp st -> Notes st mapFullContractCode :: (ContractCode cp st -> ContractCode cp st) -> FullContract cp st -> FullContract cp st pattern CAR :: () => (i ~ ('TPair a b : s), o ~ (a : s)) => Instr i o pattern CDR :: () => (i ~ ('TPair a b : s), o ~ (b : s)) => Instr i o pattern UNPAIR :: () => (i ~ ('TPair a b : s), o ~ (a : (b : s))) => Instr i o -- | A wrapper to wrap annotations and corresponding singleton. Apart from -- packing notes along with the corresponding Singleton, this wrapper -- type, when included with Instr also helps to derive the -- Show instance for Instr as `Sing a` does not have a -- Show instance on its own. data PackedNotes a [PackedNotes] :: SingI a => Notes a -> PackedNotes (a : s) type ConstraintDIPN n inp out s s' = ConstraintDIPN' T n inp out s s' -- | Constraint that is used in DIPN, we want to share it with typechecking -- code and eDSL code. type ConstraintDIPN' kind (n :: Peano) (inp :: [kind]) (out :: [kind]) (s :: [kind]) (s' :: [kind]) = (SingI n, KnownPeano n, RequireLongerOrSameLength inp n, ((Take n inp) ++ s) ~ inp, ((Take n inp) ++ s') ~ out) type ConstraintDIG n inp out a = ConstraintDIG' T n inp out a type ConstraintDIG' kind (n :: Peano) (inp :: [kind]) (out :: [kind]) (a :: kind) = (SingI n, KnownPeano n, RequireLongerThan inp n, inp ~ (Take n inp ++ (a : Drop ('S n) inp)), out ~ (a : Take n inp ++ Drop ('S n) inp)) type ConstraintDUG n inp out a = ConstraintDUG' T n inp out a type ConstraintDUG' kind (n :: Peano) (inp :: [kind]) (out :: [kind]) (a :: kind) = (SingI n, KnownPeano n, RequireLongerThan out n, inp ~ (a : Drop ('S 'Z) inp), out ~ (Take n (Drop ('S 'Z) inp) ++ (a : Drop ('S n) inp))) instance Control.DeepSeq.NFData (Michelson.Typed.Instr.Instr out inp) instance GHC.Generics.Generic (Michelson.Typed.Instr.ExtInstr s) instance GHC.Show.Show (Michelson.Typed.Instr.ExtInstr s) instance GHC.Generics.Generic Michelson.Typed.Instr.CommentType instance GHC.Show.Show Michelson.Typed.Instr.CommentType instance GHC.Base.Monoid (Michelson.Typed.Instr.PrintComment st) instance GHC.Base.Semigroup (Michelson.Typed.Instr.PrintComment st) instance GHC.Generics.Generic (Michelson.Typed.Instr.PrintComment st) instance GHC.Show.Show (Michelson.Typed.Instr.PrintComment st) instance GHC.Classes.Eq (Michelson.Typed.Instr.PrintComment st) instance GHC.Show.Show (Michelson.Typed.Instr.Instr inp out) instance GHC.Show.Show (Michelson.Typed.Instr.TestAssert s) instance GHC.Show.Show (Michelson.Typed.Instr.FullContract cp st) instance GHC.Classes.Eq (Michelson.Typed.Instr.ContractCode cp st) => GHC.Classes.Eq (Michelson.Typed.Instr.FullContract cp st) instance GHC.Base.Semigroup (Michelson.Typed.Instr.Instr s s) instance GHC.Base.Monoid (Michelson.Typed.Instr.Instr s s) instance Control.DeepSeq.NFData (Michelson.Typed.Instr.TestAssert s) instance Control.DeepSeq.NFData (Michelson.Typed.Instr.ExtInstr s) instance Control.DeepSeq.NFData (Michelson.Typed.Instr.FullContract cp st) instance Control.DeepSeq.NFData Michelson.Typed.Instr.CommentType instance Control.DeepSeq.NFData (Michelson.Typed.Instr.PrintComment st) instance Data.String.IsString (Michelson.Typed.Instr.PrintComment st) instance Control.DeepSeq.NFData (Michelson.Typed.Instr.StackRef st) instance GHC.Classes.Eq (Michelson.Typed.Instr.StackRef st) instance GHC.Show.Show (Michelson.Typed.Instr.StackRef st) instance Control.DeepSeq.NFData (Michelson.Typed.Instr.PackedNotes a) instance GHC.Show.Show (Michelson.Typed.Instr.PackedNotes a) instance Formatting.Buildable.Buildable (Michelson.Typed.Instr.PackedNotes a) instance Michelson.Printer.Util.RenderDoc (Michelson.Typed.Instr.PackedNotes a) module Michelson.Typed.Convert convertContractCode :: forall param store. (SingI param, SingI store) => ContractCode param store -> Contract convertFullContract :: forall param store. (SingI param, SingI store) => FullContract param store -> Contract instrToOps :: HasCallStack => Instr inp out -> [ExpandedOp] -- | Convert a typed Val to an untyped Value. -- -- For full isomorphism type of the given Val should not contain -- TOperation - a compile error will be raised otherwise. You can -- analyse its presence with checkOpPresence function. untypeValue :: forall t. (SingI t, HasNoOp t) => Value' Instr t -> Value instance GHC.Classes.Eq (Michelson.Typed.Instr.Instr inp out) instance Data.Typeable.Internal.Typeable s => GHC.Classes.Eq (Michelson.Typed.Instr.TestAssert s) instance (Data.Singletons.Internal.SingI t, Michelson.Typed.Scope.HasNoOp t) => Formatting.Buildable.Buildable (Michelson.Typed.Value.Value' Michelson.Typed.Instr.Instr t) module Michelson.Typed.Aliases type Value = Value' Instr type SomeValue = SomeValue' Instr type SomeConstrainedValue = SomeConstrainedValue' Instr type Operation = Operation' Instr -- | General-purpose utility functions for typed types. module Michelson.Typed.Util -- | Options for dfsInstr. data DfsSettings x DfsSettings :: Bool -> CtorEffectsApp x -> DfsSettings x -- | Whether dfsInstr function should go into values which contain -- other instructions: lambdas and constant contracts (which can be -- passed to CREATE_CONTRACT). [dsGoToValues] :: DfsSettings x -> Bool -- | How do we handle intermediate nodes in instruction tree. [dsCtorEffectsApp] :: DfsSettings x -> CtorEffectsApp x -- | Describes how intermediate nodes in instruction tree are accounted. data CtorEffectsApp x CtorEffectsApp :: Text -> (forall i o. Semigroup x => x -> x -> Instr i o -> (Instr i o, x)) -> CtorEffectsApp x -- | Name of this way. [ceaName] :: CtorEffectsApp x -> Text -- | This function accepts: 1. Effects gathered after applying -- step to node's children, but before applying it to the node -- itself. 2. Effects gathered after applying step to the given -- intermediate node. 3. Instruction resulting after all modifications -- produced by step. [ceaApplyEffects] :: CtorEffectsApp x -> forall i o. Semigroup x => x -> x -> Instr i o -> (Instr i o, x) -- | Traverse a typed instruction in depth-first order. <> is -- used to concatenate intermediate results. Each instructions can be -- changed using the supplied step function. It does not -- consider extra instructions (not present in Michelson). dfsInstr :: forall x inp out. Semigroup x => DfsSettings x -> (forall i o. Instr i o -> (Instr i o, x)) -> Instr inp out -> (Instr inp out, x) -- | Specialization of dfsInstr for case when changing the -- instruction is not required. dfsFoldInstr :: forall x inp out. Semigroup x => DfsSettings x -> (forall i o. Instr i o -> x) -> Instr inp out -> x -- | Specialization of dfsInstr which only modifies given -- instruction. dfsModifyInstr :: DfsSettings () -> (forall i o. Instr i o -> Instr i o) -> Instr inp out -> Instr inp out -- | There are many ways to represent a sequence of more than 2 -- instructions. E. g. for i1; i2; i3 it can be Seq i1 $ Seq -- i2 i3 or Seq (Seq i1 i2) i3. This function enforces a -- particular structure. Specifically, it makes each Seq have a -- single instruction (i. e. not Seq) in its second argument. This -- function also erases redundant Nops. -- -- Please note that this function is not recursive, it does not linearize -- contents of IF and similar instructions. linearizeLeft :: Instr inp out -> Instr inp out -- | Deep version of linearizeLeft. It recursively linearizes -- instructions stored in other instructions. linearizeLeftDeep :: Instr inp out -> Instr inp out -- | If value is a string, return the stored string. isStringValue :: Value t -> Maybe MText -- | If value is a bytestring, return the stored bytestring. isBytesValue :: Value t -> Maybe ByteString -- | Takes a selector which checks whether an atomic value (i. e. that can -- not contain another value) can be converted to something. Recursively -- applies it to all atomic values in potentially non-atomic value. -- Collects extracted values in a list. -- -- Perhaps one day we'll have dfsValue. allAtomicValues :: forall t a. (forall t'. Value t' -> Maybe a) -> Value t -> [a] instance GHC.Show.Show (Michelson.Typed.Util.DfsSettings x) instance Data.Default.Class.Default (Michelson.Typed.Util.DfsSettings x) instance GHC.Show.Show (Michelson.Typed.Util.CtorEffectsApp x) -- | Conversions between haskell types/values and Michelson ones. module Michelson.Typed.Haskell.Value -- | Isomorphism between Michelson values and plain Haskell types. -- -- Default implementation of this typeclass converts ADTs to Michelson -- "pair"s and "or"s. class (WellTypedToT a) => IsoValue a where { -- | Type function that converts a regular Haskell type into a T -- type. type family ToT a :: T; type ToT a = GValueType (Rep a); } -- | Converts a Haskell structure into Value representation. toVal :: IsoValue a => a -> Value (ToT a) -- | Converts a Haskell structure into Value representation. toVal :: (IsoValue a, Generic a, GIsoValue (Rep a), ToT a ~ GValueType (Rep a)) => a -> Value (ToT a) -- | Converts a Value into Haskell type. fromVal :: IsoValue a => Value (ToT a) -> a -- | Converts a Value into Haskell type. fromVal :: (IsoValue a, Generic a, GIsoValue (Rep a), ToT a ~ GValueType (Rep a)) => Value (ToT a) -> a -- | Implements ADT conversion to Michelson value. -- -- Thanks to Generic, Michelson representation will be a balanced tree; -- this reduces average access time in general case. -- -- A drawback of such approach is that, in theory, in new GHC version -- generified representation may change; however, chances are small and I -- (martoon) believe that contract versions will change much faster -- anyway. class GIsoValue (x :: Type -> Type) where { type family GValueType x :: T; } -- | Overloaded version of ToT to work on Haskell and T -- types. type family ToT' (t :: k) :: T -- | Hides some Haskell value put in line with Michelson Value. data SomeIsoValue [SomeIsoValue] :: (Typeable a, IsoValue a) => a -> SomeIsoValue -- | Any Haskell value which can be converted to Michelson Value. newtype AnyIsoValue AnyIsoValue :: (forall a. IsoValue a => a) -> AnyIsoValue -- | Whether Michelson representation of the type is derived via Generics. type GenericIsoValue t = (IsoValue t, Generic t, ToT t ~ GValueType (Rep t)) -- | This class encodes Michelson rules w.r.t where it requires comparable -- types. Earlier we had a dedicated type for representing comparable -- types CT. But then we integreated those types into -- T. This meant that some of the types that could be formed -- with various combinations of T would be illegal as per -- Michelson typing rule. Using this class, we inductively enforce that a -- type and all types it contains are well typed as per Michelson's -- rules. class WellTyped (t :: T) type WellTypedIsoValue a = (WellTyped (ToT a), IsoValue a) type WellTypedToT a = WellTyped (ToT a) -- | Values of type Dict p capture a dictionary for a -- constraint of type p. -- -- e.g. -- --
-- Dict :: Dict (Eq Int) ---- -- captures a dictionary that proves we have an: -- --
-- instance Eq 'Int ---- -- Pattern matching on the Dict constructor will bring this -- instance into scope. data Dict a [Dict] :: forall a. a => Dict a type EntryPointCall param arg = EntryPointCallT (ToT param) (ToT arg) type SomeEntryPointCall arg = SomeEntryPointCallT (ToT arg) -- | Since Contract name is used to designate contract code, lets -- call analogy of TContract type as follows. -- -- Note that type argument always designates an argument of entrypoint. -- If a contract has explicit default entrypoint (and no root -- entrypoint), ContractRef referring to it can never have the -- entire parameter as its type argument. data ContractRef (arg :: Type) ContractRef :: Address -> SomeEntryPointCall arg -> ContractRef (arg :: Type) [crAddress] :: ContractRef (arg :: Type) -> Address [crEntryPoint] :: ContractRef (arg :: Type) -> SomeEntryPointCall arg -- | Replace type argument of ContractAddr with isomorphic one. coerceContractRef :: ToT a ~ ToT b => ContractRef a -> ContractRef b contractRefToAddr :: ContractRef cp -> EpAddress newtype BigMap k v BigMap :: Map k v -> BigMap k v [unBigMap] :: BigMap k v -> Map k v -- | Type function to convert a Haskell stack type to T-based one. type family ToTs (ts :: [Type]) :: [T] -- | Overloaded version of ToTs to work on Haskell and T -- stacks. type family ToTs' (t :: [k]) :: [T] -- | Isomorphism between Michelson stack and its Haskell reflection. class IsoValuesStack (ts :: [Type]) toValStack :: IsoValuesStack ts => Rec Identity ts -> Rec Value (ToTs ts) fromValStack :: IsoValuesStack ts => Rec Value (ToTs ts) -> Rec Identity ts totsKnownLemma :: forall s. KnownList s :- KnownList (ToTs s) totsAppendLemma :: forall a b. KnownList a => Dict (ToTs (a ++ b) ~ (ToTs a ++ ToTs b)) instance GHC.Show.Show (Michelson.Typed.Haskell.Value.ContractRef arg) instance GHC.Classes.Eq (Michelson.Typed.Haskell.Value.ContractRef arg) instance GHC.Classes.Ord k => GHC.Base.Monoid (Michelson.Typed.Haskell.Value.BigMap k v) instance GHC.Classes.Ord k => GHC.Base.Semigroup (Michelson.Typed.Haskell.Value.BigMap k v) instance Data.Default.Class.Default (Michelson.Typed.Haskell.Value.BigMap k v) instance (GHC.Show.Show k, GHC.Show.Show v) => GHC.Show.Show (Michelson.Typed.Haskell.Value.BigMap k v) instance (GHC.Classes.Eq k, GHC.Classes.Eq v) => GHC.Classes.Eq (Michelson.Typed.Haskell.Value.BigMap k v) instance Michelson.Typed.Haskell.Value.IsoValue a => Michelson.Typed.Haskell.Value.IsoValue (Data.Functor.Identity.Identity a) instance Michelson.Typed.Haskell.Value.IsoValue a => Michelson.Typed.Haskell.Value.IsoValue (Named.Internal.NamedF Data.Functor.Identity.Identity a name) instance Michelson.Typed.Haskell.Value.IsoValue a => Michelson.Typed.Haskell.Value.IsoValue (Named.Internal.NamedF GHC.Maybe.Maybe a name) instance Michelson.Typed.Haskell.Value.WellTypedToT arg => Formatting.Buildable.Buildable (Michelson.Typed.Haskell.Value.ContractRef arg) instance Michelson.Typed.Haskell.Value.WellTypedToT arg => Michelson.Typed.Haskell.Value.IsoValue (Michelson.Typed.Haskell.Value.ContractRef arg) instance Michelson.Typed.Haskell.Value.IsoValuesStack '[] instance (Michelson.Typed.Haskell.Value.IsoValue t, Michelson.Typed.Haskell.Value.IsoValuesStack st) => Michelson.Typed.Haskell.Value.IsoValuesStack (t : st) instance Michelson.Typed.Haskell.Value.IsoValue GHC.Integer.Type.Integer instance Michelson.Typed.Haskell.Value.IsoValue GHC.Natural.Natural instance Michelson.Typed.Haskell.Value.IsoValue Michelson.Text.MText instance Michelson.Text.DoNotUseTextError => Michelson.Typed.Haskell.Value.IsoValue Data.Text.Internal.Text instance Michelson.Typed.Haskell.Value.IsoValue GHC.Types.Bool instance Michelson.Typed.Haskell.Value.IsoValue Data.ByteString.Internal.ByteString instance Michelson.Typed.Haskell.Value.IsoValue Tezos.Core.Mutez instance Michelson.Typed.Haskell.Value.IsoValue Tezos.Crypto.KeyHash instance Michelson.Typed.Haskell.Value.IsoValue Tezos.Core.Timestamp instance Michelson.Typed.Haskell.Value.IsoValue Tezos.Address.Address instance Michelson.Typed.Haskell.Value.IsoValue Michelson.Typed.EntryPoints.EpAddress instance Michelson.Typed.Haskell.Value.IsoValue Tezos.Crypto.PublicKey instance Michelson.Typed.Haskell.Value.IsoValue Tezos.Crypto.Signature instance Michelson.Typed.Haskell.Value.IsoValue Tezos.Core.ChainId instance Michelson.Typed.Haskell.Value.IsoValue () instance Michelson.Typed.Haskell.Value.IsoValue a => Michelson.Typed.Haskell.Value.IsoValue [a] instance Michelson.Typed.Haskell.Value.IsoValue a => Michelson.Typed.Haskell.Value.IsoValue (GHC.Maybe.Maybe a) instance (Michelson.Typed.Haskell.Value.IsoValue l, Michelson.Typed.Haskell.Value.IsoValue r) => Michelson.Typed.Haskell.Value.IsoValue (Data.Either.Either l r) instance (Michelson.Typed.Haskell.Value.IsoValue a, Michelson.Typed.Haskell.Value.IsoValue b) => Michelson.Typed.Haskell.Value.IsoValue (a, b) instance (Michelson.Typed.Value.Comparable (Michelson.Typed.Haskell.Value.ToT c), GHC.Classes.Ord c, Michelson.Typed.Haskell.Value.IsoValue c) => Michelson.Typed.Haskell.Value.IsoValue (Data.Set.Internal.Set c) instance (Michelson.Typed.Value.Comparable (Michelson.Typed.Haskell.Value.ToT k), GHC.Classes.Ord k, Michelson.Typed.Haskell.Value.IsoValue k, Michelson.Typed.Haskell.Value.IsoValue v) => Michelson.Typed.Haskell.Value.IsoValue (Data.Map.Internal.Map k v) instance Michelson.Typed.Haskell.Value.IsoValue Michelson.Typed.Aliases.Operation instance (Michelson.Typed.Haskell.Value.IsoValue a, Michelson.Typed.Haskell.Value.IsoValue b, Michelson.Typed.Haskell.Value.IsoValue c) => Michelson.Typed.Haskell.Value.IsoValue (a, b, c) instance (Michelson.Typed.Haskell.Value.IsoValue a, Michelson.Typed.Haskell.Value.IsoValue b, Michelson.Typed.Haskell.Value.IsoValue c, Michelson.Typed.Haskell.Value.IsoValue d) => Michelson.Typed.Haskell.Value.IsoValue (a, b, c, d) instance (Michelson.Typed.Haskell.Value.IsoValue a, Michelson.Typed.Haskell.Value.IsoValue b, Michelson.Typed.Haskell.Value.IsoValue c, Michelson.Typed.Haskell.Value.IsoValue d, Michelson.Typed.Haskell.Value.IsoValue e) => Michelson.Typed.Haskell.Value.IsoValue (a, b, c, d, e) instance (Michelson.Typed.Haskell.Value.IsoValue a, Michelson.Typed.Haskell.Value.IsoValue b, Michelson.Typed.Haskell.Value.IsoValue c, Michelson.Typed.Haskell.Value.IsoValue d, Michelson.Typed.Haskell.Value.IsoValue e, Michelson.Typed.Haskell.Value.IsoValue f) => Michelson.Typed.Haskell.Value.IsoValue (a, b, c, d, e, f) instance (Michelson.Typed.Haskell.Value.IsoValue a, Michelson.Typed.Haskell.Value.IsoValue b, Michelson.Typed.Haskell.Value.IsoValue c, Michelson.Typed.Haskell.Value.IsoValue d, Michelson.Typed.Haskell.Value.IsoValue e, Michelson.Typed.Haskell.Value.IsoValue f, Michelson.Typed.Haskell.Value.IsoValue g) => Michelson.Typed.Haskell.Value.IsoValue (a, b, c, d, e, f, g) instance (Michelson.Typed.Haskell.Value.WellTypedToT k, Michelson.Typed.Haskell.Value.WellTypedToT v, Michelson.Typed.Value.Comparable (Michelson.Typed.Haskell.Value.ToT k), GHC.Classes.Ord k, Michelson.Typed.Haskell.Value.IsoValue k, Michelson.Typed.Haskell.Value.IsoValue v) => Michelson.Typed.Haskell.Value.IsoValue (Michelson.Typed.Haskell.Value.BigMap k v) instance (Michelson.Typed.Haskell.Value.WellTypedToT k, Michelson.Typed.Haskell.Value.WellTypedToT v, Michelson.Typed.Value.Comparable (Michelson.Typed.Haskell.Value.ToT k), Test.QuickCheck.Arbitrary.Arbitrary k, Test.QuickCheck.Arbitrary.Arbitrary v, GHC.Classes.Ord k) => Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.Haskell.Value.BigMap k v) instance Michelson.Typed.Haskell.Value.IsoValue a => Michelson.Typed.Haskell.Value.GIsoValue (GHC.Generics.Rec0 a) instance Michelson.Typed.Haskell.Value.WellTyped 'Michelson.Typed.T.TKey instance Michelson.Typed.Haskell.Value.WellTyped 'Michelson.Typed.T.TUnit instance Michelson.Typed.Haskell.Value.WellTyped 'Michelson.Typed.T.TSignature instance Michelson.Typed.Haskell.Value.WellTyped 'Michelson.Typed.T.TChainId instance Michelson.Typed.Haskell.Value.WellTyped t => Michelson.Typed.Haskell.Value.WellTyped ('Michelson.Typed.T.TOption t) instance Michelson.Typed.Haskell.Value.WellTyped t => Michelson.Typed.Haskell.Value.WellTyped ('Michelson.Typed.T.TList t) instance (Michelson.Typed.Value.Comparable t, Michelson.Typed.Haskell.Value.WellTyped t) => Michelson.Typed.Haskell.Value.WellTyped ('Michelson.Typed.T.TSet t) instance Michelson.Typed.Haskell.Value.WellTyped 'Michelson.Typed.T.TOperation instance Michelson.Typed.Haskell.Value.WellTyped t => Michelson.Typed.Haskell.Value.WellTyped ('Michelson.Typed.T.TContract t) instance (Michelson.Typed.Haskell.Value.WellTyped t1, Michelson.Typed.Haskell.Value.WellTyped t2) => Michelson.Typed.Haskell.Value.WellTyped ('Michelson.Typed.T.TPair t1 t2) instance (Michelson.Typed.Haskell.Value.WellTyped t1, Michelson.Typed.Haskell.Value.WellTyped t2) => Michelson.Typed.Haskell.Value.WellTyped ('Michelson.Typed.T.TOr t1 t2) instance (Michelson.Typed.Haskell.Value.WellTyped t1, Michelson.Typed.Haskell.Value.WellTyped t2) => Michelson.Typed.Haskell.Value.WellTyped ('Michelson.Typed.T.TLambda t1 t2) instance (Michelson.Typed.Value.Comparable k, Michelson.Typed.Haskell.Value.WellTyped k, Michelson.Typed.Haskell.Value.WellTyped v) => Michelson.Typed.Haskell.Value.WellTyped ('Michelson.Typed.T.TMap k v) instance (Michelson.Typed.Value.Comparable k, Michelson.Typed.Haskell.Value.WellTyped k, Michelson.Typed.Haskell.Value.WellTyped v) => Michelson.Typed.Haskell.Value.WellTyped ('Michelson.Typed.T.TBigMap k v) instance Michelson.Typed.Haskell.Value.WellTyped 'Michelson.Typed.T.TInt instance Michelson.Typed.Haskell.Value.WellTyped 'Michelson.Typed.T.TNat instance Michelson.Typed.Haskell.Value.WellTyped 'Michelson.Typed.T.TString instance Michelson.Typed.Haskell.Value.WellTyped 'Michelson.Typed.T.TBytes instance Michelson.Typed.Haskell.Value.WellTyped 'Michelson.Typed.T.TMutez instance Michelson.Typed.Haskell.Value.WellTyped 'Michelson.Typed.T.TBool instance Michelson.Typed.Haskell.Value.WellTyped 'Michelson.Typed.T.TKeyHash instance Michelson.Typed.Haskell.Value.WellTyped 'Michelson.Typed.T.TTimestamp instance Michelson.Typed.Haskell.Value.WellTyped 'Michelson.Typed.T.TAddress instance Michelson.Typed.Haskell.Value.GIsoValue x => Michelson.Typed.Haskell.Value.GIsoValue (GHC.Generics.M1 t i x) instance (Michelson.Typed.Haskell.Value.GIsoValue x, Michelson.Typed.Haskell.Value.GIsoValue y) => Michelson.Typed.Haskell.Value.GIsoValue (x GHC.Generics.:+: y) instance (Michelson.Typed.Haskell.Value.GIsoValue x, Michelson.Typed.Haskell.Value.GIsoValue y) => Michelson.Typed.Haskell.Value.GIsoValue (x GHC.Generics.:*: y) instance Michelson.Typed.Haskell.Value.GIsoValue GHC.Generics.U1 -- | Instructions working on sum types derived from Haskell ones. module Michelson.Typed.Haskell.Instr.Sum type InstrWrapC dt name = (GenericIsoValue dt, GInstrWrap (Rep dt) (LnrBranch (GetNamed name dt)) (LnrFieldType (GetNamed name dt))) type InstrCaseC dt = (GenericIsoValue dt, GInstrCase (Rep dt)) type InstrUnwrapC dt name = (GenericIsoValue dt, GInstrUnwrap (Rep dt) (LnrBranch (GetNamed name dt)) (CtorOnlyField name dt)) -- | Wrap given element into a constructor with the given name. -- -- Mentioned constructor must have only one field. -- -- Since labels interpretable by OverloadedLabels extension cannot -- start with capital latter, prepend constructor name with letter "c" -- (see examples below). instrWrap :: forall dt name st. InstrWrapC dt name => Label name -> Instr (AppendCtorField (GetCtorField dt name) st) (ToT dt : st) -- | Wrap a haskell value into a constructor with the given name. -- -- This is symmetric to instrWrap. hsWrap :: forall dt name. InstrWrapC dt name => Label name -> ExtractCtorField (GetCtorField dt name) -> dt -- | Pattern-match on the given datatype. instrCase :: forall dt out inp. InstrCaseC dt => Rec (CaseClause inp out) (CaseClauses dt) -> RemFail Instr (ToT dt : inp) out -- | Lift an instruction to case clause. -- -- You should write out constructor name corresponding to the clause -- explicitly. Prefix constructor name with "c" letter, otherwise your -- label will not be recognized by Haskell parser. Passing constructor -- name can be circumvented but doing so is not recomended as mentioning -- contructor name improves readability and allows avoiding some -- mistakes. (//->) :: Label ("c" `AppendSymbol` ctor) -> RemFail Instr (AppendCtorField x inp) out -> CaseClause inp out ('CaseClauseParam ctor x) infixr 8 //-> -- | Unwrap a constructor with the given name. -- -- Rules which apply to instrWrap function work here as well. -- Although, unlike instrWrap, this function does not work for -- nullary constructors. instrUnwrapUnsafe :: forall dt name st. InstrUnwrapC dt name => Label name -> Instr (ToT dt : st) (ToT (CtorOnlyField name dt) : st) -- | Try to unwrap a constructor with the given name. hsUnwrap :: forall dt name. InstrUnwrapC dt name => Label name -> dt -> Maybe (CtorOnlyField name dt) -- | In what different case branches differ - related constructor name and -- input stack type which the branch starts with. data CaseClauseParam CaseClauseParam :: Symbol -> CtorField -> CaseClauseParam -- | Type information about single case clause. data CaseClause (inp :: [T]) (out :: [T]) (param :: CaseClauseParam) [CaseClause] :: RemFail Instr (AppendCtorField x inp) out -> CaseClause inp out ('CaseClauseParam ctor x) -- | List of CaseClauseParams required to pattern match on the given -- type. type CaseClauses a = GCaseClauses (Rep a) type family GCaseClauses x :: [CaseClauseParam] type family GCaseBranchInput ctor x :: CaseClauseParam -- | Which branch to choose in generic tree representation: left, straight -- or right. S is used when there is one constructor with one -- field (something newtype-like). -- -- The reason why we need S can be explained by this example: data -- A = A1 B | A2 Integer data B = B Bool Now we may search for A1 -- constructor or B constructor. Without S in both cases path will -- be the same ([L]). data Branch L :: Branch S :: Branch R :: Branch -- | Path to a leaf (some field or constructor) in generic tree -- representation. type Path = [Branch] -- | We support only two scenarious - constructor with one field and -- without fields. Nonetheless, it's not that sad since for sum types we -- can't even assign names to fields if there are many (the style guide -- prohibits partial records). data CtorField OneField :: Type -> CtorField NoFields :: CtorField -- | Get something as field of the given constructor. type family ExtractCtorField (cf :: CtorField) -- | Push field to stack, if any. type family AppendCtorField (cf :: CtorField) (l :: [k]) :: [k] -- | To use AppendCtorField not only here for T-based stacks, -- but also later in Lorentz with Type-based stacks we need the -- following property. type AppendCtorFieldAxiom (cf :: CtorField) (st :: [Type]) = ToTs (AppendCtorField cf st) ~ AppendCtorField cf (ToTs st) -- | Proof of AppendCtorFieldAxiom. appendCtorFieldAxiom :: (AppendCtorFieldAxiom ('OneField Word) '[Int], AppendCtorFieldAxiom 'NoFields '[Int]) => Dict (AppendCtorFieldAxiom cf st) -- | Get type of constructor fields (one or zero) referred by given -- datatype and name. type GetCtorField dt ctor = LnrFieldType (GetNamed ctor dt) -- | Expect referred constructor to have only one field (in form of -- constraint) and extract its type. type CtorHasOnlyField ctor dt f = GetCtorField dt ctor ~ 'OneField f -- | Expect referred constructor to have only one field (otherwise compile -- error is raised) and extract its type. type CtorOnlyField name dt = RequireOneField name (GetCtorField dt name) data MyCompoundType -- | Whether given type represents an atomic Michelson value. type family IsPrimitiveValue (x :: Type) :: Bool instance Michelson.Typed.Haskell.Value.IsoValue Michelson.Typed.Haskell.Instr.Sum.MyTypeWithNamedField instance GHC.Generics.Generic Michelson.Typed.Haskell.Instr.Sum.MyTypeWithNamedField instance Michelson.Typed.Haskell.Value.IsoValue Michelson.Typed.Haskell.Instr.Sum.MyEnum instance GHC.Generics.Generic Michelson.Typed.Haskell.Instr.Sum.MyEnum instance Michelson.Typed.Haskell.Value.IsoValue Michelson.Typed.Haskell.Instr.Sum.MyCompoundType instance GHC.Generics.Generic Michelson.Typed.Haskell.Instr.Sum.MyCompoundType instance Michelson.Typed.Haskell.Value.IsoValue Michelson.Typed.Haskell.Instr.Sum.MyType' instance GHC.Generics.Generic Michelson.Typed.Haskell.Instr.Sum.MyType' instance Michelson.Typed.Haskell.Value.IsoValue Michelson.Typed.Haskell.Instr.Sum.MyType instance GHC.Generics.Generic Michelson.Typed.Haskell.Instr.Sum.MyType instance Michelson.Typed.Haskell.Instr.Sum.GInstrUnwrap x path e => Michelson.Typed.Haskell.Instr.Sum.GInstrUnwrap (GHC.Generics.D1 i x) path e instance (Michelson.Typed.Haskell.Instr.Sum.GInstrUnwrap x path e, Michelson.Typed.Haskell.Value.GIsoValue y, Data.Singletons.Internal.SingI (Michelson.Typed.Haskell.Value.GValueType y)) => Michelson.Typed.Haskell.Instr.Sum.GInstrUnwrap (x GHC.Generics.:+: y) ('Michelson.Typed.Haskell.Instr.Helpers.L : path) e instance (Michelson.Typed.Haskell.Instr.Sum.GInstrUnwrap y path e, Michelson.Typed.Haskell.Value.GIsoValue x, Data.Singletons.Internal.SingI (Michelson.Typed.Haskell.Value.GValueType x)) => Michelson.Typed.Haskell.Instr.Sum.GInstrUnwrap (x GHC.Generics.:+: y) ('Michelson.Typed.Haskell.Instr.Helpers.R : path) e instance Michelson.Typed.Haskell.Value.IsoValue e => Michelson.Typed.Haskell.Instr.Sum.GInstrUnwrap (GHC.Generics.C1 c (GHC.Generics.S1 i (GHC.Generics.Rec0 e))) '[ 'Michelson.Typed.Haskell.Instr.Helpers.S] e instance (path GHC.Types.~ (x : xs), Michelson.Typed.Haskell.Instr.Sum.GInstrUnwrap (GHC.Generics.Rep sub) path e, Michelson.Typed.Haskell.Value.GenericIsoValue sub, Michelson.Typed.Haskell.Value.GIsoValue (GHC.Generics.Rep sub)) => Michelson.Typed.Haskell.Instr.Sum.GInstrUnwrap (GHC.Generics.C1 c (GHC.Generics.S1 i (GHC.Generics.Rec0 sub))) ('Michelson.Typed.Haskell.Instr.Helpers.S : x : xs) e instance Michelson.Typed.Haskell.Instr.Sum.GInstrCaseBranch ctor x => Michelson.Typed.Haskell.Instr.Sum.GInstrCase (GHC.Generics.C1 ('GHC.Generics.MetaCons ctor _1 _2) x) instance (Michelson.Typed.Haskell.Value.GIsoValue x, Michelson.Typed.Haskell.Value.GIsoValue y, (TypeError ...)) => Michelson.Typed.Haskell.Instr.Sum.GInstrCaseBranch ctor (x GHC.Generics.:*: y) instance Michelson.Typed.Haskell.Instr.Sum.GInstrCaseBranch ctor x => Michelson.Typed.Haskell.Instr.Sum.GInstrCaseBranch ctor (GHC.Generics.S1 i x) instance Michelson.Typed.Haskell.Value.IsoValue a => Michelson.Typed.Haskell.Instr.Sum.GInstrCaseBranch ctor (GHC.Generics.Rec0 a) instance Michelson.Typed.Haskell.Instr.Sum.GInstrCaseBranch ctor GHC.Generics.U1 instance Michelson.Typed.Haskell.Instr.Sum.GInstrCase x => Michelson.Typed.Haskell.Instr.Sum.GInstrCase (GHC.Generics.D1 i x) instance (Michelson.Typed.Haskell.Instr.Sum.GInstrCase x, Michelson.Typed.Haskell.Instr.Sum.GInstrCase y, Util.Type.RSplit (Michelson.Typed.Haskell.Instr.Sum.GCaseClauses x) (Michelson.Typed.Haskell.Instr.Sum.GCaseClauses y)) => Michelson.Typed.Haskell.Instr.Sum.GInstrCase (x GHC.Generics.:+: y) instance Michelson.Typed.Haskell.Instr.Sum.GInstrWrap x path e => Michelson.Typed.Haskell.Instr.Sum.GInstrWrap (GHC.Generics.D1 i x) path e instance (Michelson.Typed.Haskell.Instr.Sum.GInstrWrap x path e, Michelson.Typed.Haskell.Value.GIsoValue y, Data.Singletons.Internal.SingI (Michelson.Typed.Haskell.Value.GValueType y)) => Michelson.Typed.Haskell.Instr.Sum.GInstrWrap (x GHC.Generics.:+: y) ('Michelson.Typed.Haskell.Instr.Helpers.L : path) e instance (Michelson.Typed.Haskell.Instr.Sum.GInstrWrap y path e, Michelson.Typed.Haskell.Value.GIsoValue x, Data.Singletons.Internal.SingI (Michelson.Typed.Haskell.Value.GValueType x)) => Michelson.Typed.Haskell.Instr.Sum.GInstrWrap (x GHC.Generics.:+: y) ('Michelson.Typed.Haskell.Instr.Helpers.R : path) e instance Michelson.Typed.Haskell.Value.IsoValue e => Michelson.Typed.Haskell.Instr.Sum.GInstrWrap (GHC.Generics.C1 c (GHC.Generics.S1 i (GHC.Generics.Rec0 e))) '[ 'Michelson.Typed.Haskell.Instr.Helpers.S] ('Michelson.Typed.Haskell.Instr.Sum.OneField e) instance (path GHC.Types.~ (x : xs), Michelson.Typed.Haskell.Instr.Sum.GInstrWrap (GHC.Generics.Rep sub) path e, Michelson.Typed.Haskell.Value.GenericIsoValue sub, Michelson.Typed.Haskell.Value.GIsoValue (GHC.Generics.Rep sub)) => Michelson.Typed.Haskell.Instr.Sum.GInstrWrap (GHC.Generics.C1 c (GHC.Generics.S1 i (GHC.Generics.Rec0 sub))) ('Michelson.Typed.Haskell.Instr.Helpers.S : x : xs) e instance Michelson.Typed.Haskell.Instr.Sum.GInstrWrap (GHC.Generics.C1 c GHC.Generics.U1) '[ 'Michelson.Typed.Haskell.Instr.Helpers.S] 'Michelson.Typed.Haskell.Instr.Sum.NoFields -- | Instructions working on product types derived from Haskell ones. module Michelson.Typed.Haskell.Instr.Product -- | Constraint for instrGetField. type InstrGetFieldC dt name = (GenericIsoValue dt, GInstrGet name (Rep dt) (LnrBranch (GetNamed name dt)) (LnrFieldType (GetNamed name dt))) -- | Constraint for instrSetField. type InstrSetFieldC dt name = (GenericIsoValue dt, GInstrSetField name (Rep dt) (LnrBranch (GetNamed name dt)) (LnrFieldType (GetNamed name dt))) -- | Constraint for instrConstruct. type InstrConstructC dt = (GenericIsoValue dt, GInstrConstruct (Rep dt)) -- | Make an instruction which accesses given field of the given datatype. instrGetField :: forall dt name st. InstrGetFieldC dt name => Label name -> Instr (ToT dt : st) (ToT (GetFieldType dt name) : st) -- | For given complex type dt and its field fieldTy -- update the field value. instrSetField :: forall dt name st. InstrSetFieldC dt name => Label name -> Instr (ToT (GetFieldType dt name) : (ToT dt : st)) (ToT dt : st) -- | For given complex type dt and its field fieldTy -- update the field value. instrConstruct :: forall dt st. InstrConstructC dt => Rec (FieldConstructor st) (ConstructorFieldTypes dt) -> Instr st (ToT dt : st) -- | Get type of field by datatype it is contained in and field name. type GetFieldType dt name = LnrFieldType (GetNamed name dt) -- | Types of all fields in a datatype. type ConstructorFieldTypes dt = GFieldTypes (Rep dt) -- | Way to construct one of the fields in a complex datatype. newtype FieldConstructor (st :: [k]) (field :: Type) FieldConstructor :: Instr (ToTs' st) (ToT field : ToTs' st) -> FieldConstructor (st :: [k]) (field :: Type) instance Michelson.Typed.Haskell.Value.IsoValue Michelson.Typed.Haskell.Instr.Product.MyType2 instance GHC.Generics.Generic Michelson.Typed.Haskell.Instr.Product.MyType2 instance Michelson.Typed.Haskell.Instr.Product.GInstrConstruct x => Michelson.Typed.Haskell.Instr.Product.GInstrConstruct (GHC.Generics.M1 t i x) instance (Michelson.Typed.Haskell.Instr.Product.GInstrConstruct x, Michelson.Typed.Haskell.Instr.Product.GInstrConstruct y, Util.Type.RSplit (Michelson.Typed.Haskell.Instr.Product.GFieldTypes x) (Michelson.Typed.Haskell.Instr.Product.GFieldTypes y)) => Michelson.Typed.Haskell.Instr.Product.GInstrConstruct (x GHC.Generics.:*: y) instance Michelson.Typed.Haskell.Instr.Product.GInstrConstruct GHC.Generics.U1 instance ((TypeError ...), Michelson.Typed.Haskell.Value.GIsoValue x, Michelson.Typed.Haskell.Value.GIsoValue y) => Michelson.Typed.Haskell.Instr.Product.GInstrConstruct (x GHC.Generics.:+: y) instance Michelson.Typed.Haskell.Value.IsoValue a => Michelson.Typed.Haskell.Instr.Product.GInstrConstruct (GHC.Generics.Rec0 a) instance Michelson.Typed.Haskell.Instr.Product.GInstrSetField name x path f => Michelson.Typed.Haskell.Instr.Product.GInstrSetField name (GHC.Generics.M1 t i x) path f instance (Michelson.Typed.Haskell.Value.IsoValue f, Michelson.Typed.Haskell.Value.ToT f GHC.Types.~ Michelson.Typed.Haskell.Value.ToT f') => Michelson.Typed.Haskell.Instr.Product.GInstrSetField name (GHC.Generics.Rec0 f) '[] f' instance (Michelson.Typed.Haskell.Instr.Product.GInstrSetField name x path f, Michelson.Typed.Haskell.Value.GIsoValue y) => Michelson.Typed.Haskell.Instr.Product.GInstrSetField name (x GHC.Generics.:*: y) ('Michelson.Typed.Haskell.Instr.Helpers.L : path) f instance (Michelson.Typed.Haskell.Instr.Product.GInstrSetField name y path f, Michelson.Typed.Haskell.Value.GIsoValue x) => Michelson.Typed.Haskell.Instr.Product.GInstrSetField name (x GHC.Generics.:*: y) ('Michelson.Typed.Haskell.Instr.Helpers.R : path) f instance Michelson.Typed.Haskell.Instr.Product.GInstrGet name x path f => Michelson.Typed.Haskell.Instr.Product.GInstrGet name (GHC.Generics.M1 t i x) path f instance (Michelson.Typed.Haskell.Value.IsoValue f, Michelson.Typed.Haskell.Value.ToT f GHC.Types.~ Michelson.Typed.Haskell.Value.ToT f') => Michelson.Typed.Haskell.Instr.Product.GInstrGet name (GHC.Generics.Rec0 f) '[] f' instance (Michelson.Typed.Haskell.Instr.Product.GInstrGet name x path f, Michelson.Typed.Haskell.Value.GIsoValue y) => Michelson.Typed.Haskell.Instr.Product.GInstrGet name (x GHC.Generics.:*: y) ('Michelson.Typed.Haskell.Instr.Helpers.L : path) f instance (Michelson.Typed.Haskell.Instr.Product.GInstrGet name y path f, Michelson.Typed.Haskell.Value.GIsoValue x) => Michelson.Typed.Haskell.Instr.Product.GInstrGet name (x GHC.Generics.:*: y) ('Michelson.Typed.Haskell.Instr.Helpers.R : path) f module Michelson.Typed.Haskell.Instr -- | Representation of Haskell sum types via loosy typed Michelson values, -- useful for e.g. errors and enums. -- -- In particular, ADT sum can be represented as constructor name + data -- it carries. Such expression does not have particular type because -- different constructors may carry different data, and we avoid lifting -- this data to a union in order to keep only the significant parts (and -- thus not to confuse the client). module Michelson.Typed.Haskell.LooseSum -- | Possible outcomes of an attempt to construct a Haskell ADT value from -- constructor name and relevant data. data ComposeResult a -- | Composed fine. ComposeOk :: a -> ComposeResult a -- | No constructor with such name. ComposeCtorNotFound :: ComposeResult a -- | Found required constructor, but type of data does not correspond to -- provided one. ComposeFieldTypeMismatch :: TypeRep -> TypeRep -> ComposeResult a -- | Inverse to toTaggedVal. fromTaggedVal :: LooseSumC dt => (Text, SomeValue) -> ComposeResult dt -- | Decompose Haskell type into constructor name and data it carries, -- converting the latter into Michelson Value. toTaggedVal :: LooseSumC dt => dt -> (Text, SomeValue) -- | Constraint for hsDecompose and hsCompose. type LooseSumC dt = (Generic dt, GLooseSum (Rep dt)) instance GHC.Base.Functor Michelson.Typed.Haskell.LooseSum.ComposeResult instance (Michelson.Typed.Haskell.LooseSum.GAccessField x, GHC.TypeLits.KnownSymbol ctor) => Michelson.Typed.Haskell.LooseSum.GLooseSum (GHC.Generics.C1 ('GHC.Generics.MetaCons ctor f o) x) instance Michelson.Typed.Haskell.LooseSum.GAccessField x => Michelson.Typed.Haskell.LooseSum.GAccessField (GHC.Generics.S1 i x) instance (Data.Typeable.Internal.Typeable a, Michelson.Typed.Haskell.Value.IsoValue a, Data.Typeable.Internal.Typeable (Michelson.Typed.Haskell.Value.ToT a), Data.Singletons.Internal.SingI (Michelson.Typed.Haskell.Value.ToT a)) => Michelson.Typed.Haskell.LooseSum.GAccessField (GHC.Generics.Rec0 a) instance Michelson.Typed.Haskell.LooseSum.GAccessField GHC.Generics.U1 instance (TypeError ...) => Michelson.Typed.Haskell.LooseSum.GAccessField (x GHC.Generics.:*: y) instance Michelson.Typed.Haskell.LooseSum.GLooseSum x => Michelson.Typed.Haskell.LooseSum.GLooseSum (GHC.Generics.D1 i x) instance (Michelson.Typed.Haskell.LooseSum.GLooseSum x, Michelson.Typed.Haskell.LooseSum.GLooseSum y) => Michelson.Typed.Haskell.LooseSum.GLooseSum (x GHC.Generics.:+: y) instance Michelson.Typed.Haskell.LooseSum.GLooseSum GHC.Generics.V1 instance GHC.Base.Semigroup (Michelson.Typed.Haskell.LooseSum.ComposeResult a) instance GHC.Base.Monoid (Michelson.Typed.Haskell.LooseSum.ComposeResult a) -- | Documentation of types appearing in contracts. module Michelson.Typed.Haskell.Doc -- | Stands for representation of some Haskell ADT corresponding to -- Michelson value. Type parameter a is what you put in place of -- each field of the datatype, e.g. information about field type. -- -- Outer list layer corresponds to union, and the inner one corresponds -- to products within constructors. Constructors and fields names are -- present. type ADTRep a = NonEmpty (Text, [(Maybe Text, a)]) -- | Whether given text should be rendered grouped in parentheses (if they -- make sense). newtype WithinParens WithinParens :: Bool -> WithinParens -- | Description for a Haskell type appearing in documentation. class Typeable a => TypeHasDoc a -- | Name of type as it appears in definitions section. -- -- Each type must have its own unique name because it will be used in -- identifier for references. -- -- Default definition derives name from Generics. If it does not fit, -- consider defining this function manually. (We tried using Data -- for this, but it produces names including module names which is not do -- we want). typeDocName :: TypeHasDoc a => Proxy a -> Text -- | Name of type as it appears in definitions section. -- -- Each type must have its own unique name because it will be used in -- identifier for references. -- -- Default definition derives name from Generics. If it does not fit, -- consider defining this function manually. (We tried using Data -- for this, but it produces names including module names which is not do -- we want). typeDocName :: (TypeHasDoc a, Generic a, KnownSymbol (GenericTypeName a)) => Proxy a -> Text -- | Explanation of a type. Markdown formatting is allowed. typeDocMdDescription :: TypeHasDoc a => Markdown -- | How reference to this type is rendered, in Markdown. -- -- Examples: * Integer, * Maybe -- (). -- -- Consider using one of the following functions as default -- implementation; which one to use depends on number of type arguments -- in your type: * homomorphicTypeDocMdReference * -- poly1TypeDocMdReference * poly2TypeDocMdReference -- -- If none of them fits your purposes precisely, consider using -- customTypeDocMdReference. typeDocMdReference :: TypeHasDoc a => Proxy a -> WithinParens -> Markdown -- | How reference to this type is rendered, in Markdown. -- -- Examples: * Integer, * Maybe -- (). -- -- Consider using one of the following functions as default -- implementation; which one to use depends on number of type arguments -- in your type: * homomorphicTypeDocMdReference * -- poly1TypeDocMdReference * poly2TypeDocMdReference -- -- If none of them fits your purposes precisely, consider using -- customTypeDocMdReference. typeDocMdReference :: (TypeHasDoc a, Typeable a, IsHomomorphic a) => Proxy a -> WithinParens -> Markdown -- | All types which this type directly contains. -- -- Used in automatic types discovery. typeDocDependencies :: TypeHasDoc a => Proxy a -> [SomeTypeWithDoc] -- | All types which this type directly contains. -- -- Used in automatic types discovery. typeDocDependencies :: (TypeHasDoc a, Generic a, GTypeHasDoc (Rep a)) => Proxy a -> [SomeTypeWithDoc] -- | For complex types - their immediate Haskell representation. -- -- For primitive types set this to Nothing. -- -- For homomorphic types use homomorphicTypeDocHaskellRep -- implementation. -- -- For polymorhpic types consider using concreteTypeDocHaskellRep -- as implementation. -- -- Modifier haskellRepNoFields can be used to hide names of -- fields, beneficial for newtypes. -- -- Another modifier called haskellRepStripFieldPrefix can be used -- for datatypes to leave only meaningful part of name in every field. typeDocHaskellRep :: TypeHasDoc a => TypeDocHaskellRep a -- | For complex types - their immediate Haskell representation. -- -- For primitive types set this to Nothing. -- -- For homomorphic types use homomorphicTypeDocHaskellRep -- implementation. -- -- For polymorhpic types consider using concreteTypeDocHaskellRep -- as implementation. -- -- Modifier haskellRepNoFields can be used to hide names of -- fields, beneficial for newtypes. -- -- Another modifier called haskellRepStripFieldPrefix can be used -- for datatypes to leave only meaningful part of name in every field. typeDocHaskellRep :: (TypeHasDoc a, Generic a, GTypeHasDoc (Rep a), IsHomomorphic a) => TypeDocHaskellRep a -- | Final michelson representation of a type. -- -- For homomorphic types use homomorphicTypeDocMichelsonRep -- implementation. -- -- For polymorhpic types consider using -- concreteTypeDocMichelsonRep as implementation. typeDocMichelsonRep :: TypeHasDoc a => TypeDocMichelsonRep a -- | Final michelson representation of a type. -- -- For homomorphic types use homomorphicTypeDocMichelsonRep -- implementation. -- -- For polymorhpic types consider using -- concreteTypeDocMichelsonRep as implementation. typeDocMichelsonRep :: (TypeHasDoc a, SingI (ToT a), IsHomomorphic a) => TypeDocMichelsonRep a -- | Signature of typeDocHaskellRep function. -- -- When value is Just, it contains types which this type is built -- from. -- -- First element of provided pair may contain name a concrete type which -- has the same type constructor as a (or just a for -- homomorphic types), and the second element of the pair - its unfolding -- in Haskell. -- -- For example, for some newtype MyNewtype = MyNewtype (Integer, -- Natural) we would not specify the first element in the pair -- because MyNewtype is already a concrete type, and second -- element would contain (Integer, Natural). For polymorhpic -- types like newtype MyPolyNewtype a = MyPolyNewtype (Text, a), -- we want to describe its representation on some example of a, -- because working with type variables is too non-trivial; so the first -- element of the pair may be e.g. "MyPolyNewType Integer", and -- the second one shows that it unfolds to (Text, Integer). -- -- When rendered, values of this type look like: * (Integer, -- Natural) - for homomorphic type. * MyError Integer = (Text, -- Integer) - concrete sample for polymorhpic type. type TypeDocHaskellRep a = Proxy a -> Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc) -- | Signature of typeDocMichelsonRep function. -- -- As in TypeDocHaskellRep, set the first element of the pair to -- Nothing for primitive types, otherwise it stands as some -- instantiation of a type, and its Michelson representation is given in -- the second element of the pair. -- -- Examples of rendered representation: * pair int nat - for -- homomorphic type. * MyError Integer = pair string int - -- concrete sample for polymorhpic type. type TypeDocMichelsonRep a = Proxy a -> (Maybe DocTypeRepLHS, T) -- | Constraint, required when deriving TypeHasDoc for polymorphic -- type with the least possible number of methods defined manually. type PolyTypeHasDocC ts = Each '[TypeHasDoc] ts -- | Data hides some type implementing TypeHasDoc. data SomeTypeWithDoc [SomeTypeWithDoc] :: TypeHasDoc td => Proxy td -> SomeTypeWithDoc -- | Like typeDocDependencies but returns values of more common type -- which is used in docItemDependencies. typeDocDependencies' :: TypeHasDoc a => Proxy a -> [SomeDocDefinitionItem] -- | Require two types to be built from the same type constructor. -- -- E.g. HaveCommonTypeCtor (Maybe Integer) (Maybe Natural) is -- defined, while HaveCmmonTypeCtor (Maybe Integer) [Integer] is -- not. class HaveCommonTypeCtor a b -- | Require this type to be homomorphic. class IsHomomorphic a -- | Implement typeDocDependencies via getting all immediate fields -- of a datatype. -- -- Note: this will not include phantom types, I'm not sure yet how this -- scenario should be handled (@martoon). genericTypeDocDependencies :: forall a. (Generic a, GTypeHasDoc (Rep a)) => Proxy a -> [SomeTypeWithDoc] -- | Render a reference to a type which consists of type constructor (you -- have to provide name of this type constructor and documentation for -- the whole type) and zero or more type arguments. customTypeDocMdReference :: (Text, DType) -> [DType] -> WithinParens -> Markdown -- | Derive typeDocMdReference, for homomorphic types only. homomorphicTypeDocMdReference :: forall (t :: Type). (Typeable t, TypeHasDoc t, IsHomomorphic t) => Proxy t -> WithinParens -> Markdown -- | Derive typeDocMdReference, for polymorphic type with one type -- argument, like Maybe Integer. poly1TypeDocMdReference :: forall t (r :: Type) (a :: Type). (r ~ t a, Typeable t, Each '[TypeHasDoc] [r, a], IsHomomorphic t) => Proxy r -> WithinParens -> Markdown -- | Derive typeDocMdReference, for polymorphic type with two type -- arguments, like Lambda Integer Natural. poly2TypeDocMdReference :: forall t (r :: Type) (a :: Type) (b :: Type). (r ~ t a b, Typeable t, Each '[TypeHasDoc] [r, a, b], IsHomomorphic t) => Proxy r -> WithinParens -> Markdown -- | Implement typeDocHaskellRep for a homomorphic type. -- -- Note that it does not require your type to be of IsHomomorphic -- instance, which can be useful for some polymorhpic types which, for -- documentation purposes, we want to consider homomorphic. Example: -- Operation is in fact polymorhpic, but we don't want this fact -- to be reflected in the documentation. homomorphicTypeDocHaskellRep :: forall a. (Generic a, GTypeHasDoc (Rep a)) => TypeDocHaskellRep a -- | Implement typeDocHaskellRep on example of given concrete type. -- -- This is a best effort attempt to implement typeDocHaskellRep -- for polymorhpic types, as soon as there is no simple way to preserve -- type variables when automatically deriving Haskell representation of a -- type. concreteTypeDocHaskellRep :: forall a b. (Typeable a, GenericIsoValue a, GTypeHasDoc (Rep a), HaveCommonTypeCtor b a) => TypeDocHaskellRep b -- | Version of concreteTypeDocHaskellRep which does not ensure -- whether the type for which representation is built is any similar to -- the original type which you implement a TypeHasDoc instance -- for. concreteTypeDocHaskellRepUnsafe :: forall a b. (Typeable a, GenericIsoValue a, GTypeHasDoc (Rep a)) => TypeDocHaskellRep b -- | Erase fields from Haskell datatype representation. -- -- Use this when rendering fields names is undesired. haskellRepNoFields :: TypeDocHaskellRep a -> TypeDocHaskellRep a -- | Cut fields prefixes which we use according to the style guide. -- -- E.g. cmMyField field will be transformed to myField. haskellRepStripFieldPrefix :: HasCallStack => TypeDocHaskellRep a -> TypeDocHaskellRep a -- | Implement typeDocMichelsonRep for homomorphic type. homomorphicTypeDocMichelsonRep :: forall a. SingI (ToT a) => TypeDocMichelsonRep a -- | Implement typeDocMichelsonRep on example of given concrete -- type. -- -- This function exists for the same reason as -- concreteTypeDocHaskellRep. concreteTypeDocMichelsonRep :: forall a b. (Typeable a, SingI (ToT a), HaveCommonTypeCtor b a) => TypeDocMichelsonRep b -- | Version of concreteTypeDocHaskellRepUnsafe which does not -- ensure whether the type for which representation is built is any -- similar to the original type which you implement a TypeHasDoc -- instance for. concreteTypeDocMichelsonRepUnsafe :: forall a b. (Typeable a, SingI (ToT a)) => TypeDocMichelsonRep b -- | Doc element with description of a type. data DType [DType] :: TypeHasDoc a => Proxy a -> DType -- | Doc element with description of contract storage type. newtype DStorageType DStorageType :: DType -> DStorageType -- | Generic traversal for automatic deriving of some methods in -- TypeHasDoc. class GTypeHasDoc (x :: Type -> Type) -- | Show given ADTRep in a neat way. buildADTRep :: forall a. (WithinParens -> a -> Markdown) -> ADTRep a -> Markdown applyWithinParens :: WithinParens -> Markdown -> Markdown instance GHC.Generics.Generic Michelson.Typed.Haskell.Doc.DStorageType instance Formatting.Buildable.Buildable Michelson.Typed.Haskell.Doc.DocTypeRepLHS instance Data.String.IsString Michelson.Typed.Haskell.Doc.DocTypeRepLHS instance Michelson.Typed.Haskell.Doc.PolyCTypeHasDocC '[a] => Michelson.Typed.Haskell.Doc.TypeHasDoc (Data.Set.Internal.Set a) instance (Michelson.Typed.Haskell.Doc.PolyCTypeHasDocC '[k], Michelson.Typed.Haskell.Doc.PolyTypeHasDocC '[v], GHC.Classes.Ord k) => Michelson.Typed.Haskell.Doc.TypeHasDoc (Data.Map.Internal.Map k v) instance (Michelson.Typed.Haskell.Doc.PolyCTypeHasDocC '[k], Michelson.Typed.Haskell.Doc.PolyTypeHasDocC '[v], GHC.Classes.Ord k) => Michelson.Typed.Haskell.Doc.TypeHasDoc (Michelson.Typed.Haskell.Value.BigMap k v) instance Michelson.Typed.Haskell.Doc.PolyTypeHasDocC '[a] => Michelson.Typed.Haskell.Doc.TypeHasDoc [a] instance Michelson.Typed.Haskell.Doc.PolyTypeHasDocC '[a] => Michelson.Typed.Haskell.Doc.TypeHasDoc (GHC.Maybe.Maybe a) instance Michelson.Typed.Haskell.Doc.PolyTypeHasDocC '[l, r] => Michelson.Typed.Haskell.Doc.TypeHasDoc (Data.Either.Either l r) instance Michelson.Typed.Haskell.Doc.PolyTypeHasDocC '[a, b] => Michelson.Typed.Haskell.Doc.TypeHasDoc (a, b) instance Michelson.Typed.Haskell.Doc.PolyTypeHasDocC '[cp] => Michelson.Typed.Haskell.Doc.TypeHasDoc (Michelson.Typed.Haskell.Value.ContractRef cp) instance Michelson.Typed.Haskell.Doc.PolyTypeHasDocC '[a, b, c] => Michelson.Typed.Haskell.Doc.TypeHasDoc (a, b, c) instance Michelson.Typed.Haskell.Doc.PolyTypeHasDocC '[a, b, c, d] => Michelson.Typed.Haskell.Doc.TypeHasDoc (a, b, c, d) instance Michelson.Typed.Haskell.Doc.PolyTypeHasDocC '[a, b, c, d, e] => Michelson.Typed.Haskell.Doc.TypeHasDoc (a, b, c, d, e) instance Michelson.Typed.Haskell.Doc.PolyTypeHasDocC '[a, b, c, d, e, f] => Michelson.Typed.Haskell.Doc.TypeHasDoc (a, b, c, d, e, f) instance Michelson.Typed.Haskell.Doc.PolyTypeHasDocC '[a, b, c, d, e, f, g] => Michelson.Typed.Haskell.Doc.TypeHasDoc (a, b, c, d, e, f, g) instance (Michelson.Typed.Haskell.Doc.GProductHasDoc x, GHC.TypeLits.KnownSymbol ctor) => Michelson.Typed.Haskell.Doc.GTypeHasDoc (GHC.Generics.C1 ('GHC.Generics.MetaCons ctor _1 _2) x) instance (Michelson.Typed.Haskell.Doc.GProductHasDoc x, Michelson.Typed.Haskell.Doc.GProductHasDoc y) => Michelson.Typed.Haskell.Doc.GProductHasDoc (x GHC.Generics.:*: y) instance Michelson.Typed.Haskell.Doc.TypeHasDoc a => Michelson.Typed.Haskell.Doc.GProductHasDoc (GHC.Generics.S1 ('GHC.Generics.MetaSel 'GHC.Maybe.Nothing _1 _2 _3) (GHC.Generics.Rec0 a)) instance (Michelson.Typed.Haskell.Doc.TypeHasDoc a, GHC.TypeLits.KnownSymbol field) => Michelson.Typed.Haskell.Doc.GProductHasDoc (GHC.Generics.S1 ('GHC.Generics.MetaSel ('GHC.Maybe.Just field) _1 _2 _3) (GHC.Generics.Rec0 a)) instance Michelson.Typed.Haskell.Doc.GProductHasDoc GHC.Generics.U1 instance Michelson.Doc.DocItem Michelson.Typed.Haskell.Doc.DStorageType instance GHC.Show.Show Michelson.Typed.Haskell.Doc.DType instance GHC.Classes.Eq Michelson.Typed.Haskell.Doc.DType instance GHC.Classes.Ord Michelson.Typed.Haskell.Doc.DType instance Michelson.Doc.DocItem Michelson.Typed.Haskell.Doc.DType instance Michelson.Typed.Haskell.Doc.TypeHasDoc Michelson.Text.MText instance Michelson.Typed.Haskell.Doc.TypeHasDoc Michelson.Typed.Aliases.Operation instance Michelson.Typed.Haskell.Doc.GTypeHasDoc x => Michelson.Typed.Haskell.Doc.GTypeHasDoc (GHC.Generics.D1 i x) instance (Michelson.Typed.Haskell.Doc.GTypeHasDoc x, Michelson.Typed.Haskell.Doc.GTypeHasDoc y) => Michelson.Typed.Haskell.Doc.GTypeHasDoc (x GHC.Generics.:+: y) instance (TypeError ...) => Michelson.Typed.Haskell.Doc.GTypeHasDoc GHC.Generics.V1 instance Michelson.Typed.Haskell.Doc.TypeHasDoc GHC.Integer.Type.Integer instance Michelson.Typed.Haskell.Doc.TypeHasDoc GHC.Natural.Natural instance Michelson.Typed.Haskell.Doc.TypeHasDoc GHC.Types.Bool instance Michelson.Typed.Haskell.Doc.TypeHasDoc Data.ByteString.Internal.ByteString instance Michelson.Typed.Haskell.Doc.TypeHasDoc Tezos.Core.Mutez instance Michelson.Typed.Haskell.Doc.TypeHasDoc Tezos.Crypto.KeyHash instance Michelson.Typed.Haskell.Doc.TypeHasDoc Tezos.Core.Timestamp instance Michelson.Typed.Haskell.Doc.TypeHasDoc Tezos.Address.Address instance Michelson.Typed.Haskell.Doc.TypeHasDoc Michelson.Typed.EntryPoints.EpAddress instance Michelson.Typed.Haskell.Doc.TypeHasDoc Tezos.Crypto.PublicKey instance Michelson.Typed.Haskell.Doc.TypeHasDoc Tezos.Crypto.Signature instance Michelson.Typed.Haskell.Doc.TypeHasDoc () instance (Michelson.Typed.Haskell.Doc.TypeHasDoc (Util.Named.ApplyNamedFunctor f a), GHC.TypeLits.KnownSymbol n, Data.Singletons.Internal.SingI (Michelson.Typed.Haskell.Value.ToT (Util.Named.ApplyNamedFunctor f GHC.Integer.Type.Integer)), Data.Typeable.Internal.Typeable f, Data.Typeable.Internal.Typeable a) => Michelson.Typed.Haskell.Doc.TypeHasDoc (Named.Internal.NamedF f a n) instance forall k1 k2 (a :: k1 -> k2) (b :: k1). (TypeError ...) => Michelson.Typed.Haskell.Doc.IsHomomorphic (a b) instance forall k (a :: k). Michelson.Typed.Haskell.Doc.IsHomomorphic a instance forall k1 k2 k3 k4 (ac :: k1 -> k2) (bc :: k3 -> k4) (a :: k1) (b :: k3). Michelson.Typed.Haskell.Doc.HaveCommonTypeCtor ac bc => Michelson.Typed.Haskell.Doc.HaveCommonTypeCtor (ac a) (bc b) instance forall k (a :: k). Michelson.Typed.Haskell.Doc.HaveCommonTypeCtor a a -- | Haskell-Michelson conversions. module Michelson.Typed.Haskell -- | Values of type Dict p capture a dictionary for a -- constraint of type p. -- -- e.g. -- --
-- Dict :: Dict (Eq Int) ---- -- captures a dictionary that proves we have an: -- --
-- instance Eq 'Int ---- -- Pattern matching on the Dict constructor will bring this -- instance into scope. data Dict a [Dict] :: forall a. a => Dict a -- | Path to a leaf (some field or constructor) in generic tree -- representation. type Path = [Branch] -- | Which branch to choose in generic tree representation: left, straight -- or right. S is used when there is one constructor with one -- field (something newtype-like). -- -- The reason why we need S can be explained by this example: data -- A = A1 B | A2 Integer data B = B Bool Now we may search for A1 -- constructor or B constructor. Without S in both cases path will -- be the same ([L]). data Branch L :: Branch S :: Branch R :: Branch -- | This class encodes Michelson rules w.r.t where it requires comparable -- types. Earlier we had a dedicated type for representing comparable -- types CT. But then we integreated those types into -- T. This meant that some of the types that could be formed -- with various combinations of T would be illegal as per -- Michelson typing rule. Using this class, we inductively enforce that a -- type and all types it contains are well typed as per Michelson's -- rules. class WellTyped (t :: T) -- | Isomorphism between Michelson stack and its Haskell reflection. class IsoValuesStack (ts :: [Type]) toValStack :: IsoValuesStack ts => Rec Identity ts -> Rec Value (ToTs ts) fromValStack :: IsoValuesStack ts => Rec Value (ToTs ts) -> Rec Identity ts -- | Overloaded version of ToTs to work on Haskell and T -- stacks. type family ToTs' (t :: [k]) :: [T] -- | Type function to convert a Haskell stack type to T-based one. type family ToTs (ts :: [Type]) :: [T] -- | Whether Michelson representation of the type is derived via Generics. type GenericIsoValue t = (IsoValue t, Generic t, ToT t ~ GValueType (Rep t)) newtype BigMap k v BigMap :: Map k v -> BigMap k v [unBigMap] :: BigMap k v -> Map k v -- | Since Contract name is used to designate contract code, lets -- call analogy of TContract type as follows. -- -- Note that type argument always designates an argument of entrypoint. -- If a contract has explicit default entrypoint (and no root -- entrypoint), ContractRef referring to it can never have the -- entire parameter as its type argument. data ContractRef (arg :: Type) ContractRef :: Address -> SomeEntryPointCall arg -> ContractRef (arg :: Type) [crAddress] :: ContractRef (arg :: Type) -> Address [crEntryPoint] :: ContractRef (arg :: Type) -> SomeEntryPointCall arg type WellTypedIsoValue a = (WellTyped (ToT a), IsoValue a) type WellTypedToT a = WellTyped (ToT a) type SomeEntryPointCall arg = SomeEntryPointCallT (ToT arg) type EntryPointCall param arg = EntryPointCallT (ToT param) (ToT arg) -- | Any Haskell value which can be converted to Michelson Value. newtype AnyIsoValue AnyIsoValue :: (forall a. IsoValue a => a) -> AnyIsoValue -- | Hides some Haskell value put in line with Michelson Value. data SomeIsoValue [SomeIsoValue] :: (Typeable a, IsoValue a) => a -> SomeIsoValue -- | Overloaded version of ToT to work on Haskell and T -- types. type family ToT' (t :: k) :: T -- | Isomorphism between Michelson values and plain Haskell types. -- -- Default implementation of this typeclass converts ADTs to Michelson -- "pair"s and "or"s. class (WellTypedToT a) => IsoValue a where { -- | Type function that converts a regular Haskell type into a T -- type. type family ToT a :: T; type ToT a = GValueType (Rep a); } -- | Converts a Haskell structure into Value representation. toVal :: IsoValue a => a -> Value (ToT a) -- | Converts a Haskell structure into Value representation. toVal :: (IsoValue a, Generic a, GIsoValue (Rep a), ToT a ~ GValueType (Rep a)) => a -> Value (ToT a) -- | Converts a Value into Haskell type. fromVal :: IsoValue a => Value (ToT a) -> a -- | Converts a Value into Haskell type. fromVal :: (IsoValue a, Generic a, GIsoValue (Rep a), ToT a ~ GValueType (Rep a)) => Value (ToT a) -> a -- | Replace type argument of ContractAddr with isomorphic one. coerceContractRef :: ToT a ~ ToT b => ContractRef a -> ContractRef b contractRefToAddr :: ContractRef cp -> EpAddress totsKnownLemma :: forall s. KnownList s :- KnownList (ToTs s) totsAppendLemma :: forall a b. KnownList a => Dict (ToTs (a ++ b) ~ (ToTs a ++ ToTs b)) type InstrUnwrapC dt name = (GenericIsoValue dt, GInstrUnwrap (Rep dt) (LnrBranch (GetNamed name dt)) (CtorOnlyField name dt)) type family GCaseBranchInput ctor x :: CaseClauseParam type family GCaseBranchInput ctor x :: CaseClauseParam type family GCaseClauses x :: [CaseClauseParam] type family GCaseClauses x :: [CaseClauseParam] -- | List of CaseClauseParams required to pattern match on the given -- type. type CaseClauses a = GCaseClauses (Rep a) -- | Type information about single case clause. data CaseClause (inp :: [T]) (out :: [T]) (param :: CaseClauseParam) [CaseClause] :: RemFail Instr (AppendCtorField x inp) out -> CaseClause inp out ('CaseClauseParam ctor x) -- | In what different case branches differ - related constructor name and -- input stack type which the branch starts with. data CaseClauseParam CaseClauseParam :: Symbol -> CtorField -> CaseClauseParam type InstrCaseC dt = (GenericIsoValue dt, GInstrCase (Rep dt)) data MyCompoundType type InstrWrapC dt name = (GenericIsoValue dt, GInstrWrap (Rep dt) (LnrBranch (GetNamed name dt)) (LnrFieldType (GetNamed name dt))) -- | Expect referred constructor to have only one field (otherwise compile -- error is raised) and extract its type. type CtorOnlyField name dt = RequireOneField name (GetCtorField dt name) -- | Expect referred constructor to have only one field (in form of -- constraint) and extract its type. type CtorHasOnlyField ctor dt f = GetCtorField dt ctor ~ 'OneField f -- | Get type of constructor fields (one or zero) referred by given -- datatype and name. type GetCtorField dt ctor = LnrFieldType (GetNamed ctor dt) -- | Whether given type represents an atomic Michelson value. type family IsPrimitiveValue (x :: Type) :: Bool -- | To use AppendCtorField not only here for T-based stacks, -- but also later in Lorentz with Type-based stacks we need the -- following property. type AppendCtorFieldAxiom (cf :: CtorField) (st :: [Type]) = ToTs (AppendCtorField cf st) ~ AppendCtorField cf (ToTs st) -- | Push field to stack, if any. type family AppendCtorField (cf :: CtorField) (l :: [k]) :: [k] -- | Get something as field of the given constructor. type family ExtractCtorField (cf :: CtorField) -- | We support only two scenarious - constructor with one field and -- without fields. Nonetheless, it's not that sad since for sum types we -- can't even assign names to fields if there are many (the style guide -- prohibits partial records). data CtorField OneField :: Type -> CtorField NoFields :: CtorField -- | Proof of AppendCtorFieldAxiom. appendCtorFieldAxiom :: (AppendCtorFieldAxiom ('OneField Word) '[Int], AppendCtorFieldAxiom 'NoFields '[Int]) => Dict (AppendCtorFieldAxiom cf st) -- | Wrap given element into a constructor with the given name. -- -- Mentioned constructor must have only one field. -- -- Since labels interpretable by OverloadedLabels extension cannot -- start with capital latter, prepend constructor name with letter "c" -- (see examples below). instrWrap :: forall dt name st. InstrWrapC dt name => Label name -> Instr (AppendCtorField (GetCtorField dt name) st) (ToT dt : st) -- | Wrap a haskell value into a constructor with the given name. -- -- This is symmetric to instrWrap. hsWrap :: forall dt name. InstrWrapC dt name => Label name -> ExtractCtorField (GetCtorField dt name) -> dt -- | Pattern-match on the given datatype. instrCase :: forall dt out inp. InstrCaseC dt => Rec (CaseClause inp out) (CaseClauses dt) -> RemFail Instr (ToT dt : inp) out -- | Lift an instruction to case clause. -- -- You should write out constructor name corresponding to the clause -- explicitly. Prefix constructor name with "c" letter, otherwise your -- label will not be recognized by Haskell parser. Passing constructor -- name can be circumvented but doing so is not recomended as mentioning -- contructor name improves readability and allows avoiding some -- mistakes. (//->) :: Label ("c" `AppendSymbol` ctor) -> RemFail Instr (AppendCtorField x inp) out -> CaseClause inp out ('CaseClauseParam ctor x) infixr 8 //-> -- | Unwrap a constructor with the given name. -- -- Rules which apply to instrWrap function work here as well. -- Although, unlike instrWrap, this function does not work for -- nullary constructors. instrUnwrapUnsafe :: forall dt name st. InstrUnwrapC dt name => Label name -> Instr (ToT dt : st) (ToT (CtorOnlyField name dt) : st) -- | Try to unwrap a constructor with the given name. hsUnwrap :: forall dt name. InstrUnwrapC dt name => Label name -> dt -> Maybe (CtorOnlyField name dt) -- | Constraint for instrConstruct. type InstrConstructC dt = (GenericIsoValue dt, GInstrConstruct (Rep dt)) -- | Types of all fields in a datatype. type ConstructorFieldTypes dt = GFieldTypes (Rep dt) -- | Way to construct one of the fields in a complex datatype. newtype FieldConstructor (st :: [k]) (field :: Type) FieldConstructor :: Instr (ToTs' st) (ToT field : ToTs' st) -> FieldConstructor (st :: [k]) (field :: Type) -- | Constraint for instrSetField. type InstrSetFieldC dt name = (GenericIsoValue dt, GInstrSetField name (Rep dt) (LnrBranch (GetNamed name dt)) (LnrFieldType (GetNamed name dt))) -- | Constraint for instrGetField. type InstrGetFieldC dt name = (GenericIsoValue dt, GInstrGet name (Rep dt) (LnrBranch (GetNamed name dt)) (LnrFieldType (GetNamed name dt))) -- | Get type of field by datatype it is contained in and field name. type GetFieldType dt name = LnrFieldType (GetNamed name dt) -- | Make an instruction which accesses given field of the given datatype. instrGetField :: forall dt name st. InstrGetFieldC dt name => Label name -> Instr (ToT dt : st) (ToT (GetFieldType dt name) : st) -- | For given complex type dt and its field fieldTy -- update the field value. instrSetField :: forall dt name st. InstrSetFieldC dt name => Label name -> Instr (ToT (GetFieldType dt name) : (ToT dt : st)) (ToT dt : st) -- | For given complex type dt and its field fieldTy -- update the field value. instrConstruct :: forall dt st. InstrConstructC dt => Rec (FieldConstructor st) (ConstructorFieldTypes dt) -> Instr st (ToT dt : st) -- | Constraint for hsDecompose and hsCompose. type LooseSumC dt = (Generic dt, GLooseSum (Rep dt)) -- | Possible outcomes of an attempt to construct a Haskell ADT value from -- constructor name and relevant data. data ComposeResult a -- | Composed fine. ComposeOk :: a -> ComposeResult a -- | No constructor with such name. ComposeCtorNotFound :: ComposeResult a -- | Found required constructor, but type of data does not correspond to -- provided one. ComposeFieldTypeMismatch :: TypeRep -> TypeRep -> ComposeResult a -- | Decompose Haskell type into constructor name and data it carries, -- converting the latter into Michelson Value. toTaggedVal :: LooseSumC dt => dt -> (Text, SomeValue) -- | Inverse to toTaggedVal. fromTaggedVal :: LooseSumC dt => (Text, SomeValue) -> ComposeResult dt -- | Constraint, required when deriving TypeHasDoc for polymorphic -- type with the least possible number of methods defined manually. type PolyTypeHasDocC ts = Each '[TypeHasDoc] ts -- | Generic traversal for automatic deriving of some methods in -- TypeHasDoc. class GTypeHasDoc (x :: Type -> Type) -- | Require this type to be homomorphic. class IsHomomorphic a -- | Require two types to be built from the same type constructor. -- -- E.g. HaveCommonTypeCtor (Maybe Integer) (Maybe Natural) is -- defined, while HaveCmmonTypeCtor (Maybe Integer) [Integer] is -- not. class HaveCommonTypeCtor a b -- | Doc element with description of contract storage type. newtype DStorageType DStorageType :: DType -> DStorageType -- | Doc element with description of a type. data DType [DType] :: TypeHasDoc a => Proxy a -> DType -- | Data hides some type implementing TypeHasDoc. data SomeTypeWithDoc [SomeTypeWithDoc] :: TypeHasDoc td => Proxy td -> SomeTypeWithDoc -- | Signature of typeDocMichelsonRep function. -- -- As in TypeDocHaskellRep, set the first element of the pair to -- Nothing for primitive types, otherwise it stands as some -- instantiation of a type, and its Michelson representation is given in -- the second element of the pair. -- -- Examples of rendered representation: * pair int nat - for -- homomorphic type. * MyError Integer = pair string int - -- concrete sample for polymorhpic type. type TypeDocMichelsonRep a = Proxy a -> (Maybe DocTypeRepLHS, T) -- | Signature of typeDocHaskellRep function. -- -- When value is Just, it contains types which this type is built -- from. -- -- First element of provided pair may contain name a concrete type which -- has the same type constructor as a (or just a for -- homomorphic types), and the second element of the pair - its unfolding -- in Haskell. -- -- For example, for some newtype MyNewtype = MyNewtype (Integer, -- Natural) we would not specify the first element in the pair -- because MyNewtype is already a concrete type, and second -- element would contain (Integer, Natural). For polymorhpic -- types like newtype MyPolyNewtype a = MyPolyNewtype (Text, a), -- we want to describe its representation on some example of a, -- because working with type variables is too non-trivial; so the first -- element of the pair may be e.g. "MyPolyNewType Integer", and -- the second one shows that it unfolds to (Text, Integer). -- -- When rendered, values of this type look like: * (Integer, -- Natural) - for homomorphic type. * MyError Integer = (Text, -- Integer) - concrete sample for polymorhpic type. type TypeDocHaskellRep a = Proxy a -> Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc) -- | Description for a Haskell type appearing in documentation. class Typeable a => TypeHasDoc a -- | Name of type as it appears in definitions section. -- -- Each type must have its own unique name because it will be used in -- identifier for references. -- -- Default definition derives name from Generics. If it does not fit, -- consider defining this function manually. (We tried using Data -- for this, but it produces names including module names which is not do -- we want). typeDocName :: TypeHasDoc a => Proxy a -> Text -- | Name of type as it appears in definitions section. -- -- Each type must have its own unique name because it will be used in -- identifier for references. -- -- Default definition derives name from Generics. If it does not fit, -- consider defining this function manually. (We tried using Data -- for this, but it produces names including module names which is not do -- we want). typeDocName :: (TypeHasDoc a, Generic a, KnownSymbol (GenericTypeName a)) => Proxy a -> Text -- | Explanation of a type. Markdown formatting is allowed. typeDocMdDescription :: TypeHasDoc a => Markdown -- | How reference to this type is rendered, in Markdown. -- -- Examples: * Integer, * Maybe -- (). -- -- Consider using one of the following functions as default -- implementation; which one to use depends on number of type arguments -- in your type: * homomorphicTypeDocMdReference * -- poly1TypeDocMdReference * poly2TypeDocMdReference -- -- If none of them fits your purposes precisely, consider using -- customTypeDocMdReference. typeDocMdReference :: TypeHasDoc a => Proxy a -> WithinParens -> Markdown -- | How reference to this type is rendered, in Markdown. -- -- Examples: * Integer, * Maybe -- (). -- -- Consider using one of the following functions as default -- implementation; which one to use depends on number of type arguments -- in your type: * homomorphicTypeDocMdReference * -- poly1TypeDocMdReference * poly2TypeDocMdReference -- -- If none of them fits your purposes precisely, consider using -- customTypeDocMdReference. typeDocMdReference :: (TypeHasDoc a, Typeable a, IsHomomorphic a) => Proxy a -> WithinParens -> Markdown -- | All types which this type directly contains. -- -- Used in automatic types discovery. typeDocDependencies :: TypeHasDoc a => Proxy a -> [SomeTypeWithDoc] -- | All types which this type directly contains. -- -- Used in automatic types discovery. typeDocDependencies :: (TypeHasDoc a, Generic a, GTypeHasDoc (Rep a)) => Proxy a -> [SomeTypeWithDoc] -- | For complex types - their immediate Haskell representation. -- -- For primitive types set this to Nothing. -- -- For homomorphic types use homomorphicTypeDocHaskellRep -- implementation. -- -- For polymorhpic types consider using concreteTypeDocHaskellRep -- as implementation. -- -- Modifier haskellRepNoFields can be used to hide names of -- fields, beneficial for newtypes. -- -- Another modifier called haskellRepStripFieldPrefix can be used -- for datatypes to leave only meaningful part of name in every field. typeDocHaskellRep :: TypeHasDoc a => TypeDocHaskellRep a -- | For complex types - their immediate Haskell representation. -- -- For primitive types set this to Nothing. -- -- For homomorphic types use homomorphicTypeDocHaskellRep -- implementation. -- -- For polymorhpic types consider using concreteTypeDocHaskellRep -- as implementation. -- -- Modifier haskellRepNoFields can be used to hide names of -- fields, beneficial for newtypes. -- -- Another modifier called haskellRepStripFieldPrefix can be used -- for datatypes to leave only meaningful part of name in every field. typeDocHaskellRep :: (TypeHasDoc a, Generic a, GTypeHasDoc (Rep a), IsHomomorphic a) => TypeDocHaskellRep a -- | Final michelson representation of a type. -- -- For homomorphic types use homomorphicTypeDocMichelsonRep -- implementation. -- -- For polymorhpic types consider using -- concreteTypeDocMichelsonRep as implementation. typeDocMichelsonRep :: TypeHasDoc a => TypeDocMichelsonRep a -- | Final michelson representation of a type. -- -- For homomorphic types use homomorphicTypeDocMichelsonRep -- implementation. -- -- For polymorhpic types consider using -- concreteTypeDocMichelsonRep as implementation. typeDocMichelsonRep :: (TypeHasDoc a, SingI (ToT a), IsHomomorphic a) => TypeDocMichelsonRep a -- | Whether given text should be rendered grouped in parentheses (if they -- make sense). newtype WithinParens WithinParens :: Bool -> WithinParens -- | Stands for representation of some Haskell ADT corresponding to -- Michelson value. Type parameter a is what you put in place of -- each field of the datatype, e.g. information about field type. -- -- Outer list layer corresponds to union, and the inner one corresponds -- to products within constructors. Constructors and fields names are -- present. type ADTRep a = NonEmpty (Text, [(Maybe Text, a)]) -- | Show given ADTRep in a neat way. buildADTRep :: forall a. (WithinParens -> a -> Markdown) -> ADTRep a -> Markdown applyWithinParens :: WithinParens -> Markdown -> Markdown -- | Like typeDocDependencies but returns values of more common type -- which is used in docItemDependencies. typeDocDependencies' :: TypeHasDoc a => Proxy a -> [SomeDocDefinitionItem] -- | Render a reference to a type which consists of type constructor (you -- have to provide name of this type constructor and documentation for -- the whole type) and zero or more type arguments. customTypeDocMdReference :: (Text, DType) -> [DType] -> WithinParens -> Markdown -- | Derive typeDocMdReference, for homomorphic types only. homomorphicTypeDocMdReference :: forall (t :: Type). (Typeable t, TypeHasDoc t, IsHomomorphic t) => Proxy t -> WithinParens -> Markdown -- | Derive typeDocMdReference, for polymorphic type with one type -- argument, like Maybe Integer. poly1TypeDocMdReference :: forall t (r :: Type) (a :: Type). (r ~ t a, Typeable t, Each '[TypeHasDoc] [r, a], IsHomomorphic t) => Proxy r -> WithinParens -> Markdown -- | Derive typeDocMdReference, for polymorphic type with two type -- arguments, like Lambda Integer Natural. poly2TypeDocMdReference :: forall t (r :: Type) (a :: Type) (b :: Type). (r ~ t a b, Typeable t, Each '[TypeHasDoc] [r, a, b], IsHomomorphic t) => Proxy r -> WithinParens -> Markdown -- | Implement typeDocDependencies via getting all immediate fields -- of a datatype. -- -- Note: this will not include phantom types, I'm not sure yet how this -- scenario should be handled (@martoon). genericTypeDocDependencies :: forall a. (Generic a, GTypeHasDoc (Rep a)) => Proxy a -> [SomeTypeWithDoc] -- | Implement typeDocHaskellRep for a homomorphic type. -- -- Note that it does not require your type to be of IsHomomorphic -- instance, which can be useful for some polymorhpic types which, for -- documentation purposes, we want to consider homomorphic. Example: -- Operation is in fact polymorhpic, but we don't want this fact -- to be reflected in the documentation. homomorphicTypeDocHaskellRep :: forall a. (Generic a, GTypeHasDoc (Rep a)) => TypeDocHaskellRep a -- | Implement typeDocHaskellRep on example of given concrete type. -- -- This is a best effort attempt to implement typeDocHaskellRep -- for polymorhpic types, as soon as there is no simple way to preserve -- type variables when automatically deriving Haskell representation of a -- type. concreteTypeDocHaskellRep :: forall a b. (Typeable a, GenericIsoValue a, GTypeHasDoc (Rep a), HaveCommonTypeCtor b a) => TypeDocHaskellRep b -- | Version of concreteTypeDocHaskellRep which does not ensure -- whether the type for which representation is built is any similar to -- the original type which you implement a TypeHasDoc instance -- for. concreteTypeDocHaskellRepUnsafe :: forall a b. (Typeable a, GenericIsoValue a, GTypeHasDoc (Rep a)) => TypeDocHaskellRep b -- | Erase fields from Haskell datatype representation. -- -- Use this when rendering fields names is undesired. haskellRepNoFields :: TypeDocHaskellRep a -> TypeDocHaskellRep a -- | Cut fields prefixes which we use according to the style guide. -- -- E.g. cmMyField field will be transformed to myField. haskellRepStripFieldPrefix :: HasCallStack => TypeDocHaskellRep a -> TypeDocHaskellRep a -- | Implement typeDocMichelsonRep for homomorphic type. homomorphicTypeDocMichelsonRep :: forall a. SingI (ToT a) => TypeDocMichelsonRep a -- | Implement typeDocMichelsonRep on example of given concrete -- type. -- -- This function exists for the same reason as -- concreteTypeDocHaskellRep. concreteTypeDocMichelsonRep :: forall a b. (Typeable a, SingI (ToT a), HaveCommonTypeCtor b a) => TypeDocMichelsonRep b -- | Version of concreteTypeDocHaskellRepUnsafe which does not -- ensure whether the type for which representation is built is any -- similar to the original type which you implement a TypeHasDoc -- instance for. concreteTypeDocMichelsonRepUnsafe :: forall a b. (Typeable a, SingI (ToT a)) => TypeDocMichelsonRep b -- | Extracting documentation from instructions set. module Michelson.Typed.Doc -- | Assemble contract documentation. buildInstrDoc :: Instr inp out -> ContractDoc -- | Assemble contract documentation with the revision of the contract. buildInstrDocWithGitRev :: DGitRevision -> Instr inp out -> ContractDoc -- | Recursevly traverse an instruction and modify documentation items -- matching given type. -- -- If mapper returns Nothing, doc item will remain unmodified. modifyInstrDoc :: (DocItem i1, DocItem i2) => (i1 -> Maybe i2) -> Instr inp out -> Instr inp out -- | Modify all documentation items recursively. modifyInstrAllDoc :: (SomeDocItem -> SomeDocItem) -> Instr inp out -> Instr inp out -- | Leave only instructions related to documentation. -- -- Generated documentation for resulting instruction remains the same, -- but semantics of instruction itself gets lost. We have to pass -- optimizer here as an argument to avoid cyclic dependencies. cutInstrNonDoc :: (forall i o. Instr i o -> Instr i o) -> Instr inp out -> Instr s s -- | Put a document item. docInstr :: DocItem di => di -> Instr s s module Michelson.Typed module Michelson.TypeCheck.Types -- | Data type holding type information for stack (Heterogeneous Stack -- Type). -- -- This data type is used along with instruction data type Instr -- to carry information about its input and output stack types. -- -- That is, if there is value instr :: Instr inp out, along with -- this instr one may carry inpHST :: HST inp and -- outHST :: HST out which will contain whole information about -- input and output stack types for instr. -- -- Data type HST is very similar to Data.Vinyl.Rec, but -- is specialized for a particular purpose. In particular, definition of -- HST (t1 ': t2 ': ... tn ': '[]) requires constraints -- (Typeable t1, Typeable t2, ..., Typeable tn) as well as -- constraints (Typeable '[ t1 ], Typeable '[ t1, t2 ], ...). -- These applications of Typeable class are required for -- convenient usage of type encoded by HST ts with some -- functions from Data.Typeable. -- -- Data type HST (Heterogeneous Stack Type) is a heterogenuous -- list of tuples. First element of tuple is a structure, holding field -- and type annotations for a given type. Second element of tuple is an -- optional variable annotation for the stack element. Additionally -- constructor keeps SingI constraint for the current type. data HST (ts :: [T]) [SNil] :: HST '[] [::&] :: (Typeable xs, Typeable x, SingI x) => (Notes x, Dict (WellTyped x), VarAnn) -> HST xs -> HST (x : xs) infixr 7 ::& -- | Append a type to HST, assuming that notes and annotations for -- this type are unknown. (-:&) :: (Typeable xs, Typeable x, SingI x, WellTyped x) => Sing x -> HST xs -> HST (x : xs) infixr 7 -:& -- | Extended pattern-match - adds Sing x argument. pattern (::&+) :: () => (ys ~ (x : xs), Typeable x, SingI x, Typeable xs) => (Sing x, Notes x, Dict (WellTyped x), VarAnn) -> HST xs -> HST ys infixr 7 ::&+ -- | No-argument type wrapper for HST data type. data SomeHST [SomeHST] :: Typeable ts => HST ts -> SomeHST -- | This data type keeps part of type check result - instruction and -- corresponding output stack. data SomeInstrOut inp -- | Type-check result with concrete output stack, most common case. -- -- Output stack type is wrapped inside the type and Typeable -- constraint is provided to allow convenient unwrapping. [:::] :: Typeable out => Instr inp out -> HST out -> SomeInstrOut inp -- | Type-check result which matches against arbitrary output stack. -- Information about annotations in the output stack is absent. -- -- This case is only possible when the corresponding code terminates with -- FAILWITH instruction in all possible executions. The opposite -- may be not true though (example: you push always-failing lambda and -- immediatelly execute it - stack type is known). [AnyOutInstr] :: (forall out. Instr inp out) -> SomeInstrOut inp infix 9 ::: -- | Data type keeping the whole type check result: instruction and type -- representations of instruction's input and output. data SomeInstr inp [:/] :: HST inp -> SomeInstrOut inp -> SomeInstr inp infix 8 :/ data SomeContract [SomeContract] :: FullContract cp st -> SomeContract -- | Set of variables defined in a let-block. data BoundVars BoundVars :: Map Var Type -> Maybe SomeHST -> BoundVars -- | State for type checking nop type TcExtFrames = [BoundVars] -- | Given a type, provide evidence that it is well typed w.r.t to the -- Michelson rules regarding where comparable types are required. getWTP :: forall t. SingI t => Maybe (Dict (WellTyped t)) -- | Given a type and an action that requires evidence that the type is -- well typed, generate the evidence and execute the action, or else fail -- with an error. withWTPm :: forall t m a. (MonadFail m, SingI t) => (WellTyped t => m a) -> m a mapSomeContract :: (forall inp out. Instr inp out -> Instr inp out) -> SomeContract -> SomeContract noBoundVars :: BoundVars instance GHC.Show.Show Michelson.TypeCheck.Types.SomeHST instance GHC.Show.Show Michelson.TypeCheck.Types.SomeContract instance Control.DeepSeq.NFData Michelson.TypeCheck.Types.SomeContract instance GHC.Show.Show (Michelson.Typed.Instr.ExtInstr inp) => GHC.Show.Show (Michelson.TypeCheck.Types.SomeInstr inp) instance GHC.Show.Show (Michelson.Typed.Instr.ExtInstr inp) => GHC.Show.Show (Michelson.TypeCheck.Types.SomeInstrOut inp) instance Control.DeepSeq.NFData Michelson.TypeCheck.Types.SomeHST instance GHC.Classes.Eq Michelson.TypeCheck.Types.SomeHST instance Control.DeepSeq.NFData (Michelson.TypeCheck.Types.HST ts) instance GHC.Show.Show (Michelson.TypeCheck.Types.HST ts) instance Formatting.Buildable.Buildable (Michelson.TypeCheck.Types.HST ts) instance GHC.Classes.Eq (Michelson.TypeCheck.Types.HST ts) -- | Errors that can occur when some code is being typechecked. module Michelson.TypeCheck.Error -- | Description of the instruction which wants more items on stack than -- currently present. data NotEnoughItemsInstr NotEnoughDrop :: NotEnoughItemsInstr NotEnoughDip :: NotEnoughItemsInstr NotEnoughDig :: NotEnoughItemsInstr NotEnoughDug :: NotEnoughItemsInstr -- | Contexts where type error can occur. data TypeContext LambdaArgument :: TypeContext LambdaCode :: TypeContext DipCode :: TypeContext ConsArgument :: TypeContext ComparisonArguments :: TypeContext ContractParameter :: TypeContext ContractStorage :: TypeContext ArithmeticOperation :: TypeContext Iteration :: TypeContext Cast :: TypeContext CarArgument :: TypeContext CdrArgument :: TypeContext If :: TypeContext ConcatArgument :: TypeContext ContainerKeyType :: TypeContext ContainerValueType :: TypeContext -- | Data type that represents various errors which are related to type -- system. These errors are used to specify info about type check errors -- in TCError data type. data TCTypeError -- | Annotation unify error AnnError :: AnnConvergeError -> TCTypeError -- | Type equality error TypeEqError :: T -> T -> TCTypeError -- | Stacks equality error StackEqError :: [T] -> [T] -> TCTypeError -- | Error that happens when type cannot be used in the corresponding -- scope. Argument of this constructor carries type which violates the -- restriction, e.g. big_map in UNPACK, and a concrete -- reason why the type is unsuported. UnsupportedTypeForScope :: T -> BadTypeForScope -> TCTypeError -- | Arithmetic operation is applied to types, at least one of which is not -- numeric (e.g. timestamp and timestamp passed to -- MUL instruction). NotNumericTypes :: T -> T -> TCTypeError -- | Some instruction can not be used in a specific context, like -- SELF in LAMBDA. InvalidInstruction :: ExpandedInstr -> TCTypeError -- | Error that happens when a Value is never a valid source for -- this type (e.g. timestamp cannot be obtained from a -- ValueTrue) InvalidValueType :: T -> TCTypeError -- | There are not enough items on stack to perform a certain instruction. NotEnoughItemsOnStack :: Word -> NotEnoughItemsInstr -> TCTypeError -- | Invalid entrypoint name provided IllegalEntryPoint :: EpNameFromRefAnnError -> TCTypeError -- | Contract with given address is not originated. UnknownContract :: Address -> TCTypeError -- | Given entrypoint is not present. EntryPointNotFound :: EpName -> TCTypeError -- | Incorrect parameter declaration (with respect to entrypoints feature). IllegalParamDecl :: ParamEpError -> TCTypeError -- | Natural numbers cannot be negative NegativeNat :: TCTypeError -- | Exceeds the maximal mutez value MutezOverflow :: TCTypeError -- | Address couldn't be parsed from its textual representation InvalidAddress :: ParseEpAddressError -> TCTypeError -- | KeyHash couldn't be parsed from its textual representation InvalidKeyHash :: CryptoParseError -> TCTypeError -- | Timestamp is not RFC339 compliant InvalidTimestamp :: TCTypeError -- | Code always fails, but shouldn't, like ITER body. CodeAlwaysFails :: TCTypeError -- | Empty block of code, like ITER body. EmptyCode :: TCTypeError -- | Generic error when instruction does not match something sensible. AnyError :: TCTypeError -- | Type check error data TCError TCFailedOnInstr :: ExpandedInstr -> SomeHST -> InstrCallStack -> Maybe TypeContext -> Maybe TCTypeError -> TCError TCFailedOnValue :: Value -> T -> Text -> InstrCallStack -> Maybe TCTypeError -> TCError TCContractError :: Text -> Maybe TCTypeError -> TCError TCUnreachableCode :: InstrCallStack -> NonEmpty ExpandedOp -> TCError TCExtError :: SomeHST -> InstrCallStack -> ExtError -> TCError -- | Various type errors possible when checking Morley extension commands data ExtError LengthMismatch :: StackTypePattern -> ExtError VarError :: Text -> StackFn -> ExtError TypeMismatch :: StackTypePattern -> Int -> TCTypeError -> ExtError TyVarMismatch :: Var -> Type -> StackTypePattern -> Int -> TCTypeError -> ExtError StkRestMismatch :: StackTypePattern -> SomeHST -> SomeHST -> TCTypeError -> ExtError TestAssertError :: Text -> ExtError InvalidStackReference :: StackRef -> StackSize -> ExtError newtype StackSize StackSize :: Natural -> StackSize instance GHC.Generics.Generic Michelson.TypeCheck.Error.TCError instance GHC.Classes.Eq Michelson.TypeCheck.Error.TCError instance GHC.Generics.Generic Michelson.TypeCheck.Error.ExtError instance GHC.Classes.Eq Michelson.TypeCheck.Error.ExtError instance GHC.Generics.Generic Michelson.TypeCheck.Error.StackSize instance GHC.Classes.Eq Michelson.TypeCheck.Error.StackSize instance GHC.Show.Show Michelson.TypeCheck.Error.StackSize instance Control.DeepSeq.NFData Michelson.TypeCheck.Error.TCTypeError instance GHC.Generics.Generic Michelson.TypeCheck.Error.TCTypeError instance GHC.Classes.Eq Michelson.TypeCheck.Error.TCTypeError instance GHC.Show.Show Michelson.TypeCheck.Error.TCTypeError instance Control.DeepSeq.NFData Michelson.TypeCheck.Error.TypeContext instance GHC.Generics.Generic Michelson.TypeCheck.Error.TypeContext instance GHC.Classes.Eq Michelson.TypeCheck.Error.TypeContext instance GHC.Show.Show Michelson.TypeCheck.Error.TypeContext instance GHC.Generics.Generic Michelson.TypeCheck.Error.NotEnoughItemsInstr instance GHC.Classes.Eq Michelson.TypeCheck.Error.NotEnoughItemsInstr instance GHC.Show.Show Michelson.TypeCheck.Error.NotEnoughItemsInstr instance Control.DeepSeq.NFData Michelson.TypeCheck.Error.TCError instance Formatting.Buildable.Buildable Michelson.TypeCheck.Error.TCError instance Formatting.Buildable.Buildable Michelson.Untyped.Instr.ExpandedInstr => GHC.Show.Show Michelson.TypeCheck.Error.TCError instance Formatting.Buildable.Buildable Michelson.Untyped.Instr.ExpandedInstr => GHC.Exception.Type.Exception Michelson.TypeCheck.Error.TCError instance Control.DeepSeq.NFData Michelson.TypeCheck.Error.ExtError instance Formatting.Buildable.Buildable Michelson.TypeCheck.Error.ExtError instance Control.DeepSeq.NFData Michelson.TypeCheck.Error.StackSize instance Formatting.Buildable.Buildable Michelson.TypeCheck.Error.TCTypeError instance Formatting.Buildable.Buildable Michelson.TypeCheck.Error.TypeContext instance Control.DeepSeq.NFData Michelson.TypeCheck.Error.NotEnoughItemsInstr instance Formatting.Buildable.Buildable Michelson.TypeCheck.Error.NotEnoughItemsInstr module Michelson.TypeCheck.TypeCheck type TcInstrHandler = forall inp. Typeable inp => ExpandedInstr -> HST inp -> TypeCheckInstr (SomeInstr inp) type TcOriginatedContracts = Map ContractHash ParameterType type TcResult inp = Either TCError (SomeInstr inp) -- | The typechecking state data TypeCheckEnv TypeCheckEnv :: ~TcExtFrames -> ~ParameterType -> ~TcOriginatedContracts -> TypeCheckEnv [tcExtFrames] :: TypeCheckEnv -> ~TcExtFrames [tcContractParam] :: TypeCheckEnv -> ~ParameterType [tcContracts] :: TypeCheckEnv -> ~TcOriginatedContracts type TypeCheck = ExceptT TCError (State TypeCheckEnv) runTypeCheck :: ParameterType -> TcOriginatedContracts -> TypeCheck a -> Either TCError a type TypeCheckInstr = ReaderT InstrCallStack TypeCheck -- | Run type checker as if it worked isolated from other world - no access -- to environment of the current contract is allowed. -- -- Use this function for test purposes only or for some utilities when -- environment does not matter. In particular, it is assumed that -- whatever we typecheck does not depend on the parameter type of the -- contract which is being typechecked (because there is no contract that -- we are typechecking). runTypeCheckIsolated :: TypeCheck a -> Either TCError a -- | Similar to runTypeCheckIsolated, but for 'TypeCheckInstr.' runTypeCheckInstrIsolated :: TypeCheckInstr a -> Either TCError a -- | Run TypeCheckInstr and modify thrown errors using given -- functions. mapTCError :: (TCError -> TCError) -> TypeCheckInstr a -> TypeCheckInstr a tcContractParamL :: Lens' TypeCheckEnv ParameterType tcContractsL :: Lens' TypeCheckEnv TcOriginatedContracts tcExtFramesL :: Lens' TypeCheckEnv TcExtFrames module Michelson.TypeCheck.Helpers onLeft :: Either a c -> (a -> b) -> Either b c -- | Function which derives special annotations for CDR / CAR instructions. deriveSpecialVN :: VarAnn -> FieldAnn -> VarAnn -> VarAnn -- | Function which derives special annotations for PAIR instruction. -- -- Namely, it does following transformation: PAIR % -- % [ p.a int : p.b int : .. ] ~ [ p -- (pair (int %a) (int %b) : .. ] -- -- All relevant cases (e.g. PAIR %myf % ) are handled -- as they should be according to spec. deriveSpecialFNs :: FieldAnn -> FieldAnn -> VarAnn -> VarAnn -> (VarAnn, FieldAnn, FieldAnn) -- | Append suffix to variable annotation (if it's not empty) deriveVN :: VarAnn -> VarAnn -> VarAnn -- | Function which extracts annotations for or type (for left and -- right parts). -- -- It extracts field/type annotations and also auto-generates variable -- annotations if variable annotation is not provided as second argument. deriveNsOr :: Notes ('TOr a b) -> VarAnn -> (Notes a, Notes b, VarAnn, VarAnn) -- | Function which extracts annotations for option t type. -- -- It extracts field/type annotations and also auto-generates variable -- annotation for Some case if it is not provided as second -- argument. deriveNsOption :: Notes ('TOption a) -> VarAnn -> (Notes a, VarAnn) convergeHSTEl :: (Notes t, Dict (WellTyped t), VarAnn) -> (Notes t, Dict (WellTyped t), VarAnn) -> Either AnnConvergeError (Notes t, Dict (WellTyped t), VarAnn) -- | Combine annotations from two given stack types convergeHST :: HST ts -> HST ts -> Either AnnConvergeError (HST ts) -- | Extract singleton for each single type of the given stack. hstToTs :: HST st -> [T] -- | Check whether the given stack types are equal. eqHST :: forall as bs. (Typeable as, Typeable bs) => HST as -> HST bs -> Either TCTypeError (as :~: bs) -- | Check whether the given stack has size 1 and its only element matches -- the given type. This function is a specialized version of -- eqHST. eqHST1 :: forall t st. (Typeable st, Typeable t, SingI t, WellTyped t) => HST st -> Either TCTypeError (st :~: '[t]) lengthHST :: HST xs -> Natural -- | Check whether elements go in strictly ascending order and return the -- original list (to keep only one pass on the original list). ensureDistinctAsc :: (Ord b, Show a) => (a -> b) -> [a] -> Either Text [a] -- | Function eqType is a simple wrapper around -- Data.Typeable.eqT suited for use within Either -- TCTypeError a applicative. eqType :: forall (a :: T) (b :: T). Each [Typeable, SingI] [a, b] => Either TCTypeError (a :~: b) onTypeCheckInstrAnnErr :: (MonadReader InstrCallStack m, MonadError TCError m, Typeable ts) => ExpandedInstr -> HST ts -> Maybe TypeContext -> Either AnnConvergeError a -> m a onTypeCheckInstrErr :: (MonadReader InstrCallStack m, MonadError TCError m) => ExpandedInstr -> SomeHST -> Maybe TypeContext -> Either TCTypeError a -> m a onScopeCheckInstrErr :: forall (t :: T) m a. (MonadReader InstrCallStack m, MonadError TCError m, SingI t) => ExpandedInstr -> SomeHST -> Maybe TypeContext -> Either BadTypeForScope a -> m a typeCheckInstrErr :: (MonadReader InstrCallStack m, MonadError TCError m) => ExpandedInstr -> SomeHST -> Maybe TypeContext -> m a typeCheckInstrErr' :: (MonadReader InstrCallStack m, MonadError TCError m) => ExpandedInstr -> SomeHST -> Maybe TypeContext -> TCTypeError -> m a typeCheckImpl :: forall inp. Typeable inp => TcInstrHandler -> [ExpandedOp] -> HST inp -> TypeCheckInstr (SomeInstr inp) -- | Check whether given types are structurally equal and annotations -- converge. matchTypes :: forall t1 t2. Each [Typeable, SingI] [t1, t2] => Notes t1 -> Notes t2 -> Either TCTypeError (t1 :~: t2, Notes t1) -- | Generic implementation for MEMeration memImpl :: forall (q :: T) (c :: T) ts inp m. (MonadReader InstrCallStack m, MonadError TCError m, Typeable ts, Typeable (MemOpKey c), SingI (MemOpKey c), MemOp c, inp ~ (q : (c : ts))) => ExpandedInstr -> HST inp -> VarAnn -> m (SomeInstr inp) getImpl :: forall c getKey rs inp m. (GetOp c, Typeable (GetOpKey c), Typeable (GetOpVal c), SingI (GetOpVal c), SingI (GetOpKey c), WellTyped (GetOpVal c), inp ~ (getKey : (c : rs)), MonadReader InstrCallStack m, MonadError TCError m) => ExpandedInstr -> HST (getKey : (c : rs)) -> Notes (GetOpVal c) -> VarAnn -> m (SomeInstr inp) updImpl :: forall c updKey updParams rs inp m. (UpdOp c, Typeable (UpdOpKey c), SingI (UpdOpKey c), Typeable (UpdOpParams c), SingI (UpdOpParams c), inp ~ (updKey : (updParams : (c : rs))), MonadReader InstrCallStack m, MonadError TCError m) => ExpandedInstr -> HST (updKey : (updParams : (c : rs))) -> VarAnn -> m (SomeInstr inp) sliceImpl :: (SliceOp c, Typeable c, inp ~ ('TNat : ('TNat : (c : rs))), Monad m) => HST inp -> VarAnn -> m (SomeInstr inp) concatImpl :: (ConcatOp c, Typeable c, inp ~ (c : (c : rs)), WellTyped c, MonadReader InstrCallStack m, MonadError TCError m) => HST inp -> VarAnn -> m (SomeInstr inp) concatImpl' :: (ConcatOp c, Typeable c, SingI c, WellTyped c, inp ~ ('TList c : rs), Monad m) => HST inp -> VarAnn -> m (SomeInstr inp) sizeImpl :: (SizeOp c, inp ~ (c : rs), Monad m) => HST inp -> VarAnn -> m (SomeInstr inp) -- | Helper function to construct instructions for binary arithmetic -- operations. arithImpl :: (Typeable (ArithRes aop n m), SingI (ArithRes aop n m), Typeable (ArithRes aop n m : s), WellTyped (ArithRes aop n m), inp ~ (n : (m : s)), Monad t) => Instr inp (ArithRes aop n m : s) -> HST inp -> VarAnn -> t (SomeInstr inp) addImpl :: forall a b inp rs m. (Typeable rs, Each [Typeable, SingI] [a, b], inp ~ (a : (b : rs)), MonadReader InstrCallStack m, MonadError TCError m) => Sing a -> Sing b -> HST inp -> VarAnn -> m (SomeInstr inp) subImpl :: forall a b inp rs m. (Typeable rs, Each [Typeable, SingI] [a, b], inp ~ (a : (b : rs)), MonadReader InstrCallStack m, MonadError TCError m) => Sing a -> Sing b -> HST inp -> VarAnn -> m (SomeInstr inp) mulImpl :: forall a b inp rs m. (Typeable rs, Each [Typeable, SingI] [a, b], inp ~ (a : (b : rs)), MonadReader InstrCallStack m, MonadError TCError m) => Sing a -> Sing b -> HST inp -> VarAnn -> m (SomeInstr inp) edivImpl :: forall a b inp rs m. (Typeable rs, Each [Typeable, SingI] [a, b], inp ~ (a : (b : rs)), MonadReader InstrCallStack m, MonadError TCError m) => Sing a -> Sing b -> HST inp -> VarAnn -> m (SomeInstr inp) -- | Helper function to construct instructions for binary arithmetic -- operations. unaryArithImpl :: (Typeable (UnaryArithRes aop n), SingI (UnaryArithRes aop n), Typeable (UnaryArithRes aop n : s), WellTyped (UnaryArithRes aop n), inp ~ (n : s), Monad t) => Instr inp (UnaryArithRes aop n : s) -> HST inp -> VarAnn -> t (SomeInstr inp) withCompareableCheck :: forall a m v ts. (Typeable ts, MonadReader InstrCallStack m, MonadError TCError m) => Sing a -> ExpandedInstr -> HST ts -> (Comparable a => v) -> m v module Michelson.TypeCheck.Value -- | Function typeCheckValImpl converts a single Michelson value -- given in representation from Michelson.Type module to -- representation in strictly typed GADT. -- -- typeCheckValImpl is polymorphic in the expected type of -- value. -- -- Type checking algorithm pattern-matches on parse value representation, -- expected type t and constructs Val t value. -- -- If there was no match on a given pair of value and expected type, that -- is interpreted as input of wrong type and type check finishes with -- error. typeCheckValImpl :: forall ty. SingI ty => TcInstrHandler -> Value -> TypeCheckInstr (Value ty) -- | Type-checking of Morley extension. module Michelson.TypeCheck.Ext typeCheckExt :: forall s. Typeable s => TypeCheckListHandler s -> ExpandedExtInstr -> HST s -> TypeCheckInstr (SomeInstr s) -- | Module, providing functions for conversion from instruction and value -- representation from Michelson.Type module to strictly-typed -- GADT-based representation from Michelson.Value module. -- -- This conversion is labeled as type check because that's what we are -- obliged to do on our way. -- -- Type check algorithm relies on the property of Michelson language that -- each instruction on a given input stack type produces a definite -- output stack type. Michelson contract defines concrete types for -- storage and parameter, from which input stack type is deduced. Then -- this type is being combined with each subsequent instruction, -- producing next stack type after each application. -- -- Function typeCheck takes list of instructions and returns -- value of type Instr inp out along with HST inp and -- HST out all wrapped into SomeInstr data type. This -- wrapping is done to satsify Haskell type system (which has no support -- for dependent types). Functions typeCheckInstr, -- typeCheckValue behave similarly. -- -- When a recursive call is made within typeCheck, -- typeCheckInstr or typeCheckValue, result of a call -- is unwrapped from SomeInstr and type information from HST -- inp and HST out is being used to assert that recursive -- call returned instruction of expected type (error is thrown -- otherwise). module Michelson.TypeCheck.Instr typeCheckContract :: TcOriginatedContracts -> Contract -> Either TCError SomeContract -- | Function typeCheckValue converts a single Michelson value -- given in representation from Michelson.Untyped module -- hierarchy to representation in strictly typed GADT. -- -- typeCheckValue is polymorphic in the expected type of value. -- -- Type checking algorithm pattern-matches on parse value representation, -- expected type t and constructs Val t value. -- -- If there was no match on a given pair of value and expected type, that -- is interpreted as input of wrong type and type check finishes with -- error. typeCheckValue :: forall t. SingI t => Value -> TypeCheckInstr (Value t) -- | Function typeCheckList converts list of Michelson -- instructions given in representation from Michelson.Type -- module to representation in strictly typed GADT. -- -- Types are checked along the way which is neccessary to construct a -- strictly typed value. -- -- As a second argument, typeCheckList accepts input stack type -- representation. typeCheckList :: Typeable inp => [ExpandedOp] -> HST inp -> TypeCheck (SomeInstr inp) typeVerifyTopLevelType :: (SingI t, HasCallStack) => TcOriginatedContracts -> Value -> Either TCError (Value t) typeCheckTopLevelType :: HasCallStack => TcOriginatedContracts -> Type -> Value -> Either TCError SomeValue module Michelson.TypeCheck typeCheckContract :: TcOriginatedContracts -> Contract -> Either TCError SomeContract typeCheckTopLevelType :: HasCallStack => TcOriginatedContracts -> Type -> Value -> Either TCError SomeValue typeVerifyTopLevelType :: (SingI t, HasCallStack) => TcOriginatedContracts -> Value -> Either TCError (Value t) -- | Function typeCheckValue converts a single Michelson value -- given in representation from Michelson.Untyped module -- hierarchy to representation in strictly typed GADT. -- -- typeCheckValue is polymorphic in the expected type of value. -- -- Type checking algorithm pattern-matches on parse value representation, -- expected type t and constructs Val t value. -- -- If there was no match on a given pair of value and expected type, that -- is interpreted as input of wrong type and type check finishes with -- error. typeCheckValue :: forall t. SingI t => Value -> TypeCheckInstr (Value t) -- | Function typeCheckList converts list of Michelson -- instructions given in representation from Michelson.Type -- module to representation in strictly typed GADT. -- -- Types are checked along the way which is neccessary to construct a -- strictly typed value. -- -- As a second argument, typeCheckList accepts input stack type -- representation. typeCheckList :: Typeable inp => [ExpandedOp] -> HST inp -> TypeCheck (SomeInstr inp) typeCheckExt :: forall s. Typeable s => TypeCheckListHandler s -> ExpandedExtInstr -> HST s -> TypeCheckInstr (SomeInstr s) -- | Function eqType is a simple wrapper around -- Data.Typeable.eqT suited for use within Either -- TCTypeError a applicative. eqType :: forall (a :: T) (b :: T). Each [Typeable, SingI] [a, b] => Either TCTypeError (a :~: b) -- | Check whether given types are structurally equal and annotations -- converge. matchTypes :: forall t1 t2. Each [Typeable, SingI] [t1, t2] => Notes t1 -> Notes t2 -> Either TCTypeError (t1 :~: t2, Notes t1) -- | Utilities for arbitrary data generation in property tests. module Michelson.Test.Gen -- | Minimal (earliest) timestamp used for Arbitrary (CValue -- 'CTimestamp) minTimestamp :: Timestamp -- | Maximal (latest) timestamp used for Arbitrary (CValue -- 'CTimestamp) maxTimestamp :: Timestamp -- | Median of minTimestamp and maxTimestamp. Useful for -- testing (exactly half of generated dates will be before and after this -- date). midTimestamp :: Timestamp instance Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.Value.Value' instr 'Michelson.Typed.T.TKeyHash) instance Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.Value.Value' instr 'Michelson.Typed.T.TMutez) instance Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.Value.Value' instr 'Michelson.Typed.T.TInt) instance Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.Value.Value' instr a) => Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.Value.Value' instr ('Michelson.Typed.T.TList a)) instance Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.Value.Value' instr 'Michelson.Typed.T.TUnit) instance (Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.Value.Value' instr a), Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.Value.Value' instr b)) => Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.Value.Value' instr ('Michelson.Typed.T.TPair a b)) instance Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.Value.Value' instr 'Michelson.Typed.T.TTimestamp) instance Test.QuickCheck.Arbitrary.Arbitrary Tezos.Core.Mutez instance Test.QuickCheck.Arbitrary.Arbitrary Tezos.Core.Timestamp -- | Global blockchain state (emulated). module Michelson.Runtime.GState -- | State of a contract with code. data ContractState ContractState :: Mutez -> Value -> Contract -> Maybe SomeContract -> Maybe SomeValue -> ContractState -- | Amount of mutez owned by this contract. [csBalance] :: ContractState -> Mutez -- | Storage value associated with this contract. [csStorage] :: ContractState -> Value -- | Contract itself (untyped). [csContract] :: ContractState -> Contract [csTypedContract] :: ContractState -> Maybe SomeContract -- | We keep typed representation of contract code and storage in form, -- that hides their actual type in order to simplify the rest of the code -- (e.g. avoid type parameters for ContractState and so on). They -- are made optional in order to perform safe parsing from JSON (we -- simply return Nothing in this parser and use -- getTypedStorage or getTypedContract that optionally -- typecheck storage or contract code). [csTypedStorage] :: ContractState -> Maybe SomeValue getTypedContract :: GState -> ContractState -> Either TCError SomeContract getTypedStorage :: GState -> ContractState -> Either TCError SomeValue data SomeContractAndStorage SomeContractAndStorage :: FullContract cp st -> Value st -> SomeContractAndStorage [scsContract] :: SomeContractAndStorage -> FullContract cp st [scsStorage] :: SomeContractAndStorage -> Value st getTypedContractAndStorage :: (TCError -> err) -> (TCError -> err) -> GState -> ContractState -> Either err SomeContractAndStorage -- | State of an arbitrary address. data AddressState -- | For contracts without code we store only its balance. ASSimple :: Mutez -> AddressState -- | For contracts with code we store more state represented by -- ContractState. ASContract :: ContractState -> AddressState -- | Extract balance from AddressState. asBalance :: AddressState -> Mutez -- | Persistent data passed to Morley contracts which can be updated as -- result of contract execution. data GState GState :: ChainId -> Map Address AddressState -> GState -- | Identifier of chain. [gsChainId] :: GState -> ChainId -- | All known addresses and their state. [gsAddresses] :: GState -> Map Address AddressState gsChainIdL :: Lens' GState ChainId gsAddressesL :: Lens' GState (Map Address AddressState) -- | Initially these addresses have a lot of money. genesisAddresses :: NonEmpty Address -- | KeyHash of genesis address. genesisKeyHashes :: NonEmpty KeyHash -- | One of genesis addresses. genesisAddress :: Address -- | More genesis addresses -- -- We know size of genesisAddresses, so it is safe to use -- !! genesisAddress1 :: Address -- | More genesis addresses -- -- We know size of genesisAddresses, so it is safe to use -- !! genesisAddress2 :: Address -- | More genesis addresses -- -- We know size of genesisAddresses, so it is safe to use -- !! genesisAddress3 :: Address genesisAddress4 :: Address genesisAddress5 :: Address genesisAddress6 :: Address -- | One of genesis key hashes. genesisKeyHash :: KeyHash -- | Initial GState. It's supposed to be used if no GState is -- provided. It puts plenty of money on each genesis address. initGState :: GState -- | Read GState from a file. readGState :: FilePath -> IO GState -- | Write GState to a file. writeGState :: FilePath -> GState -> IO () -- | Updates that can be applied to GState. data GStateUpdate GSAddAddress :: Address -> AddressState -> GStateUpdate GSSetStorageValue :: Address -> Value -> SomeValue -> GStateUpdate GSSetBalance :: Address -> Mutez -> GStateUpdate data GStateUpdateError GStateAddressExists :: Address -> GStateUpdateError GStateUnknownAddress :: Address -> GStateUpdateError GStateNotContract :: Address -> GStateUpdateError -- | Apply GStateUpdate to GState. applyUpdate :: GStateUpdate -> GState -> Either GStateUpdateError GState -- | Apply a list of GStateUpdates to GState. applyUpdates :: [GStateUpdate] -> GState -> Either GStateUpdateError GState -- | Retrive all contracts stored in GState extractAllContracts :: GState -> TcOriginatedContracts instance GHC.Show.Show Michelson.Runtime.GState.GStateUpdateError instance GHC.Show.Show Michelson.Runtime.GState.GStateUpdate instance GHC.Show.Show Michelson.Runtime.GState.GStateParseError instance Formatting.Buildable.Buildable Michelson.Runtime.GState.GStateUpdateError instance Formatting.Buildable.Buildable Michelson.Runtime.GState.GStateUpdate instance GHC.Exception.Type.Exception Michelson.Runtime.GState.GStateParseError instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Runtime.GState.GState instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Runtime.GState.GState instance GHC.Show.Show Michelson.Runtime.GState.GState instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Runtime.GState.AddressState instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Runtime.GState.AddressState instance GHC.Generics.Generic Michelson.Runtime.GState.AddressState instance GHC.Show.Show Michelson.Runtime.GState.AddressState instance GHC.Show.Show Michelson.Runtime.GState.ContractState instance Formatting.Buildable.Buildable Michelson.Runtime.GState.AddressState instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Runtime.GState.ContractState instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Runtime.GState.ContractState instance Formatting.Buildable.Buildable Michelson.Runtime.GState.ContractState module Michelson.Printer -- | Generalize converting a type into a Text.PrettyPrint.Leijen.Text.Doc. -- Used to pretty print Michelson code and define Fmt.Buildable -- instances. class RenderDoc a renderDoc :: RenderDoc a => RenderContext -> a -> Doc -- | Whether a value can be represented in Michelson code. Normally either -- all values of some type are renderable or not renderable. However, in -- case of instructions we have extra instructions which should not be -- rendered. Note: it's not suficcient to just return mempty for -- such instructions, because sometimes we want to print lists of -- instructions and we need to ignore them complete (to avoid putting -- redundant separators). isRenderable :: RenderDoc a => a -> Bool -- | Convert Doc to Text with a line width of 80. printDoc :: Bool -> Doc -> Text -- | Convert an untyped contract into a textual representation which will -- be accepted by the OCaml reference client. printUntypedContract :: RenderDoc op => Bool -> Contract' op -> Text -- | Convert a typed contract into a textual representation which will be -- accepted by the OCaml reference client. printTypedContractCode :: (SingI p, SingI s) => Bool -> ContractCode p s -> Text -- | Convert typed contract into a textual representation which will be -- accepted by the OCaml reference client. printTypedFullContract :: Bool -> FullContract p s -> Text -- | Convert SomeContract into a textual representation which will -- be accepted by the OCaml reference client. printSomeContract :: Bool -> SomeContract -> Text -- | Convert typed value into a textual representation which will be -- accepted by the OCaml reference client. printTypedValue :: forall t. ProperPrintedValBetterErrors t => Bool -> Value t -> Text -- | Convert untyped value into a textual representation which will be -- accepted by the OCaml reference client. printUntypedValue :: RenderDoc op => Bool -> Value' op -> Text module Michelson.Macro data CadrStruct A :: CadrStruct D :: CadrStruct data PairStruct F :: (VarAnn, FieldAnn) -> PairStruct P :: PairStruct -> PairStruct -> PairStruct -- | Built-in Michelson Macros defined by the specification data Macro CASE :: NonEmpty [ParsedOp] -> Macro TAG :: Natural -> NonEmpty Type -> Macro ACCESS :: Natural -> Positive -> Macro SET :: Natural -> Positive -> Macro CONSTRUCT :: NonEmpty [ParsedOp] -> Macro VIEW :: [ParsedOp] -> Macro VOID :: [ParsedOp] -> Macro CMP :: ParsedInstr -> VarAnn -> Macro IFX :: ParsedInstr -> [ParsedOp] -> [ParsedOp] -> Macro IFCMP :: ParsedInstr -> VarAnn -> [ParsedOp] -> [ParsedOp] -> Macro FAIL :: Macro PAPAIR :: PairStruct -> TypeAnn -> VarAnn -> Macro UNPAIR :: PairStruct -> Macro CADR :: [CadrStruct] -> VarAnn -> FieldAnn -> Macro SET_CADR :: [CadrStruct] -> VarAnn -> FieldAnn -> Macro MAP_CADR :: [CadrStruct] -> VarAnn -> FieldAnn -> [ParsedOp] -> Macro DIIP :: Word -> [ParsedOp] -> Macro DUUP :: Word -> VarAnn -> Macro ASSERT :: Macro ASSERTX :: ParsedInstr -> Macro ASSERT_CMP :: ParsedInstr -> Macro ASSERT_NONE :: Macro ASSERT_SOME :: Macro ASSERT_LEFT :: Macro ASSERT_RIGHT :: Macro IF_SOME :: [ParsedOp] -> [ParsedOp] -> Macro IF_RIGHT :: [ParsedOp] -> [ParsedOp] -> Macro -- | A programmer-defined macro data LetMacro LetMacro :: Text -> StackFn -> [ParsedOp] -> LetMacro [lmName] :: LetMacro -> Text [lmSig] :: LetMacro -> StackFn [lmExpr] :: LetMacro -> [ParsedOp] type ParsedValue = Value' ParsedOp type ParsedInstr = InstrAbstract ParsedOp -- | Unexpanded instructions produced directly by the ops parser, -- which contains primitive Michelson Instructions, inline-able macros -- and sequences data ParsedOp -- | Primitive Michelson instruction Prim :: ParsedInstr -> SrcPos -> ParsedOp -- | Built-in Michelson macro defined by the specification Mac :: Macro -> SrcPos -> ParsedOp -- | User-defined macro with instructions to be inlined LMac :: LetMacro -> SrcPos -> ParsedOp -- | A sequence of instructions Seq :: [ParsedOp] -> SrcPos -> ParsedOp type ParsedUExtInstr = ExtInstrAbstract ParsedOp -- | Expand all macros in parsed contract. expandContract :: Contract' ParsedOp -> Contract expandValue :: ParsedValue -> Value mapLeaves :: [(VarAnn, FieldAnn)] -> PairStruct -> PairStruct expand :: LetCallStack -> ParsedOp -> ExpandedOp expandList :: [ParsedOp] -> [ExpandedOp] expandMacro :: InstrCallStack -> Macro -> [ExpandedOp] expandPapair :: InstrCallStack -> PairStruct -> TypeAnn -> VarAnn -> [ExpandedOp] expandUnpapair :: InstrCallStack -> PairStruct -> [ExpandedOp] expandCadr :: InstrCallStack -> [CadrStruct] -> VarAnn -> FieldAnn -> [ExpandedOp] expandSetCadr :: InstrCallStack -> [CadrStruct] -> VarAnn -> FieldAnn -> [ExpandedOp] expandMapCadr :: InstrCallStack -> [CadrStruct] -> VarAnn -> FieldAnn -> [ParsedOp] -> [ExpandedOp] instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Macro.Macro instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Macro.Macro instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Macro.CadrStruct instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Macro.CadrStruct instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Macro.PairStruct instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Macro.PairStruct instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Macro.LetMacro instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Macro.LetMacro instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Macro.ParsedOp instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Macro.ParsedOp instance GHC.Generics.Generic Michelson.Macro.LetMacro instance Data.Data.Data Michelson.Macro.LetMacro instance GHC.Show.Show Michelson.Macro.LetMacro instance GHC.Classes.Eq Michelson.Macro.LetMacro instance GHC.Generics.Generic Michelson.Macro.ParsedOp instance Data.Data.Data Michelson.Macro.ParsedOp instance GHC.Show.Show Michelson.Macro.ParsedOp instance GHC.Classes.Eq Michelson.Macro.ParsedOp instance GHC.Generics.Generic Michelson.Macro.Macro instance Data.Data.Data Michelson.Macro.Macro instance GHC.Show.Show Michelson.Macro.Macro instance GHC.Classes.Eq Michelson.Macro.Macro instance GHC.Generics.Generic Michelson.Macro.CadrStruct instance Data.Data.Data Michelson.Macro.CadrStruct instance GHC.Show.Show Michelson.Macro.CadrStruct instance GHC.Classes.Eq Michelson.Macro.CadrStruct instance GHC.Generics.Generic Michelson.Macro.PairStruct instance Data.Data.Data Michelson.Macro.PairStruct instance GHC.Show.Show Michelson.Macro.PairStruct instance GHC.Classes.Eq Michelson.Macro.PairStruct instance Formatting.Buildable.Buildable Michelson.Macro.LetMacro instance Control.DeepSeq.NFData Michelson.Macro.LetMacro instance Michelson.Printer.Util.RenderDoc Michelson.Macro.ParsedOp instance Formatting.Buildable.Buildable Michelson.Macro.ParsedOp instance Control.DeepSeq.NFData Michelson.Macro.ParsedOp instance Formatting.Buildable.Buildable Michelson.Macro.Macro instance Control.DeepSeq.NFData Michelson.Macro.Macro instance Control.DeepSeq.NFData Michelson.Macro.CadrStruct instance Formatting.Buildable.Buildable Michelson.Macro.CadrStruct instance Control.DeepSeq.NFData Michelson.Macro.PairStruct instance Formatting.Buildable.Buildable Michelson.Macro.PairStruct module Michelson.Let -- | A programmer-defined type-synonym data LetType LetType :: Text -> Type -> LetType [ltName] :: LetType -> Text [ltSig] :: LetType -> Type -- | A programmer-defined constant data LetValue LetValue :: Text -> Type -> Value' ParsedOp -> LetValue [lvName] :: LetValue -> Text [lvSig] :: LetValue -> Type [lvVal] :: LetValue -> Value' ParsedOp instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Let.LetType instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Let.LetType instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Let.LetValue instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Let.LetValue instance GHC.Show.Show Michelson.Let.LetType instance GHC.Classes.Eq Michelson.Let.LetType instance GHC.Show.Show Michelson.Let.LetValue instance GHC.Classes.Eq Michelson.Let.LetValue -- | Core parser types module Michelson.Parser.Types type Parser = ReaderT LetEnv (Parsec CustomParserException Text) -- | The environment containing lets from the let-block data LetEnv LetEnv :: Map Text LetMacro -> Map Text LetValue -> Map Text LetType -> LetEnv [letMacros] :: LetEnv -> Map Text LetMacro [letValues] :: LetEnv -> Map Text LetValue [letTypes] :: LetEnv -> Map Text LetType noLetEnv :: LetEnv instance GHC.Classes.Eq Michelson.Parser.Types.LetEnv instance GHC.Show.Show Michelson.Parser.Types.LetEnv instance Data.Default.Class.Default a => Data.Default.Class.Default (Michelson.Parser.Types.Parser a) module Michelson.Parser.Lexer lexeme :: Parser a -> Parser a mSpace :: Parser () symbol :: Tokens Text -> Parser () symbol' :: Text -> Parser () word :: Tokens Text -> a -> Parser a word' :: Tokens Text -> a -> Parser a string' :: (MonadParsec e s f, Tokens s ~ Text) => Text -> f Text parens :: Parser a -> Parser a braces :: Parser a -> Parser a brackets :: Parser a -> Parser a brackets' :: Parser a -> Parser a semicolon :: Parser () comma :: Parser () varID :: Parser Var module Michelson.Parser.Helpers -- | Make a parser from a string mkParser :: (a -> Text) -> a -> Parser a sepEndBy1 :: MonadPlus m => m a -> m sep -> m (NonEmpty a) -- | endBy2 p sep parses two or more occurrences of p, -- separated by sep. sepBy2 :: MonadPlus m => m a -> m sep -> m (NonEmpty a) -- | Apply given parser and return default value if it fails. parseDef :: Default a => Parser a -> Parser a -- | Parse a positive number. positive :: Parser Positive -- | Parse expression which can be wrapped in parentheses. mparens :: Parser a -> Parser a -- | Parsing of untyped Michelson values. module Michelson.Parser.Value -- | Parse untyped ParsedValue. Take instruction parser as argument -- to avoid cyclic dependencies between modules, hence ' in its name. value' :: Parser ParsedOp -> Parser ParsedValue mkLetVal :: Map Text LetValue -> Parser LetValue stringLiteral :: Parser ParsedValue bytesLiteral :: Parser (Value' op) intLiteral :: Parser (Value' op) module Michelson.Parser.Annotations -- | General TVF Annotation parser, including Special Annotations note :: forall tag. KnownAnnTag tag => Parser (Annotation tag) noteF :: Parser FieldAnn noteV :: Parser VarAnn noteDef :: KnownAnnTag tag => Parser (Annotation tag) noteV2Def :: Parser (VarAnn, VarAnn) notesTVF :: Parser (TypeAnn, VarAnn, FieldAnn) notesTVF2 :: Parser (TypeAnn, VarAnn, (FieldAnn, FieldAnn)) notesTVF2Def :: Parser (TypeAnn, VarAnn, (FieldAnn, FieldAnn)) notesTV :: Parser (TypeAnn, VarAnn) notesTF :: Parser (TypeAnn, FieldAnn) notesVF :: Parser (VarAnn, FieldAnn) fieldType :: Default a => Parser a -> Parser (a, TypeAnn) permute2Def :: (Default a, Default b, Monad f, Alternative f) => f a -> f b -> f (a, b) permute3Def :: (Default a, Default b, Default c, Monad f, Alternative f) => f a -> f b -> f c -> f (a, b, c) -- | Parsing of Michelson types. module Michelson.Parser.Type type_ :: Parser Type typeWithParen :: Parser Type field :: Parser (FieldAnn, Type) -- | Parsing logic for extra instructions (Morley extensions) module Michelson.Parser.Ext extInstr :: Parser [ParsedOp] -> Parser ParsedUExtInstr stackType :: Parser StackTypePattern printComment :: Parser PrintComment -- | Parsing of Michelson instructions. module Michelson.Parser.Instr -- | Parser for primitive Michelson instruction (no macros and extensions). primInstr :: Parser (Contract' ParsedOp) -> Parser ParsedOp -> Parser ParsedInstr -- | Parse a sequence of instructions. ops' :: Parser ParsedOp -> Parser [ParsedOp] mapOp :: Parser ParsedOp -> Parser ParsedInstr pairOp :: Parser ParsedInstr cmpOp :: Parser ParsedInstr dupOp :: Parser ParsedInstr -- | Parsing of built-in Michelson macros. module Michelson.Parser.Macro macro :: Parser ParsedOp -> Parser Macro dupNMac :: Parser Macro duupMac :: Parser Macro pairMac :: Parser Macro ifCmpMac :: Parser ParsedOp -> Parser Macro mapCadrMac :: Parser ParsedOp -> Parser Macro -- | Parsing of let blocks module Michelson.Parser.Let -- | let block parser letBlock :: Parser ParsedOp -> Parser LetEnv mkLetMac :: Map Text LetMacro -> Parser LetMacro letType :: Parser LetType module Michelson.Parser type Parser = ReaderT LetEnv (Parsec CustomParserException Text) -- | Michelson contract with let definitions program :: Parsec CustomParserException Text (Contract' ParsedOp) value :: Parser ParsedValue data CustomParserException UnknownTypeException :: CustomParserException StringLiteralException :: StringLiteralParserException -> CustomParserException OddNumberBytesException :: CustomParserException WrongTagArgs :: Natural -> Positive -> CustomParserException WrongAccessArgs :: Natural -> Positive -> CustomParserException WrongSetArgs :: Natural -> Positive -> CustomParserException ExcessFieldAnnotation :: CustomParserException -- | A non-empty collection of ParseErrors equipped with -- PosState that allows to pretty-print the errors efficiently and -- correctly. data ParseErrorBundle s e data ParserException ParserException :: ParseErrorBundle Text CustomParserException -> ParserException data StringLiteralParserException InvalidEscapeSequence :: Char -> StringLiteralParserException InvalidChar :: Char -> StringLiteralParserException -- | Parse with empty environment parseNoEnv :: Parser a -> String -> Text -> Either (ParseErrorBundle Text CustomParserException) a -- | Parse untyped value from text which comes from something that is not a -- file (which is often the case). So we assume it does not need any -- parsing environment. parseValue :: Text -> Either ParserException ParsedValue -- | Like parseValue, but also expands macros. parseExpandValue :: Text -> Either ParserException Value -- | Parses code block after "code" keyword of a contract. -- -- This function is part of the module API, its semantics should not -- change. codeEntry :: Parser [ParsedOp] type_ :: Parser Type letType :: Parser LetType stringLiteral :: Parser ParsedValue bytesLiteral :: Parser (Value' op) intLiteral :: Parser (Value' op) printComment :: Parser PrintComment -- | Creates Type by its Morley representation. -- --
-- >>> [utypeQ| (int :a | nat :b) |] -- Type (TOr % % (Type (Tc CInt) :a) (Type (Tc CNat) :b)) : --utypeQ :: QuasiQuoter -- | Pretty-print a ParseErrorBundle. All ParseErrors in the -- bundle will be pretty-printed in order together with the corresponding -- offending lines by doing a single efficient pass over the input -- stream. The rendered String always ends with a newline. errorBundlePretty :: (Stream s, ShowErrorComponent e) => ParseErrorBundle s e -> String -- | Apply some transformations to Michelson code. module Michelson.Preprocess -- | Transform all strings in a typed instructions using given function. -- The first argument specifies whether we should go into arguments that -- contain instructions. transformStrings :: Bool -> (MText -> MText) -> Instr inp out -> Instr inp out -- | Similar to transformStrings but for bytes. TODO [TM-375]: -- deduplicate transformBytes :: Bool -> (ByteString -> ByteString) -> Instr inp out -> Instr inp out -- | Module, carrying logic of UNPACK instruction. -- -- This is nearly symmetric to adjacent Pack.hs module. -- -- When implementing this the following sources were used: -- --