Safe Haskell | None |
---|---|
Language | Haskell2010 |
Common implementations of entrypoints.
Synopsis
- data EpdPlain
- data EpdRecursive
- data EpdDelegate
- data EpdWithRoot (r :: Symbol) epd
- type PlainEntrypointsC mode cp = (GenericIsoValue cp, EntrypointsNotes mode (BuildEPTree mode cp) cp, RequireSumType cp)
- data EPTree
- type BuildEPTree mode a = GBuildEntrypointsTree mode (Rep a)
Ways to implement ParameterHasEntrypoints
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.
Instances
PlainEntrypointsC EpdPlain cp => EntrypointsDerivation EpdPlain cp Source # | |
Defined in Lorentz.Entrypoints.Impl | |
type EpdAllEntrypoints EpdPlain cp Source # | |
Defined in Lorentz.Entrypoints.Impl | |
type EpdLookupEntrypoint EpdPlain cp Source # | |
Defined in Lorentz.Entrypoints.Impl |
data EpdRecursive Source #
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. :!
).
Instances
PlainEntrypointsC EpdRecursive cp => EntrypointsDerivation EpdRecursive cp Source # | |
Defined in Lorentz.Entrypoints.Impl type EpdAllEntrypoints EpdRecursive cp :: [(Symbol, Type)] Source # type EpdLookupEntrypoint EpdRecursive cp :: Symbol -> Exp (Maybe Type) Source # epdNotes :: (Notes (ToT cp), RootAnn) Source # epdCall :: forall (name :: Symbol). ParameterScope (ToT cp) => Label name -> EpConstructionRes (ToT cp) (Eval (EpdLookupEntrypoint EpdRecursive cp name)) Source # epdDescs :: Rec EpCallingDesc (EpdAllEntrypoints EpdRecursive cp) Source # | |
type EpdAllEntrypoints EpdRecursive cp Source # | |
Defined in Lorentz.Entrypoints.Impl | |
type EpdLookupEntrypoint EpdRecursive cp Source # | |
Defined in Lorentz.Entrypoints.Impl |
data EpdDelegate Source #
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.
Instances
PlainEntrypointsC EpdDelegate cp => EntrypointsDerivation EpdDelegate cp Source # | |
Defined in Lorentz.Entrypoints.Impl type EpdAllEntrypoints EpdDelegate cp :: [(Symbol, Type)] Source # type EpdLookupEntrypoint EpdDelegate cp :: Symbol -> Exp (Maybe Type) Source # epdNotes :: (Notes (ToT cp), RootAnn) Source # epdCall :: forall (name :: Symbol). ParameterScope (ToT cp) => Label name -> EpConstructionRes (ToT cp) (Eval (EpdLookupEntrypoint EpdDelegate cp name)) Source # epdDescs :: Rec EpCallingDesc (EpdAllEntrypoints EpdDelegate cp) Source # | |
type EpdAllEntrypoints EpdDelegate cp Source # | |
Defined in Lorentz.Entrypoints.Impl | |
type EpdLookupEntrypoint EpdDelegate cp Source # | |
Defined in Lorentz.Entrypoints.Impl |
data EpdWithRoot (r :: Symbol) epd Source #
Extension of EpdPlain
, EpdRecursive
, and EpdDelegate
which allow specifying root annotation
for the parameters.
Instances
(KnownSymbol r, PlainEntrypointsC deriv cp) => EntrypointsDerivation (EpdWithRoot r deriv :: Type) cp Source # | |
Defined in Lorentz.Entrypoints.Impl type EpdAllEntrypoints (EpdWithRoot r deriv) cp :: [(Symbol, Type)] Source # type EpdLookupEntrypoint (EpdWithRoot r deriv) cp :: Symbol -> Exp (Maybe Type) Source # epdNotes :: (Notes (ToT cp), RootAnn) Source # epdCall :: forall (name :: Symbol). ParameterScope (ToT cp) => Label name -> EpConstructionRes (ToT cp) (Eval (EpdLookupEntrypoint (EpdWithRoot r deriv) cp name)) Source # epdDescs :: Rec EpCallingDesc (EpdAllEntrypoints (EpdWithRoot r deriv) cp) Source # | |
type EpdAllEntrypoints (EpdWithRoot r deriv :: Type) cp Source # | |
Defined in Lorentz.Entrypoints.Impl | |
type EpdLookupEntrypoint (EpdWithRoot r deriv :: Type) cp Source # | |
Defined in Lorentz.Entrypoints.Impl |
Implementation details
type PlainEntrypointsC mode cp = (GenericIsoValue cp, EntrypointsNotes mode (BuildEPTree mode cp) cp, RequireSumType cp) Source #
Entrypoints tree - skeleton on TOr
tree later used to distinguish
between constructors-entrypoints and constructors which consolidate
a whole pack of entrypoints.
EPNode EPTree EPTree | We are in the intermediate node and need to go deeper. |
EPLeaf | We reached entrypoint argument. |
EPDelegate | We reached complex parameter part and will need to ask how to process it. |
type BuildEPTree mode a = GBuildEntrypointsTree mode (Rep a) Source #
Build EPTree
by parameter type.