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

-- | Provides the 'TokenBundle' type, which combines a 'Coin' (lovelace) value
--   with a map of named token quantities, scoped by token policy.
--
-- This module is meant to be imported qualified. For example:
--
-- >>> import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TB
--
module Cardano.Wallet.Primitive.Types.TokenBundle
    (
    -- * Types
      TokenBundle (..)
    , AssetId (..)

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

    -- * Deconstruction
    , toFlatList

    -- * Coins
    , fromCoin
    , toCoin
    , isCoin
    , getCoin
    , setCoin

    -- * Arithmetic
    , add
    , subtract
    , difference

    -- * Quantities
    , getQuantity
    , hasQuantity
    , setQuantity

    -- * Partitioning
    , equipartitionAssets
    , equipartitionQuantitiesWithUpperBound

    -- * Ordering
    , Lexicographic (..)

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

    -- * Queries
    , getAssets

    -- * Transformations
    , mapAssetIds

    -- * Unsafe operations
    , unsafeSubtract

    ) where

import Prelude hiding
    ( subtract )

import Algebra.PartialOrd
    ( PartialOrd (..) )
import Cardano.Wallet.Primitive.Types.Coin
    ( Coin (..) )
import Cardano.Wallet.Primitive.Types.TokenMap
    ( AssetId (..), Flat (..), Lexicographic (..), Nested (..), TokenMap )
import Cardano.Wallet.Primitive.Types.TokenPolicy
    ( TokenName, TokenPolicyId )
import Cardano.Wallet.Primitive.Types.TokenQuantity
    ( TokenQuantity (..) )
import Control.DeepSeq
    ( NFData )
import Control.Monad
    ( guard )
import Data.Bifunctor
    ( first )
import Data.Functor
    ( ($>) )
import Data.Hashable
    ( Hashable )
import Data.List.NonEmpty
    ( NonEmpty (..) )
import Data.Map.Strict
    ( Map )
import Data.Map.Strict.NonEmptyMap
    ( NonEmptyMap )
import Data.Ord
    ( comparing )
import Data.Set
    ( Set )
import Fmt
    ( Buildable (..), Builder, blockMapF )
import GHC.Generics
    ( Generic )
import GHC.TypeLits
    ( ErrorMessage (..), TypeError )

import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap
import qualified Data.List.NonEmpty as NE

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

-- | Combines a 'Coin' (lovelace) value with a map of named token quantities,
--   grouped by token policy.
--
data TokenBundle = TokenBundle
    { TokenBundle -> Coin
coin
        :: !Coin
    , TokenBundle -> TokenMap
tokens
        :: !TokenMap
    }
    deriving stock (TokenBundle -> TokenBundle -> Bool
(TokenBundle -> TokenBundle -> Bool)
-> (TokenBundle -> TokenBundle -> Bool) -> Eq TokenBundle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenBundle -> TokenBundle -> Bool
$c/= :: TokenBundle -> TokenBundle -> Bool
== :: TokenBundle -> TokenBundle -> Bool
$c== :: TokenBundle -> TokenBundle -> Bool
Eq, (forall x. TokenBundle -> Rep TokenBundle x)
-> (forall x. Rep TokenBundle x -> TokenBundle)
-> Generic TokenBundle
forall x. Rep TokenBundle x -> TokenBundle
forall x. TokenBundle -> Rep TokenBundle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenBundle x -> TokenBundle
$cfrom :: forall x. TokenBundle -> Rep TokenBundle x
Generic, ReadPrec [TokenBundle]
ReadPrec TokenBundle
Int -> ReadS TokenBundle
ReadS [TokenBundle]
(Int -> ReadS TokenBundle)
-> ReadS [TokenBundle]
-> ReadPrec TokenBundle
-> ReadPrec [TokenBundle]
-> Read TokenBundle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TokenBundle]
$creadListPrec :: ReadPrec [TokenBundle]
readPrec :: ReadPrec TokenBundle
$creadPrec :: ReadPrec TokenBundle
readList :: ReadS [TokenBundle]
$creadList :: ReadS [TokenBundle]
readsPrec :: Int -> ReadS TokenBundle
$creadsPrec :: Int -> ReadS TokenBundle
Read, Int -> TokenBundle -> ShowS
[TokenBundle] -> ShowS
TokenBundle -> String
(Int -> TokenBundle -> ShowS)
-> (TokenBundle -> String)
-> ([TokenBundle] -> ShowS)
-> Show TokenBundle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenBundle] -> ShowS
$cshowList :: [TokenBundle] -> ShowS
show :: TokenBundle -> String
$cshow :: TokenBundle -> String
showsPrec :: Int -> TokenBundle -> ShowS
$cshowsPrec :: Int -> TokenBundle -> ShowS
Show)
    deriving anyclass (TokenBundle -> ()
(TokenBundle -> ()) -> NFData TokenBundle
forall a. (a -> ()) -> NFData a
rnf :: TokenBundle -> ()
$crnf :: TokenBundle -> ()
NFData, Int -> TokenBundle -> Int
TokenBundle -> Int
(Int -> TokenBundle -> Int)
-> (TokenBundle -> Int) -> Hashable TokenBundle
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: TokenBundle -> Int
$chash :: TokenBundle -> Int
hashWithSalt :: Int -> TokenBundle -> Int
$chashWithSalt :: Int -> TokenBundle -> Int
Hashable)

instance Semigroup TokenBundle where
    <> :: TokenBundle -> TokenBundle -> TokenBundle
(<>) = TokenBundle -> TokenBundle -> TokenBundle
add

instance Monoid TokenBundle where
    mempty :: TokenBundle
mempty = TokenBundle
empty

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

-- | Token bundles can be partially ordered, but there is no total ordering of
--   token bundles that's consistent with their arithmetic properties.
--
-- In the event that someone attempts to define an 'Ord' instance for the
-- 'TokenBundle' type, we generate a type error.
--
-- If some arbitrary ordering is needed (for example, so that token bundles 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 bundles")
        => Ord TokenBundle where
    compare :: TokenBundle -> TokenBundle -> Ordering
compare = String -> TokenBundle -> TokenBundle -> Ordering
forall a. HasCallStack => String -> a
error String
"Ord not supported for token bundles"

instance PartialOrd TokenBundle where
    TokenBundle
b1 leq :: TokenBundle -> TokenBundle -> Bool
`leq` TokenBundle
b2 = Bool -> Bool -> Bool
(&&)
        (TokenBundle -> Coin
coin TokenBundle
b1 Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
<= TokenBundle -> Coin
coin TokenBundle
b2)
        (TokenBundle -> TokenMap
tokens TokenBundle
b1 TokenMap -> TokenMap -> Bool
forall a. PartialOrd a => a -> a -> Bool
`leq` TokenBundle -> TokenMap
tokens TokenBundle
b2)

instance Ord (Lexicographic TokenBundle) where
    compare :: Lexicographic TokenBundle -> Lexicographic TokenBundle -> Ordering
compare = (Lexicographic TokenBundle -> (Coin, Lexicographic TokenMap))
-> Lexicographic TokenBundle
-> Lexicographic TokenBundle
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Lexicographic TokenBundle -> (Coin, Lexicographic TokenMap)
projection
      where
        projection :: Lexicographic TokenBundle -> (Coin, Lexicographic TokenMap)
projection (Lexicographic (TokenBundle Coin
c TokenMap
m)) = (Coin
c, TokenMap -> Lexicographic TokenMap
forall a. a -> Lexicographic a
Lexicographic TokenMap
m)

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

instance Buildable (Flat TokenBundle) where
    build :: Flat TokenBundle -> Builder
build = (TokenMap -> Flat TokenMap) -> TokenBundle -> Builder
forall (style :: * -> *).
Buildable (style TokenMap) =>
(TokenMap -> style TokenMap) -> TokenBundle -> Builder
buildBundle TokenMap -> Flat TokenMap
forall a. a -> Flat a
Flat (TokenBundle -> Builder)
-> (Flat TokenBundle -> TokenBundle) -> Flat TokenBundle -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flat TokenBundle -> TokenBundle
forall a. Flat a -> a
getFlat

instance Buildable (Nested TokenBundle) where
    build :: Nested TokenBundle -> Builder
build = (TokenMap -> Nested TokenMap) -> TokenBundle -> Builder
forall (style :: * -> *).
Buildable (style TokenMap) =>
(TokenMap -> style TokenMap) -> TokenBundle -> Builder
buildBundle TokenMap -> Nested TokenMap
forall a. a -> Nested a
Nested (TokenBundle -> Builder)
-> (Nested TokenBundle -> TokenBundle)
-> Nested TokenBundle
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nested TokenBundle -> TokenBundle
forall a. Nested a -> a
getNested

buildBundle
    :: Buildable (style TokenMap)
    => (TokenMap -> style TokenMap)
    -> TokenBundle
    -> Builder
buildBundle :: (TokenMap -> style TokenMap) -> TokenBundle -> Builder
buildBundle TokenMap -> style TokenMap
style TokenBundle {Coin
coin :: Coin
$sel:coin:TokenBundle :: TokenBundle -> Coin
coin, TokenMap
tokens :: TokenMap
$sel:tokens:TokenBundle :: TokenBundle -> TokenMap
tokens} = [(String, Builder)] -> Builder
buildMap
    [ (String
"coin"
      , Coin -> Builder
forall p. Buildable p => p -> Builder
build Coin
coin)
    , (String
"tokens"
      , style TokenMap -> Builder
forall p. Buildable p => p -> Builder
build (style TokenMap -> Builder) -> style TokenMap -> Builder
forall a b. (a -> b) -> a -> b
$ TokenMap -> style TokenMap
style TokenMap
tokens)
    ]

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)

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

-- | The empty token bundle.
--
empty :: TokenBundle
empty :: TokenBundle
empty = Coin -> TokenMap -> TokenBundle
TokenBundle (Natural -> Coin
Coin Natural
0) TokenMap
forall a. Monoid a => a
mempty

-- | Creates a token bundle from a coin and a flat list of token quantities.
--
-- 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 bundle.
--
fromFlatList
    :: Coin
    -> [(AssetId, TokenQuantity)]
    -> TokenBundle
fromFlatList :: Coin -> [(AssetId, TokenQuantity)] -> TokenBundle
fromFlatList Coin
c = Coin -> TokenMap -> TokenBundle
TokenBundle Coin
c (TokenMap -> TokenBundle)
-> ([(AssetId, TokenQuantity)] -> TokenMap)
-> [(AssetId, TokenQuantity)]
-> TokenBundle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(AssetId, TokenQuantity)] -> TokenMap
TokenMap.fromFlatList

-- | Creates a token bundle from a coin and a nested list of token quantities.
--
-- 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 bundle.
--
fromNestedList
    :: Coin
    -> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
    -> TokenBundle
fromNestedList :: Coin
-> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
-> TokenBundle
fromNestedList Coin
c = Coin -> TokenMap -> TokenBundle
TokenBundle Coin
c (TokenMap -> TokenBundle)
-> ([(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
    -> TokenMap)
-> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
-> TokenBundle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))] -> TokenMap
TokenMap.fromNestedList

fromNestedMap
    :: (Coin, Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity))
    -> TokenBundle
fromNestedMap :: (Coin, Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity))
-> TokenBundle
fromNestedMap (Coin
c, Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
m) = Coin -> TokenMap -> TokenBundle
TokenBundle Coin
c (Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity) -> TokenMap
TokenMap.fromNestedMap Map TokenPolicyId (NonEmptyMap TokenName TokenQuantity)
m)

fromTokenMap :: TokenMap -> TokenBundle
fromTokenMap :: TokenMap -> TokenBundle
fromTokenMap = Coin -> TokenMap -> TokenBundle
TokenBundle (Natural -> Coin
Coin Natural
0)

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

-- | Converts a token bundle to a coin and a flat list of token quantities.
--
toFlatList :: TokenBundle -> (Coin, [(AssetId, TokenQuantity)])
toFlatList :: TokenBundle -> (Coin, [(AssetId, TokenQuantity)])
toFlatList (TokenBundle Coin
c TokenMap
m) = (Coin
c, TokenMap -> [(AssetId, TokenQuantity)]
TokenMap.toFlatList TokenMap
m)

--------------------------------------------------------------------------------
-- Coins
--------------------------------------------------------------------------------

-- | Creates a singleton token bundle from an ada 'Coin' value.
--
fromCoin :: Coin -> TokenBundle
fromCoin :: Coin -> TokenBundle
fromCoin Coin
c = Coin -> TokenMap -> TokenBundle
TokenBundle Coin
c TokenMap
forall a. Monoid a => a
mempty

-- | Coerces a token bundle to an ada 'Coin' value.
--
-- Returns a coin if (and only if) the token bundle has no other tokens.
--
toCoin :: TokenBundle -> Maybe Coin
toCoin :: TokenBundle -> Maybe Coin
toCoin (TokenBundle Coin
c TokenMap
ts)
    | TokenMap -> Bool
TokenMap.isEmpty TokenMap
ts = Coin -> Maybe Coin
forall a. a -> Maybe a
Just Coin
c
    | Bool
otherwise = Maybe Coin
forall a. Maybe a
Nothing

-- | Indicates 'True' if (and only if) a token bundle has no tokens other than
--   an ada 'Coin' value.
--
isCoin :: TokenBundle -> Bool
isCoin :: TokenBundle -> Bool
isCoin (TokenBundle Coin
_ TokenMap
m) = TokenMap -> Bool
TokenMap.isEmpty TokenMap
m

-- | Gets the current ada 'Coin' value from a token bundle.
--
-- If you need to assert that a bundle has no other tokens, consider using the
-- 'toCoin' function instead.
--
getCoin :: TokenBundle -> Coin
getCoin :: TokenBundle -> Coin
getCoin (TokenBundle Coin
c TokenMap
_) = Coin
c

-- | Sets the current ada 'Coin' value for a token bundle.
--
setCoin :: TokenBundle -> Coin -> TokenBundle
setCoin :: TokenBundle -> Coin -> TokenBundle
setCoin TokenBundle
b Coin
c = TokenBundle
b { $sel:coin:TokenBundle :: Coin
coin = Coin
c }

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

-- | Adds one token bundle to another.
--
add :: TokenBundle -> TokenBundle -> TokenBundle
add :: TokenBundle -> TokenBundle -> TokenBundle
add (TokenBundle (Coin Natural
c1) TokenMap
m1) (TokenBundle (Coin Natural
c2) TokenMap
m2) =
    Coin -> TokenMap -> TokenBundle
TokenBundle (Natural -> Coin
Coin (Natural -> Coin) -> Natural -> Coin
forall a b. (a -> b) -> a -> b
$ Natural
c1 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
c2) (TokenMap -> TokenMap -> TokenMap
TokenMap.add TokenMap
m1 TokenMap
m2)

-- | Subtracts the second token bundle from the first.
--
-- Returns 'Nothing' if the second bundle is not less than or equal to the first
-- bundle when compared with the `leq` function.
--
subtract :: TokenBundle -> TokenBundle -> Maybe TokenBundle
subtract :: TokenBundle -> TokenBundle -> Maybe TokenBundle
subtract TokenBundle
a TokenBundle
b = Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (TokenBundle
b TokenBundle -> TokenBundle -> Bool
forall a. PartialOrd a => a -> a -> Bool
`leq` TokenBundle
a) Maybe () -> TokenBundle -> Maybe TokenBundle
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TokenBundle -> TokenBundle -> TokenBundle
unsafeSubtract TokenBundle
a TokenBundle
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 = fromFlatList coin [(aid, TokenQuantity 1)]
-- >>> (mempty `difference` oneToken) `add` oneToken
-- oneToken
--
difference :: TokenBundle -> TokenBundle -> TokenBundle
difference :: TokenBundle -> TokenBundle -> TokenBundle
difference (TokenBundle Coin
c1 TokenMap
m1) (TokenBundle Coin
c2 TokenMap
m2) =
    Coin -> TokenMap -> TokenBundle
TokenBundle
        (Coin -> Coin -> Coin
Coin.difference Coin
c1 Coin
c2)
        (TokenMap -> TokenMap -> TokenMap
TokenMap.difference TokenMap
m1 TokenMap
m2)

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

-- | Gets the quantity associated with a given asset.
--
-- If the given bundle does not have an entry for the specified asset, this
-- function returns a value of zero.
--
getQuantity :: TokenBundle -> AssetId -> TokenQuantity
getQuantity :: TokenBundle -> AssetId -> TokenQuantity
getQuantity = TokenMap -> AssetId -> TokenQuantity
TokenMap.getQuantity (TokenMap -> AssetId -> TokenQuantity)
-> (TokenBundle -> TokenMap)
-> TokenBundle
-> AssetId
-> TokenQuantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenBundle -> TokenMap
tokens

-- | Returns true if and only if the given bundle has a non-zero quantity
--   for the given asset.
--
hasQuantity :: TokenBundle -> AssetId -> Bool
hasQuantity :: TokenBundle -> AssetId -> Bool
hasQuantity = TokenMap -> AssetId -> Bool
TokenMap.hasQuantity (TokenMap -> AssetId -> Bool)
-> (TokenBundle -> TokenMap) -> TokenBundle -> AssetId -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenBundle -> TokenMap
tokens

-- | Sets the quantity associated with a given asset.
--
-- If the given quantity is zero, the resultant bundle will not have an entry
-- for the given asset.
--
setQuantity :: TokenBundle -> AssetId -> TokenQuantity -> TokenBundle
setQuantity :: TokenBundle -> AssetId -> TokenQuantity -> TokenBundle
setQuantity (TokenBundle Coin
c TokenMap
m) AssetId
a TokenQuantity
q = Coin -> TokenMap -> TokenBundle
TokenBundle Coin
c (TokenMap -> AssetId -> TokenQuantity -> TokenMap
TokenMap.setQuantity TokenMap
m AssetId
a TokenQuantity
q)

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

-- | Partitions a token bundle into 'n' smaller bundles, where the asset sets
--   of the resultant bundles are disjoint.
--
-- In the resultant bundles, the smallest asset set size and largest asset set
-- size will differ by no more than 1.
--
-- The ada 'Coin' quantity is equipartitioned across the resulting bundles.
--
-- The quantities of each non-ada asset are unchanged.
--
equipartitionAssets
    :: TokenBundle
    -- ^ The token bundle to be partitioned.
    -> NonEmpty a
    -- ^ Represents the number of portions in which to partition the bundle.
    -> NonEmpty TokenBundle
    -- ^ The partitioned bundles.
equipartitionAssets :: TokenBundle -> NonEmpty a -> NonEmpty TokenBundle
equipartitionAssets (TokenBundle Coin
c TokenMap
m) NonEmpty a
count =
    (Coin -> TokenMap -> TokenBundle)
-> NonEmpty Coin -> NonEmpty TokenMap -> NonEmpty TokenBundle
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith Coin -> TokenMap -> TokenBundle
TokenBundle NonEmpty Coin
cs NonEmpty TokenMap
ms
  where
    cs :: NonEmpty Coin
cs = Coin -> NonEmpty a -> NonEmpty Coin
forall a. Coin -> NonEmpty a -> NonEmpty Coin
Coin.equipartition Coin
c NonEmpty a
count
    ms :: NonEmpty TokenMap
ms = TokenMap -> NonEmpty a -> NonEmpty TokenMap
forall a. TokenMap -> NonEmpty a -> NonEmpty TokenMap
TokenMap.equipartitionAssets TokenMap
m NonEmpty a
count

-- | Partitions a token bundle into 'n' smaller bundles, where the quantity of
--   each token is equipartitioned across the resultant bundles, with the goal
--   that no token quantity in any of the resultant bundles 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 bundles
-- exceeds the maximum allowable token quantity.
--
equipartitionQuantitiesWithUpperBound
    :: TokenBundle
    -> TokenQuantity
    -- ^ Maximum allowable token quantity.
    -> NonEmpty TokenBundle
    -- ^ The partitioned bundles.
equipartitionQuantitiesWithUpperBound :: TokenBundle -> TokenQuantity -> NonEmpty TokenBundle
equipartitionQuantitiesWithUpperBound (TokenBundle Coin
c TokenMap
m) TokenQuantity
maxQuantity =
    (Coin -> TokenMap -> TokenBundle)
-> NonEmpty Coin -> NonEmpty TokenMap -> NonEmpty TokenBundle
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith Coin -> TokenMap -> TokenBundle
TokenBundle NonEmpty Coin
cs NonEmpty TokenMap
ms
  where
    cs :: NonEmpty Coin
cs = Coin -> NonEmpty TokenMap -> NonEmpty Coin
forall a. Coin -> NonEmpty a -> NonEmpty Coin
Coin.equipartition Coin
c NonEmpty TokenMap
ms
    ms :: NonEmpty TokenMap
ms = TokenMap -> TokenQuantity -> NonEmpty TokenMap
TokenMap.equipartitionQuantitiesWithUpperBound TokenMap
m TokenQuantity
maxQuantity

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

getAssets :: TokenBundle -> Set AssetId
getAssets :: TokenBundle -> Set AssetId
getAssets = TokenMap -> Set AssetId
TokenMap.getAssets (TokenMap -> Set AssetId)
-> (TokenBundle -> TokenMap) -> TokenBundle -> Set AssetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenBundle -> TokenMap
tokens

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

mapAssetIds :: (AssetId -> AssetId) -> TokenBundle -> TokenBundle
mapAssetIds :: (AssetId -> AssetId) -> TokenBundle -> TokenBundle
mapAssetIds AssetId -> AssetId
f (TokenBundle Coin
c TokenMap
m) = Coin -> TokenMap -> TokenBundle
TokenBundle Coin
c ((AssetId -> AssetId) -> TokenMap -> TokenMap
TokenMap.mapAssetIds AssetId -> AssetId
f TokenMap
m)

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

-- | Subtracts the second token bundle from the first.
--
-- Pre-condition: the second bundle is less than or equal to the first bundle
-- when compared with the `leq` function.
--
-- Throws a run-time exception if the pre-condition is violated.
--
unsafeSubtract :: TokenBundle -> TokenBundle -> TokenBundle
unsafeSubtract :: TokenBundle -> TokenBundle -> TokenBundle
unsafeSubtract (TokenBundle (Coin Natural
c1) TokenMap
m1) (TokenBundle (Coin Natural
c2) TokenMap
m2) =
    Coin -> TokenMap -> TokenBundle
TokenBundle (Natural -> Coin
Coin (Natural -> Coin) -> Natural -> Coin
forall a b. (a -> b) -> a -> b
$ Natural
c1 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
c2) (TokenMap -> TokenMap -> TokenMap
TokenMap.unsafeSubtract TokenMap
m1 TokenMap
m2)