{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Copyright: © 2018-2021 IOHK
-- License: Apache-2.0
--
-- Provides the 'UTxOSelection' type, which represents a selection of UTxO
-- entries from a UTxO set.
--
-- It consists of a pair of UTxO sets:
--
--    - the selected set: UTxOs that have already been selected;
--    - the leftover set: UTxOs that have not yet been selected.
--
-- To construct a 'UTxOSelection' where none of the UTxOs are selected, use
-- the 'fromIndex' function.
--
-- To construct a 'UTxOSelection' where some of the UTxOs are selected, use
-- either the 'fromIndexFiltered' or the 'fromIndexPair' functions.
--
-- To select an element (and move it from the leftover set to the selected
-- set), use the 'select' function.
--
-- A 'UTxOSelection' can be promoted to a 'UTxOSelectionNonEmpty', indicating
-- that the selected set contains at least one UTxO. To promote a selection,
-- either use the 'toNonEmpty' function to assert that it is non-empty, or use
-- the 'select' function to select a single entry.
--
module Cardano.Wallet.Primitive.Types.UTxOSelection
    (
      -- * Classes
      IsUTxOSelection

      -- * Types
    , UTxOSelection
    , UTxOSelectionNonEmpty

      -- * Construction and deconstruction
    , empty
    , fromIndex
    , fromIndexFiltered
    , fromIndexPair
    , toIndexPair

      -- * Promotion and demotion
    , fromNonEmpty
    , toNonEmpty

      -- * Indicator functions
    , isEmpty
    , isNonEmpty
    , isMember
    , isLeftover
    , isSelected
    , isSubSelectionOf
    , isProperSubSelectionOf

      -- * Accessor functions
    , availableBalance
    , availableMap
    , availableSize
    , leftoverBalance
    , leftoverSize
    , leftoverIndex
    , leftoverList
    , leftoverMap
    , selectedBalance
    , selectedSize
    , selectedIndex
    , selectedList
    , selectedMap

      -- * Modification
    , select
    , selectMany

    ) where

import Prelude

import Cardano.Wallet.Primitive.Types.TokenBundle
    ( TokenBundle )
import Cardano.Wallet.Primitive.Types.UTxOIndex
    ( UTxOIndex )
import Control.Monad
    ( ap, (<=<) )
import Data.Bool
    ( bool )
import Data.Function
    ( (&) )
import Data.Generics.Internal.VL.Lens
    ( over )
import Data.Generics.Labels
    ()
import Data.List.NonEmpty
    ( NonEmpty )
import Data.Map.Strict
    ( Map )
import Data.Maybe
    ( fromMaybe )
import Data.Tuple
    ( swap )
import GHC.Generics
    ( Generic )

import qualified Cardano.Wallet.Primitive.Types.UTxOIndex as UTxOIndex
import qualified Data.Foldable as F
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map

--------------------------------------------------------------------------------
-- Classes
--------------------------------------------------------------------------------

class HasUTxOSelectionState s u where

    -- | Retrieves the internal state from a selection.
    state :: s u -> State u

    -- | Reconstructs a selection from an internal state.
    fromState :: State u -> s u

class HasUTxOSelectionState s u => IsUTxOSelection s u where

    -- | The type of the list of selected UTxOs.
    type SelectedList s u

    -- | Retrieves a list of the selected UTxOs.
    selectedList :: s u -> SelectedList s u

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

-- | The internal state of a selection.
--
data State u = State
    { State u -> UTxOIndex u
leftover :: !(UTxOIndex u)
      -- ^ UTxOs that have not yet been selected.
    , State u -> UTxOIndex u
selected :: !(UTxOIndex u)
      -- ^ UTxOs that have already been selected.
    }
    deriving (State u -> State u -> Bool
(State u -> State u -> Bool)
-> (State u -> State u -> Bool) -> Eq (State u)
forall u. Eq u => State u -> State u -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: State u -> State u -> Bool
$c/= :: forall u. Eq u => State u -> State u -> Bool
== :: State u -> State u -> Bool
$c== :: forall u. Eq u => State u -> State u -> Bool
Eq, (forall x. State u -> Rep (State u) x)
-> (forall x. Rep (State u) x -> State u) -> Generic (State u)
forall x. Rep (State u) x -> State u
forall x. State u -> Rep (State u) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall u x. Rep (State u) x -> State u
forall u x. State u -> Rep (State u) x
$cto :: forall u x. Rep (State u) x -> State u
$cfrom :: forall u x. State u -> Rep (State u) x
Generic, Int -> State u -> ShowS
[State u] -> ShowS
State u -> String
(Int -> State u -> ShowS)
-> (State u -> String) -> ([State u] -> ShowS) -> Show (State u)
forall u. Show u => Int -> State u -> ShowS
forall u. Show u => [State u] -> ShowS
forall u. Show u => State u -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State u] -> ShowS
$cshowList :: forall u. Show u => [State u] -> ShowS
show :: State u -> String
$cshow :: forall u. Show u => State u -> String
showsPrec :: Int -> State u -> ShowS
$cshowsPrec :: forall u. Show u => Int -> State u -> ShowS
Show)

-- | A selection for which 'isNonEmpty' may be 'False'.
--
newtype UTxOSelection u = UTxOSelection (State u)
    deriving (UTxOSelection u -> UTxOSelection u -> Bool
(UTxOSelection u -> UTxOSelection u -> Bool)
-> (UTxOSelection u -> UTxOSelection u -> Bool)
-> Eq (UTxOSelection u)
forall u. Eq u => UTxOSelection u -> UTxOSelection u -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UTxOSelection u -> UTxOSelection u -> Bool
$c/= :: forall u. Eq u => UTxOSelection u -> UTxOSelection u -> Bool
== :: UTxOSelection u -> UTxOSelection u -> Bool
$c== :: forall u. Eq u => UTxOSelection u -> UTxOSelection u -> Bool
Eq, (forall x. UTxOSelection u -> Rep (UTxOSelection u) x)
-> (forall x. Rep (UTxOSelection u) x -> UTxOSelection u)
-> Generic (UTxOSelection u)
forall x. Rep (UTxOSelection u) x -> UTxOSelection u
forall x. UTxOSelection u -> Rep (UTxOSelection u) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall u x. Rep (UTxOSelection u) x -> UTxOSelection u
forall u x. UTxOSelection u -> Rep (UTxOSelection u) x
$cto :: forall u x. Rep (UTxOSelection u) x -> UTxOSelection u
$cfrom :: forall u x. UTxOSelection u -> Rep (UTxOSelection u) x
Generic, Int -> UTxOSelection u -> ShowS
[UTxOSelection u] -> ShowS
UTxOSelection u -> String
(Int -> UTxOSelection u -> ShowS)
-> (UTxOSelection u -> String)
-> ([UTxOSelection u] -> ShowS)
-> Show (UTxOSelection u)
forall u. Show u => Int -> UTxOSelection u -> ShowS
forall u. Show u => [UTxOSelection u] -> ShowS
forall u. Show u => UTxOSelection u -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UTxOSelection u] -> ShowS
$cshowList :: forall u. Show u => [UTxOSelection u] -> ShowS
show :: UTxOSelection u -> String
$cshow :: forall u. Show u => UTxOSelection u -> String
showsPrec :: Int -> UTxOSelection u -> ShowS
$cshowsPrec :: forall u. Show u => Int -> UTxOSelection u -> ShowS
Show)

-- | A selection for which 'isNonEmpty' must be 'True'.
--
newtype UTxOSelectionNonEmpty u = UTxOSelectionNonEmpty (State u)
    deriving (UTxOSelectionNonEmpty u -> UTxOSelectionNonEmpty u -> Bool
(UTxOSelectionNonEmpty u -> UTxOSelectionNonEmpty u -> Bool)
-> (UTxOSelectionNonEmpty u -> UTxOSelectionNonEmpty u -> Bool)
-> Eq (UTxOSelectionNonEmpty u)
forall u.
Eq u =>
UTxOSelectionNonEmpty u -> UTxOSelectionNonEmpty u -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UTxOSelectionNonEmpty u -> UTxOSelectionNonEmpty u -> Bool
$c/= :: forall u.
Eq u =>
UTxOSelectionNonEmpty u -> UTxOSelectionNonEmpty u -> Bool
== :: UTxOSelectionNonEmpty u -> UTxOSelectionNonEmpty u -> Bool
$c== :: forall u.
Eq u =>
UTxOSelectionNonEmpty u -> UTxOSelectionNonEmpty u -> Bool
Eq, (forall x.
 UTxOSelectionNonEmpty u -> Rep (UTxOSelectionNonEmpty u) x)
-> (forall x.
    Rep (UTxOSelectionNonEmpty u) x -> UTxOSelectionNonEmpty u)
-> Generic (UTxOSelectionNonEmpty u)
forall x.
Rep (UTxOSelectionNonEmpty u) x -> UTxOSelectionNonEmpty u
forall x.
UTxOSelectionNonEmpty u -> Rep (UTxOSelectionNonEmpty u) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall u x.
Rep (UTxOSelectionNonEmpty u) x -> UTxOSelectionNonEmpty u
forall u x.
UTxOSelectionNonEmpty u -> Rep (UTxOSelectionNonEmpty u) x
$cto :: forall u x.
Rep (UTxOSelectionNonEmpty u) x -> UTxOSelectionNonEmpty u
$cfrom :: forall u x.
UTxOSelectionNonEmpty u -> Rep (UTxOSelectionNonEmpty u) x
Generic, Int -> UTxOSelectionNonEmpty u -> ShowS
[UTxOSelectionNonEmpty u] -> ShowS
UTxOSelectionNonEmpty u -> String
(Int -> UTxOSelectionNonEmpty u -> ShowS)
-> (UTxOSelectionNonEmpty u -> String)
-> ([UTxOSelectionNonEmpty u] -> ShowS)
-> Show (UTxOSelectionNonEmpty u)
forall u. Show u => Int -> UTxOSelectionNonEmpty u -> ShowS
forall u. Show u => [UTxOSelectionNonEmpty u] -> ShowS
forall u. Show u => UTxOSelectionNonEmpty u -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UTxOSelectionNonEmpty u] -> ShowS
$cshowList :: forall u. Show u => [UTxOSelectionNonEmpty u] -> ShowS
show :: UTxOSelectionNonEmpty u -> String
$cshow :: forall u. Show u => UTxOSelectionNonEmpty u -> String
showsPrec :: Int -> UTxOSelectionNonEmpty u -> ShowS
$cshowsPrec :: forall u. Show u => Int -> UTxOSelectionNonEmpty u -> ShowS
Show)

instance HasUTxOSelectionState UTxOSelection u where
    state :: UTxOSelection u -> State u
state (UTxOSelection State u
s) = State u
s
    fromState :: State u -> UTxOSelection u
fromState State u
s = State u -> UTxOSelection u
forall u. State u -> UTxOSelection u
UTxOSelection State u
s

instance HasUTxOSelectionState UTxOSelectionNonEmpty u where
    state :: UTxOSelectionNonEmpty u -> State u
state (UTxOSelectionNonEmpty State u
s) = State u
s
    fromState :: State u -> UTxOSelectionNonEmpty u
fromState State u
s = State u -> UTxOSelectionNonEmpty u
forall u. State u -> UTxOSelectionNonEmpty u
UTxOSelectionNonEmpty State u
s

instance IsUTxOSelection UTxOSelection u where
    type SelectedList UTxOSelection u = [(u, TokenBundle)]
    selectedList :: UTxOSelection u -> SelectedList UTxOSelection u
selectedList = UTxOIndex u -> [(u, TokenBundle)]
forall u. UTxOIndex u -> [(u, TokenBundle)]
UTxOIndex.toList (UTxOIndex u -> [(u, TokenBundle)])
-> (UTxOSelection u -> UTxOIndex u)
-> UTxOSelection u
-> [(u, TokenBundle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOSelection u -> UTxOIndex u
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> UTxOIndex u
selectedIndex

instance IsUTxOSelection UTxOSelectionNonEmpty u where
    type SelectedList UTxOSelectionNonEmpty u = NonEmpty (u, TokenBundle)
    selectedList :: UTxOSelectionNonEmpty u -> SelectedList UTxOSelectionNonEmpty u
selectedList = [(u, TokenBundle)] -> NonEmpty (u, TokenBundle)
forall a. [a] -> NonEmpty a
NE.fromList ([(u, TokenBundle)] -> NonEmpty (u, TokenBundle))
-> (UTxOSelectionNonEmpty u -> [(u, TokenBundle)])
-> UTxOSelectionNonEmpty u
-> NonEmpty (u, TokenBundle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOIndex u -> [(u, TokenBundle)]
forall u. UTxOIndex u -> [(u, TokenBundle)]
UTxOIndex.toList (UTxOIndex u -> [(u, TokenBundle)])
-> (UTxOSelectionNonEmpty u -> UTxOIndex u)
-> UTxOSelectionNonEmpty u
-> [(u, TokenBundle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOSelectionNonEmpty u -> UTxOIndex u
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> UTxOIndex u
selectedIndex

--------------------------------------------------------------------------------
-- Construction and deconstruction
--------------------------------------------------------------------------------

-- | A completely empty selection with no selected or leftover UTxOs.
--
empty :: UTxOSelection u
empty :: UTxOSelection u
empty = UTxOIndex u -> UTxOSelection u
forall u. UTxOIndex u -> UTxOSelection u
fromIndex UTxOIndex u
forall u. UTxOIndex u
UTxOIndex.empty

-- | Creates a selection where none of the UTxOs are selected.
--
-- All UTxOs in the index will be added to the leftover set.
--
fromIndex :: UTxOIndex u -> UTxOSelection u
fromIndex :: UTxOIndex u -> UTxOSelection u
fromIndex UTxOIndex u
i = State u -> UTxOSelection u
forall u. State u -> UTxOSelection u
UTxOSelection State :: forall u. UTxOIndex u -> UTxOIndex u -> State u
State
    { $sel:leftover:State :: UTxOIndex u
leftover = UTxOIndex u
i
    , $sel:selected:State :: UTxOIndex u
selected = UTxOIndex u
forall u. UTxOIndex u
UTxOIndex.empty
    }

-- | Creates a selection from an index and a filter.
--
-- All UTxOs that match the given filter will be added to the selected set,
-- whereas all UTxOs that do not match will be added to the leftover set.
--
fromIndexFiltered :: Ord u => (u -> Bool) -> UTxOIndex u -> UTxOSelection u
fromIndexFiltered :: (u -> Bool) -> UTxOIndex u -> UTxOSelection u
fromIndexFiltered u -> Bool
f =
    State u -> UTxOSelection u
forall u. State u -> UTxOSelection u
UTxOSelection (State u -> UTxOSelection u)
-> (UTxOIndex u -> State u) -> UTxOIndex u -> UTxOSelection u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxOIndex u -> UTxOIndex u -> State u)
-> (UTxOIndex u, UTxOIndex u) -> State u
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry UTxOIndex u -> UTxOIndex u -> State u
forall u. UTxOIndex u -> UTxOIndex u -> State u
State ((UTxOIndex u, UTxOIndex u) -> State u)
-> (UTxOIndex u -> (UTxOIndex u, UTxOIndex u))
-> UTxOIndex u
-> State u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxOIndex u, UTxOIndex u) -> (UTxOIndex u, UTxOIndex u)
forall a b. (a, b) -> (b, a)
swap ((UTxOIndex u, UTxOIndex u) -> (UTxOIndex u, UTxOIndex u))
-> (UTxOIndex u -> (UTxOIndex u, UTxOIndex u))
-> UTxOIndex u
-> (UTxOIndex u, UTxOIndex u)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (u -> Bool) -> UTxOIndex u -> (UTxOIndex u, UTxOIndex u)
forall u.
Ord u =>
(u -> Bool) -> UTxOIndex u -> (UTxOIndex u, UTxOIndex u)
UTxOIndex.partition u -> Bool
f

-- | Creates a selection from a pair of indices.
--
-- The 1st index in the pair represents the leftover set.
-- The 2nd index in the pair represents the selected set.
--
-- Any items that are in both sets are removed from the leftover set.
--
fromIndexPair :: Ord u => (UTxOIndex u, UTxOIndex u) -> UTxOSelection u
fromIndexPair :: (UTxOIndex u, UTxOIndex u) -> UTxOSelection u
fromIndexPair (UTxOIndex u
leftover, UTxOIndex u
selected) =
    State u -> UTxOSelection u
forall u. State u -> UTxOSelection u
UTxOSelection State :: forall u. UTxOIndex u -> UTxOIndex u -> State u
State
        { $sel:leftover:State :: UTxOIndex u
leftover = UTxOIndex u
leftover UTxOIndex u -> UTxOIndex u -> UTxOIndex u
forall u. Ord u => UTxOIndex u -> UTxOIndex u -> UTxOIndex u
`UTxOIndex.difference` UTxOIndex u
selected
        , UTxOIndex u
selected :: UTxOIndex u
$sel:selected:State :: UTxOIndex u
selected
        }

-- | Converts a selection to a pair of indices.
--
-- The 1st index in the pair represents the leftover set.
-- The 2nd index in the pair represents the selected set.
--
toIndexPair :: IsUTxOSelection s u => s u -> (UTxOIndex u, UTxOIndex u)
toIndexPair :: s u -> (UTxOIndex u, UTxOIndex u)
toIndexPair s u
s = (s u -> UTxOIndex u
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> UTxOIndex u
leftoverIndex s u
s, s u -> UTxOIndex u
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> UTxOIndex u
selectedIndex s u
s)

--------------------------------------------------------------------------------
-- Promotion and demotion
--------------------------------------------------------------------------------

-- | Demotes a non-empty selection to an ordinary selection.
--
fromNonEmpty :: UTxOSelectionNonEmpty u -> UTxOSelection u
fromNonEmpty :: UTxOSelectionNonEmpty u -> UTxOSelection u
fromNonEmpty = State u -> UTxOSelection u
forall u. State u -> UTxOSelection u
UTxOSelection (State u -> UTxOSelection u)
-> (UTxOSelectionNonEmpty u -> State u)
-> UTxOSelectionNonEmpty u
-> UTxOSelection u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOSelectionNonEmpty u -> State u
forall (s :: * -> *) u. HasUTxOSelectionState s u => s u -> State u
state

-- | Promotes an ordinary selection to a non-empty selection.
--
-- Returns 'Nothing' if the the selected set is empty.
--
toNonEmpty :: IsUTxOSelection s u => s u -> Maybe (UTxOSelectionNonEmpty u)
toNonEmpty :: s u -> Maybe (UTxOSelectionNonEmpty u)
toNonEmpty s u
s = Maybe (UTxOSelectionNonEmpty u)
-> Maybe (UTxOSelectionNonEmpty u)
-> Bool
-> Maybe (UTxOSelectionNonEmpty u)
forall a. a -> a -> Bool -> a
bool Maybe (UTxOSelectionNonEmpty u)
forall a. Maybe a
Nothing (UTxOSelectionNonEmpty u -> Maybe (UTxOSelectionNonEmpty u)
forall a. a -> Maybe a
Just (UTxOSelectionNonEmpty u -> Maybe (UTxOSelectionNonEmpty u))
-> UTxOSelectionNonEmpty u -> Maybe (UTxOSelectionNonEmpty u)
forall a b. (a -> b) -> a -> b
$ State u -> UTxOSelectionNonEmpty u
forall (s :: * -> *) u. HasUTxOSelectionState s u => State u -> s u
fromState (State u -> UTxOSelectionNonEmpty u)
-> State u -> UTxOSelectionNonEmpty u
forall a b. (a -> b) -> a -> b
$ s u -> State u
forall (s :: * -> *) u. HasUTxOSelectionState s u => s u -> State u
state s u
s) (s u -> Bool
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> Bool
isNonEmpty s u
s)

--------------------------------------------------------------------------------
-- Indicator functions
--------------------------------------------------------------------------------

-- | Returns 'True' if and only if the selected set is empty.
--
isEmpty :: IsUTxOSelection s u => s u -> Bool
isEmpty :: s u -> Bool
isEmpty = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool) -> (s u -> Int) -> s u -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s u -> Int
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> Int
selectedSize

-- | Returns 'True' if and only if the selected set is non-empty.
--
isNonEmpty :: IsUTxOSelection s u => s u -> Bool
isNonEmpty :: s u -> Bool
isNonEmpty = Bool -> Bool
not (Bool -> Bool) -> (s u -> Bool) -> s u -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s u -> Bool
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> Bool
isEmpty

-- | Returns 'True' if the given 'InputId' is a member of either set.
--
-- Otherwise, returns 'False'.
--
isMember :: IsUTxOSelection s u => Ord u => u -> s u -> Bool
isMember :: u -> s u -> Bool
isMember u
u s u
s = u -> s u -> Bool
forall (s :: * -> *) u.
(IsUTxOSelection s u, Ord u) =>
u -> s u -> Bool
isLeftover u
u s u
s Bool -> Bool -> Bool
|| u -> s u -> Bool
forall (s :: * -> *) u.
(IsUTxOSelection s u, Ord u) =>
u -> s u -> Bool
isSelected u
u s u
s

-- | Returns 'True' iff. the given 'InputId' is a member of the leftover set.
--
isLeftover :: IsUTxOSelection s u => Ord u => u -> s u -> Bool
isLeftover :: u -> s u -> Bool
isLeftover u
u = u -> UTxOIndex u -> Bool
forall u. Ord u => u -> UTxOIndex u -> Bool
UTxOIndex.member u
u (UTxOIndex u -> Bool) -> (s u -> UTxOIndex u) -> s u -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s u -> UTxOIndex u
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> UTxOIndex u
leftoverIndex

-- | Returns 'True' iff. the given 'InputId' is a member of the selected set.
--
isSelected :: IsUTxOSelection s u => Ord u => u -> s u -> Bool
isSelected :: u -> s u -> Bool
isSelected u
u = u -> UTxOIndex u -> Bool
forall u. Ord u => u -> UTxOIndex u -> Bool
UTxOIndex.member u
u (UTxOIndex u -> Bool) -> (s u -> UTxOIndex u) -> s u -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s u -> UTxOIndex u
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> UTxOIndex u
selectedIndex

-- | Returns 'True' iff. the first selection is a sub-selection of the second.
--
-- A selection 's1' is a sub-selection of selection 's2' if (and only if) it
-- is possible to transform 's1' into 's2' through zero or more applications
-- of the 'select' function.
--
isSubSelectionOf
    :: IsUTxOSelection s1 u
    => IsUTxOSelection s2 u
    => Ord u
    => s1 u
    -> s2 u
    -> Bool
isSubSelectionOf :: s1 u -> s2 u -> Bool
isSubSelectionOf s1 u
s1 s2 u
s2 = s1 u -> State u
forall (s :: * -> *) u. HasUTxOSelectionState s u => s u -> State u
state ([u] -> s1 u -> s1 u
forall (s :: * -> *) u (f :: * -> *).
(IsUTxOSelection s u, Ord u, Foldable f) =>
f u -> s u -> s u
selectMany [u]
toSelect s1 u
s1) State u -> State u -> Bool
forall a. Eq a => a -> a -> Bool
== s2 u -> State u
forall (s :: * -> *) u. HasUTxOSelectionState s u => s u -> State u
state s2 u
s2
  where
    toSelect :: [u]
toSelect = (u, TokenBundle) -> u
forall a b. (a, b) -> a
fst ((u, TokenBundle) -> u) -> [(u, TokenBundle)] -> [u]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map u TokenBundle -> [(u, TokenBundle)]
forall k a. Map k a -> [(k, a)]
Map.toList
        (s2 u -> Map u TokenBundle
forall (s :: * -> *) u.
IsUTxOSelection s u =>
s u -> Map u TokenBundle
selectedMap s2 u
s2 Map u TokenBundle -> Map u TokenBundle -> Map u TokenBundle
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`Map.difference` s1 u -> Map u TokenBundle
forall (s :: * -> *) u.
IsUTxOSelection s u =>
s u -> Map u TokenBundle
selectedMap s1 u
s1)

-- | Returns 'True' iff. the first selection is a proper sub-selection of the
--   second.
--
-- A selection 's1' is a proper sub-selection of selection 's2' if (and only
-- if) it is possible to transform 's1' into 's2' through one or more
-- applications of the 'select' function.
--
isProperSubSelectionOf
    :: IsUTxOSelection s1 u
    => IsUTxOSelection s2 u
    => Ord u
    => s1 u
    -> s2 u
    -> Bool
isProperSubSelectionOf :: s1 u -> s2 u -> Bool
isProperSubSelectionOf s1 u
s1 s2 u
s2 = s1 u -> State u
forall (s :: * -> *) u. HasUTxOSelectionState s u => s u -> State u
state s1 u
s1 State u -> State u -> Bool
forall a. Eq a => a -> a -> Bool
/= s2 u -> State u
forall (s :: * -> *) u. HasUTxOSelectionState s u => s u -> State u
state s2 u
s2 Bool -> Bool -> Bool
&& s1 u
s1 s1 u -> s2 u -> Bool
forall (s1 :: * -> *) u (s2 :: * -> *).
(IsUTxOSelection s1 u, IsUTxOSelection s2 u, Ord u) =>
s1 u -> s2 u -> Bool
`isSubSelectionOf` s2 u
s2

--------------------------------------------------------------------------------
-- Accessor functions
--------------------------------------------------------------------------------

-- | Computes the available balance.
--
-- The available balance is the sum of the selected and the leftover balances.
--
-- It predicts what 'selectedBalance' would be if every single UTxO were
-- selected.
--
-- This result of this function remains constant over applications of 'select'
-- and 'selectMany':
--
-- >>> availableBalance s == availableBalance (selectMany is s)
--
availableBalance :: IsUTxOSelection s u => s u -> TokenBundle
availableBalance :: s u -> TokenBundle
availableBalance s u
s = s u -> TokenBundle
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> TokenBundle
leftoverBalance s u
s TokenBundle -> TokenBundle -> TokenBundle
forall a. Semigroup a => a -> a -> a
<> s u -> TokenBundle
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> TokenBundle
selectedBalance s u
s

-- | Computes the complete map of all available UTxOs.
--
-- The available UTxO set is the union of the selected and leftover UTxO sets.
--
-- It predicts what 'selectedMap' would be if every single UTxO were selected.
--
-- This result of this function remains constant over applications of 'select'
-- and 'selectMany':
--
-- >>> availableMap s == availableMap (selectMany is s)
--
availableMap :: IsUTxOSelection s u => Ord u => s u -> Map u TokenBundle
availableMap :: s u -> Map u TokenBundle
availableMap s u
s = s u -> Map u TokenBundle
forall (s :: * -> *) u.
IsUTxOSelection s u =>
s u -> Map u TokenBundle
leftoverMap s u
s Map u TokenBundle -> Map u TokenBundle -> Map u TokenBundle
forall a. Semigroup a => a -> a -> a
<> s u -> Map u TokenBundle
forall (s :: * -> *) u.
IsUTxOSelection s u =>
s u -> Map u TokenBundle
selectedMap s u
s

-- | Computes the size of the available UTxO set.
--
availableSize :: IsUTxOSelection s u => s u -> Int
availableSize :: s u -> Int
availableSize s u
s = s u -> Int
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> Int
leftoverSize s u
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ s u -> Int
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> Int
selectedSize s u
s

-- | Retrieves the balance of leftover UTxOs.
--
leftoverBalance :: IsUTxOSelection s u => s u -> TokenBundle
leftoverBalance :: s u -> TokenBundle
leftoverBalance = UTxOIndex u -> TokenBundle
forall u. UTxOIndex u -> TokenBundle
UTxOIndex.balance (UTxOIndex u -> TokenBundle)
-> (s u -> UTxOIndex u) -> s u -> TokenBundle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s u -> UTxOIndex u
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> UTxOIndex u
leftoverIndex

-- | Retrieves the size of the leftover UTxO set.
--
leftoverSize :: IsUTxOSelection s u => s u -> Int
leftoverSize :: s u -> Int
leftoverSize = UTxOIndex u -> Int
forall u. UTxOIndex u -> Int
UTxOIndex.size (UTxOIndex u -> Int) -> (s u -> UTxOIndex u) -> s u -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s u -> UTxOIndex u
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> UTxOIndex u
leftoverIndex

-- | Retrieves an index of the leftover UTxOs.
--
leftoverIndex :: IsUTxOSelection s u => s u -> UTxOIndex u
leftoverIndex :: s u -> UTxOIndex u
leftoverIndex = State u -> UTxOIndex u
forall u. State u -> UTxOIndex u
leftover (State u -> UTxOIndex u) -> (s u -> State u) -> s u -> UTxOIndex u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s u -> State u
forall (s :: * -> *) u. HasUTxOSelectionState s u => s u -> State u
state

-- | Retrieves a map of the leftover UTxOs.
--
leftoverMap :: IsUTxOSelection s u => s u -> Map u TokenBundle
leftoverMap :: s u -> Map u TokenBundle
leftoverMap = UTxOIndex u -> Map u TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
UTxOIndex.toMap (UTxOIndex u -> Map u TokenBundle)
-> (s u -> UTxOIndex u) -> s u -> Map u TokenBundle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s u -> UTxOIndex u
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> UTxOIndex u
leftoverIndex

-- | Retrieves a list of the leftover UTxOs.
--
leftoverList :: IsUTxOSelection s u => s u -> [(u, TokenBundle)]
leftoverList :: s u -> [(u, TokenBundle)]
leftoverList = UTxOIndex u -> [(u, TokenBundle)]
forall u. UTxOIndex u -> [(u, TokenBundle)]
UTxOIndex.toList (UTxOIndex u -> [(u, TokenBundle)])
-> (s u -> UTxOIndex u) -> s u -> [(u, TokenBundle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s u -> UTxOIndex u
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> UTxOIndex u
leftoverIndex

-- | Retrieves the balance of selected UTxOs.
--
selectedBalance :: IsUTxOSelection s u => s u -> TokenBundle
selectedBalance :: s u -> TokenBundle
selectedBalance = UTxOIndex u -> TokenBundle
forall u. UTxOIndex u -> TokenBundle
UTxOIndex.balance (UTxOIndex u -> TokenBundle)
-> (s u -> UTxOIndex u) -> s u -> TokenBundle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s u -> UTxOIndex u
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> UTxOIndex u
selectedIndex

-- | Retrieves the size of the selected UTxO set.
--
selectedSize :: IsUTxOSelection s u => s u -> Int
selectedSize :: s u -> Int
selectedSize = UTxOIndex u -> Int
forall u. UTxOIndex u -> Int
UTxOIndex.size (UTxOIndex u -> Int) -> (s u -> UTxOIndex u) -> s u -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s u -> UTxOIndex u
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> UTxOIndex u
selectedIndex

-- | Retrieves an index of the selected UTxOs.
--
selectedIndex :: IsUTxOSelection s u => s u -> UTxOIndex u
selectedIndex :: s u -> UTxOIndex u
selectedIndex = State u -> UTxOIndex u
forall u. State u -> UTxOIndex u
selected (State u -> UTxOIndex u) -> (s u -> State u) -> s u -> UTxOIndex u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s u -> State u
forall (s :: * -> *) u. HasUTxOSelectionState s u => s u -> State u
state

-- | Retrieves a map of the selected UTxOs.
--
selectedMap :: IsUTxOSelection s u => s u -> Map u TokenBundle
selectedMap :: s u -> Map u TokenBundle
selectedMap = UTxOIndex u -> Map u TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
UTxOIndex.toMap (UTxOIndex u -> Map u TokenBundle)
-> (s u -> UTxOIndex u) -> s u -> Map u TokenBundle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s u -> UTxOIndex u
forall (s :: * -> *) u. IsUTxOSelection s u => s u -> UTxOIndex u
selectedIndex

--------------------------------------------------------------------------------
-- Modification
--------------------------------------------------------------------------------

-- | Moves a single entry from the leftover set to the selected set.
--
-- Returns 'Nothing' if the given entry is not a member of the leftover set.
--
select
    :: IsUTxOSelection s u
    => Ord u
    => u
    -> s u
    -> Maybe (UTxOSelectionNonEmpty u)
select :: u -> s u -> Maybe (UTxOSelectionNonEmpty u)
select = (s u -> Maybe (UTxOSelectionNonEmpty u)
forall (s :: * -> *) u.
IsUTxOSelection s u =>
s u -> Maybe (UTxOSelectionNonEmpty u)
toNonEmpty (s u -> Maybe (UTxOSelectionNonEmpty u))
-> (s u -> Maybe (s u)) -> s u -> Maybe (UTxOSelectionNonEmpty u)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=<) ((s u -> Maybe (s u)) -> s u -> Maybe (UTxOSelectionNonEmpty u))
-> (u -> s u -> Maybe (s u))
-> u
-> s u
-> Maybe (UTxOSelectionNonEmpty u)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State u -> Maybe (State u)) -> s u -> Maybe (s u)
forall (f :: * -> *) (s :: * -> *) u.
(Functor f, IsUTxOSelection s u) =>
(State u -> f (State u)) -> s u -> f (s u)
withState ((State u -> Maybe (State u)) -> s u -> Maybe (s u))
-> (u -> State u -> Maybe (State u)) -> u -> s u -> Maybe (s u)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. u -> State u -> Maybe (State u)
forall u. Ord u => u -> State u -> Maybe (State u)
selectState

-- | Moves multiple entries from the leftover set to the selected set.
--
selectMany
    :: IsUTxOSelection s u
    => Ord u
    => Foldable f
    => f u
    -> s u
    -> s u
selectMany :: f u -> s u -> s u
selectMany = (s u -> Maybe (s u) -> s u) -> (s u -> Maybe (s u)) -> s u -> s u
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap s u -> Maybe (s u) -> s u
forall a. a -> Maybe a -> a
fromMaybe ((s u -> Maybe (s u)) -> s u -> s u)
-> (f u -> s u -> Maybe (s u)) -> f u -> s u -> s u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State u -> Maybe (State u)) -> s u -> Maybe (s u)
forall (f :: * -> *) (s :: * -> *) u.
(Functor f, IsUTxOSelection s u) =>
(State u -> f (State u)) -> s u -> f (s u)
withState ((State u -> Maybe (State u)) -> s u -> Maybe (s u))
-> (f u -> State u -> Maybe (State u)) -> f u -> s u -> Maybe (s u)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State u -> f u -> Maybe (State u))
-> f u -> State u -> Maybe (State u)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((u -> State u -> Maybe (State u))
-> State u -> f u -> Maybe (State u)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
F.foldrM u -> State u -> Maybe (State u)
forall u. Ord u => u -> State u -> Maybe (State u)
selectState)

--------------------------------------------------------------------------------
-- Modification (Internal)
--------------------------------------------------------------------------------

-- | Moves a single entry from the leftover set to the selected set.
--
selectState :: Ord u => u -> State u -> Maybe (State u)
selectState :: u -> State u -> Maybe (State u)
selectState u
u State u
s =
    TokenBundle -> State u
updateFields (TokenBundle -> State u) -> Maybe TokenBundle -> Maybe (State u)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> u -> UTxOIndex u -> Maybe TokenBundle
forall u. Ord u => u -> UTxOIndex u -> Maybe TokenBundle
UTxOIndex.lookup u
u (State u -> UTxOIndex u
forall u. State u -> UTxOIndex u
leftover State u
s)
  where
    updateFields :: TokenBundle -> State u
updateFields TokenBundle
b = State u
s
        State u -> (State u -> State u) -> State u
forall a b. a -> (a -> b) -> b
& ((UTxOIndex u -> Identity (UTxOIndex u))
 -> State u -> Identity (State u))
-> (UTxOIndex u -> UTxOIndex u) -> State u -> State u
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "leftover"
  ((UTxOIndex u -> Identity (UTxOIndex u))
   -> State u -> Identity (State u))
(UTxOIndex u -> Identity (UTxOIndex u))
-> State u -> Identity (State u)
#leftover (u -> UTxOIndex u -> UTxOIndex u
forall u. Ord u => u -> UTxOIndex u -> UTxOIndex u
UTxOIndex.delete u
u)
        State u -> (State u -> State u) -> State u
forall a b. a -> (a -> b) -> b
& ((UTxOIndex u -> Identity (UTxOIndex u))
 -> State u -> Identity (State u))
-> (UTxOIndex u -> UTxOIndex u) -> State u -> State u
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "selected"
  ((UTxOIndex u -> Identity (UTxOIndex u))
   -> State u -> Identity (State u))
(UTxOIndex u -> Identity (UTxOIndex u))
-> State u -> Identity (State u)
#selected (u -> TokenBundle -> UTxOIndex u -> UTxOIndex u
forall u. Ord u => u -> TokenBundle -> UTxOIndex u -> UTxOIndex u
UTxOIndex.insert u
u TokenBundle
b)

-- | Applies the given function to the internal state.
--
withState
    :: Functor f
    => IsUTxOSelection s u
    => (State u -> f (State u))
    -> s u
    -> f (s u)
withState :: (State u -> f (State u)) -> s u -> f (s u)
withState State u -> f (State u)
f = (State u -> s u) -> f (State u) -> f (s u)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap State u -> s u
forall (s :: * -> *) u. HasUTxOSelectionState s u => State u -> s u
fromState (f (State u) -> f (s u)) -> (s u -> f (State u)) -> s u -> f (s u)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State u -> f (State u)
f (State u -> f (State u)) -> (s u -> State u) -> s u -> f (State u)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s u -> State u
forall (s :: * -> *) u. HasUTxOSelectionState s u => s u -> State u
state