{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
module PlutusCore.Value (
Value,
K,
k,
unK,
maxKeyLen,
negativeAmounts,
NestedMap,
unpack,
pack,
empty,
fromList,
toList,
toFlatList,
totalSize,
maxInnerSize,
insertCoin,
deleteCoin,
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.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.Monoid (All (..))
import Data.Text.Encoding qualified as Text
import GHC.Generics
import PlutusCore.Builtin.Result
import PlutusCore.Data (Data (..))
import PlutusCore.Flat qualified as Flat
import PlutusPrelude (Pretty (..))
maxKeyLen :: Int
maxKeyLen :: Int
maxKeyLen = Int
32
{-# INLINE maxKeyLen #-}
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 #-}
type NestedMap = Map K (Map K Integer)
data Value
= Value
!NestedMap
!(IntMap Int)
{-# UNPACK #-} !Int
{-# UNPACK #-} !Int
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 :: Value -> NestedMap
unpack :: Value -> NestedMap
unpack (Value NestedMap
v IntMap Int
_ Int
_ Int
_) = NestedMap
v
{-# INLINE unpack #-}
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 #-}
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 Integer -> (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 Integer -> (IntMap Int, Int, Int)
forall {a} {a} {k}.
(Ord a, Num a, Num a) =>
(IntMap a, Int, Int) -> Map k a -> (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 a -> (IntMap a, Int, Int)
alg (IntMap a
ss, Int
s, Int
n) Map k a
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 a -> Int
forall k a. Map k a -> Int
Map.size Map k a
inner) IntMap a
ss
, Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Map k a -> Int
forall k a. Map k a -> Int
Map.size Map k a
inner
, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Map k a -> Int
forall k a. Map k a -> Int
Map.size ((a -> Bool) -> Map k a -> Map k a
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0) Map k a
inner)
)
{-# INLINEABLE pack' #-}
totalSize :: Value -> Int
totalSize :: Value -> Int
totalSize (Value NestedMap
_ IntMap Int
_ Int
size Int
_) = Int
size
{-# INLINE totalSize #-}
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, Integer)])]
toList :: Value -> [(K, [(K, Integer)])]
toList = Map K [(K, Integer)] -> [(K, [(K, Integer)])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map K [(K, Integer)] -> [(K, [(K, Integer)])])
-> (Value -> Map K [(K, Integer)])
-> Value
-> [(K, [(K, Integer)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map K Integer -> [(K, Integer)])
-> NestedMap -> Map K [(K, Integer)]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Map K Integer -> [(K, Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList (NestedMap -> Map K [(K, Integer)])
-> (Value -> NestedMap) -> Value -> Map K [(K, Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> NestedMap
unpack
{-# INLINEABLE toList #-}
toFlatList :: Value -> [(K, K, Integer)]
toFlatList :: Value -> [(K, K, Integer)]
toFlatList (Value -> [(K, [(K, Integer)])]
toList -> [(K, [(K, Integer)])]
xs) = [(K
c, K
t, Integer
a) | (K
c, [(K, Integer)]
ys) <- [(K, [(K, Integer)])]
xs, (K
t, Integer
a) <- [(K, Integer)]
ys]
{-# INLINEABLE toFlatList #-}
fromList :: [(K, [(K, Integer)])] -> Value
fromList :: [(K, [(K, Integer)])] -> Value
fromList =
NestedMap -> Value
pack
(NestedMap -> Value)
-> ([(K, [(K, Integer)])] -> NestedMap)
-> [(K, [(K, Integer)])]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map K Integer -> Map K Integer -> Map K Integer)
-> [(K, Map K Integer)] -> NestedMap
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith ((Integer -> Integer -> Integer)
-> Map K Integer -> Map K Integer -> Map K Integer
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))
([(K, Map K Integer)] -> NestedMap)
-> ([(K, [(K, Integer)])] -> [(K, Map K Integer)])
-> [(K, [(K, Integer)])]
-> NestedMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((K, [(K, Integer)]) -> (K, Map K Integer))
-> [(K, [(K, Integer)])] -> [(K, Map K Integer)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(K, Integer)] -> Map K Integer)
-> (K, [(K, Integer)]) -> (K, Map K Integer)
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 ((Integer -> Integer -> Integer) -> [(K, Integer)] -> Map K Integer
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)))
{-# INLINEABLE fromList #-}
normalize :: NestedMap -> NestedMap
normalize :: NestedMap -> NestedMap
normalize = (Map K Integer -> Bool) -> NestedMap -> NestedMap
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool) -> (Map K Integer -> Bool) -> Map K Integer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map K Integer -> 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 Integer -> Map K Integer) -> NestedMap -> NestedMap
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((Integer -> Bool) -> Map K Integer -> Map K Integer
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0))
{-# INLINEABLE normalize #-}
instance Pretty Value where
pretty :: forall ann. Value -> Doc ann
pretty = [(Text, [(Text, Integer)])] -> Doc ann
forall ann. [(Text, [(Text, Integer)])] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([(Text, [(Text, Integer)])] -> Doc ann)
-> (Value -> [(Text, [(Text, Integer)])]) -> Value -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((K, [(K, Integer)]) -> (Text, [(Text, Integer)]))
-> [(K, [(K, Integer)])] -> [(Text, [(Text, Integer)])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((K -> Text)
-> ([(K, Integer)] -> [(Text, Integer)])
-> (K, [(K, Integer)])
-> (Text, [(Text, Integer)])
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, Integer) -> (Text, Integer))
-> [(K, Integer)] -> [(Text, Integer)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((K -> Text) -> (K, Integer) -> (Text, Integer)
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, Integer)])] -> [(Text, [(Text, Integer)])])
-> (Value -> [(K, [(K, Integer)])])
-> Value
-> [(Text, [(Text, Integer)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> [(K, [(K, Integer)])]
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
insertCoin :: ByteString -> ByteString -> Integer -> Value -> BuiltinResult Value
insertCoin :: ByteString -> ByteString -> Integer -> Value -> BuiltinResult Value
insertCoin ByteString
currency ByteString
token Integer
amt v :: Value
v@(Value NestedMap
outer IntMap Int
sizes Int
size Int
neg)
| Integer
amt 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
currency ByteString
token Value
v
| Bool
otherwise = case (ByteString -> Maybe K
k ByteString
currency, ByteString -> Maybe K
k ByteString
token) of
(Maybe K
Nothing, Maybe K
_) -> 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
currency)
(Maybe K
_, Maybe K
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: 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
token)
(Just K
ck, Just K
tk) ->
let f
:: Maybe (Map K Integer)
-> (
Either Int Integer
, Maybe (Map K Integer)
)
f :: Maybe (Map K Integer)
-> (Either Int Integer, Maybe (Map K Integer))
f = \case
Maybe (Map K Integer)
Nothing -> (Int -> Either Int Integer
forall a b. a -> Either a b
Left Int
0, Map K Integer -> Maybe (Map K Integer)
forall a. a -> Maybe a
Just (K -> Integer -> Map K Integer
forall k a. k -> a -> Map k a
Map.singleton K
tk Integer
amt))
Just Map K Integer
inner ->
let (Maybe Integer
moldAmt, Map K Integer
inner') =
(K -> Integer -> Integer -> Integer)
-> K -> Integer -> Map K Integer -> (Maybe Integer, Map K Integer)
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a)
Map.insertLookupWithKey (\K
_ Integer
_ Integer
_ -> Integer
amt) K
tk Integer
amt Map K Integer
inner
in (Either Int Integer
-> (Integer -> Either Int Integer)
-> Maybe Integer
-> Either Int Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> Either Int Integer
forall a b. a -> Either a b
Left (Map K Integer -> Int
forall k a. Map k a -> Int
Map.size Map K Integer
inner)) Integer -> Either Int Integer
forall a b. b -> Either a b
Right Maybe Integer
moldAmt, Map K Integer -> Maybe (Map K Integer)
forall a. a -> Maybe a
Just Map K Integer
inner')
(Either Int Integer
res, NestedMap
outer') = (Maybe (Map K Integer)
-> (Either Int Integer, Maybe (Map K Integer)))
-> K -> NestedMap -> (Either Int Integer, 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 Integer)
-> (Either Int Integer, Maybe (Map K Integer))
f K
ck NestedMap
outer
(IntMap Int
sizes', Int
size', Int
neg') = case Either Int Integer
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 Integer
amt Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then Int
neg Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
neg
)
Right Integer
oldAmt ->
( IntMap Int
sizes
, Int
size
, if Integer
oldAmt Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
&& Integer
amt Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0
then Int
neg Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
else
if Integer
oldAmt Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 Bool -> Bool -> Bool
&& Integer
amt Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
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 #-}
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, Integer)
mold, NestedMap
outer') = (Maybe (Map K Integer)
-> (Maybe (Int, Integer), Maybe (Map K Integer)))
-> K -> NestedMap -> (Maybe (Int, Integer), 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 Integer)
-> (Maybe (Int, Integer), Maybe (Map K Integer))
f K
currency NestedMap
outer
(IntMap Int
sizes', Int
size', Int
neg') = case Maybe (Int, Integer)
mold of
Just (Int
oldSize, Integer
oldAmt) ->
( 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 Integer
oldAmt Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then Int
neg Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 else Int
neg
)
Maybe (Int, Integer)
Nothing -> (IntMap Int
sizes, Int
size, Int
neg)
f
:: Maybe (Map K Integer)
-> (
Maybe (Int, Integer)
, Maybe (Map K Integer)
)
f :: Maybe (Map K Integer)
-> (Maybe (Int, Integer), Maybe (Map K Integer))
f = \case
Maybe (Map K Integer)
Nothing -> (Maybe (Int, Integer)
forall a. Maybe a
Nothing, Maybe (Map K Integer)
forall a. Maybe a
Nothing)
Just Map K Integer
inner ->
let (Maybe Integer
amt, Map K Integer
inner') = (K -> Integer -> Maybe Integer)
-> K -> Map K Integer -> (Maybe Integer, Map K Integer)
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
Map.updateLookupWithKey (\K
_ Integer
_ -> Maybe Integer
forall a. Maybe a
Nothing) K
token Map K Integer
inner
in ((Map K Integer -> Int
forall k a. Map k a -> Int
Map.size Map K Integer
inner,) (Integer -> (Int, Integer))
-> Maybe Integer -> Maybe (Int, Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
amt, if Map K Integer -> Bool
forall k a. Map k a -> Bool
Map.null Map K Integer
inner' then Maybe (Map K Integer)
forall a. Maybe a
Nothing else Map K Integer -> Maybe (Map K Integer)
forall a. a -> Maybe a
Just Map K Integer
inner')
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 Integer)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup K
currency NestedMap
outer of
Maybe (Map K Integer)
Nothing -> Integer
0
Just Map K Integer
inner -> Integer -> K -> Map K Integer -> Integer
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Integer
0 K
token Map K Integer
inner
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"
| Bool
otherwise = Bool -> BuiltinResult Bool
forall a. a -> BuiltinResult a
BuiltinSuccess (Bool -> BuiltinResult Bool)
-> (All -> Bool) -> All -> BuiltinResult Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. All -> Bool
getAll (All -> BuiltinResult Bool) -> All -> BuiltinResult Bool
forall a b. (a -> b) -> a -> b
$ (K -> Map K Integer -> All -> All) -> All -> NestedMap -> All
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey' K -> Map K Integer -> All -> All
go All
forall a. Monoid a => a
mempty (Value -> NestedMap
unpack Value
v2)
where
go :: K -> Map K Integer -> All -> All
go K
c Map K Integer
inner = All -> All -> All
forall a. Semigroup a => a -> a -> a
(<>) ((K -> Integer -> All -> All) -> All -> Map K Integer -> All
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey' K -> Integer -> All -> All
goInner All
forall a. Monoid a => a
mempty Map K Integer
inner)
where
goInner :: K -> Integer -> All -> All
goInner K
t Integer
a2 = All -> All -> All
forall a. Semigroup a => a -> a -> a
(<>) (Bool -> All
All (Bool -> All) -> Bool -> All
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Value -> Integer
lookupCoin (K -> ByteString
unK K
c) (K -> ByteString
unK K
t) Value
v1 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
a2)
{-# INLINEABLE valueContains #-}
unionValue :: Value -> Value -> Value
unionValue :: Value -> Value -> Value
unionValue (Value -> NestedMap
unpack -> NestedMap
vA) (Value -> NestedMap
unpack -> NestedMap
vB) =
NestedMap -> Value
pack' (NestedMap -> Value) -> NestedMap -> Value
forall a b. (a -> b) -> a -> b
$
SimpleWhenMissing K (Map K Integer) (Map K Integer)
-> SimpleWhenMissing K (Map K Integer) (Map K Integer)
-> SimpleWhenMatched
K (Map K Integer) (Map K Integer) (Map K Integer)
-> NestedMap
-> NestedMap
-> NestedMap
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
M.merge
SimpleWhenMissing K (Map K Integer) (Map K Integer)
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
M.preserveMissing
SimpleWhenMissing K (Map K Integer) (Map K Integer)
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
M.preserveMissing
( (K -> Map K Integer -> Map K Integer -> Maybe (Map K Integer))
-> SimpleWhenMatched
K (Map K Integer) (Map K Integer) (Map K Integer)
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
M.zipWithMaybeMatched ((K -> Map K Integer -> Map K Integer -> Maybe (Map K Integer))
-> SimpleWhenMatched
K (Map K Integer) (Map K Integer) (Map K Integer))
-> (K -> Map K Integer -> Map K Integer -> Maybe (Map K Integer))
-> SimpleWhenMatched
K (Map K Integer) (Map K Integer) (Map K Integer)
forall a b. (a -> b) -> a -> b
$ \K
_ Map K Integer
innerA Map K Integer
innerB ->
let inner :: Map K Integer
inner =
SimpleWhenMissing K Integer Integer
-> SimpleWhenMissing K Integer Integer
-> SimpleWhenMatched K Integer Integer Integer
-> Map K Integer
-> Map K Integer
-> Map K Integer
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
M.merge
SimpleWhenMissing K Integer Integer
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
M.preserveMissing
SimpleWhenMissing K Integer Integer
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
M.preserveMissing
( (K -> Integer -> Integer -> Maybe Integer)
-> SimpleWhenMatched K Integer Integer Integer
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
M.zipWithMaybeMatched ((K -> Integer -> Integer -> Maybe Integer)
-> SimpleWhenMatched K Integer Integer Integer)
-> (K -> Integer -> Integer -> Maybe Integer)
-> SimpleWhenMatched K Integer Integer Integer
forall a b. (a -> b) -> a -> b
$ \K
_ Integer
x Integer
y ->
let z :: Integer
z = Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
y in if Integer
z Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Maybe Integer
forall a. Maybe a
Nothing else Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
z
)
Map K Integer
innerA
Map K Integer
innerB
in if Map K Integer -> Bool
forall k a. Map k a -> Bool
Map.null Map K Integer
inner
then Maybe (Map K Integer)
forall a. Maybe a
Nothing
else
Map K Integer -> Maybe (Map K Integer)
forall a. a -> Maybe a
Just Map K Integer
inner
)
NestedMap
vA
NestedMap
vB
{-# INLINEABLE unionValue #-}
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 Integer) -> (Data, Data))
-> [(K, Map K Integer)] -> [(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 Integer -> Data) -> (K, Map K Integer) -> (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 Integer -> Data
tokensData) ([(K, Map K Integer)] -> [(Data, Data)])
-> (Value -> [(K, Map K Integer)]) -> Value -> [(Data, Data)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NestedMap -> [(K, Map K Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList (NestedMap -> [(K, Map K Integer)])
-> (Value -> NestedMap) -> Value -> [(K, Map K Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> NestedMap
unpack
where
tokensData :: Map K Integer -> Data
tokensData :: Map K Integer -> Data
tokensData = [(Data, Data)] -> Data
Map ([(Data, Data)] -> Data)
-> (Map K Integer -> [(Data, Data)]) -> Map K Integer -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((K, Integer) -> (Data, Data)) -> [(K, Integer)] -> [(Data, Data)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((K -> Data) -> (Integer -> Data) -> (K, Integer) -> (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) ([(K, Integer)] -> [(Data, Data)])
-> (Map K Integer -> [(K, Integer)])
-> Map K Integer
-> [(Data, Data)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map K Integer -> [(K, Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList
{-# INLINEABLE valueData #-}
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 -> ([(K, Map K Integer)] -> NestedMap)
-> BuiltinResult [(K, Map K Integer)] -> BuiltinResult NestedMap
forall a b. (a -> b) -> BuiltinResult a -> BuiltinResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Map K Integer -> Map K Integer -> Map K Integer)
-> [(K, Map K Integer)] -> NestedMap
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith ((Integer -> Integer -> Integer)
-> Map K Integer -> Map K Integer -> Map K Integer
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+))) (((Data, Data) -> BuiltinResult (K, Map K Integer))
-> [(Data, Data)] -> BuiltinResult [(K, Map K Integer)]
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 Integer))
-> (Data, Data)
-> BuiltinResult (K, Map K Integer)
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 Integer)
unTokens) [(Data, Data)]
cs)
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"
unI :: Data -> BuiltinResult Integer
unI :: Data -> BuiltinResult Integer
unI = \case
I Integer
i -> Integer -> BuiltinResult Integer
forall a. a -> BuiltinResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
i
Data
_ -> String -> BuiltinResult Integer
forall a. String -> BuiltinResult a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unValueData: non-I constructor"
unTokens :: Data -> BuiltinResult (Map K Integer)
unTokens :: Data -> BuiltinResult (Map K Integer)
unTokens = \case
Map [(Data, Data)]
ts -> ([(K, Integer)] -> Map K Integer)
-> BuiltinResult [(K, Integer)] -> BuiltinResult (Map K Integer)
forall a b. (a -> b) -> BuiltinResult a -> BuiltinResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Integer -> Integer -> Integer) -> [(K, Integer)] -> Map K Integer
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)) (((Data, Data) -> BuiltinResult (K, Integer))
-> [(Data, Data)] -> BuiltinResult [(K, Integer)]
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 Integer)
-> (Data, Data)
-> BuiltinResult (K, Integer)
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 Integer
unI) [(Data, Data)]
ts)
Data
_ -> String -> BuiltinResult (Map K Integer)
forall a. String -> BuiltinResult a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unValueData: non-Map constructor"
{-# INLINEABLE unValueData #-}
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 #-}