From 9e3147c362df91f5b5c069234dea70b1f110b21a Mon Sep 17 00:00:00 2001 From: Ana Pantilie <45069775+ana-pantilie@users.noreply.github.com> Date: Fri, 14 Jun 2024 15:59:25 +0200 Subject: [PATCH] Haskell Eq for AssocMap (#6213) Signed-off-by: Ana Pantilie --- .../src/PlutusLedgerApi/V1/Contexts.hs | 2 +- .../src/PlutusLedgerApi/V2/Contexts.hs | 4 +-- .../src/PlutusLedgerApi/V3/Contexts.hs | 31 ++++++++++--------- ...154728_ana.pantilie95_add_haskell_sc_eq.md | 3 ++ plutus-tx/src/PlutusTx/AssocMap.hs | 10 ++++++ 5 files changed, 33 insertions(+), 17 deletions(-) create mode 100644 plutus-tx/changelog.d/20240614_154728_ana.pantilie95_add_haskell_sc_eq.md diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V1/Contexts.hs b/plutus-ledger-api/src/PlutusLedgerApi/V1/Contexts.hs index aee8b7a493d..fcfb0acaac1 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V1/Contexts.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V1/Contexts.hs @@ -82,7 +82,7 @@ data ScriptPurpose | Spending TxOutRef | Rewarding StakingCredential | Certifying DCert - deriving stock (Generic, Haskell.Show, Haskell.Eq) + deriving stock (Generic, Haskell.Show, Haskell.Eq, Haskell.Ord) deriving Pretty via (PrettyShow ScriptPurpose) instance Eq ScriptPurpose where diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V2/Contexts.hs b/plutus-ledger-api/src/PlutusLedgerApi/V2/Contexts.hs index d32fd7e10b6..5c9d774da3b 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V2/Contexts.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V2/Contexts.hs @@ -84,7 +84,7 @@ data TxInfo = TxInfo , txInfoData :: Map DatumHash Datum -- ^ The lookup table of datums attached to the transaction -- /V1->V2/: changed from assoc list to a 'PlutusTx.AssocMap' , txInfoId :: TxId -- ^ Hash of the pending transaction body (i.e. transaction excluding witnesses) - } deriving stock (Generic, Haskell.Show) + } deriving stock (Generic, Haskell.Show, Haskell.Eq) instance Pretty TxInfo where pretty TxInfo{txInfoInputs, txInfoReferenceInputs, txInfoOutputs, txInfoFee, txInfoMint, txInfoDCert, txInfoWdrl, txInfoValidRange, txInfoSignatories, txInfoRedeemers, txInfoData, txInfoId} = @@ -108,7 +108,7 @@ data ScriptContext = ScriptContext { scriptContextTxInfo :: TxInfo -- ^ information about the transaction the currently-executing script is included in , scriptContextPurpose :: ScriptPurpose -- ^ the purpose of the currently-executing script } - deriving stock (Generic, Haskell.Show) + deriving stock (Generic, Haskell.Eq, Haskell.Show) instance Pretty ScriptContext where pretty ScriptContext{scriptContextTxInfo, scriptContextPurpose} = diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V3/Contexts.hs b/plutus-ledger-api/src/PlutusLedgerApi/V3/Contexts.hs index 0fac2e88685..633aaad874b 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V3/Contexts.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V3/Contexts.hs @@ -68,6 +68,7 @@ newtype ColdCommitteeCredential = ColdCommitteeCredential V2.Credential deriving (Pretty) via (PrettyShow ColdCommitteeCredential) deriving newtype ( Haskell.Eq + , Haskell.Ord , Haskell.Show , PlutusTx.Eq , PlutusTx.ToData @@ -80,6 +81,7 @@ newtype HotCommitteeCredential = HotCommitteeCredential V2.Credential deriving (Pretty) via (PrettyShow HotCommitteeCredential) deriving newtype ( Haskell.Eq + , Haskell.Ord , Haskell.Show , PlutusTx.Eq , PlutusTx.ToData @@ -92,6 +94,7 @@ newtype DRepCredential = DRepCredential V2.Credential deriving (Pretty) via (PrettyShow DRepCredential) deriving newtype ( Haskell.Eq + , Haskell.Ord , Haskell.Show , PlutusTx.Eq , PlutusTx.ToData @@ -103,7 +106,7 @@ data DRep = DRep DRepCredential | DRepAlwaysAbstain | DRepAlwaysNoConfidence - deriving stock (Generic, Haskell.Show, Haskell.Eq) + deriving stock (Generic, Haskell.Show, Haskell.Eq, Haskell.Ord) deriving (Pretty) via (PrettyShow DRep) instance PlutusTx.Eq DRep where @@ -117,7 +120,7 @@ data Delegatee = DelegStake V2.PubKeyHash | DelegVote DRep | DelegStakeVote V2.PubKeyHash DRep - deriving stock (Generic, Haskell.Show, Haskell.Eq) + deriving stock (Generic, Haskell.Show, Haskell.Eq, Haskell.Ord) deriving (Pretty) via (PrettyShow Delegatee) instance PlutusTx.Eq Delegatee where @@ -155,7 +158,7 @@ data TxCert | -- | Authorize a Hot credential for a specific Committee member's cold credential TxCertAuthHotCommittee ColdCommitteeCredential HotCommitteeCredential | TxCertResignColdCommittee ColdCommitteeCredential - deriving stock (Generic, Haskell.Show, Haskell.Eq) + deriving stock (Generic, Haskell.Show, Haskell.Eq, Haskell.Ord) deriving (Pretty) via (PrettyShow TxCert) instance PlutusTx.Eq TxCert where @@ -184,7 +187,7 @@ data Voter = CommitteeVoter HotCommitteeCredential | DRepVoter DRepCredential | StakePoolVoter V2.PubKeyHash - deriving stock (Generic, Haskell.Show, Haskell.Eq) + deriving stock (Generic, Haskell.Show, Haskell.Eq, Haskell.Ord) deriving (Pretty) via (PrettyShow Voter) instance PlutusTx.Eq Voter where @@ -217,7 +220,7 @@ data GovernanceActionId = GovernanceActionId { gaidTxId :: V3.TxId , gaidGovActionIx :: Haskell.Integer } - deriving stock (Generic, Haskell.Show, Haskell.Eq) + deriving stock (Generic, Haskell.Show, Haskell.Eq, Haskell.Ord) instance Pretty GovernanceActionId where pretty GovernanceActionId{..} = @@ -237,7 +240,7 @@ data Committee = Committee , committeeQuorum :: PlutusTx.Rational -- ^ Quorum of the committee that is necessary for a successful vote } - deriving stock (Generic, Haskell.Show) + deriving stock (Generic, Haskell.Show, Haskell.Eq, Haskell.Ord) instance Pretty Committee where pretty Committee{..} = @@ -251,7 +254,7 @@ newtype Constitution = Constitution { constitutionScript :: Haskell.Maybe V2.ScriptHash } deriving stock (Generic) - deriving newtype (Haskell.Show, Haskell.Eq) + deriving newtype (Haskell.Show, Haskell.Eq, Haskell.Ord) instance Pretty Constitution where pretty (Constitution script) = "constitutionScript:" <+> pretty script @@ -264,7 +267,7 @@ data ProtocolVersion = ProtocolVersion { pvMajor :: Haskell.Integer , pvMinor :: Haskell.Integer } - deriving stock (Generic, Haskell.Show, Haskell.Eq) + deriving stock (Generic, Haskell.Show, Haskell.Eq, Haskell.Ord) instance Pretty ProtocolVersion where pretty ProtocolVersion{..} = @@ -317,7 +320,7 @@ data GovernanceAction Rational -- ^ New quorum | NewConstitution (Haskell.Maybe GovernanceActionId) Constitution | InfoAction - deriving stock (Generic, Haskell.Show) + deriving stock (Generic, Haskell.Show, Haskell.Eq, Haskell.Ord) deriving (Pretty) via (PrettyShow GovernanceAction) -- | A proposal procedure. The optional anchor is omitted. @@ -326,7 +329,7 @@ data ProposalProcedure = ProposalProcedure , ppReturnAddr :: V2.Credential , ppGovernanceAction :: GovernanceAction } - deriving stock (Generic, Haskell.Show) + deriving stock (Generic, Haskell.Show, Haskell.Eq, Haskell.Ord) instance Pretty ProposalProcedure where pretty ProposalProcedure{..} = @@ -350,7 +353,7 @@ data ScriptPurpose Haskell.Integer -- ^ 0-based index of the given `ProposalProcedure` in `txInfoProposalProcedures` ProposalProcedure - deriving stock (Generic, Haskell.Show) + deriving stock (Generic, Haskell.Show, Haskell.Eq, Haskell.Ord) deriving (Pretty) via (PrettyShow ScriptPurpose) -- | Like `ScriptPurpose` but with an optional datum for spending scripts. @@ -367,7 +370,7 @@ data ScriptInfo Haskell.Integer -- ^ 0-based index of the given `ProposalProcedure` in `txInfoProposalProcedures` ProposalProcedure - deriving stock (Generic, Haskell.Show) + deriving stock (Generic, Haskell.Show, Haskell.Eq) deriving (Pretty) via (PrettyShow ScriptInfo) -- | An input of a pending transaction. @@ -408,7 +411,7 @@ data TxInfo = TxInfo , txInfoCurrentTreasuryAmount :: Haskell.Maybe V2.Lovelace , txInfoTreasuryDonation :: Haskell.Maybe V2.Lovelace } - deriving stock (Generic, Haskell.Show) + deriving stock (Generic, Haskell.Show, Haskell.Eq) instance Pretty TxInfo where pretty TxInfo{..} = @@ -441,7 +444,7 @@ data ScriptContext = ScriptContext -- ^ the purpose of the currently-executing script, along with information associated -- with the purpose } - deriving stock (Generic, Haskell.Show) + deriving stock (Generic, Haskell.Eq, Haskell.Show) instance Pretty ScriptContext where pretty ScriptContext{..} = diff --git a/plutus-tx/changelog.d/20240614_154728_ana.pantilie95_add_haskell_sc_eq.md b/plutus-tx/changelog.d/20240614_154728_ana.pantilie95_add_haskell_sc_eq.md new file mode 100644 index 00000000000..ed8f020277c --- /dev/null +++ b/plutus-tx/changelog.d/20240614_154728_ana.pantilie95_add_haskell_sc_eq.md @@ -0,0 +1,3 @@ +### Added + +- Haskell `Eq` and `Ord` instances for `AssocMap` based on `Data.Map.Strict`. \ No newline at end of file diff --git a/plutus-tx/src/PlutusTx/AssocMap.hs b/plutus-tx/src/PlutusTx/AssocMap.hs index 2e7c32c7163..79c5b694eff 100644 --- a/plutus-tx/src/PlutusTx/AssocMap.hs +++ b/plutus-tx/src/PlutusTx/AssocMap.hs @@ -49,6 +49,8 @@ import PlutusTx.These import Control.DeepSeq (NFData) import Data.Data +import Data.Function (on) +import Data.Map.Strict qualified as HMap import GHC.Generics (Generic) import Language.Haskell.TH.Syntax as TH (Lift) import Prettyprinter (Pretty (..)) @@ -73,6 +75,14 @@ newtype Map k v = Map {unMap :: [(k, v)]} deriving stock (Generic, Haskell.Show, Data, TH.Lift) deriving newtype (NFData) +instance (Haskell.Ord k, Haskell.Eq v) => Haskell.Eq (Map k v) where + Map l == Map r = + on (Haskell.==) HMap.fromList l r + +instance (Haskell.Ord k, Haskell.Ord v) => Haskell.Ord (Map k v) where + Map l <= Map r = + on (Haskell.<=) HMap.fromList l r + -- | Hand-written instances to use the underlying 'Map' type in 'Data', and -- to be reasonably efficient. instance (ToData k, ToData v) => ToData (Map k v) where