Merge pull request #107 from Liqwid-Labs/seungheonoh/recordToExtra
Moved `Agora.Record` to `Plutarch.Extra.Record`
This commit is contained in:
Emily
GitHub
commit
8231d1b079
6 changed files with 10 additions and 119 deletions
|
|
@ -145,7 +145,6 @@ library
|
|||
Agora.Proposal
|
||||
Agora.Proposal.Scripts
|
||||
Agora.Proposal.Time
|
||||
Agora.Record
|
||||
Agora.SafeMoney
|
||||
Agora.ScriptInfo
|
||||
Agora.Stake
|
||||
|
|
|
|||
|
|
@ -59,7 +59,6 @@ import Agora.Proposal.Scripts (
|
|||
proposalValidator,
|
||||
)
|
||||
import Agora.Proposal.Time (createProposalStartingTime)
|
||||
import Agora.Record
|
||||
import Agora.SafeMoney (GTTag)
|
||||
import Agora.Stake (
|
||||
PProposalLock (..),
|
||||
|
|
@ -91,6 +90,7 @@ import Agora.Utils (
|
|||
validatorHashToAddress,
|
||||
validatorHashToTokenName,
|
||||
)
|
||||
import Plutarch.Extra.Record
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -18,7 +18,6 @@ import Agora.Proposal (
|
|||
ProposalStatus (VotingReady),
|
||||
)
|
||||
import Agora.Proposal.Time (currentProposalTime, isVotingPeriod)
|
||||
import Agora.Record (mkRecordConstr, (.&), (.=))
|
||||
import Agora.Stake (PProposalLock (..), PStakeDatum (..), findStakeOwnedBy)
|
||||
import Agora.Utils (
|
||||
findTxOutByTxOutRef,
|
||||
|
|
@ -47,6 +46,7 @@ import Plutarch.Api.V1 (
|
|||
import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf)
|
||||
import Plutarch.Extra.Comonad (pextract)
|
||||
import Plutarch.Extra.Map (plookup)
|
||||
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
|
||||
import Plutarch.Extra.TermCont (pmatchC)
|
||||
import Plutarch.SafeMoney (PDiscrete (..))
|
||||
import Plutus.V1.Ledger.Value (AssetClass (AssetClass))
|
||||
|
|
|
|||
|
|
@ -1,108 +0,0 @@
|
|||
{- |
|
||||
Module : Agora.Record
|
||||
Maintainer : emi@haskell.fyi
|
||||
Description: PDataRecord helper functions.
|
||||
|
||||
'PDataRecord' helper functions.
|
||||
-}
|
||||
module Agora.Record (
|
||||
mkRecord,
|
||||
mkRecordConstr,
|
||||
(.=),
|
||||
(.&),
|
||||
RecordMorphism,
|
||||
FieldName,
|
||||
) where
|
||||
|
||||
import Control.Category (Category (..))
|
||||
import Data.Coerce (coerce)
|
||||
import GHC.OverloadedLabels (IsLabel (fromLabel))
|
||||
import GHC.TypeLits (Symbol)
|
||||
import Plutarch.DataRepr (PDataRecord (PDCons))
|
||||
import Prelude hiding (id, (.))
|
||||
|
||||
-- | Like 'Data.Proxy.Proxy' but local to this module.
|
||||
data FieldName (sym :: Symbol) = FieldName
|
||||
|
||||
{- | The use of two different 'Symbol's here allows unification to happen,
|
||||
ensuring 'FieldName' has a fully inferred 'Symbol'.
|
||||
|
||||
For example, @'mkRecord' (#foo .= 'pconstantData' (42 :: 'Integer'))@ gets
|
||||
the correct type. Namely, @'Term' s ('PDataRecord' '["foo" ':= 'PInteger'])@.
|
||||
-}
|
||||
instance forall (sym :: Symbol) (sym' :: Symbol). sym ~ sym' => IsLabel sym (FieldName sym) where
|
||||
fromLabel = FieldName
|
||||
|
||||
-- | Turn a constant 'RecordMorphism' into a fully built 'PDataRecord'.
|
||||
mkRecord :: forall (r :: [PLabeledType]) (s :: S). RecordMorphism s '[] r -> Term s (PDataRecord r)
|
||||
mkRecord f = f.runRecordMorphism pdnil
|
||||
|
||||
{- | 'mkRecord' but for known data-types.
|
||||
|
||||
This allows you to dynamically construct a record type constructor.
|
||||
|
||||
=== Example:
|
||||
@
|
||||
'mkRecordConstr'
|
||||
'Agora.Stake.PStakeDatum'
|
||||
( #stakedAmount '.=' 'pconstantData' ('Plutarch.SafeMoney.Tagged' @GTTag 42)
|
||||
'.&' #owner '.=' 'pconstantData' "aabbcc"
|
||||
'.&' #lockedBy '.=' 'pdata' pnil
|
||||
)
|
||||
@
|
||||
Is the same as
|
||||
|
||||
@
|
||||
'pconstant' ('Agora.Stake.StakeDatum' ('Plutarch.SafeMoney.Tagged' 42) "aabbcc" [])
|
||||
@
|
||||
-}
|
||||
mkRecordConstr ::
|
||||
forall (r :: [PLabeledType]) (s :: S) (pt :: PType).
|
||||
PlutusType pt =>
|
||||
-- | The constructor. This is just the Haskell-level constructor for the type.
|
||||
-- For 'Plutarch.Api.V1.Maybe.PMaybeData', this would
|
||||
-- be 'Plutarch.Api.V1.Maybe.PDJust', or 'Plutarch.Api.V1.Maybe.PNothing'.
|
||||
(forall s'. Term s' (PDataRecord r) -> pt s') ->
|
||||
-- | The morphism that builds the record.
|
||||
RecordMorphism s '[] r ->
|
||||
Term s pt
|
||||
mkRecordConstr ctr = pcon . ctr . mkRecord
|
||||
|
||||
-- | A morphism from one 'PDataRecord' to another, representing some sort of consing of data.
|
||||
newtype RecordMorphism (s :: S) (as :: [PLabeledType]) (bs :: [PLabeledType]) = RecordMorphism
|
||||
{ runRecordMorphism ::
|
||||
Term s (PDataRecord as) ->
|
||||
Term s (PDataRecord bs)
|
||||
}
|
||||
|
||||
instance Category (RecordMorphism s) where
|
||||
id = RecordMorphism id
|
||||
f . g = coerce $ f.runRecordMorphism . g.runRecordMorphism
|
||||
|
||||
infix 7 .=
|
||||
|
||||
-- | Cons a labeled type as a 'RecordMorphism'.
|
||||
(.=) ::
|
||||
forall (sym :: Symbol) (a :: PType) (as :: [PLabeledType]) (s :: S).
|
||||
-- | The field name. You can use @-XOverloadedLabels@ to enable the syntax:
|
||||
-- @#hello ~ 'FieldName' "hello"@
|
||||
FieldName sym ->
|
||||
-- | The value at that field. This must be 'PAsData', because the underlying
|
||||
-- type is @'PlutusCore.Data.Constr' 'Integer' ['PlutusCore.Data.Data']@.
|
||||
Term s (PAsData a) ->
|
||||
RecordMorphism s as ((sym ':= a) ': as)
|
||||
_ .= x = RecordMorphism $ pcon . PDCons x
|
||||
|
||||
infixr 6 .&
|
||||
|
||||
-- | Compose two 'RecordMorphism's.
|
||||
(.&) ::
|
||||
forall
|
||||
(s :: S)
|
||||
(a :: [PLabeledType])
|
||||
(b :: [PLabeledType])
|
||||
(c :: [PLabeledType]).
|
||||
RecordMorphism s b c ->
|
||||
RecordMorphism s a b ->
|
||||
RecordMorphism s a c
|
||||
(.&) = (.)
|
||||
|
|
@ -7,7 +7,6 @@ Plutus Scripts for Stakes.
|
|||
-}
|
||||
module Agora.Stake.Scripts (stakePolicy, stakeValidator) where
|
||||
|
||||
import Agora.Record (mkRecordConstr, (.&), (.=))
|
||||
import Agora.SafeMoney (GTTag)
|
||||
import Agora.Stake
|
||||
import Agora.Utils (
|
||||
|
|
@ -39,6 +38,7 @@ import Plutarch.Api.V1 (
|
|||
mkMintingPolicy,
|
||||
)
|
||||
import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf, pvalueOf)
|
||||
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
|
||||
import Plutarch.Internal (punsafeCoerce)
|
||||
import Plutarch.Numeric.Additive (AdditiveMonoid (zero), AdditiveSemigroup ((+)))
|
||||
import Plutarch.SafeMoney (
|
||||
|
|
|
|||
14
flake.lock
generated
14
flake.lock
generated
|
|
@ -5219,11 +5219,11 @@
|
|||
"plutarch": "plutarch"
|
||||
},
|
||||
"locked": {
|
||||
"lastModified": 1653534226,
|
||||
"narHash": "sha256-rgSziKfQPajq7qAIehg+o8oS5QZkFdqGEP5+1oKXwxA=",
|
||||
"lastModified": 1653918532,
|
||||
"narHash": "sha256-qpPc6Sctp+VUc1GaE1w7U5qmVKQtDTXXYA6CEnz7Lmk=",
|
||||
"ref": "main",
|
||||
"rev": "636bdcf5f262fd90626a55e98a68b4c26bafe663",
|
||||
"revCount": 13,
|
||||
"rev": "4ec564be34a9445be65b47e80758164268773f91",
|
||||
"revCount": 16,
|
||||
"type": "git",
|
||||
"url": "ssh://git@github.com/Liqwid-Labs/liqwid-plutarch-extra"
|
||||
},
|
||||
|
|
@ -5876,11 +5876,11 @@
|
|||
},
|
||||
"nixpkgs-2111_5": {
|
||||
"locked": {
|
||||
"lastModified": 1653399365,
|
||||
"narHash": "sha256-uU80SquzngmRHSWDFvHazBD3JvckRYLbEYWPhZ18smA=",
|
||||
"lastModified": 1653830209,
|
||||
"narHash": "sha256-V+HnLKJzvk2HZcLUKt9z2puZ46vLo74chOakxbLfXek=",
|
||||
"owner": "NixOS",
|
||||
"repo": "nixpkgs",
|
||||
"rev": "2eb86322c17232ca01a50435e8bb2751e048ff3c",
|
||||
"rev": "cc257c49c495b2d0d7d40c5753a452d0abc8adf3",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue