{-# 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),
  addCompactCoin,
  compactCoinOrError,
  sumCompactCoin,
 )
import Cardano.Ledger.Compactible (Compactible (..))
import Cardano.Ledger.Credential (Credential (..), Ptr, mkPtrNormalized)
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
(Int -> RDPair -> ShowS)
-> (RDPair -> String) -> ([RDPair] -> ShowS) -> Show RDPair
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RDPair -> ShowS
showsPrec :: Int -> RDPair -> ShowS
$cshow :: RDPair -> String
show :: RDPair -> String
$cshowList :: [RDPair] -> ShowS
showList :: [RDPair] -> ShowS
Show, RDPair -> RDPair -> Bool
(RDPair -> RDPair -> Bool)
-> (RDPair -> RDPair -> Bool) -> Eq RDPair
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RDPair -> RDPair -> Bool
== :: RDPair -> RDPair -> Bool
$c/= :: RDPair -> RDPair -> Bool
/= :: RDPair -> RDPair -> Bool
Eq, Eq RDPair
Eq RDPair =>
(RDPair -> RDPair -> Ordering)
-> (RDPair -> RDPair -> Bool)
-> (RDPair -> RDPair -> Bool)
-> (RDPair -> RDPair -> Bool)
-> (RDPair -> RDPair -> Bool)
-> (RDPair -> RDPair -> RDPair)
-> (RDPair -> RDPair -> RDPair)
-> Ord 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
$ccompare :: RDPair -> RDPair -> Ordering
compare :: RDPair -> RDPair -> Ordering
$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
>= :: RDPair -> RDPair -> Bool
$cmax :: RDPair -> RDPair -> RDPair
max :: RDPair -> RDPair -> RDPair
$cmin :: RDPair -> RDPair -> RDPair
min :: RDPair -> RDPair -> RDPair
Ord, (forall x. RDPair -> Rep RDPair x)
-> (forall x. Rep RDPair x -> RDPair) -> Generic RDPair
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
$cfrom :: forall x. RDPair -> Rep RDPair x
from :: forall x. RDPair -> Rep RDPair x
$cto :: forall x. Rep RDPair x -> RDPair
to :: forall x. Rep RDPair x -> RDPair
Generic, Context -> RDPair -> IO (Maybe ThunkInfo)
Proxy RDPair -> String
(Context -> RDPair -> IO (Maybe ThunkInfo))
-> (Context -> RDPair -> IO (Maybe ThunkInfo))
-> (Proxy RDPair -> String)
-> NoThunks RDPair
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> RDPair -> IO (Maybe ThunkInfo)
noThunks :: Context -> RDPair -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> RDPair -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> RDPair -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy RDPair -> String
showTypeOf :: Proxy RDPair -> String
NoThunks, RDPair -> ()
(RDPair -> ()) -> NFData RDPair
forall a. (a -> ()) -> NFData a
$crnf :: RDPair -> ()
rnf :: RDPair -> ()
NFData)

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

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

rdDepositCoin :: RDPair -> Coin
rdDepositCoin :: RDPair -> Coin
rdDepositCoin RDPair
rdp = CompactForm Coin -> Coin
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 :: RDPair -> CompactForm Coin
rdReward :: CompactForm Coin
rdReward, CompactForm Coin
rdDeposit :: RDPair -> CompactForm Coin
rdDeposit :: CompactForm Coin
rdDeposit} =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CompactForm Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR CompactForm Coin
rdReward Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CompactForm Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR CompactForm Coin
rdDeposit

instance DecCBOR RDPair where
  decCBOR :: forall s. Decoder s RDPair
decCBOR =
    Text -> (RDPair -> Int) -> Decoder s RDPair -> Decoder s RDPair
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"RDPair" (Int -> RDPair -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s RDPair -> Decoder s RDPair)
-> Decoder s RDPair -> Decoder s RDPair
forall a b. (a -> b) -> a -> b
$ CompactForm Coin -> CompactForm Coin -> RDPair
RDPair (CompactForm Coin -> CompactForm Coin -> RDPair)
-> Decoder s (CompactForm Coin)
-> Decoder s (CompactForm Coin -> RDPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (CompactForm Coin)
forall s. Decoder s (CompactForm Coin)
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (CompactForm Coin -> RDPair)
-> Decoder s (CompactForm Coin) -> Decoder s RDPair
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (CompactForm Coin)
forall s. Decoder s (CompactForm Coin)
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
(UMElem -> UMElem -> Bool)
-> (UMElem -> UMElem -> Bool) -> Eq UMElem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UMElem -> UMElem -> Bool
== :: UMElem -> UMElem -> Bool
$c/= :: UMElem -> UMElem -> Bool
/= :: UMElem -> UMElem -> Bool
Eq, Eq UMElem
Eq UMElem =>
(UMElem -> UMElem -> Ordering)
-> (UMElem -> UMElem -> Bool)
-> (UMElem -> UMElem -> Bool)
-> (UMElem -> UMElem -> Bool)
-> (UMElem -> UMElem -> Bool)
-> (UMElem -> UMElem -> UMElem)
-> (UMElem -> UMElem -> UMElem)
-> Ord 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
$ccompare :: UMElem -> UMElem -> Ordering
compare :: UMElem -> UMElem -> Ordering
$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
>= :: UMElem -> UMElem -> Bool
$cmax :: UMElem -> UMElem -> UMElem
max :: UMElem -> UMElem -> UMElem
$cmin :: UMElem -> UMElem -> UMElem
min :: UMElem -> UMElem -> UMElem
Ord, Int -> UMElem -> ShowS
[UMElem] -> ShowS
UMElem -> String
(Int -> UMElem -> ShowS)
-> (UMElem -> String) -> ([UMElem] -> ShowS) -> Show UMElem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UMElem -> ShowS
showsPrec :: Int -> UMElem -> ShowS
$cshow :: UMElem -> String
show :: UMElem -> String
$cshowList :: [UMElem] -> ShowS
showList :: [UMElem] -> ShowS
Show, (forall x. UMElem -> Rep UMElem x)
-> (forall x. Rep UMElem x -> UMElem) -> Generic UMElem
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
$cfrom :: forall x. UMElem -> Rep UMElem x
from :: forall x. UMElem -> Rep UMElem x
$cto :: forall x. Rep UMElem x -> UMElem
to :: forall x. Rep UMElem x -> UMElem
Generic, Context -> UMElem -> IO (Maybe ThunkInfo)
Proxy UMElem -> String
(Context -> UMElem -> IO (Maybe ThunkInfo))
-> (Context -> UMElem -> IO (Maybe ThunkInfo))
-> (Proxy UMElem -> String)
-> NoThunks UMElem
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> UMElem -> IO (Maybe ThunkInfo)
noThunks :: Context -> UMElem -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UMElem -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> UMElem -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy UMElem -> String
showTypeOf :: Proxy UMElem -> String
NoThunks, UMElem -> ()
(UMElem -> ()) -> NFData UMElem
forall a. (a -> ()) -> NFData a
$crnf :: UMElem -> ()
rnf :: UMElem -> ()
NFData)

instance ToJSON UMElem where
  toJSON :: UMElem -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value) -> (UMElem -> [Pair]) -> UMElem -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMElem -> [Pair]
forall e a. KeyValue e a => UMElem -> [a]
toUMElemair
  toEncoding :: UMElem -> Encoding
toEncoding = Series -> Encoding
Aeson.pairs (Series -> Encoding) -> (UMElem -> Series) -> UMElem -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series) -> (UMElem -> [Series]) -> UMElem -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMElem -> [Series]
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" Key -> StrictMaybe (CompactForm Coin) -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (RDPair -> CompactForm Coin)
-> StrictMaybe RDPair -> StrictMaybe (CompactForm Coin)
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RDPair -> CompactForm Coin
rdReward StrictMaybe RDPair
rd
  , Key
"deposit" Key -> StrictMaybe (CompactForm Coin) -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (RDPair -> CompactForm Coin)
-> StrictMaybe RDPair -> StrictMaybe (CompactForm Coin)
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RDPair -> CompactForm Coin
rdDeposit StrictMaybe RDPair
rd
  , Key
"ptr" Key -> Set Ptr -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Set Ptr
ptr
  , Key
"spool" Key -> StrictMaybe (KeyHash 'StakePool) -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe (KeyHash 'StakePool)
spool
  , Key
"drep" Key -> StrictMaybe DRep -> a
forall v. ToJSON v => Key -> v -> a
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 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> StrictMaybe RDPair -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR StrictMaybe RDPair
rd Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set Ptr -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Set Ptr
ptrSet Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> StrictMaybe (KeyHash 'StakePool) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR StrictMaybe (KeyHash 'StakePool)
sPool Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> StrictMaybe DRep -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR StrictMaybe DRep
dRep

instance DecShareCBOR UMElem where
  type Share UMElem = (Interns (KeyHash 'StakePool), Interns (Credential 'DRepRole))
  decShareCBOR :: forall s. Share UMElem -> Decoder s UMElem
decShareCBOR (Interns (KeyHash 'StakePool)
ks, Interns (Credential 'DRepRole)
cd) =
    Text -> (UMElem -> Int) -> Decoder s UMElem -> Decoder s UMElem
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"UMElem" (Int -> UMElem -> Int
forall a b. a -> b -> a
const Int
4) (Decoder s UMElem -> Decoder s UMElem)
-> Decoder s UMElem -> Decoder s UMElem
forall a b. (a -> b) -> a -> b
$
      StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem
        (StrictMaybe RDPair
 -> Set Ptr
 -> StrictMaybe (KeyHash 'StakePool)
 -> StrictMaybe DRep
 -> UMElem)
-> Decoder s (StrictMaybe RDPair)
-> Decoder
     s
     (Set Ptr
      -> StrictMaybe (KeyHash 'StakePool) -> StrictMaybe DRep -> UMElem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (StrictMaybe RDPair)
forall s. Decoder s (StrictMaybe RDPair)
forall a s. DecCBOR a => Decoder s a
decCBOR
        Decoder
  s
  (Set Ptr
   -> StrictMaybe (KeyHash 'StakePool) -> StrictMaybe DRep -> UMElem)
-> Decoder s (Set Ptr)
-> Decoder
     s (StrictMaybe (KeyHash 'StakePool) -> StrictMaybe DRep -> UMElem)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Version
-> Decoder s (Set Ptr)
-> Decoder s (Set Ptr)
-> Decoder s (Set Ptr)
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) (Set Ptr
forall a. Monoid a => a
mempty Set Ptr -> Decoder s () -> Decoder s (Set Ptr)
forall a b. a -> Decoder s b -> Decoder s a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Proxy (Set Ptr) -> Decoder s ()
forall s. Proxy (Set Ptr) -> Decoder s ()
forall a s. DecCBOR a => Proxy a -> Decoder s ()
dropCBOR (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Set Ptr))) Decoder s (Set Ptr)
forall s. Decoder s (Set Ptr)
forall a s. DecCBOR a => Decoder s a
decCBOR
        Decoder
  s (StrictMaybe (KeyHash 'StakePool) -> StrictMaybe DRep -> UMElem)
-> Decoder s (StrictMaybe (KeyHash 'StakePool))
-> Decoder s (StrictMaybe DRep -> UMElem)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Interns (KeyHash 'StakePool)
-> Decoder s (StrictMaybe (KeyHash 'StakePool))
forall (f :: * -> *) b s.
(DecCBOR (f b), Monad f) =>
Interns b -> Decoder s (f b)
decShareMonadCBOR Interns (KeyHash 'StakePool)
ks
        Decoder s (StrictMaybe DRep -> UMElem)
-> Decoder s (StrictMaybe DRep) -> Decoder s UMElem
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s DRep -> Decoder s (StrictMaybe DRep)
forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeStrictMaybe (Share DRep -> Decoder s DRep
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s. Share DRep -> Decoder s DRep
decShareCBOR Share DRep
Interns (Credential 'DRepRole)
cd)

-- | 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 -> (StrictMaybe RDPair
forall a. StrictMaybe a
SNothing, Set Ptr
forall a. Set a
Set.empty, StrictMaybe (KeyHash 'StakePool)
forall a. StrictMaybe a
SNothing, StrictMaybe DRep
forall a. StrictMaybe a
SNothing)
  TEEEF DRep
v -> (StrictMaybe RDPair
forall a. StrictMaybe a
SNothing, Set Ptr
forall a. Set a
Set.empty, StrictMaybe (KeyHash 'StakePool)
forall a. StrictMaybe a
SNothing, DRep -> StrictMaybe DRep
forall a. a -> StrictMaybe a
SJust DRep
v)
  TEEFE KeyHash 'StakePool
s -> (StrictMaybe RDPair
forall a. StrictMaybe a
SNothing, Set Ptr
forall a. Set a
Set.empty, KeyHash 'StakePool -> StrictMaybe (KeyHash 'StakePool)
forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool
s, StrictMaybe DRep
forall a. StrictMaybe a
SNothing)
  TEEFF KeyHash 'StakePool
s DRep
v -> (StrictMaybe RDPair
forall a. StrictMaybe a
SNothing, Set Ptr
forall a. Set a
Set.empty, KeyHash 'StakePool -> StrictMaybe (KeyHash 'StakePool)
forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool
s, DRep -> StrictMaybe DRep
forall a. a -> StrictMaybe a
SJust DRep
v)
  TEFEE Set Ptr
p -> (StrictMaybe RDPair
forall a. StrictMaybe a
SNothing, Set Ptr
p, StrictMaybe (KeyHash 'StakePool)
forall a. StrictMaybe a
SNothing, StrictMaybe DRep
forall a. StrictMaybe a
SNothing)
  TEFEF Set Ptr
p DRep
v -> (StrictMaybe RDPair
forall a. StrictMaybe a
SNothing, Set Ptr
p, StrictMaybe (KeyHash 'StakePool)
forall a. StrictMaybe a
SNothing, DRep -> StrictMaybe DRep
forall a. a -> StrictMaybe a
SJust DRep
v)
  TEFFE Set Ptr
p KeyHash 'StakePool
s -> (StrictMaybe RDPair
forall a. StrictMaybe a
SNothing, Set Ptr
p, KeyHash 'StakePool -> StrictMaybe (KeyHash 'StakePool)
forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool
s, StrictMaybe DRep
forall a. StrictMaybe a
SNothing)
  TEFFF Set Ptr
p KeyHash 'StakePool
s DRep
v -> (StrictMaybe RDPair
forall a. StrictMaybe a
SNothing, Set Ptr
p, KeyHash 'StakePool -> StrictMaybe (KeyHash 'StakePool)
forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool
s, DRep -> StrictMaybe DRep
forall a. a -> StrictMaybe a
SJust DRep
v)
  TFEEE RDPair
r -> (RDPair -> StrictMaybe RDPair
forall a. a -> StrictMaybe a
SJust RDPair
r, Set Ptr
forall a. Set a
Set.empty, StrictMaybe (KeyHash 'StakePool)
forall a. StrictMaybe a
SNothing, StrictMaybe DRep
forall a. StrictMaybe a
SNothing)
  TFEEF RDPair
r DRep
v -> (RDPair -> StrictMaybe RDPair
forall a. a -> StrictMaybe a
SJust RDPair
r, Set Ptr
forall a. Set a
Set.empty, StrictMaybe (KeyHash 'StakePool)
forall a. StrictMaybe a
SNothing, DRep -> StrictMaybe DRep
forall a. a -> StrictMaybe a
SJust DRep
v)
  TFEFE RDPair
r KeyHash 'StakePool
s -> (RDPair -> StrictMaybe RDPair
forall a. a -> StrictMaybe a
SJust RDPair
r, Set Ptr
forall a. Set a
Set.empty, KeyHash 'StakePool -> StrictMaybe (KeyHash 'StakePool)
forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool
s, StrictMaybe DRep
forall a. StrictMaybe a
SNothing)
  TFEFF RDPair
r KeyHash 'StakePool
s DRep
v -> (RDPair -> StrictMaybe RDPair
forall a. a -> StrictMaybe a
SJust RDPair
r, Set Ptr
forall a. Set a
Set.empty, KeyHash 'StakePool -> StrictMaybe (KeyHash 'StakePool)
forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool
s, DRep -> StrictMaybe DRep
forall a. a -> StrictMaybe a
SJust DRep
v)
  TFFEE RDPair
r Set Ptr
p -> (RDPair -> StrictMaybe RDPair
forall a. a -> StrictMaybe a
SJust RDPair
r, Set Ptr
p, StrictMaybe (KeyHash 'StakePool)
forall a. StrictMaybe a
SNothing, StrictMaybe DRep
forall a. StrictMaybe a
SNothing)
  TFFEF RDPair
r Set Ptr
p DRep
v -> (RDPair -> StrictMaybe RDPair
forall a. a -> StrictMaybe a
SJust RDPair
r, Set Ptr
p, StrictMaybe (KeyHash 'StakePool)
forall a. StrictMaybe a
SNothing, DRep -> StrictMaybe DRep
forall a. a -> StrictMaybe a
SJust DRep
v)
  TFFFE RDPair
r Set Ptr
p KeyHash 'StakePool
s -> (RDPair -> StrictMaybe RDPair
forall a. a -> StrictMaybe a
SJust RDPair
r, Set Ptr
p, KeyHash 'StakePool -> StrictMaybe (KeyHash 'StakePool)
forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool
s, StrictMaybe DRep
forall a. StrictMaybe a
SNothing)
  TFFFF RDPair
r Set Ptr
p KeyHash 'StakePool
s DRep
v -> (RDPair -> StrictMaybe RDPair
forall a. a -> StrictMaybe a
SJust RDPair
r, Set Ptr
p, KeyHash 'StakePool -> StrictMaybe (KeyHash 'StakePool)
forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool
s, DRep -> StrictMaybe DRep
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 :: RDPair -> CompactForm Coin
rdReward :: CompactForm Coin
rdReward} DRep
dRep -> (CompactForm Coin, DRep) -> Maybe (CompactForm Coin, DRep)
forall a. a -> Maybe a
Just (CompactForm Coin
rdReward, DRep
dRep)
  TFEFF RDPair {CompactForm Coin
rdReward :: RDPair -> CompactForm Coin
rdReward :: CompactForm Coin
rdReward} KeyHash 'StakePool
_ DRep
dRep -> (CompactForm Coin, DRep) -> Maybe (CompactForm Coin, DRep)
forall a. a -> Maybe a
Just (CompactForm Coin
rdReward, DRep
dRep)
  TFFEF RDPair {CompactForm Coin
rdReward :: RDPair -> CompactForm Coin
rdReward :: CompactForm Coin
rdReward} Set Ptr
_ DRep
dRep -> (CompactForm Coin, DRep) -> Maybe (CompactForm Coin, DRep)
forall a. a -> Maybe a
Just (CompactForm Coin
rdReward, DRep
dRep)
  TFFFF RDPair {CompactForm Coin
rdReward :: RDPair -> CompactForm Coin
rdReward :: CompactForm Coin
rdReward} Set Ptr
_ KeyHash 'StakePool
_ DRep
dRep -> (CompactForm Coin, DRep) -> Maybe (CompactForm Coin, DRep)
forall a. a -> Maybe a
Just (CompactForm Coin
rdReward, DRep
dRep)
  UMElem
_ -> Maybe (CompactForm Coin, DRep)
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
_ -> RDPair -> Maybe RDPair
forall a. a -> Maybe a
Just RDPair
rdA
  TFEFF RDPair
rdA KeyHash 'StakePool
_ DRep
_ -> RDPair -> Maybe RDPair
forall a. a -> Maybe a
Just RDPair
rdA
  TFFFE RDPair
rdA Set Ptr
_ KeyHash 'StakePool
_ -> RDPair -> Maybe RDPair
forall a. a -> Maybe a
Just RDPair
rdA
  TFFFF RDPair
rdA Set Ptr
_ KeyHash 'StakePool
_ DRep
_ -> RDPair -> Maybe RDPair
forall a. a -> Maybe a
Just RDPair
rdA
  UMElem
_ -> Maybe RDPair
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 = CompactForm Coin
-> (RDPair -> CompactForm Coin)
-> StrictMaybe RDPair
-> CompactForm Coin
forall a b. a -> (b -> a) -> StrictMaybe b -> a
strictMaybe CompactForm Coin
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) -> RewardDelegation -> Maybe RewardDelegation
forall a. a -> Maybe a
Just (RewardDelegation -> Maybe RewardDelegation)
-> RewardDelegation -> Maybe RewardDelegation
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) -> RewardDelegation -> Maybe RewardDelegation
forall a. a -> Maybe a
Just (RewardDelegation -> Maybe RewardDelegation)
-> RewardDelegation -> Maybe RewardDelegation
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) -> RewardDelegation -> Maybe RewardDelegation
forall a. a -> Maybe a
Just (RewardDelegation -> Maybe RewardDelegation)
-> RewardDelegation -> Maybe RewardDelegation
forall a b. (a -> b) -> a -> b
$ DRep -> CompactForm Coin -> RewardDelegation
RewardDelegationDRep DRep
drep CompactForm Coin
reward
        (StrictMaybe (KeyHash 'StakePool)
SNothing, StrictMaybe DRep
SNothing) -> Maybe RewardDelegation
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 -> RDPair -> Maybe RDPair
forall a. a -> Maybe a
Just RDPair
r
  TFEEF RDPair
r DRep
_ -> RDPair -> Maybe RDPair
forall a. a -> Maybe a
Just RDPair
r
  TFEFE RDPair
r KeyHash 'StakePool
_ -> RDPair -> Maybe RDPair
forall a. a -> Maybe a
Just RDPair
r
  TFEFF RDPair
r KeyHash 'StakePool
_ DRep
_ -> RDPair -> Maybe RDPair
forall a. a -> Maybe a
Just RDPair
r
  TFFEE RDPair
r Set Ptr
_ -> RDPair -> Maybe RDPair
forall a. a -> Maybe a
Just RDPair
r
  TFFEF RDPair
r Set Ptr
_ DRep
_ -> RDPair -> Maybe RDPair
forall a. a -> Maybe a
Just RDPair
r
  TFFFE RDPair
r Set Ptr
_ KeyHash 'StakePool
_ -> RDPair -> Maybe RDPair
forall a. a -> Maybe a
Just RDPair
r
  TFFFF RDPair
r Set Ptr
_ KeyHash 'StakePool
_ DRep
_ -> RDPair -> Maybe RDPair
forall a. a -> Maybe a
Just RDPair
r
  UMElem
_ -> Maybe RDPair
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 (Set Ptr -> Bool
forall a. Set a -> Bool
Set.null Set Ptr
p) -> Set Ptr -> Maybe (Set Ptr)
forall a. a -> Maybe a
Just Set Ptr
p
  TEFEF Set Ptr
p DRep
_ | Bool -> Bool
not (Set Ptr -> Bool
forall a. Set a -> Bool
Set.null Set Ptr
p) -> Set Ptr -> Maybe (Set Ptr)
forall a. a -> Maybe a
Just Set Ptr
p
  TEFFE Set Ptr
p KeyHash 'StakePool
_ | Bool -> Bool
not (Set Ptr -> Bool
forall a. Set a -> Bool
Set.null Set Ptr
p) -> Set Ptr -> Maybe (Set Ptr)
forall a. a -> Maybe a
Just Set Ptr
p
  TEFFF Set Ptr
p KeyHash 'StakePool
_ DRep
_ | Bool -> Bool
not (Set Ptr -> Bool
forall a. Set a -> Bool
Set.null Set Ptr
p) -> Set Ptr -> Maybe (Set Ptr)
forall a. a -> Maybe a
Just Set Ptr
p
  TFFEE RDPair
_ Set Ptr
p | Bool -> Bool
not (Set Ptr -> Bool
forall a. Set a -> Bool
Set.null Set Ptr
p) -> Set Ptr -> Maybe (Set Ptr)
forall a. a -> Maybe a
Just Set Ptr
p
  TFFEF RDPair
_ Set Ptr
p DRep
_ | Bool -> Bool
not (Set Ptr -> Bool
forall a. Set a -> Bool
Set.null Set Ptr
p) -> Set Ptr -> Maybe (Set Ptr)
forall a. a -> Maybe a
Just Set Ptr
p
  TFFFE RDPair
_ Set Ptr
p KeyHash 'StakePool
_ | Bool -> Bool
not (Set Ptr -> Bool
forall a. Set a -> Bool
Set.null Set Ptr
p) -> Set Ptr -> Maybe (Set Ptr)
forall a. a -> Maybe a
Just Set Ptr
p
  TFFFF RDPair
_ Set Ptr
p KeyHash 'StakePool
_ DRep
_ | Bool -> Bool
not (Set Ptr -> Bool
forall a. Set a -> Bool
Set.null Set Ptr
p) -> Set Ptr -> Maybe (Set Ptr)
forall a. a -> Maybe a
Just Set Ptr
p
  UMElem
_ -> Maybe (Set Ptr)
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 -> KeyHash 'StakePool -> Maybe (KeyHash 'StakePool)
forall a. a -> Maybe a
Just KeyHash 'StakePool
s
  TEEFF KeyHash 'StakePool
s DRep
_ -> KeyHash 'StakePool -> Maybe (KeyHash 'StakePool)
forall a. a -> Maybe a
Just KeyHash 'StakePool
s
  TEFFE Set Ptr
_ KeyHash 'StakePool
s -> KeyHash 'StakePool -> Maybe (KeyHash 'StakePool)
forall a. a -> Maybe a
Just KeyHash 'StakePool
s
  TEFFF Set Ptr
_ KeyHash 'StakePool
s DRep
_ -> KeyHash 'StakePool -> Maybe (KeyHash 'StakePool)
forall a. a -> Maybe a
Just KeyHash 'StakePool
s
  TFEFE RDPair
_ KeyHash 'StakePool
s -> KeyHash 'StakePool -> Maybe (KeyHash 'StakePool)
forall a. a -> Maybe a
Just KeyHash 'StakePool
s
  TFEFF RDPair
_ KeyHash 'StakePool
s DRep
_ -> KeyHash 'StakePool -> Maybe (KeyHash 'StakePool)
forall a. a -> Maybe a
Just KeyHash 'StakePool
s
  TFFFE RDPair
_ Set Ptr
_ KeyHash 'StakePool
s -> KeyHash 'StakePool -> Maybe (KeyHash 'StakePool)
forall a. a -> Maybe a
Just KeyHash 'StakePool
s
  TFFFF RDPair
_ Set Ptr
_ KeyHash 'StakePool
s DRep
_ -> KeyHash 'StakePool -> Maybe (KeyHash 'StakePool)
forall a. a -> Maybe a
Just KeyHash 'StakePool
s
  UMElem
_ -> Maybe (KeyHash 'StakePool)
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 -> DRep -> Maybe DRep
forall a. a -> Maybe a
Just DRep
d
  TEEFF KeyHash 'StakePool
_ DRep
d -> DRep -> Maybe DRep
forall a. a -> Maybe a
Just DRep
d
  TEFEF Set Ptr
_ DRep
d -> DRep -> Maybe DRep
forall a. a -> Maybe a
Just DRep
d
  TEFFF Set Ptr
_ KeyHash 'StakePool
_ DRep
d -> DRep -> Maybe DRep
forall a. a -> Maybe a
Just DRep
d
  TFEEF RDPair
_ DRep
d -> DRep -> Maybe DRep
forall a. a -> Maybe a
Just DRep
d
  TFEFF RDPair
_ KeyHash 'StakePool
_ DRep
d -> DRep -> Maybe DRep
forall a. a -> Maybe a
Just DRep
d
  TFFEF RDPair
_ Set Ptr
_ DRep
d -> DRep -> Maybe DRep
forall a. a -> Maybe a
Just DRep
d
  TFFFF RDPair
_ Set Ptr
_ KeyHash 'StakePool
_ DRep
d -> DRep -> Maybe DRep
forall a. a -> Maybe a
Just DRep
d
  UMElem
_ -> Maybe DRep
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 $mUMElem :: forall {r}.
UMElem
-> (StrictMaybe RDPair
    -> Set Ptr
    -> StrictMaybe (KeyHash 'StakePool)
    -> StrictMaybe DRep
    -> r)
-> ((# #) -> r)
-> r
$bUMElem :: StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
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
(Int -> UMap -> ShowS)
-> (UMap -> String) -> ([UMap] -> ShowS) -> Show UMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UMap -> ShowS
showsPrec :: Int -> UMap -> ShowS
$cshow :: UMap -> String
show :: UMap -> String
$cshowList :: [UMap] -> ShowS
showList :: [UMap] -> ShowS
Show, UMap -> UMap -> Bool
(UMap -> UMap -> Bool) -> (UMap -> UMap -> Bool) -> Eq UMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UMap -> UMap -> Bool
== :: UMap -> UMap -> Bool
$c/= :: UMap -> UMap -> Bool
/= :: UMap -> UMap -> Bool
Eq, (forall x. UMap -> Rep UMap x)
-> (forall x. Rep UMap x -> UMap) -> Generic UMap
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
$cfrom :: forall x. UMap -> Rep UMap x
from :: forall x. UMap -> Rep UMap x
$cto :: forall x. Rep UMap x -> UMap
to :: forall x. Rep UMap x -> UMap
Generic, Context -> UMap -> IO (Maybe ThunkInfo)
Proxy UMap -> String
(Context -> UMap -> IO (Maybe ThunkInfo))
-> (Context -> UMap -> IO (Maybe ThunkInfo))
-> (Proxy UMap -> String)
-> NoThunks UMap
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> UMap -> IO (Maybe ThunkInfo)
noThunks :: Context -> UMap -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UMap -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> UMap -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy UMap -> String
showTypeOf :: Proxy UMap -> String
NoThunks, UMap -> ()
(UMap -> ()) -> NFData UMap
forall a. (a -> ()) -> NFData a
$crnf :: UMap -> ()
rnf :: UMap -> ()
NFData)

umElemsL :: Lens' UMap (Map (Credential 'Staking) UMElem)
umElemsL :: Lens' UMap (Map (Credential 'Staking) UMElem)
umElemsL = (UMap -> Map (Credential 'Staking) UMElem)
-> (UMap -> Map (Credential 'Staking) UMElem -> UMap)
-> Lens' UMap (Map (Credential 'Staking) UMElem)
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 = 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
(Int -> StakeCredentials -> ShowS)
-> (StakeCredentials -> String)
-> ([StakeCredentials] -> ShowS)
-> Show StakeCredentials
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StakeCredentials -> ShowS
showsPrec :: Int -> StakeCredentials -> ShowS
$cshow :: StakeCredentials -> String
show :: StakeCredentials -> String
$cshowList :: [StakeCredentials] -> ShowS
showList :: [StakeCredentials] -> ShowS
Show, StakeCredentials -> StakeCredentials -> Bool
(StakeCredentials -> StakeCredentials -> Bool)
-> (StakeCredentials -> StakeCredentials -> Bool)
-> Eq StakeCredentials
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StakeCredentials -> StakeCredentials -> Bool
== :: StakeCredentials -> StakeCredentials -> Bool
$c/= :: StakeCredentials -> StakeCredentials -> Bool
/= :: StakeCredentials -> StakeCredentials -> Bool
Eq, (forall x. StakeCredentials -> Rep StakeCredentials x)
-> (forall x. Rep StakeCredentials x -> StakeCredentials)
-> Generic StakeCredentials
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
$cfrom :: forall x. StakeCredentials -> Rep StakeCredentials x
from :: forall x. StakeCredentials -> Rep StakeCredentials x
$cto :: forall x. Rep StakeCredentials x -> StakeCredentials
to :: forall x. Rep StakeCredentials x -> StakeCredentials
Generic, Context -> StakeCredentials -> IO (Maybe ThunkInfo)
Proxy StakeCredentials -> String
(Context -> StakeCredentials -> IO (Maybe ThunkInfo))
-> (Context -> StakeCredentials -> IO (Maybe ThunkInfo))
-> (Proxy StakeCredentials -> String)
-> NoThunks StakeCredentials
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> StakeCredentials -> IO (Maybe ThunkInfo)
noThunks :: Context -> StakeCredentials -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> StakeCredentials -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> StakeCredentials -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy StakeCredentials -> String
showTypeOf :: Proxy StakeCredentials -> String
NoThunks, StakeCredentials -> ()
(StakeCredentials -> ()) -> NFData StakeCredentials
forall a. (a -> ()) -> NFData a
$crnf :: StakeCredentials -> ()
rnf :: StakeCredentials -> ()
NFData)

instance ToJSON UMap where
  toJSON :: UMap -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value) -> (UMap -> [Pair]) -> UMap -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMap -> [Pair]
forall e a. KeyValue e a => UMap -> [a]
toUMapPair
  toEncoding :: UMap -> Encoding
toEncoding = Series -> Encoding
Aeson.pairs (Series -> Encoding) -> (UMap -> Series) -> UMap -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series) -> (UMap -> [Series]) -> UMap -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMap -> [Series]
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" Key -> Map (Credential 'Staking) UMElem -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (Credential 'Staking) UMElem
m1
  , Key
"pointers" Key -> Map Ptr (Credential 'Staking) -> a
forall v. ToJSON v => Key -> v -> a
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Credential 'Staking -> Encoding)
-> (UMElem -> Encoding)
-> Map (Credential 'Staking) UMElem
-> Encoding
forall k v.
(k -> Encoding) -> (v -> Encoding) -> Map k v -> Encoding
encodeMap Credential 'Staking -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR UMElem -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Map (Credential 'Staking) UMElem
umElems Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Ptr -> Encoding)
-> (Credential 'Staking -> Encoding)
-> Map Ptr (Credential 'Staking)
-> Encoding
forall k v.
(k -> Encoding) -> (v -> Encoding) -> Map k v -> Encoding
encodeMap Ptr -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Credential 'Staking -> Encoding
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), Interns (Credential 'DRepRole))
  decSharePlusCBOR :: forall s. StateT (Share UMap) (Decoder s) UMap
decSharePlusCBOR =
    ((Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
  Interns (Credential 'DRepRole))
 -> Decoder
      s
      (UMap,
       (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
        Interns (Credential 'DRepRole))))
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole))
     (Decoder s)
     UMap
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT
      ( \(Interns (Credential 'Staking)
a, Interns (KeyHash 'StakePool)
b, Interns (Credential 'DRepRole)
c) ->
          Text
-> ((UMap,
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole)))
    -> Int)
-> Decoder
     s
     (UMap,
      (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
       Interns (Credential 'DRepRole)))
-> Decoder
     s
     (UMap,
      (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
       Interns (Credential 'DRepRole)))
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"UMap" (Int
-> (UMap,
    (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
     Interns (Credential 'DRepRole)))
-> Int
forall a b. a -> b -> a
const Int
2) (Decoder
   s
   (UMap,
    (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
     Interns (Credential 'DRepRole)))
 -> Decoder
      s
      (UMap,
       (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
        Interns (Credential 'DRepRole))))
-> Decoder
     s
     (UMap,
      (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
       Interns (Credential 'DRepRole)))
-> Decoder
     s
     (UMap,
      (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
       Interns (Credential 'DRepRole)))
forall a b. (a -> b) -> a -> b
$ do
            Map (Credential 'Staking) UMElem
umElems <- Decoder s (Credential 'Staking)
-> Decoder s UMElem -> Decoder s (Map (Credential 'Staking) UMElem)
forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap (Interns (Credential 'Staking)
-> Credential 'Staking -> Credential 'Staking
forall k. Interns k -> k -> k
interns Interns (Credential 'Staking)
a (Credential 'Staking -> Credential 'Staking)
-> Decoder s (Credential 'Staking)
-> Decoder s (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Credential 'Staking)
forall s. Decoder s (Credential 'Staking)
forall a s. DecCBOR a => Decoder s a
decCBOR) (Share UMElem -> Decoder s UMElem
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s. Share UMElem -> Decoder s UMElem
decShareCBOR (Interns (KeyHash 'StakePool)
b, Interns (Credential 'DRepRole)
c))
            let a' :: Interns (Credential 'Staking)
a' = Map (Credential 'Staking) UMElem -> Interns (Credential 'Staking)
forall k a. Ord k => Map k a -> Interns k
internsFromMap Map (Credential 'Staking) UMElem
umElems Interns (Credential 'Staking)
-> Interns (Credential 'Staking) -> Interns (Credential 'Staking)
forall a. Semigroup a => a -> a -> a
<> Interns (Credential 'Staking)
a
                decodePtrNormalized :: Decoder s Ptr
decodePtrNormalized =
                  Text -> (Ptr -> Int) -> Decoder s Ptr -> Decoder s Ptr
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"Ptr" (Int -> Ptr -> Int
forall a b. a -> b -> a
const Int
3) (Decoder s Ptr -> Decoder s Ptr) -> Decoder s Ptr -> Decoder s Ptr
forall a b. (a -> b) -> a -> b
$
                    Word64 -> Word64 -> Word64 -> Ptr
mkPtrNormalized (Word64 -> Word64 -> Word64 -> Ptr)
-> Decoder s Word64 -> Decoder s (Word64 -> Word64 -> Ptr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall s. Decoder s Word64
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (Word64 -> Word64 -> Ptr)
-> Decoder s Word64 -> Decoder s (Word64 -> Ptr)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Word64
forall s. Decoder s Word64
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (Word64 -> Ptr) -> Decoder s Word64 -> Decoder s Ptr
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Word64
forall s. Decoder s Word64
forall a s. DecCBOR a => Decoder s a
decCBOR
                decDropPtrMap :: Decoder s (Map Ptr (Credential 'Staking))
decDropPtrMap = do
                  Map Ptr (Credential 'Staking)
m <- Decoder s Ptr
-> Decoder s (Credential 'Staking)
-> Decoder s (Map Ptr (Credential 'Staking))
forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap Decoder s Ptr
forall {s}. Decoder s Ptr
decodePtrNormalized Decoder s (Credential 'Staking)
forall s. Decoder s (Credential 'Staking)
forall a s. DecCBOR a => Decoder s a
decCBOR
                  -- ensure that we are dropping the same type as needed for decoding
                  let idConst :: a -> a -> a
                      idConst :: forall a. a -> a -> a
idConst = a -> a -> a
forall a b. a -> b -> a
const
                  Map Ptr (Credential 'Staking)
-> Decoder s (Map Ptr (Credential 'Staking))
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Ptr (Credential 'Staking)
 -> Decoder s (Map Ptr (Credential 'Staking)))
-> Map Ptr (Credential 'Staking)
-> Decoder s (Map Ptr (Credential 'Staking))
forall a b. (a -> b) -> a -> b
$ Map Ptr (Credential 'Staking)
-> Map Ptr (Credential 'Staking) -> Map Ptr (Credential 'Staking)
forall a. a -> a -> a
idConst Map Ptr (Credential 'Staking)
forall a. Monoid a => a
mempty Map Ptr (Credential 'Staking)
m
            Map Ptr (Credential 'Staking)
umPtrs <-
              Version
-> Decoder s (Map Ptr (Credential 'Staking))
-> Decoder s (Map Ptr (Credential 'Staking))
-> Decoder s (Map Ptr (Credential 'Staking))
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) Decoder s (Map Ptr (Credential 'Staking))
forall {s}. Decoder s (Map Ptr (Credential 'Staking))
decDropPtrMap (Decoder s (Map Ptr (Credential 'Staking))
 -> Decoder s (Map Ptr (Credential 'Staking)))
-> Decoder s (Map Ptr (Credential 'Staking))
-> Decoder s (Map Ptr (Credential 'Staking))
forall a b. (a -> b) -> a -> b
$
                Decoder s Ptr
-> Decoder s (Credential 'Staking)
-> Decoder s (Map Ptr (Credential 'Staking))
forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap Decoder s Ptr
forall {s}. Decoder s Ptr
forall a s. DecCBOR a => Decoder s a
decCBOR (Interns (Credential 'Staking)
-> Credential 'Staking -> Credential 'Staking
forall k. Interns k -> k -> k
interns Interns (Credential 'Staking)
a' (Credential 'Staking -> Credential 'Staking)
-> Decoder s (Credential 'Staking)
-> Decoder s (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Credential 'Staking)
forall s. Decoder s (Credential 'Staking)
forall a s. DecCBOR a => Decoder s a
decCBOR)
            (UMap,
 (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
  Interns (Credential 'DRepRole)))
-> Decoder
     s
     (UMap,
      (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
       Interns (Credential 'DRepRole)))
forall a. a -> Decoder s a
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, Interns (Credential 'DRepRole)
c))
      )

-- | 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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} = Bool
forwards Bool -> Bool -> Bool
&& Bool
backwards
  where
    forwards :: Bool
forwards =
      case Credential 'Staking
-> Map (Credential 'Staking) UMElem -> Maybe UMElem
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 Credential 'Staking -> Map Ptr (Credential 'Staking) -> Bool
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 (Ptr -> Set Ptr -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Ptr
ptr Set Ptr
ptrSet)
            Bool -> Bool -> Bool
|| ( case Ptr -> Map Ptr (Credential 'Staking) -> Maybe (Credential 'Staking)
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 Credential 'Staking -> Credential 'Staking -> Bool
forall a. Eq a => a -> a -> Bool
== Credential 'Staking
cred2
               )
    backwards :: Bool
backwards =
      case Ptr -> Map Ptr (Credential 'Staking) -> Maybe (Credential 'Staking)
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 -> (UMElem -> Bool) -> Map (Credential 'Staking) UMElem -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(UMElem StrictMaybe RDPair
_ Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
_ StrictMaybe DRep
_) -> Ptr -> Set Ptr -> Bool
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 Credential 'Staking
-> Map (Credential 'Staking) UMElem -> Maybe UMElem
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
_) -> Ptr -> Set Ptr -> Bool
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (UMElem -> Maybe v) -> Map k UMElem -> Map k v
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe UMElem -> Maybe v
UMElem -> Maybe RDPair
umElemRDPair Map k UMElem
Map (Credential 'Staking) UMElem
umElems
  PtrUView UMap {Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} -> Map k v
Map Ptr (Credential 'Staking)
umPtrs
  SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (UMElem -> Maybe v) -> Map k UMElem -> Map k v
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe UMElem -> Maybe v
UMElem -> Maybe (KeyHash 'StakePool)
umElemSPool Map k UMElem
Map (Credential 'Staking) UMElem
umElems
  DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (UMElem -> Maybe v) -> Map k UMElem -> Map k v
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe UMElem -> Maybe v
UMElem -> Maybe DRep
umElemDRep Map k UMElem
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} ->
    Int -> [(k, v)] -> VMap VB VB k v
forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
Int -> [(k, v)] -> VMap kv vv k v
VMap.fromListN (UView k v -> Int
forall k v. UView k v -> Int
size UView k v
uview) ([(k, v)] -> VMap VB VB k v)
-> (Map (Credential 'Staking) UMElem -> [(k, v)])
-> Map (Credential 'Staking) UMElem
-> VMap VB VB k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, UMElem) -> Maybe (k, v)) -> [(k, UMElem)] -> [(k, v)]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe (k, UMElem) -> Maybe (k, v)
(k, UMElem) -> Maybe (k, RDPair)
forall {a}. (a, UMElem) -> Maybe (a, RDPair)
toRDPair ([(k, UMElem)] -> [(k, v)])
-> (Map (Credential 'Staking) UMElem -> [(k, UMElem)])
-> Map (Credential 'Staking) UMElem
-> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Credential 'Staking) UMElem -> [(k, UMElem)]
Map (Credential 'Staking) UMElem -> [(Credential 'Staking, UMElem)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map (Credential 'Staking) UMElem -> VMap VB VB k v)
-> Map (Credential 'Staking) UMElem -> VMap VB VB k v
forall a b. (a -> b) -> a -> b
$ Map (Credential 'Staking) UMElem
umElems
  PtrUView UMap {Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} -> Map k v -> VMap VB VB k v
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap Map k v
Map Ptr (Credential 'Staking)
umPtrs
  SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} ->
    Int -> [(k, v)] -> VMap VB VB k v
forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
Int -> [(k, v)] -> VMap kv vv k v
VMap.fromListN (UView k v -> Int
forall k v. UView k v -> Int
size UView k v
uview) ([(k, v)] -> VMap VB VB k v)
-> (Map (Credential 'Staking) UMElem -> [(k, v)])
-> Map (Credential 'Staking) UMElem
-> VMap VB VB k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, UMElem) -> Maybe (k, v)) -> [(k, UMElem)] -> [(k, v)]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe (k, UMElem) -> Maybe (k, v)
(k, UMElem) -> Maybe (k, KeyHash 'StakePool)
forall {a}. (a, UMElem) -> Maybe (a, KeyHash 'StakePool)
toSPool ([(k, UMElem)] -> [(k, v)])
-> (Map (Credential 'Staking) UMElem -> [(k, UMElem)])
-> Map (Credential 'Staking) UMElem
-> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Credential 'Staking) UMElem -> [(k, UMElem)]
Map (Credential 'Staking) UMElem -> [(Credential 'Staking, UMElem)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map (Credential 'Staking) UMElem -> VMap VB VB k v)
-> Map (Credential 'Staking) UMElem -> VMap VB VB k v
forall a b. (a -> b) -> a -> b
$ Map (Credential 'Staking) UMElem
umElems
  DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} ->
    Int -> [(k, v)] -> VMap VB VB k v
forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
Int -> [(k, v)] -> VMap kv vv k v
VMap.fromListN (UView k v -> Int
forall k v. UView k v -> Int
size UView k v
uview) ([(k, v)] -> VMap VB VB k v)
-> (Map (Credential 'Staking) UMElem -> [(k, v)])
-> Map (Credential 'Staking) UMElem
-> VMap VB VB k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, UMElem) -> Maybe (k, v)) -> [(k, UMElem)] -> [(k, v)]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe (k, UMElem) -> Maybe (k, v)
(k, UMElem) -> Maybe (k, DRep)
forall {a}. (a, UMElem) -> Maybe (a, DRep)
toDRep ([(k, UMElem)] -> [(k, v)])
-> (Map (Credential 'Staking) UMElem -> [(k, UMElem)])
-> Map (Credential 'Staking) UMElem
-> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Credential 'Staking) UMElem -> [(k, UMElem)]
Map (Credential 'Staking) UMElem -> [(Credential 'Staking, UMElem)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map (Credential 'Staking) UMElem -> VMap VB VB k v)
-> Map (Credential 'Staking) UMElem -> VMap VB VB k v
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 (RDPair -> (a, RDPair)) -> Maybe RDPair -> Maybe (a, RDPair)
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 (KeyHash 'StakePool -> (a, KeyHash 'StakePool))
-> Maybe (KeyHash 'StakePool) -> Maybe (a, KeyHash 'StakePool)
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 (DRep -> (a, DRep)) -> Maybe DRep -> Maybe (a, DRep)
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 = UView (Credential 'Staking) RDPair
-> Map (Credential 'Staking) RDPair
forall k v. UView k v -> Map k v
unUnify (UView (Credential 'Staking) RDPair
 -> Map (Credential 'Staking) RDPair)
-> UView (Credential 'Staking) RDPair
-> Map (Credential 'Staking) RDPair
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 = (RDPair -> Coin)
-> Map (Credential 'Staking) RDPair
-> Map (Credential 'Staking) Coin
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm Coin -> Coin)
-> (RDPair -> CompactForm Coin) -> RDPair -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDPair -> CompactForm Coin
rdReward) (Map (Credential 'Staking) RDPair
 -> Map (Credential 'Staking) Coin)
-> Map (Credential 'Staking) RDPair
-> Map (Credential 'Staking) Coin
forall a b. (a -> b) -> a -> b
$ UView (Credential 'Staking) RDPair
-> Map (Credential 'Staking) RDPair
forall k v. UView k v -> Map k v
unUnify (UView (Credential 'Staking) RDPair
 -> Map (Credential 'Staking) RDPair)
-> UView (Credential 'Staking) RDPair
-> Map (Credential 'Staking) RDPair
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 = (RDPair -> CompactForm Coin)
-> Map (Credential 'Staking) RDPair
-> Map (Credential 'Staking) (CompactForm Coin)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map RDPair -> CompactForm Coin
rdReward (Map (Credential 'Staking) RDPair
 -> Map (Credential 'Staking) (CompactForm Coin))
-> Map (Credential 'Staking) RDPair
-> Map (Credential 'Staking) (CompactForm Coin)
forall a b. (a -> b) -> a -> b
$ UView (Credential 'Staking) RDPair
-> Map (Credential 'Staking) RDPair
forall k v. UView k v -> Map k v
unUnify (UView (Credential 'Staking) RDPair
 -> Map (Credential 'Staking) RDPair)
-> UView (Credential 'Staking) RDPair
-> Map (Credential 'Staking) RDPair
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 = (RDPair -> Coin)
-> Map (Credential 'Staking) RDPair
-> Map (Credential 'Staking) Coin
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm Coin -> Coin)
-> (RDPair -> CompactForm Coin) -> RDPair -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDPair -> CompactForm Coin
rdDeposit) (Map (Credential 'Staking) RDPair
 -> Map (Credential 'Staking) Coin)
-> Map (Credential 'Staking) RDPair
-> Map (Credential 'Staking) Coin
forall a b. (a -> b) -> a -> b
$ UView (Credential 'Staking) RDPair
-> Map (Credential 'Staking) RDPair
forall k v. UView k v -> Map k v
unUnify (UView (Credential 'Staking) RDPair
 -> Map (Credential 'Staking) RDPair)
-> UView (Credential 'Staking) RDPair
-> Map (Credential 'Staking) RDPair
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 = UView Ptr (Credential 'Staking) -> Map Ptr (Credential 'Staking)
forall k v. UView k v -> Map k v
unUnify (UView Ptr (Credential 'Staking) -> Map Ptr (Credential 'Staking))
-> UView Ptr (Credential 'Staking) -> Map Ptr (Credential 'Staking)
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} =
  (Map (Credential 'Staking) (Set Ptr)
 -> Credential 'Staking
 -> UMElem
 -> Map (Credential 'Staking) (Set Ptr))
-> Map (Credential 'Staking) (Set Ptr)
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) (Set Ptr)
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 Set Ptr -> Bool
forall a. Set a -> Bool
Set.null Set Ptr
ptrSet then Map (Credential 'Staking) (Set Ptr)
ans else Credential 'Staking
-> Set Ptr
-> Map (Credential 'Staking) (Set Ptr)
-> Map (Credential 'Staking) (Set Ptr)
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)
    Map (Credential 'Staking) (Set Ptr)
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 = UView (Credential 'Staking) (KeyHash 'StakePool)
-> Map (Credential 'Staking) (KeyHash 'StakePool)
forall k v. UView k v -> Map k v
unUnify (UView (Credential 'Staking) (KeyHash 'StakePool)
 -> Map (Credential 'Staking) (KeyHash 'StakePool))
-> UView (Credential 'Staking) (KeyHash 'StakePool)
-> Map (Credential 'Staking) (KeyHash 'StakePool)
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 = UView (Credential 'Staking) DRep -> Map (Credential 'Staking) DRep
forall k v. UView k v -> Map k v
unUnify (UView (Credential 'Staking) DRep
 -> Map (Credential 'Staking) DRep)
-> UView (Credential 'Staking) DRep
-> Map (Credential 'Staking) DRep
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (UMElem -> Maybe v) -> Map k UMElem -> Map k v
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe UMElem -> Maybe v
UMElem -> Maybe RDPair
umElemRDPair (Map k UMElem -> Set k -> Map k UMElem
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map k UMElem
Map (Credential 'Staking) UMElem
umElems Set k
setk)
  PtrUView UMap {Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} -> Map k v -> Set k -> Map k v
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map k v
Map Ptr (Credential 'Staking)
umPtrs Set k
setk
  SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (UMElem -> Maybe v) -> Map k UMElem -> Map k v
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe UMElem -> Maybe v
UMElem -> Maybe (KeyHash 'StakePool)
umElemSPool (Map k UMElem -> Set k -> Map k UMElem
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map k UMElem
Map (Credential 'Staking) UMElem
umElems Set k
setk)
  DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (UMElem -> Maybe v) -> Map k UMElem -> Map k v
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe UMElem -> Maybe v
UMElem -> Maybe DRep
umElemDRep (Map k UMElem -> Set k -> Map k UMElem
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map k UMElem
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} =
  let umElems' :: Map (Credential 'Staking) UMElem
umElems' = Map (Credential 'Staking) UMElem
-> Set (Credential 'Staking) -> Map (Credential 'Staking) UMElem
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 = (UMElem -> Maybe (Set Ptr))
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) (Set Ptr)
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 = (UMElem -> Maybe Coin)
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) Coin
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (\UMElem
e -> CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm Coin -> Coin)
-> (RDPair -> CompactForm Coin) -> RDPair -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDPair -> CompactForm Coin
rdReward (RDPair -> Coin) -> Maybe RDPair -> Maybe Coin
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 = (UMElem -> Maybe Coin)
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) Coin
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (\UMElem
e -> CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm Coin -> Coin)
-> (RDPair -> CompactForm Coin) -> RDPair -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDPair -> CompactForm Coin
rdDeposit (RDPair -> Coin) -> Maybe RDPair -> Maybe Coin
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 = (UMElem -> Maybe (KeyHash 'StakePool))
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) (KeyHash 'StakePool)
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 = (UMElem -> Maybe DRep)
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) DRep
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 Map Ptr (Credential 'Staking)
-> Set Ptr -> Map Ptr (Credential 'Staking)
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Map (Credential 'Staking) (Set Ptr) -> Set Ptr
forall m. Monoid m => Map (Credential 'Staking) m -> m
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (m -> Credential 'Staking -> UMElem -> m)
-> m -> Map (Credential 'Staking) UMElem -> m
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey m -> Credential 'Staking -> UMElem -> m
accum m
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 m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
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 :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} -> (a -> m) -> Map Ptr a -> m
forall m a. Monoid m => (a -> m) -> Map Ptr a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Map Ptr a
Map Ptr (Credential 'Staking)
umPtrs
    SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (m -> Credential 'Staking -> UMElem -> m)
-> m -> Map (Credential 'Staking) UMElem -> m
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey m -> Credential 'Staking -> UMElem -> m
accum m
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 m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
KeyHash 'StakePool
sd
        accum m
ans Credential 'Staking
_ UMElem
_ = m
ans
    DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (m -> Credential 'Staking -> UMElem -> m)
-> m -> Map (Credential 'Staking) UMElem -> m
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey m -> Credential 'Staking -> UMElem -> m
accum m
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 m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (UMElem -> b -> b) -> b -> Map (Credential 'Staking) UMElem -> b
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 a
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 :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} -> (a -> b -> b) -> b -> Map Ptr a -> b
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr a -> b -> b
accum b
ans0 Map Ptr a
Map Ptr (Credential 'Staking)
umPtrs
    SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (UMElem -> b -> b) -> b -> Map (Credential 'Staking) UMElem -> b
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 a
KeyHash 'StakePool
sd b
ans
        accum' UMElem
_ b
ans = b
ans
    DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (UMElem -> b -> b) -> b -> Map (Credential 'Staking) UMElem -> b
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 a
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (b -> UMElem -> b) -> b -> Map (Credential 'Staking) UMElem -> b
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 = b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
ans (b -> a -> b
accum b
ans) (Maybe a -> b) -> (UMElem -> Maybe a) -> UMElem -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMElem -> Maybe a
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 :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} -> (b -> a -> b) -> b -> Map Ptr a -> b
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' b -> a -> b
accum b
ans0 Map Ptr a
Map Ptr (Credential 'Staking)
umPtrs
    SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (b -> UMElem -> b) -> b -> Map (Credential 'Staking) UMElem -> b
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 = b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
ans (b -> a -> b
accum b
ans) (Maybe a -> b) -> (UMElem -> Maybe a) -> UMElem -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMElem -> Maybe a
UMElem -> Maybe (KeyHash 'StakePool)
umElemSPool
    DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (b -> UMElem -> b) -> b -> Map (Credential 'Staking) UMElem -> b
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 = b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
ans (b -> a -> b
accum b
ans) (Maybe a -> b) -> (UMElem -> Maybe a) -> UMElem -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMElem -> Maybe a
UMElem -> Maybe DRep
umElemDRep

  length :: forall a. UView k a -> Int
length = UView k a -> Int
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 | Set Ptr -> Bool
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 -> Maybe UMElem
forall a. Maybe a
Nothing
  UMElem
e -> UMElem -> Maybe UMElem
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 Map (Credential 'Staking) UMElem
forall k a. Map k a
Map.empty Map Ptr (Credential 'Staking)
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} -> Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking)
-> UView (Credential 'Staking) RDPair
rewDepUView ((UMElem -> Maybe UMElem)
-> Credential 'Staking
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update UMElem -> Maybe UMElem
go k
Credential 'Staking
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 (UMElem -> Maybe UMElem) -> UMElem -> Maybe UMElem
forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
forall a. StrictMaybe a
SNothing Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep
  PtrUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} -> case k -> Map k (Credential 'Staking) -> Maybe (Credential 'Staking)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key Map k (Credential 'Staking)
Map Ptr (Credential 'Staking)
umPtrs of
    Maybe (Credential 'Staking)
Nothing -> UMap -> UView Ptr (Credential 'Staking)
PtrUView (UMap -> UView Ptr (Credential 'Staking))
-> UMap -> UView Ptr (Credential 'Staking)
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 ((UMElem -> Maybe UMElem)
-> Credential 'Staking
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
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) (Ptr
-> Map Ptr (Credential 'Staking) -> Map Ptr (Credential 'Staking)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete k
Ptr
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 (UMElem -> Maybe UMElem) -> UMElem -> Maybe UMElem
forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
rd (Ptr -> Set Ptr -> Set Ptr
forall a. Ord a => a -> Set a -> Set a
Set.delete k
Ptr
key Set Ptr
ptrSet) StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep
  SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} -> Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking)
-> UView (Credential 'Staking) (KeyHash 'StakePool)
sPoolUView ((UMElem -> Maybe UMElem)
-> Credential 'Staking
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update UMElem -> Maybe UMElem
go k
Credential 'Staking
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 (UMElem -> Maybe UMElem) -> UMElem -> Maybe UMElem
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)
forall a. StrictMaybe a
SNothing StrictMaybe DRep
dRep
  DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} -> Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking)
-> UView (Credential 'Staking) DRep
dRepUView ((UMElem -> Maybe UMElem)
-> Credential 'Staking
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update UMElem -> Maybe UMElem
go k
Credential 'Staking
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 (UMElem -> Maybe UMElem) -> UMElem -> Maybe UMElem
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 StrictMaybe DRep
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 = UView k v -> UMap
forall k v. UView k v -> UMap
unUView (UView k v -> UMap) -> UView k v -> UMap
forall a b. (a -> b) -> a -> b
$ k -> UView k v -> UView k v
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} -> Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking)
-> UView (Credential 'Staking) RDPair
rewDepUView ((Maybe UMElem -> Maybe UMElem)
-> Credential 'Staking
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe UMElem -> Maybe UMElem
go k
Credential 'Staking
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 -> UMElem -> Maybe UMElem
forall a. a -> Maybe a
Just (UMElem -> Maybe UMElem) -> UMElem -> Maybe UMElem
forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem (RDPair -> StrictMaybe RDPair
forall a. a -> StrictMaybe a
SJust v
RDPair
val) Set Ptr
forall a. Set a
Set.empty StrictMaybe (KeyHash 'StakePool)
forall a. StrictMaybe a
SNothing StrictMaybe DRep
forall a. StrictMaybe a
SNothing
        Just (UMElem StrictMaybe RDPair
SNothing Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep) -> UMElem -> Maybe UMElem
nullUMElemMaybe (UMElem -> Maybe UMElem) -> UMElem -> Maybe UMElem
forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem (RDPair -> StrictMaybe RDPair
forall a. a -> StrictMaybe a
SJust v
RDPair
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 (UMElem -> Maybe UMElem) -> UMElem -> Maybe UMElem
forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem (v -> StrictMaybe v
forall a. a -> StrictMaybe a
SJust (v -> StrictMaybe v) -> v -> StrictMaybe v
forall a b. (a -> b) -> a -> b
$ v -> v -> v
combine v
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: 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 k -> Map k (Credential 'Staking) -> Maybe (Credential 'Staking)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key Map k (Credential 'Staking)
Map Ptr (Credential 'Staking)
umPtrs of
        Maybe (Credential 'Staking)
Nothing -> (v
val, v
val)
        Just Credential 'Staking
oldVal -> (v
Credential 'Staking
oldVal, v -> v -> v
combine v
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 = (UMElem -> Maybe UMElem) -> v -> Map v UMElem -> Map v UMElem
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update UMElem -> Maybe UMElem
addPtr v
newCred (Map v UMElem -> Map v UMElem) -> Map v UMElem -> Map v UMElem
forall a b. (a -> b) -> a -> b
$ (UMElem -> Maybe UMElem) -> v -> Map v UMElem -> Map v UMElem
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update UMElem -> Maybe UMElem
delPtr v
oldCred Map v UMElem
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) = UMElem -> Maybe UMElem
forall a. a -> Maybe a
Just (UMElem -> Maybe UMElem) -> UMElem -> Maybe UMElem
forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
rd (Ptr -> Set Ptr -> Set Ptr
forall a. Ord a => a -> Set a -> Set a
Set.insert k
Ptr
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 (UMElem -> Maybe UMElem) -> UMElem -> Maybe UMElem
forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
rd (Ptr -> Set Ptr -> Set Ptr
forall a. Ord a => a -> Set a -> Set a
Set.delete k
Ptr
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 = k -> v -> Map k v -> Map k v
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
key v
newCred Map k v
Map Ptr (Credential 'Staking)
umPtrs
     in
      UMap -> UView Ptr (Credential 'Staking)
PtrUView (UMap -> UView Ptr (Credential 'Staking))
-> UMap -> UView Ptr (Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UMap
UMap Map v UMElem
Map (Credential 'Staking) UMElem
newUmElem Map k v
Map Ptr (Credential 'Staking)
newUmPtr
  SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} -> Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking)
-> UView (Credential 'Staking) (KeyHash 'StakePool)
sPoolUView ((Maybe UMElem -> Maybe UMElem)
-> Credential 'Staking
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe UMElem -> Maybe UMElem
go k
Credential 'Staking
key Map (Credential 'Staking) UMElem
umElems) Map Ptr (Credential 'Staking)
umPtrs
    where
      go :: Maybe UMElem -> Maybe UMElem
go = \case
        Maybe UMElem
Nothing -> UMElem -> Maybe UMElem
forall a. a -> Maybe a
Just (UMElem -> Maybe UMElem) -> UMElem -> Maybe UMElem
forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
forall a. StrictMaybe a
SNothing Set Ptr
forall a. Set a
Set.empty (KeyHash 'StakePool -> StrictMaybe (KeyHash 'StakePool)
forall a. a -> StrictMaybe a
SJust v
KeyHash 'StakePool
val) StrictMaybe DRep
forall a. StrictMaybe a
SNothing
        Just (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
SNothing StrictMaybe DRep
dRep) -> UMElem -> Maybe UMElem
forall a. a -> Maybe a
Just (UMElem -> Maybe UMElem) -> UMElem -> Maybe UMElem
forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet (KeyHash 'StakePool -> StrictMaybe (KeyHash 'StakePool)
forall a. a -> StrictMaybe a
SJust v
KeyHash 'StakePool
val) StrictMaybe DRep
dRep
        Just (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet (SJust KeyHash 'StakePool
old) StrictMaybe DRep
dRep) -> UMElem -> Maybe UMElem
forall a. a -> Maybe a
Just (UMElem -> Maybe UMElem) -> UMElem -> Maybe UMElem
forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet (v -> StrictMaybe v
forall a. a -> StrictMaybe a
SJust (v -> StrictMaybe v) -> v -> StrictMaybe v
forall a b. (a -> b) -> a -> b
$ v -> v -> v
combine v
KeyHash 'StakePool
old v
val) StrictMaybe DRep
dRep
  DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} -> Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking)
-> UView (Credential 'Staking) DRep
dRepUView ((Maybe UMElem -> Maybe UMElem)
-> Credential 'Staking
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe UMElem -> Maybe UMElem
go k
Credential 'Staking
key Map (Credential 'Staking) UMElem
umElems) Map Ptr (Credential 'Staking)
umPtrs
    where
      go :: Maybe UMElem -> Maybe UMElem
go = \case
        Maybe UMElem
Nothing -> UMElem -> Maybe UMElem
forall a. a -> Maybe a
Just (UMElem -> Maybe UMElem) -> UMElem -> Maybe UMElem
forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
forall a. StrictMaybe a
SNothing Set Ptr
forall a. Set a
Set.empty StrictMaybe (KeyHash 'StakePool)
forall a. StrictMaybe a
SNothing (StrictMaybe DRep -> UMElem) -> StrictMaybe DRep -> UMElem
forall a b. (a -> b) -> a -> b
$ DRep -> StrictMaybe DRep
forall a. a -> StrictMaybe a
SJust v
DRep
val
        Just (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
SNothing) -> UMElem -> Maybe UMElem
forall a. a -> Maybe a
Just (UMElem -> Maybe UMElem) -> UMElem -> Maybe UMElem
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 (StrictMaybe DRep -> UMElem) -> StrictMaybe DRep -> UMElem
forall a b. (a -> b) -> a -> b
$ DRep -> StrictMaybe DRep
forall a. a -> StrictMaybe a
SJust v
DRep
val
        Just (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool (SJust DRep
old)) -> UMElem -> Maybe UMElem
forall a. a -> Maybe a
Just (UMElem -> Maybe UMElem) -> UMElem -> Maybe UMElem
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 (StrictMaybe DRep -> UMElem) -> StrictMaybe DRep -> UMElem
forall a b. (a -> b) -> a -> b
$ v -> StrictMaybe v
forall a. a -> StrictMaybe a
SJust (v -> StrictMaybe v) -> v -> StrictMaybe v
forall a b. (a -> b) -> a -> b
$ v -> v -> v
combine v
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 = UView k v -> UMap
forall k v. UView k v -> UMap
unUView (UView k v -> UMap) -> UView k v -> UMap
forall a b. (a -> b) -> a -> b
$ (v -> v -> v) -> k -> v -> UView k v -> UView k v
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' = (v -> v -> v) -> k -> v -> UView k v -> UView k v
forall v k. (v -> v -> v) -> k -> v -> UView k v -> UView k v
insertWith' ((v -> v -> v) -> k -> v -> UView k v -> UView k v)
-> (v -> v -> v) -> k -> v -> UView k v -> UView k v
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 = UView k v -> UMap
forall k v. UView k v -> UMap
unUView (UView k v -> UMap) -> UView k v -> UMap
forall a b. (a -> b) -> a -> b
$ k -> v -> UView k v -> UView k v
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs}) = Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UMap
UMap ((UMElem -> UMElem)
-> Credential 'Staking
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust UMElem -> UMElem
go k
Credential 'Staking
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 (RDPair -> StrictMaybe RDPair
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 StrictMaybe RDPair
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> k -> Map k UMElem -> Maybe UMElem
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key Map k UMElem
Map (Credential 'Staking) UMElem
umElems Maybe UMElem -> (UMElem -> Maybe v) -> Maybe v
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UMElem -> Maybe v
UMElem -> Maybe RDPair
umElemRDPair
  PtrUView UMap {Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} -> k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key Map k v
Map Ptr (Credential 'Staking)
umPtrs
  SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> k -> Map k UMElem -> Maybe UMElem
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key Map k UMElem
Map (Credential 'Staking) UMElem
umElems Maybe UMElem -> (UMElem -> Maybe v) -> Maybe v
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UMElem -> Maybe v
UMElem -> Maybe (KeyHash 'StakePool)
umElemSPool
  DRepUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> k -> Map k UMElem -> Maybe UMElem
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key Map k UMElem
Map (Credential 'Staking) UMElem
umElems Maybe UMElem -> (UMElem -> Maybe v) -> Maybe v
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UMElem -> Maybe v
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (UMElem -> Bool) -> Map (Credential 'Staking) UMElem -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe RDPair -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe RDPair -> Bool)
-> (UMElem -> Maybe RDPair) -> UMElem -> Bool
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 :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} -> Map Ptr (Credential 'Staking) -> Bool
forall k a. Map k a -> Bool
Map.null Map Ptr (Credential 'Staking)
umPtrs
  SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (UMElem -> Bool) -> Map (Credential 'Staking) UMElem -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe (KeyHash 'StakePool) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (KeyHash 'StakePool) -> Bool)
-> (UMElem -> Maybe (KeyHash 'StakePool)) -> UMElem -> Bool
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (UMElem -> Bool) -> Map (Credential 'Staking) UMElem -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe DRep -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe DRep -> Bool) -> (UMElem -> Maybe DRep) -> UMElem -> Bool
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (Set k -> k -> UMElem -> Set k) -> Set k -> Map k UMElem -> Set k
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Set k -> k -> UMElem -> Set k
forall {a}. Ord a => Set a -> a -> UMElem -> Set a
accum Set k
forall a. Set a
Set.empty Map k UMElem
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
_) = a -> Set a -> Set a
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 :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} -> Map k (Credential 'Staking) -> Set k
forall k a. Map k a -> Set k
Map.keysSet Map k (Credential 'Staking)
Map Ptr (Credential 'Staking)
umPtrs
  SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (Set k -> k -> UMElem -> Set k) -> Set k -> Map k UMElem -> Set k
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Set k -> k -> UMElem -> Set k
forall {a}. Ord a => Set a -> a -> UMElem -> Set a
accum Set k
forall a. Set a
Set.empty Map k UMElem
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
_) = a -> Set a -> Set a
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (Set k -> k -> UMElem -> Set k) -> Set k -> Map k UMElem -> Set k
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Set k -> k -> UMElem -> Set k
forall {a}. Ord a => Set a -> a -> UMElem -> Set a
accum Set k
forall a. Set a
Set.empty Map k UMElem
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
_)) = a -> Set a -> Set a
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (Set v -> UMElem -> Set v)
-> Set v -> Map (Credential 'Staking) UMElem -> Set v
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' Set v -> UMElem -> Set v
Set RDPair -> UMElem -> Set RDPair
accum Set v
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
_) = RDPair -> Set RDPair -> Set RDPair
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 :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} -> [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList ([v] -> Set v) -> [v] -> Set v
forall a b. (a -> b) -> a -> b
$ Map Ptr v -> [v]
forall k a. Map k a -> [a]
Map.elems Map Ptr v
Map Ptr (Credential 'Staking)
umPtrs
  SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (Set v -> UMElem -> Set v)
-> Set v -> Map (Credential 'Staking) UMElem -> Set v
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' Set v -> UMElem -> Set v
Set (KeyHash 'StakePool) -> UMElem -> Set (KeyHash 'StakePool)
accum Set v
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
_) = KeyHash 'StakePool
-> Set (KeyHash 'StakePool) -> Set (KeyHash 'StakePool)
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> (Set v -> UMElem -> Set v)
-> Set v -> Map (Credential 'Staking) UMElem -> Set v
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' Set v -> UMElem -> Set v
Set DRep -> UMElem -> Set DRep
accum Set v
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)) = DRep -> Set DRep -> Set 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) = (v -> v -> v) -> k -> v -> UView k v -> UMap
forall v k. (v -> v -> v) -> k -> v -> UView k v -> UMap
insertWith v -> v -> v
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 = UView k v -> (k, v) -> UMap
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: 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 ((Map (Credential 'Staking) UMElem
 -> Credential 'Staking
 -> RDPair
 -> Map (Credential 'Staking) UMElem)
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) RDPair
-> Map (Credential 'Staking) UMElem
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Map (Credential 'Staking) UMElem
-> Credential 'Staking
-> RDPair
-> Map (Credential 'Staking) UMElem
forall {k}. Ord k => Map k UMElem -> k -> RDPair -> Map k UMElem
accum Map (Credential 'Staking) UMElem
umElems Map k v
Map (Credential 'Staking) RDPair
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
_) = (UMElem -> UMElem) -> k -> Map k UMElem -> Map k UMElem
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 (RDPair -> StrictMaybe RDPair
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 = UView k v -> UMap
forall k v. UView k v -> UMap
unUView (UView k v -> UMap) -> UView k v -> UMap
forall a b. (a -> b) -> a -> b
$ (UView k v -> k -> v -> UView k v)
-> UView k v -> Map k v -> UView k v
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' UView k v -> k -> v -> UView k v
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 = (v -> v -> v) -> k -> v -> UView k v -> UView k 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 = UView k v -> Map k v -> UMap
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 = (UMap -> Credential 'Staking -> CompactForm Coin -> UMap)
-> UMap -> Map (Credential 'Staking) (CompactForm Coin) -> UMap
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' UMap -> Credential 'Staking -> CompactForm Coin -> UMap
accum (UView (Credential 'Staking) RDPair -> UMap
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 = (RDPair -> RDPair)
-> Credential 'Staking
-> UView (Credential 'Staking) RDPair
-> UMap
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
addCompactCoin 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 = UView k RDPair -> UMap
forall k v. UView k v -> UMap
unUView (UView k RDPair -> UMap) -> UView k RDPair -> UMap
forall a b. (a -> b) -> a -> b
$ (UView k RDPair -> k -> CompactForm Coin -> UView k RDPair)
-> UView k RDPair -> Map k (CompactForm Coin) -> UView k RDPair
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' UView k RDPair -> k -> CompactForm Coin -> UView k RDPair
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 = (RDPair -> RDPair -> RDPair)
-> k -> RDPair -> UView k RDPair -> UView k RDPair
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
addCompactCoin 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 = UView k v -> UMap
forall k v. UView k v -> UMap
unUView ((UView k v -> k -> UView k v) -> UView k v -> Set k -> UView k v
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' ((k -> UView k v -> UView k v) -> UView k v -> k -> UView k v
forall a b c. (a -> b -> c) -> b -> a -> c
flip k -> UView k v -> UView k v
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 = Set k -> UView k v -> UMap
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 = (Credential 'Staking -> UMap -> UMap)
-> UMap -> Set (Credential 'Staking) -> 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 = (Maybe UMElem, UMap) -> UMap
forall a b. (a, b) -> b
snd ((Maybe UMElem, UMap) -> UMap)
-> (UMap -> (Maybe UMElem, UMap)) -> UMap -> UMap
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} =
  case Credential 'Staking
-> Map (Credential 'Staking) UMElem
-> (Maybe UMElem, Map (Credential 'Staking) UMElem)
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
_) -> (Maybe 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 Map Ptr (Credential 'Staking)
-> Set Ptr -> Map Ptr (Credential 'Staking)
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: 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 ((Map (Credential 'Staking) UMElem
 -> Credential 'Staking
 -> UMElem
 -> Map (Credential 'Staking) UMElem)
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
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
_
        | RDPair -> Set RDPair -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member RDPair
rd Set v
Set RDPair
rdSet ->
            let go :: UMElem -> Maybe UMElem
go (UMElem StrictMaybe RDPair
_ Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep) = UMElem -> Maybe UMElem
nullUMElemMaybe (UMElem -> Maybe UMElem) -> UMElem -> Maybe UMElem
forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
forall a. StrictMaybe a
SNothing Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep
             in (UMElem -> Maybe UMElem)
-> Credential 'Staking
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
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 = (UMap -> Credential 'Staking -> UMap)
-> UMap -> Set (Credential 'Staking) -> UMap
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' UMap -> Credential 'Staking -> UMap
rmCred UMap
um Set v
Set (Credential 'Staking)
set
  where
    rmCred :: UMap -> Credential 'Staking -> UMap
rmCred m :: UMap
m@UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} Credential 'Staking
cred = case Credential 'Staking
-> Map (Credential 'Staking) UMElem -> Maybe UMElem
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 (UMElem -> Maybe UMElem) -> UMElem -> Maybe UMElem
forall a b. (a -> b) -> a -> b
$ StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem StrictMaybe RDPair
rd Set Ptr
forall a. Set a
Set.empty StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
dRep
         in Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UMap
UMap ((UMElem -> Maybe UMElem)
-> Credential 'Staking
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
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) ((Ptr
 -> Map Ptr (Credential 'Staking) -> Map Ptr (Credential 'Staking))
-> Map Ptr (Credential 'Staking)
-> Set Ptr
-> Map Ptr (Credential 'Staking)
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Ptr
-> Map Ptr (Credential 'Staking) -> Map Ptr (Credential 'Staking)
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} ⋫ Set v
sPoolSet = Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UMap
UMap ((Map (Credential 'Staking) UMElem
 -> Credential 'Staking
 -> UMElem
 -> Map (Credential 'Staking) UMElem)
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
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
_
        | KeyHash 'StakePool -> Set (KeyHash 'StakePool) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member KeyHash 'StakePool
sPool Set v
Set (KeyHash 'StakePool)
sPoolSet ->
            let go :: UMElem -> Maybe UMElem
go (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
_ StrictMaybe DRep
dRep) = UMElem -> Maybe UMElem
nullUMElemMaybe (UMElem -> Maybe UMElem) -> UMElem -> Maybe UMElem
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)
forall a. StrictMaybe a
SNothing StrictMaybe DRep
dRep
             in (UMElem -> Maybe UMElem)
-> Credential 'Staking
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems, Map Ptr (Credential 'Staking)
umPtrs :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} ⋫ Set v
dRepSet = Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UMap
UMap ((Map (Credential 'Staking) UMElem
 -> Credential 'Staking
 -> UMElem
 -> Map (Credential 'Staking) UMElem)
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
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)
        | DRep -> Set DRep -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member DRep
dRep Set v
Set DRep
dRepSet ->
            let go :: UMElem -> Maybe UMElem
go (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool)
sPool StrictMaybe DRep
_) = UMElem -> Maybe UMElem
nullUMElemMaybe (UMElem -> Maybe UMElem) -> UMElem -> Maybe UMElem
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 StrictMaybe DRep
forall a. StrictMaybe a
SNothing
             in (UMElem -> Maybe UMElem)
-> Credential 'Staking
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
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 = UView k v -> Set v -> UMap
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 = Credential 'Staking -> Map (Credential 'Staking) UMElem -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Credential 'Staking
k (Map (Credential 'Staking) UMElem -> Bool)
-> (UMap -> Map (Credential 'Staking) UMElem) -> UMap -> Bool
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> case k -> Map k UMElem -> Maybe UMElem
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k UMElem
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 :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} -> k -> Map k (Credential 'Staking) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member k
k Map k (Credential 'Staking)
Map Ptr (Credential 'Staking)
umPtrs
  SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> case k -> Map k UMElem -> Maybe UMElem
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k UMElem
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} -> case k -> Map k UMElem -> Maybe UMElem
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k UMElem
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 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ k -> UView k v -> Bool
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} ◁ :: forall k v u. UView k v -> Map k u -> Map k u
◁ Map k u
m = (k -> UMElem -> Bool) -> Map k u -> Map k UMElem -> Map k u
forall k v2 v1.
Ord k =>
(k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v1
intersectDomPLeft k -> UMElem -> Bool
forall {p}. p -> UMElem -> Bool
p Map k u
m Map k UMElem
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 :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} ◁ Map k u
m = Map k u -> Map k (Credential 'Staking) -> Map k u
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection Map k u
m Map k (Credential 'Staking)
Map Ptr (Credential 'Staking)
umPtrs
SPoolUView UMap {Map (Credential 'Staking) UMElem
umElems :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} ◁ Map k u
m = (k -> UMElem -> Bool) -> Map k u -> Map k UMElem -> Map k u
forall k v2 v1.
Ord k =>
(k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v1
intersectDomPLeft k -> UMElem -> Bool
forall {p}. p -> UMElem -> Bool
p Map k u
m Map k UMElem
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 :: UMap -> Map (Credential 'Staking) UMElem
umElems :: Map (Credential 'Staking) UMElem
umElems} ◁ Map k u
m = (k -> UMElem -> Bool) -> Map k u -> Map k UMElem -> Map k u
forall k v2 v1.
Ord k =>
(k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v1
intersectDomPLeft k -> UMElem -> Bool
forall {p}. p -> UMElem -> Bool
p Map k u
m Map k UMElem
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 = UView k v -> Map k u -> Map k u
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 = v -> Maybe v -> v
forall a. a -> Maybe a -> a
fromMaybe v
def (Maybe v -> v) -> (UView k v -> Maybe v) -> UView k v -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> UView k v -> Maybe v
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 :: UMap -> Map Ptr (Credential 'Staking)
umPtrs :: Map Ptr (Credential 'Staking)
umPtrs} -> Map Ptr (Credential 'Staking) -> Int
forall k a. Map k a -> Int
Map.size Map Ptr (Credential 'Staking)
umPtrs
  UView k v
x -> (Int -> v -> Int) -> Int -> UView k v -> Int
forall b a. (b -> a -> b) -> b -> UView k a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
count v
_v -> Int
count Int -> Int -> Int
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 = UView (Credential 'Staking) RDPair -> UMap
forall k v. UView k v -> UMap
unUView (UView (Credential 'Staking) RDPair -> UMap)
-> UView (Credential 'Staking) RDPair -> UMap
forall a b. (a -> b) -> a -> b
$ (UView (Credential 'Staking) RDPair
 -> Credential 'Staking
 -> RDPair
 -> UView (Credential 'Staking) RDPair)
-> UView (Credential 'Staking) RDPair
-> Map (Credential 'Staking) RDPair
-> UView (Credential 'Staking) RDPair
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 -> Credential 'Staking
-> RDPair
-> UView (Credential 'Staking) RDPair
-> UView (Credential 'Staking) RDPair
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 = UView (Credential 'Staking) (KeyHash 'StakePool) -> UMap
forall k v. UView k v -> UMap
unUView (UView (Credential 'Staking) (KeyHash 'StakePool) -> UMap)
-> UView (Credential 'Staking) (KeyHash 'StakePool) -> UMap
forall a b. (a -> b) -> a -> b
$ (UView (Credential 'Staking) (KeyHash 'StakePool)
 -> Credential 'Staking
 -> KeyHash 'StakePool
 -> UView (Credential 'Staking) (KeyHash 'StakePool))
-> UView (Credential 'Staking) (KeyHash 'StakePool)
-> Map (Credential 'Staking) (KeyHash 'StakePool)
-> UView (Credential 'Staking) (KeyHash 'StakePool)
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 -> Credential 'Staking
-> KeyHash 'StakePool
-> UView (Credential 'Staking) (KeyHash 'StakePool)
-> UView (Credential 'Staking) (KeyHash 'StakePool)
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 = UView (Credential 'Staking) DRep -> UMap
forall k v. UView k v -> UMap
unUView (UView (Credential 'Staking) DRep -> UMap)
-> UView (Credential 'Staking) DRep -> UMap
forall a b. (a -> b) -> a -> b
$ (UView (Credential 'Staking) DRep
 -> Credential 'Staking -> DRep -> UView (Credential 'Staking) DRep)
-> UView (Credential 'Staking) DRep
-> Map (Credential 'Staking) DRep
-> UView (Credential 'Staking) DRep
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 -> Credential 'Staking
-> DRep
-> UView (Credential 'Staking) DRep
-> UView (Credential 'Staking) DRep
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 = UView Ptr (Credential 'Staking) -> UMap
forall k v. UView k v -> UMap
unUView (UView Ptr (Credential 'Staking) -> UMap)
-> UView Ptr (Credential 'Staking) -> UMap
forall a b. (a -> b) -> a -> b
$ (UView Ptr (Credential 'Staking)
 -> Ptr -> Credential 'Staking -> UView Ptr (Credential 'Staking))
-> UView Ptr (Credential 'Staking)
-> Map Ptr (Credential 'Staking)
-> UView Ptr (Credential 'Staking)
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 -> Ptr
-> Credential 'Staking
-> UView Ptr (Credential 'Staking)
-> UView Ptr (Credential 'Staking)
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 = CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompactCoin
{-# DEPRECATED addCompact "In favor of `Cardano.Ledger.Coin.addCompactCoin`" #-}

sumRewardsUView :: UView k RDPair -> CompactForm Coin
sumRewardsUView :: forall k. UView k RDPair -> CompactForm Coin
sumRewardsUView = (CompactForm Coin -> RDPair -> CompactForm Coin)
-> CompactForm Coin -> UView k RDPair -> CompactForm Coin
forall b a. (b -> a -> b) -> b -> UView k a -> b
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
addCompactCoin CompactForm Coin
ans CompactForm Coin
r

sumDepositUView :: UView k RDPair -> CompactForm Coin
sumDepositUView :: forall k. UView k RDPair -> CompactForm Coin
sumDepositUView = (CompactForm Coin -> RDPair -> CompactForm Coin)
-> CompactForm Coin -> UView k RDPair -> CompactForm Coin
forall b a. (b -> a -> b) -> b -> UView k a -> b
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
addCompactCoin CompactForm Coin
ans CompactForm Coin
d