Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Haskell Eq for AssocMap #6213

Merged
merged 8 commits into from
Jun 14, 2024
Merged

Haskell Eq for AssocMap #6213

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
65923fb
Revert "Remove AssocMap comparison instances (#6173)"
ana-pantilie Jun 14, 2024
609638a
Add custom Eq and Ord for AssocMap
ana-pantilie Jun 14, 2024
5a51f22
Remove PlutusTx instances
ana-pantilie Jun 14, 2024
3c475a6
Revert file delete
ana-pantilie Jun 14, 2024
bccc721
Fix
ana-pantilie Jun 14, 2024
811a554
Fix
ana-pantilie Jun 14, 2024
e45752f
Add changelog
ana-pantilie Jun 14, 2024
7c24fd1
Fix
ana-pantilie Jun 14, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion plutus-ledger-api/src/PlutusLedgerApi/V1/Contexts.hs
View file
Open in desktop
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
Open in desktop
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
Open in desktop
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
Open in desktop
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
Open in desktop
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
Copy link
Contributor

Choose a reason for hiding this comment

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

So, this will work as long as there are no duplicates in the assoc map.

Because of conversion of types from ledger this is guaranteed, but I am not sure if this is sufficient for you. I am just not sure what are the semantic guarantees that you provide. So, if in presence of duplicate keys assoc map ignores them then we are fine with this implementation, but otherwise we either need to fallback to a slow O(n^2) implementation or implement something smarter

Suggested change
on (Haskell.==) HMap.fromList l r
let lm = HMap.fromList l
rm = HMap.fromList r
lLen = length l
rLen = length r
in if lLen == rLen && lLen == HMap.size l && HMap.size r
then lm == rm
else sortOn fst l == sortOn fst 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