{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}

module PlutusCore.Value
  ( Value -- Do not expose data constructor
  , K -- Do not expose data constructor
  , k
  , unK
  , maxKeyLen
  , Quantity -- Do not expose data constructor
  , quantity
  , unQuantity
  , zeroQuantity
  , addQuantity
  , negativeAmounts
  , NestedMap
  , unpack
  , pack
  , empty
  , fromList
  , toList
  , toFlatList
  , totalSize
  , maxInnerSize
  , insertCoin
  , deleteCoin
  , scaleValue
  , lookupCoin
  , valueContains
  , unionValue
  , valueData
  , unValueData
  ) where

import Codec.Serialise qualified as CBOR
import Control.DeepSeq (NFData)
import Data.Bifunctor
import Data.Bitraversable
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.ByteString.Base64 qualified as Base64
import Data.Foldable (find)
import Data.Hashable (Hashable (..))
import Data.IntMap.Strict (IntMap)
import Data.IntMap.Strict qualified as IntMap
import Data.Map.Merge.Strict qualified as M
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Text.Encoding qualified as Text
import GHC.Generics
import GHC.Stack
  ( HasCallStack
  , callStack
  , getCallStack
  )

import PlutusCore.Builtin.Result
import PlutusCore.Data (Data (..))
import PlutusCore.Flat qualified as Flat
import PlutusPrelude (Pretty (..))

-- Max length (in bytes) for currency symbols and token names in `Value`,
-- both of which cannot exceed 32 bytes. Currency symbols are in fact either
-- empty or 28 bytes, but for simplicity we allow anything between 0 and 32 bytes.
maxKeyLen :: Int
maxKeyLen :: Int
maxKeyLen = Int
32
{-# INLINE maxKeyLen #-}

----------------------------------------------------------------------------------------------------
-- Newtype-wrapper for keys used in the nested maps ------------------------------------------------

-- | A `ByteString` with maximum length of `maxKeyLen` bytes.
newtype K = UnsafeK {K -> ByteString
unK :: ByteString}
  deriving newtype (K -> K -> Bool
(K -> K -> Bool) -> (K -> K -> Bool) -> Eq K
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: K -> K -> Bool
== :: K -> K -> Bool
$c/= :: K -> K -> Bool
/= :: K -> K -> Bool
Eq, Eq K
Eq K =>
(K -> K -> Ordering)
-> (K -> K -> Bool)
-> (K -> K -> Bool)
-> (K -> K -> Bool)
-> (K -> K -> Bool)
-> (K -> K -> K)
-> (K -> K -> K)
-> Ord K
K -> K -> Bool
K -> K -> Ordering
K -> K -> K
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: K -> K -> Ordering
compare :: K -> K -> Ordering
$c< :: K -> K -> Bool
< :: K -> K -> Bool
$c<= :: K -> K -> Bool
<= :: K -> K -> Bool
$c> :: K -> K -> Bool
> :: K -> K -> Bool
$c>= :: K -> K -> Bool
>= :: K -> K -> Bool
$cmax :: K -> K -> K
max :: K -> K -> K
$cmin :: K -> K -> K
min :: K -> K -> K
Ord, Int -> K -> ShowS
[K] -> ShowS
K -> String
(Int -> K -> ShowS) -> (K -> String) -> ([K] -> ShowS) -> Show K
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> K -> ShowS
showsPrec :: Int -> K -> ShowS
$cshow :: K -> String
show :: K -> String
$cshowList :: [K] -> ShowS
showList :: [K] -> ShowS
Show, Eq K
Eq K => (Int -> K -> Int) -> (K -> Int) -> Hashable K
Int -> K -> Int
K -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> K -> Int
hashWithSalt :: Int -> K -> Int
$chash :: K -> Int
hash :: K -> Int
Hashable, K -> ()
(K -> ()) -> NFData K
forall a. (a -> ()) -> NFData a
$crnf :: K -> ()
rnf :: K -> ()
NFData)
  deriving stock ((forall x. K -> Rep K x) -> (forall x. Rep K x -> K) -> Generic K
forall x. Rep K x -> K
forall x. K -> Rep K x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. K -> Rep K x
from :: forall x. K -> Rep K x
$cto :: forall x. Rep K x -> K
to :: forall x. Rep K x -> K
Generic)

k :: ByteString -> Maybe K
k :: ByteString -> Maybe K
k ByteString
b = if ByteString -> Int
B.length ByteString
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxKeyLen then K -> Maybe K
forall a. a -> Maybe a
Just (ByteString -> K
UnsafeK ByteString
b) else Maybe K
forall a. Maybe a
Nothing
{-# INLINEABLE k #-}

instance Flat.Flat K where
  encode :: K -> Encoding
encode (UnsafeK ByteString
b) = ByteString -> Encoding
forall a. Flat a => a -> Encoding
Flat.encode ByteString
b
  {-# INLINE encode #-}
  decode :: Get K
decode = do
    ByteString
b <- Get ByteString
forall a. Flat a => Get a
Flat.decode
    Get K -> (K -> Get K) -> Maybe K -> Get K
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Get K
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get K) -> String -> Get K
forall a b. (a -> b) -> a -> b
$ String
"Invalid Value key: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Word8] -> String
forall a. Show a => a -> String
show (ByteString -> [Word8]
B.unpack ByteString
b)) K -> Get K
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe K
k ByteString
b)
  {-# INLINEABLE decode #-}

instance CBOR.Serialise K where
  encode :: K -> Encoding
encode (UnsafeK ByteString
b) = ByteString -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode ByteString
b
  {-# INLINE encode #-}
  decode :: forall s. Decoder s K
decode = do
    ByteString
b <- Decoder s ByteString
forall s. Decoder s ByteString
forall a s. Serialise a => Decoder s a
CBOR.decode
    Decoder s K -> (K -> Decoder s K) -> Maybe K -> Decoder s K
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Decoder s K
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s K) -> String -> Decoder s K
forall a b. (a -> b) -> a -> b
$ String
"Invalid Value key: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Word8] -> String
forall a. Show a => a -> String
show (ByteString -> [Word8]
B.unpack ByteString
b)) K -> Decoder s K
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe K
k ByteString
b)
  {-# INLINEABLE decode #-}

----------------------------------------------------------------------------------------------------
-- Quantity: Signed 128-bit Integer ----------------------------------------------------------------

-- | A signed 128-bit integer quantity.
newtype Quantity = UnsafeQuantity {Quantity -> Integer
unQuantity :: Integer}
  deriving newtype (Quantity -> Quantity -> Bool
(Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Bool) -> Eq Quantity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Quantity -> Quantity -> Bool
== :: Quantity -> Quantity -> Bool
$c/= :: Quantity -> Quantity -> Bool
/= :: Quantity -> Quantity -> Bool
Eq, Eq Quantity
Eq Quantity =>
(Quantity -> Quantity -> Ordering)
-> (Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Bool)
-> (Quantity -> Quantity -> Quantity)
-> (Quantity -> Quantity -> Quantity)
-> Ord Quantity
Quantity -> Quantity -> Bool
Quantity -> Quantity -> Ordering
Quantity -> Quantity -> Quantity
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Quantity -> Quantity -> Ordering
compare :: Quantity -> Quantity -> Ordering
$c< :: Quantity -> Quantity -> Bool
< :: Quantity -> Quantity -> Bool
$c<= :: Quantity -> Quantity -> Bool
<= :: Quantity -> Quantity -> Bool
$c> :: Quantity -> Quantity -> Bool
> :: Quantity -> Quantity -> Bool
$c>= :: Quantity -> Quantity -> Bool
>= :: Quantity -> Quantity -> Bool
$cmax :: Quantity -> Quantity -> Quantity
max :: Quantity -> Quantity -> Quantity
$cmin :: Quantity -> Quantity -> Quantity
min :: Quantity -> Quantity -> Quantity
Ord, Int -> Quantity -> ShowS
[Quantity] -> ShowS
Quantity -> String
(Int -> Quantity -> ShowS)
-> (Quantity -> String) -> ([Quantity] -> ShowS) -> Show Quantity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Quantity -> ShowS
showsPrec :: Int -> Quantity -> ShowS
$cshow :: Quantity -> String
show :: Quantity -> String
$cshowList :: [Quantity] -> ShowS
showList :: [Quantity] -> ShowS
Show, Quantity -> ()
(Quantity -> ()) -> NFData Quantity
forall a. (a -> ()) -> NFData a
$crnf :: Quantity -> ()
rnf :: Quantity -> ()
NFData, Eq Quantity
Eq Quantity =>
(Int -> Quantity -> Int) -> (Quantity -> Int) -> Hashable Quantity
Int -> Quantity -> Int
Quantity -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Quantity -> Int
hashWithSalt :: Int -> Quantity -> Int
$chash :: Quantity -> Int
hash :: Quantity -> Int
Hashable)
  deriving stock ((forall x. Quantity -> Rep Quantity x)
-> (forall x. Rep Quantity x -> Quantity) -> Generic Quantity
forall x. Rep Quantity x -> Quantity
forall x. Quantity -> Rep Quantity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Quantity -> Rep Quantity x
from :: forall x. Quantity -> Rep Quantity x
$cto :: forall x. Rep Quantity x -> Quantity
to :: forall x. Rep Quantity x -> Quantity
Generic)

instance CBOR.Serialise Quantity where
  encode :: Quantity -> Encoding
encode (UnsafeQuantity Integer
i) = Integer -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode Integer
i
  {-# INLINE encode #-}
  decode :: forall s. Decoder s Quantity
decode = do
    Integer
i <- Decoder s Integer
forall s. Decoder s Integer
forall a s. Serialise a => Decoder s a
CBOR.decode
    case Integer -> Maybe Quantity
quantity Integer
i of
      Just Quantity
q -> Quantity -> Decoder s Quantity
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Quantity
q
      Maybe Quantity
Nothing -> String -> Decoder s Quantity
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s Quantity) -> String -> Decoder s Quantity
forall a b. (a -> b) -> a -> b
$ String
"Quantity out of signed 128-bit integer bounds: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
i
  {-# INLINEABLE decode #-}

instance Flat.Flat Quantity where
  encode :: Quantity -> Encoding
encode (UnsafeQuantity Integer
i) = Integer -> Encoding
forall a. Flat a => a -> Encoding
Flat.encode Integer
i
  {-# INLINE encode #-}
  decode :: Get Quantity
decode = do
    Integer
i <- Get Integer
forall a. Flat a => Get a
Flat.decode
    case Integer -> Maybe Quantity
quantity Integer
i of
      Just Quantity
q -> Quantity -> Get Quantity
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Quantity
q
      Maybe Quantity
Nothing -> String -> Get Quantity
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Quantity) -> String -> Get Quantity
forall a b. (a -> b) -> a -> b
$ String
"Quantity out of signed 128-bit integer bounds: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
i
  {-# INLINEABLE decode #-}

instance Pretty Quantity where
  pretty :: forall ann. Quantity -> Doc ann
pretty (UnsafeQuantity Integer
i) = Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i

instance Bounded Quantity where
  minBound :: Quantity
minBound = Integer -> Quantity
UnsafeQuantity (-(Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
127 :: Integer)))
  {-# INLINE minBound #-}
  maxBound :: Quantity
maxBound = Integer -> Quantity
UnsafeQuantity (Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
127 :: Integer) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
  {-# INLINE maxBound #-}

-- | Smart constructor for Quantity that validates bounds.
quantity :: Integer -> Maybe Quantity
quantity :: Integer -> Maybe Quantity
quantity Integer
i
  | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Quantity -> Integer
unQuantity Quantity
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Quantity -> Integer
unQuantity Quantity
forall a. Bounded a => a
maxBound = Quantity -> Maybe Quantity
forall a. a -> Maybe a
Just (Integer -> Quantity
UnsafeQuantity Integer
i)
  | Bool
otherwise = Maybe Quantity
forall a. Maybe a
Nothing
{-# INLINEABLE quantity #-}

-- | The zero quantity.
zeroQuantity :: Quantity
zeroQuantity :: Quantity
zeroQuantity = Integer -> Quantity
UnsafeQuantity Integer
0
{-# INLINE zeroQuantity #-}

-- | Safely add two quantities, checking for overflow.
addQuantity :: Quantity -> Quantity -> Maybe Quantity
addQuantity :: Quantity -> Quantity -> Maybe Quantity
addQuantity (UnsafeQuantity Integer
x) (UnsafeQuantity Integer
y) = Integer -> Maybe Quantity
quantity (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
y)
{-# INLINEABLE addQuantity #-}

-- | Safely scale a quantity with given integer, checking for overflow.
scaleQuantity :: Integer -> Quantity -> Maybe Quantity
scaleQuantity :: Integer -> Quantity -> Maybe Quantity
scaleQuantity Integer
x (UnsafeQuantity Integer
y) = Integer -> Maybe Quantity
quantity (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y)
{-# INLINEABLE scaleQuantity #-}

----------------------------------------------------------------------------------------------------
-- Builtin Value definition ------------------------------------------------------------------------

type NestedMap = Map K (Map K Quantity)

-- | The underlying type of the UPLC built-in type @Value@.
data Value
  = Value
      !NestedMap
      {-^ Map from (currency symbol, token name) to quantity.

      Invariants: no empty inner map, and no zero quantity. -}
      !(IntMap Int)
      {-^ Map from size to the number of inner maps that have that size.
      This allows efficient retrieval of the size of the largest inner map,
      which is useful for costing of operations like `lookupCoin`.

      Invariant: all values are positive. -}
      {-# UNPACK #-} !Int
      {-^ Total size, i.e., sum total of inner map sizes. This avoids recomputing
      the total size during the costing of operations like `unionValue`. -}
      {-# UNPACK #-} !Int
      -- ^ The number of negative amounts it contains.
  deriving stock (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show, (forall x. Value -> Rep Value x)
-> (forall x. Rep Value x -> Value) -> Generic Value
forall x. Rep Value x -> Value
forall x. Value -> Rep Value x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Value -> Rep Value x
from :: forall x. Value -> Rep Value x
$cto :: forall x. Rep Value x -> Value
to :: forall x. Rep Value x -> Value
Generic)
  deriving anyclass (Value -> ()
(Value -> ()) -> NFData Value
forall a. (a -> ()) -> NFData a
$crnf :: Value -> ()
rnf :: Value -> ()
NFData)

instance Hashable Value where
  hash :: Value -> Int
hash = NestedMap -> Int
forall a. Hashable a => a -> Int
hash (NestedMap -> Int) -> (Value -> NestedMap) -> Value -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> NestedMap
unpack
  {-# INLINE hash #-}
  hashWithSalt :: Int -> Value -> Int
hashWithSalt Int
salt = Int -> NestedMap -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (NestedMap -> Int) -> (Value -> NestedMap) -> Value -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> NestedMap
unpack
  {-# INLINE hashWithSalt #-}

instance CBOR.Serialise Value where
  encode :: Value -> Encoding
encode (Value NestedMap
v IntMap Int
_ Int
_ Int
_) = NestedMap -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode NestedMap
v
  {-# INLINE encode #-}
  decode :: forall s. Decoder s Value
decode = NestedMap -> Value
pack (NestedMap -> Value) -> Decoder s NestedMap -> Decoder s Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s NestedMap
forall s. Decoder s NestedMap
forall a s. Serialise a => Decoder s a
CBOR.decode
  {-# INLINE decode #-}

instance Flat.Flat Value where
  encode :: Value -> Encoding
encode (Value NestedMap
v IntMap Int
_ Int
_ Int
_) = NestedMap -> Encoding
forall a. Flat a => a -> Encoding
Flat.encode NestedMap
v
  {-# INLINE encode #-}
  decode :: Get Value
decode = NestedMap -> Value
pack (NestedMap -> Value) -> Get NestedMap -> Get Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get NestedMap
forall a. Flat a => Get a
Flat.decode
  {-# INLINE decode #-}

{-| Unpack a `Value` into a map from (currency symbol, token name) to quantity.

The map is guaranteed to not contain empty inner map or zero quantity. -}
unpack :: Value -> NestedMap
unpack :: Value -> NestedMap
unpack (Value NestedMap
v IntMap Int
_ Int
_ Int
_) = NestedMap
v
{-# INLINE unpack #-}

{-| Pack a map from (currency symbol, token name) to quantity into a `Value`.

The map will be filtered so that it does not contain empty inner map or zero quantity. -}
pack :: NestedMap -> Value
pack :: NestedMap -> Value
pack = NestedMap -> Value
pack' (NestedMap -> Value)
-> (NestedMap -> NestedMap) -> NestedMap -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NestedMap -> NestedMap
normalize
{-# INLINE pack #-}

-- | Like `pack` but does not normalize.
pack' :: NestedMap -> Value
pack' :: NestedMap -> Value
pack' NestedMap
v = NestedMap -> IntMap Int -> Int -> Int -> Value
Value NestedMap
v IntMap Int
sizes Int
size Int
neg
  where
    (IntMap Int
sizes, Int
size, Int
neg) = ((IntMap Int, Int, Int)
 -> Map K Quantity -> (IntMap Int, Int, Int))
-> (IntMap Int, Int, Int) -> NestedMap -> (IntMap Int, Int, Int)
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' (IntMap Int, Int, Int) -> Map K Quantity -> (IntMap Int, Int, Int)
forall {a} {k}.
Num a =>
(IntMap a, Int, Int) -> Map k Quantity -> (IntMap a, Int, Int)
alg (IntMap Int
forall a. Monoid a => a
mempty, Int
0, Int
0) NestedMap
v
    alg :: (IntMap a, Int, Int) -> Map k Quantity -> (IntMap a, Int, Int)
alg (IntMap a
ss, Int
s, Int
n) Map k Quantity
inner =
      ( (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IntMap.alter (Maybe a -> (a -> Maybe a) -> Maybe a -> Maybe a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> Maybe a
forall a. a -> Maybe a
Just a
1) (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (a -> a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a
forall a. Num a => a -> a -> a
+ a
1))) (Map k Quantity -> Int
forall k a. Map k a -> Int
Map.size Map k Quantity
inner) IntMap a
ss
      , Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Map k Quantity -> Int
forall k a. Map k a -> Int
Map.size Map k Quantity
inner
      , Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Map k Quantity -> Int
forall k a. Map k a -> Int
Map.size ((Quantity -> Bool) -> Map k Quantity -> Map k Quantity
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
< Quantity
zeroQuantity) Map k Quantity
inner)
      )
{-# INLINEABLE pack' #-}

{-| Total size, i.e., the number of distinct `(currency symbol, token name)` pairs
contained in the `Value`. -}
totalSize :: Value -> Int
totalSize :: Value -> Int
totalSize (Value NestedMap
_ IntMap Int
_ Int
size Int
_) = Int
size
{-# INLINE totalSize #-}

-- | Size of the largest inner map.
maxInnerSize :: Value -> Int
maxInnerSize :: Value -> Int
maxInnerSize (Value NestedMap
_ IntMap Int
sizes Int
_ Int
_) = Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> a
fst (IntMap Int -> Maybe (Int, Int)
forall a. IntMap a -> Maybe (Int, a)
IntMap.lookupMax IntMap Int
sizes)
{-# INLINE maxInnerSize #-}

negativeAmounts :: Value -> Int
negativeAmounts :: Value -> Int
negativeAmounts (Value NestedMap
_ IntMap Int
_ Int
_ Int
neg) = Int
neg
{-# INLINE negativeAmounts #-}

empty :: Value
empty :: Value
empty = NestedMap -> IntMap Int -> Int -> Int -> Value
Value NestedMap
forall a. Monoid a => a
mempty IntMap Int
forall a. Monoid a => a
mempty Int
0 Int
0
{-# INLINE empty #-}

toList :: Value -> [(K, [(K, Quantity)])]
toList :: Value -> [(K, [(K, Quantity)])]
toList = Map K [(K, Quantity)] -> [(K, [(K, Quantity)])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map K [(K, Quantity)] -> [(K, [(K, Quantity)])])
-> (Value -> Map K [(K, Quantity)])
-> Value
-> [(K, [(K, Quantity)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map K Quantity -> [(K, Quantity)])
-> NestedMap -> Map K [(K, Quantity)]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Map K Quantity -> [(K, Quantity)]
forall k a. Map k a -> [(k, a)]
Map.toList (NestedMap -> Map K [(K, Quantity)])
-> (Value -> NestedMap) -> Value -> Map K [(K, Quantity)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> NestedMap
unpack
{-# INLINEABLE toList #-}

toFlatList :: Value -> [(K, K, Quantity)]
toFlatList :: Value -> [(K, K, Quantity)]
toFlatList (Value -> [(K, [(K, Quantity)])]
toList -> [(K, [(K, Quantity)])]
xs) = [(K
c, K
t, Quantity
a) | (K
c, [(K, Quantity)]
ys) <- [(K, [(K, Quantity)])]
xs, (K
t, Quantity
a) <- [(K, Quantity)]
ys]
{-# INLINEABLE toFlatList #-}

fromList :: [(K, [(K, Quantity)])] -> BuiltinResult Value
fromList :: [(K, [(K, Quantity)])] -> BuiltinResult Value
fromList [(K, [(K, Quantity)])]
xs = do
  -- Use unchecked addition during construction
  let outerMap :: NestedMap
outerMap =
        (Map K Quantity -> Map K Quantity -> Map K Quantity)
-> [(K, Map K Quantity)] -> NestedMap
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith
          ((Quantity -> Quantity -> Quantity)
-> Map K Quantity -> Map K Quantity -> Map K Quantity
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Quantity -> Quantity -> Quantity
unsafeAddQuantity) -- combine inner maps with unchecked addition
          (([(K, Quantity)] -> Map K Quantity)
-> (K, [(K, Quantity)]) -> (K, Map K Quantity)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Quantity -> Quantity -> Quantity)
-> [(K, Quantity)] -> Map K Quantity
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Quantity -> Quantity -> Quantity
unsafeAddQuantity) ((K, [(K, Quantity)]) -> (K, Map K Quantity))
-> [(K, [(K, Quantity)])] -> [(K, Map K Quantity)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(K, [(K, Quantity)])]
xs)
  -- Validate all quantities are within bounds
  NestedMap -> Value
pack (NestedMap -> Value)
-> BuiltinResult NestedMap -> BuiltinResult Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => NestedMap -> BuiltinResult NestedMap
NestedMap -> BuiltinResult NestedMap
validateQuantities NestedMap
outerMap
{-# INLINEABLE fromList #-}

-- | Unsafe addition of quantities without bounds checking.
unsafeAddQuantity :: Quantity -> Quantity -> Quantity
unsafeAddQuantity :: Quantity -> Quantity -> Quantity
unsafeAddQuantity (UnsafeQuantity Integer
x) (UnsafeQuantity Integer
y) = Integer -> Quantity
UnsafeQuantity (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
y)
{-# INLINE unsafeAddQuantity #-}

-- | Validate all quantities in a nested map are within bounds.
validateQuantities :: HasCallStack => NestedMap -> BuiltinResult NestedMap
validateQuantities :: HasCallStack => NestedMap -> BuiltinResult NestedMap
validateQuantities NestedMap
nestedMap =
  case (Quantity -> Bool) -> [Quantity] -> Maybe Quantity
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Quantity -> Bool
isOutOfBounds [Quantity]
allQuantities of
    Just (UnsafeQuantity Integer
i) -> String -> BuiltinResult NestedMap
forall a. String -> BuiltinResult a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> BuiltinResult NestedMap)
-> String -> BuiltinResult NestedMap
forall a b. (a -> b) -> a -> b
$ String
context String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": quantity out of bounds: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
i
    Maybe Quantity
Nothing -> NestedMap -> BuiltinResult NestedMap
forall a. a -> BuiltinResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NestedMap
nestedMap
  where
    allQuantities :: [Quantity]
allQuantities = (Map K Quantity -> [Quantity]) -> [Map K Quantity] -> [Quantity]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Map K Quantity -> [Quantity]
forall k a. Map k a -> [a]
Map.elems ([Map K Quantity] -> [Quantity]) -> [Map K Quantity] -> [Quantity]
forall a b. (a -> b) -> a -> b
$ NestedMap -> [Map K Quantity]
forall k a. Map k a -> [a]
Map.elems NestedMap
nestedMap
    isOutOfBounds :: Quantity -> Bool
isOutOfBounds (UnsafeQuantity Integer
i) =
      Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Quantity -> Integer
unQuantity Quantity
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
|| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Quantity -> Integer
unQuantity Quantity
forall a. Bounded a => a
maxBound
    context :: String
context = case CallStack -> [(String, SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
callStack of
      (String
fnName, SrcLoc
_) : [(String, SrcLoc)]
_ -> String
fnName
      [] -> String
"<unknown>"
{-# INLINEABLE validateQuantities #-}

normalize :: NestedMap -> NestedMap
normalize :: NestedMap -> NestedMap
normalize = (Map K Quantity -> Bool) -> NestedMap -> NestedMap
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool)
-> (Map K Quantity -> Bool) -> Map K Quantity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map K Quantity -> Bool
forall k a. Map k a -> Bool
Map.null) (NestedMap -> NestedMap)
-> (NestedMap -> NestedMap) -> NestedMap -> NestedMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map K Quantity -> Map K Quantity) -> NestedMap -> NestedMap
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((Quantity -> Bool) -> Map K Quantity -> Map K Quantity
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Quantity -> Quantity -> Bool
forall a. Eq a => a -> a -> Bool
/= Quantity
zeroQuantity))
{-# INLINEABLE normalize #-}

instance Pretty Value where
  pretty :: forall ann. Value -> Doc ann
pretty = [(Text, [(Text, Quantity)])] -> Doc ann
forall ann. [(Text, [(Text, Quantity)])] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([(Text, [(Text, Quantity)])] -> Doc ann)
-> (Value -> [(Text, [(Text, Quantity)])]) -> Value -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((K, [(K, Quantity)]) -> (Text, [(Text, Quantity)]))
-> [(K, [(K, Quantity)])] -> [(Text, [(Text, Quantity)])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((K -> Text)
-> ([(K, Quantity)] -> [(Text, Quantity)])
-> (K, [(K, Quantity)])
-> (Text, [(Text, Quantity)])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap K -> Text
toText (((K, Quantity) -> (Text, Quantity))
-> [(K, Quantity)] -> [(Text, Quantity)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((K -> Text) -> (K, Quantity) -> (Text, Quantity)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first K -> Text
toText))) ([(K, [(K, Quantity)])] -> [(Text, [(Text, Quantity)])])
-> (Value -> [(K, [(K, Quantity)])])
-> Value
-> [(Text, [(Text, Quantity)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> [(K, [(K, Quantity)])]
toList
    where
      toText :: K -> Text
toText = ByteString -> Text
Text.decodeLatin1 (ByteString -> Text) -> (K -> ByteString) -> K -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64.encode (ByteString -> ByteString) -> (K -> ByteString) -> K -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K -> ByteString
unK

{-| \(O(\log \max(m, k))\), where \(m\) is the size of the outer map, and \(k\) is
the size of the largest inner map. -}
insertCoin :: ByteString -> ByteString -> Integer -> Value -> BuiltinResult Value
insertCoin :: ByteString -> ByteString -> Integer -> Value -> BuiltinResult Value
insertCoin ByteString
unsafeCurrency ByteString
unsafeToken Integer
unsafeAmount v :: Value
v@(Value NestedMap
outer IntMap Int
sizes Int
size Int
neg)
  | Integer
unsafeAmount Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Value -> BuiltinResult Value
forall a. a -> BuiltinResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> BuiltinResult Value) -> Value -> BuiltinResult Value
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Value -> Value
deleteCoin ByteString
unsafeCurrency ByteString
unsafeToken Value
v
  | Bool
otherwise = case (ByteString -> Maybe K
k ByteString
unsafeCurrency, ByteString -> Maybe K
k ByteString
unsafeToken, Integer -> Maybe Quantity
quantity Integer
unsafeAmount) of
      (Maybe K
Nothing, Maybe K
_, Maybe Quantity
_) -> String -> BuiltinResult Value
forall a. String -> BuiltinResult a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> BuiltinResult Value) -> String -> BuiltinResult Value
forall a b. (a -> b) -> a -> b
$ String
"insertCoin: invalid currency: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Word8] -> String
forall a. Show a => a -> String
show (ByteString -> [Word8]
B.unpack ByteString
unsafeCurrency)
      (Maybe K
_, Maybe K
Nothing, Maybe Quantity
_) -> String -> BuiltinResult Value
forall a. String -> BuiltinResult a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> BuiltinResult Value) -> String -> BuiltinResult Value
forall a b. (a -> b) -> a -> b
$ String
"insertCoin: invalid token: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Word8] -> String
forall a. Show a => a -> String
show (ByteString -> [Word8]
B.unpack ByteString
unsafeToken)
      (Maybe K
_, Maybe K
_, Maybe Quantity
Nothing) -> String -> BuiltinResult Value
forall a. String -> BuiltinResult a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> BuiltinResult Value) -> String -> BuiltinResult Value
forall a b. (a -> b) -> a -> b
$ String
"insertCoin: quantity out of bounds: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
unsafeAmount
      (Just K
currency, Just K
token, Just Quantity
qty) ->
        let f
              :: Maybe (Map K Quantity)
              -> ( -- Left (old size of inner map) if the total size grows by 1,
                   -- otherwise, Right (old quantity)
                   Either Int Quantity
                 , Maybe (Map K Quantity)
                 )
            f :: Maybe (Map K Quantity)
-> (Either Int Quantity, Maybe (Map K Quantity))
f = \case
              Maybe (Map K Quantity)
Nothing -> (Int -> Either Int Quantity
forall a b. a -> Either a b
Left Int
0, Map K Quantity -> Maybe (Map K Quantity)
forall a. a -> Maybe a
Just (K -> Quantity -> Map K Quantity
forall k a. k -> a -> Map k a
Map.singleton K
token Quantity
qty))
              Just Map K Quantity
inner ->
                let (Maybe Quantity
mOldQuantity, Map K Quantity
inner') =
                      (K -> Quantity -> Quantity -> Quantity)
-> K
-> Quantity
-> Map K Quantity
-> (Maybe Quantity, Map K Quantity)
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a)
Map.insertLookupWithKey (\K
_ Quantity
_ Quantity
_ -> Quantity
qty) K
token Quantity
qty Map K Quantity
inner
                 in (Either Int Quantity
-> (Quantity -> Either Int Quantity)
-> Maybe Quantity
-> Either Int Quantity
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> Either Int Quantity
forall a b. a -> Either a b
Left (Map K Quantity -> Int
forall k a. Map k a -> Int
Map.size Map K Quantity
inner)) Quantity -> Either Int Quantity
forall a b. b -> Either a b
Right Maybe Quantity
mOldQuantity, Map K Quantity -> Maybe (Map K Quantity)
forall a. a -> Maybe a
Just Map K Quantity
inner')
            (Either Int Quantity
res, NestedMap
outer') = (Maybe (Map K Quantity)
 -> (Either Int Quantity, Maybe (Map K Quantity)))
-> K -> NestedMap -> (Either Int Quantity, NestedMap)
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
Map.alterF Maybe (Map K Quantity)
-> (Either Int Quantity, Maybe (Map K Quantity))
f K
currency NestedMap
outer
            (IntMap Int
sizes', Int
size', Int
neg') = case Either Int Quantity
res of
              Left Int
oldSize ->
                ( Int -> Int -> IntMap Int -> IntMap Int
updateSizes Int
oldSize (Int
oldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) IntMap Int
sizes
                , Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                , if Quantity
qty Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
< Quantity
zeroQuantity then Int
neg Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
neg
                )
              Right Quantity
oldQuantity ->
                ( IntMap Int
sizes
                , Int
size
                , if Quantity
oldQuantity Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
< Quantity
zeroQuantity Bool -> Bool -> Bool
&& Quantity
qty Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
> Quantity
zeroQuantity
                    then Int
neg Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                    else
                      if Quantity
oldQuantity Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
> Quantity
zeroQuantity Bool -> Bool -> Bool
&& Quantity
qty Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
< Quantity
zeroQuantity
                        then Int
neg Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                        else Int
neg
                )
         in Value -> BuiltinResult Value
forall a. a -> BuiltinResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> BuiltinResult Value) -> Value -> BuiltinResult Value
forall a b. (a -> b) -> a -> b
$ NestedMap -> IntMap Int -> Int -> Int -> Value
Value NestedMap
outer' IntMap Int
sizes' Int
size' Int
neg'
{-# INLINEABLE insertCoin #-}

-- | \(O(\log \max(m, k))\)
deleteCoin :: ByteString -> ByteString -> Value -> Value
deleteCoin :: ByteString -> ByteString -> Value -> Value
deleteCoin (ByteString -> K
UnsafeK -> K
currency) (ByteString -> K
UnsafeK -> K
token) (Value NestedMap
outer IntMap Int
sizes Int
size Int
neg) =
  NestedMap -> IntMap Int -> Int -> Int -> Value
Value NestedMap
outer' IntMap Int
sizes' Int
size' Int
neg'
  where
    (Maybe (Int, Quantity)
mold, NestedMap
outer') = (Maybe (Map K Quantity)
 -> (Maybe (Int, Quantity), Maybe (Map K Quantity)))
-> K -> NestedMap -> (Maybe (Int, Quantity), NestedMap)
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
Map.alterF Maybe (Map K Quantity)
-> (Maybe (Int, Quantity), Maybe (Map K Quantity))
f K
currency NestedMap
outer
    (IntMap Int
sizes', Int
size', Int
neg') = case Maybe (Int, Quantity)
mold of
      Just (Int
oldSize, Quantity
oldQuantity) ->
        ( Int -> Int -> IntMap Int -> IntMap Int
updateSizes Int
oldSize (Int
oldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) IntMap Int
sizes
        , Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        , if Quantity
oldQuantity Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
< Quantity
zeroQuantity then Int
neg Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 else Int
neg
        )
      Maybe (Int, Quantity)
Nothing -> (IntMap Int
sizes, Int
size, Int
neg)
    f
      :: Maybe (Map K Quantity)
      -> ( -- Just (old size of inner map, old quantity) if the total size shrinks by 1,
           -- otherwise Nothing
           Maybe (Int, Quantity)
         , Maybe (Map K Quantity)
         )
    f :: Maybe (Map K Quantity)
-> (Maybe (Int, Quantity), Maybe (Map K Quantity))
f = \case
      Maybe (Map K Quantity)
Nothing -> (Maybe (Int, Quantity)
forall a. Maybe a
Nothing, Maybe (Map K Quantity)
forall a. Maybe a
Nothing)
      Just Map K Quantity
inner ->
        let (Maybe Quantity
qty, Map K Quantity
inner') = (K -> Quantity -> Maybe Quantity)
-> K -> Map K Quantity -> (Maybe Quantity, Map K Quantity)
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
Map.updateLookupWithKey (\K
_ Quantity
_ -> Maybe Quantity
forall a. Maybe a
Nothing) K
token Map K Quantity
inner
         in ((Map K Quantity -> Int
forall k a. Map k a -> Int
Map.size Map K Quantity
inner,) (Quantity -> (Int, Quantity))
-> Maybe Quantity -> Maybe (Int, Quantity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Quantity
qty, if Map K Quantity -> Bool
forall k a. Map k a -> Bool
Map.null Map K Quantity
inner' then Maybe (Map K Quantity)
forall a. Maybe a
Nothing else Map K Quantity -> Maybe (Map K Quantity)
forall a. a -> Maybe a
Just Map K Quantity
inner')

-- | \(O(\log \max(m, k))\)
lookupCoin :: ByteString -> ByteString -> Value -> Integer
lookupCoin :: ByteString -> ByteString -> Value -> Integer
lookupCoin (ByteString -> K
UnsafeK -> K
currency) (ByteString -> K
UnsafeK -> K
token) (Value -> NestedMap
unpack -> NestedMap
outer) =
  case K -> NestedMap -> Maybe (Map K Quantity)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup K
currency NestedMap
outer of
    Maybe (Map K Quantity)
Nothing -> Integer
0
    Just Map K Quantity
inner -> Quantity -> Integer
unQuantity (Quantity -> Integer) -> Quantity -> Integer
forall a b. (a -> b) -> a -> b
$ Quantity -> K -> Map K Quantity -> Quantity
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Quantity
zeroQuantity K
token Map K Quantity
inner

{-| \(O(n_{2}\log \max(m_{1}, k_{1}))\), where \(n_{2}\) is the total size of the second
`Value`, \(m_{1}\) is the size of the outer map in the first `Value` and \(k_{1}\) is
the size of the largest inner map in the first `Value`.

@a@ contains @b@ if for each @(currency, token, quantity)@ in @b@,
@lookup currency token a >= quantity@.

Both values must not contain negative amounts. -}
valueContains :: Value -> Value -> BuiltinResult Bool
valueContains :: Value -> Value -> BuiltinResult Bool
valueContains Value
v1 Value
v2
  | Value -> Int
negativeAmounts Value
v1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = String -> BuiltinResult Bool
forall a. String -> BuiltinResult a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"valueContains: first value contains negative amounts"
  | Value -> Int
negativeAmounts Value
v2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = String -> BuiltinResult Bool
forall a. String -> BuiltinResult a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"valueContains: second value contains negative amounts"
  | Value -> Int
totalSize Value
v1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Value -> Int
totalSize Value
v2 = Bool -> BuiltinResult Bool
forall a. a -> BuiltinResult a
BuiltinSuccess Bool
False
  -- \^ v2 is too big to be contained in v1: `isSubmapOfBy` has a similar check,
  -- but that only applies to the top-level structure of the map, so v1 can
  -- have a larger outer map than v2 but a smaller number of total entries, and
  -- without this check the outer call of `isSubmapOfBy` would carry on and
  -- compare the inner maps even though v2 can't fit inside v1.
  | Bool
otherwise = Bool -> BuiltinResult Bool
forall a. a -> BuiltinResult a
BuiltinSuccess (Bool -> BuiltinResult Bool) -> Bool -> BuiltinResult Bool
forall a b. (a -> b) -> a -> b
$ (Map K Quantity -> Map K Quantity -> Bool)
-> NestedMap -> NestedMap -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> Map k a -> Map k b -> Bool
Map.isSubmapOfBy ((Quantity -> Quantity -> Bool)
-> Map K Quantity -> Map K Quantity -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> Map k a -> Map k b -> Bool
Map.isSubmapOfBy Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
(<=)) (Value -> NestedMap
unpack Value
v2) (Value -> NestedMap
unpack Value
v1)
{-# INLINEABLE valueContains #-}

{-| \(O(n_{1}) + O(n_{2})\), where \(n_{1}\) and \(n_{2}\) are the total sizes
(i.e., sum of inner map sizes) of the two maps.

Shortcircuits if either value is empty.

Since 'unionValue' is commutative, we switch the arguments whenever the second
value is larger in total size than the first one. We have found through experimentation
that this results in better performance in practice. -}
unionValue :: Value -> Value -> BuiltinResult Value
unionValue :: Value -> Value -> BuiltinResult Value
unionValue Value
vA Value
vB
  | Value -> Int
totalSize Value
vA Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Value -> BuiltinResult Value
forall a. a -> BuiltinResult a
BuiltinSuccess Value
vB
  | Value -> Int
totalSize Value
vB Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Value -> BuiltinResult Value
forall a. a -> BuiltinResult a
BuiltinSuccess Value
vA
  | Bool
otherwise =
      NestedMap -> Value
pack'
        (NestedMap -> Value)
-> BuiltinResult NestedMap -> BuiltinResult Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WhenMissing BuiltinResult K (Map K Quantity) (Map K Quantity)
-> WhenMissing BuiltinResult K (Map K Quantity) (Map K Quantity)
-> WhenMatched
     BuiltinResult K (Map K Quantity) (Map K Quantity) (Map K Quantity)
-> NestedMap
-> NestedMap
-> BuiltinResult NestedMap
forall (f :: * -> *) k a c b.
(Applicative f, Ord k) =>
WhenMissing f k a c
-> WhenMissing f k b c
-> WhenMatched f k a b c
-> Map k a
-> Map k b
-> f (Map k c)
M.mergeA
          WhenMissing BuiltinResult K (Map K Quantity) (Map K Quantity)
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
M.preserveMissing
          WhenMissing BuiltinResult K (Map K Quantity) (Map K Quantity)
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
M.preserveMissing
          ( (K
 -> Map K Quantity
 -> Map K Quantity
 -> BuiltinResult (Maybe (Map K Quantity)))
-> WhenMatched
     BuiltinResult K (Map K Quantity) (Map K Quantity) (Map K Quantity)
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
M.zipWithMaybeAMatched \K
_ Map K Quantity
innerA Map K Quantity
innerB ->
              (Map K Quantity -> Maybe (Map K Quantity))
-> BuiltinResult (Map K Quantity)
-> BuiltinResult (Maybe (Map K Quantity))
forall a b. (a -> b) -> BuiltinResult a -> BuiltinResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Map K Quantity
inner -> if Map K Quantity -> Bool
forall k a. Map k a -> Bool
Map.null Map K Quantity
inner then Maybe (Map K Quantity)
forall a. Maybe a
Nothing else Map K Quantity -> Maybe (Map K Quantity)
forall a. a -> Maybe a
Just Map K Quantity
inner) (BuiltinResult (Map K Quantity)
 -> BuiltinResult (Maybe (Map K Quantity)))
-> BuiltinResult (Map K Quantity)
-> BuiltinResult (Maybe (Map K Quantity))
forall a b. (a -> b) -> a -> b
$
                WhenMissing BuiltinResult K Quantity Quantity
-> WhenMissing BuiltinResult K Quantity Quantity
-> WhenMatched BuiltinResult K Quantity Quantity Quantity
-> Map K Quantity
-> Map K Quantity
-> BuiltinResult (Map K Quantity)
forall (f :: * -> *) k a c b.
(Applicative f, Ord k) =>
WhenMissing f k a c
-> WhenMissing f k b c
-> WhenMatched f k a b c
-> Map k a
-> Map k b
-> f (Map k c)
M.mergeA
                  WhenMissing BuiltinResult K Quantity Quantity
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
M.preserveMissing
                  WhenMissing BuiltinResult K Quantity Quantity
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
M.preserveMissing
                  ( (K -> Quantity -> Quantity -> BuiltinResult (Maybe Quantity))
-> WhenMatched BuiltinResult K Quantity Quantity Quantity
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
M.zipWithMaybeAMatched \K
_ Quantity
x Quantity
y ->
                      case Quantity -> Quantity -> Maybe Quantity
addQuantity Quantity
x Quantity
y of
                        Just Quantity
z -> Maybe Quantity -> BuiltinResult (Maybe Quantity)
forall a. a -> BuiltinResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure if Quantity
z Quantity -> Quantity -> Bool
forall a. Eq a => a -> a -> Bool
== Quantity
zeroQuantity then Maybe Quantity
forall a. Maybe a
Nothing else Quantity -> Maybe Quantity
forall a. a -> Maybe a
Just Quantity
z
                        Maybe Quantity
Nothing ->
                          String -> BuiltinResult (Maybe Quantity)
forall a. String -> BuiltinResult a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unionValue: quantity is out of the signed 128-bit integer bounds"
                  )
                  Map K Quantity
innerA
                  Map K Quantity
innerB
          )
          NestedMap
v1
          NestedMap
v2
  where
    (NestedMap
v1, NestedMap
v2) =
      if Value -> Int
totalSize Value
vB Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Value -> Int
totalSize Value
vA
        then (Value -> NestedMap
unpack Value
vB, Value -> NestedMap
unpack Value
vA)
        else (Value -> NestedMap
unpack Value
vA, Value -> NestedMap
unpack Value
vB)
{-# INLINEABLE unionValue #-}

{-| \(O(n)\). Encodes `Value` as `Data`, in the same way as non-builtin @Value@.
This is the denotation of @ValueData@ in Plutus V1, V2 and V3. -}
valueData :: Value -> Data
valueData :: Value -> Data
valueData = [(Data, Data)] -> Data
Map ([(Data, Data)] -> Data)
-> (Value -> [(Data, Data)]) -> Value -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((K, Map K Quantity) -> (Data, Data))
-> [(K, Map K Quantity)] -> [(Data, Data)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((K -> Data)
-> (Map K Quantity -> Data) -> (K, Map K Quantity) -> (Data, Data)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (ByteString -> Data
B (ByteString -> Data) -> (K -> ByteString) -> K -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K -> ByteString
unK) Map K Quantity -> Data
tokensData) ([(K, Map K Quantity)] -> [(Data, Data)])
-> (Value -> [(K, Map K Quantity)]) -> Value -> [(Data, Data)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NestedMap -> [(K, Map K Quantity)]
forall k a. Map k a -> [(k, a)]
Map.toList (NestedMap -> [(K, Map K Quantity)])
-> (Value -> NestedMap) -> Value -> [(K, Map K Quantity)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> NestedMap
unpack
  where
    tokensData :: Map K Quantity -> Data
    tokensData :: Map K Quantity -> Data
tokensData = [(Data, Data)] -> Data
Map ([(Data, Data)] -> Data)
-> (Map K Quantity -> [(Data, Data)]) -> Map K Quantity -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((K, Quantity) -> (Data, Data))
-> [(K, Quantity)] -> [(Data, Data)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((K -> Data) -> (Quantity -> Data) -> (K, Quantity) -> (Data, Data)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (ByteString -> Data
B (ByteString -> Data) -> (K -> ByteString) -> K -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K -> ByteString
unK) (Integer -> Data
I (Integer -> Data) -> (Quantity -> Integer) -> Quantity -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quantity -> Integer
unQuantity)) ([(K, Quantity)] -> [(Data, Data)])
-> (Map K Quantity -> [(K, Quantity)])
-> Map K Quantity
-> [(Data, Data)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map K Quantity -> [(K, Quantity)]
forall k a. Map k a -> [(k, a)]
Map.toList
{-# INLINEABLE valueData #-}

{-| \(O(n \log n)\). Decodes `Data` into `Value`, in the same way as non-builtin @Value@.
This is the denotation of @UnValueData@ in Plutus V1, V2 and V3. -}
unValueData :: Data -> BuiltinResult Value
unValueData :: Data -> BuiltinResult Value
unValueData =
  (NestedMap -> Value)
-> BuiltinResult NestedMap -> BuiltinResult Value
forall a b. (a -> b) -> BuiltinResult a -> BuiltinResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NestedMap -> Value
pack (BuiltinResult NestedMap -> BuiltinResult Value)
-> (Data -> BuiltinResult NestedMap) -> Data -> BuiltinResult Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    Map [(Data, Data)]
cs -> do
      -- Use unchecked addition during construction
      NestedMap
outerMap <-
        (Map K Quantity -> Map K Quantity -> Map K Quantity)
-> [(K, Map K Quantity)] -> NestedMap
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith ((Quantity -> Quantity -> Quantity)
-> Map K Quantity -> Map K Quantity -> Map K Quantity
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Quantity -> Quantity -> Quantity
unsafeAddQuantity) ([(K, Map K Quantity)] -> NestedMap)
-> BuiltinResult [(K, Map K Quantity)] -> BuiltinResult NestedMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Data, Data) -> BuiltinResult (K, Map K Quantity))
-> [(Data, Data)] -> BuiltinResult [(K, Map K Quantity)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Data -> BuiltinResult K)
-> (Data -> BuiltinResult (Map K Quantity))
-> (Data, Data)
-> BuiltinResult (K, Map K Quantity)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> (a, b) -> f (c, d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse Data -> BuiltinResult K
unB Data -> BuiltinResult (Map K Quantity)
unTokens) [(Data, Data)]
cs
      -- Validate all quantities are within bounds
      HasCallStack => NestedMap -> BuiltinResult NestedMap
NestedMap -> BuiltinResult NestedMap
validateQuantities NestedMap
outerMap
    Data
_ -> String -> BuiltinResult NestedMap
forall a. String -> BuiltinResult a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unValueData: non-Map constructor"
  where
    unB :: Data -> BuiltinResult K
    unB :: Data -> BuiltinResult K
unB = \case
      B ByteString
b -> BuiltinResult K
-> (K -> BuiltinResult K) -> Maybe K -> BuiltinResult K
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> BuiltinResult K
forall a. String -> BuiltinResult a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> BuiltinResult K) -> String -> BuiltinResult K
forall a b. (a -> b) -> a -> b
$ String
"unValueData: invalid key: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Word8] -> String
forall a. Show a => a -> String
show (ByteString -> [Word8]
B.unpack ByteString
b)) K -> BuiltinResult K
forall a. a -> BuiltinResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe K
k ByteString
b)
      Data
_ -> String -> BuiltinResult K
forall a. String -> BuiltinResult a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unValueData: non-B constructor"

    unQ :: Data -> BuiltinResult Quantity
    unQ :: Data -> BuiltinResult Quantity
unQ = \case
      I Integer
i -> Quantity -> BuiltinResult Quantity
forall a. a -> BuiltinResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Quantity
UnsafeQuantity Integer
i)
      Data
_ -> String -> BuiltinResult Quantity
forall a. String -> BuiltinResult a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unValueData: non-I constructor"

    unTokens :: Data -> BuiltinResult (Map K Quantity)
    unTokens :: Data -> BuiltinResult (Map K Quantity)
unTokens = \case
      Map [(Data, Data)]
ts -> ([(K, Quantity)] -> Map K Quantity)
-> BuiltinResult [(K, Quantity)] -> BuiltinResult (Map K Quantity)
forall a b. (a -> b) -> BuiltinResult a -> BuiltinResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Quantity -> Quantity -> Quantity)
-> [(K, Quantity)] -> Map K Quantity
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Quantity -> Quantity -> Quantity
unsafeAddQuantity) (((Data, Data) -> BuiltinResult (K, Quantity))
-> [(Data, Data)] -> BuiltinResult [(K, Quantity)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Data -> BuiltinResult K)
-> (Data -> BuiltinResult Quantity)
-> (Data, Data)
-> BuiltinResult (K, Quantity)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> (a, b) -> f (c, d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse Data -> BuiltinResult K
unB Data -> BuiltinResult Quantity
unQ) [(Data, Data)]
ts)
      Data
_ -> String -> BuiltinResult (Map K Quantity)
forall a. String -> BuiltinResult a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unValueData: non-Map constructor"
{-# INLINEABLE unValueData #-}

-- | Decrement bucket @old@, and increment bucket @new@.
updateSizes :: Int -> Int -> IntMap Int -> IntMap Int
updateSizes :: Int -> Int -> IntMap Int -> IntMap Int
updateSizes Int
old Int
new = IntMap Int -> IntMap Int
dec (IntMap Int -> IntMap Int)
-> (IntMap Int -> IntMap Int) -> IntMap Int -> IntMap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap Int -> IntMap Int
inc
  where
    inc :: IntMap Int -> IntMap Int
inc =
      if Int
new Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then IntMap Int -> IntMap Int
forall a. a -> a
id
        else (Maybe Int -> Maybe Int) -> Int -> IntMap Int -> IntMap Int
forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IntMap.alter (Maybe Int -> (Int -> Maybe Int) -> Maybe Int -> Maybe Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> (Int -> Int) -> Int -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))) Int
new
    dec :: IntMap Int -> IntMap Int
dec =
      if Int
old Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then IntMap Int -> IntMap Int
forall a. a -> a
id
        else (Int -> Maybe Int) -> Int -> IntMap Int -> IntMap Int
forall a. (a -> Maybe a) -> Int -> IntMap a -> IntMap a
IntMap.update (\Int
n -> if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Int
old
{-# INLINEABLE updateSizes #-}

-- | \(O(n)\). Scale each token by the given constant factor.
scaleValue :: Integer -> Value -> BuiltinResult Value
scaleValue :: Integer -> Value -> BuiltinResult Value
scaleValue Integer
c (Value NestedMap
outer IntMap Int
sizes Int
size Int
neg)
  -- When scaling by positive factor, no need to change sizes and number of negative amounts.
  | Integer
c Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 = do
      NestedMap
outer' <- NestedMap -> BuiltinResult NestedMap
go NestedMap
outer
      Value -> BuiltinResult Value
forall a. a -> BuiltinResult a
BuiltinSuccess (Value -> BuiltinResult Value) -> Value -> BuiltinResult Value
forall a b. (a -> b) -> a -> b
$ NestedMap -> IntMap Int -> Int -> Int -> Value
Value NestedMap
outer' IntMap Int
sizes Int
size Int
neg
  -- When scaling by negative factor, only need to "flip" negative amounts.
  | Integer
c Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = do
      NestedMap
outer' <- NestedMap -> BuiltinResult NestedMap
go NestedMap
outer
      Value -> BuiltinResult Value
forall a. a -> BuiltinResult a
BuiltinSuccess (Value -> BuiltinResult Value) -> Value -> BuiltinResult Value
forall a b. (a -> b) -> a -> b
$ NestedMap -> IntMap Int -> Int -> Int -> Value
Value NestedMap
outer' IntMap Int
sizes Int
size (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
neg)
  -- Scaling by 0 is always empty value
  | Bool
otherwise = Value -> BuiltinResult Value
forall a. a -> BuiltinResult a
BuiltinSuccess Value
empty
  where
    go :: NestedMap -> BuiltinResult NestedMap
    go :: NestedMap -> BuiltinResult NestedMap
go NestedMap
x = (Map K Quantity -> BuiltinResult (Map K Quantity))
-> NestedMap -> BuiltinResult NestedMap
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map K a -> f (Map K b)
traverse ((Quantity -> BuiltinResult Quantity)
-> Map K Quantity -> BuiltinResult (Map K Quantity)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map K a -> f (Map K b)
traverse Quantity -> BuiltinResult Quantity
goScale) NestedMap
x
    goScale :: Quantity -> BuiltinResult Quantity
    goScale :: Quantity -> BuiltinResult Quantity
goScale Quantity
x =
      case Integer -> Quantity -> Maybe Quantity
scaleQuantity Integer
c Quantity
x of
        Maybe Quantity
Nothing ->
          String -> BuiltinResult Quantity
forall a. String -> BuiltinResult a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> BuiltinResult Quantity)
-> String -> BuiltinResult Quantity
forall a b. (a -> b) -> a -> b
$
            String
"scaleValue: quantity out of bounds: "
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
c
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" * "
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show (Quantity -> Integer
unQuantity Quantity
x)
        Just Quantity
q -> Quantity -> BuiltinResult Quantity
forall a. a -> BuiltinResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Quantity
q