Safe Haskell | None |
---|---|
Language | Haskell2010 |
Lorentz.UStore.Types
Description
UStore
definition and common type-level stuff.
Synopsis
- newtype UStore (a :: Type) = UStore {}
- newtype k |~> v = UStoreSubMap {
- unUStoreSubMap :: Map k v
- newtype UStoreFieldExt (m :: UStoreMarkerType) (v :: Type) = UStoreField {
- unUStoreField :: v
- type UStoreField = UStoreFieldExt UMarkerPlainField
- type UStoreMarkerType = UStoreMarker -> Type
- data UMarkerPlainField :: UStoreMarkerType
- class KnownUStoreMarker (marker :: UStoreMarkerType) where
- type ShowUStoreField marker v :: ErrorMessage
- mkFieldMarkerUKey :: MText -> ByteString
- mkFieldMarkerUKeyL :: forall marker field. KnownUStoreMarker marker => Label field -> ByteString
- mkFieldUKey :: forall (store :: Type) field. KnownUStoreMarker (GetUStoreFieldMarker store field) => Label field -> ByteString
- type UStoreSubmapKey k = (MText, k)
- type UStoreSubmapKeyT k = 'TPair (ToT MText) k
- type GetUStoreKey store name = MSKey (GetUStore name store)
- type GetUStoreValue store name = MSValue (GetUStore name store)
- type GetUStoreField store name = FSValue (GetUStore name store)
- type GetUStoreFieldMarker store name = FSMarker (GetUStore name store)
- type PickMarkedFields marker template = GPickMarkedFields marker (Rep template)
- data ElemSignature
- type GetUStore name a = MERequireFound name a (GLookupStore name (Rep a))
- type family MSKey (ms :: ElemSignature) :: Type where ...
- type family MSValue (ms :: ElemSignature) :: Type where ...
- type family FSValue (ms :: ElemSignature) :: Type where ...
- type family FSMarker (ms :: ElemSignature) :: UStoreMarkerType where ...
UStore and related type definitions
newtype UStore (a :: Type) Source #
Gathers multple fields and BigMap
s under one object.
Type argument of this datatype stands for a "store template" -
a datatype with one constructor and multiple fields, each containing
an object of type UStoreField
or |~>
and corresponding to single
virtual field or BigMap
respectively.
It's also possible to parameterize it with a larger type which is
a product of types satisfying the above property.
Constructors
UStore | |
Fields |
Instances
Describes one virtual big map in the storage.
Constructors
UStoreSubMap | |
Fields
|
newtype UStoreFieldExt (m :: UStoreMarkerType) (v :: Type) Source #
Describes plain field in the storage.
Constructors
UStoreField | |
Fields
|
Instances
Eq v => Eq (UStoreFieldExt m v) Source # | |
Defined in Lorentz.UStore.Types Methods (==) :: UStoreFieldExt m v -> UStoreFieldExt m v -> Bool # (/=) :: UStoreFieldExt m v -> UStoreFieldExt m v -> Bool # | |
Show v => Show (UStoreFieldExt m v) Source # | |
Defined in Lorentz.UStore.Types Methods showsPrec :: Int -> UStoreFieldExt m v -> ShowS # show :: UStoreFieldExt m v -> String # showList :: [UStoreFieldExt m v] -> ShowS # | |
Arbitrary v => Arbitrary (UStoreFieldExt m v) Source # | |
Defined in Lorentz.UStore.Types Methods arbitrary :: Gen (UStoreFieldExt m v) # shrink :: UStoreFieldExt m v -> [UStoreFieldExt m v] # |
type UStoreField = UStoreFieldExt UMarkerPlainField Source #
Just a plain field used as data.
type UStoreMarkerType = UStoreMarker -> Type Source #
Specific kind used to designate markers for UStoreFieldExt
.
We suggest that fields may serve different purposes and so annotated with special markers accordingly, which influences translation to Michelson. See example below.
This Haskell kind is implemented like that because we want markers to differ from all
other types in kind; herewith UStoreMarkerType
is still an open kind
(has potentially infinite number of inhabitants).
data UMarkerPlainField :: UStoreMarkerType Source #
Instances
KnownUStoreMarker UMarkerPlainField Source # | |
Defined in Lorentz.UStore.Types Associated Types type ShowUStoreField UMarkerPlainField v :: ErrorMessage Source # Methods mkFieldMarkerUKey :: MText -> ByteString Source # | |
UStoreMarkerHasDoc UMarkerPlainField Source # | |
Defined in Lorentz.UStore.Doc Methods ustoreMarkerKeyEncoding :: Text -> Text Source # | |
type ShowUStoreField UMarkerPlainField v Source # | |
Defined in Lorentz.UStore.Types |
Extras
class KnownUStoreMarker (marker :: UStoreMarkerType) where Source #
Allows to specify format of key under which fields of this type are stored. Useful to avoid collisions.
Minimal complete definition
Nothing
Associated Types
type ShowUStoreField marker v :: ErrorMessage Source #
Display type-level information about UStore field with given marker and field value type. Used for error messages.
Methods
mkFieldMarkerUKey :: MText -> ByteString Source #
By field name derive key under which field should be stored.
default mkFieldMarkerUKey :: MText -> ByteString Source #
Instances
KnownUStoreMarker UMarkerPlainField Source # | |
Defined in Lorentz.UStore.Types Associated Types type ShowUStoreField UMarkerPlainField v :: ErrorMessage Source # Methods mkFieldMarkerUKey :: MText -> ByteString Source # |
mkFieldMarkerUKeyL :: forall marker field. KnownUStoreMarker marker => Label field -> ByteString Source #
Version of mkFieldMarkerUKey
which accepts label.
mkFieldUKey :: forall (store :: Type) field. KnownUStoreMarker (GetUStoreFieldMarker store field) => Label field -> ByteString Source #
Shortcut for mkFieldMarkerUKey
which accepts not marker but store template
and name of entry.
type UStoreSubmapKey k = (MText, k) Source #
What do we serialize when constructing big_map key for accessing an UStore submap.
type UStoreSubmapKeyT k = 'TPair (ToT MText) k Source #
Type-lookup-by-name
type GetUStoreKey store name = MSKey (GetUStore name store) Source #
Get type of submap key.
type GetUStoreValue store name = MSValue (GetUStore name store) Source #
Get type of submap value.
type GetUStoreField store name = FSValue (GetUStore name store) Source #
Get type of plain field. This ignores marker with field type.
type GetUStoreFieldMarker store name = FSMarker (GetUStore name store) Source #
Get kind of field.
Marked fields
type PickMarkedFields marker template = GPickMarkedFields marker (Rep template) Source #
Collect all fields with the given marker.
Internals
data ElemSignature Source #
What was found on lookup by constructor name.
This keeps either type arguments of |~>
or UStoreField
.
Constructors
MapSignature Type Type | |
FieldSignature UStoreMarkerType Type |
type GetUStore name a = MERequireFound name a (GLookupStore name (Rep a)) Source #
Get map signature from the constructor with a given name.
type family MSKey (ms :: ElemSignature) :: Type where ... Source #
Equations
MSKey ('MapSignature k _) = k | |
MSKey ('FieldSignature _ _) = TypeError ('Text "Expected UStore submap, but field was referred") |
type family MSValue (ms :: ElemSignature) :: Type where ... Source #
Equations
MSValue ('MapSignature _ v) = v | |
MSValue ('FieldSignature _ _) = TypeError ('Text "Expected UStore submap, but field was referred") |
type family FSValue (ms :: ElemSignature) :: Type where ... Source #
Equations
FSValue ('FieldSignature _ v) = v | |
FSValue ('MapSignature _ _) = TypeError ('Text "Expected UStore field, but submap was referred") |
type family FSMarker (ms :: ElemSignature) :: UStoreMarkerType where ... Source #
Equations
FSMarker ('FieldSignature m _) = m | |
FSMarker ('MapSignature _ _) = TypeError ('Text "Expected UStore field, but submap was referred") |