{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
module Cardano.Wallet.Primitive.Types.TokenMap
(
TokenMap
, AssetId (..)
, empty
, singleton
, fromFlatList
, fromNestedList
, fromNestedMap
, toFlatList
, toNestedList
, toNestedMap
, filter
, add
, subtract
, difference
, intersection
, size
, isEmpty
, isNotEmpty
, getQuantity
, setQuantity
, hasQuantity
, adjustQuantity
, removeQuantity
, maximumQuantity
, equipartitionAssets
, equipartitionQuantities
, equipartitionQuantitiesWithUpperBound
, Lexicographic (..)
, Flat (..)
, Nested (..)
, getAssets
, mapAssetIds
, unsafeSubtract
) where
import Prelude hiding
( filter, subtract )
import Algebra.PartialOrd
( PartialOrd (..) )
import Cardano.Numeric.Util
( equipartitionNatural )
import Cardano.Wallet.Primitive.Types.TokenPolicy
( TokenName, TokenPolicyId )
import Cardano.Wallet.Primitive.Types.TokenQuantity
( TokenQuantity (..) )
import Control.DeepSeq
( NFData )
import Control.Monad
( guard, when, (<=<) )
import Data.Aeson
( FromJSON (..), ToJSON (..), camelTo2, genericParseJSON, genericToJSON )
import Data.Aeson.Types
( Options (..), Parser )
import Data.Bifunctor
( first )
import Data.Functor
( ($>) )
import Data.Hashable
( Hashable (..), hashUsing )
import Data.List.NonEmpty
( NonEmpty (..) )
import Data.Map.Strict
( Map )
import Data.Map.Strict.NonEmptyMap
( NonEmptyMap )
import Data.Maybe
( fromMaybe, isJust )
import Data.Ord
( comparing )
import Data.Ratio
( (%) )
import Data.Set
( Set )
import Data.Text.Class
( toText )
import Fmt
( Buildable (..), Builder, blockListF', blockMapF )
import GHC.Generics
( Generic )
import GHC.TypeLits
( ErrorMessage (..), TypeError )
import Numeric.Natural
( Natural )
import Quiet
( Quiet (..) )
import qualified Cardano.Wallet.Primitive.Types.TokenQuantity as TokenQuantity
import qualified Data.Aeson as Aeson
import qualified Data.Foldable as F
import qualified Data.List as L
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import qualified Data.Map.Strict.NonEmptyMap as NEMap
import qualified Data.Set as Set
newtype TokenMap = TokenMap
{ TokenMap -> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
unTokenMap
:: Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
}
deriving stock (TokenMap -> TokenMap -> Bool
(TokenMap -> TokenMap -> Bool)
-> (TokenMap -> TokenMap -> Bool) -> Eq TokenMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenMap -> TokenMap -> Bool
$c/= :: TokenMap -> TokenMap -> Bool
== :: TokenMap -> TokenMap -> Bool
$c== :: TokenMap -> TokenMap -> Bool
Eq, (forall x. TokenMap -> Rep TokenMap x)
-> (forall x. Rep TokenMap x -> TokenMap) -> Generic TokenMap
forall x. Rep TokenMap x -> TokenMap
forall x. TokenMap -> Rep TokenMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenMap x -> TokenMap
$cfrom :: forall x. TokenMap -> Rep TokenMap x
Generic)
deriving (ReadPrec [TokenMap]
ReadPrec TokenMap
Int -> ReadS TokenMap
ReadS [TokenMap]
(Int -> ReadS TokenMap)
-> ReadS [TokenMap]
-> ReadPrec TokenMap
-> ReadPrec [TokenMap]
-> Read TokenMap
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TokenMap]
$creadListPrec :: ReadPrec [TokenMap]
readPrec :: ReadPrec TokenMap
$creadPrec :: ReadPrec TokenMap
readList :: ReadS [TokenMap]
$creadList :: ReadS [TokenMap]
readsPrec :: Int -> ReadS TokenMap
$creadsPrec :: Int -> ReadS TokenMap
Read, Int -> TokenMap -> ShowS
[TokenMap] -> ShowS
TokenMap -> String
(Int -> TokenMap -> ShowS)
-> (TokenMap -> String) -> ([TokenMap] -> ShowS) -> Show TokenMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenMap] -> ShowS
$cshowList :: [TokenMap] -> ShowS
show :: TokenMap -> String
$cshow :: TokenMap -> String
showsPrec :: Int -> TokenMap -> ShowS
$cshowsPrec :: Int -> TokenMap -> ShowS
Show) via (Quiet TokenMap)
instance NFData TokenMap
instance Hashable TokenMap where
hashWithSalt :: Int -> TokenMap -> Int
hashWithSalt = (TokenMap
-> [(TokenPolicyId, NonEmptyMap TokenName TokenQuantity)])
-> Int -> TokenMap -> Int
forall b a. Hashable b => (a -> b) -> Int -> a -> Int
hashUsing (Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> [(TokenPolicyId, NonEmptyMap TokenName TokenQuantity)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> [(TokenPolicyId, NonEmptyMap TokenName TokenQuantity)])
-> (TokenMap
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity))
-> TokenMap
-> [(TokenPolicyId, NonEmptyMap TokenName TokenQuantity)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenMap -> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
unTokenMap)
instance Semigroup TokenMap where
<> :: TokenMap -> TokenMap -> TokenMap
(<>) = TokenMap -> TokenMap -> TokenMap
add
instance Monoid TokenMap where
mempty :: TokenMap
mempty = TokenMap
empty
data AssetId = AssetId
{ AssetId -> TokenPolicyId
tokenPolicyId
:: !TokenPolicyId
, AssetId -> TokenName
tokenName
:: !TokenName
}
deriving stock (AssetId -> AssetId -> Bool
(AssetId -> AssetId -> Bool)
-> (AssetId -> AssetId -> Bool) -> Eq AssetId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssetId -> AssetId -> Bool
$c/= :: AssetId -> AssetId -> Bool
== :: AssetId -> AssetId -> Bool
$c== :: AssetId -> AssetId -> Bool
Eq, (forall x. AssetId -> Rep AssetId x)
-> (forall x. Rep AssetId x -> AssetId) -> Generic AssetId
forall x. Rep AssetId x -> AssetId
forall x. AssetId -> Rep AssetId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssetId x -> AssetId
$cfrom :: forall x. AssetId -> Rep AssetId x
Generic, Eq AssetId
Eq AssetId
-> (AssetId -> AssetId -> Ordering)
-> (AssetId -> AssetId -> Bool)
-> (AssetId -> AssetId -> Bool)
-> (AssetId -> AssetId -> Bool)
-> (AssetId -> AssetId -> Bool)
-> (AssetId -> AssetId -> AssetId)
-> (AssetId -> AssetId -> AssetId)
-> Ord AssetId
AssetId -> AssetId -> Bool
AssetId -> AssetId -> Ordering
AssetId -> AssetId -> AssetId
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
min :: AssetId -> AssetId -> AssetId
$cmin :: AssetId -> AssetId -> AssetId
max :: AssetId -> AssetId -> AssetId
$cmax :: AssetId -> AssetId -> AssetId
>= :: AssetId -> AssetId -> Bool
$c>= :: AssetId -> AssetId -> Bool
> :: AssetId -> AssetId -> Bool
$c> :: AssetId -> AssetId -> Bool
<= :: AssetId -> AssetId -> Bool
$c<= :: AssetId -> AssetId -> Bool
< :: AssetId -> AssetId -> Bool
$c< :: AssetId -> AssetId -> Bool
compare :: AssetId -> AssetId -> Ordering
$ccompare :: AssetId -> AssetId -> Ordering
$cp1Ord :: Eq AssetId
Ord, ReadPrec [AssetId]
ReadPrec AssetId
Int -> ReadS AssetId
ReadS [AssetId]
(Int -> ReadS AssetId)
-> ReadS [AssetId]
-> ReadPrec AssetId
-> ReadPrec [AssetId]
-> Read AssetId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssetId]
$creadListPrec :: ReadPrec [AssetId]
readPrec :: ReadPrec AssetId
$creadPrec :: ReadPrec AssetId
readList :: ReadS [AssetId]
$creadList :: ReadS [AssetId]
readsPrec :: Int -> ReadS AssetId
$creadsPrec :: Int -> ReadS AssetId
Read, Int -> AssetId -> ShowS
[AssetId] -> ShowS
AssetId -> String
(Int -> AssetId -> ShowS)
-> (AssetId -> String) -> ([AssetId] -> ShowS) -> Show AssetId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssetId] -> ShowS
$cshowList :: [AssetId] -> ShowS
show :: AssetId -> String
$cshow :: AssetId -> String
showsPrec :: Int -> AssetId -> ShowS
$cshowsPrec :: Int -> AssetId -> ShowS
Show)
instance NFData AssetId
instance TypeError ('Text "Ord not supported for token maps")
=> Ord TokenMap where
compare :: TokenMap -> TokenMap -> Ordering
compare = String -> TokenMap -> TokenMap -> Ordering
forall a. HasCallStack => String -> a
error String
"Ord not supported for token maps"
instance PartialOrd TokenMap where
TokenMap
m1 leq :: TokenMap -> TokenMap -> Bool
`leq` TokenMap
m2 = (AssetId -> Bool) -> Set AssetId -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all
(\AssetId
a -> TokenMap -> AssetId -> TokenQuantity
getQuantity TokenMap
m1 AssetId
a TokenQuantity -> TokenQuantity -> Bool
forall a. Ord a => a -> a -> Bool
<= TokenMap -> AssetId -> TokenQuantity
getQuantity TokenMap
m2 AssetId
a)
(TokenMap -> Set AssetId
getAssets TokenMap
m1 Set AssetId -> Set AssetId -> Set AssetId
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` TokenMap -> Set AssetId
getAssets TokenMap
m2)
newtype Lexicographic a = Lexicographic {Lexicographic a -> a
unLexicographic :: a}
deriving (Lexicographic a -> Lexicographic a -> Bool
(Lexicographic a -> Lexicographic a -> Bool)
-> (Lexicographic a -> Lexicographic a -> Bool)
-> Eq (Lexicographic a)
forall a. Eq a => Lexicographic a -> Lexicographic a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Lexicographic a -> Lexicographic a -> Bool
$c/= :: forall a. Eq a => Lexicographic a -> Lexicographic a -> Bool
== :: Lexicographic a -> Lexicographic a -> Bool
$c== :: forall a. Eq a => Lexicographic a -> Lexicographic a -> Bool
Eq, Int -> Lexicographic a -> ShowS
[Lexicographic a] -> ShowS
Lexicographic a -> String
(Int -> Lexicographic a -> ShowS)
-> (Lexicographic a -> String)
-> ([Lexicographic a] -> ShowS)
-> Show (Lexicographic a)
forall a. Show a => Int -> Lexicographic a -> ShowS
forall a. Show a => [Lexicographic a] -> ShowS
forall a. Show a => Lexicographic a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Lexicographic a] -> ShowS
$cshowList :: forall a. Show a => [Lexicographic a] -> ShowS
show :: Lexicographic a -> String
$cshow :: forall a. Show a => Lexicographic a -> String
showsPrec :: Int -> Lexicographic a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Lexicographic a -> ShowS
Show)
instance Ord (Lexicographic TokenMap) where
compare :: Lexicographic TokenMap -> Lexicographic TokenMap -> Ordering
compare = (Lexicographic TokenMap
-> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))])
-> Lexicographic TokenMap -> Lexicographic TokenMap -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (TokenMap -> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
toNestedList (TokenMap
-> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))])
-> (Lexicographic TokenMap -> TokenMap)
-> Lexicographic TokenMap
-> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexicographic TokenMap -> TokenMap
forall a. Lexicographic a -> a
unLexicographic)
newtype Flat a = Flat { Flat a -> a
getFlat :: a }
deriving stock (Flat a -> Flat a -> Bool
(Flat a -> Flat a -> Bool)
-> (Flat a -> Flat a -> Bool) -> Eq (Flat a)
forall a. Eq a => Flat a -> Flat a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flat a -> Flat a -> Bool
$c/= :: forall a. Eq a => Flat a -> Flat a -> Bool
== :: Flat a -> Flat a -> Bool
$c== :: forall a. Eq a => Flat a -> Flat a -> Bool
Eq, (forall x. Flat a -> Rep (Flat a) x)
-> (forall x. Rep (Flat a) x -> Flat a) -> Generic (Flat a)
forall x. Rep (Flat a) x -> Flat a
forall x. Flat a -> Rep (Flat a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Flat a) x -> Flat a
forall a x. Flat a -> Rep (Flat a) x
$cto :: forall a x. Rep (Flat a) x -> Flat a
$cfrom :: forall a x. Flat a -> Rep (Flat a) x
Generic, Eq (Flat a)
Eq (Flat a)
-> (Flat a -> Flat a -> Ordering)
-> (Flat a -> Flat a -> Bool)
-> (Flat a -> Flat a -> Bool)
-> (Flat a -> Flat a -> Bool)
-> (Flat a -> Flat a -> Bool)
-> (Flat a -> Flat a -> Flat a)
-> (Flat a -> Flat a -> Flat a)
-> Ord (Flat a)
Flat a -> Flat a -> Bool
Flat a -> Flat a -> Ordering
Flat a -> Flat a -> Flat a
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
forall a. Ord a => Eq (Flat a)
forall a. Ord a => Flat a -> Flat a -> Bool
forall a. Ord a => Flat a -> Flat a -> Ordering
forall a. Ord a => Flat a -> Flat a -> Flat a
min :: Flat a -> Flat a -> Flat a
$cmin :: forall a. Ord a => Flat a -> Flat a -> Flat a
max :: Flat a -> Flat a -> Flat a
$cmax :: forall a. Ord a => Flat a -> Flat a -> Flat a
>= :: Flat a -> Flat a -> Bool
$c>= :: forall a. Ord a => Flat a -> Flat a -> Bool
> :: Flat a -> Flat a -> Bool
$c> :: forall a. Ord a => Flat a -> Flat a -> Bool
<= :: Flat a -> Flat a -> Bool
$c<= :: forall a. Ord a => Flat a -> Flat a -> Bool
< :: Flat a -> Flat a -> Bool
$c< :: forall a. Ord a => Flat a -> Flat a -> Bool
compare :: Flat a -> Flat a -> Ordering
$ccompare :: forall a. Ord a => Flat a -> Flat a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Flat a)
Ord)
deriving Int -> Flat a -> ShowS
[Flat a] -> ShowS
Flat a -> String
(Int -> Flat a -> ShowS)
-> (Flat a -> String) -> ([Flat a] -> ShowS) -> Show (Flat a)
forall a. Show a => Int -> Flat a -> ShowS
forall a. Show a => [Flat a] -> ShowS
forall a. Show a => Flat a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flat a] -> ShowS
$cshowList :: forall a. Show a => [Flat a] -> ShowS
show :: Flat a -> String
$cshow :: forall a. Show a => Flat a -> String
showsPrec :: Int -> Flat a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Flat a -> ShowS
Show via (Quiet (Flat a))
newtype Nested a = Nested { Nested a -> a
getNested :: a }
deriving stock (Nested a -> Nested a -> Bool
(Nested a -> Nested a -> Bool)
-> (Nested a -> Nested a -> Bool) -> Eq (Nested a)
forall a. Eq a => Nested a -> Nested a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Nested a -> Nested a -> Bool
$c/= :: forall a. Eq a => Nested a -> Nested a -> Bool
== :: Nested a -> Nested a -> Bool
$c== :: forall a. Eq a => Nested a -> Nested a -> Bool
Eq, (forall x. Nested a -> Rep (Nested a) x)
-> (forall x. Rep (Nested a) x -> Nested a) -> Generic (Nested a)
forall x. Rep (Nested a) x -> Nested a
forall x. Nested a -> Rep (Nested a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Nested a) x -> Nested a
forall a x. Nested a -> Rep (Nested a) x
$cto :: forall a x. Rep (Nested a) x -> Nested a
$cfrom :: forall a x. Nested a -> Rep (Nested a) x
Generic, Eq (Nested a)
Eq (Nested a)
-> (Nested a -> Nested a -> Ordering)
-> (Nested a -> Nested a -> Bool)
-> (Nested a -> Nested a -> Bool)
-> (Nested a -> Nested a -> Bool)
-> (Nested a -> Nested a -> Bool)
-> (Nested a -> Nested a -> Nested a)
-> (Nested a -> Nested a -> Nested a)
-> Ord (Nested a)
Nested a -> Nested a -> Bool
Nested a -> Nested a -> Ordering
Nested a -> Nested a -> Nested a
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
forall a. Ord a => Eq (Nested a)
forall a. Ord a => Nested a -> Nested a -> Bool
forall a. Ord a => Nested a -> Nested a -> Ordering
forall a. Ord a => Nested a -> Nested a -> Nested a
min :: Nested a -> Nested a -> Nested a
$cmin :: forall a. Ord a => Nested a -> Nested a -> Nested a
max :: Nested a -> Nested a -> Nested a
$cmax :: forall a. Ord a => Nested a -> Nested a -> Nested a
>= :: Nested a -> Nested a -> Bool
$c>= :: forall a. Ord a => Nested a -> Nested a -> Bool
> :: Nested a -> Nested a -> Bool
$c> :: forall a. Ord a => Nested a -> Nested a -> Bool
<= :: Nested a -> Nested a -> Bool
$c<= :: forall a. Ord a => Nested a -> Nested a -> Bool
< :: Nested a -> Nested a -> Bool
$c< :: forall a. Ord a => Nested a -> Nested a -> Bool
compare :: Nested a -> Nested a -> Ordering
$ccompare :: forall a. Ord a => Nested a -> Nested a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Nested a)
Ord)
deriving Int -> Nested a -> ShowS
[Nested a] -> ShowS
Nested a -> String
(Int -> Nested a -> ShowS)
-> (Nested a -> String) -> ([Nested a] -> ShowS) -> Show (Nested a)
forall a. Show a => Int -> Nested a -> ShowS
forall a. Show a => [Nested a] -> ShowS
forall a. Show a => Nested a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Nested a] -> ShowS
$cshowList :: forall a. Show a => [Nested a] -> ShowS
show :: Nested a -> String
$cshow :: forall a. Show a => Nested a -> String
showsPrec :: Int -> Nested a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Nested a -> ShowS
Show via (Quiet (Nested a))
instance Buildable (Flat TokenMap) where
build :: Flat TokenMap -> Builder
build = TokenMap -> Builder
buildTokenMap (TokenMap -> Builder)
-> (Flat TokenMap -> TokenMap) -> Flat TokenMap -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flat TokenMap -> TokenMap
forall a. Flat a -> a
getFlat
where
buildTokenMap :: TokenMap -> Builder
buildTokenMap =
((AssetId, TokenQuantity) -> Builder)
-> [(AssetId, TokenQuantity)] -> Builder
forall (f :: * -> *) a.
Foldable f =>
(a -> Builder) -> f a -> Builder
buildList (AssetId, TokenQuantity) -> Builder
forall p. Buildable p => (AssetId, p) -> Builder
buildAssetQuantity ([(AssetId, TokenQuantity)] -> Builder)
-> (TokenMap -> [(AssetId, TokenQuantity)]) -> TokenMap -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenMap -> [(AssetId, TokenQuantity)]
toFlatList
buildAssetQuantity :: (AssetId, p) -> Builder
buildAssetQuantity (AssetId TokenPolicyId
policy TokenName
token, p
quantity) = [(String, Builder)] -> Builder
buildMap
[ (String
"policy",
TokenPolicyId -> Builder
forall p. Buildable p => p -> Builder
build TokenPolicyId
policy)
, (String
"token",
TokenName -> Builder
forall p. Buildable p => p -> Builder
build TokenName
token)
, (String
"quantity",
p -> Builder
forall p. Buildable p => p -> Builder
build p
quantity)
]
instance Buildable (Nested TokenMap) where
build :: Nested TokenMap -> Builder
build = Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity) -> Builder
buildTokenMap (Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> Builder)
-> (Nested TokenMap
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity))
-> Nested TokenMap
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenMap -> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
unTokenMap (TokenMap
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity))
-> (Nested TokenMap -> TokenMap)
-> Nested TokenMap
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nested TokenMap -> TokenMap
forall a. Nested a -> a
getNested
where
buildTokenMap :: Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity) -> Builder
buildTokenMap =
((TokenPolicyId, NonEmptyMap TokenName TokenQuantity) -> Builder)
-> [(TokenPolicyId, NonEmptyMap TokenName TokenQuantity)]
-> Builder
forall (f :: * -> *) a.
Foldable f =>
(a -> Builder) -> f a -> Builder
buildList (TokenPolicyId, NonEmptyMap TokenName TokenQuantity) -> Builder
forall p p p.
(Buildable p, Buildable p, Buildable p) =>
(p, NonEmptyMap p p) -> Builder
buildPolicy ([(TokenPolicyId, NonEmptyMap TokenName TokenQuantity)] -> Builder)
-> (Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> [(TokenPolicyId, NonEmptyMap TokenName TokenQuantity)])
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> [(TokenPolicyId, NonEmptyMap TokenName TokenQuantity)]
forall k a. Map k a -> [(k, a)]
Map.toList
buildPolicy :: (p, NonEmptyMap p p) -> Builder
buildPolicy (p
policy, NonEmptyMap p p
assetMap) = [(String, Builder)] -> Builder
buildMap
[ (String
"policy",
p -> Builder
forall p. Buildable p => p -> Builder
build p
policy)
, (String
"tokens",
((p, p) -> Builder) -> NonEmpty (p, p) -> Builder
forall (f :: * -> *) a.
Foldable f =>
(a -> Builder) -> f a -> Builder
buildList (p, p) -> Builder
forall p p. (Buildable p, Buildable p) => (p, p) -> Builder
buildTokenQuantity (NonEmptyMap p p -> NonEmpty (p, p)
forall k v. NonEmptyMap k v -> NonEmpty (k, v)
NEMap.toList NonEmptyMap p p
assetMap))
]
buildTokenQuantity :: (p, p) -> Builder
buildTokenQuantity (p
token, p
quantity) = [(String, Builder)] -> Builder
buildMap
[ (String
"token",
p -> Builder
forall p. Buildable p => p -> Builder
build p
token)
, (String
"quantity",
p -> Builder
forall p. Buildable p => p -> Builder
build p
quantity)
]
buildList :: Foldable f => (a -> Builder) -> f a -> Builder
buildList :: (a -> Builder) -> f a -> Builder
buildList = Text -> (a -> Builder) -> f a -> Builder
forall (f :: * -> *) a.
Foldable f =>
Text -> (a -> Builder) -> f a -> Builder
blockListF' Text
"-"
buildMap :: [(String, Builder)] -> Builder
buildMap :: [(String, Builder)] -> Builder
buildMap = [(String, Builder)] -> Builder
forall t k v.
(IsList t, Item t ~ (k, v), Buildable k, Buildable v) =>
t -> Builder
blockMapF ([(String, Builder)] -> Builder)
-> ([(String, Builder)] -> [(String, Builder)])
-> [(String, Builder)]
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Builder) -> (String, Builder))
-> [(String, Builder)] -> [(String, Builder)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShowS -> (String, Builder) -> (String, Builder)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ShowS -> (String, Builder) -> (String, Builder))
-> ShowS -> (String, Builder) -> (String, Builder)
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. a -> a
id @String)
jsonOptions :: Aeson.Options
jsonOptions :: Options
jsonOptions = Options
Aeson.defaultOptions
{ fieldLabelModifier :: ShowS
fieldLabelModifier = Char -> ShowS
camelTo2 Char
'_' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') }
jsonFailWith :: String -> Parser a
jsonFailWith :: String -> Parser a
jsonFailWith String
s = String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$
String
"Error while deserializing token map from JSON: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."
jsonFailWithEmptyTokenList :: TokenPolicyId -> Parser a
jsonFailWithEmptyTokenList :: TokenPolicyId -> Parser a
jsonFailWithEmptyTokenList TokenPolicyId
policy = String -> Parser a
forall a. String -> Parser a
jsonFailWith (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
[ String
"Encountered empty token list for policy"
, Text -> String
forall a. Show a => a -> String
show (TokenPolicyId -> Text
forall a. ToText a => a -> Text
toText TokenPolicyId
policy)
]
jsonFailWithZeroValueTokenQuantity :: TokenPolicyId -> TokenName -> Parser a
jsonFailWithZeroValueTokenQuantity :: TokenPolicyId -> TokenName -> Parser a
jsonFailWithZeroValueTokenQuantity TokenPolicyId
policy TokenName
token = String -> Parser a
forall a. String -> Parser a
jsonFailWith (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
[ String
"Encountered zero-valued quantity for token"
, Text -> String
forall a. Show a => a -> String
show (TokenName -> Text
forall a. ToText a => a -> Text
toText TokenName
token)
, String
"within policy"
, Text -> String
forall a. Show a => a -> String
show (TokenPolicyId -> Text
forall a. ToText a => a -> Text
toText TokenPolicyId
policy)
]
instance ToJSON (Flat TokenMap) where
toJSON :: Flat TokenMap -> Value
toJSON = [FlatAssetQuantity] -> Value
forall a. ToJSON a => a -> Value
toJSON ([FlatAssetQuantity] -> Value)
-> (Flat TokenMap -> [FlatAssetQuantity]) -> Flat TokenMap -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AssetId, TokenQuantity) -> FlatAssetQuantity)
-> [(AssetId, TokenQuantity)] -> [FlatAssetQuantity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AssetId, TokenQuantity) -> FlatAssetQuantity
fromTuple ([(AssetId, TokenQuantity)] -> [FlatAssetQuantity])
-> (Flat TokenMap -> [(AssetId, TokenQuantity)])
-> Flat TokenMap
-> [FlatAssetQuantity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenMap -> [(AssetId, TokenQuantity)]
toFlatList (TokenMap -> [(AssetId, TokenQuantity)])
-> (Flat TokenMap -> TokenMap)
-> Flat TokenMap
-> [(AssetId, TokenQuantity)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flat TokenMap -> TokenMap
forall a. Flat a -> a
getFlat
where
fromTuple :: (AssetId, TokenQuantity) -> FlatAssetQuantity
fromTuple (AssetId TokenPolicyId
p TokenName
t, TokenQuantity
q) = TokenPolicyId -> TokenName -> TokenQuantity -> FlatAssetQuantity
FlatAssetQuantity TokenPolicyId
p TokenName
t TokenQuantity
q
instance FromJSON (Flat TokenMap) where
parseJSON :: Value -> Parser (Flat TokenMap)
parseJSON =
([(AssetId, TokenQuantity)] -> Flat TokenMap)
-> Parser [(AssetId, TokenQuantity)] -> Parser (Flat TokenMap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TokenMap -> Flat TokenMap
forall a. a -> Flat a
Flat (TokenMap -> Flat TokenMap)
-> ([(AssetId, TokenQuantity)] -> TokenMap)
-> [(AssetId, TokenQuantity)]
-> Flat TokenMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(AssetId, TokenQuantity)] -> TokenMap
fromFlatList) (Parser [(AssetId, TokenQuantity)] -> Parser (Flat TokenMap))
-> ([FlatAssetQuantity] -> Parser [(AssetId, TokenQuantity)])
-> [FlatAssetQuantity]
-> Parser (Flat TokenMap)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FlatAssetQuantity -> Parser (AssetId, TokenQuantity))
-> [FlatAssetQuantity] -> Parser [(AssetId, TokenQuantity)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FlatAssetQuantity -> Parser (AssetId, TokenQuantity)
parseTuple ([FlatAssetQuantity] -> Parser (Flat TokenMap))
-> (Value -> Parser [FlatAssetQuantity])
-> Value
-> Parser (Flat TokenMap)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Parser [FlatAssetQuantity]
forall a. FromJSON a => Value -> Parser a
parseJSON
where
parseTuple :: FlatAssetQuantity -> Parser (AssetId, TokenQuantity)
parseTuple :: FlatAssetQuantity -> Parser (AssetId, TokenQuantity)
parseTuple (FlatAssetQuantity TokenPolicyId
p TokenName
t TokenQuantity
q) = do
Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TokenQuantity -> Bool
TokenQuantity.isZero TokenQuantity
q) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
TokenPolicyId -> TokenName -> Parser ()
forall a. TokenPolicyId -> TokenName -> Parser a
jsonFailWithZeroValueTokenQuantity TokenPolicyId
p TokenName
t
(AssetId, TokenQuantity) -> Parser (AssetId, TokenQuantity)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TokenPolicyId -> TokenName -> AssetId
AssetId TokenPolicyId
p TokenName
t, TokenQuantity
q)
data FlatAssetQuantity = FlatAssetQuantity
{ FlatAssetQuantity -> TokenPolicyId
_policyId :: !TokenPolicyId
, FlatAssetQuantity -> TokenName
_assetName :: !TokenName
, FlatAssetQuantity -> TokenQuantity
_quantity :: !TokenQuantity
} deriving (forall x. FlatAssetQuantity -> Rep FlatAssetQuantity x)
-> (forall x. Rep FlatAssetQuantity x -> FlatAssetQuantity)
-> Generic FlatAssetQuantity
forall x. Rep FlatAssetQuantity x -> FlatAssetQuantity
forall x. FlatAssetQuantity -> Rep FlatAssetQuantity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FlatAssetQuantity x -> FlatAssetQuantity
$cfrom :: forall x. FlatAssetQuantity -> Rep FlatAssetQuantity x
Generic
instance FromJSON FlatAssetQuantity where
parseJSON :: Value -> Parser FlatAssetQuantity
parseJSON = Options -> Value -> Parser FlatAssetQuantity
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOptions
instance ToJSON FlatAssetQuantity where
toJSON :: FlatAssetQuantity -> Value
toJSON = Options -> FlatAssetQuantity -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOptions
instance ToJSON (Nested TokenMap) where
toJSON :: Nested TokenMap -> Value
toJSON = [NestedMapEntry] -> Value
forall a. ToJSON a => a -> Value
toJSON ([NestedMapEntry] -> Value)
-> (Nested TokenMap -> [NestedMapEntry])
-> Nested TokenMap
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TokenPolicyId, NonEmpty (TokenName, TokenQuantity))
-> NestedMapEntry)
-> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
-> [NestedMapEntry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TokenPolicyId, NonEmpty (TokenName, TokenQuantity))
-> NestedMapEntry
mapOuter ([(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
-> [NestedMapEntry])
-> (Nested TokenMap
-> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))])
-> Nested TokenMap
-> [NestedMapEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenMap -> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
toNestedList (TokenMap
-> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))])
-> (Nested TokenMap -> TokenMap)
-> Nested TokenMap
-> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nested TokenMap -> TokenMap
forall a. Nested a -> a
getNested
where
mapOuter :: (TokenPolicyId, NonEmpty (TokenName, TokenQuantity))
-> NestedMapEntry
mapOuter = (TokenPolicyId -> [NestedTokenQuantity] -> NestedMapEntry)
-> (TokenPolicyId, [NestedTokenQuantity]) -> NestedMapEntry
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TokenPolicyId -> [NestedTokenQuantity] -> NestedMapEntry
NestedMapEntry ((TokenPolicyId, [NestedTokenQuantity]) -> NestedMapEntry)
-> ((TokenPolicyId, NonEmpty (TokenName, TokenQuantity))
-> (TokenPolicyId, [NestedTokenQuantity]))
-> (TokenPolicyId, NonEmpty (TokenName, TokenQuantity))
-> NestedMapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (TokenName, TokenQuantity) -> [NestedTokenQuantity])
-> (TokenPolicyId, NonEmpty (TokenName, TokenQuantity))
-> (TokenPolicyId, [NestedTokenQuantity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty (TokenName, TokenQuantity) -> [NestedTokenQuantity]
mapInner
mapInner :: NonEmpty (TokenName, TokenQuantity) -> [NestedTokenQuantity]
mapInner = NonEmpty NestedTokenQuantity -> [NestedTokenQuantity]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty NestedTokenQuantity -> [NestedTokenQuantity])
-> (NonEmpty (TokenName, TokenQuantity)
-> NonEmpty NestedTokenQuantity)
-> NonEmpty (TokenName, TokenQuantity)
-> [NestedTokenQuantity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TokenName, TokenQuantity) -> NestedTokenQuantity)
-> NonEmpty (TokenName, TokenQuantity)
-> NonEmpty NestedTokenQuantity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TokenName -> TokenQuantity -> NestedTokenQuantity)
-> (TokenName, TokenQuantity) -> NestedTokenQuantity
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TokenName -> TokenQuantity -> NestedTokenQuantity
NestedTokenQuantity)
instance FromJSON (Nested TokenMap) where
parseJSON :: Value -> Parser (Nested TokenMap)
parseJSON = [NestedMapEntry] -> Parser (Nested TokenMap)
parseEntryList ([NestedMapEntry] -> Parser (Nested TokenMap))
-> (Value -> Parser [NestedMapEntry])
-> Value
-> Parser (Nested TokenMap)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< FromJSON [NestedMapEntry] => Value -> Parser [NestedMapEntry]
forall a. FromJSON a => Value -> Parser a
parseJSON @[NestedMapEntry]
where
parseEntryList :: [NestedMapEntry] -> Parser (Nested TokenMap)
parseEntryList :: [NestedMapEntry] -> Parser (Nested TokenMap)
parseEntryList = ([(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
-> Nested TokenMap)
-> Parser [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
-> Parser (Nested TokenMap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TokenMap -> Nested TokenMap
forall a. a -> Nested a
Nested (TokenMap -> Nested TokenMap)
-> ([(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
-> TokenMap)
-> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
-> Nested TokenMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))] -> TokenMap
fromNestedList) (Parser [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
-> Parser (Nested TokenMap))
-> ([NestedMapEntry]
-> Parser [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))])
-> [NestedMapEntry]
-> Parser (Nested TokenMap)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NestedMapEntry
-> Parser (TokenPolicyId, NonEmpty (TokenName, TokenQuantity)))
-> [NestedMapEntry]
-> Parser [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM NestedMapEntry
-> Parser (TokenPolicyId, NonEmpty (TokenName, TokenQuantity))
parseEntry
parseEntry
:: NestedMapEntry
-> Parser (TokenPolicyId, NonEmpty (TokenName, TokenQuantity))
parseEntry :: NestedMapEntry
-> Parser (TokenPolicyId, NonEmpty (TokenName, TokenQuantity))
parseEntry (NestedMapEntry TokenPolicyId
policy [NestedTokenQuantity]
mTokens) = do
NonEmpty NestedTokenQuantity
tokens <- Parser (NonEmpty NestedTokenQuantity)
-> (NonEmpty NestedTokenQuantity
-> Parser (NonEmpty NestedTokenQuantity))
-> Maybe (NonEmpty NestedTokenQuantity)
-> Parser (NonEmpty NestedTokenQuantity)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (TokenPolicyId -> Parser (NonEmpty NestedTokenQuantity)
forall a. TokenPolicyId -> Parser a
jsonFailWithEmptyTokenList TokenPolicyId
policy) NonEmpty NestedTokenQuantity
-> Parser (NonEmpty NestedTokenQuantity)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (NonEmpty NestedTokenQuantity)
-> Parser (NonEmpty NestedTokenQuantity))
-> Maybe (NonEmpty NestedTokenQuantity)
-> Parser (NonEmpty NestedTokenQuantity)
forall a b. (a -> b) -> a -> b
$
[NestedTokenQuantity] -> Maybe (NonEmpty NestedTokenQuantity)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [NestedTokenQuantity]
mTokens
(TokenPolicyId
policy,) (NonEmpty (TokenName, TokenQuantity)
-> (TokenPolicyId, NonEmpty (TokenName, TokenQuantity)))
-> Parser (NonEmpty (TokenName, TokenQuantity))
-> Parser (TokenPolicyId, NonEmpty (TokenName, TokenQuantity))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NestedTokenQuantity -> Parser (TokenName, TokenQuantity))
-> NonEmpty NestedTokenQuantity
-> Parser (NonEmpty (TokenName, TokenQuantity))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TokenPolicyId
-> NestedTokenQuantity -> Parser (TokenName, TokenQuantity)
parseToken TokenPolicyId
policy) NonEmpty NestedTokenQuantity
tokens
parseToken
:: TokenPolicyId
-> NestedTokenQuantity
-> Parser (TokenName, TokenQuantity)
parseToken :: TokenPolicyId
-> NestedTokenQuantity -> Parser (TokenName, TokenQuantity)
parseToken TokenPolicyId
policy (NestedTokenQuantity TokenName
token TokenQuantity
quantity) = do
Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TokenQuantity -> Bool
TokenQuantity.isZero TokenQuantity
quantity) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
TokenPolicyId -> TokenName -> Parser ()
forall a. TokenPolicyId -> TokenName -> Parser a
jsonFailWithZeroValueTokenQuantity TokenPolicyId
policy TokenName
token
(TokenName, TokenQuantity) -> Parser (TokenName, TokenQuantity)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TokenName
token, TokenQuantity
quantity)
data NestedMapEntry = NestedMapEntry
{ NestedMapEntry -> TokenPolicyId
_policyId :: !TokenPolicyId
, NestedMapEntry -> [NestedTokenQuantity]
_tokens :: ![NestedTokenQuantity]
} deriving (forall x. NestedMapEntry -> Rep NestedMapEntry x)
-> (forall x. Rep NestedMapEntry x -> NestedMapEntry)
-> Generic NestedMapEntry
forall x. Rep NestedMapEntry x -> NestedMapEntry
forall x. NestedMapEntry -> Rep NestedMapEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NestedMapEntry x -> NestedMapEntry
$cfrom :: forall x. NestedMapEntry -> Rep NestedMapEntry x
Generic
data NestedTokenQuantity = NestedTokenQuantity
{ NestedTokenQuantity -> TokenName
_assetName :: !TokenName
, NestedTokenQuantity -> TokenQuantity
_quantity :: !TokenQuantity
} deriving (forall x. NestedTokenQuantity -> Rep NestedTokenQuantity x)
-> (forall x. Rep NestedTokenQuantity x -> NestedTokenQuantity)
-> Generic NestedTokenQuantity
forall x. Rep NestedTokenQuantity x -> NestedTokenQuantity
forall x. NestedTokenQuantity -> Rep NestedTokenQuantity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NestedTokenQuantity x -> NestedTokenQuantity
$cfrom :: forall x. NestedTokenQuantity -> Rep NestedTokenQuantity x
Generic
instance FromJSON NestedMapEntry where
parseJSON :: Value -> Parser NestedMapEntry
parseJSON = Options -> Value -> Parser NestedMapEntry
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOptions
instance ToJSON NestedMapEntry where
toJSON :: NestedMapEntry -> Value
toJSON = Options -> NestedMapEntry -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOptions
instance FromJSON NestedTokenQuantity where
parseJSON :: Value -> Parser NestedTokenQuantity
parseJSON = Options -> Value -> Parser NestedTokenQuantity
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOptions
instance ToJSON NestedTokenQuantity where
toJSON :: NestedTokenQuantity -> Value
toJSON = Options -> NestedTokenQuantity -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOptions
empty :: TokenMap
empty :: TokenMap
empty = Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity) -> TokenMap
TokenMap Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
forall a. Monoid a => a
mempty
singleton :: AssetId -> TokenQuantity -> TokenMap
singleton :: AssetId -> TokenQuantity -> TokenMap
singleton = TokenMap -> AssetId -> TokenQuantity -> TokenMap
setQuantity TokenMap
empty
fromFlatList :: [(AssetId, TokenQuantity)] -> TokenMap
fromFlatList :: [(AssetId, TokenQuantity)] -> TokenMap
fromFlatList = (TokenMap -> (AssetId, TokenQuantity) -> TokenMap)
-> TokenMap -> [(AssetId, TokenQuantity)] -> TokenMap
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' TokenMap -> (AssetId, TokenQuantity) -> TokenMap
acc TokenMap
empty
where
acc :: TokenMap -> (AssetId, TokenQuantity) -> TokenMap
acc TokenMap
b (AssetId
asset, TokenQuantity
quantity) = TokenMap -> AssetId -> (TokenQuantity -> TokenQuantity) -> TokenMap
adjustQuantity TokenMap
b AssetId
asset (TokenQuantity -> TokenQuantity -> TokenQuantity
forall a. Semigroup a => a -> a -> a
<> TokenQuantity
quantity)
fromNestedList
:: [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))] -> TokenMap
fromNestedList :: [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))] -> TokenMap
fromNestedList [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
entries = [(AssetId, TokenQuantity)] -> TokenMap
fromFlatList
[ (TokenPolicyId -> TokenName -> AssetId
AssetId TokenPolicyId
policy TokenName
token, TokenQuantity
quantity)
| (TokenPolicyId
policy, NonEmpty (TokenName, TokenQuantity)
tokenQuantities) <- [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
entries
, (TokenName
token, TokenQuantity
quantity) <- NonEmpty (TokenName, TokenQuantity) -> [(TokenName, TokenQuantity)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (TokenName, TokenQuantity)
tokenQuantities
]
fromNestedMap
:: Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> TokenMap
fromNestedMap :: Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity) -> TokenMap
fromNestedMap = [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))] -> TokenMap
fromNestedList ([(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
-> TokenMap)
-> (Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))])
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> TokenMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TokenPolicyId (NonEmpty (TokenName, TokenQuantity))
-> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TokenPolicyId (NonEmpty (TokenName, TokenQuantity))
-> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))])
-> (Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> Map TokenPolicyId (NonEmpty (TokenName, TokenQuantity)))
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmptyMap TokenName TokenQuantity
-> NonEmpty (TokenName, TokenQuantity))
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> Map TokenPolicyId (NonEmpty (TokenName, TokenQuantity))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmptyMap TokenName TokenQuantity
-> NonEmpty (TokenName, TokenQuantity)
forall k v. NonEmptyMap k v -> NonEmpty (k, v)
NEMap.toList
toFlatList :: TokenMap -> [(AssetId, TokenQuantity)]
toFlatList :: TokenMap -> [(AssetId, TokenQuantity)]
toFlatList TokenMap
b =
[ (TokenPolicyId -> TokenName -> AssetId
AssetId TokenPolicyId
policy TokenName
token, TokenQuantity
quantity)
| (TokenPolicyId
policy, NonEmpty (TokenName, TokenQuantity)
tokenQuantities) <- TokenMap -> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
toNestedList TokenMap
b
, (TokenName
token, TokenQuantity
quantity) <- NonEmpty (TokenName, TokenQuantity) -> [(TokenName, TokenQuantity)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (TokenName, TokenQuantity)
tokenQuantities
]
toNestedList
:: TokenMap -> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
toNestedList :: TokenMap -> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
toNestedList =
((TokenPolicyId, NonEmptyMap TokenName TokenQuantity)
-> (TokenPolicyId, NonEmpty (TokenName, TokenQuantity)))
-> [(TokenPolicyId, NonEmptyMap TokenName TokenQuantity)]
-> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NonEmptyMap TokenName TokenQuantity
-> NonEmpty (TokenName, TokenQuantity))
-> (TokenPolicyId, NonEmptyMap TokenName TokenQuantity)
-> (TokenPolicyId, NonEmpty (TokenName, TokenQuantity))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmptyMap TokenName TokenQuantity
-> NonEmpty (TokenName, TokenQuantity)
forall k v. NonEmptyMap k v -> NonEmpty (k, v)
NEMap.toList) ([(TokenPolicyId, NonEmptyMap TokenName TokenQuantity)]
-> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))])
-> (TokenMap
-> [(TokenPolicyId, NonEmptyMap TokenName TokenQuantity)])
-> TokenMap
-> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> [(TokenPolicyId, NonEmptyMap TokenName TokenQuantity)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> [(TokenPolicyId, NonEmptyMap TokenName TokenQuantity)])
-> (TokenMap
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity))
-> TokenMap
-> [(TokenPolicyId, NonEmptyMap TokenName TokenQuantity)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenMap -> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
unTokenMap
toNestedMap
:: TokenMap
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
toNestedMap :: TokenMap -> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
toNestedMap = TokenMap -> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
unTokenMap
filter :: (AssetId -> Bool) -> TokenMap -> TokenMap
filter :: (AssetId -> Bool) -> TokenMap -> TokenMap
filter AssetId -> Bool
f = [(AssetId, TokenQuantity)] -> TokenMap
fromFlatList ([(AssetId, TokenQuantity)] -> TokenMap)
-> (TokenMap -> [(AssetId, TokenQuantity)]) -> TokenMap -> TokenMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AssetId, TokenQuantity) -> Bool)
-> [(AssetId, TokenQuantity)] -> [(AssetId, TokenQuantity)]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (AssetId -> Bool
f (AssetId -> Bool)
-> ((AssetId, TokenQuantity) -> AssetId)
-> (AssetId, TokenQuantity)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AssetId, TokenQuantity) -> AssetId
forall a b. (a, b) -> a
fst) ([(AssetId, TokenQuantity)] -> [(AssetId, TokenQuantity)])
-> (TokenMap -> [(AssetId, TokenQuantity)])
-> TokenMap
-> [(AssetId, TokenQuantity)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenMap -> [(AssetId, TokenQuantity)]
toFlatList
add :: TokenMap -> TokenMap -> TokenMap
add :: TokenMap -> TokenMap -> TokenMap
add TokenMap
a TokenMap
b = (TokenMap -> (AssetId, TokenQuantity) -> TokenMap)
-> TokenMap -> [(AssetId, TokenQuantity)] -> TokenMap
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' TokenMap -> (AssetId, TokenQuantity) -> TokenMap
acc TokenMap
a ([(AssetId, TokenQuantity)] -> TokenMap)
-> [(AssetId, TokenQuantity)] -> TokenMap
forall a b. (a -> b) -> a -> b
$ TokenMap -> [(AssetId, TokenQuantity)]
toFlatList TokenMap
b
where
acc :: TokenMap -> (AssetId, TokenQuantity) -> TokenMap
acc TokenMap
c (AssetId
asset, TokenQuantity
quantity) =
TokenMap -> AssetId -> (TokenQuantity -> TokenQuantity) -> TokenMap
adjustQuantity TokenMap
c AssetId
asset (TokenQuantity -> TokenQuantity -> TokenQuantity
`TokenQuantity.add` TokenQuantity
quantity)
subtract :: TokenMap -> TokenMap -> Maybe TokenMap
subtract :: TokenMap -> TokenMap -> Maybe TokenMap
subtract TokenMap
a TokenMap
b = Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (TokenMap
b TokenMap -> TokenMap -> Bool
forall a. PartialOrd a => a -> a -> Bool
`leq` TokenMap
a) Maybe () -> TokenMap -> Maybe TokenMap
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TokenMap -> TokenMap -> TokenMap
unsafeSubtract TokenMap
a TokenMap
b
difference :: TokenMap -> TokenMap -> TokenMap
difference :: TokenMap -> TokenMap -> TokenMap
difference TokenMap
m1 TokenMap
m2 = (TokenMap -> (AssetId, TokenQuantity) -> TokenMap)
-> TokenMap -> [(AssetId, TokenQuantity)] -> TokenMap
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' TokenMap -> (AssetId, TokenQuantity) -> TokenMap
reduce TokenMap
m1 (TokenMap -> [(AssetId, TokenQuantity)]
toFlatList TokenMap
m2)
where
reduce :: TokenMap -> (AssetId, TokenQuantity) -> TokenMap
reduce :: TokenMap -> (AssetId, TokenQuantity) -> TokenMap
reduce TokenMap
m (AssetId
a, TokenQuantity
q) = TokenMap -> AssetId -> (TokenQuantity -> TokenQuantity) -> TokenMap
adjustQuantity TokenMap
m AssetId
a (TokenQuantity -> TokenQuantity -> TokenQuantity
`TokenQuantity.difference` TokenQuantity
q)
intersection :: TokenMap -> TokenMap -> TokenMap
intersection :: TokenMap -> TokenMap -> TokenMap
intersection TokenMap
m1 TokenMap
m2 =
[(AssetId, TokenQuantity)] -> TokenMap
fromFlatList (AssetId -> (AssetId, TokenQuantity)
getMinimumQuantity (AssetId -> (AssetId, TokenQuantity))
-> [AssetId] -> [(AssetId, TokenQuantity)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set AssetId -> [AssetId]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Set AssetId
sharedAssets)
where
getMinimumQuantity :: AssetId -> (AssetId, TokenQuantity)
getMinimumQuantity :: AssetId -> (AssetId, TokenQuantity)
getMinimumQuantity AssetId
a = (AssetId
a, ) (TokenQuantity -> (AssetId, TokenQuantity))
-> TokenQuantity -> (AssetId, TokenQuantity)
forall a b. (a -> b) -> a -> b
$ TokenQuantity -> TokenQuantity -> TokenQuantity
forall a. Ord a => a -> a -> a
min
(TokenMap -> AssetId -> TokenQuantity
getQuantity TokenMap
m1 AssetId
a)
(TokenMap -> AssetId -> TokenQuantity
getQuantity TokenMap
m2 AssetId
a)
sharedAssets :: Set AssetId
sharedAssets :: Set AssetId
sharedAssets = Set AssetId -> Set AssetId -> Set AssetId
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection (TokenMap -> Set AssetId
getAssets TokenMap
m1) (TokenMap -> Set AssetId
getAssets TokenMap
m2)
size :: TokenMap -> Int
size :: TokenMap -> Int
size = Set AssetId -> Int
forall a. Set a -> Int
Set.size (Set AssetId -> Int)
-> (TokenMap -> Set AssetId) -> TokenMap -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenMap -> Set AssetId
getAssets
isEmpty :: TokenMap -> Bool
isEmpty :: TokenMap -> Bool
isEmpty = (TokenMap -> TokenMap -> Bool
forall a. Eq a => a -> a -> Bool
== TokenMap
empty)
isNotEmpty :: TokenMap -> Bool
isNotEmpty :: TokenMap -> Bool
isNotEmpty = (TokenMap -> TokenMap -> Bool
forall a. Eq a => a -> a -> Bool
/= TokenMap
empty)
getQuantity :: TokenMap -> AssetId -> TokenQuantity
getQuantity :: TokenMap -> AssetId -> TokenQuantity
getQuantity (TokenMap Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
m) (AssetId TokenPolicyId
policy TokenName
token) =
TokenQuantity -> Maybe TokenQuantity -> TokenQuantity
forall a. a -> Maybe a -> a
fromMaybe TokenQuantity
TokenQuantity.zero (Maybe TokenQuantity -> TokenQuantity)
-> Maybe TokenQuantity -> TokenQuantity
forall a b. (a -> b) -> a -> b
$ TokenName
-> NonEmptyMap TokenName TokenQuantity -> Maybe TokenQuantity
forall k v. Ord k => k -> NonEmptyMap k v -> Maybe v
NEMap.lookup TokenName
token (NonEmptyMap TokenName TokenQuantity -> Maybe TokenQuantity)
-> Maybe (NonEmptyMap TokenName TokenQuantity)
-> Maybe TokenQuantity
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TokenPolicyId
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> Maybe (NonEmptyMap TokenName TokenQuantity)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TokenPolicyId
policy Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
m
setQuantity :: TokenMap -> AssetId -> TokenQuantity -> TokenMap
setQuantity :: TokenMap -> AssetId -> TokenQuantity -> TokenMap
setQuantity originalMap :: TokenMap
originalMap@(TokenMap Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
m) (AssetId TokenPolicyId
policy TokenName
token) TokenQuantity
quantity =
case TokenMap
-> TokenPolicyId -> Maybe (NonEmptyMap TokenName TokenQuantity)
getPolicyMap TokenMap
originalMap TokenPolicyId
policy of
Maybe (NonEmptyMap TokenName TokenQuantity)
Nothing | TokenQuantity -> Bool
TokenQuantity.isZero TokenQuantity
quantity ->
TokenMap
originalMap
Maybe (NonEmptyMap TokenName TokenQuantity)
Nothing ->
TokenMap
createPolicyMap
Just NonEmptyMap TokenName TokenQuantity
policyMap | TokenQuantity -> Bool
TokenQuantity.isZero TokenQuantity
quantity ->
NonEmptyMap TokenName TokenQuantity -> TokenMap
removeQuantityFromPolicyMap NonEmptyMap TokenName TokenQuantity
policyMap
Just NonEmptyMap TokenName TokenQuantity
policyMap ->
NonEmptyMap TokenName TokenQuantity -> TokenMap
updateQuantityInPolicyMap NonEmptyMap TokenName TokenQuantity
policyMap
where
createPolicyMap :: TokenMap
createPolicyMap = Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity) -> TokenMap
TokenMap
(Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> TokenMap)
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> TokenMap
forall a b. (a -> b) -> a -> b
$ (NonEmptyMap TokenName TokenQuantity
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity))
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> NonEmptyMap TokenName TokenQuantity
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TokenPolicyId
-> NonEmptyMap TokenName TokenQuantity
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TokenPolicyId
policy) Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
m
(NonEmptyMap TokenName TokenQuantity
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity))
-> NonEmptyMap TokenName TokenQuantity
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
forall a b. (a -> b) -> a -> b
$ TokenName -> TokenQuantity -> NonEmptyMap TokenName TokenQuantity
forall k v. Ord k => k -> v -> NonEmptyMap k v
NEMap.singleton TokenName
token TokenQuantity
quantity
removeQuantityFromPolicyMap :: NonEmptyMap TokenName TokenQuantity -> TokenMap
removeQuantityFromPolicyMap NonEmptyMap TokenName TokenQuantity
policyMap =
case TokenName
-> NonEmptyMap TokenName TokenQuantity
-> Maybe (NonEmptyMap TokenName TokenQuantity)
forall k a.
Ord k =>
k -> NonEmptyMap k a -> Maybe (NonEmptyMap k a)
NEMap.delete TokenName
token NonEmptyMap TokenName TokenQuantity
policyMap of
Maybe (NonEmptyMap TokenName TokenQuantity)
Nothing ->
Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity) -> TokenMap
TokenMap (Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> TokenMap)
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> TokenMap
forall a b. (a -> b) -> a -> b
$ TokenPolicyId
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete TokenPolicyId
policy Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
m
Just NonEmptyMap TokenName TokenQuantity
newPolicyMap ->
Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity) -> TokenMap
TokenMap (Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> TokenMap)
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> TokenMap
forall a b. (a -> b) -> a -> b
$ TokenPolicyId
-> NonEmptyMap TokenName TokenQuantity
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TokenPolicyId
policy NonEmptyMap TokenName TokenQuantity
newPolicyMap Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
m
updateQuantityInPolicyMap :: NonEmptyMap TokenName TokenQuantity -> TokenMap
updateQuantityInPolicyMap NonEmptyMap TokenName TokenQuantity
policyMap = Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity) -> TokenMap
TokenMap
(Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> TokenMap)
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> TokenMap
forall a b. (a -> b) -> a -> b
$ (NonEmptyMap TokenName TokenQuantity
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity))
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> NonEmptyMap TokenName TokenQuantity
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TokenPolicyId
-> NonEmptyMap TokenName TokenQuantity
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TokenPolicyId
policy) Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
m
(NonEmptyMap TokenName TokenQuantity
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity))
-> NonEmptyMap TokenName TokenQuantity
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
forall a b. (a -> b) -> a -> b
$ TokenName
-> TokenQuantity
-> NonEmptyMap TokenName TokenQuantity
-> NonEmptyMap TokenName TokenQuantity
forall k v. Ord k => k -> v -> NonEmptyMap k v -> NonEmptyMap k v
NEMap.insert TokenName
token TokenQuantity
quantity NonEmptyMap TokenName TokenQuantity
policyMap
hasQuantity :: TokenMap -> AssetId -> Bool
hasQuantity :: TokenMap -> AssetId -> Bool
hasQuantity (TokenMap Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
m) (AssetId TokenPolicyId
policy TokenName
token) =
Maybe TokenQuantity -> Bool
forall a. Maybe a -> Bool
isJust (Maybe TokenQuantity -> Bool) -> Maybe TokenQuantity -> Bool
forall a b. (a -> b) -> a -> b
$ TokenName
-> NonEmptyMap TokenName TokenQuantity -> Maybe TokenQuantity
forall k v. Ord k => k -> NonEmptyMap k v -> Maybe v
NEMap.lookup TokenName
token (NonEmptyMap TokenName TokenQuantity -> Maybe TokenQuantity)
-> Maybe (NonEmptyMap TokenName TokenQuantity)
-> Maybe TokenQuantity
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TokenPolicyId
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> Maybe (NonEmptyMap TokenName TokenQuantity)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TokenPolicyId
policy Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
m
adjustQuantity
:: TokenMap
-> AssetId
-> (TokenQuantity -> TokenQuantity)
-> TokenMap
adjustQuantity :: TokenMap -> AssetId -> (TokenQuantity -> TokenQuantity) -> TokenMap
adjustQuantity TokenMap
m AssetId
asset TokenQuantity -> TokenQuantity
adjust =
TokenMap -> AssetId -> TokenQuantity -> TokenMap
setQuantity TokenMap
m AssetId
asset (TokenQuantity -> TokenMap) -> TokenQuantity -> TokenMap
forall a b. (a -> b) -> a -> b
$ TokenQuantity -> TokenQuantity
adjust (TokenQuantity -> TokenQuantity) -> TokenQuantity -> TokenQuantity
forall a b. (a -> b) -> a -> b
$ TokenMap -> AssetId -> TokenQuantity
getQuantity TokenMap
m AssetId
asset
removeQuantity :: TokenMap -> AssetId -> TokenMap
removeQuantity :: TokenMap -> AssetId -> TokenMap
removeQuantity TokenMap
m AssetId
asset = TokenMap -> AssetId -> TokenQuantity -> TokenMap
setQuantity TokenMap
m AssetId
asset TokenQuantity
TokenQuantity.zero
maximumQuantity :: TokenMap -> TokenQuantity
maximumQuantity :: TokenMap -> TokenQuantity
maximumQuantity =
(TokenQuantity
-> NonEmptyMap TokenName TokenQuantity -> TokenQuantity)
-> TokenQuantity
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> TokenQuantity
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' (\TokenQuantity
a -> (TokenQuantity -> TokenQuantity -> TokenQuantity)
-> TokenQuantity -> Map TokenName TokenQuantity -> TokenQuantity
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr TokenQuantity -> TokenQuantity -> TokenQuantity
findMaximum TokenQuantity
a (Map TokenName TokenQuantity -> TokenQuantity)
-> (NonEmptyMap TokenName TokenQuantity
-> Map TokenName TokenQuantity)
-> NonEmptyMap TokenName TokenQuantity
-> TokenQuantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyMap TokenName TokenQuantity -> Map TokenName TokenQuantity
forall k v. Ord k => NonEmptyMap k v -> Map k v
NEMap.toMap) TokenQuantity
zero (Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> TokenQuantity)
-> (TokenMap
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity))
-> TokenMap
-> TokenQuantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenMap -> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
unTokenMap
where
zero :: TokenQuantity
zero :: TokenQuantity
zero = Natural -> TokenQuantity
TokenQuantity Natural
0
findMaximum :: TokenQuantity -> TokenQuantity -> TokenQuantity
findMaximum :: TokenQuantity -> TokenQuantity -> TokenQuantity
findMaximum TokenQuantity
challenger TokenQuantity
champion
| TokenQuantity
challenger TokenQuantity -> TokenQuantity -> Bool
forall a. Ord a => a -> a -> Bool
> TokenQuantity
champion =
TokenQuantity
challenger
| Bool
otherwise =
TokenQuantity
champion
equipartitionAssets
:: TokenMap
-> NonEmpty a
-> NonEmpty TokenMap
equipartitionAssets :: TokenMap -> NonEmpty a -> NonEmpty TokenMap
equipartitionAssets TokenMap
m NonEmpty a
mapCount =
[(AssetId, TokenQuantity)] -> TokenMap
fromFlatList ([(AssetId, TokenQuantity)] -> TokenMap)
-> NonEmpty [(AssetId, TokenQuantity)] -> NonEmpty TokenMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((NonEmpty Int, [(AssetId, TokenQuantity)])
-> ([(AssetId, TokenQuantity)],
Maybe (NonEmpty Int, [(AssetId, TokenQuantity)])))
-> (NonEmpty Int, [(AssetId, TokenQuantity)])
-> NonEmpty [(AssetId, TokenQuantity)]
forall a b. (a -> (b, Maybe a)) -> a -> NonEmpty b
NE.unfoldr (NonEmpty Int, [(AssetId, TokenQuantity)])
-> ([(AssetId, TokenQuantity)],
Maybe (NonEmpty Int, [(AssetId, TokenQuantity)]))
forall aq.
(NonEmpty Int, [aq]) -> ([aq], Maybe (NonEmpty Int, [aq]))
generateChunk (NonEmpty Int
assetCounts, TokenMap -> [(AssetId, TokenQuantity)]
toFlatList TokenMap
m)
where
assetCount :: Int
assetCount :: Int
assetCount = Set AssetId -> Int
forall a. Set a -> Int
Set.size (Set AssetId -> Int) -> Set AssetId -> Int
forall a b. (a -> b) -> a -> b
$ TokenMap -> Set AssetId
getAssets TokenMap
m
assetCounts :: NonEmpty Int
assetCounts :: NonEmpty Int
assetCounts = (Integral Natural, Num Int) => Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Natural @Int (Natural -> Int) -> NonEmpty Natural -> NonEmpty Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Natural -> NonEmpty a -> NonEmpty Natural
forall a. HasCallStack => Natural -> NonEmpty a -> NonEmpty Natural
equipartitionNatural (Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Natural Int
assetCount) NonEmpty a
mapCount
generateChunk :: (NonEmpty Int, [aq]) -> ([aq], Maybe (NonEmpty Int, [aq]))
generateChunk :: (NonEmpty Int, [aq]) -> ([aq], Maybe (NonEmpty Int, [aq]))
generateChunk (Int
c :| [Int]
mcs, [aq]
aqs) = case [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Int]
mcs of
Just NonEmpty Int
cs -> ([aq]
prefix, (NonEmpty Int, [aq]) -> Maybe (NonEmpty Int, [aq])
forall a. a -> Maybe a
Just (NonEmpty Int
cs, [aq]
suffix))
Maybe (NonEmpty Int)
Nothing -> ([aq]
aqs, Maybe (NonEmpty Int, [aq])
forall a. Maybe a
Nothing)
where
([aq]
prefix, [aq]
suffix) = Int -> [aq] -> ([aq], [aq])
forall a. Int -> [a] -> ([a], [a])
L.splitAt Int
c [aq]
aqs
equipartitionQuantities
:: TokenMap
-> NonEmpty a
-> NonEmpty TokenMap
equipartitionQuantities :: TokenMap -> NonEmpty a -> NonEmpty TokenMap
equipartitionQuantities TokenMap
m NonEmpty a
count =
(NonEmpty TokenMap
-> (AssetId, TokenQuantity) -> NonEmpty TokenMap)
-> NonEmpty TokenMap
-> [(AssetId, TokenQuantity)]
-> NonEmpty TokenMap
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' NonEmpty TokenMap -> (AssetId, TokenQuantity) -> NonEmpty TokenMap
accumulate (TokenMap
empty TokenMap -> NonEmpty a -> NonEmpty TokenMap
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ NonEmpty a
count) (TokenMap -> [(AssetId, TokenQuantity)]
toFlatList TokenMap
m)
where
accumulate
:: NonEmpty TokenMap
-> (AssetId, TokenQuantity)
-> NonEmpty TokenMap
accumulate :: NonEmpty TokenMap -> (AssetId, TokenQuantity) -> NonEmpty TokenMap
accumulate NonEmpty TokenMap
maps (AssetId
asset, TokenQuantity
quantity) = (TokenMap -> TokenMap -> TokenMap)
-> NonEmpty TokenMap -> NonEmpty TokenMap -> NonEmpty TokenMap
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith TokenMap -> TokenMap -> TokenMap
forall a. Semigroup a => a -> a -> a
(<>) NonEmpty TokenMap
maps (NonEmpty TokenMap -> NonEmpty TokenMap)
-> NonEmpty TokenMap -> NonEmpty TokenMap
forall a b. (a -> b) -> a -> b
$
AssetId -> TokenQuantity -> TokenMap
singleton AssetId
asset (TokenQuantity -> TokenMap)
-> NonEmpty TokenQuantity -> NonEmpty TokenMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
TokenQuantity -> NonEmpty a -> NonEmpty TokenQuantity
forall a. TokenQuantity -> NonEmpty a -> NonEmpty TokenQuantity
TokenQuantity.equipartition TokenQuantity
quantity NonEmpty a
count
equipartitionQuantitiesWithUpperBound
:: TokenMap
-> TokenQuantity
-> NonEmpty TokenMap
equipartitionQuantitiesWithUpperBound :: TokenMap -> TokenQuantity -> NonEmpty TokenMap
equipartitionQuantitiesWithUpperBound TokenMap
m (TokenQuantity Natural
maxQuantity)
| Natural
maxQuantity Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
0 =
NonEmpty TokenMap
forall a. a
maxQuantityZeroError
| Natural
currentMaxQuantity Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
maxQuantity =
TokenMap
m TokenMap -> [TokenMap] -> NonEmpty TokenMap
forall a. a -> [a] -> NonEmpty a
:| []
| Bool
otherwise =
TokenMap -> NonEmpty () -> NonEmpty TokenMap
forall a. TokenMap -> NonEmpty a -> NonEmpty TokenMap
equipartitionQuantities TokenMap
m (() () -> [()] -> NonEmpty ()
forall a. a -> [a] -> NonEmpty a
:| Int -> () -> [()]
forall a. Int -> a -> [a]
replicate Int
extraPartCount ())
where
TokenQuantity Natural
currentMaxQuantity = TokenMap -> TokenQuantity
maximumQuantity TokenMap
m
extraPartCount :: Int
extraPartCount :: Int
extraPartCount = Ratio Natural -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Ratio Natural -> Int) -> Ratio Natural -> Int
forall a b. (a -> b) -> a -> b
$ Natural -> Natural
forall a. Enum a => a -> a
pred Natural
currentMaxQuantity Natural -> Natural -> Ratio Natural
forall a. Integral a => a -> a -> Ratio a
% Natural
maxQuantity
maxQuantityZeroError :: a
maxQuantityZeroError = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
[ String
"equipartitionQuantitiesWithUpperBound:"
, String
"the maximum allowable token quantity cannot be zero."
]
getAssets :: TokenMap -> Set AssetId
getAssets :: TokenMap -> Set AssetId
getAssets = [AssetId] -> Set AssetId
forall a. Ord a => [a] -> Set a
Set.fromList ([AssetId] -> Set AssetId)
-> (TokenMap -> [AssetId]) -> TokenMap -> Set AssetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AssetId, TokenQuantity) -> AssetId)
-> [(AssetId, TokenQuantity)] -> [AssetId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AssetId, TokenQuantity) -> AssetId
forall a b. (a, b) -> a
fst ([(AssetId, TokenQuantity)] -> [AssetId])
-> (TokenMap -> [(AssetId, TokenQuantity)])
-> TokenMap
-> [AssetId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenMap -> [(AssetId, TokenQuantity)]
toFlatList
mapAssetIds :: (AssetId -> AssetId) -> TokenMap -> TokenMap
mapAssetIds :: (AssetId -> AssetId) -> TokenMap -> TokenMap
mapAssetIds AssetId -> AssetId
f TokenMap
m = [(AssetId, TokenQuantity)] -> TokenMap
fromFlatList ([(AssetId, TokenQuantity)] -> TokenMap)
-> [(AssetId, TokenQuantity)] -> TokenMap
forall a b. (a -> b) -> a -> b
$ (AssetId -> AssetId)
-> (AssetId, TokenQuantity) -> (AssetId, TokenQuantity)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first AssetId -> AssetId
f ((AssetId, TokenQuantity) -> (AssetId, TokenQuantity))
-> [(AssetId, TokenQuantity)] -> [(AssetId, TokenQuantity)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenMap -> [(AssetId, TokenQuantity)]
toFlatList TokenMap
m
unsafeSubtract :: TokenMap -> TokenMap -> TokenMap
unsafeSubtract :: TokenMap -> TokenMap -> TokenMap
unsafeSubtract TokenMap
a TokenMap
b = (TokenMap -> (AssetId, TokenQuantity) -> TokenMap)
-> TokenMap -> [(AssetId, TokenQuantity)] -> TokenMap
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' TokenMap -> (AssetId, TokenQuantity) -> TokenMap
acc TokenMap
a ([(AssetId, TokenQuantity)] -> TokenMap)
-> [(AssetId, TokenQuantity)] -> TokenMap
forall a b. (a -> b) -> a -> b
$ TokenMap -> [(AssetId, TokenQuantity)]
toFlatList TokenMap
b
where
acc :: TokenMap -> (AssetId, TokenQuantity) -> TokenMap
acc TokenMap
c (AssetId
asset, TokenQuantity
quantity) =
TokenMap -> AssetId -> (TokenQuantity -> TokenQuantity) -> TokenMap
adjustQuantity TokenMap
c AssetId
asset (TokenQuantity -> TokenQuantity -> TokenQuantity
`TokenQuantity.unsafeSubtract` TokenQuantity
quantity)
getPolicyMap
:: TokenMap
-> TokenPolicyId
-> Maybe (NonEmptyMap TokenName TokenQuantity)
getPolicyMap :: TokenMap
-> TokenPolicyId -> Maybe (NonEmptyMap TokenName TokenQuantity)
getPolicyMap TokenMap
b TokenPolicyId
policy = TokenPolicyId
-> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
-> Maybe (NonEmptyMap TokenName TokenQuantity)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TokenPolicyId
policy (TokenMap -> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
unTokenMap TokenMap
b)