From 20e4f56e104c24dabf3223c5f826dc187d275136 Mon Sep 17 00:00:00 2001 From: Seungheon Oh Date: Mon, 30 May 2022 09:02:07 -0500 Subject: [PATCH] Moved `Agora.Record` to `Plutarch.Extra.Record` Since `Agora.Record` provides a general utility for easy construction of Plutarch record types, they can be moved to `liqwid-plutarch-extra` to be used abroad. --- agora.cabal | 1 - agora/Agora/Governor/Scripts.hs | 2 +- agora/Agora/Proposal/Scripts.hs | 2 +- agora/Agora/Record.hs | 108 -------------------------------- agora/Agora/Stake/Scripts.hs | 2 +- flake.lock | 14 ++--- 6 files changed, 10 insertions(+), 119 deletions(-) delete mode 100644 agora/Agora/Record.hs diff --git a/agora.cabal b/agora.cabal index ac9e215..16b9ffb 100644 --- a/agora.cabal +++ b/agora.cabal @@ -145,7 +145,6 @@ library Agora.Proposal Agora.Proposal.Scripts Agora.Proposal.Time - Agora.Record Agora.SafeMoney Agora.ScriptInfo Agora.Stake diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index 9e3b891..dacef86 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -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 -------------------------------------------------------------------------------- diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index 95a8266..af040d1 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -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)) diff --git a/agora/Agora/Record.hs b/agora/Agora/Record.hs deleted file mode 100644 index 30d7490..0000000 --- a/agora/Agora/Record.hs +++ /dev/null @@ -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 -(.&) = (.) diff --git a/agora/Agora/Stake/Scripts.hs b/agora/Agora/Stake/Scripts.hs index 7081ee2..049235c 100644 --- a/agora/Agora/Stake/Scripts.hs +++ b/agora/Agora/Stake/Scripts.hs @@ -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 ( diff --git a/flake.lock b/flake.lock index 5152d02..2956692 100644 --- a/flake.lock +++ b/flake.lock @@ -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": {