Safe Haskell | None |
---|---|
Language | Haskell2010 |
Entrypoints utilities for Lorentz
Synopsis
- class EntrypointsDerivation deriv cp where
- type EpdAllEntrypoints deriv cp :: [(Symbol, Type)]
- type EpdLookupEntrypoint deriv cp :: Symbol -> Exp (Maybe Type)
- epdNotes :: (Notes (ToT cp), RootAnn)
- epdCall :: ParameterScope (ToT cp) => Label name -> EpConstructionRes (ToT cp) (Eval (EpdLookupEntrypoint deriv cp name))
- epdDescs :: Rec EpCallingDesc (EpdAllEntrypoints deriv cp)
- class (EntrypointsDerivation (ParameterEntrypointsDerivation cp) cp, RequireAllUniqueEntrypoints cp) => ParameterHasEntrypoints cp where
- type ParameterEntrypointsDerivation cp :: Type
- type ParameterDeclaresEntrypoints cp = (If (CanHaveEntrypoints cp) (ParameterHasEntrypoints cp) (() :: Constraint), NiceParameter cp, EntrypointsDerivation (GetParameterEpDerivation cp) cp)
- type family AllParameterEntrypoints (cp :: Type) :: [(Symbol, Type)] where ...
- type family LookupParameterEntrypoint (cp :: Type) :: Symbol -> Exp (Maybe Type) where ...
- parameterEntrypointsToNotes :: forall cp. ParameterDeclaresEntrypoints cp => ParamNotes (ToT cp)
- type GetEntrypointArg cp name = Eval (LiftM2 FromMaybe (TError (('Text "Entrypoint not found: " :<>: 'ShowType name) :$$: (('Text "In contract parameter `" :<>: 'ShowType cp) :<>: 'Text "`"))) (LookupParameterEntrypoint cp name))
- parameterEntrypointCall :: forall cp name. ParameterDeclaresEntrypoints cp => Label name -> EntrypointCall cp (GetEntrypointArg cp name)
- type GetDefaultEntrypointArg cp = Eval (LiftM2 FromMaybe (Pure cp) (LookupParameterEntrypoint cp DefaultEpName))
- parameterEntrypointCallDefault :: forall cp. ParameterDeclaresEntrypoints cp => EntrypointCall cp (GetDefaultEntrypointArg cp)
- 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))
- type NoExplicitDefaultEntrypoint cp = Eval (LookupParameterEntrypoint cp DefaultEpName) ~ 'Nothing
- sepcCallRootChecked :: forall cp. (NiceParameter cp, ForbidExplicitDefaultEntrypoint cp) => SomeEntrypointCall cp
- data EntrypointRef (mname :: Maybe Symbol) where
- CallDefault :: EntrypointRef 'Nothing
- Call :: NiceEntrypointName name => EntrypointRef ('Just name)
- eprName :: forall mname. EntrypointRef mname -> EpName
- type family GetEntrypointArgCustom cp mname :: Type where ...
- class HasEntrypointArg cp name arg where
- useHasEntrypointArg :: name -> (Dict (ParameterScope (ToT arg)), EpName)
- type HasDefEntrypointArg cp defEpName defArg = (defEpName ~ EntrypointRef 'Nothing, HasEntrypointArg cp defEpName defArg)
- type HasEntrypointOfType param con exp = (GetEntrypointArgCustom param ('Just con) ~ exp, ParameterDeclaresEntrypoints param)
- type family ParameterContainsEntrypoints param (fields :: [NamedEp]) :: Constraint where ...
- newtype TrustEpName = TrustEpName EpName
- parameterEntrypointCallCustom :: forall cp mname. ParameterDeclaresEntrypoints cp => EntrypointRef mname -> EntrypointCall cp (GetEntrypointArgCustom cp mname)
- type RequireAllUniqueEntrypoints cp = RequireAllUniqueEntrypoints' (ParameterEntrypointsDerivation cp) cp
- type (:>) n ty = 'NamedEp n ty
- data EpdNone
- data EpdPlain
- data EpdRecursive
- data EpdDelegate
- data EpdWithRoot (r :: Symbol) epd
- newtype ParameterWrapper (deriv :: Type) cp = ParameterWrapper {
- unParameterWraper :: cp
- newtype ShouldHaveEntrypoints a = ShouldHaveEntrypoints {
- unHasEntrypoints :: a
Typeclasses
class EntrypointsDerivation deriv cp where Source #
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.
type EpdAllEntrypoints deriv cp :: [(Symbol, Type)] Source #
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 EpdLookupEntrypoint deriv cp :: Symbol -> Exp (Maybe Type) Source #
Get entrypoint argument by name.
epdNotes :: (Notes (ToT cp), RootAnn) Source #
Construct parameter annotations corresponding to expected entrypoints set.
This method is implementation detail, for actual notes construction
use parameterEntrypointsToNotes
.
epdCall :: ParameterScope (ToT cp) => Label name -> EpConstructionRes (ToT cp) (Eval (EpdLookupEntrypoint deriv cp name)) Source #
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
.
epdDescs :: Rec EpCallingDesc (EpdAllEntrypoints deriv cp) Source #
Description of how each of the entrypoints is constructed.
Instances
class (EntrypointsDerivation (ParameterEntrypointsDerivation cp) cp, RequireAllUniqueEntrypoints cp) => ParameterHasEntrypoints cp Source #
Which entrypoints given parameter declares.
Note that usually this function should not be used as constraint, use
ParameterDeclaresEntrypoints
for this purpose.
type ParameterEntrypointsDerivation cp :: Type Source #
Instances
(NiceParameter cp, EntrypointsDerivation epd cp, RequireAllUniqueEntrypoints' epd cp) => ParameterHasEntrypoints (ParameterWrapper epd cp) Source # | |
Defined in Lorentz.Entrypoints.Manual type ParameterEntrypointsDerivation (ParameterWrapper epd cp) Source # |
type ParameterDeclaresEntrypoints cp = (If (CanHaveEntrypoints cp) (ParameterHasEntrypoints cp) (() :: Constraint), NiceParameter cp, EntrypointsDerivation (GetParameterEpDerivation cp) cp) Source #
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.
Entrypoints API
type family AllParameterEntrypoints (cp :: Type) :: [(Symbol, Type)] where ... Source #
Get all entrypoints declared for parameter.
type family LookupParameterEntrypoint (cp :: Type) :: Symbol -> Exp (Maybe Type) where ... Source #
Lookup for entrypoint type by name.
Does not treat default entrypoints in a special way.
parameterEntrypointsToNotes :: forall cp. ParameterDeclaresEntrypoints cp => ParamNotes (ToT cp) Source #
Derive annotations for given parameter.
type GetEntrypointArg cp name = Eval (LiftM2 FromMaybe (TError (('Text "Entrypoint not found: " :<>: 'ShowType name) :$$: (('Text "In contract parameter `" :<>: 'ShowType cp) :<>: 'Text "`"))) (LookupParameterEntrypoint cp name)) Source #
Get type of entrypoint with given name, fail if not found.
parameterEntrypointCall :: forall cp name. ParameterDeclaresEntrypoints cp => Label name -> EntrypointCall cp (GetEntrypointArg cp name) Source #
Prepare call to given entrypoint.
This does not treat calls to default entrypoint in a special way.
To call default entrypoint properly use parameterEntrypointCallDefault
.
type GetDefaultEntrypointArg cp = Eval (LiftM2 FromMaybe (Pure cp) (LookupParameterEntrypoint cp DefaultEpName)) Source #
Get type of entrypoint with given name, fail if not found.
parameterEntrypointCallDefault :: forall cp. ParameterDeclaresEntrypoints cp => EntrypointCall cp (GetDefaultEntrypointArg cp) Source #
Call the 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)) Source #
Ensure that there is no explicit "default" entrypoint.
type NoExplicitDefaultEntrypoint cp = Eval (LookupParameterEntrypoint cp DefaultEpName) ~ 'Nothing Source #
Similar to ForbidExplicitDefaultEntrypoint
, but in a version which
the compiler can work with (and which produces errors confusing for users :/)
sepcCallRootChecked :: forall cp. (NiceParameter cp, ForbidExplicitDefaultEntrypoint cp) => SomeEntrypointCall cp Source #
Call root entrypoint safely.
data EntrypointRef (mname :: Maybe Symbol) where Source #
Which entrypoint to call.
We intentionally distinguish default and non-default cases because this makes API more details-agnostic.
CallDefault :: EntrypointRef 'Nothing | Call the default entrypoint, or root if no explicit default is assigned. |
Call :: NiceEntrypointName name => EntrypointRef ('Just name) | 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. |
Instances
(GetEntrypointArgCustom cp mname ~ arg, ParameterDeclaresEntrypoints cp) => HasEntrypointArg (cp :: Type) (EntrypointRef mname) arg Source # | |
Defined in Lorentz.Entrypoints.Core useHasEntrypointArg :: EntrypointRef mname -> (Dict (ParameterScope (ToT arg)), EpName) Source # |
eprName :: forall mname. EntrypointRef mname -> EpName Source #
type family GetEntrypointArgCustom cp mname :: Type where ... Source #
Universal entrypoint lookup.
GetEntrypointArgCustom cp 'Nothing = GetDefaultEntrypointArg cp | |
GetEntrypointArgCustom cp ('Just name) = GetEntrypointArg cp name |
class HasEntrypointArg cp name arg where Source #
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.
useHasEntrypointArg :: name -> (Dict (ParameterScope (ToT arg)), EpName) Source #
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.
Instances
NiceParameter arg => HasEntrypointArg (cp :: k) TrustEpName arg Source # | |
Defined in Lorentz.Entrypoints.Core useHasEntrypointArg :: TrustEpName -> (Dict (ParameterScope (ToT arg)), EpName) Source # | |
(GetEntrypointArgCustom cp mname ~ arg, ParameterDeclaresEntrypoints cp) => HasEntrypointArg (cp :: Type) (EntrypointRef mname) arg Source # | |
Defined in Lorentz.Entrypoints.Core useHasEntrypointArg :: EntrypointRef mname -> (Dict (ParameterScope (ToT arg)), EpName) Source # |
type HasDefEntrypointArg cp defEpName defArg = (defEpName ~ EntrypointRef 'Nothing, HasEntrypointArg cp defEpName defArg) Source #
HasEntrypointArg
constraint specialized to default entrypoint.
type HasEntrypointOfType param con exp = (GetEntrypointArgCustom param ('Just con) ~ exp, ParameterDeclaresEntrypoints param) Source #
Checks that the given parameter consists of some specific entrypoint. Similar as
HasEntrypointArg
but ensures that the argument matches the following datatype.
type family ParameterContainsEntrypoints param (fields :: [NamedEp]) :: Constraint where ... Source #
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.
ParameterContainsEntrypoints _ '[] = () | |
ParameterContainsEntrypoints param ((n :> ty) ': rest) = (HasEntrypointOfType param n ty, ParameterContainsEntrypoints param rest) |
newtype TrustEpName Source #
This wrapper allows to pass untyped EpName
and bypass checking
that entrypoint with given name and type exists.
Instances
NiceParameter arg => HasEntrypointArg (cp :: k) TrustEpName arg Source # | |
Defined in Lorentz.Entrypoints.Core useHasEntrypointArg :: TrustEpName -> (Dict (ParameterScope (ToT arg)), EpName) Source # |
parameterEntrypointCallCustom :: forall cp mname. ParameterDeclaresEntrypoints cp => EntrypointRef mname -> EntrypointCall cp (GetEntrypointArgCustom cp mname) Source #
Universal entrypoint calling.
type RequireAllUniqueEntrypoints cp = RequireAllUniqueEntrypoints' (ParameterEntrypointsDerivation cp) cp Source #
Ensure that all declared entrypoints are unique.
Implementations
No entrypoints declared, parameter type will serve as argument type of the only existing entrypoint (default one).
Instances
HasAnnotation cp => EntrypointsDerivation EpdNone cp Source # | |
Defined in Lorentz.Entrypoints.Core | |
type EpdAllEntrypoints EpdNone cp Source # | |
Defined in Lorentz.Entrypoints.Core | |
type EpdLookupEntrypoint EpdNone cp Source # | |
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 |
Behaviour modifiers
newtype ParameterWrapper (deriv :: Type) cp Source #
Wrap parameter into this to locally assign a way to derive entrypoints for it.
Instances
newtype ShouldHaveEntrypoints a Source #
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.