Skip to content

Commit

Permalink
Haskell Eq for AssocMap (#6213)
Browse files Browse the repository at this point in the history 
Signed-off-by: Ana Pantilie <[email protected]>
  • Loading branch information
@ana-pantilie
ana-pantilie committed Jun 14, 2024
1 parent 72fa971 commit 9e3147c
Show file tree
Hide file tree
Showing 5 changed files with 33 additions and 17 deletions.
2 changes: 1 addition & 1 deletion plutus-ledger-api/src/PlutusLedgerApi/V1/Contexts.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions plutus-ledger-api/src/PlutusLedgerApi/V2/Contexts.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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} =
Expand All @@ -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} =
Expand Down
31 changes: 17 additions & 14 deletions plutus-ledger-api/src/PlutusLedgerApi/V3/Contexts.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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{..} =
Expand All @@ -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{..} =
Expand All @@ -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
Expand All @@ -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{..} =
Expand Down Expand Up @@ -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.
Expand All @@ -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{..} =
Expand All @@ -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.
Expand All @@ -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.
Expand Down Expand Up @@ -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{..} =
Expand Down Expand Up @@ -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{..} =
Expand Down
3 changes: 3 additions & 0 deletions plutus-tx/changelog.d/20240614_154728_ana.pantilie95_add_haskell_sc_eq.md
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
### Added

- Haskell `Eq` and `Ord` instances for `AssocMap` based on `Data.Map.Strict`.
10 changes: 10 additions & 0 deletions plutus-tx/src/PlutusTx/AssocMap.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..))
Expand All @@ -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
Expand Down

1 comment on commit 9e3147c

@github-actions
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

⚠️ Performance Alert ⚠️

Possible performance regression was detected for benchmark 'Plutus Benchmarks'.
Benchmark result of this commit is worse than the previous benchmark result exceeding threshold 1.05.

Benchmark suite Current: 9e3147c Previous: 72fa971 Ratio
validation-decode-uniswap-1 243.1 μs 230.6 μs 1.05
marlowe-semantics/1f0f02191604101e1f201016171604060d010d1d1c150e110a110e1006160a0d 1031 μs 980.3 μs 1.05

This comment was automatically generated by workflow using github-action-benchmark.

CC: @IntersectMBO/plutus-core

Please sign in to comment.