{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

-- | A 'UMap' (for Unified map) represents
--
-- 1. 4 Maps with the same domain in one direction, as a single `Map` and
-- 2. 1 other `Map` which is an inverse of one of the other 4 Maps.
--
-- The advantage of using `UMap` is that it stores all the information
-- compactly, by exploiting the large amount of sharing in Map #1.
--
-- As for the other Map #2, we don't expect it to have much volume.
module Cardano.Ledger.UMap (
  -- * Constructing a `UMap`
  RDPair (..),
  rdRewardCoin,
  rdDepositCoin,
  UMElem (UMElem),
  umElemRDPair,
  umElemRDActive,
  RewardDelegation (..),
  umElemDRepDelegatedReward,
  umElemDelegations,
  umElemPtrs,
  umElemSPool,
  umElemDRep,
  umElemAsTuple,
  nullUMElem,
  nullUMElemMaybe,
  UMap (..),
  umElemsL,
  empty,
  umInvariant,

  -- * StakeCredentials
  StakeCredentials (..),
  toStakeCredentials,
  domRestrictedStakeCredentials,

  -- * `UView` and its components
  UView (..),
  rewDepUView,
  ptrUView,
  sPoolUView,
  dRepUView,
  unUView,
  unUnifyToVMap,
  rdPairMap,
  rewardMap,
  compactRewardMap,
  depositMap,
  ptrMap,
  invPtrMap,
  sPoolMap,
  dRepMap,
  domRestrictedMap,
  CompactForm (CompactCoin),
  toCompact,
  fromCompact,
  addCompact,
  sumCompactCoin,
  sumRewardsUView,
  sumDepositUView,
  compactCoinOrError,
  unify,
  unUnify,

  -- * Set and Map operations on `UView`s
  nullUView,
  member,
  member',
  notMember,
  delete,
  delete',
  insertWith,
  insertWith',
  insert,
  insert',
  adjust,
  lookup,
  domain,
  range,
  (∪),
  unionL,
  (⨃),
  unionR,
  (∪+),
  unionRewAgg,
  unionKeyDeposits,
  (⋪),
  domDelete,
  (⋫),
  rngDelete,
  (◁),
  domRestrict,

  -- * Derived functions
  findWithDefault,
  size,
  domDeleteAll,
  deleteStakingCredential,
  extractStakingCredential,
)
where

import Cardano.Ledger.BaseTypes (strictMaybe)
import Cardano.Ledger.Binary
import Cardano.Ledger.Coin (Coin (..), CompactForm (CompactCoin), compactCoinOrError)
import Cardano.Ledger.Compactible (Compactible (..))
import Cardano.Ledger.Credential (Credential (..), Ptr)
import Cardano.Ledger.DRep (DRep)
import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
import Control.DeepSeq (NFData (..))
import Control.Monad.Trans.State.Strict (StateT (..))
import Data.Aeson (ToJSON (..), object, (.=))
import qualified Data.Aeson as Aeson
import Data.Foldable (Foldable (..))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.MapExtras as MapExtras (extract, intersectDomPLeft)
import Data.Maybe as Maybe (fromMaybe, isNothing, mapMaybe)
import Data.Maybe.Strict (StrictMaybe (..))
import Data.Proxy
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Set.Internal as SI (Set (Tip))
import qualified Data.VMap as VMap
import GHC.Generics (Generic)
import Lens.Micro (Lens', lens)
import NoThunks.Class (NoThunks (..))
import Prelude hiding (lookup, null)

-- | A Reward-Deposit Pair
-- Used to represent the reward and the deposit for a given (Credential 'Staking c)
data RDPair = RDPair
  { RDPair -> CompactForm Coin
rdReward :: {-# UNPACK #-} !(CompactForm Coin)
  , RDPair -> CompactForm Coin
rdDeposit :: {-# UNPACK #-} !(CompactForm Coin)
  }
  deriving (Int -> RDPair -> ShowS
[RDPair] -> ShowS
RDPair -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RDPair] -> ShowS
$cshowList :: [RDPair] -> ShowS
show :: RDPair -> String
$cshow :: RDPair -> String
showsPrec :: Int -> RDPair -> ShowS
$cshowsPrec :: Int -> RDPair -> ShowS
Show, RDPair -> RDPair -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RDPair -> RDPair -> Bool
$c/= :: RDPair -> RDPair -> Bool
== :: RDPair -> RDPair -> Bool
$c== :: RDPair -> RDPair -> Bool
Eq, Eq RDPair
RDPair -> RDPair -> Bool
RDPair -> RDPair -> Ordering
RDPair -> RDPair -> RDPair
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 :: RDPair -> RDPair -> RDPair
$cmin :: RDPair -> RDPair -> RDPair
max :: RDPair -> RDPair -> RDPair
$cmax :: RDPair -> RDPair -> RDPair
>= :: RDPair -> RDPair -> Bool
$c>= :: RDPair -> RDPair -> Bool
> :: RDPair -> RDPair -> Bool
$c> :: RDPair -> RDPair -> Bool
<= :: RDPair -> RDPair -> Bool
$c<= :: RDPair -> RDPair -> Bool
< :: RDPair -> RDPair -> Bool
$c< :: RDPair -> RDPair -> Bool
compare :: RDPair -> RDPair -> Ordering
$ccompare :: RDPair -> RDPair -> Ordering
Ord, forall x. Rep RDPair x -> RDPair
forall x. RDPair -> Rep RDPair x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RDPair x -> RDPair
$cfrom :: forall x. RDPair -> Rep RDPair x
Generic, Context -> RDPair -> IO (Maybe ThunkInfo)
Proxy RDPair -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy RDPair -> String
$cshowTypeOf :: Proxy RDPair -> String
wNoThunks :: Context -> RDPair -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> RDPair -> IO (Maybe ThunkInfo)
noThunks :: Context -> RDPair -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> RDPair -> IO (Maybe ThunkInfo)
NoThunks, RDPair -> ()
forall a. (a -> ()) -> NFData a
rnf :: RDPair -> ()
$crnf :: RDPair -> ()
NFData)

-- rdReward and rdDeposit return a (CompactForm Coin), These return a Coin.

rdRewardCoin :: RDPair -> Coin
rdRewardCoin :: RDPair -> Coin
rdRewardCoin RDPair
rdp = forall a. Compactible a => CompactForm a -> a
fromCompact (RDPair -> CompactForm Coin
rdReward RDPair
rdp)

rdDepositCoin :: RDPair -> Coin
rdDepositCoin :: RDPair -> Coin
rdDepositCoin RDPair
rdp = forall a. Compactible a => CompactForm a -> a
fromCompact (RDPair -> CompactForm Coin
rdDeposit RDPair
rdp)

instance EncCBOR RDPair where
  encCBOR :: RDPair -> Encoding
encCBOR RDPair {CompactForm Coin
rdReward :: CompactForm Coin
rdReward :: RDPair -> CompactForm Coin
rdReward, CompactForm Coin
rdDeposit :: CompactForm Coin
rdDeposit :: RDPair -> CompactForm Coin
rdDeposit} =
    Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR CompactForm Coin
rdReward forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR CompactForm Coin
rdDeposit

instance DecCBOR RDPair where
  decCBOR :: forall s. Decoder s RDPair
decCBOR =
    forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"RDPair" (forall a b. a -> b -> a
const Int
2) forall a b. (a -> b) -> a -> b
$ CompactForm Coin -> CompactForm Coin -> RDPair
RDPair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR

-- | A `UMElem` compactly represents the range of 4 `Map`s with the same domain
-- as a single n-tuple.
--
-- This space-compacting datatype, and the pattern `UMElem` are equivalent to:
-- @
-- data Elem c = Elem
--   { rdPairT :: !(StrictMaybe RDPair),
--     ptrT :: !(Set Ptr),
--     sPoolT :: !(StrictMaybe (KeyHash 'StakePool c)), -- the stake pool identity
--     dRepT :: !(StrictMaybe (DRep c)),
--   }
--   deriving (Show, Eq, Generic, NoThunks, NFData)
-- @
--
-- To name the constructors of `UMElem` we use the notation @Txxx@ where
-- each @x@ is
-- either @F@ for full, i.e. the component is present,
-- or @E@ for empty, i.e. the component is not present.
--
-- There are four components:
-- 1) the reward-deposit pair as an `RDPair` (CompactForm Coin) (CompactForm Coin) as a pair of Word64s, the first @x@,
-- 2) the set of pointers, the second @x@,
-- 3) the stake pool id (KeyHash 'StakePool c), the third @x@, and
-- 4) the voting delegatee id (DRep c), the fourth @x@.
--
-- So,
-- TEEEE means none of the components are present,
-- TFEEE means only the reward-deposit pair is present,
-- TEFEE means only the set of pointers is present,
-- TEEFE means only the stake pool id is present. etc.
-- TEEEF means only the voting delegatee id is present, and
--
-- The pattern 'UMElem' will correctly use the optimal constructor.
data UMElem
  = TEEEE
  | TEEEF !DRep
  | TEEFE !(KeyHash 'StakePool)
  | TEEFF !(KeyHash 'StakePool) !DRep
  | TEFEE !(Set Ptr)
  | TEFEF !(Set Ptr) !DRep
  | TEFFE !(Set Ptr) !(KeyHash 'StakePool)
  | TEFFF !(Set Ptr) !(KeyHash 'StakePool) !DRep
  | TFEEE {-# UNPACK #-} !RDPair
  | TFEEF {-# UNPACK #-} !RDPair !DRep
  | TFEFE {-# UNPACK #-} !RDPair !(KeyHash 'StakePool)
  | TFEFF {-# UNPACK #-} !RDPair !(KeyHash 'StakePool) !DRep
  | TFFEE {-# UNPACK #-} !RDPair !(Set Ptr)
  | TFFEF {-# UNPACK #-} !RDPair !(Set Ptr) !DRep
  | TFFFE {-# UNPACK #-} !RDPair !(Set Ptr) !(KeyHash 'StakePool)
  | TFFFF {-# UNPACK #-} !RDPair !(Set Ptr) !(KeyHash 'StakePool) !DRep
  deriving (UMElem -> UMElem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UMElem -> UMElem -> Bool
$c/= :: UMElem -> UMElem -> Bool
== :: UMElem -> UMElem -> Bool
$c== :: UMElem -> UMElem -> Bool
Eq, Eq UMElem
UMElem -> UMElem -> Bool
UMElem -> UMElem -> Ordering
UMElem -> UMElem -> UMElem
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 :: UMElem -> UMElem -> UMElem
$cmin :: UMElem -> UMElem -> UMElem
max :: UMElem -> UMElem -> UMElem
$cmax :: UMElem -> UMElem -> UMElem
>= :: UMElem -> UMElem -> Bool
$c>= :: UMElem -> UMElem -> Bool
> :: UMElem -> UMElem -> Bool
$c> :: UMElem -> UMElem -> Bool
<= :: UMElem -> UMElem -> Bool
$c<= :: UMElem -> UMElem -> Bool
< :: UMElem -> UMElem -> Bool
$c< :: UMElem -> UMElem -> Bool
compare :: UMElem -> UMElem -> Ordering
$ccompare :: UMElem -> UMElem -> Ordering
Ord, Int -> UMElem -> ShowS
[UMElem] -> ShowS
UMElem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UMElem] -> ShowS
$cshowList :: [UMElem] -> ShowS
show :: UMElem -> String
$cshow :: UMElem -> String
showsPrec :: Int -> UMElem -> ShowS
$cshowsPrec :: Int -> UMElem -> ShowS
Show, forall x. Rep UMElem x -> UMElem
forall x. UMElem -> Rep UMElem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UMElem x -> UMElem
$cfrom :: forall x. UMElem -> Rep UMElem x
Generic, Context -> UMElem -> IO (Maybe ThunkInfo)
Proxy UMElem -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy UMElem -> String
$cshowTypeOf :: Proxy UMElem -> String
wNoThunks :: Context -> UMElem -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UMElem -> IO (Maybe ThunkInfo)
noThunks :: Context -> UMElem -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> UMElem -> IO (Maybe ThunkInfo)
NoThunks, UMElem -> ()
forall a. (a -> ()) -> NFData a
rnf :: UMElem -> ()
$crnf :: UMElem -> ()
NFData)

instance ToJSON UMElem where
  toJSON :: UMElem -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. KeyValue e a => UMElem -> [a]
toUMElemair
  toEncoding :: UMElem -> Encoding
toEncoding = Series -> Encoding
Aeson.pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. KeyValue e a => UMElem -> [a]
toUMElemair

toUMElemair :: Aeson.KeyValue e a => UMElem -> [a]
toUMElemair :: forall e a. KeyValue e a => UMElem -> [a]
toUMElemair (UMElem !StrictMaybe RDPair
rd !Set Ptr
ptr !StrictMaybe (KeyHash 'StakePool)
spool !StrictMaybe DRep
drep) =
  [ Key
"reward" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RDPair -> CompactForm Coin
rdReward StrictMaybe RDPair
rd
  , Key
"deposit" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RDPair -> CompactForm Coin
rdDeposit StrictMaybe RDPair
rd
  , Key
"ptr" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Set Ptr
ptr
  , Key
"spool" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe (KeyHash 'StakePool)
spool
  , Key
"drep" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe DRep
drep
  ]

instance EncCBOR UMElem where
  encCBOR :: UMElem -> Encoding
encCBOR (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep) =
    Word -> Encoding
encodeListLen Word
4 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR StrictMaybe RDPair
rd forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Set Ptr
ptrSet forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR StrictMaybe (KeyHash 'StakePool)
sPool forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR StrictMaybe DRep
dRep

instance DecShareCBOR UMElem where
  type Share UMElem = Interns (KeyHash 'StakePool)
  decShareCBOR :: forall s. Share UMElem -> Decoder s UMElem
decShareCBOR Share UMElem
is =
    forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"UMElem" (forall a b. a -> b -> a
const Int
4) forall a b. (a -> b) -> a -> b
$
      StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9) (forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a s. DecCBOR a => Proxy a -> Decoder s ()
dropCBOR (forall {k} (t :: k). Proxy t
Proxy @(Set Ptr))) forall a s. DecCBOR a => Decoder s a
decCBOR
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) b s.
(DecCBOR (f b), Monad f) =>
Interns b -> Decoder s (f b)
decShareMonadCBOR Share UMElem
is
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR

-- | A n-Tuple view of the `UMElem`.
-- We can view all of the constructors as an `UMElem`.
umElemAsTuple ::
  UMElem ->
  (StrictMaybe RDPair, Set Ptr, StrictMaybe (KeyHash 'StakePool), StrictMaybe DRep)
umElemAsTuple :: UMElem
-> (StrictMaybe RDPair, Set Ptr, StrictMaybe (KeyHash 'StakePool),
    StrictMaybe DRep)
umElemAsTuple = \case
  UMElem
TEEEE -> (forall a. StrictMaybe a
SNothing, forall a. Set a
Set.empty, forall a. StrictMaybe a
SNothing, forall a. StrictMaybe a
SNothing)
  TEEEF DRep
v -> (forall a. StrictMaybe a
SNothing, forall a. Set a
Set.empty, forall a. StrictMaybe a
SNothing, forall a. a -> StrictMaybe a
SJust DRep
v)
  TEEFE KeyHash 'StakePool
s -> (forall a. StrictMaybe a
SNothing, forall a. Set a
Set.empty, forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool
s, forall a. StrictMaybe a
SNothing)
  TEEFF KeyHash 'StakePool
s DRep
v -> (forall a. StrictMaybe a
SNothing, forall a. Set a
Set.empty, forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool
s, forall a. a -> StrictMaybe a
SJust DRep
v)
  TEFEE Set Ptr
p -> (forall a. StrictMaybe a
SNothing, Set Ptr
p, forall a. StrictMaybe a
SNothing, forall a. StrictMaybe a
SNothing)
  TEFEF Set Ptr
p DRep
v -> (forall a. StrictMaybe a
SNothing, Set Ptr
p, forall a. StrictMaybe a
SNothing, forall a. a -> StrictMaybe a
SJust DRep
v)
  TEFFE Set Ptr
p KeyHash 'StakePool
s -> (forall a. StrictMaybe a
SNothing, Set Ptr
p, forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool
s, forall a. StrictMaybe a
SNothing)
  TEFFF Set Ptr
p KeyHash 'StakePool
s DRep
v -> (forall a. StrictMaybe a
SNothing, Set Ptr
p, forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool
s, forall a. a -> StrictMaybe a
SJust DRep
v)
  TFEEE RDPair
r -> (forall a. a -> StrictMaybe a
SJust RDPair
r, forall a. Set a
Set.empty, forall a. StrictMaybe a
SNothing, forall a. StrictMaybe a
SNothing)
  TFEEF RDPair
r DRep
v -> (forall a. a -> StrictMaybe a
SJust RDPair
r, forall a. Set a
Set.empty, forall a. StrictMaybe a
SNothing, forall a. a -> StrictMaybe a
SJust DRep
v)
  TFEFE RDPair
r KeyHash 'StakePool
s -> (forall a. a -> StrictMaybe a
SJust RDPair
r, forall a. Set a
Set.empty, forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool
s, forall a. StrictMaybe a
SNothing)
  TFEFF RDPair
r KeyHash 'StakePool
s DRep
v -> (forall a. a -> StrictMaybe a
SJust RDPair
r, forall a. Set a
Set.empty, forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool
s, forall a. a -> StrictMaybe a
SJust DRep
v)
  TFFEE RDPair
r Set Ptr
p -> (forall a. a -> StrictMaybe a
SJust RDPair
r, Set Ptr
p, forall a. StrictMaybe a
SNothing, forall a. StrictMaybe a
SNothing)
  TFFEF RDPair
r Set Ptr
p DRep
v -> (forall a. a -> StrictMaybe a
SJust RDPair
r, Set Ptr
p, forall a. StrictMaybe a
SNothing, forall a. a -> StrictMaybe a
SJust DRep
v)
  TFFFE RDPair
r Set Ptr
p KeyHash 'StakePool
s -> (forall a. a -> StrictMaybe a
SJust RDPair
r, Set Ptr
p, forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool
s, forall a. StrictMaybe a
SNothing)
  TFFFF RDPair
r Set Ptr
p KeyHash 'StakePool
s DRep
v -> (forall a. a -> StrictMaybe a
SJust RDPair
r, Set Ptr
p, forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool
s, forall a. a -> StrictMaybe a
SJust DRep
v)
{-# INLINE umElemAsTuple #-}

-- | Extract a DRep delegated reward if it is present.
-- We can tell that the pair is present and active when Txxxx has
-- an F in the 1st position (present) and 4rd position (DRep delegated).
--
-- This is equivalent to the pattern (UMElem (SJust r) _ _ (SJust d)) -> Just (r, d)
umElemDRepDelegatedReward :: UMElem -> Maybe (CompactForm Coin, DRep)
umElemDRepDelegatedReward :: UMElem -> Maybe (CompactForm Coin, DRep)
umElemDRepDelegatedReward = \case
  TFEEF RDPair {CompactForm Coin
rdReward :: CompactForm Coin
rdReward :: RDPair -> CompactForm Coin
rdReward} DRep
dRep -> forall a. a -> Maybe a
Just (CompactForm Coin
rdReward, DRep
dRep)
  TFEFF RDPair {CompactForm Coin
rdReward :: CompactForm Coin
rdReward :: RDPair -> CompactForm Coin
rdReward} KeyHash 'StakePool
_ DRep
dRep -> forall a. a -> Maybe a
Just (CompactForm Coin
rdReward, DRep
dRep)
  TFFEF RDPair {CompactForm Coin
rdReward :: CompactForm Coin
rdReward :: RDPair -> CompactForm Coin
rdReward} Set Ptr
_ DRep
dRep -> forall a. a -> Maybe a
Just (CompactForm Coin
rdReward, DRep
dRep)
  TFFFF RDPair {CompactForm Coin
rdReward :: CompactForm Coin
rdReward :: RDPair -> CompactForm Coin
rdReward} Set Ptr
_ KeyHash 'StakePool
_ DRep
dRep -> forall a. a -> Maybe a
Just (CompactForm Coin
rdReward, DRep
dRep)
  UMElem
_ -> forall a. Maybe a
Nothing
{-# INLINE umElemDRepDelegatedReward #-}

-- | Extract a delegated reward-deposit pair if it is present.
-- We can tell that the pair is present and active when Txxxx has
-- an F in the 1st position (present) and 3rd position (delegated).
--
-- This is equivalent to the pattern (UMElem (SJust r) _ (SJust _) _) -> Just r
umElemRDActive :: UMElem -> Maybe RDPair
umElemRDActive :: UMElem -> Maybe RDPair
umElemRDActive = \case
  TFEFE RDPair
rdA KeyHash 'StakePool
_ -> forall a. a -> Maybe a
Just RDPair
rdA
  TFEFF RDPair
rdA KeyHash 'StakePool
_ DRep
_ -> forall a. a -> Maybe a
Just RDPair
rdA
  TFFFE RDPair
rdA Set Ptr
_ KeyHash 'StakePool
_ -> forall a. a -> Maybe a
Just RDPair
rdA
  TFFFF RDPair
rdA Set Ptr
_ KeyHash 'StakePool
_ DRep
_ -> forall a. a -> Maybe a
Just RDPair
rdA
  UMElem
_ -> forall a. Maybe a
Nothing
{-# INLINE umElemRDActive #-}

data RewardDelegation
  = RewardDelegationSPO !(KeyHash 'StakePool) !(CompactForm Coin)
  | RewardDelegationDRep !DRep !(CompactForm Coin)
  | RewardDelegationBoth !(KeyHash 'StakePool) !DRep !(CompactForm Coin)

-- | Extract rewards that are either delegated to a DRep or an SPO (or both).
-- We can tell that the pair is present and active when Txxxx has F's in the 1st
-- and either 3rd or 4th or both positions. If there are no rewards or deposits
-- but the delegations still exist, then we return zero coin as reward.
umElemDelegations :: UMElem -> Maybe RewardDelegation
umElemDelegations :: UMElem -> Maybe RewardDelegation
umElemDelegations (UMElem StrictMaybe RDPair
r Set Ptr
_p StrictMaybe (KeyHash 'StakePool)
s StrictMaybe DRep
d) =
  let reward :: CompactForm Coin
reward = forall a b. a -> (b -> a) -> StrictMaybe b -> a
strictMaybe forall a. Monoid a => a
mempty RDPair -> CompactForm Coin
rdReward StrictMaybe RDPair
r
   in case (StrictMaybe (KeyHash 'StakePool)
s, StrictMaybe DRep
d) of
        (SJust KeyHash 'StakePool
spo, SJust DRep
drep) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool -> DRep -> CompactForm Coin -> RewardDelegation
RewardDelegationBoth KeyHash 'StakePool
spo DRep
drep CompactForm Coin
reward
        (SJust KeyHash 'StakePool
spo, StrictMaybe DRep
SNothing) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool -> CompactForm Coin -> RewardDelegation
RewardDelegationSPO KeyHash 'StakePool
spo CompactForm Coin
reward
        (StrictMaybe (KeyHash 'StakePool)
SNothing, SJust DRep
drep) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ DRep -> CompactForm Coin -> RewardDelegation
RewardDelegationDRep DRep
drep CompactForm Coin
reward
        (StrictMaybe (KeyHash 'StakePool)
SNothing, StrictMaybe DRep
SNothing) -> forall a. Maybe a
Nothing
{-# INLINE umElemDelegations #-}

-- | Extract the reward-deposit pair if it is present.
-- We can tell that the reward is present when Txxxx has an F in the first position
--
-- This is equivalent to the pattern (UMElem (SJust r) _ _ _) -> Just r
umElemRDPair :: UMElem -> Maybe RDPair
umElemRDPair :: UMElem -> Maybe RDPair
umElemRDPair = \case
  TFEEE RDPair
r -> forall a. a -> Maybe a
Just RDPair
r
  TFEEF RDPair
r DRep
_ -> forall a. a -> Maybe a
Just RDPair
r
  TFEFE RDPair
r KeyHash 'StakePool
_ -> forall a. a -> Maybe a
Just RDPair
r
  TFEFF RDPair
r KeyHash 'StakePool
_ DRep
_ -> forall a. a -> Maybe a
Just RDPair
r
  TFFEE RDPair
r Set Ptr
_ -> forall a. a -> Maybe a
Just RDPair
r
  TFFEF RDPair
r Set Ptr
_ DRep
_ -> forall a. a -> Maybe a
Just RDPair
r
  TFFFE RDPair
r Set Ptr
_ KeyHash 'StakePool
_ -> forall a. a -> Maybe a
Just RDPair
r
  TFFFF RDPair
r Set Ptr
_ KeyHash 'StakePool
_ DRep
_ -> forall a. a -> Maybe a
Just RDPair
r
  UMElem
_ -> forall a. Maybe a
Nothing
{-# INLINE umElemRDPair #-}

-- | Extract the set of pointers if it is non-empty.
-- We can tell that the reward is present when Txxxx has an F in the second position
--
-- This is equivalent to the pattern (UMElem _ p _ _) -> Just p
umElemPtrs :: UMElem -> Maybe (Set.Set Ptr)
umElemPtrs :: UMElem -> Maybe (Set Ptr)
umElemPtrs = \case
  TEFEE Set Ptr
p | Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set Ptr
p) -> forall a. a -> Maybe a
Just Set Ptr
p
  TEFEF Set Ptr
p DRep
_ | Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set Ptr
p) -> forall a. a -> Maybe a
Just Set Ptr
p
  TEFFE Set Ptr
p KeyHash 'StakePool
_ | Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set Ptr
p) -> forall a. a -> Maybe a
Just Set Ptr
p
  TEFFF Set Ptr
p KeyHash 'StakePool
_ DRep
_ | Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set Ptr
p) -> forall a. a -> Maybe a
Just Set Ptr
p
  TFFEE RDPair
_ Set Ptr
p | Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set Ptr
p) -> forall a. a -> Maybe a
Just Set Ptr
p
  TFFEF RDPair
_ Set Ptr
p DRep
_ | Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set Ptr
p) -> forall a. a -> Maybe a
Just Set Ptr
p
  TFFFE RDPair
_ Set Ptr
p KeyHash 'StakePool
_ | Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set Ptr
p) -> forall a. a -> Maybe a
Just Set Ptr
p
  TFFFF RDPair
_ Set Ptr
p KeyHash 'StakePool
_ DRep
_ | Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set Ptr
p) -> forall a. a -> Maybe a
Just Set Ptr
p
  UMElem
_ -> forall a. Maybe a
Nothing
{-# INLINE umElemPtrs #-}

-- | Extract the stake delegatee pool id, if present.
-- We can tell that the pool id is present when Txxxx has an F in the third position
--
-- This is equivalent to the pattern (UMElem _ _ (SJust s) _) -> Just s
umElemSPool :: UMElem -> Maybe (KeyHash 'StakePool)
umElemSPool :: UMElem -> Maybe (KeyHash 'StakePool)
umElemSPool = \case
  TEEFE KeyHash 'StakePool
s -> forall a. a -> Maybe a
Just KeyHash 'StakePool
s
  TEEFF KeyHash 'StakePool
s DRep
_ -> forall a. a -> Maybe a
Just KeyHash 'StakePool
s
  TEFFE Set Ptr
_ KeyHash 'StakePool
s -> forall a. a -> Maybe a
Just KeyHash 'StakePool
s
  TEFFF Set Ptr
_ KeyHash 'StakePool
s DRep
_ -> forall a. a -> Maybe a
Just KeyHash 'StakePool
s
  TFEFE RDPair
_ KeyHash 'StakePool
s -> forall a. a -> Maybe a
Just KeyHash 'StakePool
s
  TFEFF RDPair
_ KeyHash 'StakePool
s DRep
_ -> forall a. a -> Maybe a
Just KeyHash 'StakePool
s
  TFFFE RDPair
_ Set Ptr
_ KeyHash 'StakePool
s -> forall a. a -> Maybe a
Just KeyHash 'StakePool
s
  TFFFF RDPair
_ Set Ptr
_ KeyHash 'StakePool
s DRep
_ -> forall a. a -> Maybe a
Just KeyHash 'StakePool
s
  UMElem
_ -> forall a. Maybe a
Nothing
{-# INLINE umElemSPool #-}

-- | Extract the voting delegatee id, if present.
-- We can tell that the delegatee is present when Txxxx has an F in the fourth position
--
-- This is equivalent to the pattern (UMElem _ _ _ (SJust d)) -> Just d
umElemDRep :: UMElem -> Maybe DRep
umElemDRep :: UMElem -> Maybe DRep
umElemDRep = \case
  TEEEF DRep
d -> forall a. a -> Maybe a
Just DRep
d
  TEEFF KeyHash 'StakePool
_ DRep
d -> forall a. a -> Maybe a
Just DRep
d
  TEFEF Set Ptr
_ DRep
d -> forall a. a -> Maybe a
Just DRep
d
  TEFFF Set Ptr
_ KeyHash 'StakePool
_ DRep
d -> forall a. a -> Maybe a
Just DRep
d
  TFEEF RDPair
_ DRep
d -> forall a. a -> Maybe a
Just DRep
d
  TFEFF RDPair
_ KeyHash 'StakePool
_ DRep
d -> forall a. a -> Maybe a
Just DRep
d
  TFFEF RDPair
_ Set Ptr
_ DRep
d -> forall a. a -> Maybe a
Just DRep
d
  TFFFF RDPair
_ Set Ptr
_ KeyHash 'StakePool
_ DRep
d -> forall a. a -> Maybe a
Just DRep
d
  UMElem
_ -> forall a. Maybe a
Nothing
{-# INLINE umElemDRep #-}

-- | A `UMElem` can be extracted and injected into the `TEEEE` ... `TFFFF` constructors.
pattern UMElem ::
  StrictMaybe RDPair ->
  Set Ptr ->
  StrictMaybe (KeyHash 'StakePool) ->
  StrictMaybe DRep ->
  UMElem
pattern $bUMElem :: StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
$mUMElem :: forall {r}.
UMElem
-> (StrictMaybe RDPair
    -> Set Ptr
    -> StrictMaybe (KeyHash 'StakePool)
    -> StrictMaybe DRep
    -> r)
-> ((# #) -> r)
-> r
UMElem i j k l <- (umElemAsTuple -> (i, j, k, l))
  where
    UMElem StrictMaybe RDPair
i Set Ptr
j StrictMaybe (KeyHash 'StakePool)
k StrictMaybe DRep
l = case (StrictMaybe RDPair
i, Set Ptr
j, StrictMaybe (KeyHash 'StakePool)
k, StrictMaybe DRep
l) of
      (StrictMaybe RDPair
SNothing, Set Ptr
SI.Tip, StrictMaybe (KeyHash 'StakePool)
SNothing, StrictMaybe DRep
SNothing) -> UMElem
TEEEE
      (StrictMaybe RDPair
SNothing, Set Ptr
SI.Tip, StrictMaybe (KeyHash 'StakePool)
SNothing, SJust DRep
d) -> DRep -> UMElem
TEEEF DRep
d
      (StrictMaybe RDPair
SNothing, Set Ptr
SI.Tip, SJust KeyHash 'StakePool
s, StrictMaybe DRep
SNothing) -> KeyHash 'StakePool -> UMElem
TEEFE KeyHash 'StakePool
s
      (StrictMaybe RDPair
SNothing, Set Ptr
SI.Tip, SJust KeyHash 'StakePool
s, SJust DRep
d) -> KeyHash 'StakePool -> DRep -> UMElem
TEEFF KeyHash 'StakePool
s DRep
d
      (StrictMaybe RDPair
SNothing, Set Ptr
p, StrictMaybe (KeyHash 'StakePool)
SNothing, StrictMaybe DRep
SNothing) -> Set Ptr -> UMElem
TEFEE Set Ptr
p
      (StrictMaybe RDPair
SNothing, Set Ptr
p, StrictMaybe (KeyHash 'StakePool)
SNothing, SJust DRep
d) -> Set Ptr -> DRep -> UMElem
TEFEF Set Ptr
p DRep
d
      (StrictMaybe RDPair
SNothing, Set Ptr
p, SJust KeyHash 'StakePool
s, StrictMaybe DRep
SNothing) -> Set Ptr -> KeyHash 'StakePool -> UMElem
TEFFE Set Ptr
p KeyHash 'StakePool
s
      (StrictMaybe RDPair
SNothing, Set Ptr
p, SJust KeyHash 'StakePool
s, SJust DRep
d) -> Set Ptr -> KeyHash 'StakePool -> DRep -> UMElem
TEFFF Set Ptr
p KeyHash 'StakePool
s DRep
d
      (SJust RDPair
r, Set Ptr
SI.Tip, StrictMaybe (KeyHash 'StakePool)
SNothing, StrictMaybe DRep
SNothing) -> RDPair -> UMElem
TFEEE RDPair
r
      (SJust RDPair
r, Set Ptr
SI.Tip, StrictMaybe (KeyHash 'StakePool)
SNothing, SJust DRep
d) -> RDPair -> DRep -> UMElem
TFEEF RDPair
r DRep
d
      (SJust RDPair
r, Set Ptr
SI.Tip, SJust KeyHash 'StakePool
s, StrictMaybe DRep
SNothing) -> RDPair -> KeyHash 'StakePool -> UMElem
TFEFE RDPair
r KeyHash 'StakePool
s
      (SJust RDPair
r, Set Ptr
SI.Tip, SJust KeyHash 'StakePool
s, SJust DRep
d) -> RDPair -> KeyHash 'StakePool -> DRep -> UMElem
TFEFF RDPair
r KeyHash 'StakePool
s DRep
d
      (SJust RDPair
r, Set Ptr
p, StrictMaybe (KeyHash 'StakePool)
SNothing, StrictMaybe DRep
SNothing) -> RDPair -> Set Ptr -> UMElem
TFFEE RDPair
r Set Ptr
p
      (SJust RDPair
r, Set Ptr
p, StrictMaybe (KeyHash 'StakePool)
SNothing, SJust DRep
d) -> RDPair -> Set Ptr -> DRep -> UMElem
TFFEF RDPair
r Set Ptr
p DRep
d
      (SJust RDPair
r, Set Ptr
p, SJust KeyHash 'StakePool
s, StrictMaybe DRep
SNothing) -> RDPair -> Set Ptr -> KeyHash 'StakePool -> UMElem
TFFFE RDPair
r Set Ptr
p KeyHash 'StakePool
s
      (SJust RDPair
r, Set Ptr
p, SJust KeyHash 'StakePool
s, SJust DRep
d) -> RDPair -> Set Ptr -> KeyHash 'StakePool -> DRep -> UMElem
TFFFF RDPair
r Set Ptr
p KeyHash 'StakePool
s DRep
d

{-# COMPLETE UMElem #-}

-- | A unified map represents 4 Maps with domain @(Credential 'Staking c)@
--
-- 1) Map (Credential 'Staking c) RDPair  -- (RDPair rewardCoin depositCoin)
-- 2) Map (Credential 'Staking c) (Set Ptr)
-- 3) Map (Credential 'Staking c) (StrictMaybe (KeyHash 'StakePool c))
-- 4) Map (Credential 'Staking c) (StrictMaybe (DRep c))
-- and one more map in the inverse direction with @Ptr@ for keys and @(Credential 'Staking c)@ for values.
data UMap = UMap
  { UMap -> Map (Credential 'Staking) UMElem
umElems :: !(Map (Credential 'Staking) UMElem)
  , UMap -> Map Ptr (Credential 'Staking)
umPtrs :: !(Map Ptr (Credential 'Staking))
  }
  deriving (Int -> UMap -> ShowS
[UMap] -> ShowS
UMap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UMap] -> ShowS
$cshowList :: [UMap] -> ShowS
show :: UMap -> String
$cshow :: UMap -> String
showsPrec :: Int -> UMap -> ShowS
$cshowsPrec :: Int -> UMap -> ShowS
Show, UMap -> UMap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UMap -> UMap -> Bool
$c/= :: UMap -> UMap -> Bool
== :: UMap -> UMap -> Bool
$c== :: UMap -> UMap -> Bool
Eq, forall x. Rep UMap x -> UMap
forall x. UMap -> Rep UMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UMap x -> UMap
$cfrom :: forall x. UMap -> Rep UMap x
Generic, Context -> UMap -> IO (Maybe ThunkInfo)
Proxy UMap -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy UMap -> String
$cshowTypeOf :: Proxy UMap -> String
wNoThunks :: Context -> UMap -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UMap -> IO (Maybe ThunkInfo)
noThunks :: Context -> UMap -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> UMap -> IO (Maybe ThunkInfo)
NoThunks, UMap -> ()
forall a. (a -> ()) -> NFData a
rnf :: UMap -> ()
$crnf :: UMap -> ()
NFData)

umElemsL :: Lens' UMap (Map (Credential 'Staking) UMElem)
umElemsL :: Lens' UMap (Map (Credential 'Staking) UMElem)
umElemsL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UMap -> Map (Credential 'Staking) UMElem
umElems (\UMap
x Map (Credential 'Staking) UMElem
y -> UMap
x {umElems :: Map (Credential 'Staking) UMElem
umElems = Map (Credential 'Staking) UMElem
y})

-- | All maps unrolled. It is important to note that all fields are lazy, because
-- conversion from UMap can be expensive, thus only fields that are forced will incur that
-- conversion overhead.
data StakeCredentials = StakeCredentials
  { StakeCredentials -> Map (Credential 'Staking) Coin
scRewards :: Map (Credential 'Staking) Coin
  , StakeCredentials -> Map (Credential 'Staking) Coin
scDeposits :: Map (Credential 'Staking) Coin
  , StakeCredentials -> Map (Credential 'Staking) (KeyHash 'StakePool)
scSPools :: Map (Credential 'Staking) (KeyHash 'StakePool)
  , StakeCredentials -> Map (Credential 'Staking) DRep
scDReps :: Map (Credential 'Staking) DRep
  , StakeCredentials -> Map Ptr (Credential 'Staking)
scPtrs :: Map Ptr (Credential 'Staking)
  , StakeCredentials -> Map (Credential 'Staking) (Set Ptr)
scPtrsInverse :: Map (Credential 'Staking) (Set Ptr)
  -- ^ There will be no empty sets in the range
  }
  deriving (Int -> StakeCredentials -> ShowS
[StakeCredentials] -> ShowS
StakeCredentials -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StakeCredentials] -> ShowS
$cshowList :: [StakeCredentials] -> ShowS
show :: StakeCredentials -> String
$cshow :: StakeCredentials -> String
showsPrec :: Int -> StakeCredentials -> ShowS
$cshowsPrec :: Int -> StakeCredentials -> ShowS
Show, StakeCredentials -> StakeCredentials -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StakeCredentials -> StakeCredentials -> Bool
$c/= :: StakeCredentials -> StakeCredentials -> Bool
== :: StakeCredentials -> StakeCredentials -> Bool
$c== :: StakeCredentials -> StakeCredentials -> Bool
Eq, forall x. Rep StakeCredentials x -> StakeCredentials
forall x. StakeCredentials -> Rep StakeCredentials x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StakeCredentials x -> StakeCredentials
$cfrom :: forall x. StakeCredentials -> Rep StakeCredentials x
Generic, Context -> StakeCredentials -> IO (Maybe ThunkInfo)
Proxy StakeCredentials -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy StakeCredentials -> String
$cshowTypeOf :: Proxy StakeCredentials -> String
wNoThunks :: Context -> StakeCredentials -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> StakeCredentials -> IO (Maybe ThunkInfo)
noThunks :: Context -> StakeCredentials -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> StakeCredentials -> IO (Maybe ThunkInfo)
NoThunks, StakeCredentials -> ()
forall a. (a -> ()) -> NFData a
rnf :: StakeCredentials -> ()
$crnf :: StakeCredentials -> ()
NFData)

instance ToJSON UMap where
  toJSON :: UMap -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. KeyValue e a => UMap -> [a]
toUMapPair
  toEncoding :: UMap -> Encoding
toEncoding = Series -> Encoding
Aeson.pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. KeyValue e a => UMap -> [a]
toUMapPair

toUMapPair :: Aeson.KeyValue e a => UMap -> [a]
toUMapPair :: forall e a. KeyValue e a => UMap -> [a]
toUMapPair (UMap !Map (Credential 'Staking) UMElem
m1 !Map Ptr (Credential 'Staking)
m2) =
  [ Key
"credentials" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (Credential 'Staking) UMElem
m1
  , Key
"pointers" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map Ptr (Credential 'Staking)
m2
  ]

instance EncCBOR UMap where
  encCBOR :: UMap -> Encoding
encCBOR UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} =
    Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall k v.
(k -> Encoding) -> (v -> Encoding) -> Map k v -> Encoding
encodeMap forall a. EncCBOR a => a -> Encoding
encCBOR forall a. EncCBOR a => a -> Encoding
encCBOR Map (Credential 'Staking) UMElem
umElems forall a. Semigroup a => a -> a -> a
<> forall k v.
(k -> Encoding) -> (v -> Encoding) -> Map k v -> Encoding
encodeMap forall a. EncCBOR a => a -> Encoding
encCBOR forall a. EncCBOR a => a -> Encoding
encCBOR Map Ptr (Credential 'Staking)
umPtrs

instance DecShareCBOR UMap where
  type Share UMap = (Interns (Credential 'Staking), Interns (KeyHash 'StakePool))
  decSharePlusCBOR :: forall s. StateT (Share UMap) (Decoder s) UMap
decSharePlusCBOR =
    forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT
      ( \(Interns (Credential 'Staking)
a, Interns (KeyHash 'StakePool)
b) ->
          forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"UMap" (forall a b. a -> b -> a
const Int
2) forall a b. (a -> b) -> a -> b
$ do
            Map (Credential 'Staking) UMElem
umElems <- forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap (forall k. Interns k -> k -> k
interns Interns (Credential 'Staking)
a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR) (forall a s. DecShareCBOR a => Share a -> Decoder s a
decShareCBOR Interns (KeyHash 'StakePool)
b)
            let a' :: Interns (Credential 'Staking)
a' = forall k a. Ord k => Map k a -> Interns k
internsFromMap Map (Credential 'Staking) UMElem
umElems forall a. Semigroup a => a -> a -> a
<> Interns (Credential 'Staking)
a
            Map Ptr (Credential 'Staking)
umPtrs <-
              forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
                (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
                (forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a s. DecCBOR a => Proxy a -> Decoder s ()
dropCBOR (forall {k} (t :: k). Proxy t
Proxy @(Map (Credential 'Staking) (Set Ptr))))
                forall a b. (a -> b) -> a -> b
$ forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap forall a s. DecCBOR a => Decoder s a
decCBOR (forall k. Interns k -> k -> k
interns Interns (Credential 'Staking)
a' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR)
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs}, (Interns (Credential 'Staking)
a', Interns (KeyHash 'StakePool)
b))
      )

-- | It is worthwhile stating the invariant that holds on a Unified Map.
-- The `umPtrs` and the `ptrT` field of the `umElems` are inverses.
umInvariant :: Credential 'Staking -> Ptr -> UMap -> Bool
umInvariant :: Credential 'Staking -> Ptr -> UMap -> Bool
umInvariant Credential 'Staking
cred Ptr
ptr UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} = Bool
forwards Bool -> Bool -> Bool
&& Bool
backwards
  where
    forwards :: Bool
forwards =
      case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'Staking
cred Map (Credential 'Staking) UMElem
umElems of
        Maybe UMElem
Nothing -> Credential 'Staking
cred forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Map Ptr (Credential 'Staking)
umPtrs
        Just (UMElem StrictMaybe RDPair
_r Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
_s StrictMaybe DRep
_) ->
          Bool -> Bool
not (forall a. Ord a => a -> Set a -> Bool
Set.member Ptr
ptr Set Ptr
ptrSet)
            Bool -> Bool -> Bool
|| ( case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ptr
ptr Map Ptr (Credential 'Staking)
umPtrs of
                  Maybe (Credential 'Staking)
Nothing -> Bool
False
                  Just Credential 'Staking
cred2 -> Credential 'Staking
cred forall a. Eq a => a -> a -> Bool
== Credential 'Staking
cred2
               )
    backwards :: Bool
backwards =
      case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ptr
ptr Map Ptr (Credential 'Staking)
umPtrs of
        Maybe (Credential 'Staking)
Nothing -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(UMElem StrictMaybe RDPair
_ Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
_ StrictMaybe DRep
_) -> forall a. Ord a => a -> Set a -> Bool
Set.notMember Ptr
ptr Set Ptr
ptrSet) Map (Credential 'Staking) UMElem
umElems
        Just Credential 'Staking
cred' ->
          case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'Staking
cred' Map (Credential 'Staking) UMElem
umElems of
            Maybe UMElem
Nothing -> Bool
False
            Just (UMElem StrictMaybe RDPair
_ Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
_ StrictMaybe DRep
_) -> forall a. Ord a => a -> Set a -> Bool
Set.member Ptr
ptr Set Ptr
ptrSet

-- | A `UView` lets one view a `UMap` in @n@ different ways,
-- one for each of the elements in a Unified Element `UMElem` @(4)@
-- A @(UView c key value)@ can be used like a @(Map key value)@.
-- It acts like a map, supporting efficient insert, delete, and lookup operations.
data UView k v where
  RewDepUView ::
    !UMap ->
    UView (Credential 'Staking) RDPair
  PtrUView ::
    !UMap ->
    UView Ptr (Credential 'Staking)
  SPoolUView ::
    !UMap ->
    UView (Credential 'Staking) (KeyHash 'StakePool)
  DRepUView ::
    !UMap ->
    UView (Credential 'Staking) DRep

-- | Construct a `RewDepUView` from the two maps that make up a `UMap`
rewDepUView ::
  Map (Credential 'Staking) UMElem ->
  Map Ptr (Credential 'Staking) ->
  UView (Credential 'Staking) RDPair
rewDepUView :: Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking)
-> UView (Credential 'Staking) RDPair
rewDepUView Map (Credential 'Staking) UMElem
a Map Ptr (Credential 'Staking)
b = UMap -> UView (Credential 'Staking) RDPair
RewDepUView (Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UMap
UMap Map (Credential 'Staking) UMElem
a Map Ptr (Credential 'Staking)
b)

-- | Construct a `PtrUView` from the two maps that make up a `UMap`
ptrUView ::
  Map (Credential 'Staking) UMElem ->
  Map Ptr (Credential 'Staking) ->
  UView Ptr (Credential 'Staking)
ptrUView :: Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UView Ptr (Credential 'Staking)
ptrUView Map (Credential 'Staking) UMElem
a Map Ptr (Credential 'Staking)
b = UMap -> UView Ptr (Credential 'Staking)
PtrUView (Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UMap
UMap Map (Credential 'Staking) UMElem
a Map Ptr (Credential 'Staking)
b)

-- | Construct a `SPoolUView` from the two maps that make up a `UMap`
sPoolUView ::
  Map (Credential 'Staking) UMElem ->
  Map Ptr (Credential 'Staking) ->
  UView (Credential 'Staking) (KeyHash 'StakePool)
sPoolUView :: Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking)
-> UView (Credential 'Staking) (KeyHash 'StakePool)
sPoolUView Map (Credential 'Staking) UMElem
a Map Ptr (Credential 'Staking)
b = UMap -> UView (Credential 'Staking) (KeyHash 'StakePool)
SPoolUView (Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UMap
UMap Map (Credential 'Staking) UMElem
a Map Ptr (Credential 'Staking)
b)

-- | Construct a `DRepUView` from the two maps that make up a `UMap`
dRepUView ::
  Map (Credential 'Staking) UMElem ->
  Map Ptr (Credential 'Staking) ->
  UView (Credential 'Staking) DRep
dRepUView :: Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking)
-> UView (Credential 'Staking) DRep
dRepUView Map (Credential 'Staking) UMElem
a Map Ptr (Credential 'Staking)
b = UMap -> UView (Credential 'Staking) DRep
DRepUView (Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UMap
UMap Map (Credential 'Staking) UMElem
a Map Ptr (Credential 'Staking)
b)

-- | Extract the underlying `UMap` from a `UView`
unUView :: UView k v -> UMap
unUView :: forall k v. UView k v -> UMap
unUView = \case
  RewDepUView UMap
um -> UMap
um
  PtrUView UMap
um -> UMap
um
  SPoolUView UMap
um -> UMap
um
  DRepUView UMap
um -> UMap
um

-- | Materialize a real `Map` from a `View`
-- This is expensive, use it wisely (like maybe once per epoch boundary to make a `SnapShot`)
-- See also domRestrictedMap, which domain-restricts before computing a view.
unUnify :: UView k v -> Map k v
unUnify :: forall k v. UView k v -> Map k v
unUnify = \case
  RewDepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe UMElem -> Maybe RDPair
umElemRDPair Map (Credential 'Staking) UMElem
umElems
  PtrUView UMap {Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} -> Map Ptr (Credential 'Staking)
umPtrs
  SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe UMElem -> Maybe (KeyHash 'StakePool)
umElemSPool Map (Credential 'Staking) UMElem
umElems
  DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe UMElem -> Maybe DRep
umElemDRep Map (Credential 'Staking) UMElem
umElems

-- | Materialize a real `VMap` (Vector Map) from a `UView`
-- This is expensive, use it wisely (like maybe once per epoch boundary to make a `SnapShot`)
unUnifyToVMap :: UView k v -> VMap.VMap VMap.VB VMap.VB k v
unUnifyToVMap :: forall k v. UView k v -> VMap VB VB k v
unUnifyToVMap UView k v
uview = case UView k v
uview of
  RewDepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} ->
    forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
Int -> [(k, v)] -> VMap kv vv k v
VMap.fromListN (forall k v. UView k v -> Int
size UView k v
uview) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe forall {a}. (a, UMElem) -> Maybe (a, RDPair)
toRDPair forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ Map (Credential 'Staking) UMElem
umElems
  PtrUView UMap {Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} -> forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap Map Ptr (Credential 'Staking)
umPtrs
  SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} ->
    forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
Int -> [(k, v)] -> VMap kv vv k v
VMap.fromListN (forall k v. UView k v -> Int
size UView k v
uview) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe forall {a}. (a, UMElem) -> Maybe (a, KeyHash 'StakePool)
toSPool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ Map (Credential 'Staking) UMElem
umElems
  DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} ->
    forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
Int -> [(k, v)] -> VMap kv vv k v
VMap.fromListN (forall k v. UView k v -> Int
size UView k v
uview) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe forall {a}. (a, UMElem) -> Maybe (a, DRep)
toDRep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ Map (Credential 'Staking) UMElem
umElems
  where
    toRDPair :: (a, UMElem) -> Maybe (a, RDPair)
toRDPair (a
key, UMElem
t) = (,) a
key forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UMElem -> Maybe RDPair
umElemRDPair UMElem
t
    toSPool :: (a, UMElem) -> Maybe (a, KeyHash 'StakePool)
toSPool (a
key, UMElem
t) = (,) a
key forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UMElem -> Maybe (KeyHash 'StakePool)
umElemSPool UMElem
t
    toDRep :: (a, UMElem) -> Maybe (a, DRep)
toDRep (a
key, UMElem
t) = (,) a
key forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UMElem -> Maybe DRep
umElemDRep UMElem
t

-- | Extract a reward-deposit pairs `Map` from a 'UMap'
rdPairMap :: UMap -> Map (Credential 'Staking) RDPair
rdPairMap :: UMap -> Map (Credential 'Staking) RDPair
rdPairMap UMap
x = forall k v. UView k v -> Map k v
unUnify forall a b. (a -> b) -> a -> b
$ UMap -> UView (Credential 'Staking) RDPair
RewDepUView UMap
x

-- | Extract a rewards `Map` from a 'UMap'
rewardMap :: UMap -> Map (Credential 'Staking) Coin
rewardMap :: UMap -> Map (Credential 'Staking) Coin
rewardMap UMap
x = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall a. Compactible a => CompactForm a -> a
fromCompact forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDPair -> CompactForm Coin
rdReward) forall a b. (a -> b) -> a -> b
$ forall k v. UView k v -> Map k v
unUnify forall a b. (a -> b) -> a -> b
$ UMap -> UView (Credential 'Staking) RDPair
RewDepUView UMap
x

-- | Extract a compact rewards `Map` from a 'UMap'
compactRewardMap :: UMap -> Map (Credential 'Staking) (CompactForm Coin)
compactRewardMap :: UMap -> Map (Credential 'Staking) (CompactForm Coin)
compactRewardMap UMap
x = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map RDPair -> CompactForm Coin
rdReward forall a b. (a -> b) -> a -> b
$ forall k v. UView k v -> Map k v
unUnify forall a b. (a -> b) -> a -> b
$ UMap -> UView (Credential 'Staking) RDPair
RewDepUView UMap
x

-- | Extract a deposits `Map` from a 'UMap'
depositMap :: UMap -> Map (Credential 'Staking) Coin
depositMap :: UMap -> Map (Credential 'Staking) Coin
depositMap UMap
x = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall a. Compactible a => CompactForm a -> a
fromCompact forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDPair -> CompactForm Coin
rdDeposit) forall a b. (a -> b) -> a -> b
$ forall k v. UView k v -> Map k v
unUnify forall a b. (a -> b) -> a -> b
$ UMap -> UView (Credential 'Staking) RDPair
RewDepUView UMap
x

-- | Extract a pointers `Map` from a 'UMap'
ptrMap :: UMap -> Map Ptr (Credential 'Staking)
ptrMap :: UMap -> Map Ptr (Credential 'Staking)
ptrMap UMap
x = forall k v. UView k v -> Map k v
unUnify forall a b. (a -> b) -> a -> b
$ UMap -> UView Ptr (Credential 'Staking)
PtrUView UMap
x

-- | Extract a pointers `Map` from a 'UMap'
invPtrMap :: UMap -> Map (Credential 'Staking) (Set Ptr)
invPtrMap :: UMap -> Map (Credential 'Staking) (Set Ptr)
invPtrMap UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} =
  forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey'
    (\Map (Credential 'Staking) (Set Ptr)
ans Credential 'Staking
k (UMElem StrictMaybe RDPair
_ Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
_ StrictMaybe DRep
_) -> if forall a. Set a -> Bool
Set.null Set Ptr
ptrSet then Map (Credential 'Staking) (Set Ptr)
ans else forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'Staking
k Set Ptr
ptrSet Map (Credential 'Staking) (Set Ptr)
ans)
    forall k a. Map k a
Map.empty
    Map (Credential 'Staking) UMElem
umElems

-- | Extract a stake pool delegations `Map` from a 'UMap'
sPoolMap :: UMap -> Map (Credential 'Staking) (KeyHash 'StakePool)
sPoolMap :: UMap -> Map (Credential 'Staking) (KeyHash 'StakePool)
sPoolMap UMap
x = forall k v. UView k v -> Map k v
unUnify forall a b. (a -> b) -> a -> b
$ UMap -> UView (Credential 'Staking) (KeyHash 'StakePool)
SPoolUView UMap
x

-- | Extract a delegated-representatives `Map` from a 'UMap'
dRepMap :: UMap -> Map (Credential 'Staking) DRep
dRepMap :: UMap -> Map (Credential 'Staking) DRep
dRepMap UMap
x = forall k v. UView k v -> Map k v
unUnify forall a b. (a -> b) -> a -> b
$ UMap -> UView (Credential 'Staking) DRep
DRepUView UMap
x

-- | Extract a domain-restricted `Map` of a `UMap`.
-- If `Set k` is small this should be efficient.
domRestrictedMap :: Set k -> UView k v -> Map k v
domRestrictedMap :: forall k v. Set k -> UView k v -> Map k v
domRestrictedMap Set k
setk = \case
  RewDepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe UMElem -> Maybe RDPair
umElemRDPair (forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map (Credential 'Staking) UMElem
umElems Set k
setk)
  PtrUView UMap {Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} -> forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map Ptr (Credential 'Staking)
umPtrs Set k
setk
  SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe UMElem -> Maybe (KeyHash 'StakePool)
umElemSPool (forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map (Credential 'Staking) UMElem
umElems Set k
setk)
  DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe UMElem -> Maybe DRep
umElemDRep (forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map (Credential 'Staking) UMElem
umElems Set k
setk)

toStakeCredentials :: UMap -> StakeCredentials
toStakeCredentials :: UMap -> StakeCredentials
toStakeCredentials UMap
umap =
  StakeCredentials
    { scRewards :: Map (Credential 'Staking) Coin
scRewards = UMap -> Map (Credential 'Staking) Coin
rewardMap UMap
umap
    , scDeposits :: Map (Credential 'Staking) Coin
scDeposits = UMap -> Map (Credential 'Staking) Coin
depositMap UMap
umap
    , scSPools :: Map (Credential 'Staking) (KeyHash 'StakePool)
scSPools = UMap -> Map (Credential 'Staking) (KeyHash 'StakePool)
sPoolMap UMap
umap
    , scDReps :: Map (Credential 'Staking) DRep
scDReps = UMap -> Map (Credential 'Staking) DRep
dRepMap UMap
umap
    , scPtrs :: Map Ptr (Credential 'Staking)
scPtrs = UMap -> Map Ptr (Credential 'Staking)
ptrMap UMap
umap
    , scPtrsInverse :: Map (Credential 'Staking) (Set Ptr)
scPtrsInverse = UMap -> Map (Credential 'Staking) (Set Ptr)
invPtrMap UMap
umap
    }

domRestrictedStakeCredentials :: Set (Credential 'Staking) -> UMap -> StakeCredentials
domRestrictedStakeCredentials :: Set (Credential 'Staking) -> UMap -> StakeCredentials
domRestrictedStakeCredentials Set (Credential 'Staking)
setk UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} =
  let umElems' :: Map (Credential 'Staking) UMElem
umElems' = forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map (Credential 'Staking) UMElem
umElems Set (Credential 'Staking)
setk
      ptrs :: Map (Credential 'Staking) (Set Ptr)
ptrs = forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe UMElem -> Maybe (Set Ptr)
umElemPtrs Map (Credential 'Staking) UMElem
umElems'
   in StakeCredentials
        { scRewards :: Map (Credential 'Staking) Coin
scRewards = forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (\UMElem
e -> forall a. Compactible a => CompactForm a -> a
fromCompact forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDPair -> CompactForm Coin
rdReward forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UMElem -> Maybe RDPair
umElemRDPair UMElem
e) Map (Credential 'Staking) UMElem
umElems'
        , scDeposits :: Map (Credential 'Staking) Coin
scDeposits = forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (\UMElem
e -> forall a. Compactible a => CompactForm a -> a
fromCompact forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDPair -> CompactForm Coin
rdDeposit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UMElem -> Maybe RDPair
umElemRDPair UMElem
e) Map (Credential 'Staking) UMElem
umElems'
        , scSPools :: Map (Credential 'Staking) (KeyHash 'StakePool)
scSPools = forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe UMElem -> Maybe (KeyHash 'StakePool)
umElemSPool Map (Credential 'Staking) UMElem
umElems'
        , scDReps :: Map (Credential 'Staking) DRep
scDReps = forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe UMElem -> Maybe DRep
umElemDRep Map (Credential 'Staking) UMElem
umElems'
        , scPtrs :: Map Ptr (Credential 'Staking)
scPtrs = Map Ptr (Credential 'Staking)
umPtrs forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Map (Credential 'Staking) (Set Ptr)
ptrs
        , scPtrsInverse :: Map (Credential 'Staking) (Set Ptr)
scPtrsInverse = Map (Credential 'Staking) (Set Ptr)
ptrs
        }

-- | All `View`s are `Foldable`
instance Foldable (UView k) where
  foldMap :: forall m a. Monoid m => (a -> m) -> UView k a -> m
foldMap a -> m
f = \case
    RewDepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey m -> Credential 'Staking -> UMElem -> m
accum forall a. Monoid a => a
mempty Map (Credential 'Staking) UMElem
umElems
      where
        accum :: m -> Credential 'Staking -> UMElem -> m
accum m
ans Credential 'Staking
_ (UMElem (SJust RDPair
rd) Set Ptr
_ StrictMaybe (KeyHash 'StakePool)
_ StrictMaybe DRep
_) = m
ans forall a. Semigroup a => a -> a -> a
<> a -> m
f RDPair
rd
        accum m
ans Credential 'Staking
_ UMElem
_ = m
ans
    -- umInvariant` for `PtrUView` does not matter here. We just return a `Map` and not a `UMap`.
    PtrUView UMap {Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Map Ptr (Credential 'Staking)
umPtrs
    SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey m -> Credential 'Staking -> UMElem -> m
accum forall a. Monoid a => a
mempty Map (Credential 'Staking) UMElem
umElems
      where
        accum :: m -> Credential 'Staking -> UMElem -> m
accum m
ans Credential 'Staking
_ (UMElem StrictMaybe RDPair
_ Set Ptr
_ (SJust KeyHash 'StakePool
sd) StrictMaybe DRep
_) = m
ans forall a. Semigroup a => a -> a -> a
<> a -> m
f KeyHash 'StakePool
sd
        accum m
ans Credential 'Staking
_ UMElem
_ = m
ans
    DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey m -> Credential 'Staking -> UMElem -> m
accum forall a. Monoid a => a
mempty Map (Credential 'Staking) UMElem
umElems
      where
        accum :: m -> Credential 'Staking -> UMElem -> m
accum m
ans Credential 'Staking
_ (UMElem StrictMaybe RDPair
_ Set Ptr
_ StrictMaybe (KeyHash 'StakePool)
_ (SJust DRep
vd)) = m
ans forall a. Semigroup a => a -> a -> a
<> a -> m
f DRep
vd
        accum m
ans Credential 'Staking
_ UMElem
_ = m
ans

  foldr :: forall a b. (a -> b -> b) -> b -> UView k a -> b
foldr a -> b -> b
accum b
ans0 = \case
    RewDepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr UMElem -> b -> b
accum' b
ans0 Map (Credential 'Staking) UMElem
umElems
      where
        accum' :: UMElem -> b -> b
accum' (UMElem (SJust RDPair
rd) Set Ptr
_ StrictMaybe (KeyHash 'StakePool)
_ StrictMaybe DRep
_) b
ans = a -> b -> b
accum RDPair
rd b
ans
        accum' UMElem
_ b
ans = b
ans
    -- umInvariant` for `PtrUView` does not matter here. We just return a `Map` and not a `UMap`.
    PtrUView UMap {Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} -> forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr a -> b -> b
accum b
ans0 Map Ptr (Credential 'Staking)
umPtrs
    SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr UMElem -> b -> b
accum' b
ans0 Map (Credential 'Staking) UMElem
umElems
      where
        accum' :: UMElem -> b -> b
accum' (UMElem StrictMaybe RDPair
_ Set Ptr
_ (SJust KeyHash 'StakePool
sd) StrictMaybe DRep
_) b
ans = a -> b -> b
accum KeyHash 'StakePool
sd b
ans
        accum' UMElem
_ b
ans = b
ans
    DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr UMElem -> b -> b
accum' b
ans0 Map (Credential 'Staking) UMElem
umElems
      where
        accum' :: UMElem -> b -> b
accum' (UMElem StrictMaybe RDPair
_ Set Ptr
_ StrictMaybe (KeyHash 'StakePool)
_ (SJust DRep
vd)) b
ans = a -> b -> b
accum DRep
vd b
ans
        accum' UMElem
_ b
ans = b
ans

  foldl' :: forall b a. (b -> a -> b) -> b -> UView k a -> b
foldl' b -> a -> b
accum b
ans0 = \case
    RewDepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' b -> UMElem -> b
accum' b
ans0 Map (Credential 'Staking) UMElem
umElems
      where
        accum' :: b -> UMElem -> b
accum' b
ans = forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
ans (b -> a -> b
accum b
ans) forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMElem -> Maybe RDPair
umElemRDPair
    -- umInvariant` for `PtrUView` does not matter here. We just return a `Map` and not a `UMap`.
    PtrUView UMap {Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} -> forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' b -> a -> b
accum b
ans0 Map Ptr (Credential 'Staking)
umPtrs
    SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' b -> UMElem -> b
accum' b
ans0 Map (Credential 'Staking) UMElem
umElems
      where
        accum' :: b -> UMElem -> b
accum' b
ans = forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
ans (b -> a -> b
accum b
ans) forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMElem -> Maybe (KeyHash 'StakePool)
umElemSPool
    DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' b -> UMElem -> b
accum' b
ans0 Map (Credential 'Staking) UMElem
umElems
      where
        accum' :: b -> UMElem -> b
accum' b
ans = forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
ans (b -> a -> b
accum b
ans) forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMElem -> Maybe DRep
umElemDRep

  length :: forall a. UView k a -> Int
length = forall k v. UView k v -> Int
size

-- | `null` for an `UMElem`
nullUMElem :: UMElem -> Bool
nullUMElem :: UMElem -> Bool
nullUMElem = \case
  UMElem StrictMaybe RDPair
SNothing Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
SNothing StrictMaybe DRep
SNothing | forall a. Set a -> Bool
Set.null Set Ptr
ptrSet -> Bool
True
  UMElem
_ -> Bool
False

-- | `null` `Maybe` for an `UMElem`
nullUMElemMaybe :: UMElem -> Maybe UMElem
nullUMElemMaybe :: UMElem -> Maybe UMElem
nullUMElemMaybe = \case
  UMElem
e | UMElem -> Bool
nullUMElem UMElem
e -> forall a. Maybe a
Nothing
  UMElem
e -> forall a. a -> Maybe a
Just UMElem
e

-- | Construct an empty `UMap`
empty :: UMap
empty :: UMap
empty = Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UMap
UMap forall k a. Map k a
Map.empty forall k a. Map k a
Map.empty

-- | Delete a key and its value from the map-like `UView`, returning a version of the same `UView`.
--
-- In the case of a `PtrUView` we maintain the `umInvariant` and delete the pairs from both
-- `umElems` as well as `umPtrs` of the `UMap`.
delete' :: k -> UView k v -> UView k v
delete' :: forall k v. k -> UView k v -> UView k v
delete' k
key = \case
  RewDepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} -> Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking)
-> UView (Credential 'Staking) RDPair
rewDepUView (forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update UMElem -> Maybe UMElem
go k
key Map (Credential 'Staking) UMElem
umElems) Map Ptr (Credential 'Staking)
umPtrs
    where
      go :: UMElem -> Maybe UMElem
go (UMElem StrictMaybe RDPair
_ Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep) = UMElem -> Maybe UMElem
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem forall a. StrictMaybe a
SNothing Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep
  PtrUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key Map Ptr (Credential 'Staking)
umPtrs of
    Maybe (Credential 'Staking)
Nothing -> UMap -> UView Ptr (Credential 'Staking)
PtrUView forall a b. (a -> b) -> a -> b
$ Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UMap
UMap Map (Credential 'Staking) UMElem
umElems Map Ptr (Credential 'Staking)
umPtrs
    Just Credential 'Staking
cred -> Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UView Ptr (Credential 'Staking)
ptrUView (forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update UMElem -> Maybe UMElem
go Credential 'Staking
cred Map (Credential 'Staking) UMElem
umElems) (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete k
key Map Ptr (Credential 'Staking)
umPtrs)
      where
        go :: UMElem -> Maybe UMElem
go (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep) = UMElem -> Maybe UMElem
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
rd (forall a. Ord a => a -> Set a -> Set a
Set.delete k
key Set Ptr
ptrSet) StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep
  SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} -> Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking)
-> UView (Credential 'Staking) (KeyHash 'StakePool)
sPoolUView (forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update UMElem -> Maybe UMElem
go k
key Map (Credential 'Staking) UMElem
umElems) Map Ptr (Credential 'Staking)
umPtrs
    where
      go :: UMElem -> Maybe UMElem
go (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
_ StrictMaybe DRep
dRep) = UMElem -> Maybe UMElem
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet forall a. StrictMaybe a
SNothing StrictMaybe DRep
dRep
  DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} -> Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking)
-> UView (Credential 'Staking) DRep
dRepUView (forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update UMElem -> Maybe UMElem
go k
key Map (Credential 'Staking) UMElem
umElems) Map Ptr (Credential 'Staking)
umPtrs
    where
      go :: UMElem -> Maybe UMElem
go (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
_) = UMElem -> Maybe UMElem
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool forall a. StrictMaybe a
SNothing

delete :: k -> UView k v -> UMap
delete :: forall k v. k -> UView k v -> UMap
delete k
k UView k v
m = forall k v. UView k v -> UMap
unUView forall a b. (a -> b) -> a -> b
$ forall k v. k -> UView k v -> UView k v
delete' k
k UView k v
m

-- | Insert with combination
--
-- If `k` exists as a key in the (map-like) `UView`:
--
--   1. to keep the old value
--   > insertWith' (\ old new -> old) k v view
--
--   2. to replace the old value with the new value
--   > insertWith' (\ old new -> new) k v view
--
--   3. to combine the old and new values with summation
--   > insertWith' (\ old new -> old + new) k v view
--
-- If `k` does not exist as a key in the `UView`,
--   the combining function is ignored, and
--   the key `k` and the value `v` are inserted into the map-like `UView`
--   > insertWith' ignoredCombiningFunction k v view
insertWith' :: (v -> v -> v) -> k -> v -> UView k v -> UView k v
insertWith' :: forall v k. (v -> v -> v) -> k -> v -> UView k v -> UView k v
insertWith' v -> v -> v
combine k
key v
val = \case
  RewDepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} -> Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking)
-> UView (Credential 'Staking) RDPair
rewDepUView (forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe UMElem -> Maybe UMElem
go k
key Map (Credential 'Staking) UMElem
umElems) Map Ptr (Credential 'Staking)
umPtrs
    where
      -- Here 'val' is (CompactForm Coin), but the UMap stores Word64,
      -- so there is some implict coercion going on here using the UMElem pattern
      go :: Maybe UMElem -> Maybe UMElem
go = \case
        Maybe UMElem
Nothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem (forall a. a -> StrictMaybe a
SJust v
val) forall a. Set a
Set.empty forall a. StrictMaybe a
SNothing forall a. StrictMaybe a
SNothing
        Just (UMElem StrictMaybe RDPair
SNothing Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep) -> UMElem -> Maybe UMElem
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem (forall a. a -> StrictMaybe a
SJust v
val) Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep
        Just (UMElem (SJust RDPair
old) Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep) -> UMElem -> Maybe UMElem
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ v -> v -> v
combine RDPair
old v
val) Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep
  -- Here `key` is a pointer, and `val` a stake credential.
  -- We use the combining function to combine only the val, i.e. the stake credential.
  -- We do not use the combining function to combine the key, i.e. the pointer.
  -- We also maintain the `umInvariant`.
  PtrUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} ->
    let
      -- We consider what both the old and new stake credentials are
      -- in order to be able to `retract` the pointer to the old credential later on.
      (v
oldCred, v
newCred) = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key Map Ptr (Credential 'Staking)
umPtrs of
        Maybe (Credential 'Staking)
Nothing -> (v
val, v
val)
        Just Credential 'Staking
oldVal -> (Credential 'Staking
oldVal, v -> v -> v
combine Credential 'Staking
oldVal v
val)
      -- Delete the old pointer from the set in UMElem, but also delete the whole n-tuple if it goes null.
      -- and, add the new pointer to the set in UMElem after retracting the old one.
      newUmElem :: Map v UMElem
newUmElem = forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update UMElem -> Maybe UMElem
addPtr v
newCred forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update UMElem -> Maybe UMElem
delPtr v
oldCred Map (Credential 'Staking) UMElem
umElems
        where
          addPtr :: UMElem -> Maybe UMElem
addPtr (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
rd (forall a. Ord a => a -> Set a -> Set a
Set.insert k
key Set Ptr
ptrSet) StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep
          delPtr :: UMElem -> Maybe UMElem
delPtr (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep) = UMElem -> Maybe UMElem
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
rd (forall a. Ord a => a -> Set a -> Set a
Set.delete k
key Set Ptr
ptrSet) StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep
      -- `newUmPtr` replaces the old one if one it exists.
      newUmPtr :: Map k v
newUmPtr = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
key v
newCred Map Ptr (Credential 'Staking)
umPtrs
     in
      UMap -> UView Ptr (Credential 'Staking)
PtrUView forall a b. (a -> b) -> a -> b
$ Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UMap
UMap Map v UMElem
newUmElem Map k v
newUmPtr
  SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} -> Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking)
-> UView (Credential 'Staking) (KeyHash 'StakePool)
sPoolUView (forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe UMElem -> Maybe UMElem
go k
key Map (Credential 'Staking) UMElem
umElems) Map Ptr (Credential 'Staking)
umPtrs
    where
      go :: Maybe UMElem -> Maybe UMElem
go = \case
        Maybe UMElem
Nothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem forall a. StrictMaybe a
SNothing forall a. Set a
Set.empty (forall a. a -> StrictMaybe a
SJust v
val) forall a. StrictMaybe a
SNothing
        Just (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
SNothing StrictMaybe DRep
dRep) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet (forall a. a -> StrictMaybe a
SJust v
val) StrictMaybe DRep
dRep
        Just (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet (SJust KeyHash 'StakePool
old) StrictMaybe DRep
dRep) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ v -> v -> v
combine KeyHash 'StakePool
old v
val) StrictMaybe DRep
dRep
  DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} -> Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking)
-> UView (Credential 'Staking) DRep
dRepUView (forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe UMElem -> Maybe UMElem
go k
key Map (Credential 'Staking) UMElem
umElems) Map Ptr (Credential 'Staking)
umPtrs
    where
      go :: Maybe UMElem -> Maybe UMElem
go = \case
        Maybe UMElem
Nothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem forall a. StrictMaybe a
SNothing forall a. Set a
Set.empty forall a. StrictMaybe a
SNothing forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust v
val
        Just (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
SNothing) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust v
val
        Just (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool (SJust DRep
old)) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ v -> v -> v
combine DRep
old v
val

insertWith :: (v -> v -> v) -> k -> v -> UView k v -> UMap
insertWith :: forall v k. (v -> v -> v) -> k -> v -> UView k v -> UMap
insertWith v -> v -> v
combine k
k v
v UView k v
uview = forall k v. UView k v -> UMap
unUView forall a b. (a -> b) -> a -> b
$ forall v k. (v -> v -> v) -> k -> v -> UView k v -> UView k v
insertWith' v -> v -> v
combine k
k v
v UView k v
uview

insert' :: k -> v -> UView k v -> UView k v
insert' :: forall k v. k -> v -> UView k v -> UView k v
insert' = forall v k. (v -> v -> v) -> k -> v -> UView k v -> UView k v
insertWith' forall a b. (a -> b) -> a -> b
$ \v
_old v
new -> v
new

insert :: k -> v -> UView k v -> UMap
insert :: forall k v. k -> v -> UView k v -> UMap
insert k
k v
v UView k v
uview = forall k v. UView k v -> UMap
unUView forall a b. (a -> b) -> a -> b
$ forall k v. k -> v -> UView k v -> UView k v
insert' k
k v
v UView k v
uview

-- | Adjust a `UView`, just like `Map.adjust`.
-- This is implemented only for reward-deposit pairs.
adjust :: (RDPair -> RDPair) -> k -> UView k RDPair -> UMap
adjust :: forall k. (RDPair -> RDPair) -> k -> UView k RDPair -> UMap
adjust RDPair -> RDPair
f k
k (RewDepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs}) = Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UMap
UMap (forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust UMElem -> UMElem
go k
k Map (Credential 'Staking) UMElem
umElems) Map Ptr (Credential 'Staking)
umPtrs
  where
    go :: UMElem -> UMElem
go (UMElem (SJust RDPair
rd) Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep) = StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem (forall a. a -> StrictMaybe a
SJust (RDPair -> RDPair
f RDPair
rd)) Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep
    go (UMElem StrictMaybe RDPair
SNothing Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep) = StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem forall a. StrictMaybe a
SNothing Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep

-- | Lookup a `UView`, just like `Map.lookup`.
lookup :: k -> UView k v -> Maybe v
lookup :: forall k v. k -> UView k v -> Maybe v
lookup k
key = \case
  RewDepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key Map (Credential 'Staking) UMElem
umElems forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UMElem -> Maybe RDPair
umElemRDPair
  PtrUView UMap {Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} -> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key Map Ptr (Credential 'Staking)
umPtrs
  SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key Map (Credential 'Staking) UMElem
umElems forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UMElem -> Maybe (KeyHash 'StakePool)
umElemSPool
  DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key Map (Credential 'Staking) UMElem
umElems forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UMElem -> Maybe DRep
umElemDRep

-- | `null` for a `UView`, just like `Map.null`
nullUView :: UView k v -> Bool
nullUView :: forall k a. UView k a -> Bool
nullUView = \case
  RewDepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMElem -> Maybe RDPair
umElemRDPair) Map (Credential 'Staking) UMElem
umElems
  PtrUView UMap {Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} -> forall k a. Map k a -> Bool
Map.null Map Ptr (Credential 'Staking)
umPtrs
  SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMElem -> Maybe (KeyHash 'StakePool)
umElemSPool) Map (Credential 'Staking) UMElem
umElems
  DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMElem -> Maybe DRep
umElemDRep) Map (Credential 'Staking) UMElem
umElems

-- | Get the domain of the `Map`-like `UView`
domain :: UView k v -> Set k
domain :: forall k v. UView k v -> Set k
domain = \case
  RewDepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' forall {a}. Ord a => Set a -> a -> UMElem -> Set a
accum forall a. Set a
Set.empty Map (Credential 'Staking) UMElem
umElems
    where
      accum :: Set a -> a -> UMElem -> Set a
accum Set a
ans a
k (UMElem (SJust RDPair
_) Set Ptr
_ StrictMaybe (KeyHash 'StakePool)
_ StrictMaybe DRep
_) = forall a. Ord a => a -> Set a -> Set a
Set.insert a
k Set a
ans
      accum Set a
ans a
_ UMElem
_ = Set a
ans
  PtrUView UMap {Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} -> forall k a. Map k a -> Set k
Map.keysSet Map Ptr (Credential 'Staking)
umPtrs
  SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' forall {a}. Ord a => Set a -> a -> UMElem -> Set a
accum forall a. Set a
Set.empty Map (Credential 'Staking) UMElem
umElems
    where
      accum :: Set a -> a -> UMElem -> Set a
accum Set a
ans a
k (UMElem StrictMaybe RDPair
_ Set Ptr
_ (SJust KeyHash 'StakePool
_) StrictMaybe DRep
_) = forall a. Ord a => a -> Set a -> Set a
Set.insert a
k Set a
ans
      accum Set a
ans a
_ UMElem
_ = Set a
ans
  DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' forall {a}. Ord a => Set a -> a -> UMElem -> Set a
accum forall a. Set a
Set.empty Map (Credential 'Staking) UMElem
umElems
    where
      accum :: Set a -> a -> UMElem -> Set a
accum Set a
ans a
k (UMElem StrictMaybe RDPair
_ Set Ptr
_ StrictMaybe (KeyHash 'StakePool)
_ (SJust DRep
_)) = forall a. Ord a => a -> Set a -> Set a
Set.insert a
k Set a
ans
      accum Set a
ans a
_ UMElem
_ = Set a
ans

-- | Get the range of the `Map`-like `UView`
range :: UView k v -> Set v
range :: forall k v. UView k v -> Set v
range = \case
  RewDepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' Set RDPair -> UMElem -> Set RDPair
accum forall a. Set a
Set.empty Map (Credential 'Staking) UMElem
umElems
    where
      accum :: Set RDPair -> UMElem -> Set RDPair
accum Set RDPair
ans (UMElem (SJust RDPair
rd) Set Ptr
_ StrictMaybe (KeyHash 'StakePool)
_ StrictMaybe DRep
_) = forall a. Ord a => a -> Set a -> Set a
Set.insert RDPair
rd Set RDPair
ans
      accum Set RDPair
ans UMElem
_ = Set RDPair
ans
  PtrUView UMap {Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} -> forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems Map Ptr (Credential 'Staking)
umPtrs
  SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' Set (KeyHash 'StakePool) -> UMElem -> Set (KeyHash 'StakePool)
accum forall a. Set a
Set.empty Map (Credential 'Staking) UMElem
umElems
    where
      accum :: Set (KeyHash 'StakePool) -> UMElem -> Set (KeyHash 'StakePool)
accum Set (KeyHash 'StakePool)
ans (UMElem StrictMaybe RDPair
_ Set Ptr
_ (SJust KeyHash 'StakePool
sPool) StrictMaybe DRep
_) = forall a. Ord a => a -> Set a -> Set a
Set.insert KeyHash 'StakePool
sPool Set (KeyHash 'StakePool)
ans
      accum Set (KeyHash 'StakePool)
ans UMElem
_ = Set (KeyHash 'StakePool)
ans
  DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' Set DRep -> UMElem -> Set DRep
accum forall a. Set a
Set.empty Map (Credential 'Staking) UMElem
umElems
    where
      accum :: Set DRep -> UMElem -> Set DRep
accum Set DRep
ans (UMElem StrictMaybe RDPair
_ Set Ptr
_ StrictMaybe (KeyHash 'StakePool)
_ (SJust DRep
dRep)) = forall a. Ord a => a -> Set a -> Set a
Set.insert DRep
dRep Set DRep
ans
      accum Set DRep
ans UMElem
_ = Set DRep
ans

-- | Union with left preference.
-- So if k, already exists, do nothing, if it doesn't exist insert it.
--
-- Spec:
-- evalUnified (RewDepUView u1 ∪ singleton hk mempty)
-- evalUnified (Ptrs u2 ∪ singleton ptr hk)
unionL, (∪) :: UView k v -> (k, v) -> UMap
UView k v
view ∪ :: forall k v. UView k v -> (k, v) -> UMap
∪ (k
k, v
v) = forall v k. (v -> v -> v) -> k -> v -> UView k v -> UMap
insertWith forall a b. a -> b -> a
const k
k v
v UView k v
view
unionL :: forall k v. UView k v -> (k, v) -> UMap
unionL = forall k v. UView k v -> (k, v) -> UMap
(∪)

-- | Union with right preference.
-- So if k, already exists, then old v is overwritten with the new v.
--
-- Special rules apply for the `RewDepUView`, where only the `rdReward`
-- field of the `RDPair` is overwritten, and the old `rdDeposit` value persists.
--
-- Note: In this case it is an invariant that the domain of the `Map` on the right side
-- is a subset of the domain of the RewDepUView. See the single case in
-- module Cardano.Ledger.Shelley.Rules.Delegs, in the dealing with Withdrawals's where
-- it is used at this type.
--
-- Spec:
-- evalUnified (delegations ds ⨃ singleton hk dpool)
-- evalUnified (rewards' ⨃ wdrls_')
unionR, (⨃) :: UView k v -> Map k v -> UMap
(RewDepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs}) ⨃ :: forall k v. UView k v -> Map k v -> UMap
⨃ Map k v
rightUmap = Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UMap
UMap (forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' forall {k}. Ord k => Map k UMElem -> k -> RDPair -> Map k UMElem
accum Map (Credential 'Staking) UMElem
umElems Map k v
rightUmap) Map Ptr (Credential 'Staking)
umPtrs
  where
    accum :: Map k UMElem -> k -> RDPair -> Map k UMElem
accum !Map k UMElem
ans k
k (RDPair CompactForm Coin
r CompactForm Coin
_) = forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust UMElem -> UMElem
overwrite k
k Map k UMElem
ans
      where
        overwrite :: UMElem -> UMElem
overwrite (UMElem (SJust (RDPair CompactForm Coin
_ CompactForm Coin
d)) Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep) = StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem (forall a. a -> StrictMaybe a
SJust (CompactForm Coin -> CompactForm Coin -> RDPair
RDPair CompactForm Coin
r CompactForm Coin
d)) Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep
        overwrite UMElem
x = UMElem
x
UView k v
view ⨃ Map k v
mp = forall k v. UView k v -> UMap
unUView forall a b. (a -> b) -> a -> b
$ forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' forall {k} {v}. UView k v -> k -> v -> UView k v
accum UView k v
view Map k v
mp
  where
    accum :: UView k v -> k -> v -> UView k v
accum UView k v
ans k
k v
v = forall v k. (v -> v -> v) -> k -> v -> UView k v -> UView k v
insertWith' (\v
_old v
new -> v
new) k
k v
v UView k v
ans
unionR :: forall k v. UView k v -> Map k v -> UMap
unionR = forall k v. UView k v -> Map k v -> UMap
(⨃)

-- | Add the reward from the `Map` on the right side to the reward in the `UView` on the left.
-- This is only implemented and is applicable to `RewDepUView`s.
--
-- We presume that the domain of the `Map` on the right, is a subset of the domain of the `UView` on the left.
--
-- Spec:
-- evalUnified (rewards dState ∪+ registeredAggregated)
-- evalUnified (rewards' ∪+ update)
-- evalUnified (RewDepUView u0 ∪+ refunds)
unionRewAgg
  , (∪+) ::
    UView (Credential 'Staking) RDPair ->
    Map (Credential 'Staking) (CompactForm Coin) ->
    UMap
unionRewAgg :: UView (Credential 'Staking) RDPair
-> Map (Credential 'Staking) (CompactForm Coin) -> UMap
unionRewAgg UView (Credential 'Staking) RDPair
view Map (Credential 'Staking) (CompactForm Coin)
m = forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' UMap -> Credential 'Staking -> CompactForm Coin -> UMap
accum (forall k v. UView k v -> UMap
unUView UView (Credential 'Staking) RDPair
view) Map (Credential 'Staking) (CompactForm Coin)
m
  where
    accum :: UMap -> Credential 'Staking -> CompactForm Coin -> UMap
accum UMap
umap Credential 'Staking
key CompactForm Coin
ccoin = forall k. (RDPair -> RDPair) -> k -> UView k RDPair -> UMap
adjust RDPair -> RDPair
combine Credential 'Staking
key (UMap -> UView (Credential 'Staking) RDPair
RewDepUView UMap
umap)
      where
        combine :: RDPair -> RDPair
combine (RDPair CompactForm Coin
r CompactForm Coin
d) = CompactForm Coin -> CompactForm Coin -> RDPair
RDPair (CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompact CompactForm Coin
r CompactForm Coin
ccoin) CompactForm Coin
d
∪+ :: UView (Credential 'Staking) RDPair
-> Map (Credential 'Staking) (CompactForm Coin) -> UMap
(∪+) = UView (Credential 'Staking) RDPair
-> Map (Credential 'Staking) (CompactForm Coin) -> UMap
unionRewAgg

-- | Add the deposit from the `Map` on the right side to the deposit in the `UView` on the left.
-- This is only implemented and is applicable to `RewDepUView`s.
unionKeyDeposits :: UView k RDPair -> Map k (CompactForm Coin) -> UMap
unionKeyDeposits :: forall k. UView k RDPair -> Map k (CompactForm Coin) -> UMap
unionKeyDeposits UView k RDPair
view Map k (CompactForm Coin)
m = forall k v. UView k v -> UMap
unUView forall a b. (a -> b) -> a -> b
$ forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' forall {k}.
UView k RDPair -> k -> CompactForm Coin -> UView k RDPair
accum UView k RDPair
view Map k (CompactForm Coin)
m
  where
    accum :: UView k RDPair -> k -> CompactForm Coin -> UView k RDPair
accum UView k RDPair
vw k
key CompactForm Coin
ccoin = forall v k. (v -> v -> v) -> k -> v -> UView k v -> UView k v
insertWith' RDPair -> RDPair -> RDPair
combine k
key (CompactForm Coin -> CompactForm Coin -> RDPair
RDPair (Word64 -> CompactForm Coin
CompactCoin Word64
0) CompactForm Coin
ccoin) UView k RDPair
vw
    -- If the key isn't present in the `UMap` the combining function is ignored
    -- and the new `RDPair` is inserted in the `UMap`. Ref: haddock for `insertWith'`.
    combine :: RDPair -> RDPair -> RDPair
combine (RDPair CompactForm Coin
r CompactForm Coin
d) (RDPair CompactForm Coin
_ CompactForm Coin
newD) = CompactForm Coin -> CompactForm Coin -> RDPair
RDPair CompactForm Coin
r (CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompact CompactForm Coin
d CompactForm Coin
newD)

-- | Delete all keys in the given `Set` from the domain of the given map-like `UView`.
--
-- Spec:
-- evalUnified (setSingleton hk ⋪ RewDepUView u0)
-- evalUnified (setSingleton hk ⋪ SPoolUView u1)
domDelete, (⋪) :: Set k -> UView k v -> UMap
Set k
set ⋪ :: forall k v. Set k -> UView k v -> UMap
⋪ UView k v
view = forall k v. UView k v -> UMap
unUView (forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k v. k -> UView k v -> UView k v
delete') UView k v
view Set k
set)
domDelete :: forall k v. Set k -> UView k v -> UMap
domDelete = forall k v. Set k -> UView k v -> UMap
(⋪)

-- | Delete the stake credentials in the domain and all associated ranges from the `UMap`
-- This can be expensive when there are many pointers associated with the credential.
domDeleteAll :: Set (Credential 'Staking) -> UMap -> UMap
domDeleteAll :: Set (Credential 'Staking) -> UMap -> UMap
domDeleteAll Set (Credential 'Staking)
ks UMap
umap = forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr' Credential 'Staking -> UMap -> UMap
deleteStakingCredential UMap
umap Set (Credential 'Staking)
ks

-- | Completely remove the staking credential from the UMap, including all associated
-- pointers.
deleteStakingCredential :: Credential 'Staking -> UMap -> UMap
deleteStakingCredential :: Credential 'Staking -> UMap -> UMap
deleteStakingCredential Credential 'Staking
cred = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'Staking -> UMap -> (Maybe UMElem, UMap)
extractStakingCredential Credential 'Staking
cred

-- | Just like `deleteStakingCredential`, but also returned the removed element.
extractStakingCredential :: Credential 'Staking -> UMap -> (Maybe UMElem, UMap)
extractStakingCredential :: Credential 'Staking -> UMap -> (Maybe UMElem, UMap)
extractStakingCredential Credential 'Staking
cred umap :: UMap
umap@UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} =
  case forall k b. Ord k => k -> Map k b -> (Maybe b, Map k b)
MapExtras.extract Credential 'Staking
cred Map (Credential 'Staking) UMElem
umElems of
    (Maybe UMElem
Nothing, Map (Credential 'Staking) UMElem
_) -> (forall a. Maybe a
Nothing, UMap
umap)
    (e :: Maybe UMElem
e@(Just (UMElem StrictMaybe RDPair
_ Set Ptr
ptrs StrictMaybe (KeyHash 'StakePool)
_ StrictMaybe DRep
_)), Map (Credential 'Staking) UMElem
umElems') ->
      ( Maybe UMElem
e
      , UMap
          { umElems :: Map (Credential 'Staking) UMElem
umElems = Map (Credential 'Staking) UMElem
umElems'
          , umPtrs :: Map Ptr (Credential 'Staking)
umPtrs = Map Ptr (Credential 'Staking)
umPtrs forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` Set Ptr
ptrs
          }
      )

-- | Delete all elements in the given `Set` from the range of the given map-like `UView`.
-- This is slow for SPoolUView, RewDepUView, and DReps UViews, better hope the sets are small
--
-- Spec:
-- evalUnified (Ptrs u2 ⋫ setSingleton hk)
-- evalUnified (SPoolUView u1 ⋫ retired)
rngDelete, (⋫) :: UView k v -> Set v -> UMap
RewDepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} ⋫ :: forall k v. UView k v -> Set v -> UMap
⋫ Set v
rdSet = Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UMap
UMap (forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Map (Credential 'Staking) UMElem
-> Credential 'Staking
-> UMElem
-> Map (Credential 'Staking) UMElem
accum Map (Credential 'Staking) UMElem
umElems Map (Credential 'Staking) UMElem
umElems) Map Ptr (Credential 'Staking)
umPtrs
  where
    accum :: Map (Credential 'Staking) UMElem
-> Credential 'Staking
-> UMElem
-> Map (Credential 'Staking) UMElem
accum Map (Credential 'Staking) UMElem
ans Credential 'Staking
key = \case
      UMElem (SJust RDPair
rd) Set Ptr
_ StrictMaybe (KeyHash 'StakePool)
_ StrictMaybe DRep
_
        | forall a. Ord a => a -> Set a -> Bool
Set.member RDPair
rd Set v
rdSet ->
            let go :: UMElem -> Maybe UMElem
go (UMElem StrictMaybe RDPair
_ Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep) = UMElem -> Maybe UMElem
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem forall a. StrictMaybe a
SNothing Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep
             in forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update UMElem -> Maybe UMElem
go Credential 'Staking
key Map (Credential 'Staking) UMElem
ans
      UMElem
_ -> Map (Credential 'Staking) UMElem
ans
PtrUView UMap
um ⋫ Set v
set = forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' UMap -> Credential 'Staking -> UMap
rmCred UMap
um Set v
set
  where
    rmCred :: UMap -> Credential 'Staking -> UMap
rmCred m :: UMap
m@UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} Credential 'Staking
cred = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'Staking
cred Map (Credential 'Staking) UMElem
umElems of
      Maybe UMElem
Nothing -> UMap
m
      Just (UMElem StrictMaybe RDPair
_ Set Ptr
kset StrictMaybe (KeyHash 'StakePool)
_ StrictMaybe DRep
_) ->
        let go :: UMElem -> Maybe UMElem
go (UMElem StrictMaybe RDPair
rd Set Ptr
_ StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep) = UMElem -> Maybe UMElem
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
rd forall a. Set a
Set.empty StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep
         in Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UMap
UMap (forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update UMElem -> Maybe UMElem
go Credential 'Staking
cred Map (Credential 'Staking) UMElem
umElems) (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Map Ptr (Credential 'Staking)
umPtrs Set Ptr
kset)
SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} ⋫ Set v
sPoolSet = Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UMap
UMap (forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Map (Credential 'Staking) UMElem
-> Credential 'Staking
-> UMElem
-> Map (Credential 'Staking) UMElem
accum Map (Credential 'Staking) UMElem
umElems Map (Credential 'Staking) UMElem
umElems) Map Ptr (Credential 'Staking)
umPtrs
  where
    accum :: Map (Credential 'Staking) UMElem
-> Credential 'Staking
-> UMElem
-> Map (Credential 'Staking) UMElem
accum Map (Credential 'Staking) UMElem
ans Credential 'Staking
key = \case
      UMElem StrictMaybe RDPair
_ Set Ptr
_ (SJust KeyHash 'StakePool
sPool) StrictMaybe DRep
_
        | forall a. Ord a => a -> Set a -> Bool
Set.member KeyHash 'StakePool
sPool Set v
sPoolSet ->
            let go :: UMElem -> Maybe UMElem
go (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
_ StrictMaybe DRep
dRep) = UMElem -> Maybe UMElem
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet forall a. StrictMaybe a
SNothing StrictMaybe DRep
dRep
             in forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update UMElem -> Maybe UMElem
go Credential 'Staking
key Map (Credential 'Staking) UMElem
ans
      UMElem
_ -> Map (Credential 'Staking) UMElem
ans
DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} ⋫ Set v
dRepSet = Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UMap
UMap (forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Map (Credential 'Staking) UMElem
-> Credential 'Staking
-> UMElem
-> Map (Credential 'Staking) UMElem
accum Map (Credential 'Staking) UMElem
umElems Map (Credential 'Staking) UMElem
umElems) Map Ptr (Credential 'Staking)
umPtrs
  where
    accum :: Map (Credential 'Staking) UMElem
-> Credential 'Staking
-> UMElem
-> Map (Credential 'Staking) UMElem
accum Map (Credential 'Staking) UMElem
ans Credential 'Staking
key = \case
      UMElem StrictMaybe RDPair
_ Set Ptr
_ StrictMaybe (KeyHash 'StakePool)
_ (SJust DRep
dRep)
        | forall a. Ord a => a -> Set a -> Bool
Set.member DRep
dRep Set v
dRepSet ->
            let go :: UMElem -> Maybe UMElem
go (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
_) = UMElem -> Maybe UMElem
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool forall a. StrictMaybe a
SNothing
             in forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update UMElem -> Maybe UMElem
go Credential 'Staking
key Map (Credential 'Staking) UMElem
ans
      UMElem
_ -> Map (Credential 'Staking) UMElem
ans
rngDelete :: forall k v. UView k v -> Set v -> UMap
rngDelete = forall k v. UView k v -> Set v -> UMap
(⋫)

-- | Checks for membership directly against `umElems` instead of a `UView`.
member' :: Credential 'Staking -> UMap -> Bool
member' :: Credential 'Staking -> UMap -> Bool
member' Credential 'Staking
k = forall k a. Ord k => k -> Map k a -> Bool
Map.member Credential 'Staking
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMap -> Map (Credential 'Staking) UMElem
umElems

-- | Membership check for a `UView`, just like `Map.member`
--
-- Spec:
-- eval (k ∈ dom (rewards dState))
-- eval (k ∈ dom (rewards ds)))
-- eval (hk ∈ dom (rewards ds))
-- eval (hk ∉ dom (rewards ds))
member, notMember :: k -> UView k v -> Bool
member :: forall k v. k -> UView k v -> Bool
member k
k = \case
  RewDepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map (Credential 'Staking) UMElem
umElems of
    Just (UMElem (SJust RDPair
_) Set Ptr
_ StrictMaybe (KeyHash 'StakePool)
_ StrictMaybe DRep
_) -> Bool
True
    Maybe UMElem
_ -> Bool
False
  PtrUView UMap {Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} -> forall k a. Ord k => k -> Map k a -> Bool
Map.member k
k Map Ptr (Credential 'Staking)
umPtrs
  SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map (Credential 'Staking) UMElem
umElems of
    Just (UMElem StrictMaybe RDPair
_ Set Ptr
_ (SJust KeyHash 'StakePool
_) StrictMaybe DRep
_) -> Bool
True
    Maybe UMElem
_ -> Bool
False
  DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map (Credential 'Staking) UMElem
umElems of
    Just (UMElem StrictMaybe RDPair
_ Set Ptr
_ StrictMaybe (KeyHash 'StakePool)
_ (SJust DRep
_)) -> Bool
True
    Maybe UMElem
_ -> Bool
False
notMember :: forall k v. k -> UView k v -> Bool
notMember k
k UView k v
um = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall k v. k -> UView k v -> Bool
member k
k UView k v
um

-- | Domain restriction.
--
-- Spec:
-- eval (dom rewards' ◁ iRReserves (_irwd ds) :: RewardAccounts (Crypto era))
-- eval (dom rewards' ◁ iRTreasury (_irwd ds) :: RewardAccounts (Crypto era))
(◁), domRestrict :: UView k v -> Map k u -> Map k u
RewDepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} ◁ :: forall k v u. UView k v -> Map k u -> Map k u
◁ Map k u
m = forall k v2 v1.
Ord k =>
(k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v1
intersectDomPLeft forall {p}. p -> UMElem -> Bool
p Map k u
m Map (Credential 'Staking) UMElem
umElems
  where
    p :: p -> UMElem -> Bool
p p
_ (UMElem (SJust RDPair
_) Set Ptr
_ StrictMaybe (KeyHash 'StakePool)
_ StrictMaybe DRep
_) = Bool
True
    p p
_ UMElem
_ = Bool
False
PtrUView UMap {Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} ◁ Map k u
m = forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection Map k u
m Map Ptr (Credential 'Staking)
umPtrs
SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} ◁ Map k u
m = forall k v2 v1.
Ord k =>
(k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v1
intersectDomPLeft forall {p}. p -> UMElem -> Bool
p Map k u
m Map (Credential 'Staking) UMElem
umElems
  where
    p :: p -> UMElem -> Bool
p p
_ (UMElem StrictMaybe RDPair
_ Set Ptr
_ (SJust KeyHash 'StakePool
_) StrictMaybe DRep
_) = Bool
True
    p p
_ UMElem
_ = Bool
False
DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems} ◁ Map k u
m = forall k v2 v1.
Ord k =>
(k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v1
intersectDomPLeft forall {p}. p -> UMElem -> Bool
p Map k u
m Map (Credential 'Staking) UMElem
umElems
  where
    p :: p -> UMElem -> Bool
p p
_ (UMElem StrictMaybe RDPair
_ Set Ptr
_ StrictMaybe (KeyHash 'StakePool)
_ (SJust DRep
_)) = Bool
True
    p p
_ UMElem
_ = Bool
False
domRestrict :: forall k v u. UView k v -> Map k u -> Map k u
domRestrict = forall k v u. UView k v -> Map k u -> Map k u
(◁)

-- | Find the value associated with a key from a `UView`, return the default if the key is not there.
findWithDefault :: v -> k -> UView k v -> v
findWithDefault :: forall v k. v -> k -> UView k v -> v
findWithDefault v
def k
k = forall a. a -> Maybe a -> a
fromMaybe v
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. k -> UView k v -> Maybe v
lookup k
k

-- | A `UView` is a view, so the size of the view is NOT the same as the size of
-- the underlying `UMElem` map.
size :: UView k v -> Int
size :: forall k v. UView k v -> Int
size = \case
  PtrUView UMap {Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs} -> forall k a. Map k a -> Int
Map.size Map Ptr (Credential 'Staking)
umPtrs
  UView k v
x -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
count v
_v -> Int
count forall a. Num a => a -> a -> a
+ Int
1) Int
0 UView k v
x

-- | Create a UMap from 4 separate maps. NOTE: For use in tests only.
unify ::
  Map (Credential 'Staking) RDPair ->
  Map Ptr (Credential 'Staking) ->
  Map (Credential 'Staking) (KeyHash 'StakePool) ->
  Map (Credential 'Staking) DRep ->
  UMap
unify :: Map (Credential 'Staking) RDPair
-> Map Ptr (Credential 'Staking)
-> Map (Credential 'Staking) (KeyHash 'StakePool)
-> Map (Credential 'Staking) DRep
-> UMap
unify Map (Credential 'Staking) RDPair
rd Map Ptr (Credential 'Staking)
ptr Map (Credential 'Staking) (KeyHash 'StakePool)
sPool Map (Credential 'Staking) DRep
dRep = UMap
um4
  where
    um1 :: UMap
um1 = forall k v. UView k v -> UMap
unUView forall a b. (a -> b) -> a -> b
$ forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\UView (Credential 'Staking) RDPair
um Credential 'Staking
k RDPair
v -> forall k v. k -> v -> UView k v -> UView k v
insert' Credential 'Staking
k RDPair
v UView (Credential 'Staking) RDPair
um) (UMap -> UView (Credential 'Staking) RDPair
RewDepUView UMap
empty) Map (Credential 'Staking) RDPair
rd
    um2 :: UMap
um2 = forall k v. UView k v -> UMap
unUView forall a b. (a -> b) -> a -> b
$ forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\UView (Credential 'Staking) (KeyHash 'StakePool)
um Credential 'Staking
k KeyHash 'StakePool
v -> forall k v. k -> v -> UView k v -> UView k v
insert' Credential 'Staking
k KeyHash 'StakePool
v UView (Credential 'Staking) (KeyHash 'StakePool)
um) (UMap -> UView (Credential 'Staking) (KeyHash 'StakePool)
SPoolUView UMap
um1) Map (Credential 'Staking) (KeyHash 'StakePool)
sPool
    um3 :: UMap
um3 = forall k v. UView k v -> UMap
unUView forall a b. (a -> b) -> a -> b
$ forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\UView (Credential 'Staking) DRep
um Credential 'Staking
k DRep
v -> forall k v. k -> v -> UView k v -> UView k v
insert' Credential 'Staking
k DRep
v UView (Credential 'Staking) DRep
um) (UMap -> UView (Credential 'Staking) DRep
DRepUView UMap
um2) Map (Credential 'Staking) DRep
dRep
    um4 :: UMap
um4 = forall k v. UView k v -> UMap
unUView forall a b. (a -> b) -> a -> b
$ forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\UView Ptr (Credential 'Staking)
um Ptr
k Credential 'Staking
v -> forall k v. k -> v -> UView k v -> UView k v
insert' Ptr
k Credential 'Staking
v UView Ptr (Credential 'Staking)
um) (UMap -> UView Ptr (Credential 'Staking)
PtrUView UMap
um3) Map Ptr (Credential 'Staking)
ptr

addCompact :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompact :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompact (CompactCoin Word64
x) (CompactCoin Word64
y) = Word64 -> CompactForm Coin
CompactCoin (Word64
x forall a. Num a => a -> a -> a
+ Word64
y)

sumCompactCoin :: Foldable t => t (CompactForm Coin) -> CompactForm Coin
sumCompactCoin :: forall (t :: * -> *).
Foldable t =>
t (CompactForm Coin) -> CompactForm Coin
sumCompactCoin = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompact (Word64 -> CompactForm Coin
CompactCoin Word64
0)

sumRewardsUView :: UView k RDPair -> CompactForm Coin
sumRewardsUView :: forall k. UView k RDPair -> CompactForm Coin
sumRewardsUView = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' CompactForm Coin -> RDPair -> CompactForm Coin
accum (Word64 -> CompactForm Coin
CompactCoin Word64
0)
  where
    accum :: CompactForm Coin -> RDPair -> CompactForm Coin
accum CompactForm Coin
ans (RDPair CompactForm Coin
r CompactForm Coin
_) = CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompact CompactForm Coin
ans CompactForm Coin
r

sumDepositUView :: UView k RDPair -> CompactForm Coin
sumDepositUView :: forall k. UView k RDPair -> CompactForm Coin
sumDepositUView = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' CompactForm Coin -> RDPair -> CompactForm Coin
accum (Word64 -> CompactForm Coin
CompactCoin Word64
0)
  where
    accum :: CompactForm Coin -> RDPair -> CompactForm Coin
accum CompactForm Coin
ans (RDPair CompactForm Coin
_ CompactForm Coin
d) = CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompact CompactForm Coin
ans CompactForm Coin
d