Deprecate valueFromList and valueToList. Add IsList Value

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
               ]

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

cardano-api/internal/Cardano/Api/Value.hs

@@ -189,14 +189,22 @@ 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)
 
 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

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

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

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"