From 5b8abe929df38ffd42e4b3cc71df132f1aa1a67a Mon Sep 17 00:00:00 2001 From: Yura Lazaryev Date: Wed, 6 Nov 2024 11:35:12 +0100 Subject: [PATCH] withCurrencySymbol --- .../src/PlutusLedgerApi/V1/Data/Value.hs | 37 ++++++++++---- .../src/PlutusLedgerApi/V1/Value.hs | 50 ++++++++++++------- .../9.6/currencySymbolValueOf.pir.golden | 4 +- .../9.6/currencySymbolValueOf.pir.golden | 4 +- 4 files changed, 61 insertions(+), 34 deletions(-) diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V1/Data/Value.hs b/plutus-ledger-api/src/PlutusLedgerApi/V1/Data/Value.hs index caff2a24787..254d5d876a7 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V1/Data/Value.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V1/Data/Value.hs @@ -50,6 +50,7 @@ module PlutusLedgerApi.V1.Data.Value ( , Value(..) , singleton , valueOf + , withCurrencySymbol , currencySymbolValueOf , lovelaceValue , lovelaceValueOf @@ -361,20 +362,34 @@ instance MeetSemiLattice Value where -- | Get the quantity of the given currency in the 'Value'. -- Assumes that the underlying map doesn't contain duplicate keys. valueOf :: Value -> CurrencySymbol -> TokenName -> Integer -valueOf (Value mp) cur tn = - case Map.lookup cur mp of - Nothing -> 0 - Just i -> case Map.lookup tn i of +valueOf value cur tn = + withCurrencySymbol cur value 0 \tokens -> + case Map.lookup tn tokens of Nothing -> 0 Just v -> v -{-# INLINABLE currencySymbolValueOf #-} --- | Get the total value of the currency symbol in the 'Value' map. --- Assumes that the underlying map doesn't contain duplicate keys. +{-# INLINEABLE withCurrencySymbol #-} + +{- | Apply a continuation function to the token quantities of the given currency +symbol in the value or return a default value if the currency symbol is not present +in the value. +-} +withCurrencySymbol :: CurrencySymbol -> Value -> a -> (Map TokenName Integer -> a) -> a +withCurrencySymbol currency value def k = + case Map.lookup currency (getValue value) of + Nothing -> def + Just tokenQuantities -> k tokenQuantities + +{-# INLINEABLE currencySymbolValueOf #-} + +{- | Get the total value of the currency symbol in the 'Value' map. +Assumes that the underlying map doesn't contain duplicate keys. + +Note that each token of the currency symbol may have a value that is positive, +zero or negative. +-} currencySymbolValueOf :: Value -> CurrencySymbol -> Integer -currencySymbolValueOf (Value mp) cur = case Map.lookup cur mp of - Nothing -> 0 - Just tokens -> +currencySymbolValueOf value cur = withCurrencySymbol cur value 0 \tokens -> -- This is more efficient than `PlutusTx.sum (Map.elems tokens)`, because -- the latter materializes the intermediate result of `Map.elems tokens`. Map.foldr (\amt acc -> amt + acc) 0 tokens @@ -402,7 +417,7 @@ lovelaceValueOf v = Lovelace (valueOf v adaSymbol adaToken) {-# INLINABLE assetClassValue #-} -- | A 'Value' containing the given amount of the asset class. assetClassValue :: AssetClass -> Integer -> Value -assetClassValue (AssetClass (c, t)) i = singleton c t i +assetClassValue (AssetClass (c, t)) = singleton c t {-# INLINABLE assetClassValueOf #-} -- | Get the quantity of the given 'AssetClass' class in the 'Value'. diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V1/Value.hs b/plutus-ledger-api/src/PlutusLedgerApi/V1/Value.hs index 2ce3301245a..2cd03a54f1a 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V1/Value.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V1/Value.hs @@ -46,6 +46,7 @@ module PlutusLedgerApi.V1.Value ( , Value(..) , singleton , valueOf + , withCurrencySymbol , currencySymbolValueOf , lovelaceValue , lovelaceValueOf @@ -353,26 +354,37 @@ instance MeetSemiLattice Value where -- | Get the quantity of the given currency in the 'Value'. -- Assumes that the underlying map doesn't contain duplicate keys. valueOf :: Value -> CurrencySymbol -> TokenName -> Integer -valueOf (Value mp) cur tn = - case Map.lookup cur mp of - Nothing -> 0 - Just i -> case Map.lookup tn i of - Nothing -> 0 - Just v -> v - -{-# INLINABLE currencySymbolValueOf #-} --- | Get the total value of the currency symbol in the 'Value' map. --- Assumes that the underlying map doesn't contain duplicate keys. --- --- Note that each token of the currency symbol may have a value that is positive, --- zero or negative. +valueOf value cur tn = + withCurrencySymbol cur value 0 \tokens -> + case Map.lookup tn tokens of + Nothing -> 0 + Just v -> v + +{-# INLINEABLE withCurrencySymbol #-} + +{- | Apply a continuation function to the token quantities of the given currency +symbol in the value or return a default value if the currency symbol is not present +in the value. +-} +withCurrencySymbol :: CurrencySymbol -> Value -> a -> (Map TokenName Integer -> a) -> a +withCurrencySymbol currency value def k = + case Map.lookup currency (getValue value) of + Nothing -> def + Just tokenQuantities -> k tokenQuantities + +{-# INLINEABLE currencySymbolValueOf #-} + +{- | Get the total value of the currency symbol in the 'Value' map. +Assumes that the underlying map doesn't contain duplicate keys. + +Note that each token of the currency symbol may have a value that is positive, +zero or negative. +-} currencySymbolValueOf :: Value -> CurrencySymbol -> Integer -currencySymbolValueOf (Value mp) cur = case Map.lookup cur mp of - Nothing -> 0 - Just tokens -> - -- This is more efficient than `PlutusTx.sum (Map.elems tokens)`, because - -- the latter materializes the intermediate result of `Map.elems tokens`. - PlutusTx.List.foldr (\(_, amt) acc -> amt + acc) 0 (Map.toList tokens) +currencySymbolValueOf value cur = withCurrencySymbol cur value 0 \tokens -> + -- This is more efficient than `PlutusTx.sum (Map.elems tokens)`, because + -- the latter materializes the intermediate result of `Map.elems tokens`. + PlutusTx.List.foldr (\(_, amt) acc -> amt + acc) 0 (Map.toList tokens) {-# INLINABLE symbols #-} -- | The list of 'CurrencySymbol's of a 'Value'. diff --git a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.pir.golden b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.pir.golden index b850a7c45a0..8da8925e8d2 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.pir.golden +++ b/plutus-ledger-api/test-plugin/Spec/Budget/9.6/currencySymbolValueOf.pir.golden @@ -31,7 +31,7 @@ let True : Bool False : Bool in -\(ds : +\(value : (\k v -> List (Tuple2 k v)) bytestring ((\k v -> List (Tuple2 k v)) bytestring integer)) @@ -76,4 +76,4 @@ in {all dead. dead})) {all dead. dead} in - go ds \ No newline at end of file + go value \ No newline at end of file diff --git a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.pir.golden b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.pir.golden index b63efc48ea5..9a00939539f 100644 --- a/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.pir.golden +++ b/plutus-ledger-api/test-plugin/Spec/Data/Budget/9.6/currencySymbolValueOf.pir.golden @@ -15,7 +15,7 @@ let Just : a -> Maybe a Nothing : Maybe a in -\(ds : +\(value : (\k a -> list (pair data data)) bytestring ((\k a -> list (pair data data)) bytestring integer)) @@ -45,7 +45,7 @@ in (/\dead -> go) {all dead. dead}) in - go ds) + go value) {integer} (\(a : data) -> let