-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | EDSL for the Michelson Language -- -- Lorentz is a powerful meta-programming tool which allows one to write -- Michelson contracts directly in Haskell. It has the same instructions -- as Michelson, but operates on Haskell values and allows one to use -- Haskell features. @package lorentz @version 0.9.0 -- | Type and field annotations for Lorentz types. module Lorentz.Annotation -- | Allow customization of field annotation generated for a type when -- declaring its HasAnnotation instance. data AnnOptions AnnOptions :: (Text -> Text) -> AnnOptions [fieldAnnModifier] :: AnnOptions -> Text -> Text defaultAnnOptions :: AnnOptions -- | Drops the field name prefix from a field. We assume a convention of -- the prefix always being lower case, and the first letter of the actual -- field name being uppercase. It also accepts another function which -- will be applied directly after dropping the prefix. dropPrefixThen :: (Text -> Text) -> Text -> Text -- | appendTo suffix fields field appends the given suffix to -- field if the field exists in the fields list. appendTo :: Text -> [Text] -> Text -> Text -- | O(n) Convert casing to camelCasedPhrase. Subject to -- fusion. toCamel :: Text -> Text -- | O(n) Convert casing to PascalCasePhrase. Subject to -- fusion. toPascal :: Text -> Text -- | O(n) Convert casing to snake_cased_phrase. Subject to -- fusion. toSnake :: Text -> Text ctorNameToAnnWithOptions :: forall ctor. (KnownSymbol ctor, HasCallStack) => AnnOptions -> FieldAnn -- | Used in GHasAnnotation and HasAnnotation as a flag to -- track whether or not it directly follows an entrypoint to avoid -- introducing extra entrypoints. data FollowEntrypointFlag FollowEntrypoint :: FollowEntrypointFlag NotFollowEntrypoint :: FollowEntrypointFlag -- | Used in GHasAnnotation as a flag to track whether or not -- field/constructor annotations should be generated. data GenerateFieldAnnFlag GenerateFieldAnn :: GenerateFieldAnnFlag NotGenerateFieldAnn :: GenerateFieldAnnFlag -- | This class defines the type and field annotations for a given type. -- Right now the type annotations come from names in a named field, and -- field annotations are generated from the record fields. class HasAnnotation a getAnnotation :: HasAnnotation a => FollowEntrypointFlag -> Notes (ToT a) getAnnotation :: (HasAnnotation a, GHasAnnotation (Rep a), GValueType (Rep a) ~ ToT a) => FollowEntrypointFlag -> Notes (ToT a) annOptions :: HasAnnotation a => AnnOptions annOptions :: HasAnnotation a => AnnOptions -- | A Generic HasAnnotation implementation class GHasAnnotation a gGetAnnotation :: GHasAnnotation a => AnnOptions -> FollowEntrypointFlag -> GenerateFieldAnnFlag -> (Notes (GValueType a), FieldAnn) -- | Use this in the instance of HasAnnotation when field -- annotations should not be generated. gGetAnnotationNoField :: forall a. (GHasAnnotation (Rep a), GValueType (Rep a) ~ ToT a) => FollowEntrypointFlag -> Notes (ToT a) insertTypeAnn :: forall (b :: T). TypeAnn -> Notes b -> Notes b instance (Lorentz.Annotation.HasAnnotation a, GHC.TypeLits.KnownSymbol name) => Lorentz.Annotation.HasAnnotation (Named.Internal.NamedF Data.Functor.Identity.Identity a name) instance (Lorentz.Annotation.HasAnnotation (GHC.Maybe.Maybe a), GHC.TypeLits.KnownSymbol name) => Lorentz.Annotation.HasAnnotation (Named.Internal.NamedF GHC.Maybe.Maybe a name) instance Lorentz.Annotation.HasAnnotation a => Lorentz.Annotation.HasAnnotation (GHC.Maybe.Maybe a) instance Lorentz.Annotation.HasAnnotation () instance Lorentz.Annotation.HasAnnotation GHC.Integer.Type.Integer instance Lorentz.Annotation.HasAnnotation GHC.Natural.Natural instance Lorentz.Annotation.HasAnnotation Michelson.Text.MText instance Lorentz.Annotation.HasAnnotation GHC.Types.Bool instance Lorentz.Annotation.HasAnnotation Data.ByteString.Internal.ByteString instance Lorentz.Annotation.HasAnnotation Tezos.Core.Mutez instance Lorentz.Annotation.HasAnnotation Tezos.Address.Address instance Lorentz.Annotation.HasAnnotation Michelson.Typed.Entrypoints.EpAddress instance Lorentz.Annotation.HasAnnotation Tezos.Crypto.KeyHash instance Lorentz.Annotation.HasAnnotation Tezos.Core.Timestamp instance Lorentz.Annotation.HasAnnotation Tezos.Crypto.PublicKey instance Lorentz.Annotation.HasAnnotation Tezos.Crypto.Signature instance Lorentz.Annotation.HasAnnotation Tezos.Core.ChainId instance Lorentz.Annotation.HasAnnotation a => Lorentz.Annotation.HasAnnotation (Michelson.Typed.Haskell.Value.ContractRef a) instance (Lorentz.Annotation.HasAnnotation k, Lorentz.Annotation.HasAnnotation v) => Lorentz.Annotation.HasAnnotation (Data.Map.Internal.Map k v) instance (Lorentz.Annotation.HasAnnotation k, Lorentz.Annotation.HasAnnotation v) => Lorentz.Annotation.HasAnnotation (Michelson.Typed.Haskell.Value.BigMap k v) instance Michelson.Typed.Haskell.Value.KnownIsoT v => Lorentz.Annotation.HasAnnotation (Data.Set.Internal.Set v) instance Lorentz.Annotation.HasAnnotation a => Lorentz.Annotation.HasAnnotation [a] instance Lorentz.Annotation.HasAnnotation Michelson.Typed.Aliases.Operation instance (Lorentz.Annotation.HasAnnotation a, Lorentz.Annotation.HasAnnotation b) => Lorentz.Annotation.HasAnnotation (Data.Either.Either a b) instance (Lorentz.Annotation.HasAnnotation a, Lorentz.Annotation.HasAnnotation b) => Lorentz.Annotation.HasAnnotation (a, b) instance (Lorentz.Annotation.HasAnnotation a, Lorentz.Annotation.HasAnnotation b, Lorentz.Annotation.HasAnnotation c) => Lorentz.Annotation.HasAnnotation (a, b, c) instance (Lorentz.Annotation.HasAnnotation a, Lorentz.Annotation.HasAnnotation b, Lorentz.Annotation.HasAnnotation c, Lorentz.Annotation.HasAnnotation d) => Lorentz.Annotation.HasAnnotation (a, b, c, d) instance (Lorentz.Annotation.HasAnnotation a, Lorentz.Annotation.HasAnnotation b, Lorentz.Annotation.HasAnnotation c, Lorentz.Annotation.HasAnnotation d, Lorentz.Annotation.HasAnnotation e) => Lorentz.Annotation.HasAnnotation (a, b, c, d, e) instance (Lorentz.Annotation.HasAnnotation a, Lorentz.Annotation.HasAnnotation b, Lorentz.Annotation.HasAnnotation c, Lorentz.Annotation.HasAnnotation d, Lorentz.Annotation.HasAnnotation e, Lorentz.Annotation.HasAnnotation f) => Lorentz.Annotation.HasAnnotation (a, b, c, d, e, f) instance (Lorentz.Annotation.HasAnnotation a, Lorentz.Annotation.HasAnnotation b, Lorentz.Annotation.HasAnnotation c, Lorentz.Annotation.HasAnnotation d, Lorentz.Annotation.HasAnnotation e, Lorentz.Annotation.HasAnnotation f, Lorentz.Annotation.HasAnnotation g) => Lorentz.Annotation.HasAnnotation (a, b, c, d, e, f, g) instance Lorentz.Annotation.HasAnnotation x => Lorentz.Annotation.GHasAnnotation (GHC.Generics.Rec0 x) instance Lorentz.Annotation.GHasAnnotation GHC.Generics.U1 instance Lorentz.Annotation.GHasAnnotation x => Lorentz.Annotation.GHasAnnotation (GHC.Generics.M1 GHC.Generics.S ('GHC.Generics.MetaSel 'GHC.Maybe.Nothing b c d) x) instance (Lorentz.Annotation.GHasAnnotation x, GHC.TypeLits.KnownSymbol a) => Lorentz.Annotation.GHasAnnotation (GHC.Generics.M1 GHC.Generics.S ('GHC.Generics.MetaSel ('GHC.Maybe.Just a) b c d) x) instance (Lorentz.Annotation.GHasAnnotation x, GHC.TypeLits.KnownSymbol a) => Lorentz.Annotation.GHasAnnotation (GHC.Generics.M1 GHC.Generics.C ('GHC.Generics.MetaCons a _p _f) x) instance Lorentz.Annotation.GHasAnnotation x => Lorentz.Annotation.GHasAnnotation (GHC.Generics.M1 GHC.Generics.D i1 x) instance (Lorentz.Annotation.GHasAnnotation x, Lorentz.Annotation.GHasAnnotation y) => Lorentz.Annotation.GHasAnnotation (x GHC.Generics.:+: y) instance (Lorentz.Annotation.GHasAnnotation x, Lorentz.Annotation.GHasAnnotation y) => Lorentz.Annotation.GHasAnnotation (x GHC.Generics.:*: y) -- | Scope-related constraints used in Lorentz. -- -- This contains constraints from Scope modified for use in -- Lorentz. module Lorentz.Constraints.Scopes type NiceComparable n = (KnownValue n, Comparable (ToT n)) type NiceConstant a = (KnownValue a, ProperConstantBetterErrors (ToT a)) type NiceFullPackedValue a = (NicePackedValue a, NiceUnpackedValue a) type NicePackedValue a = (KnownValue a, ProperPackedValBetterErrors (ToT a)) -- | Constraint applied to any part of parameter type. -- -- Note that you don't usually apply this constraint to the whole -- parameter, consider using NiceParameterFull in such case. -- -- Using this type is justified e.g. when calling another contract, there -- you usually supply an entrypoint argument, not the whole parameter. type NiceParameter a = (KnownValue a, ProperParameterBetterErrors (ToT a)) type NicePrintedValue a = (KnownValue a, ProperPrintedValBetterErrors (ToT a)) type NiceStorage a = (HasAnnotation a, KnownValue a, ProperStorageBetterErrors (ToT a)) type NiceUnpackedValue a = (KnownValue a, ProperUnpackedValBetterErrors (ToT a)) niceParameterEvi :: forall a. NiceParameter a :- ParameterScope (ToT a) niceStorageEvi :: forall a. NiceStorage a :- StorageScope (ToT a) niceConstantEvi :: forall a. NiceConstant a :- ConstantScope (ToT a) nicePackedValueEvi :: forall a. NicePackedValue a :- PackedValScope (ToT a) niceUnpackedValueEvi :: forall a. NiceUnpackedValue a :- UnpackedValScope (ToT a) nicePrintedValueEvi :: forall a. NicePrintedValue a :- PrintedValScope (ToT a) class (IsoValue a, HasNoNestedBigMaps (ToT a)) => CanHaveBigMap a -- | Gathers constraints, commonly required for values. class (IsoValue a, Typeable a) => KnownValue a -- | Ensure given type does not contain "operation". class (IsoValue a, ForbidOp (ToT a)) => NoOperation a class (IsoValue a, ForbidContract (ToT a)) => NoContractType a class (IsoValue a, ForbidBigMap (ToT a)) => NoBigMap 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 instance (Michelson.Typed.Haskell.Value.IsoValue a, Michelson.Typed.Scope.HasNoNestedBigMaps (Michelson.Typed.Haskell.Value.ToT a)) => Lorentz.Constraints.Scopes.CanHaveBigMap a instance (Michelson.Typed.Haskell.Value.IsoValue a, Michelson.Typed.Scope.ForbidBigMap (Michelson.Typed.Haskell.Value.ToT a)) => Lorentz.Constraints.Scopes.NoBigMap a instance (Michelson.Typed.Haskell.Value.IsoValue a, Michelson.Typed.Scope.ForbidContract (Michelson.Typed.Haskell.Value.ToT a)) => Lorentz.Constraints.Scopes.NoContractType a instance (Michelson.Typed.Haskell.Value.IsoValue a, Michelson.Typed.Scope.ForbidOp (Michelson.Typed.Haskell.Value.ToT a)) => Lorentz.Constraints.Scopes.NoOperation a instance (Michelson.Typed.Haskell.Value.IsoValue a, Data.Typeable.Internal.Typeable a) => Lorentz.Constraints.Scopes.KnownValue a module Lorentz.Entrypoints.Helpers ctorNameToAnn :: forall ctor. (KnownSymbol ctor, HasCallStack) => FieldAnn ctorNameToEp :: forall ctor. (KnownSymbol ctor, HasCallStack) => EpName -- | Used to understand whether a type can potentially declare any -- entrypoints. type family CanHaveEntrypoints (p :: Type) :: Bool -- | A special type which wraps over a primitive type and states that it -- has entrypoints (one). -- -- Assuming that any type can have entrypoints makes use of Lorentz -- entrypoints too annoying, so for declaring entrypoints for not sum -- types we require an explicit wrapper. newtype ShouldHaveEntrypoints a ShouldHaveEntrypoints :: a -> ShouldHaveEntrypoints a [unHasEntrypoints] :: ShouldHaveEntrypoints a -> a -- | Ensure that given type is a sum type. -- -- This helps to prevent attempts to apply a function to, for instance, a -- pair. type family RequireSumType (a :: Type) :: Constraint instance GHC.Generics.Generic (Lorentz.Entrypoints.Helpers.ShouldHaveEntrypoints a) instance Michelson.Typed.Haskell.Value.WellTypedIsoValue r => Michelson.Typed.Haskell.Value.IsoValue (Lorentz.Entrypoints.Helpers.ShouldHaveEntrypoints r) -- | Primitives supplying entrypoints declarations and lookup. module Lorentz.Entrypoints.Core -- | Used to understand whether a type can potentially declare any -- entrypoints. type family CanHaveEntrypoints (p :: Type) :: Bool -- | Defines a generalized way to declare entrypoints for various parameter -- types. -- -- When defining instances of this typeclass, set concrete deriv -- argument and leave variable cp argument. Also keep in mind, -- that in presence of explicit default entrypoint, all other Or -- arms should be callable, though you can put this burden on user if -- very necessary. -- -- Methods of this typeclass aim to better type-safety when making up an -- implementation and they may be not too convenient to use; users should -- exploit their counterparts. class EntrypointsDerivation deriv cp where { -- | Name and argument of each entrypoint. This may include intermediate -- ones, even root if necessary. -- -- Touching this type family is costly (O(N^2)), don't use it -- often. -- -- Note [order of entrypoints children]: If this contains entrypoints -- referring to indermediate nodes (not leaves) in or tree, then -- each such entrypoint should be mentioned eariler than all of its -- children. type family EpdAllEntrypoints deriv cp :: [(Symbol, Type)]; -- | Get entrypoint argument by name. type family EpdLookupEntrypoint deriv cp :: Symbol -> Exp (Maybe Type); } -- | Construct parameter annotations corresponding to expected entrypoints -- set. -- -- This method is implementation detail, for actual notes construction -- use parameterEntrypointsToNotes. epdNotes :: EntrypointsDerivation deriv cp => (Notes (ToT cp), RootAnn) -- | Construct entrypoint caller. -- -- This does not treat calls to default entrypoint in a special way. -- -- This method is implementation detail, for actual entrypoint lookup use -- parameterEntrypointCall. epdCall :: (EntrypointsDerivation deriv cp, ParameterScope (ToT cp)) => Label name -> EpConstructionRes (ToT cp) (Eval (EpdLookupEntrypoint deriv cp name)) -- | Description of how each of the entrypoints is constructed. epdDescs :: EntrypointsDerivation deriv cp => Rec EpCallingDesc (EpdAllEntrypoints deriv cp) -- | Result of entrypoint lookup at term level. data EpConstructionRes (param :: T) (marg :: Maybe Type) [EpConstructed] :: ParameterScope (ToT arg) => EpLiftSequence (ToT arg) param -> EpConstructionRes param ('Just arg) [EpConstructionFailed] :: EpConstructionRes param 'Nothing -- | How one of the entrypoints is called. -- -- Type arguments are name of the constructor which eventually gave name -- to the entrypoint and this entrypoint's argument. data EpCallingDesc (info :: (Symbol, Type)) [EpCallingDesc] :: {epcdArg :: Proxy (arg :: Type) " Entrypoint argument type.", epcdEntrypoint :: EpName " Name of assigned entrypoint.", epcdSteps :: [EpCallingStep] " If we emulated entrypoints calling via just wrapping an argument into constructors until getting the full parameter, how would it look like. Steps are enlisted in reversed order - top-level constructors go last."} -> EpCallingDesc '(name, arg) data EpCallingStep -- | Wrap into constructor with given name. EpsWrapIn :: Text -> EpCallingStep -- | Ensure that all declared entrypoints are unique. type RequireAllUniqueEntrypoints cp = RequireAllUniqueEntrypoints' (ParameterEntrypointsDerivation cp) cp -- | Which entrypoints given parameter declares. -- -- Note that usually this function should not be used as constraint, use -- ParameterDeclaresEntrypoints for this purpose. class (EntrypointsDerivation (ParameterEntrypointsDerivation cp) cp, RequireAllUniqueEntrypoints cp) => ParameterHasEntrypoints cp where { type family ParameterEntrypointsDerivation cp :: Type; } -- | Parameter declares some entrypoints. -- -- This is a version of ParameterHasEntrypoints which we actually -- use in constraints. When given type is a sum type or newtype, we refer -- to ParameterHasEntrypoints instance, otherwise this instance is -- not necessary. type ParameterDeclaresEntrypoints cp = (If (CanHaveEntrypoints cp) (ParameterHasEntrypoints cp) (() :: Constraint), NiceParameter cp, EntrypointsDerivation (GetParameterEpDerivation cp) cp) -- | Version of ParameterEntrypointsDerivation which we actually use -- in function signatures. When given type is sum type or newtype, we -- refer to ParameterEntrypointsDerivation, otherwise we suppose -- that no entrypoints are declared. type GetParameterEpDerivation cp = If (CanHaveEntrypoints cp) (ParameterEntrypointsDerivation cp) EpdNone -- | Version of epdNotes which we actually use in code. It hides -- derivations stuff inside, and treats primitive types specially like -- GetParameterEpDerivation does. pepNotes :: forall cp. ParameterDeclaresEntrypoints cp => (Notes (ToT cp), RootAnn) -- | Version of epdCall which we actually use in code. It hides -- derivations stuff inside, and treats primitive types specially like -- GetParameterEpDerivation does. pepCall :: forall cp name. (ParameterDeclaresEntrypoints cp, ParameterScope (ToT cp)) => Label name -> EpConstructionRes (ToT cp) (Eval (LookupParameterEntrypoint cp name)) -- | Version of epdDescs which we actually use in code. It hides -- derivations stuff inside, and treats primitive types specially like -- GetParameterEpDerivation does. pepDescs :: forall cp. ParameterDeclaresEntrypoints cp => Rec EpCallingDesc (AllParameterEntrypoints cp) -- | Descriptions of how each of the entrypoints is constructed. -- -- Similar to pepDescs, but includes default entrypoint disregard -- whether it is explicit or not, while pepDescs includes it only -- if it is explicit. Also this returns list, not Rec, for -- simplicity. -- -- Note that [order of entrypoints children] property still holds here. pepDescsWithDef :: forall cp. ParameterDeclaresEntrypoints cp => [Some1 EpCallingDesc] -- | Get all entrypoints declared for parameter. type family AllParameterEntrypoints (cp :: Type) :: [(Symbol, Type)] -- | Lookup for entrypoint type by name. -- -- Does not treat default entrypoints in a special way. type family LookupParameterEntrypoint (cp :: Type) :: Symbol -> Exp (Maybe Type) -- | Derive annotations for given parameter. parameterEntrypointsToNotes :: forall cp. ParameterDeclaresEntrypoints cp => ParamNotes (ToT cp) -- | Get type of entrypoint with given name, fail if not found. type GetEntrypointArg cp name = Eval (LiftM2 FromMaybe (TError ('Text "Entrypoint not found: " :<>: 'ShowType name :$$: 'Text "In contract parameter `" :<>: 'ShowType cp :<>: 'Text "`")) (LookupParameterEntrypoint cp name)) -- | Prepare call to given entrypoint. -- -- This does not treat calls to default entrypoint in a special way. To -- call default entrypoint properly use -- parameterEntrypointCallDefault. parameterEntrypointCall :: forall cp name. ParameterDeclaresEntrypoints cp => Label name -> EntrypointCall cp (GetEntrypointArg cp name) -- | Get type of entrypoint with given name, fail if not found. type GetDefaultEntrypointArg cp = Eval (LiftM2 FromMaybe (Pure cp) (LookupParameterEntrypoint cp DefaultEpName)) -- | Call the default entrypoint. parameterEntrypointCallDefault :: forall cp. ParameterDeclaresEntrypoints cp => EntrypointCall cp (GetDefaultEntrypointArg cp) -- | Ensure that there is no explicit "default" entrypoint. type ForbidExplicitDefaultEntrypoint cp = Eval (LiftM3 UnMaybe (Pure (Pure (() :: Constraint))) (TError ('Text "Parameter used here must have no explicit \"default\" entrypoint" :$$: 'Text "In parameter type `" :<>: 'ShowType cp :<>: 'Text "`")) (LookupParameterEntrypoint cp DefaultEpName)) -- | Similar to ForbidExplicitDefaultEntrypoint, but in a version -- which the compiler can work with (and which produces errors confusing -- for users :/) type NoExplicitDefaultEntrypoint cp = Eval (LookupParameterEntrypoint cp DefaultEpName) ~ 'Nothing -- | Call root entrypoint safely. sepcCallRootChecked :: forall cp. (NiceParameter cp, ForbidExplicitDefaultEntrypoint cp) => SomeEntrypointCall cp -- | Which entrypoint to call. -- -- We intentionally distinguish default and non-default cases because -- this makes API more details-agnostic. data EntrypointRef (mname :: Maybe Symbol) -- | Call the default entrypoint, or root if no explicit default is -- assigned. [CallDefault] :: EntrypointRef 'Nothing -- | Call the given entrypoint; calling default is not treated specially. -- You have to provide entrypoint name via passing it as type argument. -- -- Unfortunatelly, here we cannot accept a label because in most cases -- our entrypoints begin from capital letter (being derived from -- constructor name), while labels must start from a lower-case letter, -- and there is no way to make a conversion at type-level. [Call] :: NiceEntrypointName name => EntrypointRef ('Just name) -- | Constraint on type-level entrypoint name specifier. type NiceEntrypointName name = (KnownSymbol name, ForbidDefaultName name) eprName :: forall mname. EntrypointRef mname -> EpName -- | Universal entrypoint lookup. type family GetEntrypointArgCustom cp mname :: Type -- | This wrapper allows to pass untyped EpName and bypass checking -- that entrypoint with given name and type exists. newtype TrustEpName TrustEpName :: EpName -> TrustEpName -- | When we call a Lorentz contract we should pass entrypoint name and -- corresponding argument. Ideally we want to statically check that -- parameter has entrypoint with given name and argument. Constraint -- defined by this type class holds for contract with parameter -- cp that have entrypoint matching name with type -- arg. -- -- In order to check this property statically, we need to know entrypoint -- name in compile time, EntrypointRef type serves this purpose. -- If entrypoint name is not known, one can use TrustEpName -- wrapper to take responsibility for presence of this entrypoint. -- -- If you want to call a function which has this constraint, you have two -- options: 1. Pass contract parameter cp using type -- application, pass EntrypointRef as a value and pass entrypoint -- argument. Type system will check that cp has an entrypoint -- with given reference and type. 2. Pass EpName wrapped into -- TrustEpName and entrypoint argument. In this case passing -- contract parameter is not necessary, you do not even have to know it. class HasEntrypointArg cp name arg -- | Data returned by this method may look somewhat arbitrary. -- EpName is obviously needed because name can be -- EntrypointRef or TrustEpName. Dict is returned -- because in EntrypointRef case we get this evidence for free and -- don't want to use it. We seem to always need it anyway. useHasEntrypointArg :: HasEntrypointArg cp name arg => name -> (Dict (ParameterScope (ToT arg)), EpName) -- | HasEntrypointArg constraint specialized to default entrypoint. type HasDefEntrypointArg cp defEpName defArg = (defEpName ~ EntrypointRef 'Nothing, HasEntrypointArg cp defEpName defArg) -- | Checks that the given parameter consists of some specific entrypoint. -- Similar as HasEntrypointArg but ensures that the argument -- matches the following datatype. type HasEntrypointOfType param con exp = (GetEntrypointArgCustom param ('Just con) ~ exp, ParameterDeclaresEntrypoints param) -- | Check that the given entrypoint has some fields inside. This interface -- allows for an abstraction of contract parameter so that it requires -- some *minimal* specification, but not a concrete one. type family ParameterContainsEntrypoints param (fields :: [NamedEp]) :: Constraint -- | Universal entrypoint calling. parameterEntrypointCallCustom :: forall cp mname. ParameterDeclaresEntrypoints cp => EntrypointRef mname -> EntrypointCall cp (GetEntrypointArgCustom cp mname) -- | No entrypoints declared, parameter type will serve as argument type of -- the only existing entrypoint (default one). data EpdNone type n :> ty = 'NamedEp n ty infixr 0 :> type RequireAllUniqueEntrypoints' deriv cp = RequireAllUnique "entrypoint name" (Eval (Map Fst $ EpdAllEntrypoints deriv cp)) instance GHC.Classes.Eq Lorentz.Entrypoints.Core.EpCallingStep instance GHC.Show.Show Lorentz.Entrypoints.Core.EpCallingStep instance GHC.Show.Show (Lorentz.Entrypoints.Core.EpCallingDesc info) instance (Lorentz.Entrypoints.Core.GetEntrypointArgCustom cp mname GHC.Types.~ arg, Lorentz.Entrypoints.Core.ParameterDeclaresEntrypoints cp) => Lorentz.Entrypoints.Core.HasEntrypointArg cp (Lorentz.Entrypoints.Core.EntrypointRef mname) arg instance Lorentz.Annotation.HasAnnotation cp => Lorentz.Entrypoints.Core.EntrypointsDerivation Lorentz.Entrypoints.Core.EpdNone cp instance forall k arg (cp :: k). Lorentz.Constraints.Scopes.NiceParameter arg => Lorentz.Entrypoints.Core.HasEntrypointArg cp Lorentz.Entrypoints.Core.TrustEpName arg -- | Some derivative constraints. -- -- They are moved to separate module because they need to lie quite high -- in modules dependencies graph (unlike -- Lorentz.Constraints.Scopes). module Lorentz.Constraints.Derivative -- | Constraint applied to a whole parameter type. type NiceParameterFull cp = (Typeable cp, ParameterDeclaresEntrypoints cp) module Lorentz.Constraints -- | Foundation of Lorentz development. module Lorentz.Base -- | Alias for instruction which hides inner types representation via -- T. newtype (inp :: [Type]) :-> (out :: [Type]) LorentzInstr :: RemFail Instr (ToTs inp) (ToTs out) -> (:->) (inp :: [Type]) (out :: [Type]) [unLorentzInstr] :: (:->) (inp :: [Type]) (out :: [Type]) -> RemFail Instr (ToTs inp) (ToTs out) infixr 1 :-> -- | Alias for :->, seems to make signatures more readable -- sometimes. -- -- Let's someday decide which one of these two should remain. type (%>) = (:->) infixr 1 %> -- | An alias for :. -- -- We discourage its use as this hinders reading error messages (the -- compiler inserts unnecessary parentheses and indentation). type (&) (a :: Type) (b :: [Type]) = a : b infixr 2 & (#) :: (a :-> b) -> (b :-> c) -> a :-> c infixl 8 # pattern I :: Instr (ToTs inp) (ToTs out) -> inp :-> out pattern FI :: (forall out'. Instr (ToTs inp) out') -> inp :-> out iGenericIf :: (forall s'. Instr (ToTs a) s' -> Instr (ToTs b) s' -> Instr (ToTs c) s') -> (a :-> s) -> (b :-> s) -> c :-> s iAnyCode :: (inp :-> out) -> Instr (ToTs inp) (ToTs out) iNonFailingCode :: HasCallStack => (inp :-> out) -> Instr (ToTs inp) (ToTs out) iMapAnyCode :: (forall o'. Instr (ToTs i1) o' -> Instr (ToTs i2) o') -> (i1 :-> o) -> i2 :-> o iForceNotFail :: (i :-> o) -> i :-> o -- | Wrap Lorentz instruction with variable annotations, annots -- list has to be non-empty, otherwise this function raises an error. iWithVarAnnotations :: HasCallStack => [Text] -> (inp :-> out) -> inp :-> out -- | Parse textual representation of a Michelson value and turn it into -- corresponding Haskell value. -- -- Note: it won't work in some complex cases, e. g. if there is a lambda -- which uses an instruction which depends on current contract's type. -- Obviously it can not work, because we don't have any information about -- a contract to which this value belongs (there is no such contract at -- all). parseLorentzValue :: forall v. KnownValue v => Text -> Either ParseLorentzError v -- | Lorentz version of transformStrings. transformStringsLorentz :: Bool -> (MText -> MText) -> (inp :-> out) -> inp :-> out -- | Lorentz version of transformBytes. transformBytesLorentz :: Bool -> (ByteString -> ByteString) -> (inp :-> out) -> inp :-> out optimizeLorentz :: (inp :-> out) -> inp :-> out optimizeLorentzWithConf :: OptimizerConf -> (inp :-> out) -> inp :-> out -- | Applicable for wrappers over Lorentz code. class MapLorentzInstr instr -- | Modify all the code under given entity. mapLorentzInstr :: MapLorentzInstr instr => (forall i o. (i :-> o) -> i :-> o) -> instr -> instr type ContractOut st = '[([Operation], st)] type ContractCode cp st = '[(cp, st)] :-> ContractOut st data SomeContractCode [SomeContractCode] :: (NiceParameterFull cp, NiceStorage st) => ContractCode cp st -> SomeContractCode type Lambda i o = '[i] :-> '[o] instance GHC.Classes.Eq Lorentz.Base.ParseLorentzError instance GHC.Show.Show Lorentz.Base.ParseLorentzError instance GHC.Classes.Eq (inp Lorentz.Base.:-> out) instance GHC.Show.Show (inp Lorentz.Base.:-> out) instance Lorentz.Base.MapLorentzInstr (i Lorentz.Base.:-> o) instance Formatting.Buildable.Buildable Lorentz.Base.ParseLorentzError instance GHC.Base.Semigroup (s Lorentz.Base.:-> s) instance GHC.Base.Monoid (s Lorentz.Base.:-> s) -- | Common primitives. module Lorentz.Common -- | Single entrypoint of a contract. -- -- Note that we cannot make it return [[Operation], store] -- because such entrypoint should've been followed by pair, and -- this is not possible if entrypoint implementation ends with -- failWith. type Entrypoint param store = '[param, store] :-> ContractOut store -- | Version of Entrypoint which accepts no argument. type Entrypoint_ store = '[store] :-> ContractOut store -- | This module introduces several types for safe work with -- address and contract types. All available types for -- that are represented in the following table: -- -- TODO: table -- -- This module also provides functions for converting between these types -- in Haskell and Michelson worlds. In the latter you can additionally -- use coercions and dedicated instructions from Lorentz.Instr. module Lorentz.Address -- | Address which remembers the parameter type of the contract it refers -- to. -- -- It differs from Michelson's contract type because it cannot -- contain entrypoint, and it always refers to entire contract parameter -- even if this contract has explicit default entrypoint. newtype TAddress p TAddress :: Address -> TAddress p [unTAddress] :: TAddress p -> Address -- | Address associated with value of contract arg type. -- -- Places where ContractRef can appear are now severely limited, -- this type gives you type-safety of ContractRef but still can be -- used everywhere. This type is not a full-featured one rather a helper; -- in particular, once pushing it on stack, you cannot return it back to -- Haskell world. -- -- Note that it refers to an entrypoint of the contract, not just the -- contract as a whole. In this sense this type differs from -- TAddress. -- -- Unlike with ContractRef, having this type you still cannot be -- sure that the referred contract exists and need to perform a lookup -- before calling it. newtype FutureContract arg FutureContract :: ContractRef arg -> FutureContract arg [unFutureContract] :: FutureContract arg -> ContractRef arg -- | Turn TAddress to ContractRef in Haskell world. -- -- This is an analogy of address to contract convertion -- in Michelson world, thus you have to supply an entrypoint (or call the -- default one explicitly). callingTAddress :: forall cp mname. NiceParameterFull cp => TAddress cp -> EntrypointRef mname -> ContractRef (GetEntrypointArgCustom cp mname) -- | Specification of callTAddress to call the default entrypoint. callingDefTAddress :: forall cp. NiceParameterFull cp => TAddress cp -> ContractRef (GetDefaultEntrypointArg cp) -- | Convert something to Address in Haskell world. -- -- Use this when you want to access state of the contract and are not -- interested in calling it. class ToAddress a toAddress :: ToAddress a => a -> Address -- | Convert something referring to a contract (not specific entrypoint) to -- TAddress in Haskell world. class ToTAddress (cp :: Type) (a :: Type) toTAddress :: ToTAddress cp a => a -> TAddress cp -- | Something coercible to 'TAddress cp'. type ToTAddress_ cp addr = (ToTAddress cp addr, ToT addr ~ ToT Address) -- | Cast something appropriate to TAddress. toTAddress_ :: forall cp addr s. ToTAddress_ cp addr => (addr : s) :-> (TAddress cp : s) -- | Convert something to ContractRef in Haskell world. class ToContractRef (cp :: Type) (contract :: Type) toContractRef :: (ToContractRef cp contract, HasCallStack) => contract -> ContractRef cp -- | Convert something from ContractAddr in Haskell world. class FromContractRef (cp :: Type) (contract :: Type) fromContractRef :: FromContractRef cp contract => ContractRef cp -> contract convertContractRef :: forall cp contract2 contract1. (ToContractRef cp contract1, FromContractRef cp contract2) => contract1 -> contract2 data Address data EpAddress EpAddress :: Address -> EpName -> EpAddress [eaAddress] :: EpAddress -> Address [eaEntrypoint] :: EpAddress -> EpName data ContractRef arg ContractRef :: Address -> SomeEntrypointCall arg -> ContractRef arg [crAddress] :: ContractRef arg -> Address [crEntrypoint] :: ContractRef arg -> SomeEntrypointCall arg coerceContractRef :: ToT a ~ ToT b => ContractRef a -> ContractRef b instance forall k (p :: k). Lorentz.Annotation.HasAnnotation (Lorentz.Address.TAddress p) instance forall k (p :: k). Michelson.Typed.Haskell.Value.IsoValue (Lorentz.Address.TAddress p) instance forall k (p :: k). GHC.Generics.Generic (Lorentz.Address.TAddress p) instance (cp GHC.Types.~ cp') => Lorentz.Address.FromContractRef cp (Michelson.Typed.Haskell.Value.ContractRef cp') instance (cp GHC.Types.~ cp') => Lorentz.Address.FromContractRef cp (Lorentz.Address.FutureContract cp') instance Lorentz.Address.FromContractRef cp Michelson.Typed.Entrypoints.EpAddress instance Lorentz.Address.FromContractRef cp Tezos.Address.Address instance (cp GHC.Types.~ cp') => Lorentz.Address.ToContractRef cp (Michelson.Typed.Haskell.Value.ContractRef cp') instance (Lorentz.Constraints.Scopes.NiceParameter cp, cp GHC.Types.~ cp') => Lorentz.Address.ToContractRef cp (Lorentz.Address.FutureContract cp') instance (Util.Type.FailWhen cond msg, cond GHC.Types.~ (Lorentz.Entrypoints.Helpers.CanHaveEntrypoints cp Data.Type.Bool.&& Data.Type.Bool.Not (Lorentz.Entrypoints.Core.ParameterEntrypointsDerivation cp Data.Type.Equality.== Lorentz.Entrypoints.Core.EpdNone)), msg GHC.Types.~ (((('GHC.TypeLits.Text "Cannot apply `ToContractRef` to `TAddress`" 'GHC.TypeLits.:$$: 'GHC.TypeLits.Text "Consider using call(Def)TAddress first`") 'GHC.TypeLits.:$$: 'GHC.TypeLits.Text "(or if you know your parameter type is primitive,") 'GHC.TypeLits.:$$: 'GHC.TypeLits.Text " make sure typechecker also knows about that)") 'GHC.TypeLits.:$$: (('GHC.TypeLits.Text "For parameter `" 'GHC.TypeLits.:<>: 'GHC.TypeLits.ShowType cp) 'GHC.TypeLits.:<>: 'GHC.TypeLits.Text "`")), cp GHC.Types.~ arg, Lorentz.Constraints.Scopes.NiceParameter arg, Lorentz.Constraints.Derivative.NiceParameterFull cp, Lorentz.Entrypoints.Core.GetDefaultEntrypointArg cp GHC.Types.~ cp) => Lorentz.Address.ToContractRef arg (Lorentz.Address.TAddress cp) instance Lorentz.Address.ToTAddress cp Tezos.Address.Address instance (cp GHC.Types.~ cp') => Lorentz.Address.ToTAddress cp (Lorentz.Address.TAddress cp') instance Lorentz.Address.ToAddress Tezos.Address.Address instance Lorentz.Address.ToAddress Michelson.Typed.Entrypoints.EpAddress instance forall k (cp :: k). Lorentz.Address.ToAddress (Lorentz.Address.TAddress cp) instance Lorentz.Address.ToAddress (Lorentz.Address.FutureContract cp) instance Lorentz.Address.ToAddress (Michelson.Typed.Haskell.Value.ContractRef cp) instance Michelson.Typed.Haskell.Value.IsoValue (Lorentz.Address.FutureContract arg) instance Lorentz.Annotation.HasAnnotation (Lorentz.Address.FutureContract a) -- | Lorentz wrappers over instructions from Morley extension. module Lorentz.Ext -- | Include a value at given position on stack into comment produced by -- printComment. -- --
-- >>> stackRef @0 -- <includes the top of the stack> --stackRef :: forall (gn :: Nat) st n. (n ~ ToPeano gn, SingI n, KnownPeano n, RequireLongerThan st n) => PrintComment st -- | Print a comment. It will be visible in tests. -- --
-- >>> printComment "Hello world!" -- -- >>> printComment $ "On top of the stack I see " <> stackRef @0 --printComment :: PrintComment (ToTs s) -> s :-> s -- | Test an invariant, fail if it does not hold. -- -- This won't be included into production contract and is executed only -- in tests. testAssert :: (Typeable (ToTs out), HasCallStack) => Text -> PrintComment (ToTs inp) -> (inp :-> (Bool : out)) -> inp :-> inp -- | Fix the current type of the stack to be given one. -- --
-- >>> stackType @'[Natural] -- -- >>> stackType @(Integer : Natural : s) -- -- >>> stackType @'["balance" :! Integer, "toSpend" :! Integer, BigMap Address Integer] ---- -- Note that you can omit arbitrary parts of the type. -- --
-- >>> stackType @'["balance" :! Integer, "toSpend" :! _, BigMap _ _] --stackType :: forall s. s :-> s -- | Type families from Polymorphic lifted to Haskell types. module Lorentz.Polymorphic -- | Lifted MemOpKey. class (MemOp (ToT c), ToT (MemOpKeyHs c) ~ MemOpKey (ToT c)) => MemOpHs c where { type family MemOpKeyHs c :: Type; } -- | Lifted MapOp. class (MapOp (ToT c), ToT (MapOpInpHs c) ~ MapOpInp (ToT c), ToT (MapOpResHs c ()) ~ MapOpRes (ToT c) (ToT ())) => MapOpHs c where { type family MapOpInpHs c :: Type; type family MapOpResHs c :: Type -> Type; } -- | Lifted IterOp. class (IterOp (ToT c), ToT (IterOpElHs c) ~ IterOpEl (ToT c)) => IterOpHs c where { type family IterOpElHs c :: Type; } -- | Lifted SizeOp. -- -- This could be just a constraint alias, but to avoid T types -- appearance in error messages we make a full type class with concrete -- instances. class SizeOp (ToT c) => SizeOpHs c -- | Lifted UpdOp. class (UpdOp (ToT c), ToT (UpdOpKeyHs c) ~ (UpdOpKey (ToT c)), ToT (UpdOpParamsHs c) ~ UpdOpParams (ToT c)) => UpdOpHs c where { type family UpdOpKeyHs c :: Type; type family UpdOpParamsHs c :: Type; } -- | Lifted GetOp. class (GetOp (ToT c), ToT (GetOpKeyHs c) ~ (GetOpKey (ToT c)), ToT (GetOpValHs c) ~ GetOpVal (ToT c)) => GetOpHs c where { type family GetOpKeyHs c :: Type; type family GetOpValHs c :: Type; } -- | Lifted ConcatOp. class ConcatOp (ToT c) => ConcatOpHs c -- | Lifted SliceOp. class SliceOp (ToT c) => SliceOpHs c -- | Lifted EDivOp. class (EDivOp (ToT n) (ToT m), NiceComparable n, NiceComparable m, ToT (EDivOpResHs n m) ~ EDivOpRes (ToT n) (ToT m), ToT (EModOpResHs n m) ~ EModOpRes (ToT n) (ToT m)) => EDivOpHs n m where { type family EDivOpResHs n m :: Type; type family EModOpResHs n m :: Type; } -- | A useful property which holds for reasonable MapOp instances. -- -- It's a separate thing from MapOpHs because it mentions -- b type parameter. type family IsoMapOpRes c b instance Lorentz.Polymorphic.EDivOpHs GHC.Integer.Type.Integer GHC.Integer.Type.Integer instance Lorentz.Polymorphic.EDivOpHs GHC.Integer.Type.Integer GHC.Natural.Natural instance Lorentz.Polymorphic.EDivOpHs GHC.Natural.Natural GHC.Integer.Type.Integer instance Lorentz.Polymorphic.EDivOpHs GHC.Natural.Natural GHC.Natural.Natural instance Lorentz.Polymorphic.EDivOpHs Tezos.Core.Mutez Tezos.Core.Mutez instance Lorentz.Polymorphic.EDivOpHs Tezos.Core.Mutez GHC.Natural.Natural instance Lorentz.Polymorphic.SliceOpHs Michelson.Text.MText instance Lorentz.Polymorphic.SliceOpHs Data.ByteString.Internal.ByteString instance Lorentz.Polymorphic.ConcatOpHs Michelson.Text.MText instance Lorentz.Polymorphic.ConcatOpHs Data.ByteString.Internal.ByteString instance Lorentz.Constraints.Scopes.NiceComparable k => Lorentz.Polymorphic.GetOpHs (Data.Map.Internal.Map k v) instance Lorentz.Constraints.Scopes.NiceComparable k => Lorentz.Polymorphic.GetOpHs (Michelson.Typed.Haskell.Value.BigMap k v) instance Lorentz.Constraints.Scopes.NiceComparable k => Lorentz.Polymorphic.UpdOpHs (Data.Map.Internal.Map k v) instance Lorentz.Constraints.Scopes.NiceComparable k => Lorentz.Polymorphic.UpdOpHs (Michelson.Typed.Haskell.Value.BigMap k v) instance Lorentz.Constraints.Scopes.NiceComparable a => Lorentz.Polymorphic.UpdOpHs (Data.Set.Internal.Set a) instance Lorentz.Polymorphic.SizeOpHs Michelson.Text.MText instance Lorentz.Polymorphic.SizeOpHs Data.ByteString.Internal.ByteString instance Lorentz.Polymorphic.SizeOpHs (Data.Set.Internal.Set a) instance Lorentz.Polymorphic.SizeOpHs [a] instance Lorentz.Polymorphic.SizeOpHs (Data.Map.Internal.Map k v) instance Lorentz.Constraints.Scopes.NiceComparable k => Lorentz.Polymorphic.IterOpHs (Data.Map.Internal.Map k v) instance Lorentz.Polymorphic.IterOpHs [e] instance Lorentz.Constraints.Scopes.NiceComparable e => Lorentz.Polymorphic.IterOpHs (Data.Set.Internal.Set e) instance Lorentz.Constraints.Scopes.NiceComparable k => Lorentz.Polymorphic.MapOpHs (Data.Map.Internal.Map k v) instance Lorentz.Polymorphic.MapOpHs [e] instance Lorentz.Constraints.Scopes.NiceComparable e => Lorentz.Polymorphic.MemOpHs (Data.Set.Internal.Set e) instance Lorentz.Constraints.Scopes.NiceComparable k => Lorentz.Polymorphic.MemOpHs (Data.Map.Internal.Map k v) instance Lorentz.Constraints.Scopes.NiceComparable k => Lorentz.Polymorphic.MemOpHs (Michelson.Typed.Haskell.Value.BigMap k v) -- | Commonly used parts of regular Prelude. module Lorentz.Prelude -- | Application operator. This operator is redundant, since ordinary -- application (f x) means the same as (f $ x). -- However, $ has low, right-associative binding precedence, so it -- sometimes allows parentheses to be omitted; for example: -- --
-- f $ g $ h x = f (g (h x)) ---- -- It is also useful in higher-order situations, such as map -- ($ 0) xs, or zipWith ($) fs xs. -- -- Note that ($) is levity-polymorphic in its result -- type, so that foo $ True where foo :: Bool -> -- Int# is well-typed. ($) :: forall (r :: RuntimeRep) a (b :: TYPE r). (a -> b) -> a -> b infixr 0 $ -- | Function composition. (.) :: (b -> c) -> (a -> b) -> a -> c infixr 9 . -- | Infix application. -- --
-- f :: Either String $ Maybe Int -- = -- f :: Either String (Maybe Int) --type (f :: k1 -> k) $ (a :: k1) = f a infixr 2 $ -- | The Eq class defines equality (==) and inequality -- (/=). All the basic datatypes exported by the Prelude -- are instances of Eq, and Eq may be derived for any -- datatype whose constituents are also instances of Eq. -- -- The Haskell Report defines no laws for Eq. However, == -- is customarily expected to implement an equivalence relationship where -- two values comparing equal are indistinguishable by "public" -- functions, with a "public" function being one not allowing to see -- implementation details. For example, for a type representing -- non-normalised natural numbers modulo 100, a "public" function doesn't -- make the difference between 1 and 201. It is expected to have the -- following properties: -- --
-- from . to ≡ id -- to . from ≡ id --class Generic a -- | A space efficient, packed, unboxed Unicode text type. data Text -- | The Either type represents values with two possibilities: a -- value of type Either a b is either Left -- a or Right b. -- -- The Either type is sometimes used to represent a value which is -- either correct or an error; by convention, the Left constructor -- is used to hold an error value and the Right constructor is -- used to hold a correct value (mnemonic: "right" also means "correct"). -- --
-- >>> let s = Left "foo" :: Either String Int -- -- >>> s -- Left "foo" -- -- >>> let n = Right 3 :: Either String Int -- -- >>> n -- Right 3 -- -- >>> :type s -- s :: Either String Int -- -- >>> :type n -- n :: Either String Int ---- -- The fmap from our Functor instance will ignore -- Left values, but will apply the supplied function to values -- contained in a Right: -- --
-- >>> let s = Left "foo" :: Either String Int -- -- >>> let n = Right 3 :: Either String Int -- -- >>> fmap (*2) s -- Left "foo" -- -- >>> fmap (*2) n -- Right 6 ---- -- The Monad instance for Either allows us to chain -- together multiple actions which may fail, and fail overall if any of -- the individual steps failed. First we'll write a function that can -- either parse an Int from a Char, or fail. -- --
-- >>> import Data.Char ( digitToInt, isDigit )
--
-- >>> :{
-- let parseEither :: Char -> Either String Int
-- parseEither c
-- | isDigit c = Right (digitToInt c)
-- | otherwise = Left "parse error"
--
-- >>> :}
--
--
-- The following should work, since both '1' and '2'
-- can be parsed as Ints.
--
--
-- >>> :{
-- let parseMultiple :: Either String Int
-- parseMultiple = do
-- x <- parseEither '1'
-- y <- parseEither '2'
-- return (x + y)
--
-- >>> :}
--
--
-- -- >>> parseMultiple -- Right 3 ---- -- But the following should fail overall, since the first operation where -- we attempt to parse 'm' as an Int will fail: -- --
-- >>> :{
-- let parseMultiple :: Either String Int
-- parseMultiple = do
-- x <- parseEither 'm'
-- y <- parseEither '2'
-- return (x + y)
--
-- >>> :}
--
--
-- -- >>> parseMultiple -- Left "parse error" --data Either a b Left :: a -> Either a b Right :: b -> Either a b -- | The Maybe type encapsulates an optional value. A value of type -- Maybe a either contains a value of type a -- (represented as Just a), or it is empty (represented -- as Nothing). Using Maybe is a good way to deal with -- errors or exceptional cases without resorting to drastic measures such -- as error. -- -- The Maybe type is also a monad. It is a simple kind of error -- monad, where all errors are represented by Nothing. A richer -- error monad can be built using the Either type. data Maybe a Nothing :: Maybe a Just :: a -> Maybe a -- | Proxy is a type that holds no data, but has a phantom parameter -- of arbitrary type (or even kind). Its use is to provide type -- information, even though there is no value available of that type (or -- it may be too costly to create one). -- -- Historically, Proxy :: Proxy a is a safer -- alternative to the undefined :: a idiom. -- --
-- >>> Proxy :: Proxy (Void, Int -> Int) -- Proxy ---- -- Proxy can even hold types of higher kinds, -- --
-- >>> Proxy :: Proxy Either -- Proxy ---- --
-- >>> Proxy :: Proxy Functor -- Proxy ---- --
-- >>> Proxy :: Proxy complicatedStructure -- Proxy --data Proxy (t :: k) Proxy :: Proxy (t :: k) fromString :: IsString a => String -> a -- | undefined that leaves a warning in code on every usage. undefined :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => a -- | error that takes Text as an argument. error :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => Text -> a -- | Re-exports typed Value, CValue, some core types, some helpers and -- defines aliases for constructors of typed values. module Lorentz.Value type Value = Value' Instr class WellTypedToT a => IsoValue a where { type family ToT a :: T; type ToT a = GValueType Rep a; } toVal :: IsoValue a => a -> Value (ToT a) fromVal :: IsoValue a => Value (ToT a) -> a type WellTypedIsoValue a = (WellTyped ToT a, IsoValue a) -- | Invariant: Jn# and Jp# are used iff value doesn't fit in -- S# -- -- Useful properties resulting from the invariants: -- -- data Integer -- | Type representing arbitrary-precision non-negative integers. -- --
-- >>> 2^100 :: Natural -- 1267650600228229401496703205376 ---- -- Operations whose result would be negative throw -- (Underflow :: ArithException), -- --
-- >>> -1 :: Natural -- *** Exception: arithmetic underflow --data Natural data MText data Bool False :: Bool True :: Bool -- | A space-efficient representation of a Word8 vector, supporting -- many efficient operations. -- -- A ByteString contains 8-bit bytes, or by using the operations -- from Data.ByteString.Char8 it can be interpreted as containing -- 8-bit characters. data ByteString data Address data EpAddress EpAddress :: Address -> EpName -> EpAddress [eaAddress] :: EpAddress -> Address [eaEntrypoint] :: EpAddress -> EpName data Mutez data Timestamp data ChainId data KeyHash data PublicKey data Signature -- | A set of values a. data Set a -- | A Map from keys k to values a. -- -- The Semigroup operation for Map is union, which -- prefers values from the left operand. If m1 maps a key -- k to a value a1, and m2 maps the same key -- to a different value a2, then their union m1 <> -- m2 maps k to a1. data Map k a newtype BigMap k v BigMap :: Map k v -> BigMap k v [unBigMap] :: BigMap k v -> Map k v type Operation = Operation' Instr -- | The Maybe type encapsulates an optional value. A value of type -- Maybe a either contains a value of type a -- (represented as Just a), or it is empty (represented -- as Nothing). Using Maybe is a good way to deal with -- errors or exceptional cases without resorting to drastic measures such -- as error. -- -- The Maybe type is also a monad. It is a simple kind of error -- monad, where all errors are represented by Nothing. A richer -- error monad can be built using the Either type. data Maybe a Nothing :: Maybe a Just :: a -> Maybe a type List = [] data ContractRef arg ContractRef :: Address -> SomeEntrypointCall arg -> ContractRef arg [crAddress] :: ContractRef arg -> Address [crEntrypoint] :: ContractRef arg -> SomeEntrypointCall arg -- | Address which remembers the parameter type of the contract it refers -- to. -- -- It differs from Michelson's contract type because it cannot -- contain entrypoint, and it always refers to entire contract parameter -- even if this contract has explicit default entrypoint. newtype TAddress p TAddress :: Address -> TAddress p [unTAddress] :: TAddress p -> Address -- | Address associated with value of contract arg type. -- -- Places where ContractRef can appear are now severely limited, -- this type gives you type-safety of ContractRef but still can be -- used everywhere. This type is not a full-featured one rather a helper; -- in particular, once pushing it on stack, you cannot return it back to -- Haskell world. -- -- Note that it refers to an entrypoint of the contract, not just the -- contract as a whole. In this sense this type differs from -- TAddress. -- -- Unlike with ContractRef, having this type you still cannot be -- sure that the referred contract exists and need to perform a lookup -- before calling it. newtype FutureContract arg FutureContract :: ContractRef arg -> FutureContract arg [unFutureContract] :: FutureContract arg -> ContractRef arg data EpName pattern DefEpName :: EpName type EntrypointCall param arg = EntrypointCallT ToT param ToT arg type SomeEntrypointCall arg = SomeEntrypointCallT ToT arg toMutez :: Word32 -> Mutez zeroMutez :: Mutez oneMutez :: Mutez mt :: QuasiQuoter timestampFromSeconds :: Integer -> Timestamp timestampFromUTCTime :: UTCTime -> Timestamp timestampQuote :: QuasiQuoter coerceContractRef :: ToT a ~ ToT b => ContractRef a -> ContractRef b -- | Turn TAddress to ContractRef in Haskell world. -- -- This is an analogy of address to contract convertion -- in Michelson world, thus you have to supply an entrypoint (or call the -- default one explicitly). callingTAddress :: forall cp mname. NiceParameterFull cp => TAddress cp -> EntrypointRef mname -> ContractRef (GetEntrypointArgCustom cp mname) -- | Specification of callTAddress to call the default entrypoint. callingDefTAddress :: forall cp. NiceParameterFull cp => TAddress cp -> ContractRef (GetDefaultEntrypointArg cp) -- | Convert something to Address in Haskell world. -- -- Use this when you want to access state of the contract and are not -- interested in calling it. class ToAddress a toAddress :: ToAddress a => a -> Address -- | Convert something referring to a contract (not specific entrypoint) to -- TAddress in Haskell world. class ToTAddress (cp :: Type) (a :: Type) toTAddress :: ToTAddress cp a => a -> TAddress cp -- | Convert something to ContractRef in Haskell world. class ToContractRef (cp :: Type) (contract :: Type) toContractRef :: (ToContractRef cp contract, HasCallStack) => contract -> ContractRef cp -- | Convert something from ContractAddr in Haskell world. class FromContractRef (cp :: Type) (contract :: Type) fromContractRef :: FromContractRef cp contract => ContractRef cp -> contract convertContractRef :: forall cp contract2 contract1. (ToContractRef cp contract1, FromContractRef cp contract2) => contract1 -> contract2 -- | Conversion of values to readable Strings. -- -- Derived instances of Show have the following properties, which -- are compatible with derived instances of Read: -- --
-- infixr 5 :^: -- data Tree a = Leaf a | Tree a :^: Tree a ---- -- the derived instance of Show is equivalent to -- --
-- instance (Show a) => Show (Tree a) where -- -- showsPrec d (Leaf m) = showParen (d > app_prec) $ -- showString "Leaf " . showsPrec (app_prec+1) m -- where app_prec = 10 -- -- showsPrec d (u :^: v) = showParen (d > up_prec) $ -- showsPrec (up_prec+1) u . -- showString " :^: " . -- showsPrec (up_prec+1) v -- where up_prec = 5 ---- -- Note that right-associativity of :^: is ignored. For example, -- --
-- fn (arg #t -> t) (arg #f -> f) = ... ---- -- This way, the names of parameters can be inferred from the patterns: -- no type signature for fn is required. In case a type -- signature for fn is provided, the parameters must come in the -- same order: -- --
-- fn :: "t" :! Integer -> "f" :! Integer -> ... -- fn (arg #t -> t) (arg #f -> f) = ... -- ok -- fn (arg #f -> f) (arg #t -> t) = ... -- does not typecheck --arg :: forall (name :: Symbol) a. Name name -> (name :! a) -> a -- | A variation of arg for optional arguments. Requires a default -- value to handle the case when the optional argument was omitted: -- --
-- fn (argDef #answer 42 -> ans) = ... ---- -- In case you want to get a value wrapped in Maybe instead, use -- argF or ArgF. argDef :: forall (name :: Symbol) a. Name name -> a -> (name :? a) -> a -- | argF is similar to arg: it unwraps a named parameter -- with the specified name. The difference is that the result of -- argF is inside an arity wrapper, which is Identity for -- normal parameters and Maybe for optional parameters. argF :: forall (name :: Symbol) f a. Name name -> NamedF f a name -> f a instance (name GHC.Types.~ GHC.TypeLits.AppendSymbol "c" ctor, body GHC.Types.~ (Michelson.Typed.Haskell.Instr.Sum.AppendCtorField x inp Lorentz.Base.:-> out)) => Lorentz.ADT.CaseArrow name body (Lorentz.ADT.CaseClauseL inp out ('Michelson.Typed.Haskell.Instr.Sum.CaseClauseParam ctor x)) -- | Utilities for declaring and documenting entry points. module Lorentz.Entrypoints.Doc -- | Gathers information about single entrypoint. -- -- We assume that entry points might be of different kinds, which is -- designated by phantom type parameter. For instance, you may want to -- have several groups of entry points corresponding to various parts of -- a contract - specifying different kind type argument for each -- of those groups will allow you defining different DocItem -- instances with appropriate custom descriptions for them. data DEntrypoint (kind :: Type) DEntrypoint :: Text -> SubDoc -> DEntrypoint (kind :: Type) [depName] :: DEntrypoint (kind :: Type) -> Text [depSub] :: DEntrypoint (kind :: Type) -> SubDoc -- | Pattern that checks whether given SomeDocItem hides -- DEntrypoint inside (of any entrypoint kind). -- -- In case a specific kind is necessary, use plain (cast -> Just -- DEntrypoint{..}) construction instead. pattern DEntrypointDocItem :: DEntrypoint kind -> SomeDocItem -- | Describes location of entrypoints of the given kind. -- -- All such entrypoints will be placed under the same "entrypoints" -- section, and this instance defines characteristics of this section. class Typeable ep => EntrypointKindHasDoc (ep :: Type) -- | Position of the respective entrypoints section in the doc. This shares -- the same positions space with all other doc items. entrypointKindPos :: EntrypointKindHasDoc ep => Natural -- | Name of the respective entrypoints section. entrypointKindSectionName :: EntrypointKindHasDoc ep => Text -- | Description in the respective entrypoints section. entrypointKindSectionDescription :: EntrypointKindHasDoc ep => Maybe Markdown -- | Mark code as part of entrypoint with given name. -- -- This is automatically called at most of the appropriate situations, -- like entryCase calls. entrypointSection :: EntrypointKindHasDoc kind => Text -> Proxy kind -> (i :-> o) -> i :-> o -- | Inserts a reference to an existing entrypoint. -- -- This helps to avoid duplication in the generated documentation, in -- order not to overwhelm the reader. data DEntrypointReference DEntrypointReference :: Text -> Anchor -> DEntrypointReference -- | Provides arror for convenient entrypoint documentation class EntryArrow kind name body -- | Lift entrypoint implementation. -- -- Entrypoint names should go with "e" prefix. (#->) :: EntryArrow kind name body => (Label name, Proxy kind) -> body -> body -- | Default value for DEntrypoint type argument. data PlainEntrypointsKind -- | Describes the behaviour common for all entrypoints. -- -- For instance, if your contract runs some checks before calling any -- entrypoint, you probably want to wrap those checks into -- entrypointSection "Prior checks" (Proxy -- @CommonContractBehaviourKind). data CommonContractBehaviourKind -- | Describes the behaviour common for entrypoints of given kind. -- -- This has very special use cases, like contracts with mix of -- upgradeable and permanent entrypoints. data CommonEntrypointsBehaviourKind kind -- | Default implementation of docItemToMarkdown for entrypoints. diEntrypointToMarkdown :: HeaderLevel -> DEntrypoint level -> Markdown -- | Describes argument of an entrypoint. data DEntrypointArg DEntrypointArg :: Maybe DType -> [ParamBuildingStep] -> Type -> DEntrypointArg -- | Argument of the entrypoint. Pass Nothing if no argument is -- required. [epaArg] :: DEntrypointArg -> Maybe DType -- | Describes a way to lift an entrypoint argument into full parameter -- which can be passed to the contract. -- -- Steps are supposed to be applied in the order opposite to one in which -- they are given. E.g. suppose that an entrypoint is called as Run -- (Service1 arg); then the first step (actual last) should describe -- wrapping into Run constructor, and the second step (actual -- first) should be about wrapping into Service1 constructor. [epaBuilding] :: DEntrypointArg -> [ParamBuildingStep] -- | Untyped representation of entrypoint, used for printing its michelson -- type representation. [epaType] :: DEntrypointArg -> Type data DType [DType] :: forall a. TypeHasDoc a => Proxy a -> DType -- | Pick a type documentation from CtorField. class (KnownSymbol con) => DeriveCtorFieldDoc con (cf :: CtorField) deriveCtorFieldDoc :: DeriveCtorFieldDoc con cf => DEntrypointArg -- | When describing the way of parameter construction - piece of -- incremental builder for this description. newtype ParamBuilder ParamBuilder :: (Markdown -> Markdown) -> ParamBuilder -- | Argument stands for previously constructed parameter piece, and -- returned value - a piece constructed after our step. [unParamBuilder] :: ParamBuilder -> Markdown -> Markdown data ParamBuildingDesc ParamBuildingDesc :: Markdown -> ParamBuilder -> ParamBuilder -> ParamBuildingDesc -- | Plain english description of this step. [pbdEnglish] :: ParamBuildingDesc -> Markdown -- | How to construct parameter in Haskell code. [pbdHaskell] :: ParamBuildingDesc -> ParamBuilder -- | How to construct parameter working on raw Michelson. [pbdMichelson] :: ParamBuildingDesc -> ParamBuilder -- | Describes a parameter building step. -- -- This can be wrapping into (Haskell) constructor, or a more complex -- transformation. data ParamBuildingStep -- | Wraps something into constructor with given name. Constructor should -- be the one which corresponds to an entrypoint defined via field -- annotation, for more complex cases use PbsCustom. PbsWrapIn :: Text -> ParamBuildingDesc -> ParamBuildingStep -- | Directly call an entrypoint marked with a field annotation. PbsCallEntrypoint :: EpName -> ParamBuildingStep -- | Other action. PbsCustom :: ParamBuildingDesc -> ParamBuildingStep -- | This entrypoint cannot be called, which is possible when an explicit -- default entrypoint is present. This is not a true entrypoint but just -- some intermediate node in or tree and neither it nor any of -- its parents are marked with a field annotation. -- -- It contains dummy ParamBuildingSteps which were assigned before -- entrypoints were taken into account. PbsUncallable :: [ParamBuildingStep] -> ParamBuildingStep -- | Make a ParamBuildingStep that tells about wrapping an argument -- into a constructor with given name and uses given ParamBuilder -- as description of Michelson part. mkPbsWrapIn :: Text -> ParamBuilder -> ParamBuildingStep -- | Go over contract code and update every occurrence of -- DEntrypointArg documentation item, adding the given step to its -- "how to build parameter" description. clarifyParamBuildingSteps :: ParamBuildingStep -> (inp :-> out) -> inp :-> out constructDEpArg :: forall arg. (TypeHasDoc arg, HasAnnotation arg, KnownValue arg) => DEntrypointArg emptyDEpArg :: DEntrypointArg mkUType :: forall (x :: T). SingI x => Notes x -> Type mkDEpUType :: forall t. (KnownValue t, HasAnnotation t) => Type mkDEntrypointArgSimple :: forall t. (KnownValue t, HasAnnotation t, TypeHasDoc t) => DEntrypointArg -- | Constraint for documentEntrypoints. type DocumentEntrypoints kind a = (Generic a, GDocumentEntrypoints kind (Rep a)) -- | Wrapper for documenting single entrypoint which parameter isn't going -- to be unwrapped from some datatype. -- -- entryCase unwraps a datatype, however, sometimes we want to -- have entrypoint parameter to be not wrapped into some datatype. documentEntrypoint :: forall kind epName param s out. (KnownSymbol epName, DocItem (DEntrypoint kind), TypeHasDoc param, HasAnnotation param, KnownValue param) => ((param : s) :-> out) -> (param : s) :-> out -- | Version of entryCase_ for tuples. entryCase :: forall dt entrypointKind out inp clauses. (CaseTC dt out inp clauses, DocumentEntrypoints entrypointKind dt) => Proxy entrypointKind -> IsoRecTuple clauses -> (dt : inp) :-> out -- | Like case_, to be used for pattern-matching on a parameter or -- its part. -- -- Modifies documentation accordingly. Including description of -- entrypoints' arguments, thus for them you will need to supply -- TypeHasDoc instance. entryCase_ :: forall dt entrypointKind out inp. (InstrCaseC dt, RMap (CaseClauses dt), DocumentEntrypoints entrypointKind dt) => Proxy entrypointKind -> Rec (CaseClauseL inp out) (CaseClauses dt) -> (dt : inp) :-> out -- | Version of 'finalizeParamCallingDoc'' more convenient for manual call -- in a contract. finalizeParamCallingDoc :: forall cp inp out. (NiceParameterFull cp, RequireSumType cp, HasCallStack) => ((cp : inp) :-> out) -> (cp : inp) :-> out -- | Modify param building steps with respect to entrypoints that given -- parameter declares. -- -- Each contract with entrypoints should eventually call this function, -- otherwise, in case if contract uses built-in entrypoints feature, the -- resulting parameter building steps in the generated documentation will -- not consider entrypoints and thus may be incorrect. -- -- Calling this twice over the same code is also prohibited. -- -- This method is for internal use, if you want to apply it to a contract -- manually, use finalizeParamCallingDoc. finalizeParamCallingDoc' :: forall cp inp out. (NiceParameterFull cp, HasCallStack) => Proxy cp -> (inp :-> out) -> inp :-> out -- | Whether finalizeParamCallingDoc has already been applied to -- these steps. areFinalizedParamBuildingSteps :: [ParamBuildingStep] -> Bool entryCaseSimple_ :: forall cp out inp. (InstrCaseC cp, RMap (CaseClauses cp), DocumentEntrypoints PlainEntrypointsKind cp, RequireFlatParamEps cp) => Rec (CaseClauseL inp out) (CaseClauses cp) -> (cp : inp) :-> out -- | Version of entryCase for contracts with flat parameter, use it -- when you need only one entryCase all over the contract -- implementation. entryCaseSimple :: forall cp out inp clauses. (CaseTC cp out inp clauses, DocumentEntrypoints PlainEntrypointsKind cp, RequireFlatParamEps cp) => IsoRecTuple clauses -> (cp : inp) :-> out type family RequireFlatParamEps cp :: Constraint type family RequireFlatEpDerivation cp deriv :: Constraint instance GHC.Classes.Eq Lorentz.Entrypoints.Doc.ParamBuildingStep instance GHC.Show.Show Lorentz.Entrypoints.Doc.ParamBuildingStep instance GHC.Classes.Eq Lorentz.Entrypoints.Doc.ParamBuildingDesc instance GHC.Show.Show Lorentz.Entrypoints.Doc.ParamBuildingDesc instance (name GHC.Types.~ GHC.TypeLits.AppendSymbol "e" epName, body GHC.Types.~ ((param : s) Lorentz.Base.:-> out), GHC.TypeLits.KnownSymbol epName, Michelson.Doc.DocItem (Lorentz.Entrypoints.Doc.DEntrypoint kind), Michelson.Typed.Haskell.Doc.TypeHasDoc param, Lorentz.Annotation.HasAnnotation param, Lorentz.Constraints.Scopes.KnownValue param) => Lorentz.Entrypoints.Doc.EntryArrow kind name body instance Lorentz.Entrypoints.Doc.GDocumentEntrypoints kind x => Lorentz.Entrypoints.Doc.GDocumentEntrypoints kind (GHC.Generics.D1 i x) instance (Lorentz.Entrypoints.Doc.GDocumentEntrypoints kind x, Lorentz.Entrypoints.Doc.GDocumentEntrypoints kind y, Util.Type.RSplit (Michelson.Typed.Haskell.Instr.Sum.GCaseClauses x) (Michelson.Typed.Haskell.Instr.Sum.GCaseClauses y)) => Lorentz.Entrypoints.Doc.GDocumentEntrypoints kind (x GHC.Generics.:+: y) instance ('Michelson.Typed.Haskell.Instr.Sum.CaseClauseParam ctor cf GHC.Types.~ Michelson.Typed.Haskell.Instr.Sum.GCaseBranchInput ctor x, GHC.TypeLits.KnownSymbol ctor, Michelson.Doc.DocItem (Lorentz.Entrypoints.Doc.DEntrypoint kind), Lorentz.Entrypoints.Doc.DeriveCtorFieldDoc ctor cf) => Lorentz.Entrypoints.Doc.GDocumentEntrypoints kind (GHC.Generics.C1 ('GHC.Generics.MetaCons ctor _1 _2) x) instance GHC.TypeLits.KnownSymbol con => Lorentz.Entrypoints.Doc.DeriveCtorFieldDoc con 'Michelson.Typed.Haskell.Instr.Sum.NoFields instance (Michelson.Typed.Haskell.Doc.TypeHasDoc ty, Lorentz.Annotation.HasAnnotation ty, Lorentz.Constraints.Scopes.KnownValue ty, GHC.TypeLits.KnownSymbol con) => Lorentz.Entrypoints.Doc.DeriveCtorFieldDoc con ('Michelson.Typed.Haskell.Instr.Sum.OneField ty) instance Michelson.Doc.DocItem Lorentz.Entrypoints.Doc.DEntrypointArg instance Formatting.Buildable.Buildable Lorentz.Entrypoints.Doc.ParamBuildingStep instance Formatting.Buildable.Buildable Lorentz.Entrypoints.Doc.ParamBuilder instance GHC.Show.Show Lorentz.Entrypoints.Doc.ParamBuilder instance GHC.Classes.Eq Lorentz.Entrypoints.Doc.ParamBuilder instance Michelson.Doc.DocItem Lorentz.Entrypoints.Doc.DEntrypointReference instance Lorentz.Entrypoints.Doc.EntrypointKindHasDoc kind => Lorentz.Entrypoints.Doc.EntrypointKindHasDoc (Lorentz.Entrypoints.Doc.CommonEntrypointsBehaviourKind kind) instance Lorentz.Entrypoints.Doc.EntrypointKindHasDoc Lorentz.Entrypoints.Doc.CommonContractBehaviourKind instance Lorentz.Entrypoints.Doc.EntrypointKindHasDoc Lorentz.Entrypoints.Doc.PlainEntrypointsKind instance Lorentz.Entrypoints.Doc.EntrypointKindHasDoc ep => Michelson.Doc.DocItem (Lorentz.Entrypoints.Doc.DEntrypoint ep) module Lorentz.Run -- | Options to control Lorentz to Michelson compilation. data CompilationOptions CompilationOptions :: Maybe OptimizerConf -> (Bool, MText -> MText) -> (Bool, ByteString -> ByteString) -> CompilationOptions -- | Config for Michelson optimizer. [coOptimizerConf] :: CompilationOptions -> Maybe OptimizerConf -- | Function to transform strings with. See -- transformStringsLorentz. [coStringTransformer] :: CompilationOptions -> (Bool, MText -> MText) -- | Function to transform byte strings with. See -- transformBytesLorentz. [coBytesTransformer] :: CompilationOptions -> (Bool, ByteString -> ByteString) -- | Runs Michelson optimizer with default config and does not touch -- strings and bytes. defaultCompilationOptions :: CompilationOptions -- | Leave contract without any modifications. For testing purposes. intactCompilationOptions :: CompilationOptions coBytesTransformerL :: Lens' CompilationOptions (Bool, ByteString -> ByteString) coOptimizerConfL :: Lens' CompilationOptions (Maybe OptimizerConf) coStringTransformerL :: Lens' CompilationOptions (Bool, MText -> MText) -- | For use outside of Lorentz. Will use defaultCompilationOptions. compileLorentz :: (inp :-> out) -> Instr (ToTs inp) (ToTs out) -- | Compile Lorentz code, optionally running the optimizer, string and -- byte transformers. compileLorentzWithOptions :: CompilationOptions -> (inp :-> out) -> Instr (ToTs inp) (ToTs out) -- | Code for a contract along with compilation options for the Lorentz -- compiler. -- -- It is expected that a Contract is one packaged entity, wholly -- controlled by its author. Therefore the author should be able to set -- all options that control contract's behavior. -- -- This helps ensure that a given contract will be interpreted in the -- same way in all environments, like production and testing. -- -- Raw ContractCode should not be used for distribution of -- contracts. data Contract cp st Contract :: ContractCode cp st -> Bool -> CompilationOptions -> Contract cp st -- | The contract itself. [cCode] :: Contract cp st -> ContractCode cp st -- | Flag which defines whether compiled Michelson contract will have -- CAST (which drops parameter annotations) as a first -- instruction. Note that when flag is false, there still may be no -- CAST (in case when parameter type has no annotations). [cDisableInitialCast] :: Contract cp st -> Bool -- | General compilation options for the Lorentz compiler. [cCompilationOptions] :: Contract cp st -> CompilationOptions -- | Compile contract with defaultCompilationOptions and -- cDisableInitialCast set to False. defaultContract :: forall cp st. (NiceParameterFull cp, HasCallStack) => ContractCode cp st -> Contract cp st -- | Compile a whole contract to Michelson. -- -- Note that compiled contract can be ill-typed in terms of Michelson -- code when some of the compilation options are used (e.g. when -- ccoDisableInitialCast is True, resulted contract can -- be ill-typed). However, compilation with -- defaultContractCompilationOptions should be valid. compileLorentzContract :: forall cp st. (NiceParameterFull cp, NiceStorage st) => Contract cp st -> Contract (ToT cp) (ToT st) cCodeL :: forall cp_a1Id8 st_a1Id9 cp_a1IxT st_a1IxU. Lens (Contract cp_a1Id8 st_a1Id9) (Contract cp_a1IxT st_a1IxU) (ContractCode cp_a1Id8 st_a1Id9) (ContractCode cp_a1IxT st_a1IxU) cDisableInitialCastL :: forall cp_a1Id8 st_a1Id9. Lens' (Contract cp_a1Id8 st_a1Id9) Bool cCompilationOptionsL :: forall cp_a1Id8 st_a1Id9. Lens' (Contract cp_a1Id8 st_a1Id9) CompilationOptions -- | Interpret a Lorentz instruction, for test purposes. Note that this -- does not run the optimizer. interpretLorentzInstr :: (IsoValuesStack inp, IsoValuesStack out) => ContractEnv -> (inp :-> out) -> Rec Identity inp -> Either MichelsonFailed (Rec Identity out) -- | Like interpretLorentzInstr, but works on lambda rather than -- arbitrary instruction. interpretLorentzLambda :: (IsoValue inp, IsoValue out) => ContractEnv -> Lambda inp out -> inp -> Either MichelsonFailed out -- | Lorentz version of analyzer. analyzeLorentz :: (inp :-> out) -> AnalyzerRes instance Michelson.Doc.ContainsDoc (Lorentz.Run.Contract cp st) instance Michelson.Doc.ContainsUpdateableDoc (Lorentz.Run.Contract cp st) -- | Running Lorentz code easily. -- -- For testing and demonstration purposes. module Lorentz.Run.Simple -- | Run a lambda with given input. -- -- Note that this always returns one value, but can accept multiple input -- values (in such case they are grouped into nested pairs). -- -- For testing and demonstration purposes. (-$?) :: (ZipInstr inps, IsoValue (ZippedStack inps), IsoValue out) => (inps :-> '[out]) -> ZippedStack inps -> Either MichelsonFailed out infixr 2 -$? -- | Like -$?, assumes that no failure is possible. -- -- For testing and demonstration purposes. -- --
-- >>> import Lorentz.Instr ---- --
-- >>> nop -$ 5 -- 5 -- -- >>> sub -$ (3, 2) -- 1 -- -- >>> push 9 -$ () -- 9 -- -- >>> add # add -$ ((1, 2), 3) -- 6 --(-$) :: (ZipInstr inps, IsoValue (ZippedStack inps), IsoValue out, HasCallStack) => (inps :-> '[out]) -> ZippedStack inps -> out infixr 2 -$ -- | Version of (-$?) with arguments flipped. (&?-) :: (ZipInstr inps, IsoValue (ZippedStack inps), IsoValue out) => ZippedStack inps -> (inps :-> '[out]) -> Either MichelsonFailed out infixl 2 &?- -- | Version of (-$) with arguments flipped. (&-) :: (ZipInstr inps, IsoValue (ZippedStack inps), IsoValue out, HasCallStack) => ZippedStack inps -> (inps :-> '[out]) -> out infixl 2 &- -- | Version of (-$) applicable to a series of values. (<-$>) :: (ZipInstr inps, IsoValue (ZippedStack inps), IsoValue out, HasCallStack) => (inps :-> '[out]) -> [ZippedStack inps] -> [out] infixl 2 <-$> -- | Printing lorentz contracts. module Lorentz.Print -- | Pretty-print a Haskell value as Michelson one. printLorentzValue :: forall v. NicePrintedValue v => Bool -> v -> LText -- | Pretty-print a Lorentz contract into Michelson code. printLorentzContract :: forall cp st. (NiceParameterFull cp, NiceStorage st) => Bool -> Contract cp st -> LText -- | Operation size evaluation. module Lorentz.OpSize newtype OpSize OpSize :: Word -> OpSize [unOpSize] :: OpSize -> Word opSizeHardLimit :: OpSize smallTransferOpSize :: OpSize -- | Estimate code operation size. contractOpSize :: (NiceParameterFull cp, NiceStorage st) => Contract cp st -> OpSize -- | Estimate value operation size. valueOpSize :: forall a. NicePrintedValue a => a -> OpSize module Lorentz.Instr nop :: s :-> s justComment :: Text -> s :-> s comment :: CommentType -> s :-> s commentAroundFun :: Text -> (i :-> o) -> i :-> o commentAroundStmt :: Text -> (i :-> o) -> i :-> o drop :: (a : s) :-> s -- | Drop top n elements from the stack. dropN :: forall (n :: Nat) (s :: [Type]). (SingI (ToPeano n), KnownPeano (ToPeano n), RequireLongerOrSameLength (ToTs s) (ToPeano n), Drop (ToPeano n) (ToTs s) ~ ToTs (Drop (ToPeano n) s)) => s :-> Drop (ToPeano n) s dup :: (a : s) :-> (a : (a : s)) swap :: (a : (b : s)) :-> (b : (a : s)) type ConstraintDIGLorentz (n :: Peano) (inp :: [Type]) (out :: [Type]) (a :: Type) = (ConstraintDIG n (ToTs inp) (ToTs out) (ToT a), ConstraintDIG' Type n inp out a) -- | Version of dig which uses Peano number. It is inteded for -- internal usage in Lorentz. digPeano :: forall (n :: Peano) inp out a. ConstraintDIGLorentz n inp out a => inp :-> out dig :: forall (n :: Nat) inp out a. ConstraintDIGLorentz (ToPeano n) inp out a => inp :-> out type ConstraintDUGLorentz (n :: Peano) (inp :: [Type]) (out :: [Type]) (a :: Type) = (ConstraintDUG n (ToTs inp) (ToTs out) (ToT a), ConstraintDUG' Type n inp out a) -- | Version of dug which uses Peano number. It is inteded for -- internal usage in Lorentz. dugPeano :: forall (n :: Peano) inp out a. ConstraintDUGLorentz n inp out a => inp :-> out dug :: forall (n :: Nat) inp out a. ConstraintDUGLorentz (ToPeano n) inp out a => inp :-> out push :: forall t s. NiceConstant t => t -> s :-> (t : s) some :: (a : s) :-> (Maybe a : s) none :: forall a s. KnownValue a => s :-> (Maybe a : s) unit :: s :-> (() : s) ifNone :: (s :-> s') -> ((a : s) :-> s') -> (Maybe a : s) :-> s' pair :: (a : (b : s)) :-> ((a, b) : s) car :: ((a, b) : s) :-> (a : s) cdr :: ((a, b) : s) :-> (b : s) left :: forall a b s. KnownValue b => (a : s) :-> (Either a b : s) right :: forall a b s. KnownValue a => (b : s) :-> (Either a b : s) ifLeft :: ((a : s) :-> s') -> ((b : s) :-> s') -> (Either a b : s) :-> s' nil :: KnownValue p => s :-> (List p : s) cons :: (a : (List a : s)) :-> (List a : s) size :: SizeOpHs c => (c : s) :-> (Natural : s) emptySet :: NiceComparable e => s :-> (Set e : s) emptyMap :: (NiceComparable k, KnownValue v) => s :-> (Map k v : s) emptyBigMap :: (NiceComparable k, KnownValue v) => s :-> (BigMap k v : s) map :: (MapOpHs c, IsoMapOpRes c b, KnownValue b, HasCallStack) => ((MapOpInpHs c : s) :-> (b : s)) -> (c : s) :-> (MapOpResHs c b : s) iter :: (IterOpHs c, HasCallStack) => ((IterOpElHs c : s) :-> s) -> (c : s) :-> s mem :: MemOpHs c => (MemOpKeyHs c : (c : s)) :-> (Bool : s) get :: (GetOpHs c, KnownValue (GetOpValHs c)) => (GetOpKeyHs c : (c : s)) :-> (Maybe (GetOpValHs c) : s) update :: UpdOpHs c => (UpdOpKeyHs c : (UpdOpParamsHs c : (c : s))) :-> (c : s) -- | Helper instruction. -- -- Checks whether given key present in the storage and fails if it is. -- This instruction leaves stack intact. failingWhenPresent :: forall c k s v st e. (MemOpHs c, k ~ MemOpKeyHs c, KnownValue e, st ~ (k : (v : (c : s)))) => (forall s0. (k : s0) :-> (e : s0)) -> st :-> st -- | Like update, but throw an error on attempt to overwrite -- existing entry. updateNew :: forall c k s e. (UpdOpHs c, MemOpHs c, k ~ UpdOpKeyHs c, k ~ MemOpKeyHs c, KnownValue e) => (forall s0. (k : s0) :-> (e : s0)) -> (k : (UpdOpParamsHs c : (c : s))) :-> (c : s) if_ :: (s :-> s') -> (s :-> s') -> (Bool : s) :-> s' ifCons :: ((a : (List a : s)) :-> s') -> (s :-> s') -> (List a : s) :-> s' loop :: (s :-> (Bool : s)) -> (Bool : s) :-> s loopLeft :: ((a : s) :-> (Either a b : s)) -> (Either a b : s) :-> (b : s) lambda :: ZipInstrs [i, o] => (i :-> o) -> s :-> ((i :-> o) : s) exec :: (a : (Lambda a b : s)) :-> (b : s) -- | Similar to exec but works for lambdas with arbitrary size of -- input and output. -- -- Note that this instruction has its arguments flipped, lambda goes -- first. This seems to be the only reasonable way to achieve good -- inference. execute :: forall i o s. Each [KnownList, ZipInstr] [i, o] => ((i :-> o) : (i ++ s)) :-> (o ++ s) apply :: forall a b c s. (NiceConstant a, KnownValue b) => (a : (Lambda (a, b) c : s)) :-> (Lambda b c : s) -- | Version of apply that works for lambdas with arbitrary length -- input and output. applicate :: forall a b c inp2nd inpTail s. (NiceConstant a, ZipInstr b, b ~ (inp2nd : inpTail)) => (a : (((a : b) :-> c) : s)) :-> ((b :-> c) : s) dip :: forall a s s'. HasCallStack => (s :-> s') -> (a : s) :-> (a : s') type ConstraintDIPNLorentz (n :: Peano) (inp :: [Type]) (out :: [Type]) (s :: [Type]) (s' :: [Type]) = (ConstraintDIPN n (ToTs inp) (ToTs out) (ToTs s) (ToTs s'), ConstraintDIPN' Type n inp out s s') -- | Version of dipN which uses Peano number. It is inteded for -- internal usage in Lorentz. dipNPeano :: forall (n :: Peano) (inp :: [Type]) (out :: [Type]) (s :: [Type]) (s' :: [Type]). ConstraintDIPNLorentz n inp out s s' => (s :-> s') -> inp :-> out dipN :: forall (n :: Nat) (inp :: [Type]) (out :: [Type]) (s :: [Type]) (s' :: [Type]). ConstraintDIPNLorentz (ToPeano n) inp out s s' => (s :-> s') -> inp :-> out failWith :: KnownValue a => (a : s) :-> t cast :: KnownValue a => (a : s) :-> (a : s) pack :: forall a s. NicePackedValue a => (a : s) :-> (Packed a : s) unpack :: forall a s. NiceUnpackedValue a => (Packed a : s) :-> (Maybe a : s) packRaw :: forall a s. NicePackedValue a => (a : s) :-> (ByteString : s) unpackRaw :: forall a s. NiceUnpackedValue a => (ByteString : s) :-> (Maybe a : s) concat :: ConcatOpHs c => (c : (c : s)) :-> (c : s) concat' :: ConcatOpHs c => (List c : s) :-> (c : s) slice :: (SliceOpHs c, KnownValue c) => (Natural : (Natural : (c : s))) :-> (Maybe c : s) isNat :: (Integer : s) :-> (Maybe Natural : s) add :: ArithOpHs Add n m => (n : (m : s)) :-> (ArithResHs Add n m : s) sub :: ArithOpHs Sub n m => (n : (m : s)) :-> (ArithResHs Sub n m : s) rsub :: ArithOpHs Sub n m => (m : (n : s)) :-> (ArithResHs Sub n m : s) mul :: ArithOpHs Mul n m => (n : (m : s)) :-> (ArithResHs Mul n m : s) ediv :: EDivOpHs n m => (n : (m : s)) :-> (Maybe (EDivOpResHs n m, EModOpResHs n m) : s) abs :: UnaryArithOpHs Abs n => (n : s) :-> (UnaryArithResHs Abs n : s) neg :: UnaryArithOpHs Neg n => (n : s) :-> (UnaryArithResHs Neg n : s) lsl :: ArithOpHs Lsl n m => (n : (m : s)) :-> (ArithResHs Lsl n m : s) lsr :: ArithOpHs Lsr n m => (n : (m : s)) :-> (ArithResHs Lsr n m : s) or :: ArithOpHs Or n m => (n : (m : s)) :-> (ArithResHs Or n m : s) and :: ArithOpHs And n m => (n : (m : s)) :-> (ArithResHs And n m : s) xor :: ArithOpHs Xor n m => (n : (m : s)) :-> (ArithResHs Xor n m : s) not :: UnaryArithOpHs Not n => (n : s) :-> (UnaryArithResHs Not n : s) compare :: NiceComparable n => (n : (n : s)) :-> (Integer : s) eq0 :: UnaryArithOpHs Eq' n => (n : s) :-> (UnaryArithResHs Eq' n : s) neq0 :: UnaryArithOpHs Neq n => (n : s) :-> (UnaryArithResHs Neq n : s) lt0 :: UnaryArithOpHs Lt n => (n : s) :-> (UnaryArithResHs Lt n : s) gt0 :: UnaryArithOpHs Gt n => (n : s) :-> (UnaryArithResHs Gt n : s) le0 :: UnaryArithOpHs Le n => (n : s) :-> (UnaryArithResHs Le n : s) ge0 :: UnaryArithOpHs Ge n => (n : s) :-> (UnaryArithResHs Ge n : s) int :: (Natural : s) :-> (Integer : s) -- | Cast something appropriate to TAddress. toTAddress_ :: forall cp addr s. ToTAddress_ cp addr => (addr : s) :-> (TAddress cp : s) -- | Get a reference to the current contract. -- -- Note that, similar to CONTRACT instruction, in Michelson -- SELF instruction can accept an entrypoint as field annotation, -- and without annotation specified it creates a contract value -- which calls the default entrypoint. -- -- This particular function carries the behaviour of SELF before -- introduction of lightweight entrypoints feature. Thus the contract -- must not have explicit "default" entrypoint for this to work. -- -- If you are going to call a specific entrypoint of the contract, see -- selfCalling. self :: forall p s. (NiceParameterFull p, ForbidExplicitDefaultEntrypoint p) => s :-> (ContractRef p : s) -- | Make a reference to the current contract, maybe a specific entrypoint. -- -- Note that, since information about parameter of the current contract -- is not carried around, in this function you need to specify parameter -- type p explicitly. selfCalling :: forall p mname s. NiceParameterFull p => EntrypointRef mname -> s :-> (ContractRef (GetEntrypointArgCustom p mname) : s) -- | Get a reference to a contract by its address. -- -- This instruction carries the behaviour of CONTRACT before -- introduction of lightweight entrypoints feature. The contract must -- not have explicit "default" entrypoint for this to work. -- -- If you are going to call a specific entrypoint of the contract, see -- contractCalling. contract :: forall p addr s. (NiceParameterFull p, ForbidExplicitDefaultEntrypoint p, ToTAddress_ p addr) => (addr : s) :-> (Maybe (ContractRef p) : s) -- | Make a reference to a contract, maybe a specific entrypoint. -- -- When calling this function, make sure that parameter type is known. -- It's recommended that you supply TAddress with a concrete -- parameter as the stack argument. contractCalling :: forall cp epRef epArg addr s. (HasEntrypointArg cp epRef epArg, ToTAddress_ cp addr) => epRef -> (addr : s) :-> (Maybe (ContractRef epArg) : s) -- | Specialized version of contractCalling for the case when you do -- not have compile-time evidence of appropriate HasEntrypointArg. -- For instance, if you have untyped EpName you can not have this -- evidence (the value is only available in runtime). If you have typed -- EntrypointRef, use eprName to construct EpName. contractCallingUnsafe :: forall arg s. NiceParameter arg => EpName -> (Address : s) :-> (Maybe (ContractRef arg) : s) -- | Version of contract instruction which may accept address with -- already specified entrypoint name. -- -- Also you cannot specify entrypoint name here because this could result -- in conflict. runFutureContract :: forall p s. NiceParameter p => (FutureContract p : s) :-> (Maybe (ContractRef p) : s) -- | Similar to runFutureContract, works with EpAddress. -- -- Validity of such operation cannot be ensured at compile time. epAddressToContract :: forall p s. NiceParameter p => (EpAddress : s) :-> (Maybe (ContractRef p) : s) transferTokens :: forall p s. NiceParameter p => (p : (Mutez : (ContractRef p : s))) :-> (Operation : s) setDelegate :: (Maybe KeyHash : s) :-> (Operation : s) createContract :: forall p g s. (NiceStorage g, NiceParameterFull p) => Contract p g -> (Maybe KeyHash : (Mutez : (g : s))) :-> (Operation : (Address : s)) implicitAccount :: (KeyHash : s) :-> (ContractRef () : s) now :: s :-> (Timestamp : s) amount :: s :-> (Mutez : s) balance :: s :-> (Mutez : s) checkSignature :: BytesLike bs => (PublicKey : (TSignature bs : (bs : s))) :-> (Bool : s) sha256 :: BytesLike bs => (bs : s) :-> (Hash Sha256 bs : s) sha512 :: BytesLike bs => (bs : s) :-> (Hash Sha512 bs : s) blake2B :: BytesLike bs => (bs : s) :-> (Hash Blake2b bs : s) hashKey :: (PublicKey : s) :-> (KeyHash : s) -- | Warning: Using source is considered a bad practice. Consider -- using sender instead until further investigation source :: s :-> (Address : s) sender :: s :-> (Address : s) address :: (ContractRef a : s) :-> (Address : s) chainId :: s :-> (ChainId : s) -- | Execute given instruction on truncated stack. -- -- This instruction requires you to specify the piece of stack to -- truncate as type argument. framed :: forall s i o. (KnownList i, KnownList o) => (i :-> o) -> (i ++ s) :-> (o ++ s) class LorentzFunctor (c :: Type -> Type) lmap :: (LorentzFunctor c, KnownValue b) => ((a : s) :-> (b : s)) -> (c a : s) :-> (c b : s) class NonZero t -- | Retain the value only if it is not zero. nonZero :: NonZero t => (t : s) :-> (Maybe t : s) instance Lorentz.Instr.NonZero GHC.Integer.Type.Integer instance Lorentz.Instr.NonZero GHC.Natural.Natural instance Lorentz.Instr.LorentzFunctor GHC.Maybe.Maybe -- | Referenced-by-name versions of some instructions. -- -- They allow to "dig" into stack or copy elements of stack referring -- them by label. module Lorentz.ReferencedByName -- | Indicates that stack s contains a name :! var or -- name :? var value. class HasNamedVar (s :: [Type]) (name :: Symbol) (var :: Type) | s name -> var -- | Version of HasNamedVar for multiple variables. -- --
-- >>> type HasContext = HasNamedVars s ["x" := Integer, "f" := Lambda MText MText] --type family HasNamedVars (s :: [Type]) (vs :: [NamedField]) :: Constraint type n := ty = 'NamedField n ty infixr 0 := -- | Take the element with given label on stack and copy it on top. -- -- If there are multiple variables with given label, the one closest to -- the top of the stack is picked. dupL :: forall var name s. HasNamedVar s name var => Label name -> s :-> (var : s) -- | Version of dupL that leaves a named variable on stack. dupLNamed :: forall var name s. HasNamedVar s name var => Label name -> s :-> ((name :! var) : s) -- | Requires type x to be an unnamed variable. -- -- When e.g. dupL sees a polymorphic variable, it can't judge -- whether is it a variable we are seeking for or not; -- VarIsUnnamed helps to assure the type system that given -- variable won't be named. type VarIsUnnamed x = VarName x ~ 'VarUnnamed instance Lorentz.ReferencedByName.ElemHasNamedVar (ty : s) name var (Lorentz.ReferencedByName.VarNamePretty ty Data.Type.Equality.== 'Lorentz.ReferencedByName.VarNamed name) => Lorentz.ReferencedByName.HasNamedVar (ty : s) name var instance (ty GHC.Types.~ Named.Internal.NamedF f var name) => Lorentz.ReferencedByName.ElemHasNamedVar (ty : s) name var 'GHC.Types.True instance Lorentz.ReferencedByName.HasNamedVar s name var => Lorentz.ReferencedByName.ElemHasNamedVar (ty : s) name var 'GHC.Types.False instance ((TypeError ...), var GHC.Types.~ Lorentz.ReferencedByName.NamedVariableNotFound name) => Lorentz.ReferencedByName.HasNamedVar '[] name var -- | Referenced-by-type versions of some instructions. -- -- They allow to "dip" into stack or copy elements of stack referring -- them by type. Their use is justified, because in most cases there is -- only one element of each type of stack, and in cases when this does -- not hold (e.g. entrypoint with multiple parameters of the same type), -- it might be a good idea to wrap those types into a newtype or to use -- primitives from named package. -- -- This module is experimental, i.e. everything here should work but may -- be removed in favor of better development practices. -- -- Each instruction is followed with usage example. module Lorentz.Referenced -- | Duplicate an element of stack referring it by type. -- -- If stack contains multiple entries of this type, compile error is -- raised. dupT :: forall a st. DupT st a st => st :-> (a : st) -- | Dip repeatedly until element of the given type is on top of the stack. -- -- If stack contains multiple entries of this type, compile error is -- raised. dipT :: forall a inp dinp dout out. DipT inp a inp dinp dout out => (dinp :-> dout) -> inp :-> out -- | Remove element with the given type from the stack. dropT :: forall a inp dinp dout out. (DipT inp a inp dinp dout out, dinp ~ (a : dout)) => inp :-> out instance ((TypeError ...), dipInp GHC.Types.~ (TypeError ...), out GHC.Types.~ (TypeError ...)) => Lorentz.Referenced.DipT origSt a '[] dipInp dipOut out instance (Data.Type.Bool.If (Util.Type.IsElem a st) (TypeError ...) (() :: Constraint), dipInp GHC.Types.~ (a : st), dipOut GHC.Types.~ out) => Lorentz.Referenced.DipT origSt a (a : st) dipInp dipOut out instance (Lorentz.Referenced.DipT origSt a st dipInp dipOut out, out1 GHC.Types.~ (b : out)) => Lorentz.Referenced.DipT origSt a (b : st) dipInp dipOut out1 instance (TypeError ...) => Lorentz.Referenced.DupT origSt a '[] instance Data.Type.Bool.If (Util.Type.IsElem a st) (TypeError ...) (() :: Constraint) => Lorentz.Referenced.DupT origSt a (a : st) instance Lorentz.Referenced.DupT origSt a st => Lorentz.Referenced.DupT origSt a (b : st) -- | This module contains implementation of Extensible values. -- -- Extensible values are an alternative representation of -- sum-types for Michelson. Instead of representing them as nested -- options, we treat them as (Natural, ByteString) pair, where the first -- element of the pair represents the constructor index, while the second -- is a packed argument. -- -- With such a representation sum types can be easily upgraded: it is -- possible to add new elements to the sum type, and the representation -- would not change. -- -- However, such representation essentially limits the applicability of -- the values. This module does not provide Michelson-level function to -- unwrap the value because it would require traversing all the possible -- options in the contract code. While this is possible, it is very -- inefficient. Up to this moment, we have not come up with a decent -- reason to allow such behavior, so Extensible types are write-only in -- Michelson code. They can be unwrapped off-chain with -- fromExtVal. -- -- In order to preserve previous values during migrations, users should -- ONLY APPEND items to the underlying sum type. Changing, reordering and -- deleting items is not allowed and would lead to compatibility -- breakage. Currently, this restriction in not enforced. Only -- no-argument and one-argument constructors are supported. -- -- GOOD: -- `Extensible GoodSumTypeV1` is backwards compatible -- with -- `Extensible GoodSumTypeV2` data GoodSumTypeV1 = A Natural | B data -- GoodSumTypeV2 = A Natural | B | C MText -- -- BAD: -- `Extensible BadSumTypeV1` is NOT backwards compatible -- with -- `Extensible BadSumTypeV2` data BadSumTypeV1 = A | B data BadSumTypeV2 -- = A Natural | B | C MText module Lorentz.Extensible newtype Extensible x Extensible :: (Natural, ByteString) -> Extensible x -- | Errors related to fromExtVal conversion data ExtConversionError ConstructorIndexNotFound :: Natural -> ExtConversionError ArgumentUnpackFailed :: ExtConversionError type ExtVal x = (Generic x, GExtVal x (Rep x)) -- | Information to be provided for documenting some Extensible -- x. class Typeable x => ExtensibleHasDoc x -- | Implementation for typeDocName of the corresponding -- Extensible. extensibleDocName :: ExtensibleHasDoc x => Proxy x -> Text -- | Implementation for typeDocDependencies of the corresponding -- Extensible. extensibleDocDependencies :: ExtensibleHasDoc x => Proxy x -> [SomeDocDefinitionItem] -- | Implementation for typeDocDependencies of the corresponding -- Extensible. extensibleDocDependencies :: (ExtensibleHasDoc x, Generic x, GTypeHasDoc (Rep x)) => Proxy x -> [SomeDocDefinitionItem] -- | Overall description of this type. extensibleDocMdDescription :: ExtensibleHasDoc x => Markdown -- | Converts a value from a Haskell representation to its extensible -- Michelson representation (i.e. (Natural, Bytestring) pair). toExtVal :: ExtVal a => a -> Extensible a -- | Converts a value from an extensible Michelson representation to its -- Haskell sum-type representation. Fails if the Michelson representation -- points to a nun-existent constructor, or if we failed to unpack the -- argument. fromExtVal :: ExtVal a => Extensible a -> Either ExtConversionError a -- | Wraps an argument on top of the stack into an Extensible -- representation wrapExt :: forall t (n :: Nat) name field s. WrapExtC t n name field s => Label ("c" `AppendSymbol` name) -> AppendCtorField field s :-> (Extensible t : s) type WrapExtC t n name field s = ('Ctor n name field ~ LookupCtor name (EnumerateCtors (GetCtors t)), WrapExt field, KnownNat n) instance GHC.Show.Show Lorentz.Extensible.ExtConversionError instance GHC.Classes.Eq Lorentz.Extensible.ExtConversionError instance forall k (x :: k). Lorentz.Wrappable.Wrappable (Lorentz.Extensible.Extensible x) instance forall k (x :: k). Lorentz.Annotation.HasAnnotation (Lorentz.Extensible.Extensible x) instance forall k (x :: k). Michelson.Typed.Haskell.Value.IsoValue (Lorentz.Extensible.Extensible x) instance forall k (x :: k). GHC.Show.Show (Lorentz.Extensible.Extensible x) instance forall k (x :: k). GHC.Classes.Eq (Lorentz.Extensible.Extensible x) instance forall k (x :: k). GHC.Generics.Generic (Lorentz.Extensible.Extensible x) instance (GHC.TypeNats.KnownNat pos, GHC.TypeLits.KnownSymbol name, Michelson.Typed.Haskell.Doc.TypeHasDoc param, param GHC.Types.~ Michelson.Typed.Haskell.Instr.Sum.ExtractCtorField field) => Lorentz.Extensible.DocumentCtor ('Lorentz.Extensible.Ctor pos name field) instance (Lorentz.Extensible.ExtensibleHasDoc x, Util.Type.ReifyList Lorentz.Extensible.DocumentCtor (Lorentz.Extensible.EnumerateCtors (Lorentz.Extensible.GetCtors x))) => Michelson.Typed.Haskell.Doc.TypeHasDoc (Lorentz.Extensible.Extensible x) instance forall k (t :: k) (x :: * -> *) (i :: GHC.Generics.Meta). Lorentz.Extensible.GExtVal t x => Lorentz.Extensible.GExtVal t (GHC.Generics.D1 i x) instance ('Lorentz.Extensible.Ctor n name 'Michelson.Typed.Haskell.Instr.Sum.NoFields GHC.Types.~ Lorentz.Extensible.LookupCtor name (Lorentz.Extensible.EnumerateCtors (Lorentz.Extensible.GetCtors t)), GHC.TypeNats.KnownNat n) => Lorentz.Extensible.GExtVal t (GHC.Generics.C1 ('GHC.Generics.MetaCons name _1 _2) GHC.Generics.U1) instance (Lorentz.Constraints.Scopes.NiceFullPackedValue param, 'Lorentz.Extensible.Ctor n name ('Michelson.Typed.Haskell.Instr.Sum.OneField param) GHC.Types.~ Lorentz.Extensible.LookupCtor name (Lorentz.Extensible.EnumerateCtors (Lorentz.Extensible.GetCtors t)), GHC.TypeNats.KnownNat n) => Lorentz.Extensible.GExtVal t (GHC.Generics.C1 ('GHC.Generics.MetaCons name _1 _2) (GHC.Generics.S1 _3 (GHC.Generics.Rec0 param))) instance forall k (t :: k) (x :: * -> *) (y :: * -> *). (Lorentz.Extensible.GExtVal t x, Lorentz.Extensible.GExtVal t y) => Lorentz.Extensible.GExtVal t (x GHC.Generics.:+: y) instance Formatting.Buildable.Buildable Lorentz.Extensible.ExtConversionError instance Lorentz.Constraints.Scopes.NicePackedValue param => Lorentz.Extensible.WrapExt ('Michelson.Typed.Haskell.Instr.Sum.OneField param) instance Lorentz.Extensible.WrapExt 'Michelson.Typed.Haskell.Instr.Sum.NoFields module Lorentz.Errors -- | Haskell type representing error. class (Typeable e, ErrorHasDoc e) => IsError e -- | Converts a Haskell error into Value representation. errorToVal :: IsError e => e -> (forall t. ErrorScope t => Value t -> r) -> r -- | Converts a Value into Haskell error. errorFromVal :: (IsError e, KnownT t) => Value t -> Either Text e type ErrorScope t = (Typeable t, ConstantScope t) -- | Implementation of errorToVal via IsoValue. isoErrorToVal :: (KnownError e, IsoValue e) => e -> (forall t. ErrorScope t => Value t -> r) -> r -- | Implementation of errorFromVal via IsoValue. isoErrorFromVal :: (Typeable t, Typeable (ToT e), IsoValue e) => Value t -> Either Text e class Typeable e => ErrorHasDoc (e :: Type) where { -- | Constraints which we require in a particular instance. You are not -- oblidged to often instantiate this correctly, it is only useful for -- some utilities. type family ErrorRequirements e :: Constraint; type ErrorRequirements e = (); } -- | Name of error as it appears in the corresponding section title. errorDocName :: ErrorHasDoc e => Text -- | What should happen for this error to be raised. errorDocMdCause :: ErrorHasDoc e => Markdown -- | Brief version of errorDocMdCause. -- -- This will appear along with the error when mentioned in entrypoint -- description. By default, the first sentence of the full description is -- used. errorDocMdCauseInEntrypoint :: ErrorHasDoc e => Markdown -- | How this error is represented in Haskell. errorDocHaskellRep :: ErrorHasDoc e => Markdown -- | Error class. errorDocClass :: ErrorHasDoc e => ErrorClass -- | Which definitions documentation for this error mentions. errorDocDependencies :: ErrorHasDoc e => [SomeDocDefinitionItem] -- | Captured constraints which we require in a particular instance. This -- is a way to encode a bidirectional instance in the nowaday Haskell, -- for class MyConstraint => ErrorHasDoc MyType instance it -- lets deducing MyConstraint by ErrorHasDoc MyType. -- -- You are not oblidged to always instantiate, it is only useful for some -- utilities which otherwise would not compile. errorDocRequirements :: ErrorHasDoc e => Dict (ErrorRequirements e) -- | Captured constraints which we require in a particular instance. This -- is a way to encode a bidirectional instance in the nowaday Haskell, -- for class MyConstraint => ErrorHasDoc MyType instance it -- lets deducing MyConstraint by ErrorHasDoc MyType. -- -- You are not oblidged to always instantiate, it is only useful for some -- utilities which otherwise would not compile. errorDocRequirements :: (ErrorHasDoc e, ErrorRequirements e) => Dict (ErrorRequirements e) -- | Implementation of typeDocMdDescription (of TypeHasDoc -- typeclass) for Haskell types which sole purpose is to be error. typeDocMdDescriptionReferToError :: forall e. IsError e => Markdown -- | Description of error representation in Haskell. customErrorDocHaskellRepGeneral :: (SingI (ToT (ErrorArg tag)), IsError (CustomError tag), TypeHasDoc (ErrorArg tag), CustomErrorHasDoc tag) => Text -> Proxy tag -> Markdown -- | Whether given error class is about internal errors. -- -- Internal errors are not enlisted on per-entrypoint basis, only once -- for the entire contract. isInternalErrorClass :: ErrorClass -> Bool -- | Use this type as replacement for () when you really -- want to leave error cause unspecified. data UnspecifiedError UnspecifiedError :: UnspecifiedError -- | Type wrapper for an IsError. data SomeError SomeError :: e -> SomeError -- | Fail with the given Haskell value. failUsing :: forall e s t. IsError e => e -> s :-> t -- | Fail, providing a reference to the place in the code where this -- function is called. -- -- Like error in Haskell code, this instruction is for internal -- errors only. failUnexpected :: MText -> s :-> t -- | Declares a custom error, defining error name - error argument -- relation. -- -- If your error is supposed to carry no argument, then provide -- (). -- -- Note that this relation is defined globally rather than on -- per-contract basis, so define errors accordingly. If your error has -- argument specific to your contract, call it such that error name -- reflects its belonging to this contract. -- -- This is the basic [error format]. type family ErrorArg (tag :: Symbol) :: Type -- | Material custom error. -- -- Use this in pattern matches against error (e.g. in tests). data CustomError (tag :: Symbol) CustomError :: Label tag -> ErrorArg tag -> CustomError (tag :: Symbol) [ceTag] :: CustomError (tag :: Symbol) -> Label tag [ceArg] :: CustomError (tag :: Symbol) -> ErrorArg tag -- | Fail with given custom error. failCustom :: forall tag err s any. (err ~ ErrorArg tag, CustomErrorHasDoc tag, KnownError err) => Label tag -> (err : s) :-> any type RequireNoArgError tag msg = (TypeErrorUnless (ErrorArg tag == ()) msg, msg ~ ('Text "Expected no-arg error, but given error requires argument of type " :<>: 'ShowType (ErrorArg tag))) -- | Specialization of failCustom for no-arg errors. failCustom_ :: forall tag s any notVoidErrorMsg. (RequireNoArgError tag notVoidErrorMsg, CustomErrorHasDoc tag) => Label tag -> s :-> any -- | Error class on how the error should be handled by the client. data ErrorClass -- | Normal expected error. Examples: "insufficient balance", "wallet does -- not exist". ErrClassActionException :: ErrorClass -- | Invalid argument passed to entrypoint. Examples: your entrypoint -- accepts an enum represented as nat, and unknown value is -- provided. This includes more complex cases which involve multiple -- entrypoints. E.g. API provides iterator interface, middleware should -- care about using it hiding complex details and exposing a simpler API -- to user; then an attempt to request non-existing element would also -- correspond to an error from this class. ErrClassBadArgument :: ErrorClass -- | Unexpected error. Most likely it means that there is a bug in the -- contract or the contract has been deployed incorrectly. ErrClassContractInternal :: ErrorClass -- | It's possible to leave error class unspecified. ErrClassUnknown :: ErrorClass class (KnownSymbol tag, TypeHasDoc (ErrorArg tag), IsError (CustomError tag)) => CustomErrorHasDoc tag -- | What should happen for this error to be raised. customErrDocMdCause :: CustomErrorHasDoc tag => Markdown -- | Brief version of customErrDocMdCause. This will appear along -- with the error when mentioned in entrypoint description. -- -- By default, the first sentence of the full description is used. customErrDocMdCauseInEntrypoint :: CustomErrorHasDoc tag => Markdown -- | Error class. -- -- By default this returns "unknown error" class; though you should -- provide explicit implementation in order to avoid a warning. customErrClass :: CustomErrorHasDoc tag => ErrorClass -- | Clarification of error argument meaning. -- -- Provide when it's not obvious, e.g. argument is not named with -- :!. -- -- NOTE: This should not be an entire sentence, rather just the -- semantic backbone. -- -- Bad: * Error argument stands for the previous value of -- approval. -- -- Good: * the previous value of approval * pair, first -- argument of which is one thing, and the second is another customErrArgumentSemantics :: CustomErrorHasDoc tag => Maybe Markdown -- | Mentions that contract uses given error. data DError [DError] :: ErrorHasDoc e => Proxy e -> DError -- | Documentation for custom errors. -- -- Mentions that entrypoint throws given error. data DThrows [DThrows] :: ErrorHasDoc e => Proxy e -> DThrows errorTagToText :: forall tag. KnownSymbol tag => Text -- | Demote error tag to term level. errorTagToMText :: Label tag -> MText instance Language.Haskell.TH.Syntax.Lift Lorentz.Errors.ErrorClass instance Michelson.Typed.Haskell.Value.IsoValue Lorentz.Errors.UnspecifiedError instance GHC.Generics.Generic Lorentz.Errors.UnspecifiedError instance GHC.Classes.Eq (Lorentz.Errors.ErrorArg tag) => GHC.Classes.Eq (Lorentz.Errors.CustomError tag) instance GHC.Show.Show (Lorentz.Errors.ErrorArg tag) => GHC.Show.Show (Lorentz.Errors.CustomError tag) instance GHC.Classes.Eq Lorentz.Errors.DThrows instance Michelson.Doc.DocItem Lorentz.Errors.DThrows instance GHC.Classes.Eq Lorentz.Errors.DError instance GHC.Classes.Ord Lorentz.Errors.DError instance Michelson.Doc.DocItem Lorentz.Errors.DError instance (Lorentz.Errors.CustomErrorHasDoc tag, Lorentz.Errors.KnownError (Lorentz.Errors.ErrorArg tag), Michelson.Typed.Haskell.Value.IsoValue (Lorentz.Errors.ErrorArg tag)) => Lorentz.Errors.IsError (Lorentz.Errors.CustomError tag) instance (Lorentz.Errors.CustomErrorHasDoc tag, Data.Singletons.Internal.SingI (Michelson.Typed.Haskell.Value.ToT (Lorentz.Errors.ErrorArg tag))) => Lorentz.Errors.ErrorHasDoc (Lorentz.Errors.CustomError tag) instance GHC.Classes.Eq Lorentz.Errors.SomeError instance Formatting.Buildable.Buildable Lorentz.Errors.SomeError instance GHC.Show.Show Lorentz.Errors.SomeError instance Lorentz.Errors.IsError Michelson.Text.MText instance (TypeError ...) => Lorentz.Errors.IsError () instance Lorentz.Errors.IsError Lorentz.Errors.UnspecifiedError instance (Data.Typeable.Internal.Typeable arg, Lorentz.Errors.IsError (Lorentz.Errors.CustomError tag), Util.TypeLits.TypeErrorUnless (arg Data.Type.Equality.== ()) notVoidError, arg GHC.Types.~ Lorentz.Errors.ErrorArg tag, notVoidError GHC.Types.~ ('GHC.TypeLits.Text "This error requires argument of type " 'GHC.TypeLits.:<>: 'GHC.TypeLits.ShowType (Lorentz.Errors.ErrorArg tag))) => Lorentz.Errors.IsError (arg -> Lorentz.Errors.CustomError tag) instance Lorentz.Errors.ErrorHasDoc Michelson.Text.MText instance (TypeError ...) => Lorentz.Errors.ErrorHasDoc () instance Lorentz.Errors.ErrorHasDoc Lorentz.Errors.UnspecifiedError instance (Data.Typeable.Internal.Typeable arg, Lorentz.Errors.ErrorHasDoc (Lorentz.Errors.CustomError tag)) => Lorentz.Errors.ErrorHasDoc (arg -> Lorentz.Errors.CustomError tag) instance GHC.Read.Read Lorentz.Errors.ErrorClass instance Formatting.Buildable.Buildable Lorentz.Errors.ErrorClass instance Formatting.Buildable.Buildable (Lorentz.Errors.CustomError tag) instance (Michelson.Typed.Haskell.Value.WellTypedIsoValue (Lorentz.Errors.ErrorArg tag), (TypeError ...)) => Michelson.Typed.Haskell.Value.IsoValue (Lorentz.Errors.CustomError tag) instance GHC.Classes.Eq (Lorentz.Errors.ErrorArg tag) => GHC.Classes.Eq (() -> Lorentz.Errors.CustomError tag) instance GHC.Show.Show (Lorentz.Errors.ErrorArg tag) => GHC.Show.Show (() -> Lorentz.Errors.CustomError tag) -- | Lorentz template-haskell and quasiquote utilities. module Lorentz.Util.TH -- | QuasiQuote that helps generating ParameterHasEntrypoints -- instance. -- -- Usage: -- --
-- [entrypointDoc| Parameter <parameter-type> <optional-root-annotation> |] -- [entrypointDoc| Parameter plain |] -- [entrypointDoc| Parameter plain "root"|] ---- -- See this tutorial which includes this quasiquote. entrypointDoc :: QuasiQuoter -- | QuasiQuote that helps generating CustomErrorHasDoc instance. -- -- Usage: -- --
-- [errorDoc| <error-name> <error-type> <error-description> |] -- [errorDoc| "errorName" exception "Error description" |] ---- -- See this tutorial which includes this quasiquote. errorDoc :: QuasiQuoter -- | QuasiQuote that helps generating TypeHasDoc instance. -- -- Usage: -- --
-- [typeDoc| <type> <description> |] -- [typeDoc| Storage "This is storage description" |] ---- -- See this tutorial which includes this quasiquote. typeDoc :: QuasiQuoter -- | Common Michelson macros defined using Lorentz syntax. module Lorentz.Macro type NiceComparable n = (KnownValue n, Comparable (ToT n)) eq :: NiceComparable n => (n : (n : s)) :-> (Bool : s) neq :: NiceComparable n => (n : (n : s)) :-> (Bool : s) lt :: NiceComparable n => (n : (n : s)) :-> (Bool : s) gt :: NiceComparable n => (n : (n : s)) :-> (Bool : s) le :: NiceComparable n => (n : (n : s)) :-> (Bool : s) ge :: NiceComparable n => (n : (n : s)) :-> (Bool : s) ifEq0 :: IfCmp0Constraints a Eq' => (s :-> s') -> (s :-> s') -> (a : s) :-> s' ifGe0 :: IfCmp0Constraints a Ge => (s :-> s') -> (s :-> s') -> (a : s) :-> s' ifGt0 :: IfCmp0Constraints a Gt => (s :-> s') -> (s :-> s') -> (a : s) :-> s' ifLe0 :: IfCmp0Constraints a Le => (s :-> s') -> (s :-> s') -> (a : s) :-> s' ifLt0 :: IfCmp0Constraints a Lt => (s :-> s') -> (s :-> s') -> (a : s) :-> s' ifNeq0 :: IfCmp0Constraints a Neq => (s :-> s') -> (s :-> s') -> (a : s) :-> s' ifEq :: NiceComparable a => (s :-> s') -> (s :-> s') -> (a : (a : s)) :-> s' ifGe :: NiceComparable a => (s :-> s') -> (s :-> s') -> (a : (a : s)) :-> s' ifGt :: NiceComparable a => (s :-> s') -> (s :-> s') -> (a : (a : s)) :-> s' ifLe :: NiceComparable a => (s :-> s') -> (s :-> s') -> (a : (a : s)) :-> s' ifLt :: NiceComparable a => (s :-> s') -> (s :-> s') -> (a : (a : s)) :-> s' ifNeq :: NiceComparable a => (s :-> s') -> (s :-> s') -> (a : (a : s)) :-> s' -- | Analog of the FAIL macro in Michelson. Its usage is discouraged -- because it doesn't carry any information about failure. -- | Warning: fail_ remains in code fail_ :: a :-> c assert :: IsError err => err -> (Bool : s) :-> s assertEq0 :: (IfCmp0Constraints a Eq', IsError err) => err -> (a : s) :-> s assertNeq0 :: (IfCmp0Constraints a Neq, IsError err) => err -> (a : s) :-> s assertLt0 :: (IfCmp0Constraints a Lt, IsError err) => err -> (a : s) :-> s assertGt0 :: (IfCmp0Constraints a Gt, IsError err) => err -> (a : s) :-> s assertLe0 :: (IfCmp0Constraints a Le, IsError err) => err -> (a : s) :-> s assertGe0 :: (IfCmp0Constraints a Ge, IsError err) => err -> (a : s) :-> s assertEq :: (NiceComparable a, IsError err) => err -> (a : (a : s)) :-> s assertNeq :: (NiceComparable a, IsError err) => err -> (a : (a : s)) :-> s assertLt :: (NiceComparable a, IsError err) => err -> (a : (a : s)) :-> s assertGt :: (NiceComparable a, IsError err) => err -> (a : (a : s)) :-> s assertLe :: (NiceComparable a, IsError err) => err -> (a : (a : s)) :-> s assertGe :: (NiceComparable a, IsError err) => err -> (a : (a : s)) :-> s assertNone :: IsError err => err -> (Maybe a : s) :-> s assertSome :: IsError err => err -> (Maybe a : s) :-> (a : s) assertLeft :: IsError err => err -> (Either a b : s) :-> (a : s) assertRight :: IsError err => err -> (Either a b : s) :-> (b : s) assertUsing :: IsError a => a -> (Bool : s) :-> s -- | Constraint for duupX that combines kind-agnostic constraint for -- Lorentz (Haskell) types and for our typed Michelson. type ConstraintDuupXLorentz (n :: Peano) (s :: [Type]) (a :: Type) (s1 :: [Type]) (tail :: [Type]) = (DuupXConstraint' T n (ToTs s) (ToT a) (ToTs s1) (ToTs tail), DuupXConstraint' Type n s a s1 tail) -- | Constraint for replaceN that combines kind-agnostic constraint for -- Lorentz (Haskell) types and for our typed Michelson. type ConstraintReplaceNLorentz (n :: Peano) (s :: [Type]) (a :: Type) (mid :: [Type]) (tail :: [Type]) = (ReplaceNConstraint' T n (ToTs s) (ToT a) (ToTs mid) (ToTs tail), ReplaceNConstraint' Type n s a mid tail) -- | Constraint for updateN that combines kind-agnostic constraint for -- Lorentz (Haskell) types and for our typed Michelson. type ConstraintUpdateNLorentz (n :: Peano) (s :: [Type]) (a :: Type) (b :: Type) (mid :: [Type]) (tail :: [Type]) = (UpdateNConstraint' T n (ToTs s) (ToT a) (ToT b) (ToTs mid) (ToTs tail), UpdateNConstraint' Type n s a b mid tail) class DuupX (n :: Peano) (s :: [Type]) (a :: Type) s1 tail duupXImpl :: DuupX n s a s1 tail => s :-> (a : s) class ReplaceN (n :: Peano) (s :: [Type]) (a :: Type) mid tail replaceNImpl :: ReplaceN n s a mid tail => (a : s) :-> s class UpdateN (n :: Peano) (s :: [Type]) (a :: Type) (b :: Type) mid tail updateNImpl :: UpdateN n s a b mid tail => ('[a, b] :-> '[b]) -> (a : s) :-> s -- | Custom Lorentz macro that drops element with given index (starting -- from 0) from the stack. dropX :: forall (n :: Nat) a inp out s s'. (ConstraintDIPNLorentz (ToPeano n) inp out s s', s ~ (a : s')) => inp :-> out -- | Duplicate the top of the stack n times. -- -- For example, `cloneX @3` has type `a : s :-> a : a : a : a : s`. cloneX :: forall (n :: Nat) a s. CloneX (ToPeano n) a s => (a : s) :-> CloneXT (ToPeano n) a s -- | DUU+P macro. For example, `duupX @3` is DUUUP, it -- puts the 3-rd (starting from 1) element to the top of the stack. Note -- that it is implemented differently for `n ≤ 2` and for `n > 2`. In -- the latter case it is implemented using dipN, dig and -- dup. In the former case it uses specialized versions. There is -- also a minor difference with the implementation of `DUU*P` in -- Michelson. They implement DUUUUP as `DIP 3 { DUP }; DIG 4`. -- We implement it as `DIP 3 { DUP }; DIG 3`. These are equivalent. Our -- version is supposedly cheaper, at least it should be packed more -- efficiently due to the way numbers are packed. duupX :: forall (n :: Nat) a (s :: [Type]) (s1 :: [Type]) (tail :: [Type]). (ConstraintDuupXLorentz (ToPeano (n - 1)) s a s1 tail, DuupX (ToPeano n) s a s1 tail) => s :-> (a : s) -- | Version of framed which accepts number of elements on input -- stack which should be preserved. -- -- You can treat this macro as calling a Michelson function with given -- number of arguments. framedN :: forall n nNat s i i' o o'. (nNat ~ ToPeano n, i' ~ Take nNat i, s ~ Drop nNat i, i ~ (i' ++ s), o ~ (o' ++ s), KnownList i', KnownList o') => (i' :-> o') -> i :-> o caar :: (((a, b1), b2) : s) :-> (a : s) cadr :: (((a, b1), b2) : s) :-> (b1 : s) cdar :: ((a1, (a2, b)) : s) :-> (a2 : s) cddr :: ((a1, (a2, b)) : s) :-> (b : s) ifRight :: ((b : s) :-> s') -> ((a : s) :-> s') -> (Either a b : s) :-> s' ifSome :: ((a : s) :-> s') -> (s :-> s') -> (Maybe a : s) :-> s' when_ :: (s :-> s) -> (Bool : s) :-> s unless_ :: (s :-> s) -> (Bool : s) :-> s whenSome :: ((a : s) :-> s) -> (Maybe a : s) :-> s whenNone :: (s :-> (a : s)) -> (Maybe a : s) :-> (a : s) mapCar :: ((a : s) :-> (a1 : s)) -> ((a, b) : s) :-> ((a1, b) : s) mapCdr :: ((b : ((a, b) : s)) :-> (b1 : ((a, b) : s))) -> ((a, b) : s) :-> ((a, b1) : s) papair :: (a : (b : (c : s))) :-> (((a, b), c) : s) ppaiir :: (a : (b : (c : s))) :-> ((a, (b, c)) : s) unpair :: ((a, b) : s) :-> (a : (b : s)) setCar :: ((a, b1) : (b2 : s)) :-> ((b2, b1) : s) setCdr :: ((a, b1) : (b2 : s)) :-> ((a, b2) : s) -- | Insert given element into set. -- -- This is a separate function from updateMap because stacks -- they operate with differ in length. setInsert :: NiceComparable e => (e : (Set e : s)) :-> (Set e : s) -- | Insert given element into map. mapInsert :: (MapInstrs map, NiceComparable k) => (k : (v : (map k v : s))) :-> (map k v : s) -- | Insert given element into set, ensuring that it does not overwrite any -- existing entry. -- -- As first argument accepts container name. setInsertNew :: (NiceComparable e, KnownValue err) => (forall s0. (e : s0) :-> (err : s0)) -> (e : (Set e : s)) :-> (Set e : s) -- | Insert given element into map, ensuring that it does not overwrite any -- existing entry. -- -- As first argument accepts container name (for error message). mapInsertNew :: (MapInstrs map, NiceComparable k, KnownValue e) => (forall s0. (k : s0) :-> (e : s0)) -> (k : (v : (map k v : s))) :-> (map k v : s) -- | Delete element from the map. deleteMap :: forall k v s. (MapInstrs map, NiceComparable k, KnownValue v) => (k : (map k v : s)) :-> (map k v : s) -- | Delete given element from the set. setDelete :: NiceComparable e => (e : (Set e : s)) :-> (Set e : s) -- | Replace nth element (0-indexed) with the one on the top of the stack. -- For example, `replaceN 3` replaces the 3rd element with the 0th -- one. `replaceN 0` is not a valid operation (and it is not -- implemented). `replaceN 1` is equivalent to `swap # drop` (and is -- the only one implemented like this). In all other cases `replaceN -- n` will drop the nth element (`dipN n drop`) and then put the -- 0th one in its place (`dug (n-1)`). replaceN :: forall (n :: Nat) a (s :: [Type]) (s1 :: [Type]) (tail :: [Type]). (ConstraintReplaceNLorentz (ToPeano (n - 1)) s a s1 tail, ReplaceN (ToPeano n) s a s1 tail) => (a : s) :-> s -- | Replaces the nth element (0-indexed) with the result of the given -- "updating" instruction (binary with the return type equal to the -- second argument) applied to the 0th element and the nth element -- itself. For example, `updateN 3 cons` replaces the 3rd element -- with the result of cons applied to the topmost element and the -- 3rd one. `updateN 0 instr` is not a valid operation (and it is -- not implemented). `updateN 1 instr` is equivalent to -- instr (and so is implemented). `updateN 2 instr` is -- equivalent to `swap # dip instr` (and so is implemented). In all other -- cases `updateN n instr` will put the topmost element right above -- the nth one (`dug (n-1)`) and then apply the function to them in -- place (`dipN @(n-1) instr`). updateN :: forall (n :: Nat) a b (s :: [Type]) (mid :: [Type]) (tail :: [Type]). (ConstraintUpdateNLorentz (ToPeano (n - 1)) s a b mid tail, UpdateN (ToPeano n) s a b mid tail) => ('[a, b] :-> '[b]) -> (a : s) :-> s -- | view type synonym as described in A1. data View (a :: Type) (r :: Type) View :: a -> ContractRef r -> View (a :: Type) (r :: Type) [viewParam] :: View (a :: Type) (r :: Type) -> a [viewCallbackTo] :: View (a :: Type) (r :: Type) -> ContractRef r -- | void type synonym as described in A1. data Void_ (a :: Type) (b :: Type) Void_ :: a -> Lambda b b -> Void_ (a :: Type) (b :: Type) -- | Entry point argument. [voidParam] :: Void_ (a :: Type) (b :: Type) -> a -- | Type of result reported via failWith. [voidResProxy] :: Void_ (a :: Type) (b :: Type) -> Lambda b b -- | Newtype over void result type used in tests to distinguish successful -- void result from other errors. -- -- Usage example: lExpectFailWith (== VoidResult roleMaster)` -- -- This error is special - it can contain arguments of different types -- depending on entrypoint which raises it. newtype VoidResult r VoidResult :: r -> VoidResult r [unVoidResult] :: VoidResult r -> r view_ :: NiceParameter r => (forall s0. (a : (storage : s0)) :-> (r : s0)) -> (View a r : (storage : s)) :-> ((List Operation, storage) : s) -- | Polymorphic version of View constructor. mkView :: ToContractRef r contract => a -> contract -> View a r -- | Wrap internal representation of view into View itself. -- -- View is part of public standard and should not change often. wrapView :: ((a, ContractRef r) : s) :-> (View a r : s) -- | Unwrap View into its internal representation. -- -- View is part of public standard and should not change often. unwrapView :: (View a r : s) :-> ((a, ContractRef r) : s) void_ :: forall a b s s' anything. (IsError (VoidResult b), KnownValue b) => ((a : s) :-> (b : s')) -> (Void_ a b : s) :-> anything mkVoid :: forall b a. a -> Void_ a b -- | Wrap internal representation of void into Void_ itself. -- -- Void_ is part of public standard and should not change often. wrapVoid :: ((a, Lambda b b) : s) :-> (Void_ a b : s) -- | Unwrap Void_ into its internal representation. -- -- Void_ is part of public standard and should not change often. unwrapVoid :: (Void_ a b : s) :-> ((a, Lambda b b) : s) voidResultTag :: MText -- | Duplicate two topmost items on top of the stack. dupTop2 :: forall (a :: Type) (b :: Type) (s :: [Type]). (a : (b : s)) :-> (a : (b : (a : (b : s)))) fromOption :: NiceConstant a => a -> (Maybe a : s) :-> (a : s) isSome :: (Maybe a : s) :-> (Bool : s) -- | Retain the value if it is not equal to the given one. -- --
-- >>> non 0 -$ 5 -- Just 5 -- -- >>> non 0 -$ 0 -- Nothing --non :: (NiceConstant a, NiceComparable a) => a -> (a : s) :-> (Maybe a : s) -- | Version of non with a custom predicate. -- --
-- >>> non' eq0 -$ 5 -- Just 5 -- -- >>> non' eq0 -$ 0 -- Nothing --non' :: NiceConstant a => Lambda a Bool -> (a : s) :-> (Maybe a : s) -- | Check whether container is empty. isEmpty :: SizeOpHs c => (c : s) :-> (Bool : s) buildView :: WellTypedIsoValue r => (a -> Builder) -> View a r -> Builder buildViewTuple :: (WellTypedIsoValue r, TupleF a) => View a r -> Builder addressToEpAddress :: (Address : s) :-> (EpAddress : s) -- | Push a value of contract type. -- -- Doing this via push instruction is not possible, so we need to -- perform extra actions here. -- -- Aside from contract value itself you will need to specify -- which error to throw in case this value is not valid. pushContractRef :: NiceParameter arg => (forall s0. (FutureContract arg : s) :-> s0) -> ContractRef arg -> s :-> (ContractRef arg : s) -- | Get address of the current contract. -- -- TODO [#373]: reimplement this using SELF_ADDRESS selfAddress :: s :-> (Address : s) instance GHC.Classes.Eq r => GHC.Classes.Eq (Lorentz.Macro.VoidResult r) instance GHC.Generics.Generic (Lorentz.Macro.VoidResult r) instance (Lorentz.Annotation.HasAnnotation a, Lorentz.Annotation.HasAnnotation b) => Lorentz.Annotation.HasAnnotation (Lorentz.Macro.Void_ a b) instance GHC.Show.Show a => GHC.Show.Show (Lorentz.Macro.Void_ a b) instance GHC.Generics.Generic (Lorentz.Macro.Void_ a b) instance (Lorentz.Annotation.HasAnnotation a, Lorentz.Annotation.HasAnnotation r) => Lorentz.Annotation.HasAnnotation (Lorentz.Macro.View a r) instance GHC.Generics.Generic (Lorentz.Macro.View a r) instance GHC.Show.Show a => GHC.Show.Show (Lorentz.Macro.View a r) instance GHC.Classes.Eq a => GHC.Classes.Eq (Lorentz.Macro.View a r) instance (Michelson.Typed.Haskell.Value.WellTypedIsoValue r, Michelson.Typed.Haskell.Value.WellTypedIsoValue a) => Michelson.Typed.Haskell.Value.IsoValue (Lorentz.Macro.View a r) instance (Michelson.Typed.Haskell.Value.WellTypedIsoValue r, Michelson.Typed.Haskell.Value.WellTypedIsoValue a) => Michelson.Typed.Haskell.Value.IsoValue (Lorentz.Macro.Void_ a r) instance (Michelson.Typed.Haskell.Doc.TypeHasDoc r, Lorentz.Errors.IsError (Lorentz.Macro.VoidResult r)) => Michelson.Typed.Haskell.Doc.TypeHasDoc (Lorentz.Macro.VoidResult r) instance (Data.Typeable.Internal.Typeable r, Lorentz.Constraints.Scopes.NiceConstant r, Lorentz.Errors.ErrorHasDoc (Lorentz.Macro.VoidResult r)) => Lorentz.Errors.IsError (Lorentz.Macro.VoidResult r) instance Michelson.Typed.Haskell.Doc.TypeHasDoc r => Lorentz.Errors.ErrorHasDoc (Lorentz.Macro.VoidResult r) instance (Michelson.Typed.Haskell.Value.WellTypedIsoValue (Lorentz.Macro.VoidResult r), (TypeError ...)) => Michelson.Typed.Haskell.Value.IsoValue (Lorentz.Macro.VoidResult r) instance (Lorentz.Coercions.CanCastTo a1 a2, Lorentz.Coercions.CanCastTo r1 r2) => Lorentz.Coercions.CanCastTo (Lorentz.Macro.Void_ a1 r1) (Lorentz.Macro.Void_ a2 r2) instance Universum.TypeOps.Each '[Data.Typeable.Internal.Typeable, Michelson.Typed.Haskell.Doc.TypeHasDoc] '[a, r] => Michelson.Typed.Haskell.Doc.TypeHasDoc (Lorentz.Macro.Void_ a r) instance Formatting.Buildable.Buildable a => Formatting.Buildable.Buildable (Lorentz.Macro.Void_ a b) instance (Lorentz.Coercions.CanCastTo a1 a2, Lorentz.Coercions.CanCastTo r1 r2) => Lorentz.Coercions.CanCastTo (Lorentz.Macro.View a1 r1) (Lorentz.Macro.View a2 r2) instance Universum.TypeOps.Each '[Data.Typeable.Internal.Typeable, Michelson.Typed.Haskell.Doc.TypeHasDoc] '[a, r] => Michelson.Typed.Haskell.Doc.TypeHasDoc (Lorentz.Macro.View a r) instance (Formatting.Buildable.Buildable a, Michelson.Typed.Haskell.Value.WellTypedIsoValue r) => Formatting.Buildable.Buildable (Lorentz.Macro.View a r) instance Michelson.Typed.Haskell.Value.WellTypedIsoValue r => Formatting.Buildable.Buildable (Lorentz.Macro.View () r) instance forall k (s :: [*]) b (tail :: [*]) a (mid :: k). (s GHC.Types.~ (b : tail)) => Lorentz.Macro.UpdateN ('Data.Vinyl.TypeLevel.S 'Data.Vinyl.TypeLevel.Z) s a b mid tail instance forall k (s :: [*]) x b (tail :: [*]) a (mid :: k). (s GHC.Types.~ (x : b : tail)) => Lorentz.Macro.UpdateN ('Data.Vinyl.TypeLevel.S ('Data.Vinyl.TypeLevel.S 'Data.Vinyl.TypeLevel.Z)) s a b mid tail instance Lorentz.Macro.ConstraintUpdateNLorentz ('Data.Vinyl.TypeLevel.S ('Data.Vinyl.TypeLevel.S n)) s a b mid tail => Lorentz.Macro.UpdateN ('Data.Vinyl.TypeLevel.S ('Data.Vinyl.TypeLevel.S ('Data.Vinyl.TypeLevel.S n))) s a b mid tail instance forall k1 k2 (s :: [*]) a (xs :: [*]) (mid :: k1) (tail :: k2). (s GHC.Types.~ (a : xs)) => Lorentz.Macro.ReplaceN ('Data.Vinyl.TypeLevel.S 'Data.Vinyl.TypeLevel.Z) s a mid tail instance Lorentz.Macro.ConstraintReplaceNLorentz ('Data.Vinyl.TypeLevel.S n) s a mid tail => Lorentz.Macro.ReplaceN ('Data.Vinyl.TypeLevel.S ('Data.Vinyl.TypeLevel.S n)) s a mid tail instance Lorentz.Macro.MapInstrs Data.Map.Internal.Map instance Lorentz.Macro.MapInstrs Michelson.Typed.Haskell.Value.BigMap instance forall k1 k2 (s :: [*]) a (xs :: [*]) (s1 :: k1) (tail :: k2). (s GHC.Types.~ (a : xs)) => Lorentz.Macro.DuupX ('Data.Vinyl.TypeLevel.S 'Data.Vinyl.TypeLevel.Z) s a s1 tail instance forall k1 k2 b a (xs :: [*]) (s1 :: k1) (tail :: k2). Lorentz.Macro.DuupX ('Data.Vinyl.TypeLevel.S ('Data.Vinyl.TypeLevel.S 'Data.Vinyl.TypeLevel.Z)) (b : a : xs) a s1 tail instance Lorentz.Macro.ConstraintDuupXLorentz ('Data.Vinyl.TypeLevel.S ('Data.Vinyl.TypeLevel.S n)) s a s1 tail => Lorentz.Macro.DuupX ('Data.Vinyl.TypeLevel.S ('Data.Vinyl.TypeLevel.S ('Data.Vinyl.TypeLevel.S n))) s a s1 tail instance Lorentz.Macro.CloneX 'Data.Vinyl.TypeLevel.Z a s instance Lorentz.Macro.CloneX n a s => Lorentz.Macro.CloneX ('Data.Vinyl.TypeLevel.S n) a s module Lorentz.UParam -- | Encapsulates parameter for one of entry points. It keeps entrypoint -- name and corresponding argument serialized. -- -- In Haskell world, we keep an invariant of that contained value relates -- to one of entry points from entries list. newtype UParam (entries :: [EntrypointKind]) UParamUnsafe :: (MText, ByteString) -> UParam (entries :: [EntrypointKind]) -- | An entrypoint is described by two types: its name and type of -- argument. type EntrypointKind = (Symbol, Type) -- | A convenient alias for type-level name-something pair. type (n :: Symbol) ?: (a :: k) = '(n, a) -- | Construct a UParam safely. mkUParam :: (NicePackedValue a, LookupEntrypoint name entries ~ a, RequireUniqueEntrypoints entries) => Label name -> a -> UParam entries -- | This type can store any value that satisfies a certain constraint. data ConstrainedSome (c :: Type -> Constraint) [ConstrainedSome] :: c a => a -> ConstrainedSome c -- | This class is needed to implement unpackUParam. class UnpackUParam (c :: Type -> Constraint) entries -- | Turn UParam into a Haskell value. Since we don't know its type -- in compile time, we have to erase it using ConstrainedSome. The -- user of this function can require arbitrary constraint to hold -- (depending on how they want to use the result). unpackUParam :: UnpackUParam c entries => UParam entries -> Either EntrypointLookupError (MText, ConstrainedSome c) -- | Pseudo value for UParam type variable. type SomeInterface = '[ '("SomeEntrypoints", Void)] -- | Homomorphic version of UParam, forgets the exact interface. type UParam_ = UParam SomeInterface -- | Implementations of some entry points. -- -- Note that this thing inherits properties of Rec, e.g. you can -- Data.Vinyl.Core.rappend implementations for two entrypoint -- sets when assembling scattered parts of a contract. type EntrypointsImpl inp out entries = Rec (CaseClauseU inp out) entries -- | An action invoked when user-provided entrypoint is not found. type UParamFallback inp out = ((MText, ByteString) : inp) :-> out data EntrypointLookupError NoSuchEntrypoint :: MText -> EntrypointLookupError ArgumentUnpackFailed :: EntrypointLookupError -- | Make up a "case" over entry points. class CaseUParam (entries :: [EntrypointKind]) -- | Pattern-match on given UParam entries. -- -- You have to provide all case branches and a fallback action on case -- when entrypoint is not found. caseUParam :: (CaseUParam entries, RequireUniqueEntrypoints entries) => Rec (CaseClauseU inp out) entries -> UParamFallback inp out -> (UParam entries : inp) :-> out -- | Like caseUParam, but accepts a tuple of clauses, not a -- Rec. caseUParamT :: forall entries inp out clauses. (clauses ~ Rec (CaseClauseU inp out) entries, RecFromTuple clauses, CaseUParam entries) => IsoRecTuple clauses -> UParamFallback inp out -> (UParam entries : inp) :-> out -- | Default implementation for UParamFallback, simply reports an -- error. uparamFallbackFail :: UParamFallback inp out -- | Get type of entrypoint argument by its name. type family LookupEntrypoint (name :: Symbol) (entries :: [EntrypointKind]) :: Type -- | Ensure that given entry points do no contain duplicated names. type family RequireUniqueEntrypoints (entries :: [EntrypointKind]) :: Constraint -- | Make up UParam from ADT sum. -- -- Entry points template will consist of (constructorName, -- constructorFieldType) pairs. Each constructor is expected to have -- exactly one field. uparamFromAdt :: UParamLinearize up => up -> UParam (UParamLinearized up) -- | Constraint required by uparamFromAdt. type UParamLinearize p = (Generic p, GUParamLinearize (Rep p)) -- | Entry points template derived from given ADT sum. type UParamLinearized p = GUParamLinearized (Rep p) -- | Note that calling given entrypoints involves constructing -- UParam. pbsUParam :: forall ctorName. KnownSymbol ctorName => ParamBuildingStep -- | Helper instruction which extracts content of UParam. unwrapUParam :: (UParam entries : s) :-> ((MText, ByteString) : s) instance GHC.Show.Show Lorentz.UParam.EntrypointLookupError instance GHC.Classes.Eq Lorentz.UParam.EntrypointLookupError instance GHC.Generics.Generic Lorentz.UParam.EntrypointLookupError instance Lorentz.Wrappable.Wrappable (Lorentz.UParam.UParam entries) instance Lorentz.Annotation.HasAnnotation (Lorentz.UParam.UParam entries) instance Michelson.Typed.Haskell.Value.IsoValue (Lorentz.UParam.UParam entries) instance GHC.Show.Show (Lorentz.UParam.UParam entries) instance GHC.Classes.Eq (Lorentz.UParam.UParam entries) instance GHC.Generics.Generic (Lorentz.UParam.UParam entries) instance Lorentz.UParam.GUParamLinearize x => Lorentz.UParam.GUParamLinearize (GHC.Generics.D1 i x) instance (Lorentz.UParam.GUParamLinearize x, Lorentz.UParam.GUParamLinearize y) => Lorentz.UParam.GUParamLinearize (x GHC.Generics.:+: y) instance (GHC.TypeLits.KnownSymbol name, Lorentz.Constraints.Scopes.NicePackedValue a) => Lorentz.UParam.GUParamLinearize (GHC.Generics.C1 ('GHC.Generics.MetaCons name _1 _2) (GHC.Generics.S1 si (GHC.Generics.Rec0 a))) instance (TypeError ...) => Lorentz.UParam.GUParamLinearize (GHC.Generics.C1 i GHC.Generics.U1) instance (TypeError ...) => Lorentz.UParam.GUParamLinearize (GHC.Generics.C1 i (x GHC.Generics.:*: y)) instance Lorentz.UParam.CaseUParam '[] instance (GHC.TypeLits.KnownSymbol name, Lorentz.UParam.CaseUParam entries, Lorentz.Constraints.Scopes.NiceUnpackedValue arg) => Lorentz.UParam.CaseUParam ((name Lorentz.UParam.?: arg) : entries) instance Lorentz.UParam.UnpackUParam c '[] instance (GHC.TypeLits.KnownSymbol name, Lorentz.UParam.UnpackUParam c entries, Lorentz.Constraints.Scopes.NiceUnpackedValue arg, c arg) => Lorentz.UParam.UnpackUParam c ((name Lorentz.UParam.?: arg) : entries) instance Formatting.Buildable.Buildable Lorentz.UParam.EntrypointLookupError instance (name GHC.Types.~ name', body GHC.Types.~ ((arg : inp) Lorentz.Base.:-> out)) => Lorentz.ADT.CaseArrow name' body (Lorentz.UParam.CaseClauseU inp out '(name, arg)) instance GHC.Show.Show (Lorentz.UParam.ConstrainedSome GHC.Show.Show) instance Formatting.Buildable.Buildable (Lorentz.UParam.ConstrainedSome Formatting.Buildable.Buildable) instance Lorentz.UParam.SameEntries entries1 entries2 => Lorentz.Coercions.CanCastTo (Lorentz.UParam.UParam entries1) (Lorentz.UParam.UParam entries2) instance Data.Typeable.Internal.Typeable interface => Michelson.Typed.Haskell.Doc.TypeHasDoc (Lorentz.UParam.UParam interface) instance Formatting.Buildable.Buildable (Lorentz.Errors.CustomError "uparamNoSuchEntrypoint") instance Formatting.Buildable.Buildable (Lorentz.Errors.CustomError "uparamArgumentUnpackFailed") instance Lorentz.Errors.CustomErrorHasDoc "uparamNoSuchEntrypoint" instance Lorentz.Errors.CustomErrorHasDoc "uparamArgumentUnpackFailed" -- | Reimplementation of some syntax sugar. -- -- You need the following module pragmas to make it work smoothly: module Lorentz.Rebinded -- | Aliases for (#) used by do-blocks. (>>) :: (a :-> b) -> (b :-> c) -> a :-> c -- | Lift a value. pure :: Applicative f => a -> f a -- | Inject a value into the monadic type. return :: Monad m => a -> m a -- | Defines semantics of if ... then ... else ... construction. ifThenElse :: Condition arg argl argr outb out -> (argl :-> outb) -> (argr :-> outb) -> arg :-> out -- | Predicate for if ... then .. else ... construction, defines a -- kind of operation applied to the top elements of the current stack. -- -- Type arguments mean: 1. Input of if 2. Left branch input 3. -- Right branch input 4. Output of branches 5. Output of if data Condition arg argl argr outb out [Holds] :: Condition (Bool : s) s s o o [IsSome] :: Condition (Maybe a : s) (a : s) s o o [IsNone] :: Condition (Maybe a : s) s (a : s) o o [IsLeft] :: Condition (Either l r : s) (l : s) (r : s) o o [IsRight] :: Condition (Either l r : s) (r : s) (l : s) o o [IsCons] :: Condition ([a] : s) (a : ([a] : s)) s o o [IsNil] :: Condition ([a] : s) s (a : ([a] : s)) o o [IsZero] :: (UnaryArithOpHs Eq' a, UnaryArithResHs Eq' a ~ Bool) => Condition (a : s) s s o o [IsNotZero] :: (UnaryArithOpHs Eq' a, UnaryArithResHs Eq' a ~ Bool) => Condition (a : s) s s o o [IsEq] :: NiceComparable a => Condition (a : (a : s)) s s o o [IsNeq] :: NiceComparable a => Condition (a : (a : s)) s s o o [IsLt] :: NiceComparable a => Condition (a : (a : s)) s s o o [IsGt] :: NiceComparable a => Condition (a : (a : s)) s s o o [IsLe] :: NiceComparable a => Condition (a : (a : s)) s s o o [IsGe] :: NiceComparable a => Condition (a : (a : s)) s s o o -- | Explicitly named binary condition, to ensure proper order of stack -- arguments. [NamedBinCondition] :: Condition (a : (a : s)) s s o o -> Label n1 -> Label n2 -> Condition ((n1 :! a) : ((n2 :! a) : s)) s s o o -- | Provide the compared arguments to if branches. [PreserveArgsBinCondition] :: (forall st o. Condition (a : (b : st)) st st o o) -> Condition (a : (b : s)) (a : (b : s)) (a : (b : s)) (a : (b : s)) s -- | Named version of IsLt. -- -- In this and similar operators you provide names of accepted stack -- operands as a safety measure of that they go in the expected order. (<.) :: NiceComparable a => Label n1 -> Label n2 -> Condition ((n1 :! a) : ((n2 :! a) : s)) s s o o infix 4 <. -- | Named version of IsGt. (>.) :: NiceComparable a => Label n1 -> Label n2 -> Condition ((n1 :! a) : ((n2 :! a) : s)) s s o o infix 4 >. -- | Named version of IsLe. (<=.) :: NiceComparable a => Label n1 -> Label n2 -> Condition ((n1 :! a) : ((n2 :! a) : s)) s s o o infix 4 <=. -- | Named version of IsGe. (>=.) :: NiceComparable a => Label n1 -> Label n2 -> Condition ((n1 :! a) : ((n2 :! a) : s)) s s o o infix 4 >=. -- | Named version of IsEq. (==.) :: NiceComparable a => Label n1 -> Label n2 -> Condition ((n1 :! a) : ((n2 :! a) : s)) s s o o infix 4 ==. -- | Named version of IsNeq. (/=.) :: NiceComparable a => Label n1 -> Label n2 -> Condition ((n1 :! a) : ((n2 :! a) : s)) s s o o infix 4 /=. -- | Condition modifier, makes stack operands of binary comparison to be -- available within if branches. keepIfArgs :: (forall st o. Condition (a : (b : st)) st st o o) -> Condition (a : (b : s)) (a : (b : s)) (a : (b : s)) (a : (b : s)) s -- | Conversion from an Integer. An integer literal represents the -- application of the function fromInteger to the appropriate -- value of type Integer, so such literals have type -- (Num a) => a. fromInteger :: Num a => Integer -> a fromString :: IsString a => String -> a fromLabel :: IsLabel x a => a -- | Unary negation. negate :: Num a => a -> a -- | By default we represent error tags using strings. This module makes it -- possible to use numbers instead. It introduces new [error format]. -- -- There are two possible ways to use it: 1. If you have just one Lorentz -- instruction (potentially a big one), just use useNumericErrors -- function. It will change error representation there and return a map -- that can be used to interpret new error codes. 2. If your contract -- consists of multiple parts, start with gathering all error tags -- (gatherErrorTags). Then build ErrorTagMap using -- addNewErrorTags. Pass empty map if you are building from -- scratch (you can use buildErrorTagMap shortcut) or an existing -- map if you have one (e. g. you are upgrading a contract). module Lorentz.Errors.Numeric.Contract -- | This is a bidirectional map with correspondence between numeric and -- textual error tags. type ErrorTagMap = Bimap Natural MText -- | Tags excluded from map. type ErrorTagExclusions = HashSet MText -- | Find all textual error tags that are used in typical FAILWITH -- patterns within given instruction. Map them to natural numbers. gatherErrorTags :: (inp :-> out) -> HashSet MText -- | Add more error tags to an existing ErrorTagMap. It is useful -- when your contract consists of multiple parts (e. g. in case of -- contract upgrade), you have existing map for some part and want to add -- tags from another part to it. You can pass empty map as existing one -- if you just want to build ErrorTagMap from a set of textual -- tags. See buildErrorTagMap. addNewErrorTags :: ErrorTagMap -> HashSet MText -> ErrorTagMap -- | Build ErrorTagMap from a set of textual tags. buildErrorTagMap :: HashSet MText -> ErrorTagMap -- | Remove some error tags from map. This way you say to remain these -- string tags intact, while others will be converted to numbers when -- this map is applied. -- -- Note that later you have to apply this map using -- applyErrorTagMapWithExclusions, otherwise an error would be -- raised. excludeErrorTags :: HasCallStack => ErrorTagExclusions -> ErrorTagMap -> ErrorTagMap -- | For each typical FAILWITH that uses a string to represent error -- tag this function changes error tag to be a number using the supplied -- conversion map. It assumes that supplied map contains all such strings -- (and will error out if it does not). It will always be the case if you -- gather all error tags using gatherErrorTags and build -- ErrorTagMap from them using addNewErrorTags. applyErrorTagMap :: HasCallStack => ErrorTagMap -> (inp :-> out) -> inp :-> out -- | Similar to applyErrorTagMap, but for case when you have -- excluded some tags from map via excludeErrorTags. Needed, -- because both excludeErrorTags and this function do not tolerate -- unknown errors in contract code (for your safety). applyErrorTagMapWithExclusions :: HasCallStack => ErrorTagMap -> ErrorTagExclusions -> (inp :-> out) -> inp :-> out -- | This function implements the simplest scenario of using this module's -- functionality: 1. Gather all error tags from a single instruction. 2. -- Turn them into error conversion map. 3. Apply this conversion. useNumericErrors :: HasCallStack => (inp :-> out) -> (inp :-> out, ErrorTagMap) -- | If you apply numeric error representation in your contract, -- errorFromVal will stop working because it doesn't know about -- this transformation. This function takes this transformation into -- account. If a number is used as a tag, but it is not found in the -- passed map, we conservatively preserve that number (because this whole -- approach is rather a heuristic). errorFromValNumeric :: (KnownT t, IsError e) => ErrorTagMap -> Value t -> Either Text e -- | If you apply numeric error representation in your contract, -- errorToVal will stop working because it doesn't know about this -- transformation. This function takes this transformation into account. -- If a string is used as a tag, but it is not found in the passed map, -- we conservatively preserve that string (because this whole approach is -- rather a heuristic). errorToValNumeric :: IsError e => ErrorTagMap -> e -> (forall t. ErrorScope t => Value t -> r) -> r -- | Autodoc for numeric errors. module Lorentz.Errors.Numeric.Doc -- | Adds a section which explains error tag mapping. data DDescribeErrorTagMap DDescribeErrorTagMap :: Text -> DDescribeErrorTagMap -- | Describes where the error tag map is defined in Haskell code. [detmSrcLoc] :: DDescribeErrorTagMap -> Text -- | Modify documentation generated for given code so that all -- CustomError mention not their textual error tag rather -- respective numeric one from the given map. -- -- If some documented error is not present in the map, it remains -- unmodified. This function may fail with error if contract uses -- some uncommon errors, see applyErrorTagToErrorsDocWith for -- details. applyErrorTagToErrorsDoc :: HasCallStack => ErrorTagMap -> (inp :-> out) -> inp :-> out -- | Extended version of applyErrorTagToErrorsDoc which accepts -- error handlers. -- -- In most cases that function should be enough for your purposes, but it -- uses a fixed set of base handlers which may be not enough in case when -- you define your own errors. In this case define and pass all the -- necessary handlers to this function. -- -- It fails with error if some of the errors used in the contract -- cannot be handled with given handlers. applyErrorTagToErrorsDocWith :: HasCallStack => [NumericErrorDocHandler] -> ErrorTagMap -> (inp :-> out) -> inp :-> out -- | Handler which changes documentation for one particular error type. data NumericErrorDocHandler -- | Errors for NumericErrorDocHandler data NumericErrorDocHandlerError -- | Handler for all CustomErrors. customErrorDocHandler :: NumericErrorDocHandler -- | Handler for VoidResult. voidResultDocHandler :: NumericErrorDocHandler -- | Handlers for most common errors defined in Lorentz. baseErrorDocHandlers :: [NumericErrorDocHandler] -- | Some error with a numeric tag attached. data NumericErrorWrapper (numTag :: Nat) (err :: Type) instance GHC.Classes.Ord Lorentz.Errors.Numeric.Doc.DDescribeErrorTagMap instance GHC.Classes.Eq Lorentz.Errors.Numeric.Doc.DDescribeErrorTagMap instance (Lorentz.Errors.ErrorHasDoc err, GHC.TypeNats.KnownNat numTag, Lorentz.Errors.Numeric.Doc.ErrorHasNumericDoc err) => Lorentz.Errors.ErrorHasDoc (Lorentz.Errors.Numeric.Doc.NumericErrorWrapper numTag err) instance Lorentz.Errors.Numeric.Doc.ErrorHasNumericDoc (Lorentz.Errors.CustomError tag) instance Lorentz.Errors.ErrorHasDoc (Lorentz.Macro.VoidResult res) => Lorentz.Errors.Numeric.Doc.ErrorHasNumericDoc (Lorentz.Macro.VoidResult res) instance Lorentz.Errors.ErrorHasDoc Lorentz.Errors.Numeric.Doc.NumericTextError instance Michelson.Doc.DocItem Lorentz.Errors.Numeric.Doc.DDescribeErrorTagMap module Lorentz.Errors.Numeric -- | Some common errors. -- -- Such registry makes sense, as soon as errors are declared globally. module Lorentz.Errors.Common instance Formatting.Buildable.Buildable (Lorentz.Errors.CustomError "senderIsNotAdmin") instance Lorentz.Errors.CustomErrorHasDoc "senderIsNotAdmin" -- | Support for uninhabited type. -- -- Currently they are not supported my Michelson, so we provide a sort of -- replacement. -- -- This module should be removed once the proposal is implemented: -- https://gitlab.com/tezos/tezos/issues/662 module Lorentz.Empty -- | Replacement for uninhabited type. data Empty -- | Witness of that this code is unreachable. absurd_ :: (Empty : s) :-> s' instance Lorentz.Annotation.HasAnnotation Lorentz.Empty.Empty instance Michelson.Typed.Haskell.Value.IsoValue Lorentz.Empty.Empty instance GHC.Generics.Generic Lorentz.Empty.Empty instance Michelson.Typed.Haskell.Doc.TypeHasDoc Lorentz.Empty.Empty instance Lorentz.Errors.CustomErrorHasDoc "emptySupplied" instance Formatting.Buildable.Buildable (Lorentz.Errors.CustomError "emptySupplied") -- | Default values for Lorentz. module Lorentz.Default -- | Lorentz version of Default. class LDefault a ldef :: LDefault a => a ldef :: (LDefault a, Default a) => a lIsDef :: LDefault a => (a : s) :-> (Bool : s) lIsDef :: (LDefault a, NiceConstant a, NiceComparable a) => (a : s) :-> (Bool : s) instance Lorentz.Default.LDefault GHC.Integer.Type.Integer instance Lorentz.Default.LDefault GHC.Natural.Natural instance Lorentz.Default.LDefault [a] instance Lorentz.Default.LDefault (Data.Set.Internal.Set k) instance Lorentz.Default.LDefault (Data.Map.Internal.Map k v) instance (Lorentz.Default.LDefault a, GHC.TypeLits.KnownSymbol n) => Lorentz.Default.LDefault (n Named.Internal.:! a) instance (Lorentz.Default.LDefault a, Lorentz.Default.LDefault b) => Lorentz.Default.LDefault (a, b) -- | Isomorphisms in Lorentz. module Lorentz.Iso -- | Lorentz version of Iso. data LIso a b LIso :: (forall s. (a : s) :-> (b : s)) -> (forall s. (b : s) :-> (a : s)) -> LIso a b [liTo] :: LIso a b -> forall s. (a : s) :-> (b : s) [liFrom] :: LIso a b -> forall s. (b : s) :-> (a : s) -- | Invert an isomorphism. invertIso :: LIso a b -> LIso b a -- | Given a function that is its own inverse, make an LIso using it -- in both directions. involutedIso :: Lambda a a -> LIso a a -- | The isomorphism between two values with identical representation and -- semantics. checkedCoerceIso :: Coercible_ a b => LIso a b -- | The isomorphism between two values with identical representation. -- -- The same precautions as for forcedCoerce apply here. forcedCoerceIso :: MichelsonCoercible a b => LIso a b -- | The isomorphism between raw and named value. namedIso :: Label n -> LIso a (n :! a) -- | Absence of value on the left hand side is associated with the given -- value on the right hand side. nonIso :: (NiceConstant a, NiceComparable a) => a -> LIso (Maybe a) a -- | Absence of value on the left hand side is associated with the default -- value on the right hand side. -- -- This is more general version of nonIso ldef since it can work -- with e.g. containers. nonDefIso :: (LDefault a, NiceConstant a) => LIso (Maybe a) a -- | This module provides storage interfaces. -- -- Whenever you need to write a generic code applicable to different -- storage formats, consider using this module. -- -- Use methods like stToField and stUpdate to work with -- storage from your code. -- -- To explain how e.g. required fields are obtainable from your storage -- you define StoreHasField instance (and a similar case is for -- other typeclasses). We provide the most common building blocks for -- implementing these instances, see Implementations section. module Lorentz.StoreClass -- | Provides operations on fields for storage. class StoreHasField store fname ftype | store fname -> ftype storeFieldOps :: StoreHasField store fname ftype => StoreFieldOps store fname ftype -- | Datatype containing the full implementation of StoreHasField -- typeclass. -- -- We use this grouping because in most cases the implementation will be -- chosen among the default ones, and initializing all methods at once is -- simpler and more consistent. (One can say that we are trying to -- emulate the DerivingVia extension.) data StoreFieldOps store fname ftype StoreFieldOps :: (forall s. Label fname -> (store : s) :-> (ftype : s)) -> (forall s. Label fname -> (ftype : (store : s)) :-> (store : s)) -> StoreFieldOps store fname ftype [sopToField] :: StoreFieldOps store fname ftype -> forall s. Label fname -> (store : s) :-> (ftype : s) [sopSetField] :: StoreFieldOps store fname ftype -> forall s. Label fname -> (ftype : (store : s)) :-> (store : s) -- | Provides operations on submaps of storage. class StoreHasSubmap store mname key value | store mname -> key value storeSubmapOps :: StoreHasSubmap store mname key value => StoreSubmapOps store mname key value -- | Datatype containing the full implementation of StoreHasSubmap -- typeclass. -- -- We use this grouping because in most cases the implementation will be -- chosen among the default ones, and initializing all methods at once is -- simpler and more consistent. (One can say that we are trying to -- emulate the DerivingVia extension.) data StoreSubmapOps store mname key value StoreSubmapOps :: (forall s. Label mname -> (key : (store : s)) :-> (Bool : s)) -> (forall s. KnownValue value => Label mname -> (key : (store : s)) :-> (Maybe value : s)) -> (forall s. Label mname -> (key : (Maybe value : (store : s))) :-> (store : s)) -> (forall s. Label mname -> (key : (store : s)) :-> (store : s)) -> (forall s. Label mname -> (key : (value : (store : s))) :-> (store : s)) -> StoreSubmapOps store mname key value [sopMem] :: StoreSubmapOps store mname key value -> forall s. Label mname -> (key : (store : s)) :-> (Bool : s) [sopGet] :: StoreSubmapOps store mname key value -> forall s. KnownValue value => Label mname -> (key : (store : s)) :-> (Maybe value : s) [sopUpdate] :: StoreSubmapOps store mname key value -> forall s. Label mname -> (key : (Maybe value : (store : s))) :-> (store : s) [sopDelete] :: StoreSubmapOps store mname key value -> forall s. Label mname -> (key : (store : s)) :-> (store : s) [sopInsert] :: StoreSubmapOps store mname key value -> forall s. Label mname -> (key : (value : (store : s))) :-> (store : s) -- | Provides operations on stored entrypoints. -- -- store is the storage containing both the entrypoint -- epName (note: it has to be in a BigMap to take -- advantage of lazy evaluation) and the epStore field this -- operates on. class StoreHasEntrypoint store epName epParam epStore | store epName -> epParam epStore storeEpOps :: StoreHasEntrypoint store epName epParam epStore => StoreEntrypointOps store epName epParam epStore -- | Datatype containing the full implementation of -- StoreHasEntrypoint typeclass. -- -- We use this grouping because in most cases the implementation will be -- chosen among the default ones, and initializing all methods at once is -- simpler and more consistent. (One can say that we are trying to -- emulate the DerivingVia extension.) data StoreEntrypointOps store epName epParam epStore StoreEntrypointOps :: (forall s. Label epName -> (store : s) :-> (EntrypointLambda epParam epStore : s)) -> (forall s. Label epName -> (EntrypointLambda epParam epStore : (store : s)) :-> (store : s)) -> (forall s. Label epName -> (store : s) :-> (epStore : s)) -> (forall s. Label epName -> (epStore : (store : s)) :-> (store : s)) -> StoreEntrypointOps store epName epParam epStore [sopToEpLambda] :: StoreEntrypointOps store epName epParam epStore -> forall s. Label epName -> (store : s) :-> (EntrypointLambda epParam epStore : s) [sopSetEpLambda] :: StoreEntrypointOps store epName epParam epStore -> forall s. Label epName -> (EntrypointLambda epParam epStore : (store : s)) :-> (store : s) [sopToEpStore] :: StoreEntrypointOps store epName epParam epStore -> forall s. Label epName -> (store : s) :-> (epStore : s) [sopSetEpStore] :: StoreEntrypointOps store epName epParam epStore -> forall s. Label epName -> (epStore : (store : s)) :-> (store : s) -- | Type synonym for a Lambda that can be used as an entrypoint type EntrypointLambda param store = Lambda (param, store) ([Operation], store) -- | Type synonym of a BigMap mapping MText (entrypoint -- names) to EntrypointLambda. -- -- This is useful when defining instances of StoreHasEntrypoint as -- a storage field containing one or more entrypoints (lambdas) of the -- same type. type EntrypointsField param store = BigMap MText (EntrypointLambda param store) -- | Indicates a submap with given key and value types. data k ~> v infix 9 ~> -- | Indicates a stored entrypoint with the given param and -- store types. data param ::-> store infix 9 ::-> -- | Concise way to write down constraints with expected content of a -- storage. -- -- Use it like follows: -- --
-- type StorageConstraint store = StorageContains store -- [ "fieldInt" := Int -- , "fieldNat" := Nat -- , "epsToNat" := Int ::-> Nat -- , "balances" := Address ~> Int -- ] --type family StorageContains store (content :: [NamedField]) :: Constraint -- | Pick storage field. stToField :: StoreHasField store fname ftype => Label fname -> (store : s) :-> (ftype : s) -- | Get storage field, preserving the storage itself on stack. stGetField :: StoreHasField store fname ftype => Label fname -> (store : s) :-> (ftype : (store : s)) -- | Update storage field. stSetField :: StoreHasField store fname ftype => Label fname -> (ftype : (store : s)) :-> (store : s) -- | Check value presence in storage. stMem :: StoreHasSubmap store mname key value => Label mname -> (key : (store : s)) :-> (Bool : s) -- | Get value in storage. stGet :: (StoreHasSubmap store mname key value, KnownValue value) => Label mname -> (key : (store : s)) :-> (Maybe value : s) -- | Update a value in storage. stUpdate :: StoreHasSubmap store mname key value => Label mname -> (key : (Maybe value : (store : s))) :-> (store : s) -- | Delete a value in storage. stDelete :: forall store mname key value s. StoreHasSubmap store mname key value => Label mname -> (key : (store : s)) :-> (store : s) -- | Add a value in storage. stInsert :: StoreHasSubmap store mname key value => Label mname -> (key : (value : (store : s))) :-> (store : s) -- | Add a value in storage, but fail if it will overwrite some existing -- entry. stInsertNew :: StoreHasSubmap store mname key value => Label mname -> (forall s0 any. (key : s0) :-> any) -> (key : (value : (store : s))) :-> (store : s) -- | Extracts and executes the epName entrypoint lambda from -- storage, returing the updated full storage (store) and the -- produced Operations. stEntrypoint :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (epParam : (store : s)) :-> (([Operation], store) : s) -- | Pick stored entrypoint lambda. stToEpLambda :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (store : s) :-> (EntrypointLambda epParam epStore : s) -- | Get stored entrypoint lambda, preserving the storage itself on the -- stack. stGetEpLambda :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (store : s) :-> (EntrypointLambda epParam epStore : (store : s)) -- | Stores the entrypoint lambda in the storage. Fails if already set. stSetEpLambda :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (EntrypointLambda epParam epStore : (store : s)) :-> (store : s) -- | Pick the sub-storage that the entrypoint operates on. stToEpStore :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (store : s) :-> (epStore : s) -- | Get the sub-storage that the entrypoint operates on, preserving the -- storage itself on the stack. stGetEpStore :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (store : s) :-> (epStore : (store : s)) -- | Update the sub-storage that the entrypoint operates on. stSetEpStore :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (epStore : (store : s)) :-> (store : s) -- | Implementation of StoreHasField for case of datatype keeping a -- pack of fields. storeFieldOpsADT :: HasFieldOfType dt fname ftype => StoreFieldOps dt fname ftype -- | Implementation of StoreHasEntrypoint for a datatype keeping a -- pack of fields, among which one has contains the entrypoint and -- another is what such entrypoint operates on. storeEntrypointOpsADT :: (HasFieldOfType store epmName (EntrypointsField epParam epStore), HasFieldOfType store epsName epStore, KnownValue epParam, KnownValue epStore) => Label epmName -> Label epsName -> StoreEntrypointOps store epName epParam epStore -- | Implementation of StoreHasEntrypoint for a datatype that has a -- StoreHasField for an EntrypointsField that contains the -- entrypoint and a StoreHasField for the field such entrypoint -- operates on. storeEntrypointOpsFields :: (StoreHasField store epmName (EntrypointsField epParam epStore), StoreHasField store epsName epStore, KnownValue epParam, KnownValue epStore) => Label epmName -> Label epsName -> StoreEntrypointOps store epName epParam epStore -- | Implementation of StoreHasEntrypoint for a datatype that has a -- StoreHasSubmap that contains the entrypoint and a -- StoreHasField for the field such entrypoint operates on. storeEntrypointOpsSubmapField :: (StoreHasSubmap store epmName MText (EntrypointLambda epParam epStore), StoreHasField store epsName epStore, KnownValue epParam, KnownValue epStore) => Label epmName -> Label epsName -> StoreEntrypointOps store epName epParam epStore -- | Implementation of StoreHasField for a data type which has an -- instance of StoreHasField inside. For instance, it can be used -- for top-level storage. storeFieldOpsDeeper :: (HasFieldOfType storage fieldsPartName fields, StoreHasField fields fname ftype) => Label fieldsPartName -> StoreFieldOps storage fname ftype -- | Implementation of StoreHasSubmap for a data type which has an -- instance of StoreHasSubmap inside. For instance, it can be used -- for top-level storage. storeSubmapOpsDeeper :: (HasFieldOfType storage bigMapPartName fields, StoreHasSubmap fields mname key value) => Label bigMapPartName -> StoreSubmapOps storage mname key value -- | Implementation of StoreHasEntrypoint for a data type which has -- an instance of StoreHasEntrypoint inside. For instance, it can -- be used for top-level storage. storeEntrypointOpsDeeper :: (HasFieldOfType store nameInStore substore, StoreHasEntrypoint substore epName epParam epStore) => Label nameInStore -> StoreEntrypointOps store epName epParam epStore -- | Pretend that given StoreFieldOps implementation is made up for -- field with name desiredName, not its actual name. Logic of -- the implementation remains the same. -- -- See also storeSubmapOpsReferTo. storeFieldOpsReferTo :: Label name -> StoreFieldOps storage name field -> StoreFieldOps storage desiredName field -- | Pretend that given StoreSubmapOps implementation is made up for -- submap with name desiredName, not its actual name. Logic of -- the implementation remains the same. -- -- Use case: imagine that your code requires access to submap named -- X, but in your storage that submap is called Y. Then -- you implement the instance which makes X refer to Y: -- --
-- instance StoreHasSubmap Store X Key Value where -- storeSubmapOps = storeSubmapOpsReferTo #Y storeSubmapOpsForY --storeSubmapOpsReferTo :: Label name -> StoreSubmapOps storage name key value -> StoreSubmapOps storage desiredName key value -- | Change field operations so that they work on a modified field. -- -- For instance, to go from StoreFieldOps Storage "name" Integer -- to StoreFieldOps Storage "name" (value :! Integer) you can -- use mapStoreFieldOps (namedIso #value) mapStoreFieldOps :: LIso field1 field2 -> StoreFieldOps store name field1 -> StoreFieldOps store name field2 -- | Change submap operations so that they work on a modified key. mapStoreSubmapOpsKey :: Lambda key2 key1 -> StoreSubmapOps store name key1 value -> StoreSubmapOps store name key2 value -- | Change submap operations so that they work on a modified value. mapStoreSubmapOpsValue :: KnownValue value1 => LIso value1 value2 -> StoreSubmapOps store name key value1 -> StoreSubmapOps store name key value2 -- | Pretend that given StoreEntrypointOps implementation is made up -- for entrypoint with name desiredName, not its actual name. -- Logic of the implementation remains the same. -- -- See also storeSubmapOpsReferTo. storeEntrypointOpsReferTo :: Label epName -> StoreEntrypointOps store epName epParam epStore -> StoreEntrypointOps store desiredName epParam epStore -- | Chain two implementations of field operations. -- -- Suits for a case when your store does not contain its fields directly -- rather has a nested structure. composeStoreFieldOps :: Label nameInStore -> StoreFieldOps store nameInStore substore -> StoreFieldOps substore nameInSubstore field -> StoreFieldOps store nameInSubstore field -- | Chain implementations of field and submap operations. composeStoreSubmapOps :: Label nameInStore -> StoreFieldOps store nameInStore substore -> StoreSubmapOps substore mname key value -> StoreSubmapOps store mname key value -- | Chain implementations of two submap operations sets. Used to provide -- shortcut access to a nested submap. -- -- This is very inefficient since on each access to substore it has to be -- serialized/deserialized. Use this implementation only if due to -- historical reasons migrating storage is difficult. -- -- LIso (Maybe substore) substore argument describes how to get -- substore value if it was absent in map and how to detect when -- it can be safely removed. -- -- Example of use: sequenceStoreSubmapOps #mySubmap nonDefIso -- storeSubmapOps storeSubmapOps sequenceStoreSubmapOps :: forall store substore value name subName key1 key2. (NiceConstant substore, KnownValue value) => Label name -> LIso (Maybe substore) substore -> StoreSubmapOps store name key1 substore -> StoreSubmapOps substore subName key2 value -> StoreSubmapOps store subName (key1, key2) value composeStoreEntrypointOps :: Label nameInStore -> StoreFieldOps store nameInStore substore -> StoreEntrypointOps substore epName epParam epStore -> StoreEntrypointOps store epName epParam epStore -- | Turn submap operations into operations on a part of the submap value. -- -- Normally, if you need this set of operations, it would be better to -- split your submap into several separate submaps, each operating with -- its own part of the value. This set of operations is pretty -- inefficient and exists only as a temporary measure, if due to -- historical reasons you have to leave storage format intact. -- -- This implementation puts no distinction between value == -- Nothing and value == Just defValue cases. Getters, when -- notice a value equal to the default value, report its absence. Setters -- tend to remove the value from submap when possible. -- -- LIso (Maybe value) value and LIso (Maybe subvalue) -- subvalue arguments describe how to get a value if it was absent -- in map and how to detect when it can be safely removed from map. -- -- Example of use: zoomStoreSubmapOps #mySubmap nonDefIso nonDefIso -- storeSubmapOps storeFieldOpsADT zoomStoreSubmapOps :: forall store submapName nameInSubmap key value subvalue. (NiceConstant value, NiceConstant subvalue) => Label submapName -> LIso (Maybe value) value -> LIso (Maybe subvalue) subvalue -> StoreSubmapOps store submapName key value -> StoreFieldOps value nameInSubmap subvalue -> StoreSubmapOps store nameInSubmap key subvalue -- | Utility to create EntrypointsFields from an entrypoint name -- (epName) and an EntrypointLambda implementation. Note -- that you need to merge multiple of these (with <>) if -- your field contains more than one entrypoint lambda. mkStoreEp :: Label epName -> EntrypointLambda epParam epStore -> EntrypointsField epParam epStore instance (key GHC.Types.~ key', value GHC.Types.~ value', Lorentz.Constraints.Scopes.NiceComparable key, Lorentz.Constraints.Scopes.KnownValue value) => Lorentz.StoreClass.StoreHasSubmap (Michelson.Typed.Haskell.Value.BigMap key' value') name key value instance (key GHC.Types.~ key', value GHC.Types.~ value', Lorentz.Constraints.Scopes.NiceComparable key, Lorentz.Constraints.Scopes.KnownValue value) => Lorentz.StoreClass.StoreHasSubmap (Data.Map.Internal.Map key' value') name key value -- | This module contains various datatypes and functions which are common -- for contract registry packages (e.g. morley-ledgers). module Lorentz.ContractRegistry data ContractInfo ContractInfo :: Contract cp st -> Bool -> Maybe (Parser st) -> Maybe (Notes (ToT st)) -> ContractInfo [ciContract] :: ContractInfo -> Contract cp st [ciIsDocumented] :: ContractInfo -> Bool -- | Specifies how to parse initial storage value. -- -- Normally you pass some user data and call a function that constructs -- storage from that data. -- -- If storage is simple and can be easilly constructed manually, you can -- use Nothing. [ciStorageParser] :: ContractInfo -> Maybe (Parser st) -- | Rewrite annotations in storage. We don't won't to uncoditionally -- override storage notes since after #20 we require notes to be -- non-empty, so we wrap them into Maybe. [ciStorageNotes] :: ContractInfo -> Maybe (Notes (ToT st)) newtype ContractRegistry ContractRegistry :: Map Text ContractInfo -> ContractRegistry [unContractRegistry] :: ContractRegistry -> Map Text ContractInfo (?::) :: Text -> a -> (Text, a) -- | ContractRegistry actions parsed from CLI. data CmdLnArgs List :: CmdLnArgs Print :: Maybe Text -> Maybe FilePath -> Bool -> Bool -> CmdLnArgs Document :: Maybe Text -> Maybe FilePath -> DGitRevision -> CmdLnArgs Analyze :: Maybe Text -> CmdLnArgs PrintStorage :: SomeNiceStorage -> Bool -> CmdLnArgs argParser :: ContractRegistry -> DGitRevision -> Parser CmdLnArgs -- | Run an action operating with ContractRegistry. runContractRegistry :: ContractRegistry -> CmdLnArgs -> IO () printContractFromRegistryDoc :: Maybe Text -> ContractRegistry -> DGitRevision -> Maybe FilePath -> IO () instance Formatting.Buildable.Buildable Lorentz.ContractRegistry.ContractRegistry module Lorentz -- | Application operator. This operator is redundant, since ordinary -- application (f x) means the same as (f $ x). -- However, $ has low, right-associative binding precedence, so it -- sometimes allows parentheses to be omitted; for example: -- --
-- f $ g $ h x = f (g (h x)) ---- -- It is also useful in higher-order situations, such as map -- ($ 0) xs, or zipWith ($) fs xs. -- -- Note that ($) is levity-polymorphic in its result -- type, so that foo $ True where foo :: Bool -> -- Int# is well-typed. ($) :: forall (r :: RuntimeRep) a (b :: TYPE r). (a -> b) -> a -> b infixr 0 $ -- | The Bounded class is used to name the upper and lower limits of -- a type. Ord is not a superclass of Bounded since types -- that are not totally ordered may also have upper and lower bounds. -- -- The Bounded class may be derived for any enumeration type; -- minBound is the first constructor listed in the data -- declaration and maxBound is the last. Bounded may also -- be derived for single-constructor datatypes whose constituent types -- are in Bounded. class Bounded a minBound :: Bounded a => a maxBound :: Bounded a => a -- | The Eq class defines equality (==) and inequality -- (/=). All the basic datatypes exported by the Prelude -- are instances of Eq, and Eq may be derived for any -- datatype whose constituents are also instances of Eq. -- -- The Haskell Report defines no laws for Eq. However, == -- is customarily expected to implement an equivalence relationship where -- two values comparing equal are indistinguishable by "public" -- functions, with a "public" function being one not allowing to see -- implementation details. For example, for a type representing -- non-normalised natural numbers modulo 100, a "public" function doesn't -- make the difference between 1 and 201. It is expected to have the -- following properties: -- --
-- infixr 5 :^: -- data Tree a = Leaf a | Tree a :^: Tree a ---- -- the derived instance of Show is equivalent to -- --
-- instance (Show a) => Show (Tree a) where -- -- showsPrec d (Leaf m) = showParen (d > app_prec) $ -- showString "Leaf " . showsPrec (app_prec+1) m -- where app_prec = 10 -- -- showsPrec d (u :^: v) = showParen (d > up_prec) $ -- showsPrec (up_prec+1) u . -- showString " :^: " . -- showsPrec (up_prec+1) v -- where up_prec = 5 ---- -- Note that right-associativity of :^: is ignored. For example, -- --
-- from . to ≡ id -- to . from ≡ id --class Generic a fromLabel :: IsLabel x a => a -- | The class of semigroups (types with an associative binary operation). -- -- Instances should satisfy the following: -- -- class Semigroup a -- | An associative operation. (<>) :: Semigroup a => a -> a -> a -- | Reduce a non-empty list with <> -- -- The default definition should be sufficient, but this can be -- overridden for efficiency. sconcat :: Semigroup a => NonEmpty a -> a -- | Repeat a value n times. -- -- Given that this works on a Semigroup it is allowed to fail if -- you request 0 or fewer repetitions, and the default definition will do -- so. -- -- By making this a member of the class, idempotent semigroups and -- monoids can upgrade this to execute in O(1) by picking -- stimes = stimesIdempotent or stimes = -- stimesIdempotentMonoid respectively. stimes :: (Semigroup a, Integral b) => b -> a -> a infixr 6 <> -- | The class of monoids (types with an associative binary operation that -- has an identity). Instances should satisfy the following: -- --
-- >>> 2^100 :: Natural -- 1267650600228229401496703205376 ---- -- Operations whose result would be negative throw -- (Underflow :: ArithException), -- --
-- >>> -1 :: Natural -- *** Exception: arithmetic underflow --data Natural -- | The Maybe type encapsulates an optional value. A value of type -- Maybe a either contains a value of type a -- (represented as Just a), or it is empty (represented -- as Nothing). Using Maybe is a good way to deal with -- errors or exceptional cases without resorting to drastic measures such -- as error. -- -- The Maybe type is also a monad. It is a simple kind of error -- monad, where all errors are represented by Nothing. A richer -- error monad can be built using the Either type. data Maybe a Nothing :: Maybe a Just :: a -> Maybe a -- | The Either type represents values with two possibilities: a -- value of type Either a b is either Left -- a or Right b. -- -- The Either type is sometimes used to represent a value which is -- either correct or an error; by convention, the Left constructor -- is used to hold an error value and the Right constructor is -- used to hold a correct value (mnemonic: "right" also means "correct"). -- --
-- >>> let s = Left "foo" :: Either String Int -- -- >>> s -- Left "foo" -- -- >>> let n = Right 3 :: Either String Int -- -- >>> n -- Right 3 -- -- >>> :type s -- s :: Either String Int -- -- >>> :type n -- n :: Either String Int ---- -- The fmap from our Functor instance will ignore -- Left values, but will apply the supplied function to values -- contained in a Right: -- --
-- >>> let s = Left "foo" :: Either String Int -- -- >>> let n = Right 3 :: Either String Int -- -- >>> fmap (*2) s -- Left "foo" -- -- >>> fmap (*2) n -- Right 6 ---- -- The Monad instance for Either allows us to chain -- together multiple actions which may fail, and fail overall if any of -- the individual steps failed. First we'll write a function that can -- either parse an Int from a Char, or fail. -- --
-- >>> import Data.Char ( digitToInt, isDigit )
--
-- >>> :{
-- let parseEither :: Char -> Either String Int
-- parseEither c
-- | isDigit c = Right (digitToInt c)
-- | otherwise = Left "parse error"
--
-- >>> :}
--
--
-- The following should work, since both '1' and '2'
-- can be parsed as Ints.
--
--
-- >>> :{
-- let parseMultiple :: Either String Int
-- parseMultiple = do
-- x <- parseEither '1'
-- y <- parseEither '2'
-- return (x + y)
--
-- >>> :}
--
--
-- -- >>> parseMultiple -- Right 3 ---- -- But the following should fail overall, since the first operation where -- we attempt to parse 'm' as an Int will fail: -- --
-- >>> :{
-- let parseMultiple :: Either String Int
-- parseMultiple = do
-- x <- parseEither 'm'
-- y <- parseEither '2'
-- return (x + y)
--
-- >>> :}
--
--
-- -- >>> parseMultiple -- Left "parse error" --data Either a b Left :: a -> Either a b Right :: b -> Either a b -- | A space-efficient representation of a Word8 vector, supporting -- many efficient operations. -- -- A ByteString contains 8-bit bytes, or by using the operations -- from Data.ByteString.Char8 it can be interpreted as containing -- 8-bit characters. data ByteString -- | A space efficient, packed, unboxed Unicode text type. data Text -- | Function composition. (.) :: (b -> c) -> (a -> b) -> a -> c infixr 9 . -- | A Map from keys k to values a. -- -- The Semigroup operation for Map is union, which -- prefers values from the left operand. If m1 maps a key -- k to a value a1, and m2 maps the same key -- to a different value a2, then their union m1 <> -- m2 maps k to a1. data Map k a -- | Proxy is a type that holds no data, but has a phantom parameter -- of arbitrary type (or even kind). Its use is to provide type -- information, even though there is no value available of that type (or -- it may be too costly to create one). -- -- Historically, Proxy :: Proxy a is a safer -- alternative to the undefined :: a idiom. -- --
-- >>> Proxy :: Proxy (Void, Int -> Int) -- Proxy ---- -- Proxy can even hold types of higher kinds, -- --
-- >>> Proxy :: Proxy Either -- Proxy ---- --
-- >>> Proxy :: Proxy Functor -- Proxy ---- --
-- >>> Proxy :: Proxy complicatedStructure -- Proxy --data Proxy (t :: k) Proxy :: Proxy (t :: k) -- | 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 set of values a. data Set a -- | A class for types with a default value. class Default a -- | The default value for this type. def :: Default a => a -- | A variation of arg for optional arguments. Requires a default -- value to handle the case when the optional argument was omitted: -- --
-- fn (argDef #answer 42 -> ans) = ... ---- -- In case you want to get a value wrapped in Maybe instead, use -- argF or ArgF. argDef :: forall (name :: Symbol) a. Name name -> a -> (name :? a) -> a -- | argF is similar to arg: it unwraps a named parameter -- with the specified name. The difference is that the result of -- argF is inside an arity wrapper, which is Identity for -- normal parameters and Maybe for optional parameters. argF :: forall (name :: Symbol) f a. Name name -> NamedF f a name -> f a -- | arg unwraps a named parameter with the specified name. One way -- to use it is to match on arguments with -XViewPatterns: -- --
-- fn (arg #t -> t) (arg #f -> f) = ... ---- -- This way, the names of parameters can be inferred from the patterns: -- no type signature for fn is required. In case a type -- signature for fn is provided, the parameters must come in the -- same order: -- --
-- fn :: "t" :! Integer -> "f" :! Integer -> ... -- fn (arg #t -> t) (arg #f -> f) = ... -- ok -- fn (arg #f -> f) (arg #t -> t) = ... -- does not typecheck --arg :: forall (name :: Symbol) a. Name name -> (name :! a) -> a -- | 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 -- | O(n) Convert casing to snake_cased_phrase. Subject to -- fusion. toSnake :: Text -> Text -- | O(n) Convert casing to PascalCasePhrase. Subject to -- fusion. toPascal :: Text -> Text -- | O(n) Convert casing to camelCasedPhrase. Subject to -- fusion. toCamel :: Text -> Text -- | Infix application. -- --
-- f :: Either String $ Maybe Int -- = -- f :: Either String (Maybe Int) --type (f :: k1 -> k) $ (a :: k1) = f a infixr 2 $ -- | undefined that leaves a warning in code on every usage. undefined :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => a -- | error that takes Text as an argument. error :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => Text -> a -- | A record is parameterized by a universe u, an interpretation -- f and a list of rows rs. The labels or indices of -- the record are given by inhabitants of the kind u; the type -- of values at any label r :: u is given by its interpretation -- f r :: *. data Rec (a :: u -> Type) (b :: [u]) [RNil] :: forall u (a :: u -> Type). Rec a ('[] :: [u]) [:&] :: forall u (a :: u -> Type) (r :: u) (rs :: [u]). !a r -> !Rec a rs -> Rec a (r : rs) infixr 7 :& mt :: QuasiQuoter data MText data Label (name :: Symbol) [Label] :: forall (name :: Symbol). KnownSymbol name => Label name insertTypeAnn :: forall (b :: T). TypeAnn -> Notes b -> Notes b mkUType :: forall (x :: T). SingI x => Notes x -> Type ligoCombLayout :: GenericStrategy ligoLayout :: GenericStrategy concreteTypeDocHaskellRep :: (Typeable a, GenericIsoValue a, GTypeHasDoc (Rep a), HaveCommonTypeCtor b a) => TypeDocHaskellRep b concreteTypeDocHaskellRepUnsafe :: (Typeable a, GenericIsoValue a, GTypeHasDoc (Rep a)) => TypeDocHaskellRep b concreteTypeDocMichelsonRep :: forall k a (b :: k). (Typeable a, SingI (ToT a), HaveCommonTypeCtor b a) => TypeDocMichelsonRep b concreteTypeDocMichelsonRepUnsafe :: forall k a (b :: k). (Typeable a, SingI (ToT a)) => TypeDocMichelsonRep b customTypeDocMdReference :: (Text, DType) -> [DType] -> WithinParens -> Markdown dStorage :: TypeHasDoc store => DStorageType dTypeDep :: TypeHasDoc t => SomeDocDefinitionItem genericTypeDocDependencies :: (Generic a, GTypeHasDoc (Rep a)) => Proxy a -> [SomeDocDefinitionItem] haskellAddNewtypeField :: Text -> TypeDocHaskellRep a -> TypeDocHaskellRep a haskellRepNoFields :: TypeDocHaskellRep a -> TypeDocHaskellRep a haskellRepStripFieldPrefix :: HasCallStack => TypeDocHaskellRep a -> TypeDocHaskellRep a homomorphicTypeDocHaskellRep :: (Generic a, GTypeHasDoc (Rep a)) => TypeDocHaskellRep a homomorphicTypeDocMdReference :: (Typeable t, TypeHasDoc t, IsHomomorphic t) => Proxy t -> WithinParens -> Markdown homomorphicTypeDocMichelsonRep :: SingI (ToT a) => TypeDocMichelsonRep a poly1TypeDocMdReference :: forall (t :: Type -> Type) r a. (r ~ t a, Typeable t, Each '[TypeHasDoc] '[r, a], IsHomomorphic t) => Proxy r -> WithinParens -> Markdown poly2TypeDocMdReference :: forall (t :: Type -> Type -> Type) r a b. (r ~ t a b, Typeable t, Each '[TypeHasDoc] '[r, a, b], IsHomomorphic t) => Proxy r -> WithinParens -> Markdown coerceContractRef :: ToT a ~ ToT b => ContractRef a -> ContractRef b pattern DefEpName :: EpName opSizeHardLimit :: OpSize smallTransferOpSize :: OpSize type Operation = Operation' Instr type Value = Value' Instr data EpAddress EpAddress :: Address -> EpName -> EpAddress [eaAddress] :: EpAddress -> Address [eaEntrypoint] :: EpAddress -> EpName data DType [DType] :: forall a. TypeHasDoc a => Proxy a -> DType class HaveCommonTypeCtor (a :: k) (b :: k1) class IsHomomorphic (a :: k) data SomeTypeWithDoc [SomeTypeWithDoc] :: forall td. TypeHasDoc td => Proxy td -> SomeTypeWithDoc type family TypeDocFieldDescriptions a :: FieldDescriptions class (Typeable a, SingI TypeDocFieldDescriptions a, FieldDescriptionsValid TypeDocFieldDescriptions a a) => TypeHasDoc a where { type family TypeDocFieldDescriptions a :: FieldDescriptions; type TypeDocFieldDescriptions a = '[] :: [(Symbol, (Maybe Symbol, [(Symbol, Symbol)]))]; } typeDocName :: TypeHasDoc a => Proxy a -> Text typeDocMdDescription :: TypeHasDoc a => Markdown typeDocMdReference :: TypeHasDoc a => Proxy a -> WithinParens -> Markdown typeDocDependencies :: TypeHasDoc a => Proxy a -> [SomeDocDefinitionItem] typeDocHaskellRep :: TypeHasDoc a => TypeDocHaskellRep a typeDocMichelsonRep :: TypeHasDoc a => TypeDocMichelsonRep a type ConstructorFieldTypes dt = GFieldTypes Rep dt type InstrConstructC dt = (GenericIsoValue dt, GInstrConstruct Rep dt) newtype BigMap k v BigMap :: Map k v -> BigMap k v [unBigMap] :: BigMap k v -> Map k v data ContractRef arg ContractRef :: Address -> SomeEntrypointCall arg -> ContractRef arg [crAddress] :: ContractRef arg -> Address [crEntrypoint] :: ContractRef arg -> SomeEntrypointCall arg type EntrypointCall param arg = EntrypointCallT ToT param ToT arg class WellTypedToT a => IsoValue a where { type family ToT a :: T; type ToT a = GValueType Rep a; } toVal :: IsoValue a => a -> Value (ToT a) fromVal :: IsoValue a => Value (ToT a) -> a type family ToT a :: T type SomeEntrypointCall arg = SomeEntrypointCallT ToT arg type WellTypedIsoValue a = (WellTyped ToT a, IsoValue a) data EpName newtype OpSize OpSize :: Word -> OpSize [unOpSize] :: OpSize -> Word data Address data ChainId data KeyHash data Mutez data PublicKey data Signature data Timestamp oneMutez :: Mutez timestampFromSeconds :: Integer -> Timestamp timestampFromUTCTime :: UTCTime -> Timestamp timestampQuote :: QuasiQuoter toMutez :: Word32 -> Mutez zeroMutez :: Mutez class ContainsDoc a buildDocUnfinalized :: ContainsDoc a => a -> ContractDoc class ContainsDoc a => ContainsUpdateableDoc a modifyDocEntirely :: ContainsUpdateableDoc a => (SomeDocItem -> SomeDocItem) -> a -> a data ContractDoc ContractDoc :: DocBlock -> DocBlock -> Set SomeDocDefinitionItem -> Set DocItemId -> ContractDoc [cdContents] :: ContractDoc -> DocBlock [cdDefinitions] :: ContractDoc -> DocBlock [cdDefinitionsSet] :: ContractDoc -> Set SomeDocDefinitionItem [cdDefinitionIds] :: ContractDoc -> Set DocItemId data DGitRevision DGitRevisionKnown :: DGitRevisionInfo -> DGitRevision DGitRevisionUnknown :: DGitRevision class (Typeable d, DOrd d) => DocItem d where { type family DocItemPlacement d :: DocItemPlacementKind; type family DocItemReferenced d :: DocItemReferencedKind; type DocItemPlacement d = 'DocItemInlined; type DocItemReferenced d = 'False; } docItemPos :: DocItem d => Natural docItemSectionName :: DocItem d => Maybe Text docItemSectionDescription :: DocItem d => Maybe Markdown docItemSectionNameStyle :: DocItem d => DocSectionNameStyle docItemRef :: DocItem d => d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d) docItemToMarkdown :: DocItem d => HeaderLevel -> d -> Markdown docItemToToc :: DocItem d => HeaderLevel -> d -> Markdown docItemDependencies :: DocItem d => d -> [SomeDocDefinitionItem] docItemsOrder :: DocItem d => [d] -> [d] data SomeDocItem [SomeDocItem] :: forall d. DocItem d => d -> SomeDocItem -- | A Generic HasAnnotation implementation class GHasAnnotation a gGetAnnotation :: GHasAnnotation a => AnnOptions -> FollowEntrypointFlag -> GenerateFieldAnnFlag -> (Notes (GValueType a), FieldAnn) -- | This class defines the type and field annotations for a given type. -- Right now the type annotations come from names in a named field, and -- field annotations are generated from the record fields. class HasAnnotation a getAnnotation :: HasAnnotation a => FollowEntrypointFlag -> Notes (ToT a) getAnnotation :: (HasAnnotation a, GHasAnnotation (Rep a), GValueType (Rep a) ~ ToT a) => FollowEntrypointFlag -> Notes (ToT a) annOptions :: HasAnnotation a => AnnOptions annOptions :: HasAnnotation a => AnnOptions -- | Used in GHasAnnotation as a flag to track whether or not -- field/constructor annotations should be generated. data GenerateFieldAnnFlag GenerateFieldAnn :: GenerateFieldAnnFlag NotGenerateFieldAnn :: GenerateFieldAnnFlag -- | Used in GHasAnnotation and HasAnnotation as a flag to -- track whether or not it directly follows an entrypoint to avoid -- introducing extra entrypoints. data FollowEntrypointFlag FollowEntrypoint :: FollowEntrypointFlag NotFollowEntrypoint :: FollowEntrypointFlag -- | Allow customization of field annotation generated for a type when -- declaring its HasAnnotation instance. data AnnOptions AnnOptions :: (Text -> Text) -> AnnOptions [fieldAnnModifier] :: AnnOptions -> Text -> Text defaultAnnOptions :: AnnOptions -- | Drops the field name prefix from a field. We assume a convention of -- the prefix always being lower case, and the first letter of the actual -- field name being uppercase. It also accepts another function which -- will be applied directly after dropping the prefix. dropPrefixThen :: (Text -> Text) -> Text -> Text -- | appendTo suffix fields field appends the given suffix to -- field if the field exists in the fields list. appendTo :: Text -> [Text] -> Text -> Text ctorNameToAnnWithOptions :: forall ctor. (KnownSymbol ctor, HasCallStack) => AnnOptions -> FieldAnn -- | Use this in the instance of HasAnnotation when field -- annotations should not be generated. gGetAnnotationNoField :: forall a. (GHasAnnotation (Rep a), GValueType (Rep a) ~ ToT a) => FollowEntrypointFlag -> Notes (ToT a) type DocGrouping = SubDoc -> SomeDocItem attachDocCommons :: ContainsUpdateableDoc a => DGitRevision -> a -> WithFinalizedDoc a buildDoc :: ContainsDoc a => WithFinalizedDoc a -> ContractDoc buildMarkdownDoc :: ContainsDoc a => WithFinalizedDoc a -> LText contractDocToMarkdown :: ContractDoc -> LText docDefinitionRef :: (DocItem d, DocItemPlacement d ~ 'DocItemInDefinitions) => Markdown -> d -> Markdown docItemPosition :: DocItem d => DocItemPos docItemSectionRef :: DocItem di => Maybe Markdown finalizedAsIs :: a -> WithFinalizedDoc a mdTocFromRef :: (DocItem d, DocItemReferenced d ~ 'True) => HeaderLevel -> Markdown -> d -> Markdown mkDGitRevision :: ExpQ modifyDoc :: (ContainsUpdateableDoc a, DocItem i1, DocItem i2) => (i1 -> Maybe i2) -> a -> a morleyRepoSettings :: GitRepoSettings subDocToMarkdown :: HeaderLevel -> SubDoc -> Markdown data DAnchor DAnchor :: Anchor -> DAnchor data DComment DComment :: Text -> DComment data DDescription DDescription :: Markdown -> DDescription newtype DGeneralInfoSection DGeneralInfoSection :: SubDoc -> DGeneralInfoSection data DName DName :: Text -> SubDoc -> DName data DocElem d DocElem :: d -> Maybe SubDoc -> DocElem d [deItem] :: DocElem d -> d [deSub] :: DocElem d -> Maybe SubDoc type family DocItemPlacement d :: DocItemPlacementKind type family DocItemReferenced d :: DocItemReferencedKind newtype DocItemId DocItemId :: Text -> DocItemId data DocItemPlacementKind DocItemInlined :: DocItemPlacementKind DocItemInDefinitions :: DocItemPlacementKind newtype DocItemPos DocItemPos :: (Natural, Text) -> DocItemPos data DocItemRef (p :: DocItemPlacementKind) (r :: DocItemReferencedKind) [DocItemRef] :: DocItemId -> DocItemRef 'DocItemInDefinitions 'True [DocItemRefInlined] :: DocItemId -> DocItemRef 'DocItemInlined 'True [DocItemNoRef] :: DocItemRef 'DocItemInlined 'False data DocSection DocSection :: (NonEmpty $ DocElem d) -> DocSection data DocSectionNameStyle DocSectionNameBig :: DocSectionNameStyle DocSectionNameSmall :: DocSectionNameStyle newtype GitRepoSettings GitRepoSettings :: (Text -> Text) -> GitRepoSettings [grsMkGitRevision] :: GitRepoSettings -> Text -> Text data SomeDocDefinitionItem [SomeDocDefinitionItem] :: forall d. (DocItem d, DocItemPlacement d ~ 'DocItemInDefinitions) => d -> SomeDocDefinitionItem newtype SubDoc SubDoc :: DocBlock -> SubDoc data WithFinalizedDoc a type Markdown = Builder type NiceComparable n = (KnownValue n, Comparable (ToT n)) type NicePrintedValue a = (KnownValue a, ProperPrintedValBetterErrors (ToT a)) type NiceFullPackedValue a = (NicePackedValue a, NiceUnpackedValue a) type NiceUnpackedValue a = (KnownValue a, ProperUnpackedValBetterErrors (ToT a)) type NicePackedValue a = (KnownValue a, ProperPackedValBetterErrors (ToT a)) type NiceConstant a = (KnownValue a, ProperConstantBetterErrors (ToT a)) type NiceStorage a = (HasAnnotation a, KnownValue a, ProperStorageBetterErrors (ToT a)) -- | Constraint applied to any part of parameter type. -- -- Note that you don't usually apply this constraint to the whole -- parameter, consider using NiceParameterFull in such case. -- -- Using this type is justified e.g. when calling another contract, there -- you usually supply an entrypoint argument, not the whole parameter. type NiceParameter a = (KnownValue a, ProperParameterBetterErrors (ToT a)) class (IsoValue a, HasNoNestedBigMaps (ToT a)) => CanHaveBigMap a class (IsoValue a, ForbidBigMap (ToT a)) => NoBigMap a class (IsoValue a, ForbidContract (ToT a)) => NoContractType a -- | Ensure given type does not contain "operation". class (IsoValue a, ForbidOp (ToT a)) => NoOperation a -- | Gathers constraints, commonly required for values. class (IsoValue a, Typeable a) => KnownValue a niceParameterEvi :: forall a. NiceParameter a :- ParameterScope (ToT a) niceStorageEvi :: forall a. NiceStorage a :- StorageScope (ToT a) niceConstantEvi :: forall a. NiceConstant a :- ConstantScope (ToT a) nicePackedValueEvi :: forall a. NicePackedValue a :- PackedValScope (ToT a) niceUnpackedValueEvi :: forall a. NiceUnpackedValue a :- UnpackedValScope (ToT a) nicePrintedValueEvi :: forall a. NicePrintedValue a :- PrintedValScope (ToT a) -- | A special type which wraps over a primitive type and states that it -- has entrypoints (one). -- -- Assuming that any type can have entrypoints makes use of Lorentz -- entrypoints too annoying, so for declaring entrypoints for not sum -- types we require an explicit wrapper. newtype ShouldHaveEntrypoints a ShouldHaveEntrypoints :: a -> ShouldHaveEntrypoints a [unHasEntrypoints] :: ShouldHaveEntrypoints a -> a -- | No entrypoints declared, parameter type will serve as argument type of -- the only existing entrypoint (default one). data EpdNone -- | Check that the given entrypoint has some fields inside. This interface -- allows for an abstraction of contract parameter so that it requires -- some *minimal* specification, but not a concrete one. type family ParameterContainsEntrypoints param (fields :: [NamedEp]) :: Constraint type n :> ty = 'NamedEp n ty infixr 0 :> -- | Checks that the given parameter consists of some specific entrypoint. -- Similar as HasEntrypointArg but ensures that the argument -- matches the following datatype. type HasEntrypointOfType param con exp = (GetEntrypointArgCustom param ('Just con) ~ exp, ParameterDeclaresEntrypoints param) -- | This wrapper allows to pass untyped EpName and bypass checking -- that entrypoint with given name and type exists. newtype TrustEpName TrustEpName :: EpName -> TrustEpName -- | HasEntrypointArg constraint specialized to default entrypoint. type HasDefEntrypointArg cp defEpName defArg = (defEpName ~ EntrypointRef 'Nothing, HasEntrypointArg cp defEpName defArg) -- | When we call a Lorentz contract we should pass entrypoint name and -- corresponding argument. Ideally we want to statically check that -- parameter has entrypoint with given name and argument. Constraint -- defined by this type class holds for contract with parameter -- cp that have entrypoint matching name with type -- arg. -- -- In order to check this property statically, we need to know entrypoint -- name in compile time, EntrypointRef type serves this purpose. -- If entrypoint name is not known, one can use TrustEpName -- wrapper to take responsibility for presence of this entrypoint. -- -- If you want to call a function which has this constraint, you have two -- options: 1. Pass contract parameter cp using type -- application, pass EntrypointRef as a value and pass entrypoint -- argument. Type system will check that cp has an entrypoint -- with given reference and type. 2. Pass EpName wrapped into -- TrustEpName and entrypoint argument. In this case passing -- contract parameter is not necessary, you do not even have to know it. class HasEntrypointArg cp name arg -- | Data returned by this method may look somewhat arbitrary. -- EpName is obviously needed because name can be -- EntrypointRef or TrustEpName. Dict is returned -- because in EntrypointRef case we get this evidence for free and -- don't want to use it. We seem to always need it anyway. useHasEntrypointArg :: HasEntrypointArg cp name arg => name -> (Dict (ParameterScope (ToT arg)), EpName) -- | Universal entrypoint lookup. type family GetEntrypointArgCustom cp mname :: Type -- | Which entrypoint to call. -- -- We intentionally distinguish default and non-default cases because -- this makes API more details-agnostic. data EntrypointRef (mname :: Maybe Symbol) -- | Call the default entrypoint, or root if no explicit default is -- assigned. [CallDefault] :: EntrypointRef 'Nothing -- | Call the given entrypoint; calling default is not treated specially. -- You have to provide entrypoint name via passing it as type argument. -- -- Unfortunatelly, here we cannot accept a label because in most cases -- our entrypoints begin from capital letter (being derived from -- constructor name), while labels must start from a lower-case letter, -- and there is no way to make a conversion at type-level. [Call] :: NiceEntrypointName name => EntrypointRef ('Just name) -- | Similar to ForbidExplicitDefaultEntrypoint, but in a version -- which the compiler can work with (and which produces errors confusing -- for users :/) type NoExplicitDefaultEntrypoint cp = Eval (LookupParameterEntrypoint cp DefaultEpName) ~ 'Nothing -- | Ensure that there is no explicit "default" entrypoint. type ForbidExplicitDefaultEntrypoint cp = Eval (LiftM3 UnMaybe (Pure (Pure (() :: Constraint))) (TError ('Text "Parameter used here must have no explicit \"default\" entrypoint" :$$: 'Text "In parameter type `" :<>: 'ShowType cp :<>: 'Text "`")) (LookupParameterEntrypoint cp DefaultEpName)) -- | Get type of entrypoint with given name, fail if not found. type GetDefaultEntrypointArg cp = Eval (LiftM2 FromMaybe (Pure cp) (LookupParameterEntrypoint cp DefaultEpName)) -- | Get type of entrypoint with given name, fail if not found. type GetEntrypointArg cp name = Eval (LiftM2 FromMaybe (TError ('Text "Entrypoint not found: " :<>: 'ShowType name :$$: 'Text "In contract parameter `" :<>: 'ShowType cp :<>: 'Text "`")) (LookupParameterEntrypoint cp name)) -- | Lookup for entrypoint type by name. -- -- Does not treat default entrypoints in a special way. type family LookupParameterEntrypoint (cp :: Type) :: Symbol -> Exp (Maybe Type) -- | Get all entrypoints declared for parameter. type family AllParameterEntrypoints (cp :: Type) :: [(Symbol, Type)] -- | Parameter declares some entrypoints. -- -- This is a version of ParameterHasEntrypoints which we actually -- use in constraints. When given type is a sum type or newtype, we refer -- to ParameterHasEntrypoints instance, otherwise this instance is -- not necessary. type ParameterDeclaresEntrypoints cp = (If (CanHaveEntrypoints cp) (ParameterHasEntrypoints cp) (() :: Constraint), NiceParameter cp, EntrypointsDerivation (GetParameterEpDerivation cp) cp) -- | Which entrypoints given parameter declares. -- -- Note that usually this function should not be used as constraint, use -- ParameterDeclaresEntrypoints for this purpose. class (EntrypointsDerivation (ParameterEntrypointsDerivation cp) cp, RequireAllUniqueEntrypoints cp) => ParameterHasEntrypoints cp where { type family ParameterEntrypointsDerivation cp :: Type; } -- | Ensure that all declared entrypoints are unique. type RequireAllUniqueEntrypoints cp = RequireAllUniqueEntrypoints' (ParameterEntrypointsDerivation cp) cp -- | Defines a generalized way to declare entrypoints for various parameter -- types. -- -- When defining instances of this typeclass, set concrete deriv -- argument and leave variable cp argument. Also keep in mind, -- that in presence of explicit default entrypoint, all other Or -- arms should be callable, though you can put this burden on user if -- very necessary. -- -- Methods of this typeclass aim to better type-safety when making up an -- implementation and they may be not too convenient to use; users should -- exploit their counterparts. class EntrypointsDerivation deriv cp where { -- | Name and argument of each entrypoint. This may include intermediate -- ones, even root if necessary. -- -- Touching this type family is costly (O(N^2)), don't use it -- often. -- -- Note [order of entrypoints children]: If this contains entrypoints -- referring to indermediate nodes (not leaves) in or tree, then -- each such entrypoint should be mentioned eariler than all of its -- children. type family EpdAllEntrypoints deriv cp :: [(Symbol, Type)]; -- | Get entrypoint argument by name. type family EpdLookupEntrypoint deriv cp :: Symbol -> Exp (Maybe Type); } -- | Construct parameter annotations corresponding to expected entrypoints -- set. -- -- This method is implementation detail, for actual notes construction -- use parameterEntrypointsToNotes. epdNotes :: EntrypointsDerivation deriv cp => (Notes (ToT cp), RootAnn) -- | Construct entrypoint caller. -- -- This does not treat calls to default entrypoint in a special way. -- -- This method is implementation detail, for actual entrypoint lookup use -- parameterEntrypointCall. epdCall :: (EntrypointsDerivation deriv cp, ParameterScope (ToT cp)) => Label name -> EpConstructionRes (ToT cp) (Eval (EpdLookupEntrypoint deriv cp name)) -- | Description of how each of the entrypoints is constructed. epdDescs :: EntrypointsDerivation deriv cp => Rec EpCallingDesc (EpdAllEntrypoints deriv cp) -- | Derive annotations for given parameter. parameterEntrypointsToNotes :: forall cp. ParameterDeclaresEntrypoints cp => ParamNotes (ToT cp) -- | Prepare call to given entrypoint. -- -- This does not treat calls to default entrypoint in a special way. To -- call default entrypoint properly use -- parameterEntrypointCallDefault. parameterEntrypointCall :: forall cp name. ParameterDeclaresEntrypoints cp => Label name -> EntrypointCall cp (GetEntrypointArg cp name) -- | Call the default entrypoint. parameterEntrypointCallDefault :: forall cp. ParameterDeclaresEntrypoints cp => EntrypointCall cp (GetDefaultEntrypointArg cp) -- | Call root entrypoint safely. sepcCallRootChecked :: forall cp. (NiceParameter cp, ForbidExplicitDefaultEntrypoint cp) => SomeEntrypointCall cp eprName :: forall mname. EntrypointRef mname -> EpName -- | Universal entrypoint calling. parameterEntrypointCallCustom :: forall cp mname. ParameterDeclaresEntrypoints cp => EntrypointRef mname -> EntrypointCall cp (GetEntrypointArgCustom cp mname) -- | Constraint applied to a whole parameter type. type NiceParameterFull cp = (Typeable cp, ParameterDeclaresEntrypoints cp) -- | Applicable for wrappers over Lorentz code. class MapLorentzInstr instr -- | Modify all the code under given entity. mapLorentzInstr :: MapLorentzInstr instr => (forall i o. (i :-> o) -> i :-> o) -> instr -> instr type Lambda i o = '[i] :-> '[o] -- | An alias for :. -- -- We discourage its use as this hinders reading error messages (the -- compiler inserts unnecessary parentheses and indentation). type (&) (a :: Type) (b :: [Type]) = a : b infixr 2 & data SomeContractCode [SomeContractCode] :: (NiceParameterFull cp, NiceStorage st) => ContractCode cp st -> SomeContractCode type ContractCode cp st = '[(cp, st)] :-> ContractOut st type ContractOut st = '[([Operation], st)] -- | Alias for :->, seems to make signatures more readable -- sometimes. -- -- Let's someday decide which one of these two should remain. type (%>) = (:->) infixr 1 %> -- | Alias for instruction which hides inner types representation via -- T. newtype (inp :: [Type]) :-> (out :: [Type]) LorentzInstr :: RemFail Instr (ToTs inp) (ToTs out) -> (:->) (inp :: [Type]) (out :: [Type]) [unLorentzInstr] :: (:->) (inp :: [Type]) (out :: [Type]) -> RemFail Instr (ToTs inp) (ToTs out) infixr 1 :-> pattern FI :: (forall out'. Instr (ToTs inp) out') -> inp :-> out pattern I :: Instr (ToTs inp) (ToTs out) -> inp :-> out iGenericIf :: (forall s'. Instr (ToTs a) s' -> Instr (ToTs b) s' -> Instr (ToTs c) s') -> (a :-> s) -> (b :-> s) -> c :-> s iAnyCode :: (inp :-> out) -> Instr (ToTs inp) (ToTs out) iNonFailingCode :: HasCallStack => (inp :-> out) -> Instr (ToTs inp) (ToTs out) iMapAnyCode :: (forall o'. Instr (ToTs i1) o' -> Instr (ToTs i2) o') -> (i1 :-> o) -> i2 :-> o iForceNotFail :: (i :-> o) -> i :-> o -- | Wrap Lorentz instruction with variable annotations, annots -- list has to be non-empty, otherwise this function raises an error. iWithVarAnnotations :: HasCallStack => [Text] -> (inp :-> out) -> inp :-> out (#) :: (a :-> b) -> (b :-> c) -> a :-> c infixl 8 # -- | Parse textual representation of a Michelson value and turn it into -- corresponding Haskell value. -- -- Note: it won't work in some complex cases, e. g. if there is a lambda -- which uses an instruction which depends on current contract's type. -- Obviously it can not work, because we don't have any information about -- a contract to which this value belongs (there is no such contract at -- all). parseLorentzValue :: forall v. KnownValue v => Text -> Either ParseLorentzError v -- | Lorentz version of transformStrings. transformStringsLorentz :: Bool -> (MText -> MText) -> (inp :-> out) -> inp :-> out -- | Lorentz version of transformBytes. transformBytesLorentz :: Bool -> (ByteString -> ByteString) -> (inp :-> out) -> inp :-> out optimizeLorentzWithConf :: OptimizerConf -> (inp :-> out) -> inp :-> out optimizeLorentz :: (inp :-> out) -> inp :-> out -- | Version of Entrypoint which accepts no argument. type Entrypoint_ store = '[store] :-> ContractOut store -- | Single entrypoint of a contract. -- -- Note that we cannot make it return [[Operation], store] -- because such entrypoint should've been followed by pair, and -- this is not possible if entrypoint implementation ends with -- failWith. type Entrypoint param store = '[param, store] :-> ContractOut store -- | Convert something from ContractAddr in Haskell world. class FromContractRef (cp :: Type) (contract :: Type) fromContractRef :: FromContractRef cp contract => ContractRef cp -> contract -- | Convert something to ContractRef in Haskell world. class ToContractRef (cp :: Type) (contract :: Type) toContractRef :: (ToContractRef cp contract, HasCallStack) => contract -> ContractRef cp -- | Convert something referring to a contract (not specific entrypoint) to -- TAddress in Haskell world. class ToTAddress (cp :: Type) (a :: Type) toTAddress :: ToTAddress cp a => a -> TAddress cp -- | Convert something to Address in Haskell world. -- -- Use this when you want to access state of the contract and are not -- interested in calling it. class ToAddress a toAddress :: ToAddress a => a -> Address -- | Address associated with value of contract arg type. -- -- Places where ContractRef can appear are now severely limited, -- this type gives you type-safety of ContractRef but still can be -- used everywhere. This type is not a full-featured one rather a helper; -- in particular, once pushing it on stack, you cannot return it back to -- Haskell world. -- -- Note that it refers to an entrypoint of the contract, not just the -- contract as a whole. In this sense this type differs from -- TAddress. -- -- Unlike with ContractRef, having this type you still cannot be -- sure that the referred contract exists and need to perform a lookup -- before calling it. newtype FutureContract arg FutureContract :: ContractRef arg -> FutureContract arg [unFutureContract] :: FutureContract arg -> ContractRef arg -- | Address which remembers the parameter type of the contract it refers -- to. -- -- It differs from Michelson's contract type because it cannot -- contain entrypoint, and it always refers to entire contract parameter -- even if this contract has explicit default entrypoint. newtype TAddress p TAddress :: Address -> TAddress p [unTAddress] :: TAddress p -> Address -- | Turn TAddress to ContractRef in Haskell world. -- -- This is an analogy of address to contract convertion -- in Michelson world, thus you have to supply an entrypoint (or call the -- default one explicitly). callingTAddress :: forall cp mname. NiceParameterFull cp => TAddress cp -> EntrypointRef mname -> ContractRef (GetEntrypointArgCustom cp mname) -- | Specification of callTAddress to call the default entrypoint. callingDefTAddress :: forall cp. NiceParameterFull cp => TAddress cp -> ContractRef (GetDefaultEntrypointArg cp) -- | Cast something appropriate to TAddress. toTAddress_ :: forall cp addr s. ToTAddress_ cp addr => (addr : s) :-> (TAddress cp : s) convertContractRef :: forall cp contract2 contract1. (ToContractRef cp contract1, FromContractRef cp contract2) => contract1 -> contract2 -- | Include a value at given position on stack into comment produced by -- printComment. -- --
-- >>> stackRef @0 -- <includes the top of the stack> --stackRef :: forall (gn :: Nat) st n. (n ~ ToPeano gn, SingI n, KnownPeano n, RequireLongerThan st n) => PrintComment st -- | Print a comment. It will be visible in tests. -- --
-- >>> printComment "Hello world!" -- -- >>> printComment $ "On top of the stack I see " <> stackRef @0 --printComment :: PrintComment (ToTs s) -> s :-> s -- | Test an invariant, fail if it does not hold. -- -- This won't be included into production contract and is executed only -- in tests. testAssert :: (Typeable (ToTs out), HasCallStack) => Text -> PrintComment (ToTs inp) -> (inp :-> (Bool : out)) -> inp :-> inp -- | Fix the current type of the stack to be given one. -- --
-- >>> stackType @'[Natural] -- -- >>> stackType @(Integer : Natural : s) -- -- >>> stackType @'["balance" :! Integer, "toSpend" :! Integer, BigMap Address Integer] ---- -- Note that you can omit arbitrary parts of the type. -- --
-- >>> stackType @'["balance" :! Integer, "toSpend" :! _, BigMap _ _] --stackType :: forall s. s :-> s -- | Lifted EDivOp. class (EDivOp (ToT n) (ToT m), NiceComparable n, NiceComparable m, ToT (EDivOpResHs n m) ~ EDivOpRes (ToT n) (ToT m), ToT (EModOpResHs n m) ~ EModOpRes (ToT n) (ToT m)) => EDivOpHs n m where { type family EDivOpResHs n m :: Type; type family EModOpResHs n m :: Type; } -- | Lifted SliceOp. class SliceOp (ToT c) => SliceOpHs c -- | Lifted ConcatOp. class ConcatOp (ToT c) => ConcatOpHs c -- | Lifted GetOp. class (GetOp (ToT c), ToT (GetOpKeyHs c) ~ (GetOpKey (ToT c)), ToT (GetOpValHs c) ~ GetOpVal (ToT c)) => GetOpHs c where { type family GetOpKeyHs c :: Type; type family GetOpValHs c :: Type; } -- | Lifted UpdOp. class (UpdOp (ToT c), ToT (UpdOpKeyHs c) ~ (UpdOpKey (ToT c)), ToT (UpdOpParamsHs c) ~ UpdOpParams (ToT c)) => UpdOpHs c where { type family UpdOpKeyHs c :: Type; type family UpdOpParamsHs c :: Type; } -- | Lifted SizeOp. -- -- This could be just a constraint alias, but to avoid T types -- appearance in error messages we make a full type class with concrete -- instances. class SizeOp (ToT c) => SizeOpHs c -- | Lifted IterOp. class (IterOp (ToT c), ToT (IterOpElHs c) ~ IterOpEl (ToT c)) => IterOpHs c where { type family IterOpElHs c :: Type; } -- | Lifted MapOp. class (MapOp (ToT c), ToT (MapOpInpHs c) ~ MapOpInp (ToT c), ToT (MapOpResHs c ()) ~ MapOpRes (ToT c) (ToT ())) => MapOpHs c where { type family MapOpInpHs c :: Type; type family MapOpResHs c :: Type -> Type; } -- | A useful property which holds for reasonable MapOp instances. -- -- It's a separate thing from MapOpHs because it mentions -- b type parameter. type family IsoMapOpRes c b -- | Lifted MemOpKey. class (MemOp (ToT c), ToT (MemOpKeyHs c) ~ MemOpKey (ToT c)) => MemOpHs c where { type family MemOpKeyHs c :: Type; } data GenericStrategy alphabetically :: EntriesReorder cstr :: forall (n :: Nat). KnownNat n => [Natural] -> CstrDepth customGeneric :: String -> GenericStrategy -> Q [Dec] fld :: forall (n :: Nat). KnownNat n => Natural forbidUnnamedFields :: UnnamedEntriesReorder fromDepthsStrategy :: (Int -> [Natural]) -> GenericStrategy haskellBalanced :: GenericStrategy leaveUnnamedFields :: UnnamedEntriesReorder leftBalanced :: GenericStrategy leftComb :: GenericStrategy reorderingConstrs :: EntriesReorder -> GenericStrategy -> GenericStrategy reorderingData :: UnnamedEntriesReorder -> EntriesReorder -> GenericStrategy -> GenericStrategy reorderingFields :: UnnamedEntriesReorder -> EntriesReorder -> GenericStrategy -> GenericStrategy rightBalanced :: GenericStrategy rightComb :: GenericStrategy withDepths :: [CstrDepth] -> GenericStrategy -- | Provides Buildable instance that prints Lorentz value via -- Michelson's Value. -- -- Result won't be very pretty, but this avoids requiring Show or -- Buildable instances. newtype PrintAsValue a PrintAsValue :: a -> PrintAsValue a type List = [] -- | Extension of EpdPlain, EpdRecursive, and -- EpdDelegate which allow specifying root annotation for the -- parameters. data EpdWithRoot (r :: Symbol) epd -- | Extension of EpdPlain on parameters being defined as several -- nested datatypes. -- -- In particular, it will traverse the immediate sum type, and require -- another ParameterHasEntrypoints for the inner complex -- datatypes. Only those inner types are considered which are the only -- fields in their respective constructors. Inner types should not -- themselves declare default entrypoint, we enforce this for better -- modularity. Each top-level constructor will be treated as entrypoint -- even if it contains a complex datatype within, in such case that would -- be an entrypoint corresponding to intermediate node in or -- tree. -- -- Comparing to EpdRecursive this gives you more control over -- where and how entrypoints will be derived. data EpdDelegate -- | Extension of EpdPlain on parameters being defined as several -- nested datatypes. -- -- In particular, this will traverse sum types recursively, stopping at -- Michelson primitives (like Natural) and constructors with -- number of fields different from one. -- -- It does not assign names to intermediate nodes of Or tree, only -- to the very leaves. -- -- If some entrypoint arguments have custom IsoValue instance, -- this derivation way will not work. As a workaround, you can wrap your -- argument into some primitive (e.g. :!). data EpdRecursive -- | Implementation of ParameterHasEntrypoints which fits for case -- when your contract exposes multiple entrypoints via having sum type as -- its parameter. -- -- In particular, each constructor would produce a homonymous entrypoint -- with argument type equal to type of constructor field (each -- constructor should have only one field). Constructor called -- Default will designate the default entrypoint. data EpdPlain -- | Lifted UnaryArithOp. class (UnaryArithOp aop (ToT n), NiceComparable n, ToT (UnaryArithResHs aop n) ~ UnaryArithRes aop (ToT n)) => UnaryArithOpHs (aop :: Type) (n :: Type) where { type family UnaryArithResHs aop n :: Type; } -- | Lifted ArithOp. class (ArithOp aop (ToT n) (ToT m), NiceComparable n, NiceComparable m, ToT (ArithResHs aop n m) ~ ArithRes aop (ToT n) (ToT m)) => ArithOpHs (aop :: Type) (n :: Type) (m :: Type) where { type family ArithResHs aop n m :: Type; } -- | Wrappable is similar to lens Wrapped class without the -- method. It provides type family that is mainly used as constraint when -- unwrapping Lorentz instruction into a Haskell newtype and vice versa. class ToT s ~ ToT (Unwrappable s) => Wrappable (s :: Type) where { type family Unwrappable s :: Type; type Unwrappable s = GUnwrappable (Rep s); } -- | Wrap parameter into this to locally assign a way to derive entrypoints -- for it. newtype ParameterWrapper (deriv :: Type) cp ParameterWrapper :: cp -> ParameterWrapper (deriv :: Type) cp [unParameterWraper] :: ParameterWrapper (deriv :: Type) cp -> cp -- | Modify the example value of an entrypoint data DEntrypointExample DEntrypointExample :: Value t -> DEntrypointExample -- | Put a document item. doc :: DocItem di => di -> s :-> s -- | Group documentation built in the given piece of code into block -- dedicated to one thing, e.g. to one entrypoint. -- -- Examples of doc items you can pass here: DName, -- DGeneralInfoSection. docGroup :: DocItem di => (SubDoc -> di) -> (inp :-> out) -> inp :-> out -- | Insert documentation of the contract storage type. The type should be -- passed using type applications. -- | Deprecated: Use `doc (dStorage @storage)` instead. docStorage :: forall storage s. TypeHasDoc storage => s :-> s -- | Give a name to given contract. Apply it to the whole contract code. -- | Deprecated: Use `docGroup name` instead. contractName :: Text -> (inp :-> out) -> inp :-> out -- | Deprecated: Use buildDoc instead. buildLorentzDoc :: (inp :-> out) -> ContractDoc -- | Takes an instruction that inserts documentation items with general -- information about the contract. Inserts it into general section. See -- DGeneralInfoSection. -- | Deprecated: Use `docGroup DGeneralInfoSection` instead. contractGeneral :: (inp :-> out) -> inp :-> out -- | Inserts general information about the contract using the default -- format. -- -- This includes git revision and some other information common for all -- contracts. Git revision is left unknown in the library code and is -- supposed to be updated in an executable using e.g. -- buildLorentzDocWithGitRev. contractGeneralDefault :: s :-> s -- | Deprecated: Use `buildDoc . attachDocCommons gitRev` instead. buildLorentzDocWithGitRev :: DGitRevision -> (inp :-> out) -> ContractDoc -- | Deprecated: Use buildMarkdownDoc instead. renderLorentzDoc :: (inp :-> out) -> LText -- | Deprecated: Use `buildMarkdownDoc . attachDocCommons gitRev` -- instead. renderLorentzDocWithGitRev :: DGitRevision -> (inp :-> out) -> LText -- | Leave only instructions related to documentation. -- -- This function is useful when your method executes a lambda coming from -- outside, but you know its properties and want to propagate its -- documentation to your contract code. cutLorentzNonDoc :: (inp :-> out) -> s :-> s mkDEntrypointExample :: forall a. NiceParameter a => a -> DEntrypointExample data Blake2b :: HashAlgorithmKind data Sha512 :: HashAlgorithmKind data Sha256 :: HashAlgorithmKind -- | Documentation item for hash algorithms. data DHashAlgorithm -- | Hash algorithm used in Tezos. class Typeable alg => KnownHashAlgorithm (alg :: HashAlgorithmKind) hashAlgorithmName :: KnownHashAlgorithm alg => Proxy alg -> Text computeHash :: KnownHashAlgorithm alg => ByteString -> ByteString toHash :: (KnownHashAlgorithm alg, BytesLike bs) => (bs : s) :-> (Hash alg bs : s) -- | Hash of type t evaluated from data of type a. newtype Hash (alg :: HashAlgorithmKind) a HashUnsafe :: ByteString -> Hash (alg :: HashAlgorithmKind) a [unHash] :: Hash (alg :: HashAlgorithmKind) a -> ByteString -- | Represents a signature, where signed data has given type. -- -- Since we usually sign a packed data, a common pattern for this type is -- TSignature (Packed signedData). If you don't want to -- use Packed, use plain TSignature ByteString instead. newtype TSignature a TSignature :: Signature -> TSignature a [unTSignature] :: TSignature a -> Signature -- | Represents a ByteString resulting from packing a value of type -- a. -- -- This is not guaranteed to keep some packed value, and -- unpack can fail. We do so because often we need to accept -- values of such type from user, and also because there is no simple way -- to check validity of packed data without performing full unpack. So -- this wrapper is rather a hint for users. newtype Packed a Packed :: ByteString -> Packed a [unPacked] :: Packed a -> ByteString -- | Everything which is represented as bytes inside. class (KnownValue bs, ToT bs ~ ToT ByteString) => BytesLike bs toBytes :: BytesLike bs => bs -> ByteString -- | Sign data using Ed25519 curve. TODO [#456]: handle other methods, -- either all at once (if viable) or each one separately lSignEd22519 :: BytesLike a => SecretKey -> a -> TSignature a -- | Evaluate hash in Haskell world. toHashHs :: forall alg bs. (BytesLike bs, KnownHashAlgorithm alg) => bs -> Hash alg bs lPackValueRaw :: forall a. NicePackedValue a => a -> ByteString lUnpackValueRaw :: forall a. NiceUnpackedValue a => ByteString -> Either UnpackError a lPackValue :: forall a. NicePackedValue a => a -> Packed a lUnpackValue :: forall a. NiceUnpackedValue a => Packed a -> Either UnpackError a lEncodeValue :: forall a. NicePrintedValue a => a -> ByteString -- | This function transforms Lorentz values into script_expr. -- -- script_expr is used in RPC as an argument in entrypoint -- designed for getting value by key from the big_map in Babylon. In -- order to convert value to the script_expr we have to pack it, -- take blake2b hash and add specific expr prefix. Take a look -- at -- https://gitlab.com/tezos/tezos/blob/6e25ae8eb385d9975a30388c7a7aa2a9a65bf184/src/proto_005_PsBabyM1/lib_protocol/script_expr_hash.ml -- and -- https://gitlab.com/tezos/tezos/blob/6e25ae8eb385d9975a30388c7a7aa2a9a65bf184/src/proto_005_PsBabyM1/lib_protocol/contract_services.ml#L136 -- for more information. valueToScriptExpr :: forall t. NicePackedValue t => t -> ByteString -- | Similar to valueToScriptExpr, but for values encoded as -- Expressions. This is only used in tests. expressionToScriptExpr :: Expression -> ByteString -- | Coercions between a to b are permitted and safe. type Coercible_ a b = (MichelsonCoercible a b, CanCastTo a b, CanCastTo b a) -- | Coercion from a to b is permitted and safe. type Castable_ a b = (MichelsonCoercible a b, CanCastTo a b) -- | Explicitly allowed coercions. -- -- a CanCastTo b proclaims that a can be casted -- to b without violating any invariants of b. -- -- This relation is reflexive; it may be symmetric or not. It -- tends to be composable: casting complex types usually requires -- permission to cast their respective parts; for such types consider -- using castDummyG as implementation of the method of this -- typeclass. -- -- For cases when a cast from a to b requires some -- validation, consider rather making a dedicated function which performs -- the necessary checks and then calls forcedCoerce. class a `CanCastTo` b -- | An optional method which helps passing -Wredundant-constraints check. -- Also, you can set specific implementation for it with specific sanity -- checks. castDummy :: CanCastTo a b => Proxy a -> Proxy b -> () -- | Whether two types have the same Michelson representation. type MichelsonCoercible a b = ToT a ~ ToT b -- | Coercion for Haskell world. -- -- We discourage using this function on Lorentz types, consider using -- coerce instead. One of the reasons forthat is that in Lorentz -- it's common to declare types as newtypes consisting of existing -- primitives, and forcedCoerce tends to ignore all phantom type -- variables of newtypes thus violating their invariants. forcedCoerce :: Coercible a b => a -> b -- | Convert between values of types that have the same representation. -- -- This function is not safe in a sense that this allows * breaking -- invariants of casted type (example: UStore from -- morley-upgradeable), or * may stop compile on code changes (example: -- coercion of pair to a datatype with two fields will break if new field -- is added). Still, produced Michelson code will always be valid. -- -- Prefer using one of more specific functions from this module. forcedCoerce_ :: MichelsonCoercible a b => (a : s) :-> (b : s) gForcedCoerce_ :: MichelsonCoercible (t a) (t b) => (t a : s) :-> (t b : s) -- | Convert between two stacks via failing. fakeCoerce :: s1 :-> s2 fakeCoercing :: (s1 :-> s2) -> s1' :-> s2' -- | Specialized version of coerce_ to wrap into a haskell -- newtype. coerceWrap :: forall a s. Wrappable a => (Unwrappable a : s) :-> (a : s) -- | Specialized version of coerce_ to unwrap a haskell newtype. coerceUnwrap :: forall a s. Wrappable a => (a : s) :-> (Unwrappable a : s) -- | Lift given value to a named value. toNamed :: Label name -> (a : s) :-> (NamedF Identity a name : s) -- | Unpack named value. fromNamed :: Label name -> (NamedF Identity a name : s) :-> (a : s) -- | Coercion in Haskell world which respects CanCastTo. checkedCoerce :: forall a b. (CanCastTo a b, Coercible a b) => a -> b -- | Coerce between types which have an explicit permission for that in the -- face of CanCastTo constraint. checkedCoerce_ :: forall a b s. Castable_ a b => (a : s) :-> (b : s) -- | Pretends that the top item of the stack was coerced. checkedCoercing_ :: forall a b s. Coercible_ a b => ((b : s) :-> (b : s)) -> (a : s) :-> (a : s) -- | Locally provide given CanCastTo instance. allowCheckedCoerceTo :: forall b a. Dict (CanCastTo a b) -- | Locally provide bidirectional CanCastTo instance. allowCheckedCoerce :: forall a b. Dict (CanCastTo a b, CanCastTo b a) -- | Implementation of castDummy for types composed from smaller -- types. It helps to ensure that all necessary constraints are requested -- in instance head. castDummyG :: (Generic a, Generic b, GCanCastTo (Rep a) (Rep b)) => Proxy a -> Proxy b -> () type CaseTC dt out inp clauses = (InstrCaseC dt, RMap (CaseClauses dt), RecFromTuple clauses, clauses ~ Rec (CaseClauseL inp out) (CaseClauses dt)) -- | Provides "case" arrow which works on different wrappers for clauses. class CaseArrow name body clause | clause -> name, clause -> body -- | 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. (/->) :: CaseArrow name body clause => Label name -> body -> clause infixr 0 /-> -- | Lorentz analogy of CaseClause, it works on plain Type -- types. data CaseClauseL (inp :: [Type]) (out :: [Type]) (param :: CaseClauseParam) [CaseClauseL] :: (AppendCtorField x inp :-> out) -> CaseClauseL inp out ('CaseClauseParam ctor x) -- | Shortcut for multiple HasFieldOfType constraints. type family HasFieldsOfType (dt :: Type) (fs :: [NamedField]) :: Constraint type n := ty = 'NamedField n ty infixr 0 := -- | A pair of field name and type. data NamedField NamedField :: Symbol -> Type -> NamedField -- | Like HasField, but allows constrainting field type. type HasFieldOfType dt fname fieldTy = (HasField dt fname, GetFieldType dt fname ~ fieldTy) -- | Allows field access and modification. type HasField dt fname = (InstrGetFieldC dt fname, InstrSetFieldC dt fname) -- | Extract a field of a datatype replacing the value of this datatype -- with the extracted field. -- -- For this and the following functions you have to specify field name -- which is either record name or name attached with (:!) -- operator. toField :: forall dt name st. InstrGetFieldC dt name => Label name -> (dt : st) :-> (GetFieldType dt name : st) -- | Like toField, but leaves field named. toFieldNamed :: forall dt name st. InstrGetFieldC dt name => Label name -> (dt : st) :-> ((name :! GetFieldType dt name) : st) -- | Extract a field of a datatype, leaving the original datatype on stack. getField :: forall dt name st. InstrGetFieldC dt name => Label name -> (dt : st) :-> (GetFieldType dt name : (dt : st)) -- | Like getField, but leaves field named. getFieldNamed :: forall dt name st. InstrGetFieldC dt name => Label name -> (dt : st) :-> ((name :! GetFieldType dt name) : (dt : st)) -- | Set a field of a datatype. setField :: forall dt name st. InstrSetFieldC dt name => Label name -> (GetFieldType dt name : (dt : st)) :-> (dt : st) -- | Apply given modifier to a datatype field. modifyField :: forall dt name st. (InstrGetFieldC dt name, InstrSetFieldC dt name) => Label name -> (forall st0. (GetFieldType dt name : st0) :-> (GetFieldType dt name : st0)) -> (dt : st) :-> (dt : st) -- | Make up a datatype. You provide a pack of individual fields -- constructors. -- -- Each element of the accepted record should be an instruction wrapped -- with fieldCtor function. This instruction will have access to -- the stack at the moment of calling construct. Instructions -- have to output fields of the built datatype, one per instruction; -- instructions order is expected to correspond to the order of fields in -- the datatype. construct :: forall dt st. (InstrConstructC dt, RMap (ConstructorFieldTypes dt)) => Rec (FieldConstructor st) (ConstructorFieldTypes dt) -> st :-> (dt : st) -- | Version of construct which accepts tuple of field constructors. constructT :: forall dt fctors st. (InstrConstructC dt, RMap (ConstructorFieldTypes dt), fctors ~ Rec (FieldConstructor st) (ConstructorFieldTypes dt), RecFromTuple fctors) => IsoRecTuple fctors -> st :-> (dt : st) -- | Construct an object from fields on the stack. constructStack :: forall dt fields st. (InstrConstructC dt, ToTs fields ~ ToTs (ConstructorFieldTypes dt), KnownList fields) => (fields ++ st) :-> (dt : st) -- | Decompose a complex object into its fields deconstruct :: forall dt fields st. (InstrDeconstructC dt, KnownList fields, ToTs fields ~ ToTs (ConstructorFieldTypes dt)) => (dt : st) :-> (fields ++ st) -- | Lift an instruction to field constructor. fieldCtor :: HasCallStack => (st :-> (f : st)) -> FieldConstructor st f -- | Wrap entry in constructor. Useful for sum types. wrap_ :: forall dt name st. InstrWrapC dt name => Label name -> AppendCtorField (GetCtorField dt name) st :-> (dt : st) -- | Wrap entry in single-field constructor. Useful for sum types. wrapOne :: forall dt name st. InstrWrapOneC dt name => Label name -> (CtorOnlyField name dt : st) :-> (dt : st) -- | Pattern match on the given sum type. -- -- You have to provide a Rec containing case branches. To -- construct a case branch use /-> operator. case_ :: forall dt out inp. (InstrCaseC dt, RMap (CaseClauses dt)) => Rec (CaseClauseL inp out) (CaseClauses dt) -> (dt : inp) :-> out -- | Like case_, accepts a tuple of clauses, which may be more -- convenient. -- -- If user is experiencing problems with wierd errors about tuples while -- using this function, he should take look at Instances and -- ensure that his tuple isn't bigger than generated instances, if so, he -- should probably extend number of generated instances. caseT :: forall dt out inp clauses. CaseTC dt out inp clauses => IsoRecTuple clauses -> (dt : inp) :-> out -- | Unwrap a constructor with the given name. Useful for sum types. unwrapUnsafe_ :: forall dt name st. InstrUnwrapC dt name => Label name -> (dt : st) :-> (CtorOnlyField name dt : st) type family RequireFlatEpDerivation cp deriv :: Constraint type family RequireFlatParamEps cp :: Constraint -- | Provides arror for convenient entrypoint documentation class EntryArrow kind name body -- | Lift entrypoint implementation. -- -- Entrypoint names should go with "e" prefix. (#->) :: EntryArrow kind name body => (Label name, Proxy kind) -> body -> body -- | Constraint for documentEntrypoints. type DocumentEntrypoints kind a = (Generic a, GDocumentEntrypoints kind (Rep a)) -- | Pick a type documentation from CtorField. class (KnownSymbol con) => DeriveCtorFieldDoc con (cf :: CtorField) deriveCtorFieldDoc :: DeriveCtorFieldDoc con cf => DEntrypointArg -- | Describes argument of an entrypoint. data DEntrypointArg DEntrypointArg :: Maybe DType -> [ParamBuildingStep] -> Type -> DEntrypointArg -- | Argument of the entrypoint. Pass Nothing if no argument is -- required. [epaArg] :: DEntrypointArg -> Maybe DType -- | Describes a way to lift an entrypoint argument into full parameter -- which can be passed to the contract. -- -- Steps are supposed to be applied in the order opposite to one in which -- they are given. E.g. suppose that an entrypoint is called as Run -- (Service1 arg); then the first step (actual last) should describe -- wrapping into Run constructor, and the second step (actual -- first) should be about wrapping into Service1 constructor. [epaBuilding] :: DEntrypointArg -> [ParamBuildingStep] -- | Untyped representation of entrypoint, used for printing its michelson -- type representation. [epaType] :: DEntrypointArg -> Type -- | Describes a parameter building step. -- -- This can be wrapping into (Haskell) constructor, or a more complex -- transformation. data ParamBuildingStep -- | Wraps something into constructor with given name. Constructor should -- be the one which corresponds to an entrypoint defined via field -- annotation, for more complex cases use PbsCustom. PbsWrapIn :: Text -> ParamBuildingDesc -> ParamBuildingStep -- | Directly call an entrypoint marked with a field annotation. PbsCallEntrypoint :: EpName -> ParamBuildingStep -- | Other action. PbsCustom :: ParamBuildingDesc -> ParamBuildingStep -- | This entrypoint cannot be called, which is possible when an explicit -- default entrypoint is present. This is not a true entrypoint but just -- some intermediate node in or tree and neither it nor any of -- its parents are marked with a field annotation. -- -- It contains dummy ParamBuildingSteps which were assigned before -- entrypoints were taken into account. PbsUncallable :: [ParamBuildingStep] -> ParamBuildingStep data ParamBuildingDesc ParamBuildingDesc :: Markdown -> ParamBuilder -> ParamBuilder -> ParamBuildingDesc -- | Plain english description of this step. [pbdEnglish] :: ParamBuildingDesc -> Markdown -- | How to construct parameter in Haskell code. [pbdHaskell] :: ParamBuildingDesc -> ParamBuilder -- | How to construct parameter working on raw Michelson. [pbdMichelson] :: ParamBuildingDesc -> ParamBuilder -- | When describing the way of parameter construction - piece of -- incremental builder for this description. newtype ParamBuilder ParamBuilder :: (Markdown -> Markdown) -> ParamBuilder -- | Argument stands for previously constructed parameter piece, and -- returned value - a piece constructed after our step. [unParamBuilder] :: ParamBuilder -> Markdown -> Markdown -- | Inserts a reference to an existing entrypoint. -- -- This helps to avoid duplication in the generated documentation, in -- order not to overwhelm the reader. data DEntrypointReference DEntrypointReference :: Text -> Anchor -> DEntrypointReference -- | Describes the behaviour common for entrypoints of given kind. -- -- This has very special use cases, like contracts with mix of -- upgradeable and permanent entrypoints. data CommonEntrypointsBehaviourKind kind -- | Describes the behaviour common for all entrypoints. -- -- For instance, if your contract runs some checks before calling any -- entrypoint, you probably want to wrap those checks into -- entrypointSection "Prior checks" (Proxy -- @CommonContractBehaviourKind). data CommonContractBehaviourKind -- | Default value for DEntrypoint type argument. data PlainEntrypointsKind -- | Describes location of entrypoints of the given kind. -- -- All such entrypoints will be placed under the same "entrypoints" -- section, and this instance defines characteristics of this section. class Typeable ep => EntrypointKindHasDoc (ep :: Type) -- | Position of the respective entrypoints section in the doc. This shares -- the same positions space with all other doc items. entrypointKindPos :: EntrypointKindHasDoc ep => Natural -- | Name of the respective entrypoints section. entrypointKindSectionName :: EntrypointKindHasDoc ep => Text -- | Description in the respective entrypoints section. entrypointKindSectionDescription :: EntrypointKindHasDoc ep => Maybe Markdown -- | Gathers information about single entrypoint. -- -- We assume that entry points might be of different kinds, which is -- designated by phantom type parameter. For instance, you may want to -- have several groups of entry points corresponding to various parts of -- a contract - specifying different kind type argument for each -- of those groups will allow you defining different DocItem -- instances with appropriate custom descriptions for them. data DEntrypoint (kind :: Type) DEntrypoint :: Text -> SubDoc -> DEntrypoint (kind :: Type) [depName] :: DEntrypoint (kind :: Type) -> Text [depSub] :: DEntrypoint (kind :: Type) -> SubDoc -- | Pattern that checks whether given SomeDocItem hides -- DEntrypoint inside (of any entrypoint kind). -- -- In case a specific kind is necessary, use plain (cast -> Just -- DEntrypoint{..}) construction instead. pattern DEntrypointDocItem :: DEntrypoint kind -> SomeDocItem -- | Default implementation of docItemToMarkdown for entrypoints. diEntrypointToMarkdown :: HeaderLevel -> DEntrypoint level -> Markdown -- | Mark code as part of entrypoint with given name. -- -- This is automatically called at most of the appropriate situations, -- like entryCase calls. entrypointSection :: EntrypointKindHasDoc kind => Text -> Proxy kind -> (i :-> o) -> i :-> o -- | Make a ParamBuildingStep that tells about wrapping an argument -- into a constructor with given name and uses given ParamBuilder -- as description of Michelson part. mkPbsWrapIn :: Text -> ParamBuilder -> ParamBuildingStep constructDEpArg :: forall arg. (TypeHasDoc arg, HasAnnotation arg, KnownValue arg) => DEntrypointArg emptyDEpArg :: DEntrypointArg mkDEpUType :: forall t. (KnownValue t, HasAnnotation t) => Type mkDEntrypointArgSimple :: forall t. (KnownValue t, HasAnnotation t, TypeHasDoc t) => DEntrypointArg -- | Go over contract code and update every occurrence of -- DEntrypointArg documentation item, adding the given step to its -- "how to build parameter" description. clarifyParamBuildingSteps :: ParamBuildingStep -> (inp :-> out) -> inp :-> out -- | Like case_, to be used for pattern-matching on a parameter or -- its part. -- -- Modifies documentation accordingly. Including description of -- entrypoints' arguments, thus for them you will need to supply -- TypeHasDoc instance. entryCase_ :: forall dt entrypointKind out inp. (InstrCaseC dt, RMap (CaseClauses dt), DocumentEntrypoints entrypointKind dt) => Proxy entrypointKind -> Rec (CaseClauseL inp out) (CaseClauses dt) -> (dt : inp) :-> out -- | Version of entryCase_ for tuples. entryCase :: forall dt entrypointKind out inp clauses. (CaseTC dt out inp clauses, DocumentEntrypoints entrypointKind dt) => Proxy entrypointKind -> IsoRecTuple clauses -> (dt : inp) :-> out -- | Wrapper for documenting single entrypoint which parameter isn't going -- to be unwrapped from some datatype. -- -- entryCase unwraps a datatype, however, sometimes we want to -- have entrypoint parameter to be not wrapped into some datatype. documentEntrypoint :: forall kind epName param s out. (KnownSymbol epName, DocItem (DEntrypoint kind), TypeHasDoc param, HasAnnotation param, KnownValue param) => ((param : s) :-> out) -> (param : s) :-> out -- | Modify param building steps with respect to entrypoints that given -- parameter declares. -- -- Each contract with entrypoints should eventually call this function, -- otherwise, in case if contract uses built-in entrypoints feature, the -- resulting parameter building steps in the generated documentation will -- not consider entrypoints and thus may be incorrect. -- -- Calling this twice over the same code is also prohibited. -- -- This method is for internal use, if you want to apply it to a contract -- manually, use finalizeParamCallingDoc. finalizeParamCallingDoc' :: forall cp inp out. (NiceParameterFull cp, HasCallStack) => Proxy cp -> (inp :-> out) -> inp :-> out -- | Version of 'finalizeParamCallingDoc'' more convenient for manual call -- in a contract. finalizeParamCallingDoc :: forall cp inp out. (NiceParameterFull cp, RequireSumType cp, HasCallStack) => ((cp : inp) :-> out) -> (cp : inp) :-> out -- | Whether finalizeParamCallingDoc has already been applied to -- these steps. areFinalizedParamBuildingSteps :: [ParamBuildingStep] -> Bool entryCaseSimple_ :: forall cp out inp. (InstrCaseC cp, RMap (CaseClauses cp), DocumentEntrypoints PlainEntrypointsKind cp, RequireFlatParamEps cp) => Rec (CaseClauseL inp out) (CaseClauses cp) -> (cp : inp) :-> out -- | Version of entryCase for contracts with flat parameter, use it -- when you need only one entryCase all over the contract -- implementation. entryCaseSimple :: forall cp out inp clauses. (CaseTC cp out inp clauses, DocumentEntrypoints PlainEntrypointsKind cp, RequireFlatParamEps cp) => IsoRecTuple clauses -> (cp : inp) :-> out -- | Code for a contract along with compilation options for the Lorentz -- compiler. -- -- It is expected that a Contract is one packaged entity, wholly -- controlled by its author. Therefore the author should be able to set -- all options that control contract's behavior. -- -- This helps ensure that a given contract will be interpreted in the -- same way in all environments, like production and testing. -- -- Raw ContractCode should not be used for distribution of -- contracts. data Contract cp st Contract :: ContractCode cp st -> Bool -> CompilationOptions -> Contract cp st -- | The contract itself. [cCode] :: Contract cp st -> ContractCode cp st -- | Flag which defines whether compiled Michelson contract will have -- CAST (which drops parameter annotations) as a first -- instruction. Note that when flag is false, there still may be no -- CAST (in case when parameter type has no annotations). [cDisableInitialCast] :: Contract cp st -> Bool -- | General compilation options for the Lorentz compiler. [cCompilationOptions] :: Contract cp st -> CompilationOptions -- | Options to control Lorentz to Michelson compilation. data CompilationOptions CompilationOptions :: Maybe OptimizerConf -> (Bool, MText -> MText) -> (Bool, ByteString -> ByteString) -> CompilationOptions -- | Config for Michelson optimizer. [coOptimizerConf] :: CompilationOptions -> Maybe OptimizerConf -- | Function to transform strings with. See -- transformStringsLorentz. [coStringTransformer] :: CompilationOptions -> (Bool, MText -> MText) -- | Function to transform byte strings with. See -- transformBytesLorentz. [coBytesTransformer] :: CompilationOptions -> (Bool, ByteString -> ByteString) -- | Runs Michelson optimizer with default config and does not touch -- strings and bytes. defaultCompilationOptions :: CompilationOptions -- | Leave contract without any modifications. For testing purposes. intactCompilationOptions :: CompilationOptions -- | For use outside of Lorentz. Will use defaultCompilationOptions. compileLorentz :: (inp :-> out) -> Instr (ToTs inp) (ToTs out) -- | Compile Lorentz code, optionally running the optimizer, string and -- byte transformers. compileLorentzWithOptions :: CompilationOptions -> (inp :-> out) -> Instr (ToTs inp) (ToTs out) -- | Compile contract with defaultCompilationOptions and -- cDisableInitialCast set to False. defaultContract :: forall cp st. (NiceParameterFull cp, HasCallStack) => ContractCode cp st -> Contract cp st -- | Compile a whole contract to Michelson. -- -- Note that compiled contract can be ill-typed in terms of Michelson -- code when some of the compilation options are used (e.g. when -- ccoDisableInitialCast is True, resulted contract can -- be ill-typed). However, compilation with -- defaultContractCompilationOptions should be valid. compileLorentzContract :: forall cp st. (NiceParameterFull cp, NiceStorage st) => Contract cp st -> Contract (ToT cp) (ToT st) -- | Interpret a Lorentz instruction, for test purposes. Note that this -- does not run the optimizer. interpretLorentzInstr :: (IsoValuesStack inp, IsoValuesStack out) => ContractEnv -> (inp :-> out) -> Rec Identity inp -> Either MichelsonFailed (Rec Identity out) -- | Like interpretLorentzInstr, but works on lambda rather than -- arbitrary instruction. interpretLorentzLambda :: (IsoValue inp, IsoValue out) => ContractEnv -> Lambda inp out -> inp -> Either MichelsonFailed out -- | Lorentz version of analyzer. analyzeLorentz :: (inp :-> out) -> AnalyzerRes coBytesTransformerL :: Lens' CompilationOptions (Bool, ByteString -> ByteString) coOptimizerConfL :: Lens' CompilationOptions (Maybe OptimizerConf) coStringTransformerL :: Lens' CompilationOptions (Bool, MText -> MText) cCodeL :: forall cp_a1Id8 st_a1Id9 cp_a1IxT st_a1IxU. Lens (Contract cp_a1Id8 st_a1Id9) (Contract cp_a1IxT st_a1IxU) (ContractCode cp_a1Id8 st_a1Id9) (ContractCode cp_a1IxT st_a1IxU) cCompilationOptionsL :: forall cp_a1Id8 st_a1Id9. Lens' (Contract cp_a1Id8 st_a1Id9) CompilationOptions cDisableInitialCastL :: forall cp_a1Id8 st_a1Id9. Lens' (Contract cp_a1Id8 st_a1Id9) Bool -- | Run a lambda with given input. -- -- Note that this always returns one value, but can accept multiple input -- values (in such case they are grouped into nested pairs). -- -- For testing and demonstration purposes. (-$?) :: (ZipInstr inps, IsoValue (ZippedStack inps), IsoValue out) => (inps :-> '[out]) -> ZippedStack inps -> Either MichelsonFailed out infixr 2 -$? -- | Like -$?, assumes that no failure is possible. -- -- For testing and demonstration purposes. -- --
-- >>> import Lorentz.Instr ---- --
-- >>> nop -$ 5 -- 5 -- -- >>> sub -$ (3, 2) -- 1 -- -- >>> push 9 -$ () -- 9 -- -- >>> add # add -$ ((1, 2), 3) -- 6 --(-$) :: (ZipInstr inps, IsoValue (ZippedStack inps), IsoValue out, HasCallStack) => (inps :-> '[out]) -> ZippedStack inps -> out infixr 2 -$ -- | Version of (-$?) with arguments flipped. (&?-) :: (ZipInstr inps, IsoValue (ZippedStack inps), IsoValue out) => ZippedStack inps -> (inps :-> '[out]) -> Either MichelsonFailed out infixl 2 &?- -- | Version of (-$) with arguments flipped. (&-) :: (ZipInstr inps, IsoValue (ZippedStack inps), IsoValue out, HasCallStack) => ZippedStack inps -> (inps :-> '[out]) -> out infixl 2 &- -- | Version of (-$) applicable to a series of values. (<-$>) :: (ZipInstr inps, IsoValue (ZippedStack inps), IsoValue out, HasCallStack) => (inps :-> '[out]) -> [ZippedStack inps] -> [out] infixl 2 <-$> -- | Pretty-print a Haskell value as Michelson one. printLorentzValue :: forall v. NicePrintedValue v => Bool -> v -> LText -- | Pretty-print a Lorentz contract into Michelson code. printLorentzContract :: forall cp st. (NiceParameterFull cp, NiceStorage st) => Bool -> Contract cp st -> LText -- | Estimate code operation size. contractOpSize :: (NiceParameterFull cp, NiceStorage st) => Contract cp st -> OpSize -- | Estimate value operation size. valueOpSize :: forall a. NicePrintedValue a => a -> OpSize class NonZero t -- | Retain the value only if it is not zero. nonZero :: NonZero t => (t : s) :-> (Maybe t : s) class LorentzFunctor (c :: Type -> Type) lmap :: (LorentzFunctor c, KnownValue b) => ((a : s) :-> (b : s)) -> (c a : s) :-> (c b : s) type ConstraintDIPNLorentz (n :: Peano) (inp :: [Type]) (out :: [Type]) (s :: [Type]) (s' :: [Type]) = (ConstraintDIPN n (ToTs inp) (ToTs out) (ToTs s) (ToTs s'), ConstraintDIPN' Type n inp out s s') type ConstraintDUGLorentz (n :: Peano) (inp :: [Type]) (out :: [Type]) (a :: Type) = (ConstraintDUG n (ToTs inp) (ToTs out) (ToT a), ConstraintDUG' Type n inp out a) type ConstraintDIGLorentz (n :: Peano) (inp :: [Type]) (out :: [Type]) (a :: Type) = (ConstraintDIG n (ToTs inp) (ToTs out) (ToT a), ConstraintDIG' Type n inp out a) nop :: s :-> s justComment :: Text -> s :-> s comment :: CommentType -> s :-> s commentAroundFun :: Text -> (i :-> o) -> i :-> o commentAroundStmt :: Text -> (i :-> o) -> i :-> o drop :: (a : s) :-> s -- | Drop top n elements from the stack. dropN :: forall (n :: Nat) (s :: [Type]). (SingI (ToPeano n), KnownPeano (ToPeano n), RequireLongerOrSameLength (ToTs s) (ToPeano n), Drop (ToPeano n) (ToTs s) ~ ToTs (Drop (ToPeano n) s)) => s :-> Drop (ToPeano n) s dup :: (a : s) :-> (a : (a : s)) swap :: (a : (b : s)) :-> (b : (a : s)) -- | Version of dig which uses Peano number. It is inteded for -- internal usage in Lorentz. digPeano :: forall (n :: Peano) inp out a. ConstraintDIGLorentz n inp out a => inp :-> out dig :: forall (n :: Nat) inp out a. ConstraintDIGLorentz (ToPeano n) inp out a => inp :-> out -- | Version of dug which uses Peano number. It is inteded for -- internal usage in Lorentz. dugPeano :: forall (n :: Peano) inp out a. ConstraintDUGLorentz n inp out a => inp :-> out dug :: forall (n :: Nat) inp out a. ConstraintDUGLorentz (ToPeano n) inp out a => inp :-> out push :: forall t s. NiceConstant t => t -> s :-> (t : s) some :: (a : s) :-> (Maybe a : s) none :: forall a s. KnownValue a => s :-> (Maybe a : s) unit :: s :-> (() : s) ifNone :: (s :-> s') -> ((a : s) :-> s') -> (Maybe a : s) :-> s' pair :: (a : (b : s)) :-> ((a, b) : s) car :: ((a, b) : s) :-> (a : s) cdr :: ((a, b) : s) :-> (b : s) left :: forall a b s. KnownValue b => (a : s) :-> (Either a b : s) right :: forall a b s. KnownValue a => (b : s) :-> (Either a b : s) ifLeft :: ((a : s) :-> s') -> ((b : s) :-> s') -> (Either a b : s) :-> s' nil :: KnownValue p => s :-> (List p : s) cons :: (a : (List a : s)) :-> (List a : s) ifCons :: ((a : (List a : s)) :-> s') -> (s :-> s') -> (List a : s) :-> s' size :: SizeOpHs c => (c : s) :-> (Natural : s) emptySet :: NiceComparable e => s :-> (Set e : s) emptyMap :: (NiceComparable k, KnownValue v) => s :-> (Map k v : s) emptyBigMap :: (NiceComparable k, KnownValue v) => s :-> (BigMap k v : s) map :: (MapOpHs c, IsoMapOpRes c b, KnownValue b, HasCallStack) => ((MapOpInpHs c : s) :-> (b : s)) -> (c : s) :-> (MapOpResHs c b : s) iter :: (IterOpHs c, HasCallStack) => ((IterOpElHs c : s) :-> s) -> (c : s) :-> s mem :: MemOpHs c => (MemOpKeyHs c : (c : s)) :-> (Bool : s) get :: (GetOpHs c, KnownValue (GetOpValHs c)) => (GetOpKeyHs c : (c : s)) :-> (Maybe (GetOpValHs c) : s) update :: UpdOpHs c => (UpdOpKeyHs c : (UpdOpParamsHs c : (c : s))) :-> (c : s) if_ :: (s :-> s') -> (s :-> s') -> (Bool : s) :-> s' loop :: (s :-> (Bool : s)) -> (Bool : s) :-> s loopLeft :: ((a : s) :-> (Either a b : s)) -> (Either a b : s) :-> (b : s) lambda :: ZipInstrs [i, o] => (i :-> o) -> s :-> ((i :-> o) : s) exec :: (a : (Lambda a b : s)) :-> (b : s) -- | Similar to exec but works for lambdas with arbitrary size of -- input and output. -- -- Note that this instruction has its arguments flipped, lambda goes -- first. This seems to be the only reasonable way to achieve good -- inference. execute :: forall i o s. Each [KnownList, ZipInstr] [i, o] => ((i :-> o) : (i ++ s)) :-> (o ++ s) apply :: forall a b c s. (NiceConstant a, KnownValue b) => (a : (Lambda (a, b) c : s)) :-> (Lambda b c : s) -- | Version of apply that works for lambdas with arbitrary length -- input and output. applicate :: forall a b c inp2nd inpTail s. (NiceConstant a, ZipInstr b, b ~ (inp2nd : inpTail)) => (a : (((a : b) :-> c) : s)) :-> ((b :-> c) : s) dip :: forall a s s'. HasCallStack => (s :-> s') -> (a : s) :-> (a : s') -- | Version of dipN which uses Peano number. It is inteded for -- internal usage in Lorentz. dipNPeano :: forall (n :: Peano) (inp :: [Type]) (out :: [Type]) (s :: [Type]) (s' :: [Type]). ConstraintDIPNLorentz n inp out s s' => (s :-> s') -> inp :-> out dipN :: forall (n :: Nat) (inp :: [Type]) (out :: [Type]) (s :: [Type]) (s' :: [Type]). ConstraintDIPNLorentz (ToPeano n) inp out s s' => (s :-> s') -> inp :-> out failWith :: KnownValue a => (a : s) :-> t cast :: KnownValue a => (a : s) :-> (a : s) pack :: forall a s. NicePackedValue a => (a : s) :-> (Packed a : s) unpack :: forall a s. NiceUnpackedValue a => (Packed a : s) :-> (Maybe a : s) packRaw :: forall a s. NicePackedValue a => (a : s) :-> (ByteString : s) unpackRaw :: forall a s. NiceUnpackedValue a => (ByteString : s) :-> (Maybe a : s) concat :: ConcatOpHs c => (c : (c : s)) :-> (c : s) concat' :: ConcatOpHs c => (List c : s) :-> (c : s) slice :: (SliceOpHs c, KnownValue c) => (Natural : (Natural : (c : s))) :-> (Maybe c : s) isNat :: (Integer : s) :-> (Maybe Natural : s) add :: ArithOpHs Add n m => (n : (m : s)) :-> (ArithResHs Add n m : s) sub :: ArithOpHs Sub n m => (n : (m : s)) :-> (ArithResHs Sub n m : s) rsub :: ArithOpHs Sub n m => (m : (n : s)) :-> (ArithResHs Sub n m : s) mul :: ArithOpHs Mul n m => (n : (m : s)) :-> (ArithResHs Mul n m : s) ediv :: EDivOpHs n m => (n : (m : s)) :-> (Maybe (EDivOpResHs n m, EModOpResHs n m) : s) abs :: UnaryArithOpHs Abs n => (n : s) :-> (UnaryArithResHs Abs n : s) neg :: UnaryArithOpHs Neg n => (n : s) :-> (UnaryArithResHs Neg n : s) lsl :: ArithOpHs Lsl n m => (n : (m : s)) :-> (ArithResHs Lsl n m : s) lsr :: ArithOpHs Lsr n m => (n : (m : s)) :-> (ArithResHs Lsr n m : s) or :: ArithOpHs Or n m => (n : (m : s)) :-> (ArithResHs Or n m : s) and :: ArithOpHs And n m => (n : (m : s)) :-> (ArithResHs And n m : s) xor :: ArithOpHs Xor n m => (n : (m : s)) :-> (ArithResHs Xor n m : s) not :: UnaryArithOpHs Not n => (n : s) :-> (UnaryArithResHs Not n : s) compare :: NiceComparable n => (n : (n : s)) :-> (Integer : s) eq0 :: UnaryArithOpHs Eq' n => (n : s) :-> (UnaryArithResHs Eq' n : s) neq0 :: UnaryArithOpHs Neq n => (n : s) :-> (UnaryArithResHs Neq n : s) lt0 :: UnaryArithOpHs Lt n => (n : s) :-> (UnaryArithResHs Lt n : s) gt0 :: UnaryArithOpHs Gt n => (n : s) :-> (UnaryArithResHs Gt n : s) le0 :: UnaryArithOpHs Le n => (n : s) :-> (UnaryArithResHs Le n : s) ge0 :: UnaryArithOpHs Ge n => (n : s) :-> (UnaryArithResHs Ge n : s) int :: (Natural : s) :-> (Integer : s) -- | Get a reference to the current contract. -- -- Note that, similar to CONTRACT instruction, in Michelson -- SELF instruction can accept an entrypoint as field annotation, -- and without annotation specified it creates a contract value -- which calls the default entrypoint. -- -- This particular function carries the behaviour of SELF before -- introduction of lightweight entrypoints feature. Thus the contract -- must not have explicit "default" entrypoint for this to work. -- -- If you are going to call a specific entrypoint of the contract, see -- selfCalling. self :: forall p s. (NiceParameterFull p, ForbidExplicitDefaultEntrypoint p) => s :-> (ContractRef p : s) -- | Make a reference to the current contract, maybe a specific entrypoint. -- -- Note that, since information about parameter of the current contract -- is not carried around, in this function you need to specify parameter -- type p explicitly. selfCalling :: forall p mname s. NiceParameterFull p => EntrypointRef mname -> s :-> (ContractRef (GetEntrypointArgCustom p mname) : s) -- | Get a reference to a contract by its address. -- -- This instruction carries the behaviour of CONTRACT before -- introduction of lightweight entrypoints feature. The contract must -- not have explicit "default" entrypoint for this to work. -- -- If you are going to call a specific entrypoint of the contract, see -- contractCalling. contract :: forall p addr s. (NiceParameterFull p, ForbidExplicitDefaultEntrypoint p, ToTAddress_ p addr) => (addr : s) :-> (Maybe (ContractRef p) : s) -- | Make a reference to a contract, maybe a specific entrypoint. -- -- When calling this function, make sure that parameter type is known. -- It's recommended that you supply TAddress with a concrete -- parameter as the stack argument. contractCalling :: forall cp epRef epArg addr s. (HasEntrypointArg cp epRef epArg, ToTAddress_ cp addr) => epRef -> (addr : s) :-> (Maybe (ContractRef epArg) : s) -- | Specialized version of contractCalling for the case when you do -- not have compile-time evidence of appropriate HasEntrypointArg. -- For instance, if you have untyped EpName you can not have this -- evidence (the value is only available in runtime). If you have typed -- EntrypointRef, use eprName to construct EpName. contractCallingUnsafe :: forall arg s. NiceParameter arg => EpName -> (Address : s) :-> (Maybe (ContractRef arg) : s) -- | Version of contract instruction which may accept address with -- already specified entrypoint name. -- -- Also you cannot specify entrypoint name here because this could result -- in conflict. runFutureContract :: forall p s. NiceParameter p => (FutureContract p : s) :-> (Maybe (ContractRef p) : s) -- | Similar to runFutureContract, works with EpAddress. -- -- Validity of such operation cannot be ensured at compile time. epAddressToContract :: forall p s. NiceParameter p => (EpAddress : s) :-> (Maybe (ContractRef p) : s) transferTokens :: forall p s. NiceParameter p => (p : (Mutez : (ContractRef p : s))) :-> (Operation : s) setDelegate :: (Maybe KeyHash : s) :-> (Operation : s) createContract :: forall p g s. (NiceStorage g, NiceParameterFull p) => Contract p g -> (Maybe KeyHash : (Mutez : (g : s))) :-> (Operation : (Address : s)) implicitAccount :: (KeyHash : s) :-> (ContractRef () : s) now :: s :-> (Timestamp : s) amount :: s :-> (Mutez : s) balance :: s :-> (Mutez : s) checkSignature :: BytesLike bs => (PublicKey : (TSignature bs : (bs : s))) :-> (Bool : s) sha256 :: BytesLike bs => (bs : s) :-> (Hash Sha256 bs : s) sha512 :: BytesLike bs => (bs : s) :-> (Hash Sha512 bs : s) blake2B :: BytesLike bs => (bs : s) :-> (Hash Blake2b bs : s) hashKey :: (PublicKey : s) :-> (KeyHash : s) -- | Warning: Using source is considered a bad practice. Consider -- using sender instead until further investigation source :: s :-> (Address : s) sender :: s :-> (Address : s) address :: (ContractRef a : s) :-> (Address : s) chainId :: s :-> (ChainId : s) -- | Execute given instruction on truncated stack. -- -- This instruction requires you to specify the piece of stack to -- truncate as type argument. framed :: forall s i o. (KnownList i, KnownList o) => (i :-> o) -> (i ++ s) :-> (o ++ s) -- | Helper instruction. -- -- Checks whether given key present in the storage and fails if it is. -- This instruction leaves stack intact. failingWhenPresent :: forall c k s v st e. (MemOpHs c, k ~ MemOpKeyHs c, KnownValue e, st ~ (k : (v : (c : s)))) => (forall s0. (k : s0) :-> (e : s0)) -> st :-> st -- | Like update, but throw an error on attempt to overwrite -- existing entry. updateNew :: forall c k s e. (UpdOpHs c, MemOpHs c, k ~ UpdOpKeyHs c, k ~ MemOpKeyHs c, KnownValue e) => (forall s0. (k : s0) :-> (e : s0)) -> (k : (UpdOpParamsHs c : (c : s))) :-> (c : s) -- | Version of HasNamedVar for multiple variables. -- --
-- >>> type HasContext = HasNamedVars s ["x" := Integer, "f" := Lambda MText MText] --type family HasNamedVars (s :: [Type]) (vs :: [NamedField]) :: Constraint -- | Indicates that stack s contains a name :! var or -- name :? var value. class HasNamedVar (s :: [Type]) (name :: Symbol) (var :: Type) | s name -> var -- | Requires type x to be an unnamed variable. -- -- When e.g. dupL sees a polymorphic variable, it can't judge -- whether is it a variable we are seeking for or not; -- VarIsUnnamed helps to assure the type system that given -- variable won't be named. type VarIsUnnamed x = VarName x ~ 'VarUnnamed -- | Version of dupL that leaves a named variable on stack. dupLNamed :: forall var name s. HasNamedVar s name var => Label name -> s :-> ((name :! var) : s) -- | Take the element with given label on stack and copy it on top. -- -- If there are multiple variables with given label, the one closest to -- the top of the stack is picked. dupL :: forall var name s. HasNamedVar s name var => Label name -> s :-> (var : s) -- | Duplicate an element of stack referring it by type. -- -- If stack contains multiple entries of this type, compile error is -- raised. dupT :: forall a st. DupT st a st => st :-> (a : st) -- | Dip repeatedly until element of the given type is on top of the stack. -- -- If stack contains multiple entries of this type, compile error is -- raised. dipT :: forall a inp dinp dout out. DipT inp a inp dinp dout out => (dinp :-> dout) -> inp :-> out -- | Remove element with the given type from the stack. dropT :: forall a inp dinp dout out. (DipT inp a inp dinp dout out, dinp ~ (a : dout)) => inp :-> out -- | Documentation for custom errors. -- -- Mentions that entrypoint throws given error. data DThrows [DThrows] :: ErrorHasDoc e => Proxy e -> DThrows -- | Mentions that contract uses given error. data DError [DError] :: ErrorHasDoc e => Proxy e -> DError class (KnownSymbol tag, TypeHasDoc (ErrorArg tag), IsError (CustomError tag)) => CustomErrorHasDoc tag -- | What should happen for this error to be raised. customErrDocMdCause :: CustomErrorHasDoc tag => Markdown -- | Brief version of customErrDocMdCause. This will appear along -- with the error when mentioned in entrypoint description. -- -- By default, the first sentence of the full description is used. customErrDocMdCauseInEntrypoint :: CustomErrorHasDoc tag => Markdown -- | Error class. -- -- By default this returns "unknown error" class; though you should -- provide explicit implementation in order to avoid a warning. customErrClass :: CustomErrorHasDoc tag => ErrorClass -- | Clarification of error argument meaning. -- -- Provide when it's not obvious, e.g. argument is not named with -- :!. -- -- NOTE: This should not be an entire sentence, rather just the -- semantic backbone. -- -- Bad: * Error argument stands for the previous value of -- approval. -- -- Good: * the previous value of approval * pair, first -- argument of which is one thing, and the second is another customErrArgumentSemantics :: CustomErrorHasDoc tag => Maybe Markdown -- | Error class on how the error should be handled by the client. data ErrorClass -- | Normal expected error. Examples: "insufficient balance", "wallet does -- not exist". ErrClassActionException :: ErrorClass -- | Invalid argument passed to entrypoint. Examples: your entrypoint -- accepts an enum represented as nat, and unknown value is -- provided. This includes more complex cases which involve multiple -- entrypoints. E.g. API provides iterator interface, middleware should -- care about using it hiding complex details and exposing a simpler API -- to user; then an attempt to request non-existing element would also -- correspond to an error from this class. ErrClassBadArgument :: ErrorClass -- | Unexpected error. Most likely it means that there is a bug in the -- contract or the contract has been deployed incorrectly. ErrClassContractInternal :: ErrorClass -- | It's possible to leave error class unspecified. ErrClassUnknown :: ErrorClass type RequireNoArgError tag msg = (TypeErrorUnless (ErrorArg tag == ()) msg, msg ~ ('Text "Expected no-arg error, but given error requires argument of type " :<>: 'ShowType (ErrorArg tag))) -- | Material custom error. -- -- Use this in pattern matches against error (e.g. in tests). data CustomError (tag :: Symbol) CustomError :: Label tag -> ErrorArg tag -> CustomError (tag :: Symbol) [ceTag] :: CustomError (tag :: Symbol) -> Label tag [ceArg] :: CustomError (tag :: Symbol) -> ErrorArg tag -- | Declares a custom error, defining error name - error argument -- relation. -- -- If your error is supposed to carry no argument, then provide -- (). -- -- Note that this relation is defined globally rather than on -- per-contract basis, so define errors accordingly. If your error has -- argument specific to your contract, call it such that error name -- reflects its belonging to this contract. -- -- This is the basic [error format]. type family ErrorArg (tag :: Symbol) :: Type -- | Type wrapper for an IsError. data SomeError SomeError :: e -> SomeError -- | Use this type as replacement for () when you really -- want to leave error cause unspecified. data UnspecifiedError UnspecifiedError :: UnspecifiedError class Typeable e => ErrorHasDoc (e :: Type) where { -- | Constraints which we require in a particular instance. You are not -- oblidged to often instantiate this correctly, it is only useful for -- some utilities. type family ErrorRequirements e :: Constraint; type ErrorRequirements e = (); } -- | Name of error as it appears in the corresponding section title. errorDocName :: ErrorHasDoc e => Text -- | What should happen for this error to be raised. errorDocMdCause :: ErrorHasDoc e => Markdown -- | Brief version of errorDocMdCause. -- -- This will appear along with the error when mentioned in entrypoint -- description. By default, the first sentence of the full description is -- used. errorDocMdCauseInEntrypoint :: ErrorHasDoc e => Markdown -- | How this error is represented in Haskell. errorDocHaskellRep :: ErrorHasDoc e => Markdown -- | Error class. errorDocClass :: ErrorHasDoc e => ErrorClass -- | Which definitions documentation for this error mentions. errorDocDependencies :: ErrorHasDoc e => [SomeDocDefinitionItem] -- | Captured constraints which we require in a particular instance. This -- is a way to encode a bidirectional instance in the nowaday Haskell, -- for class MyConstraint => ErrorHasDoc MyType instance it -- lets deducing MyConstraint by ErrorHasDoc MyType. -- -- You are not oblidged to always instantiate, it is only useful for some -- utilities which otherwise would not compile. errorDocRequirements :: ErrorHasDoc e => Dict (ErrorRequirements e) -- | Captured constraints which we require in a particular instance. This -- is a way to encode a bidirectional instance in the nowaday Haskell, -- for class MyConstraint => ErrorHasDoc MyType instance it -- lets deducing MyConstraint by ErrorHasDoc MyType. -- -- You are not oblidged to always instantiate, it is only useful for some -- utilities which otherwise would not compile. errorDocRequirements :: (ErrorHasDoc e, ErrorRequirements e) => Dict (ErrorRequirements e) -- | Haskell type representing error. class (Typeable e, ErrorHasDoc e) => IsError e -- | Converts a Haskell error into Value representation. errorToVal :: IsError e => e -> (forall t. ErrorScope t => Value t -> r) -> r -- | Converts a Value into Haskell error. errorFromVal :: (IsError e, KnownT t) => Value t -> Either Text e type ErrorScope t = (Typeable t, ConstantScope t) -- | Implementation of errorToVal via IsoValue. isoErrorToVal :: (KnownError e, IsoValue e) => e -> (forall t. ErrorScope t => Value t -> r) -> r -- | Implementation of errorFromVal via IsoValue. isoErrorFromVal :: (Typeable t, Typeable (ToT e), IsoValue e) => Value t -> Either Text e -- | Fail with the given Haskell value. failUsing :: forall e s t. IsError e => e -> s :-> t -- | Fail, providing a reference to the place in the code where this -- function is called. -- -- Like error in Haskell code, this instruction is for internal -- errors only. failUnexpected :: MText -> s :-> t -- | Description of error representation in Haskell. customErrorDocHaskellRepGeneral :: (SingI (ToT (ErrorArg tag)), IsError (CustomError tag), TypeHasDoc (ErrorArg tag), CustomErrorHasDoc tag) => Text -> Proxy tag -> Markdown -- | Demote error tag to term level. errorTagToMText :: Label tag -> MText errorTagToText :: forall tag. KnownSymbol tag => Text -- | Fail with given custom error. failCustom :: forall tag err s any. (err ~ ErrorArg tag, CustomErrorHasDoc tag, KnownError err) => Label tag -> (err : s) :-> any -- | Specialization of failCustom for no-arg errors. failCustom_ :: forall tag s any notVoidErrorMsg. (RequireNoArgError tag notVoidErrorMsg, CustomErrorHasDoc tag) => Label tag -> s :-> any -- | Whether given error class is about internal errors. -- -- Internal errors are not enlisted on per-entrypoint basis, only once -- for the entire contract. isInternalErrorClass :: ErrorClass -> Bool -- | Implementation of typeDocMdDescription (of TypeHasDoc -- typeclass) for Haskell types which sole purpose is to be error. typeDocMdDescriptionReferToError :: forall e. IsError e => Markdown -- | QuasiQuote that helps generating ParameterHasEntrypoints -- instance. -- -- Usage: -- --
-- [entrypointDoc| Parameter <parameter-type> <optional-root-annotation> |] -- [entrypointDoc| Parameter plain |] -- [entrypointDoc| Parameter plain "root"|] ---- -- See this tutorial which includes this quasiquote. entrypointDoc :: QuasiQuoter -- | QuasiQuote that helps generating CustomErrorHasDoc instance. -- -- Usage: -- --
-- [errorDoc| <error-name> <error-type> <error-description> |] -- [errorDoc| "errorName" exception "Error description" |] ---- -- See this tutorial which includes this quasiquote. errorDoc :: QuasiQuoter -- | QuasiQuote that helps generating TypeHasDoc instance. -- -- Usage: -- --
-- [typeDoc| <type> <description> |] -- [typeDoc| Storage "This is storage description" |] ---- -- See this tutorial which includes this quasiquote. typeDoc :: QuasiQuoter -- | Newtype over void result type used in tests to distinguish successful -- void result from other errors. -- -- Usage example: lExpectFailWith (== VoidResult roleMaster)` -- -- This error is special - it can contain arguments of different types -- depending on entrypoint which raises it. newtype VoidResult r VoidResult :: r -> VoidResult r [unVoidResult] :: VoidResult r -> r -- | void type synonym as described in A1. data Void_ (a :: Type) (b :: Type) Void_ :: a -> Lambda b b -> Void_ (a :: Type) (b :: Type) -- | Entry point argument. [voidParam] :: Void_ (a :: Type) (b :: Type) -> a -- | Type of result reported via failWith. [voidResProxy] :: Void_ (a :: Type) (b :: Type) -> Lambda b b -- | view type synonym as described in A1. data View (a :: Type) (r :: Type) View :: a -> ContractRef r -> View (a :: Type) (r :: Type) [viewParam] :: View (a :: Type) (r :: Type) -> a [viewCallbackTo] :: View (a :: Type) (r :: Type) -> ContractRef r class UpdateN (n :: Peano) (s :: [Type]) (a :: Type) (b :: Type) mid tail updateNImpl :: UpdateN n s a b mid tail => ('[a, b] :-> '[b]) -> (a : s) :-> s -- | Constraint for updateN that combines kind-agnostic constraint for -- Lorentz (Haskell) types and for our typed Michelson. type ConstraintUpdateNLorentz (n :: Peano) (s :: [Type]) (a :: Type) (b :: Type) (mid :: [Type]) (tail :: [Type]) = (UpdateNConstraint' T n (ToTs s) (ToT a) (ToT b) (ToTs mid) (ToTs tail), UpdateNConstraint' Type n s a b mid tail) class ReplaceN (n :: Peano) (s :: [Type]) (a :: Type) mid tail replaceNImpl :: ReplaceN n s a mid tail => (a : s) :-> s -- | Constraint for replaceN that combines kind-agnostic constraint for -- Lorentz (Haskell) types and for our typed Michelson. type ConstraintReplaceNLorentz (n :: Peano) (s :: [Type]) (a :: Type) (mid :: [Type]) (tail :: [Type]) = (ReplaceNConstraint' T n (ToTs s) (ToT a) (ToTs mid) (ToTs tail), ReplaceNConstraint' Type n s a mid tail) -- | Insert given element into map. mapInsert :: (MapInstrs map, NiceComparable k) => (k : (v : (map k v : s))) :-> (map k v : s) -- | Insert given element into map, ensuring that it does not overwrite any -- existing entry. -- -- As first argument accepts container name (for error message). mapInsertNew :: (MapInstrs map, NiceComparable k, KnownValue e) => (forall s0. (k : s0) :-> (e : s0)) -> (k : (v : (map k v : s))) :-> (map k v : s) -- | Delete element from the map. deleteMap :: forall k v s. (MapInstrs map, NiceComparable k, KnownValue v) => (k : (map k v : s)) :-> (map k v : s) class DuupX (n :: Peano) (s :: [Type]) (a :: Type) s1 tail duupXImpl :: DuupX n s a s1 tail => s :-> (a : s) -- | Constraint for duupX that combines kind-agnostic constraint for -- Lorentz (Haskell) types and for our typed Michelson. type ConstraintDuupXLorentz (n :: Peano) (s :: [Type]) (a :: Type) (s1 :: [Type]) (tail :: [Type]) = (DuupXConstraint' T n (ToTs s) (ToT a) (ToTs s1) (ToTs tail), DuupXConstraint' Type n s a s1 tail) eq :: NiceComparable n => (n : (n : s)) :-> (Bool : s) neq :: NiceComparable n => (n : (n : s)) :-> (Bool : s) gt :: NiceComparable n => (n : (n : s)) :-> (Bool : s) le :: NiceComparable n => (n : (n : s)) :-> (Bool : s) ge :: NiceComparable n => (n : (n : s)) :-> (Bool : s) lt :: NiceComparable n => (n : (n : s)) :-> (Bool : s) ifEq0 :: IfCmp0Constraints a Eq' => (s :-> s') -> (s :-> s') -> (a : s) :-> s' ifNeq0 :: IfCmp0Constraints a Neq => (s :-> s') -> (s :-> s') -> (a : s) :-> s' ifLt0 :: IfCmp0Constraints a Lt => (s :-> s') -> (s :-> s') -> (a : s) :-> s' ifGt0 :: IfCmp0Constraints a Gt => (s :-> s') -> (s :-> s') -> (a : s) :-> s' ifLe0 :: IfCmp0Constraints a Le => (s :-> s') -> (s :-> s') -> (a : s) :-> s' ifGe0 :: IfCmp0Constraints a Ge => (s :-> s') -> (s :-> s') -> (a : s) :-> s' ifEq :: NiceComparable a => (s :-> s') -> (s :-> s') -> (a : (a : s)) :-> s' ifNeq :: NiceComparable a => (s :-> s') -> (s :-> s') -> (a : (a : s)) :-> s' ifLt :: NiceComparable a => (s :-> s') -> (s :-> s') -> (a : (a : s)) :-> s' ifGt :: NiceComparable a => (s :-> s') -> (s :-> s') -> (a : (a : s)) :-> s' ifLe :: NiceComparable a => (s :-> s') -> (s :-> s') -> (a : (a : s)) :-> s' ifGe :: NiceComparable a => (s :-> s') -> (s :-> s') -> (a : (a : s)) :-> s' -- | Analog of the FAIL macro in Michelson. Its usage is discouraged -- because it doesn't carry any information about failure. -- | Warning: fail_ remains in code fail_ :: a :-> c assert :: IsError err => err -> (Bool : s) :-> s assertEq0 :: (IfCmp0Constraints a Eq', IsError err) => err -> (a : s) :-> s assertNeq0 :: (IfCmp0Constraints a Neq, IsError err) => err -> (a : s) :-> s assertLt0 :: (IfCmp0Constraints a Lt, IsError err) => err -> (a : s) :-> s assertGt0 :: (IfCmp0Constraints a Gt, IsError err) => err -> (a : s) :-> s assertLe0 :: (IfCmp0Constraints a Le, IsError err) => err -> (a : s) :-> s assertGe0 :: (IfCmp0Constraints a Ge, IsError err) => err -> (a : s) :-> s assertEq :: (NiceComparable a, IsError err) => err -> (a : (a : s)) :-> s assertNeq :: (NiceComparable a, IsError err) => err -> (a : (a : s)) :-> s assertLt :: (NiceComparable a, IsError err) => err -> (a : (a : s)) :-> s assertGt :: (NiceComparable a, IsError err) => err -> (a : (a : s)) :-> s assertLe :: (NiceComparable a, IsError err) => err -> (a : (a : s)) :-> s assertGe :: (NiceComparable a, IsError err) => err -> (a : (a : s)) :-> s assertNone :: IsError err => err -> (Maybe a : s) :-> s assertSome :: IsError err => err -> (Maybe a : s) :-> (a : s) assertLeft :: IsError err => err -> (Either a b : s) :-> (a : s) assertRight :: IsError err => err -> (Either a b : s) :-> (b : s) assertUsing :: IsError a => a -> (Bool : s) :-> s -- | Custom Lorentz macro that drops element with given index (starting -- from 0) from the stack. dropX :: forall (n :: Nat) a inp out s s'. (ConstraintDIPNLorentz (ToPeano n) inp out s s', s ~ (a : s')) => inp :-> out -- | Duplicate the top of the stack n times. -- -- For example, `cloneX @3` has type `a : s :-> a : a : a : a : s`. cloneX :: forall (n :: Nat) a s. CloneX (ToPeano n) a s => (a : s) :-> CloneXT (ToPeano n) a s -- | DUU+P macro. For example, `duupX @3` is DUUUP, it -- puts the 3-rd (starting from 1) element to the top of the stack. Note -- that it is implemented differently for `n ≤ 2` and for `n > 2`. In -- the latter case it is implemented using dipN, dig and -- dup. In the former case it uses specialized versions. There is -- also a minor difference with the implementation of `DUU*P` in -- Michelson. They implement DUUUUP as `DIP 3 { DUP }; DIG 4`. -- We implement it as `DIP 3 { DUP }; DIG 3`. These are equivalent. Our -- version is supposedly cheaper, at least it should be packed more -- efficiently due to the way numbers are packed. duupX :: forall (n :: Nat) a (s :: [Type]) (s1 :: [Type]) (tail :: [Type]). (ConstraintDuupXLorentz (ToPeano (n - 1)) s a s1 tail, DuupX (ToPeano n) s a s1 tail) => s :-> (a : s) -- | Version of framed which accepts number of elements on input -- stack which should be preserved. -- -- You can treat this macro as calling a Michelson function with given -- number of arguments. framedN :: forall n nNat s i i' o o'. (nNat ~ ToPeano n, i' ~ Take nNat i, s ~ Drop nNat i, i ~ (i' ++ s), o ~ (o' ++ s), KnownList i', KnownList o') => (i' :-> o') -> i :-> o papair :: (a : (b : (c : s))) :-> (((a, b), c) : s) ppaiir :: (a : (b : (c : s))) :-> ((a, (b, c)) : s) unpair :: ((a, b) : s) :-> (a : (b : s)) cdar :: ((a1, (a2, b)) : s) :-> (a2 : s) cddr :: ((a1, (a2, b)) : s) :-> (b : s) caar :: (((a, b1), b2) : s) :-> (a : s) cadr :: (((a, b1), b2) : s) :-> (b1 : s) setCar :: ((a, b1) : (b2 : s)) :-> ((b2, b1) : s) setCdr :: ((a, b1) : (b2 : s)) :-> ((a, b2) : s) mapCar :: ((a : s) :-> (a1 : s)) -> ((a, b) : s) :-> ((a1, b) : s) mapCdr :: ((b : ((a, b) : s)) :-> (b1 : ((a, b) : s))) -> ((a, b) : s) :-> ((a, b1) : s) ifRight :: ((b : s) :-> s') -> ((a : s) :-> s') -> (Either a b : s) :-> s' ifSome :: ((a : s) :-> s') -> (s :-> s') -> (Maybe a : s) :-> s' when_ :: (s :-> s) -> (Bool : s) :-> s unless_ :: (s :-> s) -> (Bool : s) :-> s whenSome :: ((a : s) :-> s) -> (Maybe a : s) :-> s whenNone :: (s :-> (a : s)) -> (Maybe a : s) :-> (a : s) -- | Insert given element into set. -- -- This is a separate function from updateMap because stacks -- they operate with differ in length. setInsert :: NiceComparable e => (e : (Set e : s)) :-> (Set e : s) -- | Insert given element into set, ensuring that it does not overwrite any -- existing entry. -- -- As first argument accepts container name. setInsertNew :: (NiceComparable e, KnownValue err) => (forall s0. (e : s0) :-> (err : s0)) -> (e : (Set e : s)) :-> (Set e : s) -- | Delete given element from the set. setDelete :: NiceComparable e => (e : (Set e : s)) :-> (Set e : s) -- | Replace nth element (0-indexed) with the one on the top of the stack. -- For example, `replaceN 3` replaces the 3rd element with the 0th -- one. `replaceN 0` is not a valid operation (and it is not -- implemented). `replaceN 1` is equivalent to `swap # drop` (and is -- the only one implemented like this). In all other cases `replaceN -- n` will drop the nth element (`dipN n drop`) and then put the -- 0th one in its place (`dug (n-1)`). replaceN :: forall (n :: Nat) a (s :: [Type]) (s1 :: [Type]) (tail :: [Type]). (ConstraintReplaceNLorentz (ToPeano (n - 1)) s a s1 tail, ReplaceN (ToPeano n) s a s1 tail) => (a : s) :-> s -- | Replaces the nth element (0-indexed) with the result of the given -- "updating" instruction (binary with the return type equal to the -- second argument) applied to the 0th element and the nth element -- itself. For example, `updateN 3 cons` replaces the 3rd element -- with the result of cons applied to the topmost element and the -- 3rd one. `updateN 0 instr` is not a valid operation (and it is -- not implemented). `updateN 1 instr` is equivalent to -- instr (and so is implemented). `updateN 2 instr` is -- equivalent to `swap # dip instr` (and so is implemented). In all other -- cases `updateN n instr` will put the topmost element right above -- the nth one (`dug (n-1)`) and then apply the function to them in -- place (`dipN @(n-1) instr`). updateN :: forall (n :: Nat) a b (s :: [Type]) (mid :: [Type]) (tail :: [Type]). (ConstraintUpdateNLorentz (ToPeano (n - 1)) s a b mid tail, UpdateN (ToPeano n) s a b mid tail) => ('[a, b] :-> '[b]) -> (a : s) :-> s buildViewTuple :: (WellTypedIsoValue r, TupleF a) => View a r -> Builder buildView :: WellTypedIsoValue r => (a -> Builder) -> View a r -> Builder -- | Polymorphic version of View constructor. mkView :: ToContractRef r contract => a -> contract -> View a r -- | Wrap internal representation of view into View itself. -- -- View is part of public standard and should not change often. wrapView :: ((a, ContractRef r) : s) :-> (View a r : s) -- | Unwrap View into its internal representation. -- -- View is part of public standard and should not change often. unwrapView :: (View a r : s) :-> ((a, ContractRef r) : s) view_ :: NiceParameter r => (forall s0. (a : (storage : s0)) :-> (r : s0)) -> (View a r : (storage : s)) :-> ((List Operation, storage) : s) voidResultTag :: MText mkVoid :: forall b a. a -> Void_ a b void_ :: forall a b s s' anything. (IsError (VoidResult b), KnownValue b) => ((a : s) :-> (b : s')) -> (Void_ a b : s) :-> anything -- | Wrap internal representation of void into Void_ itself. -- -- Void_ is part of public standard and should not change often. wrapVoid :: ((a, Lambda b b) : s) :-> (Void_ a b : s) -- | Unwrap Void_ into its internal representation. -- -- Void_ is part of public standard and should not change often. unwrapVoid :: (Void_ a b : s) :-> ((a, Lambda b b) : s) addressToEpAddress :: (Address : s) :-> (EpAddress : s) -- | Push a value of contract type. -- -- Doing this via push instruction is not possible, so we need to -- perform extra actions here. -- -- Aside from contract value itself you will need to specify -- which error to throw in case this value is not valid. pushContractRef :: NiceParameter arg => (forall s0. (FutureContract arg : s) :-> s0) -> ContractRef arg -> s :-> (ContractRef arg : s) -- | Get address of the current contract. -- -- TODO [#373]: reimplement this using SELF_ADDRESS selfAddress :: s :-> (Address : s) -- | Duplicate two topmost items on top of the stack. dupTop2 :: forall (a :: Type) (b :: Type) (s :: [Type]). (a : (b : s)) :-> (a : (b : (a : (b : s)))) fromOption :: NiceConstant a => a -> (Maybe a : s) :-> (a : s) isSome :: (Maybe a : s) :-> (Bool : s) -- | Retain the value if it is not equal to the given one. -- --
-- >>> non 0 -$ 5 -- Just 5 -- -- >>> non 0 -$ 0 -- Nothing --non :: (NiceConstant a, NiceComparable a) => a -> (a : s) :-> (Maybe a : s) -- | Version of non with a custom predicate. -- --
-- >>> non' eq0 -$ 5 -- Just 5 -- -- >>> non' eq0 -$ 0 -- Nothing --non' :: NiceConstant a => Lambda a Bool -> (a : s) :-> (Maybe a : s) -- | Check whether container is empty. isEmpty :: SizeOpHs c => (c : s) :-> (Bool : s) -- | Entry points template derived from given ADT sum. type UParamLinearized p = GUParamLinearized (Rep p) -- | Constraint required by uparamFromAdt. type UParamLinearize p = (Generic p, GUParamLinearize (Rep p)) -- | Make up a "case" over entry points. class CaseUParam (entries :: [EntrypointKind]) -- | An action invoked when user-provided entrypoint is not found. type UParamFallback inp out = ((MText, ByteString) : inp) :-> out -- | Implementations of some entry points. -- -- Note that this thing inherits properties of Rec, e.g. you can -- Data.Vinyl.Core.rappend implementations for two entrypoint -- sets when assembling scattered parts of a contract. type EntrypointsImpl inp out entries = Rec (CaseClauseU inp out) entries data EntrypointLookupError NoSuchEntrypoint :: MText -> EntrypointLookupError ArgumentUnpackFailed :: EntrypointLookupError -- | This class is needed to implement unpackUParam. class UnpackUParam (c :: Type -> Constraint) entries -- | Turn UParam into a Haskell value. Since we don't know its type -- in compile time, we have to erase it using ConstrainedSome. The -- user of this function can require arbitrary constraint to hold -- (depending on how they want to use the result). unpackUParam :: UnpackUParam c entries => UParam entries -> Either EntrypointLookupError (MText, ConstrainedSome c) -- | This type can store any value that satisfies a certain constraint. data ConstrainedSome (c :: Type -> Constraint) [ConstrainedSome] :: c a => a -> ConstrainedSome c -- | Ensure that given entry points do no contain duplicated names. type family RequireUniqueEntrypoints (entries :: [EntrypointKind]) :: Constraint -- | Get type of entrypoint argument by its name. type family LookupEntrypoint (name :: Symbol) (entries :: [EntrypointKind]) :: Type -- | Homomorphic version of UParam, forgets the exact interface. type UParam_ = UParam SomeInterface -- | Pseudo value for UParam type variable. type SomeInterface = '[ '("SomeEntrypoints", Void)] -- | Encapsulates parameter for one of entry points. It keeps entrypoint -- name and corresponding argument serialized. -- -- In Haskell world, we keep an invariant of that contained value relates -- to one of entry points from entries list. newtype UParam (entries :: [EntrypointKind]) UParamUnsafe :: (MText, ByteString) -> UParam (entries :: [EntrypointKind]) -- | A convenient alias for type-level name-something pair. type (n :: Symbol) ?: (a :: k) = '(n, a) -- | An entrypoint is described by two types: its name and type of -- argument. type EntrypointKind = (Symbol, Type) -- | Construct a UParam safely. mkUParam :: (NicePackedValue a, LookupEntrypoint name entries ~ a, RequireUniqueEntrypoints entries) => Label name -> a -> UParam entries -- | Helper instruction which extracts content of UParam. unwrapUParam :: (UParam entries : s) :-> ((MText, ByteString) : s) -- | Default implementation for UParamFallback, simply reports an -- error. uparamFallbackFail :: UParamFallback inp out -- | Pattern-match on given UParam entries. -- -- You have to provide all case branches and a fallback action on case -- when entrypoint is not found. caseUParam :: (CaseUParam entries, RequireUniqueEntrypoints entries) => Rec (CaseClauseU inp out) entries -> UParamFallback inp out -> (UParam entries : inp) :-> out -- | Like caseUParam, but accepts a tuple of clauses, not a -- Rec. caseUParamT :: forall entries inp out clauses. (clauses ~ Rec (CaseClauseU inp out) entries, RecFromTuple clauses, CaseUParam entries) => IsoRecTuple clauses -> UParamFallback inp out -> (UParam entries : inp) :-> out -- | Make up UParam from ADT sum. -- -- Entry points template will consist of (constructorName, -- constructorFieldType) pairs. Each constructor is expected to have -- exactly one field. uparamFromAdt :: UParamLinearize up => up -> UParam (UParamLinearized up) -- | Note that calling given entrypoints involves constructing -- UParam. pbsUParam :: forall ctorName. KnownSymbol ctorName => ParamBuildingStep -- | Predicate for if ... then .. else ... construction, defines a -- kind of operation applied to the top elements of the current stack. -- -- Type arguments mean: 1. Input of if 2. Left branch input 3. -- Right branch input 4. Output of branches 5. Output of if data Condition arg argl argr outb out [Holds] :: Condition (Bool : s) s s o o [IsSome] :: Condition (Maybe a : s) (a : s) s o o [IsNone] :: Condition (Maybe a : s) s (a : s) o o [IsLeft] :: Condition (Either l r : s) (l : s) (r : s) o o [IsRight] :: Condition (Either l r : s) (r : s) (l : s) o o [IsCons] :: Condition ([a] : s) (a : ([a] : s)) s o o [IsNil] :: Condition ([a] : s) s (a : ([a] : s)) o o [IsZero] :: (UnaryArithOpHs Eq' a, UnaryArithResHs Eq' a ~ Bool) => Condition (a : s) s s o o [IsNotZero] :: (UnaryArithOpHs Eq' a, UnaryArithResHs Eq' a ~ Bool) => Condition (a : s) s s o o [IsEq] :: NiceComparable a => Condition (a : (a : s)) s s o o [IsNeq] :: NiceComparable a => Condition (a : (a : s)) s s o o [IsLt] :: NiceComparable a => Condition (a : (a : s)) s s o o [IsGt] :: NiceComparable a => Condition (a : (a : s)) s s o o [IsLe] :: NiceComparable a => Condition (a : (a : s)) s s o o [IsGe] :: NiceComparable a => Condition (a : (a : s)) s s o o -- | Explicitly named binary condition, to ensure proper order of stack -- arguments. [NamedBinCondition] :: Condition (a : (a : s)) s s o o -> Label n1 -> Label n2 -> Condition ((n1 :! a) : ((n2 :! a) : s)) s s o o -- | Provide the compared arguments to if branches. [PreserveArgsBinCondition] :: (forall st o. Condition (a : (b : st)) st st o o) -> Condition (a : (b : s)) (a : (b : s)) (a : (b : s)) (a : (b : s)) s -- | Aliases for (#) used by do-blocks. (>>) :: (a :-> b) -> (b :-> c) -> a :-> c -- | Defines semantics of if ... then ... else ... construction. ifThenElse :: Condition arg argl argr outb out -> (argl :-> outb) -> (argr :-> outb) -> arg :-> out -- | Named version of IsLt. -- -- In this and similar operators you provide names of accepted stack -- operands as a safety measure of that they go in the expected order. (<.) :: NiceComparable a => Label n1 -> Label n2 -> Condition ((n1 :! a) : ((n2 :! a) : s)) s s o o infix 4 <. -- | Named version of IsGt. (>.) :: NiceComparable a => Label n1 -> Label n2 -> Condition ((n1 :! a) : ((n2 :! a) : s)) s s o o infix 4 >. -- | Named version of IsLe. (<=.) :: NiceComparable a => Label n1 -> Label n2 -> Condition ((n1 :! a) : ((n2 :! a) : s)) s s o o infix 4 <=. -- | Named version of IsGe. (>=.) :: NiceComparable a => Label n1 -> Label n2 -> Condition ((n1 :! a) : ((n2 :! a) : s)) s s o o infix 4 >=. -- | Named version of IsEq. (==.) :: NiceComparable a => Label n1 -> Label n2 -> Condition ((n1 :! a) : ((n2 :! a) : s)) s s o o infix 4 ==. -- | Named version of IsNeq. (/=.) :: NiceComparable a => Label n1 -> Label n2 -> Condition ((n1 :! a) : ((n2 :! a) : s)) s s o o infix 4 /=. -- | Condition modifier, makes stack operands of binary comparison to be -- available within if branches. keepIfArgs :: (forall st o. Condition (a : (b : st)) st st o o) -> Condition (a : (b : s)) (a : (b : s)) (a : (b : s)) (a : (b : s)) s -- | Tags excluded from map. type ErrorTagExclusions = HashSet MText -- | This is a bidirectional map with correspondence between numeric and -- textual error tags. type ErrorTagMap = Bimap Natural MText -- | Find all textual error tags that are used in typical FAILWITH -- patterns within given instruction. Map them to natural numbers. gatherErrorTags :: (inp :-> out) -> HashSet MText -- | Add more error tags to an existing ErrorTagMap. It is useful -- when your contract consists of multiple parts (e. g. in case of -- contract upgrade), you have existing map for some part and want to add -- tags from another part to it. You can pass empty map as existing one -- if you just want to build ErrorTagMap from a set of textual -- tags. See buildErrorTagMap. addNewErrorTags :: ErrorTagMap -> HashSet MText -> ErrorTagMap -- | Build ErrorTagMap from a set of textual tags. buildErrorTagMap :: HashSet MText -> ErrorTagMap -- | Remove some error tags from map. This way you say to remain these -- string tags intact, while others will be converted to numbers when -- this map is applied. -- -- Note that later you have to apply this map using -- applyErrorTagMapWithExclusions, otherwise an error would be -- raised. excludeErrorTags :: HasCallStack => ErrorTagExclusions -> ErrorTagMap -> ErrorTagMap -- | For each typical FAILWITH that uses a string to represent error -- tag this function changes error tag to be a number using the supplied -- conversion map. It assumes that supplied map contains all such strings -- (and will error out if it does not). It will always be the case if you -- gather all error tags using gatherErrorTags and build -- ErrorTagMap from them using addNewErrorTags. applyErrorTagMap :: HasCallStack => ErrorTagMap -> (inp :-> out) -> inp :-> out -- | Similar to applyErrorTagMap, but for case when you have -- excluded some tags from map via excludeErrorTags. Needed, -- because both excludeErrorTags and this function do not tolerate -- unknown errors in contract code (for your safety). applyErrorTagMapWithExclusions :: HasCallStack => ErrorTagMap -> ErrorTagExclusions -> (inp :-> out) -> inp :-> out -- | This function implements the simplest scenario of using this module's -- functionality: 1. Gather all error tags from a single instruction. 2. -- Turn them into error conversion map. 3. Apply this conversion. useNumericErrors :: HasCallStack => (inp :-> out) -> (inp :-> out, ErrorTagMap) -- | If you apply numeric error representation in your contract, -- errorFromVal will stop working because it doesn't know about -- this transformation. This function takes this transformation into -- account. If a number is used as a tag, but it is not found in the -- passed map, we conservatively preserve that number (because this whole -- approach is rather a heuristic). errorFromValNumeric :: (KnownT t, IsError e) => ErrorTagMap -> Value t -> Either Text e -- | If you apply numeric error representation in your contract, -- errorToVal will stop working because it doesn't know about this -- transformation. This function takes this transformation into account. -- If a string is used as a tag, but it is not found in the passed map, -- we conservatively preserve that string (because this whole approach is -- rather a heuristic). errorToValNumeric :: IsError e => ErrorTagMap -> e -> (forall t. ErrorScope t => Value t -> r) -> r -- | Some error with a numeric tag attached. data NumericErrorWrapper (numTag :: Nat) (err :: Type) -- | Handler which changes documentation for one particular error type. data NumericErrorDocHandler -- | Errors for NumericErrorDocHandler data NumericErrorDocHandlerError -- | Adds a section which explains error tag mapping. data DDescribeErrorTagMap DDescribeErrorTagMap :: Text -> DDescribeErrorTagMap -- | Describes where the error tag map is defined in Haskell code. [detmSrcLoc] :: DDescribeErrorTagMap -> Text -- | Modify documentation generated for given code so that all -- CustomError mention not their textual error tag rather -- respective numeric one from the given map. -- -- If some documented error is not present in the map, it remains -- unmodified. This function may fail with error if contract uses -- some uncommon errors, see applyErrorTagToErrorsDocWith for -- details. applyErrorTagToErrorsDoc :: HasCallStack => ErrorTagMap -> (inp :-> out) -> inp :-> out -- | Extended version of applyErrorTagToErrorsDoc which accepts -- error handlers. -- -- In most cases that function should be enough for your purposes, but it -- uses a fixed set of base handlers which may be not enough in case when -- you define your own errors. In this case define and pass all the -- necessary handlers to this function. -- -- It fails with error if some of the errors used in the contract -- cannot be handled with given handlers. applyErrorTagToErrorsDocWith :: HasCallStack => [NumericErrorDocHandler] -> ErrorTagMap -> (inp :-> out) -> inp :-> out -- | Handler for all CustomErrors. customErrorDocHandler :: NumericErrorDocHandler -- | Handler for VoidResult. voidResultDocHandler :: NumericErrorDocHandler -- | Handlers for most common errors defined in Lorentz. baseErrorDocHandlers :: [NumericErrorDocHandler] -- | Replacement for uninhabited type. data Empty -- | Witness of that this code is unreachable. absurd_ :: (Empty : s) :-> s' -- | Lorentz version of Iso. data LIso a b LIso :: (forall s. (a : s) :-> (b : s)) -> (forall s. (b : s) :-> (a : s)) -> LIso a b [liTo] :: LIso a b -> forall s. (a : s) :-> (b : s) [liFrom] :: LIso a b -> forall s. (b : s) :-> (a : s) -- | Invert an isomorphism. invertIso :: LIso a b -> LIso b a -- | Given a function that is its own inverse, make an LIso using it -- in both directions. involutedIso :: Lambda a a -> LIso a a -- | The isomorphism between two values with identical representation and -- semantics. checkedCoerceIso :: Coercible_ a b => LIso a b -- | The isomorphism between two values with identical representation. -- -- The same precautions as for forcedCoerce apply here. forcedCoerceIso :: MichelsonCoercible a b => LIso a b -- | The isomorphism between raw and named value. namedIso :: Label n -> LIso a (n :! a) -- | Absence of value on the left hand side is associated with the given -- value on the right hand side. nonIso :: (NiceConstant a, NiceComparable a) => a -> LIso (Maybe a) a -- | Absence of value on the left hand side is associated with the default -- value on the right hand side. -- -- This is more general version of nonIso ldef since it can work -- with e.g. containers. nonDefIso :: (LDefault a, NiceConstant a) => LIso (Maybe a) a -- | Concise way to write down constraints with expected content of a -- storage. -- -- Use it like follows: -- --
-- type StorageConstraint store = StorageContains store -- [ "fieldInt" := Int -- , "fieldNat" := Nat -- , "epsToNat" := Int ::-> Nat -- , "balances" := Address ~> Int -- ] --type family StorageContains store (content :: [NamedField]) :: Constraint -- | Indicates a stored entrypoint with the given param and -- store types. data param ::-> store infix 9 ::-> -- | Indicates a submap with given key and value types. data k ~> v infix 9 ~> -- | Provides operations on stored entrypoints. -- -- store is the storage containing both the entrypoint -- epName (note: it has to be in a BigMap to take -- advantage of lazy evaluation) and the epStore field this -- operates on. class StoreHasEntrypoint store epName epParam epStore | store epName -> epParam epStore storeEpOps :: StoreHasEntrypoint store epName epParam epStore => StoreEntrypointOps store epName epParam epStore -- | Datatype containing the full implementation of -- StoreHasEntrypoint typeclass. -- -- We use this grouping because in most cases the implementation will be -- chosen among the default ones, and initializing all methods at once is -- simpler and more consistent. (One can say that we are trying to -- emulate the DerivingVia extension.) data StoreEntrypointOps store epName epParam epStore StoreEntrypointOps :: (forall s. Label epName -> (store : s) :-> (EntrypointLambda epParam epStore : s)) -> (forall s. Label epName -> (EntrypointLambda epParam epStore : (store : s)) :-> (store : s)) -> (forall s. Label epName -> (store : s) :-> (epStore : s)) -> (forall s. Label epName -> (epStore : (store : s)) :-> (store : s)) -> StoreEntrypointOps store epName epParam epStore [sopToEpLambda] :: StoreEntrypointOps store epName epParam epStore -> forall s. Label epName -> (store : s) :-> (EntrypointLambda epParam epStore : s) [sopSetEpLambda] :: StoreEntrypointOps store epName epParam epStore -> forall s. Label epName -> (EntrypointLambda epParam epStore : (store : s)) :-> (store : s) [sopToEpStore] :: StoreEntrypointOps store epName epParam epStore -> forall s. Label epName -> (store : s) :-> (epStore : s) [sopSetEpStore] :: StoreEntrypointOps store epName epParam epStore -> forall s. Label epName -> (epStore : (store : s)) :-> (store : s) -- | Type synonym of a BigMap mapping MText (entrypoint -- names) to EntrypointLambda. -- -- This is useful when defining instances of StoreHasEntrypoint as -- a storage field containing one or more entrypoints (lambdas) of the -- same type. type EntrypointsField param store = BigMap MText (EntrypointLambda param store) -- | Type synonym for a Lambda that can be used as an entrypoint type EntrypointLambda param store = Lambda (param, store) ([Operation], store) -- | Provides operations on submaps of storage. class StoreHasSubmap store mname key value | store mname -> key value storeSubmapOps :: StoreHasSubmap store mname key value => StoreSubmapOps store mname key value -- | Datatype containing the full implementation of StoreHasSubmap -- typeclass. -- -- We use this grouping because in most cases the implementation will be -- chosen among the default ones, and initializing all methods at once is -- simpler and more consistent. (One can say that we are trying to -- emulate the DerivingVia extension.) data StoreSubmapOps store mname key value StoreSubmapOps :: (forall s. Label mname -> (key : (store : s)) :-> (Bool : s)) -> (forall s. KnownValue value => Label mname -> (key : (store : s)) :-> (Maybe value : s)) -> (forall s. Label mname -> (key : (Maybe value : (store : s))) :-> (store : s)) -> (forall s. Label mname -> (key : (store : s)) :-> (store : s)) -> (forall s. Label mname -> (key : (value : (store : s))) :-> (store : s)) -> StoreSubmapOps store mname key value [sopMem] :: StoreSubmapOps store mname key value -> forall s. Label mname -> (key : (store : s)) :-> (Bool : s) [sopGet] :: StoreSubmapOps store mname key value -> forall s. KnownValue value => Label mname -> (key : (store : s)) :-> (Maybe value : s) [sopUpdate] :: StoreSubmapOps store mname key value -> forall s. Label mname -> (key : (Maybe value : (store : s))) :-> (store : s) [sopDelete] :: StoreSubmapOps store mname key value -> forall s. Label mname -> (key : (store : s)) :-> (store : s) [sopInsert] :: StoreSubmapOps store mname key value -> forall s. Label mname -> (key : (value : (store : s))) :-> (store : s) -- | Provides operations on fields for storage. class StoreHasField store fname ftype | store fname -> ftype storeFieldOps :: StoreHasField store fname ftype => StoreFieldOps store fname ftype -- | Datatype containing the full implementation of StoreHasField -- typeclass. -- -- We use this grouping because in most cases the implementation will be -- chosen among the default ones, and initializing all methods at once is -- simpler and more consistent. (One can say that we are trying to -- emulate the DerivingVia extension.) data StoreFieldOps store fname ftype StoreFieldOps :: (forall s. Label fname -> (store : s) :-> (ftype : s)) -> (forall s. Label fname -> (ftype : (store : s)) :-> (store : s)) -> StoreFieldOps store fname ftype [sopToField] :: StoreFieldOps store fname ftype -> forall s. Label fname -> (store : s) :-> (ftype : s) [sopSetField] :: StoreFieldOps store fname ftype -> forall s. Label fname -> (ftype : (store : s)) :-> (store : s) -- | Pick storage field. stToField :: StoreHasField store fname ftype => Label fname -> (store : s) :-> (ftype : s) -- | Get storage field, preserving the storage itself on stack. stGetField :: StoreHasField store fname ftype => Label fname -> (store : s) :-> (ftype : (store : s)) -- | Update storage field. stSetField :: StoreHasField store fname ftype => Label fname -> (ftype : (store : s)) :-> (store : s) -- | Check value presence in storage. stMem :: StoreHasSubmap store mname key value => Label mname -> (key : (store : s)) :-> (Bool : s) -- | Get value in storage. stGet :: (StoreHasSubmap store mname key value, KnownValue value) => Label mname -> (key : (store : s)) :-> (Maybe value : s) -- | Update a value in storage. stUpdate :: StoreHasSubmap store mname key value => Label mname -> (key : (Maybe value : (store : s))) :-> (store : s) -- | Delete a value in storage. stDelete :: forall store mname key value s. StoreHasSubmap store mname key value => Label mname -> (key : (store : s)) :-> (store : s) -- | Add a value in storage. stInsert :: StoreHasSubmap store mname key value => Label mname -> (key : (value : (store : s))) :-> (store : s) -- | Add a value in storage, but fail if it will overwrite some existing -- entry. stInsertNew :: StoreHasSubmap store mname key value => Label mname -> (forall s0 any. (key : s0) :-> any) -> (key : (value : (store : s))) :-> (store : s) -- | Extracts and executes the epName entrypoint lambda from -- storage, returing the updated full storage (store) and the -- produced Operations. stEntrypoint :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (epParam : (store : s)) :-> (([Operation], store) : s) -- | Pick stored entrypoint lambda. stToEpLambda :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (store : s) :-> (EntrypointLambda epParam epStore : s) -- | Get stored entrypoint lambda, preserving the storage itself on the -- stack. stGetEpLambda :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (store : s) :-> (EntrypointLambda epParam epStore : (store : s)) -- | Stores the entrypoint lambda in the storage. Fails if already set. stSetEpLambda :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (EntrypointLambda epParam epStore : (store : s)) :-> (store : s) -- | Pick the sub-storage that the entrypoint operates on. stToEpStore :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (store : s) :-> (epStore : s) -- | Get the sub-storage that the entrypoint operates on, preserving the -- storage itself on the stack. stGetEpStore :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (store : s) :-> (epStore : (store : s)) -- | Update the sub-storage that the entrypoint operates on. stSetEpStore :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (epStore : (store : s)) :-> (store : s) -- | Implementation of StoreHasField for case of datatype keeping a -- pack of fields. storeFieldOpsADT :: HasFieldOfType dt fname ftype => StoreFieldOps dt fname ftype -- | Implementation of StoreHasEntrypoint for a datatype keeping a -- pack of fields, among which one has contains the entrypoint and -- another is what such entrypoint operates on. storeEntrypointOpsADT :: (HasFieldOfType store epmName (EntrypointsField epParam epStore), HasFieldOfType store epsName epStore, KnownValue epParam, KnownValue epStore) => Label epmName -> Label epsName -> StoreEntrypointOps store epName epParam epStore -- | Implementation of StoreHasEntrypoint for a datatype that has a -- StoreHasField for an EntrypointsField that contains the -- entrypoint and a StoreHasField for the field such entrypoint -- operates on. storeEntrypointOpsFields :: (StoreHasField store epmName (EntrypointsField epParam epStore), StoreHasField store epsName epStore, KnownValue epParam, KnownValue epStore) => Label epmName -> Label epsName -> StoreEntrypointOps store epName epParam epStore -- | Implementation of StoreHasEntrypoint for a datatype that has a -- StoreHasSubmap that contains the entrypoint and a -- StoreHasField for the field such entrypoint operates on. storeEntrypointOpsSubmapField :: (StoreHasSubmap store epmName MText (EntrypointLambda epParam epStore), StoreHasField store epsName epStore, KnownValue epParam, KnownValue epStore) => Label epmName -> Label epsName -> StoreEntrypointOps store epName epParam epStore -- | Implementation of StoreHasField for a data type which has an -- instance of StoreHasField inside. For instance, it can be used -- for top-level storage. storeFieldOpsDeeper :: (HasFieldOfType storage fieldsPartName fields, StoreHasField fields fname ftype) => Label fieldsPartName -> StoreFieldOps storage fname ftype -- | Implementation of StoreHasSubmap for a data type which has an -- instance of StoreHasSubmap inside. For instance, it can be used -- for top-level storage. storeSubmapOpsDeeper :: (HasFieldOfType storage bigMapPartName fields, StoreHasSubmap fields mname key value) => Label bigMapPartName -> StoreSubmapOps storage mname key value -- | Implementation of StoreHasEntrypoint for a data type which has -- an instance of StoreHasEntrypoint inside. For instance, it can -- be used for top-level storage. storeEntrypointOpsDeeper :: (HasFieldOfType store nameInStore substore, StoreHasEntrypoint substore epName epParam epStore) => Label nameInStore -> StoreEntrypointOps store epName epParam epStore -- | Pretend that given StoreSubmapOps implementation is made up for -- submap with name desiredName, not its actual name. Logic of -- the implementation remains the same. -- -- Use case: imagine that your code requires access to submap named -- X, but in your storage that submap is called Y. Then -- you implement the instance which makes X refer to Y: -- --
-- instance StoreHasSubmap Store X Key Value where -- storeSubmapOps = storeSubmapOpsReferTo #Y storeSubmapOpsForY --storeSubmapOpsReferTo :: Label name -> StoreSubmapOps storage name key value -> StoreSubmapOps storage desiredName key value -- | Pretend that given StoreFieldOps implementation is made up for -- field with name desiredName, not its actual name. Logic of -- the implementation remains the same. -- -- See also storeSubmapOpsReferTo. storeFieldOpsReferTo :: Label name -> StoreFieldOps storage name field -> StoreFieldOps storage desiredName field -- | Pretend that given StoreEntrypointOps implementation is made up -- for entrypoint with name desiredName, not its actual name. -- Logic of the implementation remains the same. -- -- See also storeSubmapOpsReferTo. storeEntrypointOpsReferTo :: Label epName -> StoreEntrypointOps store epName epParam epStore -> StoreEntrypointOps store desiredName epParam epStore -- | Change field operations so that they work on a modified field. -- -- For instance, to go from StoreFieldOps Storage "name" Integer -- to StoreFieldOps Storage "name" (value :! Integer) you can -- use mapStoreFieldOps (namedIso #value) mapStoreFieldOps :: LIso field1 field2 -> StoreFieldOps store name field1 -> StoreFieldOps store name field2 -- | Change submap operations so that they work on a modified key. mapStoreSubmapOpsKey :: Lambda key2 key1 -> StoreSubmapOps store name key1 value -> StoreSubmapOps store name key2 value -- | Change submap operations so that they work on a modified value. mapStoreSubmapOpsValue :: KnownValue value1 => LIso value1 value2 -> StoreSubmapOps store name key value1 -> StoreSubmapOps store name key value2 -- | Chain two implementations of field operations. -- -- Suits for a case when your store does not contain its fields directly -- rather has a nested structure. composeStoreFieldOps :: Label nameInStore -> StoreFieldOps store nameInStore substore -> StoreFieldOps substore nameInSubstore field -> StoreFieldOps store nameInSubstore field -- | Chain implementations of field and submap operations. composeStoreSubmapOps :: Label nameInStore -> StoreFieldOps store nameInStore substore -> StoreSubmapOps substore mname key value -> StoreSubmapOps store mname key value -- | Chain implementations of two submap operations sets. Used to provide -- shortcut access to a nested submap. -- -- This is very inefficient since on each access to substore it has to be -- serialized/deserialized. Use this implementation only if due to -- historical reasons migrating storage is difficult. -- -- LIso (Maybe substore) substore argument describes how to get -- substore value if it was absent in map and how to detect when -- it can be safely removed. -- -- Example of use: sequenceStoreSubmapOps #mySubmap nonDefIso -- storeSubmapOps storeSubmapOps sequenceStoreSubmapOps :: forall store substore value name subName key1 key2. (NiceConstant substore, KnownValue value) => Label name -> LIso (Maybe substore) substore -> StoreSubmapOps store name key1 substore -> StoreSubmapOps substore subName key2 value -> StoreSubmapOps store subName (key1, key2) value composeStoreEntrypointOps :: Label nameInStore -> StoreFieldOps store nameInStore substore -> StoreEntrypointOps substore epName epParam epStore -> StoreEntrypointOps store epName epParam epStore -- | Turn submap operations into operations on a part of the submap value. -- -- Normally, if you need this set of operations, it would be better to -- split your submap into several separate submaps, each operating with -- its own part of the value. This set of operations is pretty -- inefficient and exists only as a temporary measure, if due to -- historical reasons you have to leave storage format intact. -- -- This implementation puts no distinction between value == -- Nothing and value == Just defValue cases. Getters, when -- notice a value equal to the default value, report its absence. Setters -- tend to remove the value from submap when possible. -- -- LIso (Maybe value) value and LIso (Maybe subvalue) -- subvalue arguments describe how to get a value if it was absent -- in map and how to detect when it can be safely removed from map. -- -- Example of use: zoomStoreSubmapOps #mySubmap nonDefIso nonDefIso -- storeSubmapOps storeFieldOpsADT zoomStoreSubmapOps :: forall store submapName nameInSubmap key value subvalue. (NiceConstant value, NiceConstant subvalue) => Label submapName -> LIso (Maybe value) value -> LIso (Maybe subvalue) subvalue -> StoreSubmapOps store submapName key value -> StoreFieldOps value nameInSubmap subvalue -> StoreSubmapOps store nameInSubmap key subvalue -- | Utility to create EntrypointsFields from an entrypoint name -- (epName) and an EntrypointLambda implementation. Note -- that you need to merge multiple of these (with <>) if -- your field contains more than one entrypoint lambda. mkStoreEp :: Label epName -> EntrypointLambda epParam epStore -> EntrypointsField epParam epStore