Merge pull request #107 from Liqwid-Labs/seungheonoh/recordToExtra

Moved `Agora.Record` to `Plutarch.Extra.Record`

agora.cabal

@@ -145,7 +145,6 @@ library
     Agora.Proposal
     Agora.Proposal.Scripts
     Agora.Proposal.Time
-    Agora.Record
     Agora.SafeMoney
     Agora.ScriptInfo
     Agora.Stake

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
 
 --------------------------------------------------------------------------------
 

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))

agora/Agora/Record.hs

@@ -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
-(.&) = (.)

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 (

flake.lock

@@ -5219,11 +5219,11 @@
         "plutarch": "plutarch"
       },
       "locked": {
-        "lastModified": 1653534226,
+        "lastModified": 1653918532,
-        "narHash": "sha256-rgSziKfQPajq7qAIehg+o8oS5QZkFdqGEP5+1oKXwxA=",
+        "narHash": "sha256-qpPc6Sctp+VUc1GaE1w7U5qmVKQtDTXXYA6CEnz7Lmk=",
         "ref": "main",
-        "rev": "636bdcf5f262fd90626a55e98a68b4c26bafe663",
+        "rev": "4ec564be34a9445be65b47e80758164268773f91",
-        "revCount": 13,
+        "revCount": 16,
         "type": "git",
         "url": "ssh://git@github.com/Liqwid-Labs/liqwid-plutarch-extra"
       },
@@ -5876,11 +5876,11 @@
     },
     "nixpkgs-2111_5": {
       "locked": {
-        "lastModified": 1653399365,
+        "lastModified": 1653830209,
-        "narHash": "sha256-uU80SquzngmRHSWDFvHazBD3JvckRYLbEYWPhZ18smA=",
+        "narHash": "sha256-V+HnLKJzvk2HZcLUKt9z2puZ46vLo74chOakxbLfXek=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "2eb86322c17232ca01a50435e8bb2751e048ff3c",
+        "rev": "cc257c49c495b2d0d7d40c5753a452d0abc8adf3",
         "type": "github"
       },
       "original": {