Safe Haskell | None |
---|---|
Language | Haskell2010 |
This module provides storage interfaces.
Synopsis
- class StoreHasField store fname ftype | store fname -> ftype where
- storeFieldOps :: StoreFieldOps store fname ftype
- data StoreFieldOps store fname ftype = StoreFieldOps {
- sopToField :: forall s. Label fname -> (store ': s) :-> (ftype ': s)
- sopSetField :: forall s. Label fname -> (ftype ': (store ': s)) :-> (store ': s)
- class StoreHasSubmap store mname key value | store mname -> key value where
- storeSubmapOps :: StoreSubmapOps store mname key value
- data StoreSubmapOps store mname key value = StoreSubmapOps {
- sopMem :: forall s. Label mname -> (key ': (store ': s)) :-> (Bool ': s)
- sopGet :: forall s. KnownValue value => Label mname -> (key ': (store ': s)) :-> (Maybe value ': s)
- sopUpdate :: forall s. Label mname -> (key ': (Maybe value ': (store ': s))) :-> (store ': s)
- sopDelete :: forall s. Maybe (Label mname -> (key ': (store ': s)) :-> (store ': s))
- sopInsert :: forall s. Maybe (Label mname -> (key ': (value ': (store ': s))) :-> (store ': s))
- class StoreHasEntrypoint store epName epParam epStore | store epName -> epParam epStore where
- storeEpOps :: StoreEntrypointOps store epName epParam epStore
- data StoreEntrypointOps store epName epParam epStore = StoreEntrypointOps {
- sopToEpLambda :: forall s. Label epName -> (store ': s) :-> (EntrypointLambda epParam epStore ': s)
- sopSetEpLambda :: forall s. Label epName -> (EntrypointLambda epParam epStore ': (store ': s)) :-> (store ': s)
- sopToEpStore :: forall s. Label epName -> (store ': s) :-> (epStore ': s)
- sopSetEpStore :: forall s. Label epName -> (epStore ': (store ': s)) :-> (store ': s)
- type EntrypointLambda param store = Lambda (param, store) ([Operation], store)
- type EntrypointsField param store = BigMap MText (EntrypointLambda param store)
- data k ~> v
- data param ::-> store
- type family StorageContains store (content :: [NamedField]) :: Constraint where ...
- stToField :: StoreHasField store fname ftype => Label fname -> (store ': s) :-> (ftype ': s)
- stGetField :: StoreHasField store fname ftype => Label fname -> (store ': s) :-> (ftype ': (store ': s))
- stSetField :: StoreHasField store fname ftype => Label fname -> (ftype ': (store ': s)) :-> (store ': s)
- stMem :: StoreHasSubmap store mname key value => Label mname -> (key ': (store ': s)) :-> (Bool ': s)
- stGet :: (StoreHasSubmap store mname key value, KnownValue value) => Label mname -> (key ': (store ': s)) :-> (Maybe value ': s)
- stUpdate :: StoreHasSubmap store mname key value => Label mname -> (key ': (Maybe value ': (store ': s))) :-> (store ': s)
- stDelete :: forall store mname key value s. (StoreHasSubmap store mname key value, KnownValue value) => Label mname -> (key ': (store ': s)) :-> (store ': s)
- stInsert :: StoreHasSubmap store mname key value => Label mname -> (key ': (value ': (store ': s))) :-> (store ': s)
- stInsertNew :: StoreHasSubmap store mname key value => Label mname -> (forall s0 any. (key ': s0) :-> any) -> (key ': (value ': (store ': s))) :-> (store ': s)
- stEntrypoint :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (epParam ': (store ': s)) :-> (([Operation], store) ': s)
- stToEpLambda :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (store ': s) :-> (EntrypointLambda epParam epStore ': s)
- stGetEpLambda :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (store ': s) :-> (EntrypointLambda epParam epStore ': (store ': s))
- stSetEpLambda :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (EntrypointLambda epParam epStore ': (store ': s)) :-> (store ': s)
- stToEpStore :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (store ': s) :-> (epStore ': s)
- stGetEpStore :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (store ': s) :-> (epStore ': (store ': s))
- stSetEpStore :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (epStore ': (store ': s)) :-> (store ': s)
- storeFieldOpsADT :: HasFieldOfType dt fname ftype => StoreFieldOps dt fname ftype
- storeEntrypointOpsADT :: (HasFieldOfType store epmName (EntrypointsField epParam epStore), HasFieldOfType store epsName epStore, KnownValue epParam, KnownValue epStore) => Label epmName -> Label epsName -> StoreEntrypointOps store epName epParam epStore
- storeEntrypointOpsFields :: (StoreHasField store epmName (EntrypointsField epParam epStore), StoreHasField store epsName epStore, KnownValue epParam, KnownValue epStore) => Label epmName -> Label epsName -> StoreEntrypointOps store epName epParam epStore
- 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
- storeFieldOpsDeeper :: (HasFieldOfType storage fieldsPartName fields, StoreHasField fields fname ftype) => Label fieldsPartName -> StoreFieldOps storage fname ftype
- storeSubmapOpsDeeper :: (HasFieldOfType storage bigMapPartName fields, StoreHasSubmap fields mname key value) => Label bigMapPartName -> StoreSubmapOps storage mname key value
- storeEntrypointOpsDeeper :: (HasFieldOfType store nameInStore substore, StoreHasEntrypoint substore epName epParam epStore) => Label nameInStore -> StoreEntrypointOps store epName epParam epStore
- storeFieldOpsReferTo :: Label name -> StoreFieldOps storage name field -> StoreFieldOps storage desiredName field
- storeSubmapOpsReferTo :: Label name -> StoreSubmapOps storage name key value -> StoreSubmapOps storage desiredName key value
- storeEntrypointOpsReferTo :: Label epName -> StoreEntrypointOps store epName epParam epStore -> StoreEntrypointOps store desiredName epParam epStore
- composeStoreFieldOps :: Label nameInStore -> StoreFieldOps store nameInStore substore -> StoreFieldOps substore nameInSubstore field -> StoreFieldOps store nameInSubstore field
- composeStoreSubmapOps :: Label nameInStore -> StoreFieldOps store nameInStore substore -> StoreSubmapOps substore mname key value -> StoreSubmapOps store mname key value
- composeStoreEntrypointOps :: Label nameInStore -> StoreFieldOps store nameInStore substore -> StoreEntrypointOps substore epName epParam epStore -> StoreEntrypointOps store epName epParam epStore
- mkStoreEp :: Label epName -> EntrypointLambda epParam epStore -> EntrypointsField epParam epStore
Class
class StoreHasField store fname ftype | store fname -> ftype where Source #
Provides operations on fields for storage.
storeFieldOps :: StoreFieldOps store fname ftype Source #
Instances
HasUField fname ftype templ => StoreHasField (UStore templ) fname ftype Source # | |
Defined in Lorentz.UStore.Instances storeFieldOps :: StoreFieldOps (UStore templ) fname ftype Source # |
data StoreFieldOps store fname ftype Source #
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.)
StoreFieldOps | |
|
class StoreHasSubmap store mname key value | store mname -> key value where Source #
Provides operations on submaps of storage.
storeSubmapOps :: StoreSubmapOps store mname key value Source #
Instances
HasUStore mname key value templ => StoreHasSubmap (UStore templ) mname key value Source # | |
Defined in Lorentz.UStore.Instances storeSubmapOps :: StoreSubmapOps (UStore templ) mname key value Source # | |
(key ~ key', value ~ value', NiceComparable key) => StoreHasSubmap (Map key' value') name key value Source # |
|
Defined in Lorentz.StoreClass storeSubmapOps :: StoreSubmapOps (Map key' value') name key value Source # | |
(key ~ key', value ~ value', NiceComparable key) => StoreHasSubmap (BigMap key' value') name key value Source # |
|
Defined in Lorentz.StoreClass storeSubmapOps :: StoreSubmapOps (BigMap key' value') name key value Source # |
data StoreSubmapOps store mname key value Source #
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.)
StoreSubmapOps | |
|
class StoreHasEntrypoint store epName epParam epStore | store epName -> epParam epStore where Source #
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.
storeEpOps :: StoreEntrypointOps store epName epParam epStore Source #
data StoreEntrypointOps store epName epParam epStore Source #
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.)
StoreEntrypointOps | |
|
Useful type synonyms
type EntrypointLambda param store = Lambda (param, store) ([Operation], store) Source #
Type synonym for a Lambda
that can be used as an entrypoint
type EntrypointsField param store = BigMap MText (EntrypointLambda param store) Source #
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.
Expressing constraints on storage
data param ::-> store infix 9 Source #
Indicates a stored entrypoint with the given param
and store
types.
type family StorageContains store (content :: [NamedField]) :: Constraint where ... Source #
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 ]
StorageContains _ '[] = () | |
StorageContains store ((n := (k ~> v)) ': ct) = (StoreHasSubmap store n k v, StorageContains store ct) | |
StorageContains store ((n := (ep ::-> es)) ': ct) = (StoreHasEntrypoint store n ep es, StorageContains store ct) | |
StorageContains store ((n := ty) ': ct) = (StoreHasField store n ty, StorageContains store ct) |
Methods to work with storage
stToField :: StoreHasField store fname ftype => Label fname -> (store ': s) :-> (ftype ': s) Source #
Pick storage field.
stGetField :: StoreHasField store fname ftype => Label fname -> (store ': s) :-> (ftype ': (store ': s)) Source #
Get storage field, preserving the storage itself on stack.
stSetField :: StoreHasField store fname ftype => Label fname -> (ftype ': (store ': s)) :-> (store ': s) Source #
Update storage field.
stMem :: StoreHasSubmap store mname key value => Label mname -> (key ': (store ': s)) :-> (Bool ': s) Source #
Check value presence in storage.
stGet :: (StoreHasSubmap store mname key value, KnownValue value) => Label mname -> (key ': (store ': s)) :-> (Maybe value ': s) Source #
Get value in storage.
stUpdate :: StoreHasSubmap store mname key value => Label mname -> (key ': (Maybe value ': (store ': s))) :-> (store ': s) Source #
Update a value in storage.
stDelete :: forall store mname key value s. (StoreHasSubmap store mname key value, KnownValue value) => Label mname -> (key ': (store ': s)) :-> (store ': s) Source #
Delete a value in storage.
stInsert :: StoreHasSubmap store mname key value => Label mname -> (key ': (value ': (store ': s))) :-> (store ': s) Source #
Add a value in storage.
stInsertNew :: StoreHasSubmap store mname key value => Label mname -> (forall s0 any. (key ': s0) :-> any) -> (key ': (value ': (store ': s))) :-> (store ': s) Source #
Add a value in storage, but fail if it will overwrite some existing entry.
stEntrypoint :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (epParam ': (store ': s)) :-> (([Operation], store) ': s) Source #
Extracts and executes the epName
entrypoint lambda from storage, returing
the updated full storage (store
) and the produced Operation
s.
stToEpLambda :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (store ': s) :-> (EntrypointLambda epParam epStore ': s) Source #
Pick stored entrypoint lambda.
stGetEpLambda :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (store ': s) :-> (EntrypointLambda epParam epStore ': (store ': s)) Source #
Get stored entrypoint lambda, preserving the storage itself on the stack.
stSetEpLambda :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (EntrypointLambda epParam epStore ': (store ': s)) :-> (store ': s) Source #
Stores the entrypoint lambda in the storage. Fails if already set.
stToEpStore :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (store ': s) :-> (epStore ': s) Source #
Pick the sub-storage that the entrypoint operates on.
stGetEpStore :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (store ': s) :-> (epStore ': (store ': s)) Source #
Get the sub-storage that the entrypoint operates on, preserving the storage itself on the stack.
stSetEpStore :: StoreHasEntrypoint store epName epParam epStore => Label epName -> (epStore ': (store ': s)) :-> (store ': s) Source #
Update the sub-storage that the entrypoint operates on.
Implementations
storeFieldOpsADT :: HasFieldOfType dt fname ftype => StoreFieldOps dt fname ftype Source #
Implementation of StoreHasField
for case of datatype
keeping a pack of fields.
storeEntrypointOpsADT :: (HasFieldOfType store epmName (EntrypointsField epParam epStore), HasFieldOfType store epsName epStore, KnownValue epParam, KnownValue epStore) => Label epmName -> Label epsName -> StoreEntrypointOps store epName epParam epStore Source #
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.
storeEntrypointOpsFields :: (StoreHasField store epmName (EntrypointsField epParam epStore), StoreHasField store epsName epStore, KnownValue epParam, KnownValue epStore) => Label epmName -> Label epsName -> StoreEntrypointOps store epName epParam epStore Source #
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.
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 Source #
Implementation of StoreHasEntrypoint
for a datatype that has a StoreHasSubmap
that contains the entrypoint and a StoreHasField
for the field such
entrypoint operates on.
storeFieldOpsDeeper :: (HasFieldOfType storage fieldsPartName fields, StoreHasField fields fname ftype) => Label fieldsPartName -> StoreFieldOps storage fname ftype Source #
Implementation of StoreHasField
for a data type which has an
instance of StoreHasField
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 Source #
Implementation of StoreHasSubmap
for a data type which has an
instance of StoreHasSubmap
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 Source #
Implementation of StoreHasEntrypoint
for a data type which has an
instance of StoreHasEntrypoint
inside.
For instance, it can be used for top-level storage.
storeFieldOpsReferTo :: Label name -> StoreFieldOps storage name field -> StoreFieldOps storage desiredName field Source #
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
.
storeSubmapOpsReferTo :: Label name -> StoreSubmapOps storage name key value -> StoreSubmapOps storage desiredName key value Source #
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
storeEntrypointOpsReferTo :: Label epName -> StoreEntrypointOps store epName epParam epStore -> StoreEntrypointOps store desiredName epParam epStore Source #
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
.
composeStoreFieldOps :: Label nameInStore -> StoreFieldOps store nameInStore substore -> StoreFieldOps substore nameInSubstore field -> StoreFieldOps store nameInSubstore field Source #
Chain two implementations of field operations.
Suits for a case when your store does not contain its fields directly rather has a nested structure.
composeStoreSubmapOps :: Label nameInStore -> StoreFieldOps store nameInStore substore -> StoreSubmapOps substore mname key value -> StoreSubmapOps store mname key value Source #
Chain implementations of field and submap operations.
composeStoreEntrypointOps :: Label nameInStore -> StoreFieldOps store nameInStore substore -> StoreEntrypointOps substore epName epParam epStore -> StoreEntrypointOps store epName epParam epStore Source #
Storage generation
mkStoreEp :: Label epName -> EntrypointLambda epParam epStore -> EntrypointsField epParam epStore Source #
Utility to create EntrypointsField
s 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.