From fa260180b71f923fb199ceea7e530ce1286e0cba Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Wed, 28 Aug 2024 17:02:49 +0200 Subject: [PATCH] Deprecate valueFromList and valueToList. Add `IsList Value` --- .../internal/Cardano/Api/Experimental/Tx.hs | 4 ++-- cardano-api/internal/Cardano/Api/Tx/Body.hs | 15 +++++++++------ cardano-api/internal/Cardano/Api/Value.hs | 19 +++++++++++++------ .../internal/Cardano/Api/ValueParser.hs | 7 ++++--- .../Test/Golden/Cardano/Api/Value.hs | 5 +++-- .../Test/Golden/ErrorsSpec.hs | 2 +- 6 files changed, 32 insertions(+), 20 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Experimental/Tx.hs b/cardano-api/internal/Cardano/Api/Experimental/Tx.hs index 6cecdffcd..76566c0df 100644 --- a/cardano-api/internal/Cardano/Api/Experimental/Tx.hs +++ b/cardano-api/internal/Cardano/Api/Experimental/Tx.hs @@ -39,8 +39,8 @@ import Cardano.Ledger.Hashes import qualified Cardano.Ledger.Keys as L import qualified Cardano.Ledger.SafeHash as L -import qualified Data.Map.Strict as Map import qualified Data.Set as Set +import GHC.Exts (IsList (..)) import Lens.Micro -- | A transaction that can contain everything @@ -115,7 +115,7 @@ makeUnsignedTx era bc = obtainCommonConstraints era $ do scriptWitnesses = L.mkBasicTxWits & L.scriptTxWitsL - .~ Map.fromList + .~ fromList [ (L.hashScript sw, sw) | sw <- scripts ] diff --git a/cardano-api/internal/Cardano/Api/Tx/Body.hs b/cardano-api/internal/Cardano/Api/Tx/Body.hs index 6eec0fdd4..0e40356f0 100644 --- a/cardano-api/internal/Cardano/Api/Tx/Body.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Body.hs @@ -288,6 +288,7 @@ import qualified Data.Text as Text import Data.Type.Equality (TestEquality (..), (:~:) (Refl)) import Data.Word (Word16, Word32, Word64) import GHC.Exts (IsList (..)) +import GHC.Stack import Lens.Micro hiding (ix) import Lens.Micro.Extras (view) import qualified Text.Parsec as Parsec @@ -709,7 +710,8 @@ toByronTxOut = \case toShelleyTxOut :: forall era ledgerera - . ShelleyLedgerEra era ~ ledgerera + . HasCallStack + => ShelleyLedgerEra era ~ ledgerera => ShelleyBasedEra era -> TxOut CtxUTxO era -> Ledger.TxOut ledgerera @@ -959,12 +961,12 @@ instance IsShelleyBasedEra era => FromJSON (TxOutValue era) where decodeAssetId (polid, Aeson.Object assetNameHm) = do let polId = fromString . Text.unpack $ Aeson.toText polid aNameQuantity <- decodeAssets assetNameHm - pure . valueFromList $ + pure . fromList $ map (first $ AssetId polId) aNameQuantity decodeAssetId ("lovelace", Aeson.Number sci) = case toBoundedInteger sci of Just (ll :: Word64) -> - pure $ valueFromList [(AdaAssetId, Quantity $ toInteger ll)] + pure $ fromList [(AdaAssetId, Quantity $ toInteger ll)] Nothing -> fail $ "Expected a Bounded number but got: " <> show sci decodeAssetId wrong = fail $ "Expected a policy id and a JSON object but got: " <> show wrong @@ -1829,7 +1831,7 @@ outputDoesNotExceedMax -> TxOut CtxTx era -> Either TxBodyError () outputDoesNotExceedMax era v txout = - case [q | (_, q) <- valueToList v, q > maxTxOut] of + case [q | (_, q) <- toList v, q > maxTxOut] of [] -> Right () q : _ -> Left (TxBodyOutputOverflow q (txOutInAnyEra era txout)) @@ -1840,7 +1842,7 @@ positiveOutput -> TxOut CtxTx era -> Either TxBodyError () positiveOutput era v txout = - case [q | (_, q) <- valueToList v, q < 0] of + case [q | (_, q) <- toList v, q < 0] of [] -> Right () q : _ -> Left (TxBodyOutputNegative q (txOutInAnyEra era txout)) @@ -3057,7 +3059,8 @@ makeShelleyTransactionBody -- embedded datums (taking only their hash). toShelleyTxOutAny :: forall ctx era ledgerera - . ShelleyLedgerEra era ~ ledgerera + . HasCallStack + => ShelleyLedgerEra era ~ ledgerera => ShelleyBasedEra era -> TxOut ctx era -> Ledger.TxOut ledgerera diff --git a/cardano-api/internal/Cardano/Api/Value.hs b/cardano-api/internal/Cardano/Api/Value.hs index 695cfe7ec..819e7eb33 100644 --- a/cardano-api/internal/Cardano/Api/Value.hs +++ b/cardano-api/internal/Cardano/Api/Value.hs @@ -189,7 +189,7 @@ newtype Value = Value (Map AssetId Quantity) instance Show Value where showsPrec d v = showParen (d > 10) $ - showString "valueFromList " . shows (valueToList v) + showString "valueFromList " . shows (toList v) instance Semigroup Value where Value a <> Value b = Value (mergeAssetMaps a b) @@ -197,6 +197,14 @@ instance Semigroup Value where instance Monoid Value where mempty = Value Map.empty +instance IsList Value where + type Item Value = (AssetId, Quantity) + fromList = + Value + . Map.filter (/= 0) + . Map.fromListWith (<>) + toList (Value m) = toList m + {-# NOINLINE mergeAssetMaps #-} -- as per advice in Data.Map.Merge docs mergeAssetMaps :: Map AssetId Quantity @@ -223,14 +231,13 @@ instance FromJSON Value where selectAsset :: Value -> (AssetId -> Quantity) selectAsset (Value m) a = Map.findWithDefault mempty a m +{-# DEPRECATED valueFromList "Use 'fromList' instead." #-} valueFromList :: [(AssetId, Quantity)] -> Value -valueFromList = - Value - . Map.filter (/= 0) - . Map.fromListWith (<>) +valueFromList = fromList +{-# DEPRECATED valueToList "Use 'toList' instead." #-} valueToList :: Value -> [(AssetId, Quantity)] -valueToList (Value m) = toList m +valueToList = toList -- | This lets you write @a - b@ as @a <> negateValue b@. negateValue :: Value -> Value diff --git a/cardano-api/internal/Cardano/Api/ValueParser.hs b/cardano-api/internal/Cardano/Api/ValueParser.hs index fe3163cd4..ada6c83bf 100644 --- a/cardano-api/internal/Cardano/Api/ValueParser.hs +++ b/cardano-api/internal/Cardano/Api/ValueParser.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedLists #-} + module Cardano.Api.ValueParser ( parseValue , assetName @@ -34,9 +36,8 @@ evalValueExpr vExpr = case vExpr of ValueExprAdd x y -> evalValueExpr x <> evalValueExpr y ValueExprNegate x -> negateValue (evalValueExpr x) - ValueExprLovelace quant -> valueFromList [(AdaAssetId, quant)] - ValueExprMultiAsset polId aName quant -> - valueFromList [(AssetId polId aName, quant)] + ValueExprLovelace quant -> [(AdaAssetId, quant)] + ValueExprMultiAsset polId aName quant -> [(AssetId polId aName, quant)] ------------------------------------------------------------------------------ -- Expression parser diff --git a/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/Value.hs b/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/Value.hs index 3342921e1..9430e858a 100644 --- a/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/Value.hs +++ b/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/Value.hs @@ -11,6 +11,7 @@ import Data.Aeson (eitherDecode, encode) import Data.List (groupBy, sort) import qualified Data.Map.Strict as Map import qualified Data.Text as Text +import GHC.Exts (IsList (..)) import qualified Text.Parsec as Parsec (parse) import Test.Gen.Cardano.Api.Typed (genAssetName, genValueDefault, genValueNestedRep) @@ -47,7 +48,7 @@ hprop_goldenValue_1_lovelace :: Property hprop_goldenValue_1_lovelace = H.propertyOnce $ do valueList <- pure [(Api.AdaAssetId, 1)] - value <- pure $ Text.unpack $ Api.renderValuePretty $ Api.valueFromList valueList + value <- pure $ Text.unpack $ Api.renderValuePretty $ fromList valueList H.diffVsGoldenFile value "test/cardano-api-golden/files/golden/Cardano/Api/Value/value-ada-1.json" @@ -57,7 +58,7 @@ hprop_goldenValue1 = policyId <- pure $ Api.PolicyId "a0000000000000000000000000000000000000000000000000000000" assetName <- pure $ Api.AssetName "asset1" valueList <- pure [(Api.AssetId policyId assetName, 1)] - value <- pure $ Text.unpack $ Api.renderValuePretty $ Api.valueFromList valueList + value <- pure $ Text.unpack $ Api.renderValuePretty $ fromList valueList H.diffVsGoldenFile value diff --git a/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs b/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs index d0e24c40e..19cc09359 100644 --- a/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs +++ b/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs @@ -382,7 +382,7 @@ test_TxBodyErrorAutoBalance = , ("TxBodyErrorMinUTxONotMet", TxBodyErrorMinUTxONotMet txOutInAnyEra1 1) , ( "TxBodyErrorNonAdaAssetsUnbalanced" - , TxBodyErrorNonAdaAssetsUnbalanced (valueFromList [(AdaAssetId, Quantity 1)]) + , TxBodyErrorNonAdaAssetsUnbalanced (fromList [(AdaAssetId, Quantity 1)]) ) , ( "TxBodyErrorScriptWitnessIndexMissingFromExecUnitsMap"