| Safe Haskell | Safe-Inferred |
|---|---|
| Language | GHC2021 |
Plutarch.DataRepr
Synopsis
- newtype PDataSum defs s = PDataSum (NS (Compose (Term s) PDataRecord) defs)
- punDataSum :: Term s (PDataSum '[def] :--> PDataRecord def)
- ptryIndexDataSum :: KnownNat n => Proxy n -> Term s (PDataSum (def ': defs) :--> PDataRecord (IndexList n (def ': defs)))
- data DataReprHandlers (out :: PType) (defs :: [[PLabeledType]]) (s :: S) where
- DRHNil :: DataReprHandlers out '[] s
- DRHCons :: (Term s (PDataRecord def) -> Term s out) -> DataReprHandlers out defs s -> DataReprHandlers out (def ': defs) s
- data PDataRecord (as :: [PLabeledType]) (s :: S) where
- PDCons :: forall name_x x xs s. PUnLabel name_x ~ x => Term s (PAsData x) -> Term s (PDataRecord xs) -> PDataRecord (name_x ': xs) s
- PDNil :: PDataRecord '[] s
- pdcons :: forall label a l s. Term s (PAsData a :--> (PDataRecord l :--> PDataRecord ((label := a) ': l)))
- pdnil :: Term s (PDataRecord '[])
- data PLabeledType = Symbol := PType
- pindexDataRecord :: KnownNat n => Proxy n -> Term s (PDataRecord as) -> Term s (PAsData (PUnLabel (IndexList n as)))
- pdropDataRecord :: KnownNat n => Proxy n -> Term s (PDataRecord xs) -> Term s (PDataRecord (Drop n xs))
- newtype DerivePConstantViaData (h :: Type) (p :: PType) = DerivePConstantViaData h
- type PConstantData h = (PConstant h, FromData h, ToData h, PIsData (PConstanted h))
- type PLiftData p = (PLift p, FromData (PLifted p), ToData (PLifted p), PIsData p)
- data PlutusTypeData
- class PDataFields (a :: PType) where
- type PFields a :: [PLabeledType]
- ptoFields :: Term s a -> Term s (PDataRecord (PFields a))
- pletFields :: forall fs a s b ps bs. (PDataFields a, ps ~ PFields a, bs ~ Bindings ps fs, BindFields ps bs) => Term s a -> (HRecOf a fs s -> Term s b) -> Term s b
- pfield :: forall name b p s a as n. (PDataFields p, as ~ PFields p, n ~ PLabelIndex name as, KnownNat n, a ~ PUnLabel (IndexList n as), PFromDataable a b) => Term s (p :--> b)
- data HRec as
- type HRecOf t fs s = HRec (BoundTerms (PFields t) (Bindings (PFields t) fs) s)
- type family PMemberFields t fs s as where ...
- type family PMemberField t name s as where ...
DataRepr
newtype PDataSum defs s Source #
A sum of PDataRecords. The underlying representation is the Constr constructor,
where the integer is the index of the variant and the list is the record.
Constructors
| PDataSum (NS (Compose (Term s) PDataRecord) defs) |
Instances
punDataSum :: Term s (PDataSum '[def] :--> PDataRecord def) Source #
If there is only a single variant, then we can safely extract it.
ptryIndexDataSum :: KnownNat n => Proxy n -> Term s (PDataSum (def ': defs) :--> PDataRecord (IndexList n (def ': defs))) Source #
Try getting the nth variant. Errs if it's another variant.
data DataReprHandlers (out :: PType) (defs :: [[PLabeledType]]) (s :: S) where Source #
Constructors
| DRHNil :: DataReprHandlers out '[] s | |
| DRHCons :: (Term s (PDataRecord def) -> Term s out) -> DataReprHandlers out defs s -> DataReprHandlers out (def ': defs) s |
data PDataRecord (as :: [PLabeledType]) (s :: S) where Source #
A "record" of `exists a. PAsData a`. The underlying representation is `PBuiltinList PData`.
Constructors
| PDCons :: forall name_x x xs s. PUnLabel name_x ~ x => Term s (PAsData x) -> Term s (PDataRecord xs) -> PDataRecord (name_x ': xs) s | |
| PDNil :: PDataRecord '[] s |
Instances
pdcons :: forall label a l s. Term s (PAsData a :--> (PDataRecord l :--> PDataRecord ((label := a) ': l))) Source #
Cons a field to a data record.
You can specify the label to associate with the field using type applications-
foo :: Term s (PDataRecord '[ "fooField" ':= PByteString ]) foo = pdcons @"fooField" # pdata (phexByteStr "ab") # pdnil
pdnil :: Term s (PDataRecord '[]) Source #
An empty PDataRecord.
data PLabeledType Source #
Instances
pindexDataRecord :: KnownNat n => Proxy n -> Term s (PDataRecord as) -> Term s (PAsData (PUnLabel (IndexList n as))) Source #
Safely index a PDataRecord.
pdropDataRecord :: KnownNat n => Proxy n -> Term s (PDataRecord xs) -> Term s (PDataRecord (Drop n xs)) Source #
Safely drop the first n items of a PDataRecord.
newtype DerivePConstantViaData (h :: Type) (p :: PType) Source #
For deriving PConstant for a wrapped type represented by a builtin type, see
DerivePConstantViaNewtype.
Constructors
| DerivePConstantViaData h | The Haskell type for which @PConstant is being derived. |
Instances
| (PSubtype PData p, PLift p, FromData h, ToData h) => PConstantDecl (DerivePConstantViaData h p) Source # | |
Defined in Plutarch.DataRepr.Internal Associated Types type PConstantRepr (DerivePConstantViaData h p) Source # type PConstanted (DerivePConstantViaData h p) :: PType Source # Methods pconstantToRepr :: DerivePConstantViaData h p -> PConstantRepr (DerivePConstantViaData h p) Source # pconstantFromRepr :: PConstantRepr (DerivePConstantViaData h p) -> Maybe (DerivePConstantViaData h p) Source # | |
| type PConstantRepr (DerivePConstantViaData h p) Source # | |
Defined in Plutarch.DataRepr.Internal | |
| type PConstanted (DerivePConstantViaData h p) Source # | |
Defined in Plutarch.DataRepr.Internal | |
type PConstantData h = (PConstant h, FromData h, ToData h, PIsData (PConstanted h)) Source #
Type synonym to simplify deriving of PConstant via DerivePConstantViaData.
A type Foo a is considered ConstantableData if:
- The wrapped type
ahas aPConstantinstance. - The lifted type of
ahas aPUnsafeLiftDeclinstance. - There is type equality between
aandPLifted (PConstanted a). - The newtype has
FromDataandToDatainstances
These constraints are sufficient to derive a PConstant instance for the newtype.
For deriving PConstant for a wrapped type represented in UPLC as Data, see
DerivePConstantViaData.
Polymorphic types can be derived as follows:
data Bar a = Bar a deriving stock (GHC.Generic)
PlutusTx.makeLift ''Bar
PlutusTx.makeIsDataIndexed ''Bar [('Bar, 0)]
data PBar (a :: PType) (s :: S)
= PBar (Term s (PDataRecord '["_0" ':= a]))
deriving stock (GHC.Generic)
deriving anyclass (SOP.Generic, PIsDataRepr)
deriving (PlutusType, PIsData, PDataFields) via PIsDataReprInstances (PBar a)
instance
forall a.
PLiftData a =>
PUnsafeLiftDecl (PBar a)
where
type PLifted (PBar a) = Bar (PLifted a)
deriving via
( DerivePConstantViaData
(Bar a)
(PBar (PConstanted a))
)
instance
PConstantData a =>
PConstantDecl (Bar a)data PlutusTypeData Source #
Instances
| PlutusTypeStrat PlutusTypeData Source # | |
Defined in Plutarch.DataRepr.Internal Associated Types type PlutusTypeStratConstraint PlutusTypeData :: PType -> Constraint Source # type DerivedPInner PlutusTypeData a :: PType Source # Methods derivedPCon :: forall a (s :: S). (DerivePlutusType a, DPTStrat a ~ PlutusTypeData) => a s -> Term s (DerivedPInner PlutusTypeData a) Source # derivedPMatch :: forall a (s :: S) (b :: PType). (DerivePlutusType a, DPTStrat a ~ PlutusTypeData) => Term s (DerivedPInner PlutusTypeData a) -> (a s -> Term s b) -> Term s b Source # | |
| type PlutusTypeStratConstraint PlutusTypeData Source # | |
Defined in Plutarch.DataRepr.Internal | |
| type DerivedPInner PlutusTypeData a Source # | |
Defined in Plutarch.DataRepr.Internal | |
Fields
class PDataFields (a :: PType) where Source #
Class allowing letFields to work for a PType, usually via
PIsDataRepr, but is derived for some other types for convenience.
Minimal complete definition
Nothing
Methods
ptoFields :: Term s a -> Term s (PDataRecord (PFields a)) Source #
Convert a Term to a PDataList
Instances
pletFields :: forall fs a s b ps bs. (PDataFields a, ps ~ PFields a, bs ~ Bindings ps fs, BindFields ps bs) => Term s a -> (HRecOf a fs s -> Term s b) -> Term s b Source #
Bind a HRec of named fields containing all the specified fields.
pfield :: forall name b p s a as n. (PDataFields p, as ~ PFields p, n ~ PLabelIndex name as, KnownNat n, a ~ PUnLabel (IndexList n as), PFromDataable a b) => Term s (p :--> b) Source #
Get a single field from a Term.
- NB*: If you access more than one field from
the same value you should use
pletFieldsinstead, which will generate the bindings more efficiently.
type HRecOf t fs s = HRec (BoundTerms (PFields t) (Bindings (PFields t) fs) s) Source #
The HRec yielded by 'pletFields @fs t'.
type family PMemberFields t fs s as where ... Source #
Constrain an HRec to contain the specified fields from the given Plutarch type.
Example ===
import qualified GHC.Generics as GHC
import Generics.SOP
import Plutarch.Prelude
import Plutarch.DataRepr
newtype PFooType s = PFooType (Term s (PDataRecord '["frst" ':= PInteger, "scnd" ':= PBool, "thrd" ':= PString]))
deriving stock (GHC.Generic)
deriving anyclass (Generic)
deriving anyclass (PIsDataRepr)
deriving
(PlutusType, PIsData, PDataFields, PEq)
via PIsDataReprInstances PFooType
foo :: PMemberFields PFooType '["scnd", "frst"] s as => HRec as -> Term s PInteger
foo h = pif (getField "scnd" h) (getField "frst" h) 0
Equations
| PMemberFields _ '[] _ _ = () | |
| PMemberFields t (name ': rest) s as = (PMemberField t name s as, PMemberFields t rest s as) |
type family PMemberField t name s as where ... Source #
Single field version of PMemberFields.
Equations
| PMemberField t name s as = (IndexLabel name as ~ Term s (PAsData (PLookupLabel name (PFields t))), ElemOf name (Term s (PAsData (PLookupLabel name (PFields t)))) as) |