Use IsList(toList,fromList) instead of specialised functions

IntersectMBO · Aug 6, 2024 · 7e9fcb7 · 7e9fcb7
1 parent 3d000e0
commit 7e9fcb7
Show file tree

Hide file tree

Showing 24 changed files with 118 additions and 113 deletions.
diff --git a/cardano-api/gen/Test/Gen/Cardano/Api.hs b/cardano-api/gen/Test/Gen/Cardano/Api.hs
@@ -20,6 +20,7 @@ import           Cardano.Ledger.Shelley.TxAuxData (Metadatum (..), ShelleyTxAuxD
 
 import qualified Data.Map.Strict as Map
 import           Data.Word (Word64)
+import           GHC.Exts (IsList (..))
 
 import           Test.Gen.Cardano.Api.Typed (genCostModel, genRational)
 
@@ -32,7 +33,7 @@ genMetadata = do
   numberOfIndices <- Gen.integral (Range.linear 1 15)
   let indices = map (\i -> fromIntegral i :: Word64) [1 .. numberOfIndices]
   mData <- Gen.list (Range.singleton numberOfIndices) genMetadatum
-  return . ShelleyTxAuxData . Map.fromList $ zip indices mData
+  return . ShelleyTxAuxData . fromList $ zip indices mData
 
 genMetadatum :: Gen Metadatum
 genMetadatum = do

diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Metadata.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Metadata.hs
@@ -15,11 +15,11 @@ import qualified Data.Aeson.Key as Aeson
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base16 as Base16
-import qualified Data.Map.Strict as Map
 import           Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 import           Data.Word (Word64)
+import           GHC.Exts (IsList (..))
 
 import           Hedgehog (Gen)
 import qualified Hedgehog.Gen as Gen
@@ -36,8 +36,7 @@ genJsonForTxMetadata mapping =
     Aeson.object
       <$> Gen.list
         (Range.linear 0 (fromIntegral sz))
-        ( (,)
-            <$> (Aeson.fromString . show <$> Gen.word64 Range.constantBounded)
+        ( ((,) . Aeson.fromString . show <$> Gen.word64 Range.constantBounded)
             <*> genJsonForTxMetadataValue mapping
         )
 
@@ -167,7 +166,7 @@ genJsonForTxMetadataValue TxMetadataJsonDetailedSchema = genJsonValue
 genTxMetadata :: Gen TxMetadata
 genTxMetadata =
   Gen.sized $ \sz ->
-    TxMetadata . Map.fromList
+    TxMetadata . fromList
       <$> Gen.list
         (Range.linear 0 (fromIntegral sz))
         ( (,)

diff --git a/cardano-api/internal/Cardano/Api/Certificate.hs b/cardano-api/internal/Cardano/Api/Certificate.hs
@@ -97,8 +97,6 @@ import           Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import           Data.IP (IPv4, IPv6)
 import           Data.Maybe
-import qualified Data.Sequence.Strict as Seq
-import qualified Data.Set as Set
 import           Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
@@ -610,10 +608,10 @@ toShelleyPoolParams
             (Ledger.boundRational stakePoolMargin)
       , Ledger.ppRewardAccount = toShelleyStakeAddr stakePoolRewardAccount
       , Ledger.ppOwners =
-          Set.fromList
+          fromList
             [kh | StakeKeyHash kh <- stakePoolOwners]
       , Ledger.ppRelays =
-          Seq.fromList
+          fromList
             (map toShelleyStakePoolRelay stakePoolRelays)
       , Ledger.ppMetadata =
           toShelleyPoolMetadata

diff --git a/cardano-api/internal/Cardano/Api/Convenience/Construction.hs b/cardano-api/internal/Cardano/Api/Convenience/Construction.hs
@@ -32,9 +32,9 @@ import qualified Cardano.Ledger.Keys as L
 import qualified Data.List as List
 import qualified Data.Map.Strict as Map
 import           Data.Set (Set)
-import qualified Data.Set as Set
 import           Data.Text (Text)
 import qualified Data.Text as Text
+import           GHC.Exts (IsList (..))
 
 -- | Construct a balanced transaction.
 -- See Cardano.Api.Convenience.Query.queryStateForBalancedTx for a
@@ -120,7 +120,7 @@ renderNotScriptLockedTxInsError (ScriptLockedTxIns txins) =
 
 notScriptLockedTxIns :: [TxIn] -> UTxO era -> Either ScriptLockedTxInsError ()
 notScriptLockedTxIns collTxIns (UTxO utxo) = do
-  let onlyCollateralUTxOs = Map.restrictKeys utxo $ Set.fromList collTxIns
+  let onlyCollateralUTxOs = Map.restrictKeys utxo $ fromList collTxIns
       scriptLockedTxIns =
         filter (\(_, TxOut aInEra _ _ _) -> not $ isKeyAddress aInEra) $ Map.assocs onlyCollateralUTxOs
   if null scriptLockedTxIns

diff --git a/cardano-api/internal/Cardano/Api/Convenience/Query.hs b/cardano-api/internal/Cardano/Api/Convenience/Query.hs
@@ -54,9 +54,8 @@ import           Data.Map (Map)
 import qualified Data.Map as Map
 import           Data.Maybe (mapMaybe)
 import           Data.Set (Set)
-import qualified Data.Set as Set
 import           Data.Text (Text)
-import           GHC.Exts (IsString (..))
+import           GHC.Exts (IsList (..), IsString (..))
 
 data QueryConvenienceError
   = AcqFailure AcquiringFailure
@@ -122,12 +121,12 @@ queryStateForBalancedTx era allTxIns certs = runExceptT $ do
     requireShelleyBasedEra era
       & onNothing (left ByronEraNotSupported)
 
-  let stakeCreds = Set.fromList $ mapMaybe filterUnRegCreds certs
-      drepCreds = Set.fromList $ mapMaybe filterUnRegDRepCreds certs
+  let stakeCreds = fromList $ mapMaybe filterUnRegCreds certs
+      drepCreds = fromList $ mapMaybe filterUnRegDRepCreds certs
 
   -- Query execution
   utxo <-
-    lift (queryUtxo sbe (QueryUTxOByTxIn (Set.fromList allTxIns)))
+    lift (queryUtxo sbe (QueryUTxOByTxIn (fromList allTxIns)))
       & onLeft (left . QceUnsupportedNtcVersion)
       & onLeft (left . QueryEraMismatch)
 

diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs
@@ -715,7 +715,7 @@ evaluateTransactionExecutionUnitsShelley sbe systemstart epochInfo (LedgerProtoc
         (Either (L.TransactionScriptFailure (ShelleyLedgerEra era)) (EvalTxExecutionUnitsLog, Alonzo.ExUnits))
     -> Map ScriptWitnessIndex (Either ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))
   fromLedgerScriptExUnitsMap aOnwards exmap =
-    Map.fromList
+    fromList
       [ ( toScriptIndex aOnwards rdmrptr
         , bimap (fromAlonzoScriptExecutionError aOnwards) (second fromAlonzoExUnits) exunitsOrFailure
         )
@@ -1349,7 +1349,7 @@ createFakeUTxO sbe txbodycontent totalAdaInUTxO =
             txOuts txbodycontent
    in -- Take one txin and one txout. Replace the out value with totalAdaInUTxO
       -- Return an empty UTxO if there are no txins or txouts
-      UTxO $ Map.fromList $ zip singleTxIn singleTxOut
+      UTxO $ fromList $ zip singleTxIn singleTxOut
 
 updateTxOut :: ShelleyBasedEra era -> Coin -> TxOut CtxUTxO era -> TxOut CtxUTxO era
 updateTxOut sbe updatedValue txout =
@@ -1567,7 +1567,7 @@ substituteExecutionUnits
 
       return $
         Just
-          (Featured era (TxVotingProcedures vProcedures (BuildTxWith $ Map.fromList substitutedExecutionUnits)))
+          (Featured era (TxVotingProcedures vProcedures (BuildTxWith $ fromList substitutedExecutionUnits)))
 
     mapScriptWitnessesProposals
       :: Maybe (Featured ConwayEraOnwards era (TxProposalProcedures build era))
@@ -1592,7 +1592,7 @@ substituteExecutionUnits
         Just
           ( Featured
               era
-              (TxProposalProcedures osetProposalProcedures (BuildTxWith $ Map.fromList substitutedExecutionUnits))
+              (TxProposalProcedures osetProposalProcedures (BuildTxWith $ fromList substitutedExecutionUnits))
           )
 
     mapScriptWitnessesMinting
@@ -1605,7 +1605,7 @@ substituteExecutionUnits
           value
           (BuildTxWith witnesses)
         ) =
-        -- TxMintValue supported value $ BuildTxWith $ Map.fromList
+        -- TxMintValue supported value $ BuildTxWith $ fromList
         let mappedScriptWitnesses
               :: [(PolicyId, Either (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxMint era))]
             mappedScriptWitnesses =
@@ -1619,7 +1619,7 @@ substituteExecutionUnits
          in do
               final <- traverseScriptWitnesses mappedScriptWitnesses
               Right . TxMintValue supported value . BuildTxWith $
-                Map.fromList final
+                fromList final
 
 traverseScriptWitnesses
   :: [(a, Either (TxBodyErrorAutoBalance era) (ScriptWitness ctx era))]

diff --git a/cardano-api/internal/Cardano/Api/Governance/Poll.hs b/cardano-api/internal/Cardano/Api/Governance/Poll.hs
@@ -68,6 +68,7 @@ import qualified Data.Text.Lazy as Text.Lazy
 import qualified Data.Text.Lazy.Builder as Text.Builder
 import           Data.Word (Word64)
 import           Formatting (build, sformat)
+import           GHC.Exts (IsList (..))
 
 -- | Associated metadata label as defined in CIP-0094
 pollMetadataLabel :: Word64
@@ -124,7 +125,7 @@ instance HasTypeProxy GovernancePoll where
 instance AsTxMetadata GovernancePoll where
   asTxMetadata GovernancePoll{govPollQuestion, govPollAnswers, govPollNonce} =
     makeTransactionMetadata $
-      Map.fromList
+      fromList
         [
           ( pollMetadataLabel
           , TxMetaMap $
@@ -220,7 +221,7 @@ instance HasTypeProxy GovernancePollAnswer where
 instance AsTxMetadata GovernancePollAnswer where
   asTxMetadata GovernancePollAnswer{govAnsPoll, govAnsChoice} =
     makeTransactionMetadata $
-      Map.fromList
+      fromList
         [
           ( pollMetadataLabel
           , TxMetaMap

diff --git a/cardano-api/internal/Cardano/Api/LedgerState.hs b/cardano-api/internal/Cardano/Api/LedgerState.hs
@@ -199,7 +199,7 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base16 as Base16
 import qualified Data.ByteString.Lazy as LBS
 import           Data.ByteString.Short as BSS
-import           Data.Foldable
+import           Data.Foldable (asum)
 import           Data.IORef
 import qualified Data.List as List
 import           Data.Map.Strict (Map)
@@ -219,6 +219,7 @@ import           Data.Text.Lazy.Builder (toLazyText)
 import           Data.Word
 import qualified Data.Yaml as Yaml
 import           Formatting.Buildable (build)
+import           GHC.Exts (IsList (..))
 import           Lens.Micro
 import           Network.TypedProtocol.Pipelined (Nat (..))
 import           System.FilePath
@@ -1885,7 +1886,7 @@ nextEpochEligibleLeadershipSlots sbe sGen serCurrEpochState ptclState poolid (Vr
         slotRangeOfInterest pp' =
           Set.filter
             (not . Ledger.isOverlaySlot firstSlotOfEpoch (pp' ^. Core.ppDG))
-            $ Set.fromList [firstSlotOfEpoch .. lastSlotofEpoch]
+            $ fromList [firstSlotOfEpoch .. lastSlotofEpoch]
 
     caseShelleyToAlonzoOrBabbageEraOnwards
       ( const
@@ -1999,7 +2000,7 @@ currentEpochEligibleLeadershipSlots sbe sGen eInfo pp ptclState poolid (VrfSigni
         slotRangeOfInterest pp' =
           Set.filter
             (not . Ledger.isOverlaySlot firstSlotOfEpoch (pp' ^. Core.ppDG))
-            $ Set.fromList [firstSlotOfEpoch .. lastSlotofEpoch]
+            $ fromList [firstSlotOfEpoch .. lastSlotofEpoch]
 
     caseShelleyToAlonzoOrBabbageEraOnwards
       ( const

diff --git a/cardano-api/internal/Cardano/Api/Orphans.hs b/cardano-api/internal/Cardano/Api/Orphans.hs
@@ -86,11 +86,14 @@ import qualified Data.ByteString.Base16 as Base16
 import qualified Data.ByteString.Short as SBS
 import           Data.Data (Data)
 import           Data.Kind (Constraint, Type)
+import           Data.ListMap (ListMap)
+import qualified Data.ListMap as ListMap
 import           Data.Maybe.Strict (StrictMaybe (..))
 import           Data.Monoid
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as Text
 import           Data.Typeable (Typeable)
+import           GHC.Exts (IsList (..))
 import           GHC.Generics
 import           GHC.Stack (HasCallStack)
 import           GHC.TypeLits
@@ -571,3 +574,9 @@ parsePlutusParamName t =
     Nothing -> fail $ "Cannot parse cost model parameter name: " <> T.unpack t
 
 deriving instance Show V2.ParamName
+
+-- TODO upstream to cardano-ledger
+instance IsList (ListMap k a) where
+  type Item (ListMap k a) = (k, a)
+  fromList = ListMap.fromList
+  toList = ListMap.toList
diff --git a/cardano-api/internal/Cardano/Api/ProtocolParameters.hs b/cardano-api/internal/Cardano/Api/ProtocolParameters.hs
@@ -18,9 +18,9 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 
-{- HLINT ignore "Redundant ==" -}
-{- HLINT ignore "Use mapM" -}
+{-# HLINT ignore "Redundant ==" #-}
 
 -- | The various Cardano protocol parameters, including:
 --
@@ -1016,7 +1016,7 @@ toAlonzoCostModels
   -> Either ProtocolParametersConversionError Alonzo.CostModels
 toAlonzoCostModels m = do
   f <- mapM conv $ toList m
-  Right $ Plutus.mkCostModels $ Map.fromList f
+  Right $ Plutus.mkCostModels $ fromList f
  where
   conv
     :: (AnyPlutusScriptVersion, CostModel)
@@ -1029,7 +1029,7 @@ fromAlonzoCostModels
   :: Plutus.CostModels
   -> Map AnyPlutusScriptVersion CostModel
 fromAlonzoCostModels cModels =
-  Map.fromList
+  fromList
     . map (bimap fromAlonzoScriptLanguage fromAlonzoCostModel)
     $ toList
     $ Plutus.costModelsValid cModels
@@ -1091,7 +1091,7 @@ makeShelleyUpdateProposal params genesisKeyHashes =
   -- TODO decide how to handle parameter validation
   --     for example we need to validate the Rational values can convert
   --     into the UnitInterval type ok.
-  UpdateProposal (Map.fromList [(kh, params) | kh <- genesisKeyHashes])
+  UpdateProposal (fromList [(kh, params) | kh <- genesisKeyHashes])
 
 -- ----------------------------------------------------------------------------
 -- Conversion functions: updates to ledger types

diff --git a/cardano-api/internal/Cardano/Api/Query.hs b/cardano-api/internal/Cardano/Api/Query.hs
@@ -380,7 +380,7 @@ instance
   parseJSON = withObject "UTxO" $ \hm -> do
     let l = toList $ KeyMap.toHashMapText hm
     res <- mapM toTxIn l
-    pure . UTxO $ Map.fromList res
+    pure . UTxO $ fromList res
    where
     toTxIn :: (Text, Aeson.Value) -> Parser (TxIn, TxOut CtxUTxO era)
     toTxIn (txinText, txOutVal) = do
@@ -473,7 +473,7 @@ toShelleyAddrSet
   -> Set AddressAny
   -> Set (Shelley.Addr Consensus.StandardCrypto)
 toShelleyAddrSet era =
-  Set.fromList
+  fromList
     . map toShelleyAddr
     -- Ignore any addresses that are not appropriate for the era,
     -- e.g. Shelley addresses in the Byron era, as these would not
@@ -489,7 +489,7 @@ toLedgerUTxO
 toLedgerUTxO sbe (UTxO utxo) =
   shelleyBasedEraConstraints sbe
     $ Shelley.UTxO
-      . Map.fromList
+      . fromList
       . map (bimap toShelleyTxIn (toShelleyTxOut sbe))
       . toList
     $ utxo
@@ -502,7 +502,7 @@ fromLedgerUTxO
 fromLedgerUTxO sbe (Shelley.UTxO utxo) =
   shelleyBasedEraConstraints sbe
     $ UTxO
-      . Map.fromList
+      . fromList
       . map (bimap fromShelleyTxIn (fromShelleyTxOut sbe))
       . toList
     $ utxo
@@ -513,7 +513,7 @@ fromShelleyPoolDistr
 fromShelleyPoolDistr =
   -- TODO: write an appropriate property to show it is safe to use
   -- Map.fromListAsc or to use Map.mapKeysMonotonic
-  Map.fromList
+  fromList
     . map (bimap StakePoolKeyHash Consensus.individualPoolStake)
     . toList
     . Consensus.unPoolDistr
@@ -528,7 +528,7 @@ fromShelleyDelegations =
   -- Map.fromListAsc or to use Map.mapKeysMonotonic
   -- In this case it may not be: the Ord instances for Shelley.Credential
   -- do not match the one for StakeCredential
-  Map.fromList
+  fromList
     . map (bimap fromShelleyStakeCredential StakePoolKeyHash)
     . toList
 
@@ -538,7 +538,7 @@ fromShelleyRewardAccounts
 fromShelleyRewardAccounts =
   -- TODO: write an appropriate property to show it is safe to use
   -- Map.fromListAsc or to use Map.mapKeysMonotonic
-  Map.fromList
+  fromList
     . map (first fromShelleyStakeCredential)
     . toList
 

diff --git a/cardano-api/internal/Cardano/Api/Rewards.hs b/cardano-api/internal/Cardano/Api/Rewards.hs
@@ -14,7 +14,6 @@ import qualified Data.Aeson.Types as Aeson
 import           Data.List (nub)
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
-import qualified Data.Vector as Vector
 import           GHC.Exts (IsList (..))
 
 -- | A mapping of Shelley reward accounts to both the stake pool that they
@@ -27,7 +26,7 @@ newtype DelegationsAndRewards
 instance ToJSON DelegationsAndRewards where
   toJSON delegsAndRwds =
     Aeson.Array
-      . Vector.fromList
+      . fromList
       . map delegAndRwdToJson
       $ mergeDelegsAndRewards delegsAndRwds
    where