{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Provides the 'TokenMap' type, which represents a map of named non-ada
--   token quantities scoped by token policy.
--
-- The 'TokenMap' type does not provide a way to store ada quantities. If you
-- also need to store ada quantities, use the 'TokenBundle' type.
--
-- This module is meant to be imported qualified. For example:
--
-- >>> import qualified Cardano.Wallet.Primitive.Types.TokenMap as TM
--
module Cardano.Wallet.Primitive.Types.TokenMap
    (
    -- * Types

      -- Important:
      --
      -- The default data constructor for 'TokenMap' is not exported, by design,
      -- as the internal data structure has an invariant that must be preserved
      -- across all operations.
      --
      -- Exporting the default constructor would make it possible for functions
      -- outside the 'TokenMap' module to break the invariant, opening the door
      -- to subtle regressions.
      --
      -- See the definition of 'TokenMap' for more details of the invariant.
      --
      -- To construct a 'TokenMap', use one of the provided constructors, all
      -- of which are tested to check that they respect the invariant.
      --
      TokenMap
    , AssetId (..)

    -- * Construction
    , empty
    , singleton
    , fromFlatList
    , fromNestedList
    , fromNestedMap

    -- * Deconstruction
    , toFlatList
    , toNestedList
    , toNestedMap

    -- * Filtering
    , filter

    -- * Arithmetic
    , add
    , subtract
    , difference
    , intersection

    -- * Queries
    , size

    -- * Tests
    , isEmpty
    , isNotEmpty

    -- * Quantities
    , getQuantity
    , setQuantity
    , hasQuantity
    , adjustQuantity
    , removeQuantity
    , maximumQuantity

    -- * Partitioning
    , equipartitionAssets
    , equipartitionQuantities
    , equipartitionQuantitiesWithUpperBound

    -- * Ordering
    , Lexicographic (..)

    -- * Serialization
    , Flat (..)
    , Nested (..)

    -- * Queries
    , getAssets

    -- * Transformations
    , mapAssetIds

    -- * Unsafe operations
    , 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

--------------------------------------------------------------------------------
-- Types
--------------------------------------------------------------------------------

-- | A map of named token quantities, grouped by token policy.
--
-- The token map data structure has an important invariant: all token
-- quantities held within a map are non-zero.
--
-- This means that:
--
--   - using the 'setQuantity' function to add a zero-valued quantity to a
--     map is equivalent to applying the identity operation to that map.
--
--   - using the 'setQuantity' function to change an existing quantity to zero
--     is equivalent to removing that quantity from the map.
--
-- As a consequence of this invariant, the token map data structure is
-- always in its canonical form: we can perform an equality check without
-- needing any extra canonicalization steps.
--
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

-- | A combination of a token policy identifier and a token name that can be
--   used as a compound identifier.
--
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

--------------------------------------------------------------------------------
-- Ordering
--------------------------------------------------------------------------------

-- | Token maps can be partially ordered, but there is no total ordering of
--   token maps that's consistent with their arithmetic properties.
--
-- In the event that someone attempts to define an 'Ord' instance for the
-- 'TokenMap' type, we generate a type error.
--
-- If some arbitrary ordering is needed (for example, so that token maps can
-- be included in an ordered set), the recommended course of action is to
-- define a newtype with its own dedicated 'Ord' instance.
--
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"

-- | Partial ordering for token maps.
--
-- There is no total ordering of token maps that's consistent with their
-- arithmetic properties.
--
-- To see why this is true, consider how we might order the following maps:
--
--     >>> p = fromFlatList [(assetA, 2), (assetB, 1)]
--     >>> q = fromFlatList [(assetA, 1), (assetB, 2)]
--
-- One possibility would be to use a lexicographic ordering, but this is not
-- arithmetically useful.
--
-- Instead, we define a partial order, where map 'x' is less than or equal
-- to map 'y' if (and only if):
--
--     - all the quantities in map 'x' are less than or equal to their
--       corresponding quantities in map 'y';
--
--     - all the quantities in map 'y' are greater than or equal to their
--       corresponding quantities in map 'x'.
--
-- For example, consider the following pair of maps:
--
--     >>> x = fromFlatList [(assetA, 1)]
--     >>> y = fromFlatList [(assetA, 2), (assetB, 1)]
--
-- In the above example, map 'x' is strictly less than map 'y'.
--
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)

-- | Defines a lexicographic ordering.
--
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)

--------------------------------------------------------------------------------
-- Serialization
--------------------------------------------------------------------------------

-- | When used with the 'Buildable' or 'ToJSON' instances, provides a flat
-- serialization style, where token quantities are paired with their asset
-- identifiers.
--
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))

-- | When used with the 'Buildable' or 'ToJSON' instances, provides a nested
-- serialization style, where token quantities are grouped by policy
-- identifier.
--
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))

--------------------------------------------------------------------------------
-- Text serialization
--------------------------------------------------------------------------------

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)

--------------------------------------------------------------------------------
-- JSON serialization (common)
--------------------------------------------------------------------------------

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)
    ]

--------------------------------------------------------------------------------
-- JSON serialization (flat)
--------------------------------------------------------------------------------

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)

-- Used for JSON serialization only: not exported.
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

--------------------------------------------------------------------------------
-- JSON serialization (nested)
--------------------------------------------------------------------------------

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)

-- Used for JSON serialization only: not exported.
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

-- Used for JSON serialization only: not exported.
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

--------------------------------------------------------------------------------
-- Construction
--------------------------------------------------------------------------------

-- | The empty token map.
--
empty :: TokenMap
empty :: TokenMap
empty = Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity) -> TokenMap
TokenMap Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
forall a. Monoid a => a
mempty

-- | Creates a singleton token map with just one token quantity.
--
-- If the specified token quantity is zero, then the resultant map will be
-- equal to the 'empty' map.
--
singleton :: AssetId -> TokenQuantity -> TokenMap
singleton :: AssetId -> TokenQuantity -> TokenMap
singleton = TokenMap -> AssetId -> TokenQuantity -> TokenMap
setQuantity TokenMap
empty

-- | Creates a token map from a flat list.
--
-- If a token name appears more than once in the list under the same policy,
-- its associated quantities will be added together in the resultant map.
--
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)

-- | Creates a token map from a nested list.
--
-- If a token name appears more than once in the list under the same policy,
-- its associated quantities will be added together in the resultant map.
--
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
    ]

-- | Creates a token map from a nested map.
--
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

--------------------------------------------------------------------------------
-- Deconstruction
--------------------------------------------------------------------------------

-- | Converts a token map to a flat list.
--
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
    ]

-- | Converts a token map to a nested list.
--
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

-- | Converts a token map to a nested map.
--
toNestedMap
    :: TokenMap
    -> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
toNestedMap :: TokenMap -> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
toNestedMap = TokenMap -> Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
unTokenMap

--------------------------------------------------------------------------------
-- Filtering
--------------------------------------------------------------------------------

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

--------------------------------------------------------------------------------
-- Arithmetic
--------------------------------------------------------------------------------

-- | Adds one token map to another.
--
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)

-- | Subtracts the second token map from the first.
--
-- Returns 'Nothing' if the second map is not less than or equal to the first
-- map when compared with the `leq` function.
--
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

-- | Analogous to @Set.difference@, return the difference between two token
-- maps.
--
-- The following property holds:
-- prop> x `leq` (x `difference` y) `add` y
--
-- Note that there's a `leq` rather than equality, which we'd expect if this was
-- subtraction of integers. I.e.
--
-- >>> (0 - 1) + 1
-- 0
--
-- whereas
--
-- >>> let oneToken = singleton aid (TokenQuantity 1)
-- >>> (mempty `difference` oneToken) `add` oneToken
-- oneToken
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)

-- | Computes the intersection of two token maps.
--
-- Analogous to @Set.intersection@.
--
-- Example:
--
-- >>> m1 = [("a", 1), ("b", 2), ("c", 3)          ]
-- >>> m2 = [          ("b", 3), ("c", 2), ("d", 1)]
-- >>> intersection m1 m2
--          [          ("b", 2), ("c", 2)          ]
--
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)

--------------------------------------------------------------------------------
-- Queries
--------------------------------------------------------------------------------

-- | Returns the number of unique assets in a token map.
--
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

--------------------------------------------------------------------------------
-- Tests
--------------------------------------------------------------------------------

-- | Returns true if and only if the given map is empty.
--
isEmpty :: TokenMap -> Bool
isEmpty :: TokenMap -> Bool
isEmpty = (TokenMap -> TokenMap -> Bool
forall a. Eq a => a -> a -> Bool
== TokenMap
empty)

-- | Returns true if and only if the given map is not empty.
--
isNotEmpty :: TokenMap -> Bool
isNotEmpty :: TokenMap -> Bool
isNotEmpty = (TokenMap -> TokenMap -> Bool
forall a. Eq a => a -> a -> Bool
/= TokenMap
empty)

--------------------------------------------------------------------------------
-- Quantities
--------------------------------------------------------------------------------

-- | Gets the quantity associated with a given asset.
--
-- If the given map does not have an entry for the specified asset, this
-- function returns a value of zero.
--
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

-- | Updates the quantity associated with a given asset.
--
-- If the given quantity is zero, the resultant map will not have an entry for
-- the given asset.
--
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

-- | Returns true if and only if the given map has a non-zero quantity for the
--   given asset.
--
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

-- | Uses the specified function to adjust the quantity associated with a
--   given asset.
--
-- If the result of adjusting the quantity is equal to zero, the resultant map
-- will not have an entry for the given asset.
--
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

-- | Removes the quantity associated with the given asset.
--
-- This is equivalent to calling 'setQuantity' with a value of zero.
--
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

-- | Get the largest quantity from this map.
--
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

--------------------------------------------------------------------------------
-- Partitioning
--------------------------------------------------------------------------------

-- | Partitions a token map into 'n' smaller maps, where the asset sets of the
--   resultant maps are disjoint.
--
-- In the resultant maps, the smallest asset set size and largest asset set
-- size will differ by no more than 1.
--
-- The quantities of each asset are unchanged.
--
equipartitionAssets
    :: TokenMap
    -- ^ The token map to be partitioned.
    -> NonEmpty a
    -- ^ Represents the number of portions in which to partition the token map.
    -> NonEmpty TokenMap
    -- ^ The partitioned maps.
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
    -- The total number of assets.
    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

    -- How many asset quantities to include in each chunk.
    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

    -- Generates a single chunk of asset quantities.
    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

-- | Partitions a token map into 'n' smaller maps, where the quantity of each
--   token is equipartitioned across the resultant maps.
--
-- In the resultant maps, the smallest quantity and largest quantity of a given
-- token will differ by no more than 1.
--
-- The resultant list is sorted into ascending order when maps are compared
-- with the 'leq' function.
--
equipartitionQuantities
    :: TokenMap
    -- ^ The map to be partitioned.
    -> NonEmpty a
    -- ^ Represents the number of portions in which to partition the map.
    -> NonEmpty TokenMap
    -- ^ The partitioned maps.
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

-- | Partitions a token map into 'n' smaller maps, where the quantity of each
--   token is equipartitioned across the resultant maps, with the goal that no
--   token quantity in any of the resultant maps exceeds the given upper bound.
--
-- The value 'n' is computed automatically, and is the minimum value required
-- to achieve the goal that no token quantity in any of the resulting maps
-- exceeds the maximum allowable token quantity.
--
equipartitionQuantitiesWithUpperBound
    :: TokenMap
    -> TokenQuantity
    -- ^ Maximum allowable token quantity.
    -> NonEmpty TokenMap
    -- ^ The partitioned maps.
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."
        ]

--------------------------------------------------------------------------------
-- Queries
--------------------------------------------------------------------------------

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

--------------------------------------------------------------------------------
-- Transformations
--------------------------------------------------------------------------------

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

--------------------------------------------------------------------------------
-- Unsafe operations
--------------------------------------------------------------------------------

-- | Subtracts the second token map from the first.
--
-- Pre-condition: the second map is less than or equal to the first map when
-- compared with the `leq` function.
--
-- Throws a run-time exception if the pre-condition is violated.
--
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)

--------------------------------------------------------------------------------
-- Internal functions
--------------------------------------------------------------------------------

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)