content: {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE DuplicateRecordFields #-}
  {-# LANGUAGE ExplicitForAll #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE NamedFieldPuns #-}
  {-# LANGUAGE OverloadedLabels #-}
  {-# LANGUAGE TypeFamilies #-}
  
  {- |
  Copyright: © 2018-2021 IOHK, 2025 GYELD GMBH
  License: Apache-2.0
  
  Modified by: GeniusYield
  
  Originally from: [@Cardano.CoinSelection.UTxOSelection@](https://github.com/cardano-foundation/cardano-wallet/blob/master/lib/coin-selection/lib/Cardano/CoinSelection/UTxOSelection.hs).
  
  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 GeniusYield.Transaction.CoinSelection.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 Control.Monad (
    ap,
    (<=<),
   )
  import Data.Bool (
    bool,
   )
  import Data.Foldable qualified as F
  import Data.Function (
    (&),
   )
  import Data.Generics.Internal.VL.Lens (
    over,
   )
  import Data.Generics.Labels (
  
   )
  import Data.List.NonEmpty (
    NonEmpty,
   )
  import Data.List.NonEmpty qualified as NE
  import Data.Map.Strict (
    Map,
   )
  import Data.Map.Strict qualified as Map
  import Data.Maybe (
    fromMaybe,
   )
  import Data.Tuple (
    swap,
   )
  import GHC.Generics (
    Generic,
   )
  import GeniusYield.Transaction.CoinSelection.UTxOIndex (
    UTxOIndex,
   )
  import GeniusYield.Transaction.CoinSelection.UTxOIndex qualified as UTxOIndex
  import GeniusYield.Types
  import Prelude
  
  --------------------------------------------------------------------------------
  -- 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
    { leftover :: !(UTxOIndex u)
    -- ^ UTxOs that have not yet been selected.
    , selected :: !(UTxOIndex u)
    -- ^ UTxOs that have already been selected.
    }
    deriving (Eq, Generic, Show)
  
  -- | A selection for which 'isNonEmpty' may be 'False'.
  newtype UTxOSelection u = UTxOSelection (State u)
    deriving (Eq, Generic, Show)
  
  -- | A selection for which 'isNonEmpty' must be 'True'.
  newtype UTxOSelectionNonEmpty u = UTxOSelectionNonEmpty (State u)
    deriving (Eq, Generic, Show)
  
  instance HasUTxOSelectionState UTxOSelection u where
    state (UTxOSelection s) = s
    fromState = UTxOSelection
  
  instance HasUTxOSelectionState UTxOSelectionNonEmpty u where
    state (UTxOSelectionNonEmpty s) = s
    fromState = UTxOSelectionNonEmpty
  
  instance IsUTxOSelection UTxOSelection u where
    type SelectedList UTxOSelection u = [(u, GYValue)]
    selectedList = UTxOIndex.toList . selectedIndex
  
  instance IsUTxOSelection UTxOSelectionNonEmpty u where
    type SelectedList UTxOSelectionNonEmpty u = NonEmpty (u, GYValue)
    selectedList = NE.fromList . UTxOIndex.toList . selectedIndex
  
  --------------------------------------------------------------------------------
  -- Construction and deconstruction
  --------------------------------------------------------------------------------
  
  -- | A completely empty selection with no selected or leftover UTxOs.
  empty :: UTxOSelection u
  empty = fromIndex 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 i =
    UTxOSelection
      State
        { leftover = i
        , selected = 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 f =
    UTxOSelection . uncurry State . swap . UTxOIndex.partition 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 (leftover, selected) =
    UTxOSelection
      State
        { leftover = leftover `UTxOIndex.difference` selected
        , 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 = (leftoverIndex s, selectedIndex s)
  
  --------------------------------------------------------------------------------
  -- Promotion and demotion
  --------------------------------------------------------------------------------
  
  -- | Demotes a non-empty selection to an ordinary selection.
  fromNonEmpty :: UTxOSelectionNonEmpty u -> UTxOSelection u
  fromNonEmpty = UTxOSelection . 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 = bool Nothing (Just $ fromState $ state s) (isNonEmpty s)
  
  --------------------------------------------------------------------------------
  -- Indicator functions
  --------------------------------------------------------------------------------
  
  -- | Returns 'True' if and only if the selected set is empty.
  isEmpty :: IsUTxOSelection s u => s u -> Bool
  isEmpty = (== 0) . selectedSize
  
  -- | Returns 'True' if and only if the selected set is non-empty.
  isNonEmpty :: IsUTxOSelection s u => s u -> Bool
  isNonEmpty = not . 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 = isLeftover u s || isSelected 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 = UTxOIndex.member 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 = UTxOIndex.member 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 s2 = state (selectMany toSelect s1) == state s2
   where
    toSelect =
      fst
        <$> Map.toList
          (selectedMap s2 `Map.difference` selectedMap 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 s2 = state s1 /= state s2 && s1 `isSubSelectionOf` 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 -> GYValue
  availableBalance s = leftoverBalance s <> selectedBalance 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 GYValue
  availableMap s = leftoverMap s <> selectedMap s
  
  -- | Computes the size of the available UTxO set.
  availableSize :: IsUTxOSelection s u => s u -> Int
  availableSize s = leftoverSize s + selectedSize s
  
  -- | Retrieves the balance of leftover UTxOs.
  leftoverBalance :: IsUTxOSelection s u => s u -> GYValue
  leftoverBalance = UTxOIndex.balance . leftoverIndex
  
  -- | Retrieves the size of the leftover UTxO set.
  leftoverSize :: IsUTxOSelection s u => s u -> Int
  leftoverSize = UTxOIndex.size . leftoverIndex
  
  -- | Retrieves an index of the leftover UTxOs.
  leftoverIndex :: IsUTxOSelection s u => s u -> UTxOIndex u
  leftoverIndex = leftover . state
  
  -- | Retrieves a map of the leftover UTxOs.
  leftoverMap :: IsUTxOSelection s u => s u -> Map u GYValue
  leftoverMap = UTxOIndex.toMap . leftoverIndex
  
  -- | Retrieves a list of the leftover UTxOs.
  leftoverList :: IsUTxOSelection s u => s u -> [(u, GYValue)]
  leftoverList = UTxOIndex.toList . leftoverIndex
  
  -- | Retrieves the balance of selected UTxOs.
  selectedBalance :: IsUTxOSelection s u => s u -> GYValue
  selectedBalance = UTxOIndex.balance . selectedIndex
  
  -- | Retrieves the size of the selected UTxO set.
  selectedSize :: IsUTxOSelection s u => s u -> Int
  selectedSize = UTxOIndex.size . selectedIndex
  
  -- | Retrieves an index of the selected UTxOs.
  selectedIndex :: IsUTxOSelection s u => s u -> UTxOIndex u
  selectedIndex = selected . state
  
  -- | Retrieves a map of the selected UTxOs.
  selectedMap :: IsUTxOSelection s u => s u -> Map u GYValue
  selectedMap = UTxOIndex.toMap . 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 = (toNonEmpty <=<) . withState . 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 = ap fromMaybe . withState . flip (F.foldrM 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 s =
    updateFields <$> UTxOIndex.lookup u (leftover s)
   where
    updateFields v =
      s
        & over #leftover (UTxOIndex.delete u)
        & over #selected (UTxOIndex.insert u v)
  
  -- | 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 f = fmap fromState . f . state
  