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

module Data.UMap
  ( Trip (Triple),
    tripReward,
    tripRewardActiveDelegation,
    tripDelegation,
    UMap (..),
    UnifiedView (..),
    umInvariant,
    unView,
    unUnify,
    viewToVMap,
    rewView,
    delView,
    ptrView,
    domRestrictedView,
    zero,
    zeroMaybe,
    mapNext,
    mapLub,
    next,
    leastUpperBound,
    empty,
    delete,
    delete',
    insertWith,
    insertWith',
    insert,
    insert',
    lookup,
    isNull,
    domain,
    range,
    (∪),
    (⨃),
    (∪+),
    (⋪),
    (⋫),
    member,
    notMember,
    domRestrict,
    Tag (..),
    View (..),
    findWithDefault,
    size,
    unify,
  )
where

import Cardano.Binary (FromCBOR (..), ToCBOR (..), encodeListLen)
import Control.DeepSeq (NFData (..))
import Control.Monad.Trans.State.Strict (StateT (..))
import Data.Coders (decodeMap, decodeRecordNamed, encodeMap)
import Data.Foldable (Foldable (..))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.MapExtras (intersectDomPLeft)
import Data.Maybe as Maybe (fromMaybe, isNothing, mapMaybe)
import Data.Maybe.Strict (StrictMaybe (..))
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Set.Internal as SI (Set (..))
import Data.Sharing
import Data.Typeable (Typeable)
import qualified Data.VMap as VMap
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Prelude hiding (lookup)

-- ===================================================================

{- The space compacting Trip datatype, and the pattern Triple are equivalent to:

data Trip coin ptr pool = Triple
  { coinT :: !(StrictMaybe coin),
    ptrT :: !(Set ptr),
    poolidT :: !(StrictMaybe pool)
  }
  deriving (Show, Eq, Generic, NoThunks, NFData)
-}

-- We use the notation "F" for full, the component is present, and "E" for empty,
-- the component  is not present. As illustrsted above there are three components
-- 1) the coin, 2) the Ptr set, and 3) the PoolID. so TEEE means none of the
-- components are present, and TEEF means only the PoolId is present. etc.

data Trip coin ptr pool
  = TEEE
  | TEEF !pool
  | TEFE !(Set ptr)
  | TEFF !(Set ptr) !pool
  | TFEE !coin
  | TFEF !coin !pool
  | TFFE !coin !(Set ptr)
  | TFFF !coin !(Set ptr) !pool
  deriving (Trip coin ptr pool -> Trip coin ptr pool -> Bool
(Trip coin ptr pool -> Trip coin ptr pool -> Bool)
-> (Trip coin ptr pool -> Trip coin ptr pool -> Bool)
-> Eq (Trip coin ptr pool)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall coin ptr pool.
(Eq pool, Eq ptr, Eq coin) =>
Trip coin ptr pool -> Trip coin ptr pool -> Bool
/= :: Trip coin ptr pool -> Trip coin ptr pool -> Bool
$c/= :: forall coin ptr pool.
(Eq pool, Eq ptr, Eq coin) =>
Trip coin ptr pool -> Trip coin ptr pool -> Bool
== :: Trip coin ptr pool -> Trip coin ptr pool -> Bool
$c== :: forall coin ptr pool.
(Eq pool, Eq ptr, Eq coin) =>
Trip coin ptr pool -> Trip coin ptr pool -> Bool
Eq, Eq (Trip coin ptr pool)
Eq (Trip coin ptr pool)
-> (Trip coin ptr pool -> Trip coin ptr pool -> Ordering)
-> (Trip coin ptr pool -> Trip coin ptr pool -> Bool)
-> (Trip coin ptr pool -> Trip coin ptr pool -> Bool)
-> (Trip coin ptr pool -> Trip coin ptr pool -> Bool)
-> (Trip coin ptr pool -> Trip coin ptr pool -> Bool)
-> (Trip coin ptr pool -> Trip coin ptr pool -> Trip coin ptr pool)
-> (Trip coin ptr pool -> Trip coin ptr pool -> Trip coin ptr pool)
-> Ord (Trip coin ptr pool)
Trip coin ptr pool -> Trip coin ptr pool -> Bool
Trip coin ptr pool -> Trip coin ptr pool -> Ordering
Trip coin ptr pool -> Trip coin ptr pool -> Trip coin ptr pool
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
forall coin ptr pool.
(Ord pool, Ord ptr, Ord coin) =>
Eq (Trip coin ptr pool)
forall coin ptr pool.
(Ord pool, Ord ptr, Ord coin) =>
Trip coin ptr pool -> Trip coin ptr pool -> Bool
forall coin ptr pool.
(Ord pool, Ord ptr, Ord coin) =>
Trip coin ptr pool -> Trip coin ptr pool -> Ordering
forall coin ptr pool.
(Ord pool, Ord ptr, Ord coin) =>
Trip coin ptr pool -> Trip coin ptr pool -> Trip coin ptr pool
min :: Trip coin ptr pool -> Trip coin ptr pool -> Trip coin ptr pool
$cmin :: forall coin ptr pool.
(Ord pool, Ord ptr, Ord coin) =>
Trip coin ptr pool -> Trip coin ptr pool -> Trip coin ptr pool
max :: Trip coin ptr pool -> Trip coin ptr pool -> Trip coin ptr pool
$cmax :: forall coin ptr pool.
(Ord pool, Ord ptr, Ord coin) =>
Trip coin ptr pool -> Trip coin ptr pool -> Trip coin ptr pool
>= :: Trip coin ptr pool -> Trip coin ptr pool -> Bool
$c>= :: forall coin ptr pool.
(Ord pool, Ord ptr, Ord coin) =>
Trip coin ptr pool -> Trip coin ptr pool -> Bool
> :: Trip coin ptr pool -> Trip coin ptr pool -> Bool
$c> :: forall coin ptr pool.
(Ord pool, Ord ptr, Ord coin) =>
Trip coin ptr pool -> Trip coin ptr pool -> Bool
<= :: Trip coin ptr pool -> Trip coin ptr pool -> Bool
$c<= :: forall coin ptr pool.
(Ord pool, Ord ptr, Ord coin) =>
Trip coin ptr pool -> Trip coin ptr pool -> Bool
< :: Trip coin ptr pool -> Trip coin ptr pool -> Bool
$c< :: forall coin ptr pool.
(Ord pool, Ord ptr, Ord coin) =>
Trip coin ptr pool -> Trip coin ptr pool -> Bool
compare :: Trip coin ptr pool -> Trip coin ptr pool -> Ordering
$ccompare :: forall coin ptr pool.
(Ord pool, Ord ptr, Ord coin) =>
Trip coin ptr pool -> Trip coin ptr pool -> Ordering
$cp1Ord :: forall coin ptr pool.
(Ord pool, Ord ptr, Ord coin) =>
Eq (Trip coin ptr pool)
Ord, (forall x. Trip coin ptr pool -> Rep (Trip coin ptr pool) x)
-> (forall x. Rep (Trip coin ptr pool) x -> Trip coin ptr pool)
-> Generic (Trip coin ptr pool)
forall x. Rep (Trip coin ptr pool) x -> Trip coin ptr pool
forall x. Trip coin ptr pool -> Rep (Trip coin ptr pool) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall coin ptr pool x.
Rep (Trip coin ptr pool) x -> Trip coin ptr pool
forall coin ptr pool x.
Trip coin ptr pool -> Rep (Trip coin ptr pool) x
$cto :: forall coin ptr pool x.
Rep (Trip coin ptr pool) x -> Trip coin ptr pool
$cfrom :: forall coin ptr pool x.
Trip coin ptr pool -> Rep (Trip coin ptr pool) x
Generic, Context -> Trip coin ptr pool -> IO (Maybe ThunkInfo)
Proxy (Trip coin ptr pool) -> String
(Context -> Trip coin ptr pool -> IO (Maybe ThunkInfo))
-> (Context -> Trip coin ptr pool -> IO (Maybe ThunkInfo))
-> (Proxy (Trip coin ptr pool) -> String)
-> NoThunks (Trip coin ptr pool)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall coin ptr pool.
(NoThunks pool, NoThunks ptr, NoThunks coin) =>
Context -> Trip coin ptr pool -> IO (Maybe ThunkInfo)
forall coin ptr pool.
(NoThunks pool, NoThunks ptr, NoThunks coin) =>
Proxy (Trip coin ptr pool) -> String
showTypeOf :: Proxy (Trip coin ptr pool) -> String
$cshowTypeOf :: forall coin ptr pool.
(NoThunks pool, NoThunks ptr, NoThunks coin) =>
Proxy (Trip coin ptr pool) -> String
wNoThunks :: Context -> Trip coin ptr pool -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall coin ptr pool.
(NoThunks pool, NoThunks ptr, NoThunks coin) =>
Context -> Trip coin ptr pool -> IO (Maybe ThunkInfo)
noThunks :: Context -> Trip coin ptr pool -> IO (Maybe ThunkInfo)
$cnoThunks :: forall coin ptr pool.
(NoThunks pool, NoThunks ptr, NoThunks coin) =>
Context -> Trip coin ptr pool -> IO (Maybe ThunkInfo)
NoThunks, Trip coin ptr pool -> ()
(Trip coin ptr pool -> ()) -> NFData (Trip coin ptr pool)
forall a. (a -> ()) -> NFData a
forall coin ptr pool.
(NFData pool, NFData ptr, NFData coin) =>
Trip coin ptr pool -> ()
rnf :: Trip coin ptr pool -> ()
$crnf :: forall coin ptr pool.
(NFData pool, NFData ptr, NFData coin) =>
Trip coin ptr pool -> ()
NFData)

-- | We can view all of the constructors as a Triple.
viewTrip :: Trip coin ptr pool -> (StrictMaybe coin, Set ptr, StrictMaybe pool)
viewTrip :: Trip coin ptr pool -> (StrictMaybe coin, Set ptr, StrictMaybe pool)
viewTrip Trip coin ptr pool
TEEE = (StrictMaybe coin
forall a. StrictMaybe a
SNothing, Set ptr
forall a. Set a
Set.empty, StrictMaybe pool
forall a. StrictMaybe a
SNothing)
viewTrip (TEEF pool
x) = (StrictMaybe coin
forall a. StrictMaybe a
SNothing, Set ptr
forall a. Set a
Set.empty, pool -> StrictMaybe pool
forall a. a -> StrictMaybe a
SJust pool
x)
viewTrip (TEFE Set ptr
x) = (StrictMaybe coin
forall a. StrictMaybe a
SNothing, Set ptr
x, StrictMaybe pool
forall a. StrictMaybe a
SNothing)
viewTrip (TEFF Set ptr
x pool
y) = (StrictMaybe coin
forall a. StrictMaybe a
SNothing, Set ptr
x, pool -> StrictMaybe pool
forall a. a -> StrictMaybe a
SJust pool
y)
viewTrip (TFEE coin
x) = (coin -> StrictMaybe coin
forall a. a -> StrictMaybe a
SJust coin
x, Set ptr
forall a. Set a
Set.empty, StrictMaybe pool
forall a. StrictMaybe a
SNothing)
viewTrip (TFEF coin
x pool
y) = (coin -> StrictMaybe coin
forall a. a -> StrictMaybe a
SJust coin
x, Set ptr
forall a. Set a
Set.empty, pool -> StrictMaybe pool
forall a. a -> StrictMaybe a
SJust pool
y)
viewTrip (TFFE coin
x Set ptr
y) = (coin -> StrictMaybe coin
forall a. a -> StrictMaybe a
SJust coin
x, Set ptr
y, StrictMaybe pool
forall a. StrictMaybe a
SNothing)
viewTrip (TFFF coin
x Set ptr
y pool
z) = (coin -> StrictMaybe coin
forall a. a -> StrictMaybe a
SJust coin
x, Set ptr
y, pool -> StrictMaybe pool
forall a. a -> StrictMaybe a
SJust pool
z)

tripRewardActiveDelegation :: Trip coin ptr pool -> Maybe coin
tripRewardActiveDelegation :: Trip coin ptr pool -> Maybe coin
tripRewardActiveDelegation =
  \case
    TFFF coin
c Set ptr
_ pool
_ -> coin -> Maybe coin
forall a. a -> Maybe a
Just coin
c
    TFEF coin
c pool
_ -> coin -> Maybe coin
forall a. a -> Maybe a
Just coin
c
    Trip coin ptr pool
_ -> Maybe coin
forall a. Maybe a
Nothing

tripReward :: Trip coin ptr pool -> Maybe coin
tripReward :: Trip coin ptr pool -> Maybe coin
tripReward =
  \case
    TFFF coin
c Set ptr
_ pool
_ -> coin -> Maybe coin
forall a. a -> Maybe a
Just coin
c
    TFFE coin
c Set ptr
_ -> coin -> Maybe coin
forall a. a -> Maybe a
Just coin
c
    TFEF coin
c pool
_ -> coin -> Maybe coin
forall a. a -> Maybe a
Just coin
c
    TFEE coin
c -> coin -> Maybe coin
forall a. a -> Maybe a
Just coin
c
    Trip coin ptr pool
_ -> Maybe coin
forall a. Maybe a
Nothing

tripDelegation :: Trip coin ptr pool -> Maybe pool
tripDelegation :: Trip coin ptr pool -> Maybe pool
tripDelegation =
  \case
    TFFF coin
_ Set ptr
_ pool
p -> pool -> Maybe pool
forall a. a -> Maybe a
Just pool
p
    TFEF coin
_ pool
p -> pool -> Maybe pool
forall a. a -> Maybe a
Just pool
p
    TEFF Set ptr
_ pool
p -> pool -> Maybe pool
forall a. a -> Maybe a
Just pool
p
    TEEF pool
p -> pool -> Maybe pool
forall a. a -> Maybe a
Just pool
p
    Trip coin ptr pool
_ -> Maybe pool
forall a. Maybe a
Nothing

-- A Triple can be extracted and injected into the TEEE ... TFFF constructors.
pattern Triple :: StrictMaybe coin -> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
pattern $bTriple :: StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
$mTriple :: forall r coin ptr pool.
Trip coin ptr pool
-> (StrictMaybe coin -> Set ptr -> StrictMaybe pool -> r)
-> (Void# -> r)
-> r
Triple a b c <-
  (viewTrip -> (a, b, c))
  where
    Triple StrictMaybe coin
a Set ptr
b StrictMaybe pool
c =
      case (StrictMaybe coin
a, Set ptr
b, StrictMaybe pool
c) of
        (StrictMaybe coin
SNothing, Set ptr
SI.Tip, StrictMaybe pool
SNothing) -> Trip coin ptr pool
forall coin ptr pool. Trip coin ptr pool
TEEE
        (StrictMaybe coin
SNothing, Set ptr
SI.Tip, SJust pool
x) -> pool -> Trip coin ptr pool
forall coin ptr pool. pool -> Trip coin ptr pool
TEEF pool
x
        (StrictMaybe coin
SNothing, Set ptr
x, StrictMaybe pool
SNothing) -> Set ptr -> Trip coin ptr pool
forall coin ptr pool. Set ptr -> Trip coin ptr pool
TEFE Set ptr
x
        (StrictMaybe coin
SNothing, Set ptr
x, SJust pool
y) -> Set ptr -> pool -> Trip coin ptr pool
forall coin ptr pool. Set ptr -> pool -> Trip coin ptr pool
TEFF Set ptr
x pool
y
        (SJust coin
x, Set ptr
SI.Tip, StrictMaybe pool
SNothing) -> coin -> Trip coin ptr pool
forall coin ptr pool. coin -> Trip coin ptr pool
TFEE coin
x
        (SJust coin
x, Set ptr
SI.Tip, SJust pool
y) -> coin -> pool -> Trip coin ptr pool
forall coin ptr pool. coin -> pool -> Trip coin ptr pool
TFEF coin
x pool
y
        (SJust coin
x, Set ptr
y, StrictMaybe pool
SNothing) -> coin -> Set ptr -> Trip coin ptr pool
forall coin ptr pool. coin -> Set ptr -> Trip coin ptr pool
TFFE coin
x Set ptr
y
        (SJust coin
x, Set ptr
y, SJust pool
z) -> coin -> Set ptr -> pool -> Trip coin ptr pool
forall coin ptr pool. coin -> Set ptr -> pool -> Trip coin ptr pool
TFFF coin
x Set ptr
y pool
z

{-# COMPLETE Triple #-}

instance (Show coin, Show pool, Show ptr) => Show (Trip coin ptr pool) where
  show :: Trip coin ptr pool -> String
show (Triple StrictMaybe coin
a Set ptr
b StrictMaybe pool
c) = String
"(Triple " String -> ShowS
forall a. [a] -> [a] -> [a]
++ StrictMaybe coin -> String
forall a. Show a => a -> String
show StrictMaybe coin
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Set ptr -> String
forall a. Show a => a -> String
show Set ptr
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ StrictMaybe pool -> String
forall a. Show a => a -> String
show StrictMaybe pool
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

-- =====================================================

data UMap coin cred pool ptr = UnifiedMap !(Map cred (Trip coin ptr pool)) !(Map ptr cred)
  deriving (Int -> UMap coin cred pool ptr -> ShowS
[UMap coin cred pool ptr] -> ShowS
UMap coin cred pool ptr -> String
(Int -> UMap coin cred pool ptr -> ShowS)
-> (UMap coin cred pool ptr -> String)
-> ([UMap coin cred pool ptr] -> ShowS)
-> Show (UMap coin cred pool ptr)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall coin cred pool ptr.
(Show cred, Show coin, Show pool, Show ptr) =>
Int -> UMap coin cred pool ptr -> ShowS
forall coin cred pool ptr.
(Show cred, Show coin, Show pool, Show ptr) =>
[UMap coin cred pool ptr] -> ShowS
forall coin cred pool ptr.
(Show cred, Show coin, Show pool, Show ptr) =>
UMap coin cred pool ptr -> String
showList :: [UMap coin cred pool ptr] -> ShowS
$cshowList :: forall coin cred pool ptr.
(Show cred, Show coin, Show pool, Show ptr) =>
[UMap coin cred pool ptr] -> ShowS
show :: UMap coin cred pool ptr -> String
$cshow :: forall coin cred pool ptr.
(Show cred, Show coin, Show pool, Show ptr) =>
UMap coin cred pool ptr -> String
showsPrec :: Int -> UMap coin cred pool ptr -> ShowS
$cshowsPrec :: forall coin cred pool ptr.
(Show cred, Show coin, Show pool, Show ptr) =>
Int -> UMap coin cred pool ptr -> ShowS
Show, UMap coin cred pool ptr -> UMap coin cred pool ptr -> Bool
(UMap coin cred pool ptr -> UMap coin cred pool ptr -> Bool)
-> (UMap coin cred pool ptr -> UMap coin cred pool ptr -> Bool)
-> Eq (UMap coin cred pool ptr)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall coin cred pool ptr.
(Eq cred, Eq pool, Eq ptr, Eq coin) =>
UMap coin cred pool ptr -> UMap coin cred pool ptr -> Bool
/= :: UMap coin cred pool ptr -> UMap coin cred pool ptr -> Bool
$c/= :: forall coin cred pool ptr.
(Eq cred, Eq pool, Eq ptr, Eq coin) =>
UMap coin cred pool ptr -> UMap coin cred pool ptr -> Bool
== :: UMap coin cred pool ptr -> UMap coin cred pool ptr -> Bool
$c== :: forall coin cred pool ptr.
(Eq cred, Eq pool, Eq ptr, Eq coin) =>
UMap coin cred pool ptr -> UMap coin cred pool ptr -> Bool
Eq, (forall x.
 UMap coin cred pool ptr -> Rep (UMap coin cred pool ptr) x)
-> (forall x.
    Rep (UMap coin cred pool ptr) x -> UMap coin cred pool ptr)
-> Generic (UMap coin cred pool ptr)
forall x.
Rep (UMap coin cred pool ptr) x -> UMap coin cred pool ptr
forall x.
UMap coin cred pool ptr -> Rep (UMap coin cred pool ptr) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall coin cred pool ptr x.
Rep (UMap coin cred pool ptr) x -> UMap coin cred pool ptr
forall coin cred pool ptr x.
UMap coin cred pool ptr -> Rep (UMap coin cred pool ptr) x
$cto :: forall coin cred pool ptr x.
Rep (UMap coin cred pool ptr) x -> UMap coin cred pool ptr
$cfrom :: forall coin cred pool ptr x.
UMap coin cred pool ptr -> Rep (UMap coin cred pool ptr) x
Generic, Context -> UMap coin cred pool ptr -> IO (Maybe ThunkInfo)
Proxy (UMap coin cred pool ptr) -> String
(Context -> UMap coin cred pool ptr -> IO (Maybe ThunkInfo))
-> (Context -> UMap coin cred pool ptr -> IO (Maybe ThunkInfo))
-> (Proxy (UMap coin cred pool ptr) -> String)
-> NoThunks (UMap coin cred pool ptr)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall coin cred pool ptr.
(NoThunks cred, NoThunks pool, NoThunks ptr, NoThunks coin) =>
Context -> UMap coin cred pool ptr -> IO (Maybe ThunkInfo)
forall coin cred pool ptr.
(NoThunks cred, NoThunks pool, NoThunks ptr, NoThunks coin) =>
Proxy (UMap coin cred pool ptr) -> String
showTypeOf :: Proxy (UMap coin cred pool ptr) -> String
$cshowTypeOf :: forall coin cred pool ptr.
(NoThunks cred, NoThunks pool, NoThunks ptr, NoThunks coin) =>
Proxy (UMap coin cred pool ptr) -> String
wNoThunks :: Context -> UMap coin cred pool ptr -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall coin cred pool ptr.
(NoThunks cred, NoThunks pool, NoThunks ptr, NoThunks coin) =>
Context -> UMap coin cred pool ptr -> IO (Maybe ThunkInfo)
noThunks :: Context -> UMap coin cred pool ptr -> IO (Maybe ThunkInfo)
$cnoThunks :: forall coin cred pool ptr.
(NoThunks cred, NoThunks pool, NoThunks ptr, NoThunks coin) =>
Context -> UMap coin cred pool ptr -> IO (Maybe ThunkInfo)
NoThunks, UMap coin cred pool ptr -> ()
(UMap coin cred pool ptr -> ()) -> NFData (UMap coin cred pool ptr)
forall a. (a -> ()) -> NFData a
forall coin cred pool ptr.
(NFData cred, NFData pool, NFData ptr, NFData coin) =>
UMap coin cred pool ptr -> ()
rnf :: UMap coin cred pool ptr -> ()
$crnf :: forall coin cred pool ptr.
(NFData cred, NFData pool, NFData ptr, NFData coin) =>
UMap coin cred pool ptr -> ()
NFData)

-- | It is worthwhie stating the invariant that holds on a Unified Map
--   The 'ptrmap' and the 'ptrT' field of the 'tripmap' are inverses.
umInvariant :: (Ord cred, Ord ptr) => cred -> ptr -> UMap coin cred pool ptr -> Bool
umInvariant :: cred -> ptr -> UMap coin cred pool ptr -> Bool
umInvariant cred
stake ptr
ptr (UnifiedMap Map cred (Trip coin ptr pool)
tripmap Map ptr cred
ptrmap) = Bool
forwards Bool -> Bool -> Bool
&& Bool
backwards
  where
    forwards :: Bool
forwards =
      case cred -> Map cred (Trip coin ptr pool) -> Maybe (Trip coin ptr pool)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup cred
stake Map cred (Trip coin ptr pool)
tripmap of
        Maybe (Trip coin ptr pool)
Nothing -> (cred -> Bool) -> Map ptr cred -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (cred
stake cred -> cred -> Bool
forall a. Eq a => a -> a -> Bool
/=) Map ptr cred
ptrmap
        Just (Triple StrictMaybe coin
_c Set ptr
set StrictMaybe pool
_d) ->
          if ptr -> Set ptr -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member ptr
ptr Set ptr
set
            then case ptr -> Map ptr cred -> Maybe cred
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ptr
ptr Map ptr cred
ptrmap of
              Maybe cred
Nothing -> Bool
False
              Just cred
stake2 -> cred
stake cred -> cred -> Bool
forall a. Eq a => a -> a -> Bool
== cred
stake2
            else Bool
True
    backwards :: Bool
backwards =
      case ptr -> Map ptr cred -> Maybe cred
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ptr
ptr Map ptr cred
ptrmap of
        Maybe cred
Nothing -> (Trip coin ptr pool -> Bool)
-> Map cred (Trip coin ptr pool) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(Triple StrictMaybe coin
_ Set ptr
set StrictMaybe pool
_) -> ptr -> Set ptr -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember ptr
ptr Set ptr
set) Map cred (Trip coin ptr pool)
tripmap
        Just cred
cred ->
          case cred -> Map cred (Trip coin ptr pool) -> Maybe (Trip coin ptr pool)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup cred
cred Map cred (Trip coin ptr pool)
tripmap of
            Maybe (Trip coin ptr pool)
Nothing -> Bool
False
            Just (Triple StrictMaybe coin
_ Set ptr
set StrictMaybe pool
_) -> ptr -> Set ptr -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member ptr
ptr Set ptr
set

-- =====================================================

data View coin cr pl ptr k v where
  Rewards ::
    !(UMap coin cr pl ptr) ->
    View coin cr pl ptr cr coin
  Delegations ::
    !(UMap coin cr pl ptr) ->
    View coin cr pl ptr cr pl
  Ptrs ::
    !(UMap coin cr pl ptr) ->
    View coin cr pl ptr ptr cr

-- ==================================================
-- short hand constructors and selectors

rewards ::
  Map cr (Trip coin ptr pool) ->
  Map ptr cr ->
  View coin cr pool ptr cr coin
rewards :: Map cr (Trip coin ptr pool)
-> Map ptr cr -> View coin cr pool ptr cr coin
rewards Map cr (Trip coin ptr pool)
x Map ptr cr
y = UMap coin cr pool ptr -> View coin cr pool ptr cr coin
forall coin cr pl ptr.
UMap coin cr pl ptr -> View coin cr pl ptr cr coin
Rewards (Map cr (Trip coin ptr pool) -> Map ptr cr -> UMap coin cr pool ptr
forall coin cred pool ptr.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
UnifiedMap Map cr (Trip coin ptr pool)
x Map ptr cr
y)

delegations ::
  Map cred (Trip coin ptr pool) ->
  Map ptr cred ->
  View coin cred pool ptr cred pool
delegations :: Map cred (Trip coin ptr pool)
-> Map ptr cred -> View coin cred pool ptr cred pool
delegations Map cred (Trip coin ptr pool)
x Map ptr cred
y = UMap coin cred pool ptr -> View coin cred pool ptr cred pool
forall coin cr pl ptr.
UMap coin cr pl ptr -> View coin cr pl ptr cr pl
Delegations (Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
forall coin cred pool ptr.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
UnifiedMap Map cred (Trip coin ptr pool)
x Map ptr cred
y)

ptrs ::
  Map cred (Trip coin ptr pool) ->
  Map ptr cred ->
  View coin cred pool ptr ptr cred
ptrs :: Map cred (Trip coin ptr pool)
-> Map ptr cred -> View coin cred pool ptr ptr cred
ptrs Map cred (Trip coin ptr pool)
x Map ptr cred
y = UMap coin cred pool ptr -> View coin cred pool ptr ptr cred
forall coin cr pl ptr.
UMap coin cr pl ptr -> View coin cr pl ptr ptr cr
Ptrs (Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
forall coin cred pool ptr.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
UnifiedMap Map cred (Trip coin ptr pool)
x Map ptr cred
y)

unView :: View coin cr pl ptr k v -> UMap coin cr pl ptr
unView :: View coin cr pl ptr k v -> UMap coin cr pl ptr
unView (Rewards UMap coin cr pl ptr
um) = UMap coin cr pl ptr
um
unView (Delegations UMap coin cr pl ptr
um) = UMap coin cr pl ptr
um
unView (Ptrs UMap coin cr pl ptr
um) = UMap coin cr pl ptr
um

-- | This is expensive, use it wisely (like maybe once per epoch boundary to make a SnapShot)
--   See also domRestrictedView, which domain restricts before computing a view.
unUnify :: View coin cred pool ptr k v -> Map k v
unUnify :: View coin cred pool ptr k v -> Map k v
unUnify (Rewards (UnifiedMap Map cred (Trip coin ptr pool)
tripmap Map ptr cred
_)) = (Trip coin ptr pool -> Maybe coin)
-> Map cred (Trip coin ptr pool) -> Map cred coin
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Trip coin ptr pool -> Maybe coin
forall coin ptr pool. Trip coin ptr pool -> Maybe coin
tripReward Map cred (Trip coin ptr pool)
tripmap
unUnify (Delegations (UnifiedMap Map cred (Trip coin ptr pool)
tripmap Map ptr cred
_)) = (Trip coin ptr pool -> Maybe pool)
-> Map cred (Trip coin ptr pool) -> Map cred pool
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Trip coin ptr pool -> Maybe pool
forall coin ptr pool. Trip coin ptr pool -> Maybe pool
tripDelegation Map cred (Trip coin ptr pool)
tripmap
unUnify (Ptrs (UnifiedMap Map cred (Trip coin ptr pool)
_ Map ptr cred
ptrmap)) = Map ptr cred
Map k v
ptrmap

-- | This is expensive, use it wisely (like maybe once per epoch boundary to make a SnapShot)
viewToVMap :: Ord cred => View coin cred pool ptr k v -> VMap.VMap VMap.VB VMap.VB k v
viewToVMap :: View coin cred pool ptr k v -> VMap VB VB k v
viewToVMap View coin cred pool ptr k v
view =
  case View coin cred pool ptr k v
view of
    Rewards (UnifiedMap Map cred (Trip coin ptr pool)
tripmap Map ptr cred
_) ->
      Int -> [(cred, coin)] -> VMap VB VB cred coin
forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
Int -> [(k, v)] -> VMap kv vv k v
VMap.fromListN (View coin cred pool ptr k v -> Int
forall coin cred pool ptr k a. View coin cred pool ptr k a -> Int
size View coin cred pool ptr k v
view) ([(cred, coin)] -> VMap VB VB cred coin)
-> (Map cred (Trip coin ptr pool) -> [(cred, coin)])
-> Map cred (Trip coin ptr pool)
-> VMap VB VB cred coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((cred, Trip coin ptr pool) -> Maybe (cred, coin))
-> [(cred, Trip coin ptr pool)] -> [(cred, coin)]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe (cred, Trip coin ptr pool) -> Maybe (cred, coin)
forall a b ptr pool. (a, Trip b ptr pool) -> Maybe (a, b)
toReward ([(cred, Trip coin ptr pool)] -> [(cred, coin)])
-> (Map cred (Trip coin ptr pool) -> [(cred, Trip coin ptr pool)])
-> Map cred (Trip coin ptr pool)
-> [(cred, coin)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map cred (Trip coin ptr pool) -> [(cred, Trip coin ptr pool)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map cred (Trip coin ptr pool) -> VMap VB VB cred coin)
-> Map cred (Trip coin ptr pool) -> VMap VB VB cred coin
forall a b. (a -> b) -> a -> b
$ Map cred (Trip coin ptr pool)
tripmap
    Delegations (UnifiedMap Map cred (Trip coin ptr pool)
tripmap Map ptr cred
_) ->
      Int -> [(cred, pool)] -> VMap VB VB cred pool
forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
Int -> [(k, v)] -> VMap kv vv k v
VMap.fromListN (View coin cred pool ptr k v -> Int
forall coin cred pool ptr k a. View coin cred pool ptr k a -> Int
size View coin cred pool ptr k v
view) ([(cred, pool)] -> VMap VB VB cred pool)
-> (Map cred (Trip coin ptr pool) -> [(cred, pool)])
-> Map cred (Trip coin ptr pool)
-> VMap VB VB cred pool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((cred, Trip coin ptr pool) -> Maybe (cred, pool))
-> [(cred, Trip coin ptr pool)] -> [(cred, pool)]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe (cred, Trip coin ptr pool) -> Maybe (cred, pool)
forall a coin ptr b. (a, Trip coin ptr b) -> Maybe (a, b)
toDelegation ([(cred, Trip coin ptr pool)] -> [(cred, pool)])
-> (Map cred (Trip coin ptr pool) -> [(cred, Trip coin ptr pool)])
-> Map cred (Trip coin ptr pool)
-> [(cred, pool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map cred (Trip coin ptr pool) -> [(cred, Trip coin ptr pool)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map cred (Trip coin ptr pool) -> VMap VB VB cred pool)
-> Map cred (Trip coin ptr pool) -> VMap VB VB cred pool
forall a b. (a -> b) -> a -> b
$ Map cred (Trip coin ptr pool)
tripmap
    Ptrs (UnifiedMap Map cred (Trip coin ptr pool)
_ Map ptr cred
ptrmap) -> Map ptr cred -> VMap VB VB ptr cred
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap Map ptr cred
ptrmap
  where
    toReward :: (a, Trip b ptr pool) -> Maybe (a, b)
toReward (a
key, Trip b ptr pool
t) = (,) a
key (b -> (a, b)) -> Maybe b -> Maybe (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Trip b ptr pool -> Maybe b
forall coin ptr pool. Trip coin ptr pool -> Maybe coin
tripReward Trip b ptr pool
t
    toDelegation :: (a, Trip coin ptr b) -> Maybe (a, b)
toDelegation (a
key, Trip coin ptr b
t) = (,) a
key (b -> (a, b)) -> Maybe b -> Maybe (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Trip coin ptr b -> Maybe b
forall coin ptr pool. Trip coin ptr pool -> Maybe pool
tripDelegation Trip coin ptr b
t

rewView :: UMap coin cred pool ptr -> Map.Map cred coin
rewView :: UMap coin cred pool ptr -> Map cred coin
rewView UMap coin cred pool ptr
x = View coin cred pool ptr cred coin -> Map cred coin
forall coin cred pool ptr k v.
View coin cred pool ptr k v -> Map k v
unUnify (UMap coin cred pool ptr -> View coin cred pool ptr cred coin
forall coin cr pl ptr.
UMap coin cr pl ptr -> View coin cr pl ptr cr coin
Rewards UMap coin cred pool ptr
x)

delView :: UMap coin cred pool ptr -> Map.Map cred pool
delView :: UMap coin cred pool ptr -> Map cred pool
delView UMap coin cred pool ptr
x = View coin cred pool ptr cred pool -> Map cred pool
forall coin cred pool ptr k v.
View coin cred pool ptr k v -> Map k v
unUnify (UMap coin cred pool ptr -> View coin cred pool ptr cred pool
forall coin cr pl ptr.
UMap coin cr pl ptr -> View coin cr pl ptr cr pl
Delegations UMap coin cred pool ptr
x)

ptrView :: UMap coin cred pool ptr -> Map.Map ptr cred
ptrView :: UMap coin cred pool ptr -> Map ptr cred
ptrView UMap coin cred pool ptr
x = View coin cred pool ptr ptr cred -> Map ptr cred
forall coin cred pool ptr k v.
View coin cred pool ptr k v -> Map k v
unUnify (UMap coin cred pool ptr -> View coin cred pool ptr ptr cred
forall coin cr pl ptr.
UMap coin cr pl ptr -> View coin cr pl ptr ptr cr
Ptrs UMap coin cred pool ptr
x)

-- | Return the appropriate View of a domain restricted Umap. f 'setk' is small this should be efficient.
domRestrictedView :: (Ord ptr, Ord cred) => Set k -> View coin cred pl ptr k v -> Map.Map k v
domRestrictedView :: Set k -> View coin cred pl ptr k v -> Map k v
domRestrictedView Set k
setk (Rewards (UnifiedMap Map cred (Trip coin ptr pl)
tripmap Map ptr cred
_)) =
  (Trip coin ptr pl -> Maybe coin)
-> Map cred (Trip coin ptr pl) -> Map cred coin
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Trip coin ptr pl -> Maybe coin
forall coin ptr pool. Trip coin ptr pool -> Maybe coin
tripReward (Map cred (Trip coin ptr pl)
-> Set cred -> Map cred (Trip coin ptr pl)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map cred (Trip coin ptr pl)
tripmap Set cred
Set k
setk)
domRestrictedView Set k
setk (Delegations (UnifiedMap Map cred (Trip coin ptr pl)
tripmap Map ptr cred
_)) =
  (Trip coin ptr pl -> Maybe pl)
-> Map cred (Trip coin ptr pl) -> Map cred pl
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Trip coin ptr pl -> Maybe pl
forall coin ptr pool. Trip coin ptr pool -> Maybe pool
tripDelegation (Map cred (Trip coin ptr pl)
-> Set cred -> Map cred (Trip coin ptr pl)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map cred (Trip coin ptr pl)
tripmap Set cred
Set k
setk)
domRestrictedView Set k
setk (Ptrs (UnifiedMap Map cred (Trip coin ptr pl)
_ Map ptr cred
ptrmap)) = Map ptr cred -> Set ptr -> Map ptr cred
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map ptr cred
ptrmap Set ptr
Set k
setk

instance Foldable (View coin cred pool ptr k) where
  foldMap :: (a -> m) -> View coin cred pool ptr k a -> m
foldMap a -> m
f (Rewards (UnifiedMap Map cred (Trip coin ptr pool)
tmap Map ptr cred
_)) = (m -> cred -> Trip a ptr pool -> m)
-> m -> Map cred (Trip a ptr pool) -> m
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey m -> cred -> Trip a ptr pool -> m
accum m
forall a. Monoid a => a
mempty Map cred (Trip coin ptr pool)
Map cred (Trip a ptr pool)
tmap
    where
      accum :: m -> cred -> Trip a ptr pool -> m
accum m
ans cred
_ (Triple (SJust a
c) Set ptr
_ StrictMaybe pool
_) = m
ans m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
c
      accum m
ans cred
_ Trip a ptr pool
_ = m
ans
  foldMap a -> m
f (Delegations (UnifiedMap Map cred (Trip coin ptr pool)
tmap Map ptr cred
_)) = (m -> cred -> Trip coin ptr a -> m)
-> m -> Map cred (Trip coin ptr a) -> m
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey m -> cred -> Trip coin ptr a -> m
accum m
forall a. Monoid a => a
mempty Map cred (Trip coin ptr pool)
Map cred (Trip coin ptr a)
tmap
    where
      accum :: m -> cred -> Trip coin ptr a -> m
accum m
ans cred
_ (Triple StrictMaybe coin
_ Set ptr
_ (SJust a
c)) = m
ans m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
c
      accum m
ans cred
_ (Triple StrictMaybe coin
_ Set ptr
_ StrictMaybe a
SNothing) = m
ans
  foldMap a -> m
f (Ptrs (UnifiedMap Map cred (Trip coin ptr pool)
_ Map ptr cred
ptrmap)) = (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 cred
Map ptr a
ptrmap
  foldr :: (a -> b -> b) -> b -> View coin cred pool ptr k a -> b
foldr a -> b -> b
accum b
ans0 (Rewards (UnifiedMap Map cred (Trip coin ptr pool)
tmap Map ptr cred
_)) = (Trip a ptr pool -> b -> b) -> b -> Map cred (Trip a ptr pool) -> b
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr Trip a ptr pool -> b -> b
accum2 b
ans0 Map cred (Trip coin ptr pool)
Map cred (Trip a ptr pool)
tmap
    where
      accum2 :: Trip a ptr pool -> b -> b
accum2 (Triple (SJust a
c) Set ptr
_ StrictMaybe pool
_) b
ans = a -> b -> b
accum a
c b
ans
      accum2 Trip a ptr pool
_ b
ans = b
ans
  foldr a -> b -> b
accum b
ans0 (Delegations (UnifiedMap Map cred (Trip coin ptr pool)
tmap Map ptr cred
_)) = (Trip coin ptr a -> b -> b) -> b -> Map cred (Trip coin ptr a) -> b
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr Trip coin ptr a -> b -> b
accum2 b
ans0 Map cred (Trip coin ptr pool)
Map cred (Trip coin ptr a)
tmap
    where
      accum2 :: Trip coin ptr a -> b -> b
accum2 (Triple StrictMaybe coin
_ Set ptr
_ (SJust a
c)) b
ans = a -> b -> b
accum a
c b
ans
      accum2 (Triple StrictMaybe coin
_ Set ptr
_ StrictMaybe a
SNothing) b
ans = b
ans
  foldr a -> b -> b
accum b
ans (Ptrs (UnifiedMap Map cred (Trip coin ptr pool)
_ Map ptr cred
ptrmap)) = (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
ans Map ptr cred
Map ptr a
ptrmap

  foldl' :: (b -> a -> b) -> b -> View coin cred pool ptr k a -> b
foldl' b -> a -> b
accum b
ans0 (Rewards (UnifiedMap Map cred (Trip coin ptr pool)
tmap Map ptr cred
_)) = (b -> Trip a ptr pool -> b) -> b -> Map cred (Trip a ptr pool) -> b
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' b -> Trip a ptr pool -> b
accum2 b
ans0 Map cred (Trip coin ptr pool)
Map cred (Trip a ptr pool)
tmap
    where
      accum2 :: b -> Trip a ptr pool -> b
accum2 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)
-> (Trip a ptr pool -> Maybe a) -> Trip a ptr pool -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trip a ptr pool -> Maybe a
forall coin ptr pool. Trip coin ptr pool -> Maybe coin
tripReward
  foldl' b -> a -> b
accum b
ans0 (Delegations (UnifiedMap Map cred (Trip coin ptr pool)
tmap Map ptr cred
_)) = (b -> Trip coin ptr a -> b) -> b -> Map cred (Trip coin ptr a) -> b
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' b -> Trip coin ptr a -> b
accum2 b
ans0 Map cred (Trip coin ptr pool)
Map cred (Trip coin ptr a)
tmap
    where
      accum2 :: b -> Trip coin ptr a -> b
accum2 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)
-> (Trip coin ptr a -> Maybe a) -> Trip coin ptr a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trip coin ptr a -> Maybe a
forall coin ptr pool. Trip coin ptr pool -> Maybe pool
tripDelegation
  foldl' b -> a -> b
accum b
ans (Ptrs (UnifiedMap Map cred (Trip coin ptr pool)
_ Map ptr cred
ptrmap)) = (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
ans Map ptr cred
Map ptr a
ptrmap
  length :: View coin cred pool ptr k a -> Int
length = View coin cred pool ptr k a -> Int
forall coin cred pool ptr k a. View coin cred pool ptr k a -> Int
size

-- =======================================================
-- Operations on Triple

instance (Ord ptr, Monoid coin) => Semigroup (Trip coin ptr pool) where
  <> :: Trip coin ptr pool -> Trip coin ptr pool -> Trip coin ptr pool
(<>) (Triple StrictMaybe coin
c1 Set ptr
ptrs1 StrictMaybe pool
x) (Triple StrictMaybe coin
c2 Set ptr
ptrs2 StrictMaybe pool
y) =
    StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
forall coin ptr pool.
StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
Triple (StrictMaybe coin -> StrictMaybe coin -> StrictMaybe coin
forall x.
Monoid x =>
StrictMaybe x -> StrictMaybe x -> StrictMaybe x
appendStrictMaybe StrictMaybe coin
c1 StrictMaybe coin
c2) (Set ptr -> Set ptr -> Set ptr
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set ptr
ptrs1 Set ptr
ptrs2) (StrictMaybe pool -> StrictMaybe pool -> StrictMaybe pool
forall a. StrictMaybe a -> StrictMaybe a -> StrictMaybe a
add StrictMaybe pool
x StrictMaybe pool
y)
    where
      add :: StrictMaybe a -> StrictMaybe a -> StrictMaybe a
add StrictMaybe a
SNothing StrictMaybe a
SNothing = StrictMaybe a
forall a. StrictMaybe a
SNothing
      add (SJust a
w) StrictMaybe a
SNothing = a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust a
w
      add StrictMaybe a
SNothing (SJust a
z) = a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust a
z
      add (SJust a
w) (SJust a
_) = a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust a
w

appendStrictMaybe :: Monoid x => StrictMaybe x -> StrictMaybe x -> StrictMaybe x
appendStrictMaybe :: StrictMaybe x -> StrictMaybe x -> StrictMaybe x
appendStrictMaybe StrictMaybe x
SNothing StrictMaybe x
SNothing = StrictMaybe x
forall a. StrictMaybe a
SNothing
appendStrictMaybe (SJust x
w) StrictMaybe x
SNothing = x -> StrictMaybe x
forall a. a -> StrictMaybe a
SJust x
w
appendStrictMaybe StrictMaybe x
SNothing (SJust x
z) = x -> StrictMaybe x
forall a. a -> StrictMaybe a
SJust x
z
appendStrictMaybe (SJust x
c1) (SJust x
c2) = x -> StrictMaybe x
forall a. a -> StrictMaybe a
SJust (x
c1 x -> x -> x
forall a. Semigroup a => a -> a -> a
<> x
c2)

instance (Ord ptr, Monoid coin) => Monoid (Trip coin ptr pool) where
  mempty :: Trip coin ptr pool
mempty = StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
forall coin ptr pool.
StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
Triple StrictMaybe coin
forall a. StrictMaybe a
SNothing Set ptr
forall a. Set a
Set.empty StrictMaybe pool
forall a. StrictMaybe a
SNothing

-- | Is there no information in a Triple? If so then we can delete it from the UnifedMap
zero :: Trip coin ptr pool -> Bool
zero :: Trip coin ptr pool -> Bool
zero (Triple StrictMaybe coin
SNothing Set ptr
s StrictMaybe pool
SNothing) | Set ptr -> Bool
forall a. Set a -> Bool
Set.null Set ptr
s = Bool
True
zero Trip coin ptr pool
_ = Bool
False

zeroMaybe :: Trip coin ptr pool -> Maybe (Trip coin ptr pool)
zeroMaybe :: Trip coin ptr pool -> Maybe (Trip coin ptr pool)
zeroMaybe Trip coin ptr pool
t | Trip coin ptr pool -> Bool
forall coin ptr pool. Trip coin ptr pool -> Bool
zero Trip coin ptr pool
t = Maybe (Trip coin ptr pool)
forall a. Maybe a
Nothing
zeroMaybe Trip coin ptr pool
t = Trip coin ptr pool -> Maybe (Trip coin ptr pool)
forall a. a -> Maybe a
Just Trip coin ptr pool
t

-- ===============================================================

mapNext :: Map k v -> Maybe (k, v, Map k v)
mapNext :: Map k v -> Maybe (k, v, Map k v)
mapNext Map k v
m =
  case Map k v -> Maybe ((k, v), Map k v)
forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey Map k v
m of
    Maybe ((k, v), Map k v)
Nothing -> Maybe (k, v, Map k v)
forall a. Maybe a
Nothing
    Just ((k
k, v
v), Map k v
m2) -> (k, v, Map k v) -> Maybe (k, v, Map k v)
forall a. a -> Maybe a
Just (k
k, v
v, Map k v
m2)

mapLub :: Ord k => k -> Map k v -> Maybe (k, v, Map k v)
mapLub :: k -> Map k v -> Maybe (k, v, Map k v)
mapLub k
k Map k v
m =
  case k -> Map k v -> (Map k v, Maybe v, Map k v)
forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
Map.splitLookup k
k Map k v
m of
    (Map k v
_, Maybe v
Nothing, Map k v
m2) -> Map k v -> Maybe (k, v, Map k v)
forall k v. Map k v -> Maybe (k, v, Map k v)
mapNext Map k v
m2
    (Map k v
_, Just v
v, Map k v
m2) -> (k, v, Map k v) -> Maybe (k, v, Map k v)
forall a. a -> Maybe a
Just (k
k, v
v, Map k v
m2)

-- ================================================================
-- Iter Operations

next :: View coin cr pl ptr k v -> Maybe (k, v, View coin cr pl ptr k v)
next :: View coin cr pl ptr k v -> Maybe (k, v, View coin cr pl ptr k v)
next (Rewards (UnifiedMap Map cr (Trip coin ptr pl)
tripmap Map ptr cr
_)) =
  case Map cr (Trip coin ptr pl)
-> Maybe (cr, Trip coin ptr pl, Map cr (Trip coin ptr pl))
forall k v. Map k v -> Maybe (k, v, Map k v)
mapNext Map cr (Trip coin ptr pl)
tripmap of
    Maybe (cr, Trip coin ptr pl, Map cr (Trip coin ptr pl))
Nothing -> Maybe (k, v, View coin cr pl ptr k v)
forall a. Maybe a
Nothing
    Just (cr
k, Triple (SJust coin
coin) Set ptr
_ StrictMaybe pl
_, Map cr (Trip coin ptr pl)
tripmap2) -> (cr, coin, View coin cr pl ptr cr coin)
-> Maybe (cr, coin, View coin cr pl ptr cr coin)
forall a. a -> Maybe a
Just (cr
k, coin
coin, Map cr (Trip coin ptr pl)
-> Map ptr cr -> View coin cr pl ptr cr coin
forall cr coin ptr pool.
Map cr (Trip coin ptr pool)
-> Map ptr cr -> View coin cr pool ptr cr coin
rewards Map cr (Trip coin ptr pl)
tripmap2 Map ptr cr
forall k a. Map k a
Map.empty)
    Just (cr
_, Triple StrictMaybe coin
SNothing Set ptr
_ StrictMaybe pl
_, Map cr (Trip coin ptr pl)
tripmap2) -> View coin cr pl ptr cr coin
-> Maybe (cr, coin, View coin cr pl ptr cr coin)
forall coin cr pl ptr k v.
View coin cr pl ptr k v -> Maybe (k, v, View coin cr pl ptr k v)
next (Map cr (Trip coin ptr pl)
-> Map ptr cr -> View coin cr pl ptr cr coin
forall cr coin ptr pool.
Map cr (Trip coin ptr pool)
-> Map ptr cr -> View coin cr pool ptr cr coin
rewards Map cr (Trip coin ptr pl)
tripmap2 Map ptr cr
forall k a. Map k a
Map.empty)
next (Delegations (UnifiedMap Map cr (Trip coin ptr pl)
tripmap Map ptr cr
_)) =
  case Map cr (Trip coin ptr pl)
-> Maybe (cr, Trip coin ptr pl, Map cr (Trip coin ptr pl))
forall k v. Map k v -> Maybe (k, v, Map k v)
mapNext Map cr (Trip coin ptr pl)
tripmap of
    Maybe (cr, Trip coin ptr pl, Map cr (Trip coin ptr pl))
Nothing -> Maybe (k, v, View coin cr pl ptr k v)
forall a. Maybe a
Nothing
    Just (cr
k, Triple StrictMaybe coin
_ Set ptr
_ (SJust pl
poolid), Map cr (Trip coin ptr pl)
tripmap2) -> (cr, pl, View coin cr pl ptr cr pl)
-> Maybe (cr, pl, View coin cr pl ptr cr pl)
forall a. a -> Maybe a
Just (cr
k, pl
poolid, Map cr (Trip coin ptr pl)
-> Map ptr cr -> View coin cr pl ptr cr pl
forall cred coin ptr pool.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> View coin cred pool ptr cred pool
delegations Map cr (Trip coin ptr pl)
tripmap2 Map ptr cr
forall k a. Map k a
Map.empty)
    Just (cr
_, Triple StrictMaybe coin
_ Set ptr
_ StrictMaybe pl
SNothing, Map cr (Trip coin ptr pl)
tripmap2) -> View coin cr pl ptr cr pl
-> Maybe (cr, pl, View coin cr pl ptr cr pl)
forall coin cr pl ptr k v.
View coin cr pl ptr k v -> Maybe (k, v, View coin cr pl ptr k v)
next (Map cr (Trip coin ptr pl)
-> Map ptr cr -> View coin cr pl ptr cr pl
forall cred coin ptr pool.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> View coin cred pool ptr cred pool
delegations Map cr (Trip coin ptr pl)
tripmap2 Map ptr cr
forall k a. Map k a
Map.empty)
next (Ptrs (UnifiedMap Map cr (Trip coin ptr pl)
tripmap Map ptr cr
ptrmap)) =
  case Map ptr cr -> Maybe (ptr, cr, Map ptr cr)
forall k v. Map k v -> Maybe (k, v, Map k v)
mapNext Map ptr cr
ptrmap of
    Maybe (ptr, cr, Map ptr cr)
Nothing -> Maybe (k, v, View coin cr pl ptr k v)
forall a. Maybe a
Nothing
    Just (ptr
k, cr
stakeid, Map ptr cr
m2) -> (ptr, cr, View coin cr pl ptr ptr cr)
-> Maybe (ptr, cr, View coin cr pl ptr ptr cr)
forall a. a -> Maybe a
Just (ptr
k, cr
stakeid, Map cr (Trip coin ptr pl)
-> Map ptr cr -> View coin cr pl ptr ptr cr
forall cred coin ptr pool.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> View coin cred pool ptr ptr cred
ptrs (Map cr (Trip coin ptr pl)
forall k a. Map k a
Map.empty Map cr (Trip coin ptr pl)
-> Map cr (Trip coin ptr pl) -> Map cr (Trip coin ptr pl)
forall a. a -> a -> a
`asTypeOf` Map cr (Trip coin ptr pl)
tripmap) Map ptr cr
m2)

leastUpperBound ::
  (Ord ptr, Ord cr) =>
  k ->
  View coin cr pool ptr k v ->
  Maybe (k, v, View coin cr pool ptr k v)
leastUpperBound :: k
-> View coin cr pool ptr k v
-> Maybe (k, v, View coin cr pool ptr k v)
leastUpperBound k
stakeid (Rewards (UnifiedMap Map cr (Trip coin ptr pool)
tripmap Map ptr cr
_)) =
  case k
-> Map k (Trip coin ptr pool)
-> Maybe (k, Trip coin ptr pool, Map k (Trip coin ptr pool))
forall k v. Ord k => k -> Map k v -> Maybe (k, v, Map k v)
mapLub k
stakeid Map cr (Trip coin ptr pool)
Map k (Trip coin ptr pool)
tripmap of
    Maybe (k, Trip coin ptr pool, Map k (Trip coin ptr pool))
Nothing -> Maybe (k, v, View coin cr pool ptr k v)
forall a. Maybe a
Nothing
    Just (k
k, Triple (SJust coin
coin) Set ptr
_ StrictMaybe pool
_, Map k (Trip coin ptr pool)
tripmap2) -> (k, coin, View coin k pool ptr k coin)
-> Maybe (k, coin, View coin k pool ptr k coin)
forall a. a -> Maybe a
Just (k
k, coin
coin, Map k (Trip coin ptr pool)
-> Map ptr k -> View coin k pool ptr k coin
forall cr coin ptr pool.
Map cr (Trip coin ptr pool)
-> Map ptr cr -> View coin cr pool ptr cr coin
rewards Map k (Trip coin ptr pool)
tripmap2 Map ptr k
forall k a. Map k a
Map.empty)
    Just (k
_, Triple StrictMaybe coin
SNothing Set ptr
_ StrictMaybe pool
_, Map k (Trip coin ptr pool)
tripmap2) -> View coin k pool ptr k coin
-> Maybe (k, coin, View coin k pool ptr k coin)
forall coin cr pl ptr k v.
View coin cr pl ptr k v -> Maybe (k, v, View coin cr pl ptr k v)
next (Map k (Trip coin ptr pool)
-> Map ptr k -> View coin k pool ptr k coin
forall cr coin ptr pool.
Map cr (Trip coin ptr pool)
-> Map ptr cr -> View coin cr pool ptr cr coin
rewards Map k (Trip coin ptr pool)
tripmap2 Map ptr k
forall k a. Map k a
Map.empty)
leastUpperBound k
stakeid (Delegations (UnifiedMap Map cr (Trip coin ptr pool)
tripmap Map ptr cr
_)) =
  case k
-> Map k (Trip coin ptr pool)
-> Maybe (k, Trip coin ptr pool, Map k (Trip coin ptr pool))
forall k v. Ord k => k -> Map k v -> Maybe (k, v, Map k v)
mapLub k
stakeid Map cr (Trip coin ptr pool)
Map k (Trip coin ptr pool)
tripmap of
    Maybe (k, Trip coin ptr pool, Map k (Trip coin ptr pool))
Nothing -> Maybe (k, v, View coin cr pool ptr k v)
forall a. Maybe a
Nothing
    Just (k
k, Triple StrictMaybe coin
_ Set ptr
_ (SJust pool
poolid), Map k (Trip coin ptr pool)
tripmap2) -> (k, pool, View coin k pool ptr k pool)
-> Maybe (k, pool, View coin k pool ptr k pool)
forall a. a -> Maybe a
Just (k
k, pool
poolid, Map k (Trip coin ptr pool)
-> Map ptr k -> View coin k pool ptr k pool
forall cred coin ptr pool.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> View coin cred pool ptr cred pool
delegations Map k (Trip coin ptr pool)
tripmap2 Map ptr k
forall k a. Map k a
Map.empty)
    Just (k
_, Triple StrictMaybe coin
_ Set ptr
_ StrictMaybe pool
SNothing, Map k (Trip coin ptr pool)
tripmap2) -> View coin k pool ptr k pool
-> Maybe (k, pool, View coin k pool ptr k pool)
forall coin cr pl ptr k v.
View coin cr pl ptr k v -> Maybe (k, v, View coin cr pl ptr k v)
next (UMap coin k pool ptr -> View coin k pool ptr k pool
forall coin cr pl ptr.
UMap coin cr pl ptr -> View coin cr pl ptr cr pl
Delegations (Map k (Trip coin ptr pool) -> Map ptr k -> UMap coin k pool ptr
forall coin cred pool ptr.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
UnifiedMap Map k (Trip coin ptr pool)
tripmap2 Map ptr k
forall k a. Map k a
Map.empty))
leastUpperBound k
ptr (Ptrs (UnifiedMap Map cr (Trip coin ptr pool)
tripmap Map ptr cr
ptrmap)) =
  case k -> Map k cr -> Maybe (k, cr, Map k cr)
forall k v. Ord k => k -> Map k v -> Maybe (k, v, Map k v)
mapLub k
ptr Map ptr cr
Map k cr
ptrmap of
    Maybe (k, cr, Map k cr)
Nothing -> Maybe (k, v, View coin cr pool ptr k v)
forall a. Maybe a
Nothing
    Just (k
k, cr
stakeid, Map k cr
m2) -> (k, cr, View coin cr pool ptr ptr cr)
-> Maybe (k, cr, View coin cr pool ptr ptr cr)
forall a. a -> Maybe a
Just (k
k, cr
stakeid, Map cr (Trip coin ptr pool)
-> Map ptr cr -> View coin cr pool ptr ptr cr
forall cred coin ptr pool.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> View coin cred pool ptr ptr cred
ptrs (Map cr (Trip coin ptr pool)
forall k a. Map k a
Map.empty Map cr (Trip coin ptr pool)
-> Map cr (Trip coin ptr pool) -> Map cr (Trip coin ptr pool)
forall a. a -> a -> a
`asTypeOf` Map cr (Trip coin ptr pool)
tripmap) Map ptr cr
Map k cr
m2)

-- ==============================================================
-- Basic operations on ViewMap

empty :: UMap coin cr pool ptr
empty :: UMap coin cr pool ptr
empty = Map cr (Trip coin ptr pool) -> Map ptr cr -> UMap coin cr pool ptr
forall coin cred pool ptr.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
UnifiedMap Map cr (Trip coin ptr pool)
forall k a. Map k a
Map.empty Map ptr cr
forall k a. Map k a
Map.empty

delete' ::
  (Ord cr, Ord ptr) =>
  k ->
  View coin cr pool ptr k v ->
  View coin cr pool ptr k v
delete' :: k -> View coin cr pool ptr k v -> View coin cr pool ptr k v
delete' k
stakeid (Rewards (UnifiedMap Map cr (Trip coin ptr pool)
tripmap Map ptr cr
ptrmap)) =
  Map k (Trip coin ptr pool)
-> Map ptr k -> View coin k pool ptr k coin
forall cr coin ptr pool.
Map cr (Trip coin ptr pool)
-> Map ptr cr -> View coin cr pool ptr cr coin
rewards ((Trip coin ptr pool -> Maybe (Trip coin ptr pool))
-> k -> Map k (Trip coin ptr pool) -> Map k (Trip coin ptr pool)
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update Trip coin ptr pool -> Maybe (Trip coin ptr pool)
forall coin ptr pool coin.
Trip coin ptr pool -> Maybe (Trip coin ptr pool)
ok k
stakeid Map cr (Trip coin ptr pool)
Map k (Trip coin ptr pool)
tripmap) Map ptr cr
Map ptr k
ptrmap
  where
    ok :: Trip coin ptr pool -> Maybe (Trip coin ptr pool)
ok (Triple StrictMaybe coin
_ Set ptr
ptr StrictMaybe pool
poolid) = Trip coin ptr pool -> Maybe (Trip coin ptr pool)
forall coin ptr pool.
Trip coin ptr pool -> Maybe (Trip coin ptr pool)
zeroMaybe (StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
forall coin ptr pool.
StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
Triple StrictMaybe coin
forall a. StrictMaybe a
SNothing Set ptr
ptr StrictMaybe pool
poolid)
delete' k
stakeid (Delegations (UnifiedMap Map cr (Trip coin ptr pool)
tripmap Map ptr cr
ptrmap)) =
  Map k (Trip coin ptr pool)
-> Map ptr k -> View coin k pool ptr k pool
forall cred coin ptr pool.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> View coin cred pool ptr cred pool
delegations ((Trip coin ptr pool -> Maybe (Trip coin ptr pool))
-> k -> Map k (Trip coin ptr pool) -> Map k (Trip coin ptr pool)
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update Trip coin ptr pool -> Maybe (Trip coin ptr pool)
forall coin ptr pool pool.
Trip coin ptr pool -> Maybe (Trip coin ptr pool)
ok k
stakeid Map cr (Trip coin ptr pool)
Map k (Trip coin ptr pool)
tripmap) Map ptr cr
Map ptr k
ptrmap
  where
    ok :: Trip coin ptr pool -> Maybe (Trip coin ptr pool)
ok (Triple StrictMaybe coin
c Set ptr
ptr StrictMaybe pool
_) = Trip coin ptr pool -> Maybe (Trip coin ptr pool)
forall coin ptr pool.
Trip coin ptr pool -> Maybe (Trip coin ptr pool)
zeroMaybe (StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
forall coin ptr pool.
StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
Triple StrictMaybe coin
c Set ptr
ptr StrictMaybe pool
forall a. StrictMaybe a
SNothing)
delete' k
ptr (Ptrs (UnifiedMap Map cr (Trip coin ptr pool)
tripmap Map ptr cr
ptrmap)) =
  case k -> Map k cr -> Maybe cr
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
ptr Map ptr cr
Map k cr
ptrmap of
    Maybe cr
Nothing -> UMap coin cr pool ptr -> View coin cr pool ptr ptr cr
forall coin cr pl ptr.
UMap coin cr pl ptr -> View coin cr pl ptr ptr cr
Ptrs (Map cr (Trip coin ptr pool) -> Map ptr cr -> UMap coin cr pool ptr
forall coin cred pool ptr.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
UnifiedMap Map cr (Trip coin ptr pool)
tripmap Map ptr cr
ptrmap)
    Just cr
stakeid -> Map cr (Trip coin k pool) -> Map k cr -> View coin cr pool k k cr
forall cred coin ptr pool.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> View coin cred pool ptr ptr cred
ptrs ((Trip coin k pool -> Maybe (Trip coin k pool))
-> cr -> Map cr (Trip coin k pool) -> Map cr (Trip coin k pool)
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update Trip coin k pool -> Maybe (Trip coin k pool)
ok cr
stakeid Map cr (Trip coin ptr pool)
Map cr (Trip coin k pool)
tripmap) (k -> Map k cr -> Map k cr
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete k
ptr Map ptr cr
Map k cr
ptrmap)
      where
        ok :: Trip coin k pool -> Maybe (Trip coin k pool)
ok (Triple StrictMaybe coin
coin Set k
ptrset StrictMaybe pool
poolid) = Trip coin k pool -> Maybe (Trip coin k pool)
forall coin ptr pool.
Trip coin ptr pool -> Maybe (Trip coin ptr pool)
zeroMaybe (StrictMaybe coin -> Set k -> StrictMaybe pool -> Trip coin k pool
forall coin ptr pool.
StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
Triple StrictMaybe coin
coin (k -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
Set.delete k
ptr Set k
ptrset) StrictMaybe pool
poolid)

delete :: (Ord cr, Ord ptr) => k -> View coin cr pool ptr k v -> UMap coin cr pool ptr
delete :: k -> View coin cr pool ptr k v -> UMap coin cr pool ptr
delete k
k View coin cr pool ptr k v
m = View coin cr pool ptr k v -> UMap coin cr pool ptr
forall coin cr pl ptr k v.
View coin cr pl ptr k v -> UMap coin cr pl ptr
unView (k -> View coin cr pool ptr k v -> View coin cr pool ptr k v
forall cr ptr k coin pool v.
(Ord cr, Ord ptr) =>
k -> View coin cr pool ptr k v -> View coin cr pool ptr k v
delete' k
k View coin cr pool ptr k v
m)

-- | Special insertion:
--
--  Keeps the value already in the ViewMap if the key 'k' is already there:
--
-- > insertWith' (\ old new -> old) k v xs
--
-- Replaces the value already in the ViewMap with 'v', if key 'k' is already there:
--
-- > insertWith' (\ old new -> new) k v xs
--
-- Replaces the value already in the ViewMap with the sum, if key 'k' is already there:
--
-- > insertWith' (\ old new -> old+new) k v xs
--
-- Ignores 'combine' if the key 'k' is NOT already in the ViewMap, and inserts 'v':
--
-- > insertWith' combine k v xs
insertWith' ::
  (Ord cr, Monoid coin, Ord ptr) =>
  (v -> v -> v) ->
  k ->
  v ->
  View coin cr pool ptr k v ->
  View coin cr pool ptr k v
insertWith' :: (v -> v -> v)
-> k -> v -> View coin cr pool ptr k v -> View coin cr pool ptr k v
insertWith' v -> v -> v
comb k
stakeid v
newcoin (Rewards (UnifiedMap Map cr (Trip coin ptr pool)
tripmap Map ptr cr
ptrmap)) =
  Map k (Trip v ptr pool) -> Map ptr k -> View v k pool ptr k v
forall cr coin ptr pool.
Map cr (Trip coin ptr pool)
-> Map ptr cr -> View coin cr pool ptr cr coin
rewards ((Maybe (Trip v ptr pool) -> Maybe (Trip v ptr pool))
-> k -> Map k (Trip v ptr pool) -> Map k (Trip v ptr pool)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe (Trip v ptr pool) -> Maybe (Trip v ptr pool)
comb2 k
stakeid Map cr (Trip coin ptr pool)
Map k (Trip v ptr pool)
tripmap) Map ptr cr
Map ptr k
ptrmap
  where
    comb2 :: Maybe (Trip v ptr pool) -> Maybe (Trip v ptr pool)
comb2 Maybe (Trip v ptr pool)
Nothing = Trip v ptr pool -> Maybe (Trip v ptr pool)
forall a. a -> Maybe a
Just (StrictMaybe v -> Set ptr -> StrictMaybe pool -> Trip v ptr pool
forall coin ptr pool.
StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
Triple (v -> StrictMaybe v
forall a. a -> StrictMaybe a
SJust v
newcoin) Set ptr
forall a. Set a
Set.empty StrictMaybe pool
forall a. StrictMaybe a
SNothing)
    comb2 (Just (Triple (SJust v
oldcoin) Set ptr
x StrictMaybe pool
y)) = Trip v ptr pool -> Maybe (Trip v ptr pool)
forall coin ptr pool.
Trip coin ptr pool -> Maybe (Trip coin ptr pool)
zeroMaybe (StrictMaybe v -> Set ptr -> StrictMaybe pool -> Trip v ptr pool
forall coin ptr pool.
StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
Triple (v -> StrictMaybe v
forall a. a -> StrictMaybe a
SJust (v -> v -> v
comb v
oldcoin v
newcoin)) Set ptr
x StrictMaybe pool
y)
    comb2 (Just (Triple StrictMaybe v
SNothing Set ptr
x StrictMaybe pool
y)) = Trip v ptr pool -> Maybe (Trip v ptr pool)
forall coin ptr pool.
Trip coin ptr pool -> Maybe (Trip coin ptr pool)
zeroMaybe (StrictMaybe v -> Set ptr -> StrictMaybe pool -> Trip v ptr pool
forall coin ptr pool.
StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
Triple (v -> StrictMaybe v
forall a. a -> StrictMaybe a
SJust v
newcoin) Set ptr
x StrictMaybe pool
y)
insertWith' v -> v -> v
comb k
stakeid v
newpoolid (Delegations (UnifiedMap Map cr (Trip coin ptr pool)
tripmap Map ptr cr
ptrmap)) =
  Map k (Trip coin ptr v) -> Map ptr k -> View coin k v ptr k v
forall cred coin ptr pool.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> View coin cred pool ptr cred pool
delegations ((Maybe (Trip coin ptr v) -> Maybe (Trip coin ptr v))
-> k -> Map k (Trip coin ptr v) -> Map k (Trip coin ptr v)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe (Trip coin ptr v) -> Maybe (Trip coin ptr v)
comb2 k
stakeid Map cr (Trip coin ptr pool)
Map k (Trip coin ptr v)
tripmap) Map ptr cr
Map ptr k
ptrmap
  where
    comb2 :: Maybe (Trip coin ptr v) -> Maybe (Trip coin ptr v)
comb2 Maybe (Trip coin ptr v)
Nothing = Trip coin ptr v -> Maybe (Trip coin ptr v)
forall a. a -> Maybe a
Just (StrictMaybe coin -> Set ptr -> StrictMaybe v -> Trip coin ptr v
forall coin ptr pool.
StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
Triple StrictMaybe coin
forall a. StrictMaybe a
SNothing Set ptr
forall a. Set a
Set.empty (v -> StrictMaybe v
forall a. a -> StrictMaybe a
SJust v
newpoolid))
    comb2 (Just (Triple StrictMaybe coin
x Set ptr
y (SJust v
old))) = Trip coin ptr v -> Maybe (Trip coin ptr v)
forall a. a -> Maybe a
Just (StrictMaybe coin -> Set ptr -> StrictMaybe v -> Trip coin ptr v
forall coin ptr pool.
StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
Triple StrictMaybe coin
x Set ptr
y (v -> StrictMaybe v
forall a. a -> StrictMaybe a
SJust (v -> v -> v
comb v
old v
newpoolid)))
    comb2 (Just (Triple StrictMaybe coin
x Set ptr
y StrictMaybe v
SNothing)) = Trip coin ptr v -> Maybe (Trip coin ptr v)
forall a. a -> Maybe a
Just (StrictMaybe coin -> Set ptr -> StrictMaybe v -> Trip coin ptr v
forall coin ptr pool.
StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
Triple StrictMaybe coin
x Set ptr
y (v -> StrictMaybe v
forall a. a -> StrictMaybe a
SJust v
newpoolid))
insertWith' v -> v -> v
comb k
ptr v
stake (Ptrs (UnifiedMap Map cr (Trip coin ptr pool)
tripmap Map ptr cr
ptrmap)) =
  let (v
oldstake, v
newstake) =
        case k -> Map k cr -> Maybe cr
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
ptr Map ptr cr
Map k cr
ptrmap of -- This is tricky, because we need to retract the oldstake
          Maybe cr
Nothing -> (v
stake, v
stake) -- and to add the newstake to maintain the UnifiedMap invariant
          Just cr
stake2 -> (cr
v
stake2, v -> v -> v
comb cr
v
stake2 v
stake)
      -- Delete pointer from set in Triple, but also delete the whole triple if it goes to Zero.
      retract :: k
-> ptr -> Map k (Trip coin ptr pool) -> Map k (Trip coin ptr pool)
retract k
stakeid ptr
pointer Map k (Trip coin ptr pool)
m = (Trip coin ptr pool -> Maybe (Trip coin ptr pool))
-> k -> Map k (Trip coin ptr pool) -> Map k (Trip coin ptr pool)
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update Trip coin ptr pool -> Maybe (Trip coin ptr pool)
ok k
stakeid Map k (Trip coin ptr pool)
m
        where
          ok :: Trip coin ptr pool -> Maybe (Trip coin ptr pool)
ok (Triple StrictMaybe coin
c Set ptr
set StrictMaybe pool
d) = Trip coin ptr pool -> Maybe (Trip coin ptr pool)
forall coin ptr pool.
Trip coin ptr pool -> Maybe (Trip coin ptr pool)
zeroMaybe (StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
forall coin ptr pool.
StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
Triple StrictMaybe coin
c (ptr -> Set ptr -> Set ptr
forall a. Ord a => a -> Set a -> Set a
Set.delete ptr
pointer Set ptr
set) StrictMaybe pool
d)
      add :: k
-> ptr -> Map k (Trip coin ptr pool) -> Map k (Trip coin ptr pool)
add k
stakeid ptr
pointer Map k (Trip coin ptr pool)
m =
        (Trip coin ptr pool -> Trip coin ptr pool -> Trip coin ptr pool)
-> k
-> Trip coin ptr pool
-> Map k (Trip coin ptr pool)
-> Map k (Trip coin ptr pool)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Trip coin ptr pool -> Trip coin ptr pool -> Trip coin ptr pool
forall a. Semigroup a => a -> a -> a
(<>) k
stakeid (StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
forall coin ptr pool.
StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
Triple StrictMaybe coin
forall a. StrictMaybe a
SNothing (ptr -> Set ptr
forall a. a -> Set a
Set.singleton ptr
pointer) StrictMaybe pool
forall a. StrictMaybe a
SNothing) Map k (Trip coin ptr pool)
m
      tripmap2 :: Map v (Trip coin k pool)
tripmap2 = v -> k -> Map v (Trip coin k pool) -> Map v (Trip coin k pool)
forall k ptr coin pool.
(Ord k, Ord ptr, Monoid coin) =>
k
-> ptr -> Map k (Trip coin ptr pool) -> Map k (Trip coin ptr pool)
add v
newstake k
ptr (v -> k -> Map v (Trip coin k pool) -> Map v (Trip coin k pool)
forall ptr k coin pool.
(Ord ptr, Ord k) =>
k
-> ptr -> Map k (Trip coin ptr pool) -> Map k (Trip coin ptr pool)
retract v
oldstake k
ptr Map cr (Trip coin ptr pool)
Map v (Trip coin k pool)
tripmap)
      ptrmap2 :: Map k v
ptrmap2 = k -> v -> Map k v -> Map k v
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
ptr v
newstake Map ptr cr
Map k v
ptrmap
   in UMap coin v pool k -> View coin v pool k k v
forall coin cr pl ptr.
UMap coin cr pl ptr -> View coin cr pl ptr ptr cr
Ptrs (Map v (Trip coin k pool) -> Map k v -> UMap coin v pool k
forall coin cred pool ptr.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
UnifiedMap Map v (Trip coin k pool)
tripmap2 Map k v
ptrmap2)

insertWith ::
  (Ord cr, Monoid coin, Ord ptr) =>
  (v -> v -> v) ->
  k ->
  v ->
  View coin cr pool ptr k v ->
  UMap coin cr pool ptr
insertWith :: (v -> v -> v)
-> k -> v -> View coin cr pool ptr k v -> UMap coin cr pool ptr
insertWith v -> v -> v
comb k
k v
v View coin cr pool ptr k v
m = View coin cr pool ptr k v -> UMap coin cr pool ptr
forall coin cr pl ptr k v.
View coin cr pl ptr k v -> UMap coin cr pl ptr
unView ((v -> v -> v)
-> k -> v -> View coin cr pool ptr k v -> View coin cr pool ptr k v
forall cr coin ptr v k pool.
(Ord cr, Monoid coin, Ord ptr) =>
(v -> v -> v)
-> k -> v -> View coin cr pool ptr k v -> View coin cr pool ptr k v
insertWith' v -> v -> v
comb k
k v
v View coin cr pool ptr k v
m)

insert' ::
  (Ord cr, Monoid coin, Ord ptr) =>
  k ->
  v ->
  View coin cr pool ptr k v ->
  View coin cr pool ptr k v
insert' :: k -> v -> View coin cr pool ptr k v -> View coin cr pool ptr k v
insert' = (v -> v -> v)
-> k -> v -> View coin cr pool ptr k v -> View coin cr pool ptr k v
forall cr coin ptr v k pool.
(Ord cr, Monoid coin, Ord ptr) =>
(v -> v -> v)
-> k -> v -> View coin cr pool ptr k v -> View coin cr pool ptr k v
insertWith' (\v
_old v
new -> v
new)

insert ::
  (Ord cr, Monoid coin, Ord ptr) =>
  k ->
  v ->
  View coin cr pool ptr k v ->
  UMap coin cr pool ptr
insert :: k -> v -> View coin cr pool ptr k v -> UMap coin cr pool ptr
insert k
k v
v View coin cr pool ptr k v
m = View coin cr pool ptr k v -> UMap coin cr pool ptr
forall coin cr pl ptr k v.
View coin cr pl ptr k v -> UMap coin cr pl ptr
unView (k -> v -> View coin cr pool ptr k v -> View coin cr pool ptr k v
forall cr coin ptr k v pool.
(Ord cr, Monoid coin, Ord ptr) =>
k -> v -> View coin cr pool ptr k v -> View coin cr pool ptr k v
insert' k
k v
v View coin cr pool ptr k v
m)

lookup :: (Ord cr, Ord ptr) => k -> View coin cr pool ptr k v -> Maybe v
lookup :: k -> View coin cr pool ptr k v -> Maybe v
lookup k
stakeid (Rewards (UnifiedMap Map cr (Trip coin ptr pool)
tripmap Map ptr cr
_)) =
  k -> Map k (Trip coin ptr pool) -> Maybe (Trip coin ptr pool)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
stakeid Map cr (Trip coin ptr pool)
Map k (Trip coin ptr pool)
tripmap Maybe (Trip coin ptr pool)
-> (Trip coin ptr pool -> Maybe coin) -> Maybe coin
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Trip coin ptr pool -> Maybe coin
forall coin ptr pool. Trip coin ptr pool -> Maybe coin
tripReward
lookup k
stakeid (Delegations (UnifiedMap Map cr (Trip coin ptr pool)
tripmap Map ptr cr
_)) =
  k -> Map k (Trip coin ptr pool) -> Maybe (Trip coin ptr pool)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
stakeid Map cr (Trip coin ptr pool)
Map k (Trip coin ptr pool)
tripmap Maybe (Trip coin ptr pool)
-> (Trip coin ptr pool -> Maybe pool) -> Maybe pool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Trip coin ptr pool -> Maybe pool
forall coin ptr pool. Trip coin ptr pool -> Maybe pool
tripDelegation
lookup k
ptr (Ptrs (UnifiedMap Map cr (Trip coin ptr pool)
_ Map ptr cr
ptrmap)) = k -> Map k cr -> Maybe cr
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
ptr Map ptr cr
Map k cr
ptrmap

isNull :: View coin cr pool ptr k v -> Bool
isNull :: View coin cr pool ptr k v -> Bool
isNull (Rewards (UnifiedMap Map cr (Trip coin ptr pool)
tripmap Map ptr cr
_)) = (Trip coin ptr pool -> Bool) -> Map cr (Trip coin ptr pool) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe coin -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe coin -> Bool)
-> (Trip coin ptr pool -> Maybe coin) -> Trip coin ptr pool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trip coin ptr pool -> Maybe coin
forall coin ptr pool. Trip coin ptr pool -> Maybe coin
tripReward) Map cr (Trip coin ptr pool)
tripmap
isNull (Delegations (UnifiedMap Map cr (Trip coin ptr pool)
tripmap Map ptr cr
_)) = (Trip coin ptr pool -> Bool) -> Map cr (Trip coin ptr pool) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe pool -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe pool -> Bool)
-> (Trip coin ptr pool -> Maybe pool) -> Trip coin ptr pool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trip coin ptr pool -> Maybe pool
forall coin ptr pool. Trip coin ptr pool -> Maybe pool
tripDelegation) Map cr (Trip coin ptr pool)
tripmap
isNull (Ptrs (UnifiedMap Map cr (Trip coin ptr pool)
_ Map ptr cr
ptrmap)) = Map ptr cr -> Bool
forall k a. Map k a -> Bool
Map.null Map ptr cr
ptrmap

domain :: (Ord cr) => View coin cr pool ptr k v -> Set k
domain :: View coin cr pool ptr k v -> Set k
domain (Rewards (UnifiedMap Map cr (Trip coin ptr pool)
tripmap Map ptr cr
_)) = (Set cr -> cr -> Trip coin ptr pool -> Set cr)
-> Set cr -> Map cr (Trip coin ptr pool) -> Set cr
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Set cr -> cr -> Trip coin ptr pool -> Set cr
forall a coin ptr pool.
Ord a =>
Set a -> a -> Trip coin ptr pool -> Set a
accum Set cr
forall a. Set a
Set.empty Map cr (Trip coin ptr pool)
tripmap
  where
    accum :: Set a -> a -> Trip coin ptr pool -> Set a
accum Set a
ans a
k (Triple (SJust coin
_) Set ptr
_ StrictMaybe pool
_) = 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
_ Trip coin ptr pool
_ = Set a
ans
domain (Delegations (UnifiedMap Map cr (Trip coin ptr pool)
tripmap Map ptr cr
_)) = (Set cr -> cr -> Trip coin ptr pool -> Set cr)
-> Set cr -> Map cr (Trip coin ptr pool) -> Set cr
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Set cr -> cr -> Trip coin ptr pool -> Set cr
forall a coin ptr pool.
Ord a =>
Set a -> a -> Trip coin ptr pool -> Set a
accum Set cr
forall a. Set a
Set.empty Map cr (Trip coin ptr pool)
tripmap
  where
    accum :: Set a -> a -> Trip coin ptr pool -> Set a
accum Set a
ans a
k (Triple StrictMaybe coin
_ Set ptr
_ (SJust pool
_)) = 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
_k (Triple StrictMaybe coin
_ Set ptr
_ StrictMaybe pool
SNothing) = Set a
ans
domain (Ptrs (UnifiedMap Map cr (Trip coin ptr pool)
_ Map ptr cr
ptrmap)) = Map ptr cr -> Set ptr
forall k a. Map k a -> Set k
Map.keysSet Map ptr cr
ptrmap

range :: (Ord coin, Ord pool, Ord cr) => View coin cr pool ptr k v -> Set v
range :: View coin cr pool ptr k v -> Set v
range (Rewards (UnifiedMap Map cr (Trip coin ptr pool)
tripmap Map ptr cr
_)) = (Set coin -> cr -> Trip coin ptr pool -> Set coin)
-> Set coin -> Map cr (Trip coin ptr pool) -> Set coin
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Set coin -> cr -> Trip coin ptr pool -> Set coin
forall a p ptr pool.
Ord a =>
Set a -> p -> Trip a ptr pool -> Set a
accum Set coin
forall a. Set a
Set.empty Map cr (Trip coin ptr pool)
tripmap
  where
    accum :: Set a -> p -> Trip a ptr pool -> Set a
accum Set a
ans p
_ (Triple (SJust a
coin) Set ptr
_ StrictMaybe pool
_) = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
coin Set a
ans
    accum Set a
ans p
_ Trip a ptr pool
_ = Set a
ans
range (Delegations (UnifiedMap Map cr (Trip coin ptr pool)
tripmap Map ptr cr
_)) = (Set pool -> cr -> Trip coin ptr pool -> Set pool)
-> Set pool -> Map cr (Trip coin ptr pool) -> Set pool
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Set pool -> cr -> Trip coin ptr pool -> Set pool
forall pool p coin ptr.
Ord pool =>
Set pool -> p -> Trip coin ptr pool -> Set pool
accum Set pool
forall a. Set a
Set.empty Map cr (Trip coin ptr pool)
tripmap
  where
    accum :: Set pool -> p -> Trip coin ptr pool -> Set pool
accum Set pool
ans p
_ (Triple StrictMaybe coin
_ Set ptr
_ (SJust pool
v)) = pool -> Set pool -> Set pool
forall a. Ord a => a -> Set a -> Set a
Set.insert pool
v Set pool
ans
    accum Set pool
ans p
_ (Triple StrictMaybe coin
_ Set ptr
_ StrictMaybe pool
SNothing) = Set pool
ans
range (Ptrs (UnifiedMap Map cr (Trip coin ptr pool)
_tripmap Map ptr cr
ptrmap)) =
  [cr] -> Set cr
forall a. Ord a => [a] -> Set a
Set.fromList (Map ptr cr -> [cr]
forall k a. Map k a -> [a]
Map.elems Map ptr cr
ptrmap) -- tripmap is the inverse of ptrmap

-- =============================================================
-- evalUnified (Rewards u1 ∪ singleton hk mempty)
-- evalUnified (Ptrs u2 ∪ singleton ptr hk)

-- | Union with left preference, so if k, already exists, do nothing, if it doesn't exist insert it.
(∪) ::
  ( Ord cr,
    Monoid coin,
    Ord ptr
  ) =>
  View coin cr pool ptr k v ->
  (k, v) ->
  UMap coin cr pool ptr
View coin cr pool ptr k v
view ∪ :: View coin cr pool ptr k v -> (k, v) -> UMap coin cr pool ptr
∪ (k
k, v
v) = (v -> v -> v)
-> k -> v -> View coin cr pool ptr k v -> UMap coin cr pool ptr
forall cr coin ptr v k pool.
(Ord cr, Monoid coin, Ord ptr) =>
(v -> v -> v)
-> k -> v -> View coin cr pool ptr k v -> UMap coin cr pool ptr
insertWith (\v
old v
_new -> v
old) k
k v
v View coin cr pool ptr k v
view

-- ======================================
-- evalUnified  (delegations ds ⨃ singleton hk dpool) })
-- evalUnified (rewards' ⨃ wdrls_')

-- | Union with right preference, so if 'k', already exists, then its value is overwritten with 'v'
(⨃) ::
  ( Ord cr,
    Monoid coin,
    Ord ptr
  ) =>
  View coin cr pool ptr k v ->
  Map k v ->
  UMap coin cr pool ptr
View coin cr pool ptr k v
view ⨃ :: View coin cr pool ptr k v -> Map k v -> UMap coin cr pool ptr
⨃ Map k v
mp = View coin cr pool ptr k v -> UMap coin cr pool ptr
forall coin cr pl ptr k v.
View coin cr pl ptr k v -> UMap coin cr pl ptr
unView (View coin cr pool ptr k v -> UMap coin cr pool ptr)
-> View coin cr pool ptr k v -> UMap coin cr pool ptr
forall a b. (a -> b) -> a -> b
$ (View coin cr pool ptr k v -> k -> v -> View coin cr pool ptr k v)
-> View coin cr pool ptr k v
-> Map k v
-> View coin cr pool ptr k v
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' View coin cr pool ptr k v -> k -> v -> View coin cr pool ptr k v
forall coin cr ptr pool k v.
(Monoid coin, Ord cr, Ord ptr) =>
View coin cr pool ptr k v -> k -> v -> View coin cr pool ptr k v
accum View coin cr pool ptr k v
view Map k v
mp
  where
    accum :: View coin cr pool ptr k v -> k -> v -> View coin cr pool ptr k v
accum View coin cr pool ptr k v
ans k
k v
v = (v -> v -> v)
-> k -> v -> View coin cr pool ptr k v -> View coin cr pool ptr k v
forall cr coin ptr v k pool.
(Ord cr, Monoid coin, Ord ptr) =>
(v -> v -> v)
-> k -> v -> View coin cr pool ptr k v -> View coin cr pool ptr k v
insertWith' (\v
_old v
new -> v
new) k
k v
v View coin cr pool ptr k v
ans

-- ==========================================
-- evalUnified (rewards dState ∪+ registeredAggregated)
-- evalUnified (rewards' ∪+ update)
-- evalUnified  (Rewards u0 ∪+ refunds)

(∪+) ::
  ( Ord cred,
    Monoid coin
  ) =>
  View coin cred pool ptr k coin ->
  Map k coin ->
  UMap coin cred pool ptr
(Rewards (UnifiedMap Map cred (Trip coin ptr pool)
tm Map ptr cred
pm)) ∪+ :: View coin cred pool ptr k coin
-> Map k coin -> UMap coin cred pool ptr
∪+ Map k coin
mp = Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
forall coin cred pool ptr.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
UnifiedMap (Map cred (Trip coin ptr pool)
-> Map cred coin -> Map cred (Trip coin ptr pool)
forall k coin ptr pool.
(Ord k, Monoid coin) =>
Map k (Trip coin ptr pool)
-> Map k coin -> Map k (Trip coin ptr pool)
unionHelp Map cred (Trip coin ptr pool)
tm Map cred coin
Map k coin
mp) Map ptr cred
pm
(Delegations (UnifiedMap Map cred (Trip coin ptr pool)
tm Map ptr cred
pm)) ∪+ Map k coin
_mp = Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
forall coin cred pool ptr.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
UnifiedMap Map cred (Trip coin ptr pool)
tm Map ptr cred
pm -- I don't think this is reachable
(Ptrs (UnifiedMap Map cred (Trip coin ptr pool)
tm Map ptr cred
pm)) ∪+ Map k coin
_mp = Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
forall coin cred pool ptr.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
UnifiedMap Map cred (Trip coin ptr pool)
tm Map ptr cred
pm -- I don't think this is reachable

unionHelp ::
  (Ord k, Monoid coin) =>
  Map k (Trip coin ptr pool) ->
  Map k coin ->
  Map k (Trip coin ptr pool)
unionHelp :: Map k (Trip coin ptr pool)
-> Map k coin -> Map k (Trip coin ptr pool)
unionHelp Map k (Trip coin ptr pool)
tm Map k coin
mm =
  (k -> Trip coin ptr pool -> coin -> Maybe (Trip coin ptr pool))
-> (Map k (Trip coin ptr pool) -> Map k (Trip coin ptr pool))
-> (Map k coin -> Map k (Trip coin ptr pool))
-> Map k (Trip coin ptr pool)
-> Map k coin
-> Map k (Trip coin ptr pool)
forall k a b c.
Ord k =>
(k -> a -> b -> Maybe c)
-> (Map k a -> Map k c)
-> (Map k b -> Map k c)
-> Map k a
-> Map k b
-> Map k c
Map.mergeWithKey
    (\k
_k (Triple StrictMaybe coin
c1 Set ptr
s StrictMaybe pool
d) coin
c2 -> Trip coin ptr pool -> Maybe (Trip coin ptr pool)
forall a. a -> Maybe a
Just (StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
forall coin ptr pool.
StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
Triple (StrictMaybe coin -> StrictMaybe coin -> StrictMaybe coin
forall x.
Monoid x =>
StrictMaybe x -> StrictMaybe x -> StrictMaybe x
appendStrictMaybe StrictMaybe coin
c1 (coin -> StrictMaybe coin
forall a. a -> StrictMaybe a
SJust coin
c2)) Set ptr
s StrictMaybe pool
d))
    Map k (Trip coin ptr pool) -> Map k (Trip coin ptr pool)
forall a. a -> a
id
    ((coin -> Trip coin ptr pool)
-> Map k coin -> Map k (Trip coin ptr pool)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\coin
c -> StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
forall coin ptr pool.
StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
Triple (coin -> StrictMaybe coin
forall a. a -> StrictMaybe a
SJust coin
c) Set ptr
forall a. Set a
Set.empty StrictMaybe pool
forall a. StrictMaybe a
SNothing))
    Map k (Trip coin ptr pool)
tm
    Map k coin
mm

-- ============================================
-- evalUnified (setSingleton hk ⋪ Rewards u0)
-- evalUnified (setSingleton hk ⋪ Delegations u1)

(⋪) ::
  (Ord cred, Ord ptr) =>
  Set k ->
  View coin cred pool ptr k v ->
  UMap coin cred pool ptr
Set k
set ⋪ :: Set k -> View coin cred pool ptr k v -> UMap coin cred pool ptr
⋪ View coin cred pool ptr k v
view = View coin cred pool ptr k v -> UMap coin cred pool ptr
forall coin cr pl ptr k v.
View coin cr pl ptr k v -> UMap coin cr pl ptr
unView ((View coin cred pool ptr k v -> k -> View coin cred pool ptr k v)
-> View coin cred pool ptr k v
-> Set k
-> View coin cred pool ptr k v
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' ((k -> View coin cred pool ptr k v -> View coin cred pool ptr k v)
-> View coin cred pool ptr k v -> k -> View coin cred pool ptr k v
forall a b c. (a -> b -> c) -> b -> a -> c
flip k -> View coin cred pool ptr k v -> View coin cred pool ptr k v
forall cr ptr k coin pool v.
(Ord cr, Ord ptr) =>
k -> View coin cr pool ptr k v -> View coin cr pool ptr k v
delete') View coin cred pool ptr k v
view Set k
set)

-- ============================================
-- evalUnified (Ptrs u2 ⋫ setSingleton hk)
-- evalUnified (Delegations u1 ⋫ retired)

-- | This is slow for Delegations and Rewards Views, better hope they are small
(⋫) ::
  (Ord cred, Ord ptr, Ord coin, Ord pool) =>
  View coin cred pool ptr k v ->
  Set v ->
  UMap coin cred pool ptr
Ptrs UMap coin cred pool ptr
um ⋫ :: View coin cred pool ptr k v -> Set v -> UMap coin cred pool ptr
⋫ Set v
set = (UMap coin cred pool ptr -> cred -> UMap coin cred pool ptr)
-> UMap coin cred pool ptr -> Set cred -> UMap coin cred pool ptr
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' UMap coin cred pool ptr -> cred -> UMap coin cred pool ptr
forall a k coin pool.
(Ord a, Ord k) =>
UMap coin a pool k -> a -> UMap coin a pool k
removeCredStaking UMap coin cred pool ptr
um Set cred
Set v
set
  where
    -- removeCredStaking :: UnifiedMap crypto -> Credential 'Staking crypto -> UnifiedMap crypto
    removeCredStaking :: UMap coin a pool k -> a -> UMap coin a pool k
removeCredStaking m :: UMap coin a pool k
m@(UnifiedMap Map a (Trip coin k pool)
m2 Map k a
m1) a
cred =
      case a -> Map a (Trip coin k pool) -> Maybe (Trip coin k pool)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
cred Map a (Trip coin k pool)
m2 of
        Just (Triple StrictMaybe coin
_ Set k
kset StrictMaybe pool
_) ->
          Map a (Trip coin k pool) -> Map k a -> UMap coin a pool k
forall coin cred pool ptr.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
UnifiedMap ((Trip coin k pool -> Maybe (Trip coin k pool))
-> a -> Map a (Trip coin k pool) -> Map a (Trip coin k pool)
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update Trip coin k pool -> Maybe (Trip coin k pool)
forall coin ptr pool ptr.
Trip coin ptr pool -> Maybe (Trip coin ptr pool)
ok a
cred Map a (Trip coin k pool)
m2) ((k -> Map k a -> Map k a) -> Map k a -> Set k -> Map k a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\k
k Map k a
pset -> k -> Map k a -> Map k a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete k
k Map k a
pset) Map k a
m1 Set k
kset)
          where
            ok :: Trip coin ptr pool -> Maybe (Trip coin ptr pool)
ok (Triple StrictMaybe coin
coin Set ptr
_ StrictMaybe pool
poolid) = Trip coin ptr pool -> Maybe (Trip coin ptr pool)
forall coin ptr pool.
Trip coin ptr pool -> Maybe (Trip coin ptr pool)
zeroMaybe (StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
forall coin ptr pool.
StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
Triple StrictMaybe coin
coin Set ptr
forall a. Set a
Set.empty StrictMaybe pool
poolid)
        Maybe (Trip coin k pool)
Nothing -> UMap coin a pool k
m
Delegations (UnifiedMap Map cred (Trip coin ptr pool)
tmap Map ptr cred
pmap) ⋫ Set v
delegset = Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
forall coin cred pool ptr.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
UnifiedMap ((Map cred (Trip coin ptr pool)
 -> cred -> Trip coin ptr v -> Map cred (Trip coin ptr pool))
-> Map cred (Trip coin ptr pool)
-> Map cred (Trip coin ptr v)
-> Map cred (Trip coin ptr pool)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Map cred (Trip coin ptr pool)
-> cred -> Trip coin ptr v -> Map cred (Trip coin ptr pool)
accum Map cred (Trip coin ptr pool)
tmap Map cred (Trip coin ptr pool)
Map cred (Trip coin ptr v)
tmap) Map ptr cred
pmap
  where
    ok :: Trip coin ptr pool -> Maybe (Trip coin ptr pool)
ok (Triple StrictMaybe coin
c Set ptr
set StrictMaybe pool
_) = Trip coin ptr pool -> Maybe (Trip coin ptr pool)
forall coin ptr pool.
Trip coin ptr pool -> Maybe (Trip coin ptr pool)
zeroMaybe (StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
forall coin ptr pool.
StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
Triple StrictMaybe coin
c Set ptr
set StrictMaybe pool
forall a. StrictMaybe a
SNothing)
    accum :: Map cred (Trip coin ptr pool)
-> cred -> Trip coin ptr v -> Map cred (Trip coin ptr pool)
accum Map cred (Trip coin ptr pool)
ans cred
_key (Triple StrictMaybe coin
_ Set ptr
_ StrictMaybe v
SNothing) = Map cred (Trip coin ptr pool)
ans
    accum Map cred (Trip coin ptr pool)
ans cred
key (Triple StrictMaybe coin
_ Set ptr
_ (SJust v
d)) =
      if v -> Set v -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member v
d Set v
delegset
        then (Trip coin ptr pool -> Maybe (Trip coin ptr pool))
-> cred
-> Map cred (Trip coin ptr pool)
-> Map cred (Trip coin ptr pool)
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update Trip coin ptr pool -> Maybe (Trip coin ptr pool)
forall coin ptr pool pool.
Trip coin ptr pool -> Maybe (Trip coin ptr pool)
ok cred
key Map cred (Trip coin ptr pool)
ans
        else Map cred (Trip coin ptr pool)
ans
Rewards (UnifiedMap Map cred (Trip coin ptr pool)
tmap Map ptr cred
pmap) ⋫ Set v
coinset = Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
forall coin cred pool ptr.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
UnifiedMap ((Map cred (Trip coin ptr pool)
 -> cred -> Trip v ptr pool -> Map cred (Trip coin ptr pool))
-> Map cred (Trip coin ptr pool)
-> Map cred (Trip v ptr pool)
-> Map cred (Trip coin ptr pool)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Map cred (Trip coin ptr pool)
-> cred -> Trip v ptr pool -> Map cred (Trip coin ptr pool)
accum Map cred (Trip coin ptr pool)
tmap Map cred (Trip coin ptr pool)
Map cred (Trip v ptr pool)
tmap) Map ptr cred
pmap
  where
    ok :: Trip coin ptr pool -> Maybe (Trip coin ptr pool)
ok (Triple StrictMaybe coin
_ Set ptr
set StrictMaybe pool
d) = Trip coin ptr pool -> Maybe (Trip coin ptr pool)
forall coin ptr pool.
Trip coin ptr pool -> Maybe (Trip coin ptr pool)
zeroMaybe (StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
forall coin ptr pool.
StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
Triple StrictMaybe coin
forall a. StrictMaybe a
SNothing Set ptr
set StrictMaybe pool
d)
    accum :: Map cred (Trip coin ptr pool)
-> cred -> Trip v ptr pool -> Map cred (Trip coin ptr pool)
accum Map cred (Trip coin ptr pool)
ans cred
key (Triple (SJust v
coin) Set ptr
_ StrictMaybe pool
_) =
      if v -> Set v -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member v
coin Set v
coinset
        then (Trip coin ptr pool -> Maybe (Trip coin ptr pool))
-> cred
-> Map cred (Trip coin ptr pool)
-> Map cred (Trip coin ptr pool)
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update Trip coin ptr pool -> Maybe (Trip coin ptr pool)
forall coin ptr pool coin.
Trip coin ptr pool -> Maybe (Trip coin ptr pool)
ok cred
key Map cred (Trip coin ptr pool)
ans
        else Map cred (Trip coin ptr pool)
ans
    accum Map cred (Trip coin ptr pool)
ans cred
_ Trip v ptr pool
_ = Map cred (Trip coin ptr pool)
ans

-- =============================================

-- eval (k ∈ dom (rewards dState))
-- eval (k ∈ dom (rewards ds)))
-- eval (hk ∈ dom (rewards ds))
-- eval (hk ∉ dom (rewards ds))

member :: (Ord cr, Ord ptr) => k -> View coin cr pool ptr k v -> Bool
member :: k -> View coin cr pool ptr k v -> Bool
member k
k (Rewards (UnifiedMap Map cr (Trip coin ptr pool)
tmap Map ptr cr
_)) =
  case k -> Map k (Trip coin ptr pool) -> Maybe (Trip coin ptr pool)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map cr (Trip coin ptr pool)
Map k (Trip coin ptr pool)
tmap of
    Just (Triple (SJust coin
_) Set ptr
_ StrictMaybe pool
_) -> Bool
True
    Maybe (Trip coin ptr pool)
_ -> Bool
False
member k
k (Delegations (UnifiedMap Map cr (Trip coin ptr pool)
tmap Map ptr cr
_)) =
  case k -> Map k (Trip coin ptr pool) -> Maybe (Trip coin ptr pool)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map cr (Trip coin ptr pool)
Map k (Trip coin ptr pool)
tmap of
    Just (Triple StrictMaybe coin
_ Set ptr
_ (SJust pool
_)) -> Bool
True
    Maybe (Trip coin ptr pool)
_ -> Bool
False
member k
k (Ptrs (UnifiedMap Map cr (Trip coin ptr pool)
_ Map ptr cr
pmap)) = k -> Map k cr -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member k
k Map ptr cr
Map k cr
pmap

notMember :: (Ord cr, Ord ptr) => k -> View coin cr pool ptr k v -> Bool
notMember :: k -> View coin cr pool ptr k v -> Bool
notMember k
k View coin cr pool ptr k v
um = Bool -> Bool
not (k -> View coin cr pool ptr k v -> Bool
forall cr ptr k coin pool v.
(Ord cr, Ord ptr) =>
k -> View coin cr pool ptr k v -> Bool
member k
k View coin cr pool ptr k v
um)

-- =====================================================

-- eval (dom rewards' ◁ iRReserves (_irwd ds) :: RewardAccounts (Crypto era))
-- eval (dom rewards' ◁ iRTreasury (_irwd ds) :: RewardAccounts (Crypto era))

domRestrict :: (Ord cr, Ord ptr) => View coin cr pool ptr k v -> Map k u -> Map k u
domRestrict :: View coin cr pool ptr k v -> Map k u -> Map k u
domRestrict (Rewards (UnifiedMap Map cr (Trip coin ptr pool)
tmap Map ptr cr
_)) Map k u
m = (k -> Trip coin ptr pool -> Bool)
-> Map k u -> Map k (Trip coin ptr pool) -> Map k u
forall k v2 v1.
Ord k =>
(k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v1
intersectDomPLeft k -> Trip coin ptr pool -> Bool
forall p coin ptr pool. p -> Trip coin ptr pool -> Bool
p Map k u
m Map cr (Trip coin ptr pool)
Map k (Trip coin ptr pool)
tmap
  where
    p :: p -> Trip coin ptr pool -> Bool
p p
_ (Triple (SJust coin
_) Set ptr
_ StrictMaybe pool
_) = Bool
True
    p p
_ Trip coin ptr pool
_ = Bool
False
domRestrict (Delegations (UnifiedMap Map cr (Trip coin ptr pool)
tmap Map ptr cr
_)) Map k u
m = (k -> Trip coin ptr pool -> Bool)
-> Map k u -> Map k (Trip coin ptr pool) -> Map k u
forall k v2 v1.
Ord k =>
(k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v1
intersectDomPLeft k -> Trip coin ptr pool -> Bool
forall p coin ptr pool. p -> Trip coin ptr pool -> Bool
p Map k u
m Map cr (Trip coin ptr pool)
Map k (Trip coin ptr pool)
tmap
  where
    p :: p -> Trip coin ptr pool -> Bool
p p
_ (Triple StrictMaybe coin
_ Set ptr
_ (SJust pool
_)) = Bool
True
    p p
_ Trip coin ptr pool
_ = Bool
False
domRestrict (Ptrs (UnifiedMap Map cr (Trip coin ptr pool)
_ Map ptr cr
pmap)) Map k u
m = Map k u -> Map k cr -> 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 ptr cr
Map k cr
pmap

-- ==========================

type Tbor x = (Typeable x, ToCBOR x)

instance
  (Tbor coin, Tbor ptr, Ord ptr, ToCBOR pool) =>
  ToCBOR (Trip coin ptr pool)
  where
  toCBOR :: Trip coin ptr pool -> Encoding
toCBOR (Triple StrictMaybe coin
coin Set ptr
ptr StrictMaybe pool
pool) =
    Word -> Encoding
encodeListLen Word
3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> StrictMaybe coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR StrictMaybe coin
coin Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set ptr -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Set ptr
ptr Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> StrictMaybe pool -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR StrictMaybe pool
pool

instance
  (FromCBOR coin, Ord ptr, FromCBOR ptr, FromCBOR pool) =>
  FromSharedCBOR (Trip coin ptr pool)
  where
  type Share (Trip coin ptr pool) = Interns pool
  fromSharedCBOR :: Share (Trip coin ptr pool) -> Decoder s (Trip coin ptr pool)
fromSharedCBOR Share (Trip coin ptr pool)
is =
    Text
-> (Trip coin ptr pool -> Int)
-> Decoder s (Trip coin ptr pool)
-> Decoder s (Trip coin ptr pool)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"Triple" (Int -> Trip coin ptr pool -> Int
forall a b. a -> b -> a
const Int
3) (Decoder s (Trip coin ptr pool) -> Decoder s (Trip coin ptr pool))
-> Decoder s (Trip coin ptr pool) -> Decoder s (Trip coin ptr pool)
forall a b. (a -> b) -> a -> b
$
      do
        StrictMaybe coin
a <- Decoder s (StrictMaybe coin)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Set ptr
b <- Decoder s (Set ptr)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        StrictMaybe pool
c <- Interns pool -> Decoder s (StrictMaybe pool)
forall (f :: * -> *) b s.
(FromCBOR (f b), Monad f) =>
Interns b -> Decoder s (f b)
fromShareCBORfunctor Share (Trip coin ptr pool)
Interns pool
is
        Trip coin ptr pool -> Decoder s (Trip coin ptr pool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
forall coin ptr pool.
StrictMaybe coin
-> Set ptr -> StrictMaybe pool -> Trip coin ptr pool
Triple StrictMaybe coin
a Set ptr
b StrictMaybe pool
c)

instance
  (Tbor coin, Tbor ptr, Tbor cred, ToCBOR pool, Ord ptr) =>
  ToCBOR (UMap coin cred pool ptr)
  where
  toCBOR :: UMap coin cred pool ptr -> Encoding
toCBOR (UnifiedMap Map cred (Trip coin ptr pool)
tripmap Map ptr cred
ptrmap) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (cred -> Encoding)
-> (Trip coin ptr pool -> Encoding)
-> Map cred (Trip coin ptr pool)
-> Encoding
forall a b.
(a -> Encoding) -> (b -> Encoding) -> Map a b -> Encoding
encodeMap cred -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Trip coin ptr pool -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Map cred (Trip coin ptr pool)
tripmap Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (ptr -> Encoding) -> (cred -> Encoding) -> Map ptr cred -> Encoding
forall a b.
(a -> Encoding) -> (b -> Encoding) -> Map a b -> Encoding
encodeMap ptr -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR cred -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Map ptr cred
ptrmap

instance
  (Ord cred, FromCBOR cred, Ord ptr, FromCBOR ptr, FromCBOR coin, FromCBOR pool) =>
  FromSharedCBOR (UMap coin cred pool ptr)
  where
  type
    Share (UMap coin cred pool ptr) =
      (Interns cred, Interns pool)
  fromSharedPlusCBOR :: StateT
  (Share (UMap coin cred pool ptr))
  (Decoder s)
  (UMap coin cred pool ptr)
fromSharedPlusCBOR =
    ((Interns cred, Interns pool)
 -> Decoder
      s (UMap coin cred pool ptr, (Interns cred, Interns pool)))
-> StateT
     (Interns cred, Interns pool) (Decoder s) (UMap coin cred pool ptr)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT
      ( \(Interns cred
a, Interns pool
b) ->
          Text
-> ((UMap coin cred pool ptr, (Interns cred, Interns pool)) -> Int)
-> Decoder
     s (UMap coin cred pool ptr, (Interns cred, Interns pool))
-> Decoder
     s (UMap coin cred pool ptr, (Interns cred, Interns pool))
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"UnifiedMap" (Int
-> (UMap coin cred pool ptr, (Interns cred, Interns pool)) -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s (UMap coin cred pool ptr, (Interns cred, Interns pool))
 -> Decoder
      s (UMap coin cred pool ptr, (Interns cred, Interns pool)))
-> Decoder
     s (UMap coin cred pool ptr, (Interns cred, Interns pool))
-> Decoder
     s (UMap coin cred pool ptr, (Interns cred, Interns pool))
forall a b. (a -> b) -> a -> b
$ do
            Map cred (Trip coin ptr pool)
tripmap <- Decoder s cred
-> Decoder s (Trip coin ptr pool)
-> Decoder s (Map cred (Trip coin ptr pool))
forall a s b.
Ord a =>
Decoder s a -> Decoder s b -> Decoder s (Map a b)
decodeMap (Interns cred -> cred -> cred
forall k. Interns k -> k -> k
interns Interns cred
a (cred -> cred) -> Decoder s cred -> Decoder s cred
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s cred
forall a s. FromCBOR a => Decoder s a
fromCBOR) (Share (Trip coin ptr pool) -> Decoder s (Trip coin ptr pool)
forall a s. FromSharedCBOR a => Share a -> Decoder s a
fromSharedCBOR Share (Trip coin ptr pool)
Interns pool
b)
            let a' :: Interns cred
a' = Map cred (Trip coin ptr pool) -> Interns cred
forall k a. Ord k => Map k a -> Interns k
internsFromMap Map cred (Trip coin ptr pool)
tripmap Interns cred -> Interns cred -> Interns cred
forall a. Semigroup a => a -> a -> a
<> Interns cred
a
            Map ptr cred
ptrmap <- Decoder s ptr -> Decoder s cred -> Decoder s (Map ptr cred)
forall a s b.
Ord a =>
Decoder s a -> Decoder s b -> Decoder s (Map a b)
decodeMap Decoder s ptr
forall a s. FromCBOR a => Decoder s a
fromCBOR (Interns cred -> cred -> cred
forall k. Interns k -> k -> k
interns Interns cred
a' (cred -> cred) -> Decoder s cred -> Decoder s cred
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s cred
forall a s. FromCBOR a => Decoder s a
fromCBOR)
            (UMap coin cred pool ptr, (Interns cred, Interns pool))
-> Decoder
     s (UMap coin cred pool ptr, (Interns cred, Interns pool))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
forall coin cred pool ptr.
Map cred (Trip coin ptr pool)
-> Map ptr cred -> UMap coin cred pool ptr
UnifiedMap Map cred (Trip coin ptr pool)
tripmap Map ptr cred
ptrmap, (Interns cred
a', Interns pool
b))
      )

-- =================================================================

data Tag coin cred pool ptr k v where
  Rew :: Tag coin cred pool ptr cred coin
  Del :: Tag coin cred pool ptr cred pool
  Ptr :: Tag coin cred pool ptr ptr cred

class UnifiedView coin cred pool ptr k v where
  tag :: Tag coin cred pool ptr k v

-- ===================================================
-- derived operations

findWithDefault :: (Ord cred, Ord ptr) => a -> k -> View coin cred pool ptr k a -> a
findWithDefault :: a -> k -> View coin cred pool ptr k a -> a
findWithDefault a
d k
k = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
d (Maybe a -> a)
-> (View coin cred pool ptr k a -> Maybe a)
-> View coin cred pool ptr k a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> View coin cred pool ptr k a -> Maybe a
forall cr ptr k coin pool v.
(Ord cr, Ord ptr) =>
k -> View coin cr pool ptr k v -> Maybe v
lookup k
k

-- | A View is a view, so the size of the view is NOT the same as the size of
-- the underlying triple map.
size :: View coin cred pool ptr k a -> Int
size :: View coin cred pool ptr k a -> Int
size (Ptrs (UnifiedMap Map cred (Trip coin ptr pool)
_ Map ptr cred
ptrmap)) = Map ptr cred -> Int
forall k a. Map k a -> Int
Map.size Map ptr cred
ptrmap
size View coin cred pool ptr k a
x = (Int -> a -> Int) -> Int -> View coin cred pool ptr k a -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
count a
_v -> Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0 View coin cred pool ptr k a
x

-- | Create a UMap from 3 separate maps. For use in tests only.
unify ::
  (Monoid coin, Ord cred, Ord ptr) =>
  Map cred coin ->
  Map cred pool ->
  Map ptr cred ->
  UMap coin cred pool ptr
unify :: Map cred coin
-> Map cred pool -> Map ptr cred -> UMap coin cred pool ptr
unify Map cred coin
rews Map cred pool
dels Map ptr cred
ptrss = UMap coin cred pool ptr
um3
  where
    um1 :: UMap coin cred pool ptr
um1 = View coin cred pool ptr cred coin -> UMap coin cred pool ptr
forall coin cr pl ptr k v.
View coin cr pl ptr k v -> UMap coin cr pl ptr
unView (View coin cred pool ptr cred coin -> UMap coin cred pool ptr)
-> View coin cred pool ptr cred coin -> UMap coin cred pool ptr
forall a b. (a -> b) -> a -> b
$ (View coin cred pool ptr cred coin
 -> cred -> coin -> View coin cred pool ptr cred coin)
-> View coin cred pool ptr cred coin
-> Map cred coin
-> View coin cred pool ptr cred coin
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\View coin cred pool ptr cred coin
um cred
k coin
v -> cred
-> coin
-> View coin cred pool ptr cred coin
-> View coin cred pool ptr cred coin
forall cr coin ptr k v pool.
(Ord cr, Monoid coin, Ord ptr) =>
k -> v -> View coin cr pool ptr k v -> View coin cr pool ptr k v
insert' cred
k coin
v View coin cred pool ptr cred coin
um) (UMap coin cred pool ptr -> View coin cred pool ptr cred coin
forall coin cr pl ptr.
UMap coin cr pl ptr -> View coin cr pl ptr cr coin
Rewards UMap coin cred pool ptr
forall coin cr pool ptr. UMap coin cr pool ptr
empty) Map cred coin
rews
    um2 :: UMap coin cred pool ptr
um2 = View coin cred pool ptr cred pool -> UMap coin cred pool ptr
forall coin cr pl ptr k v.
View coin cr pl ptr k v -> UMap coin cr pl ptr
unView (View coin cred pool ptr cred pool -> UMap coin cred pool ptr)
-> View coin cred pool ptr cred pool -> UMap coin cred pool ptr
forall a b. (a -> b) -> a -> b
$ (View coin cred pool ptr cred pool
 -> cred -> pool -> View coin cred pool ptr cred pool)
-> View coin cred pool ptr cred pool
-> Map cred pool
-> View coin cred pool ptr cred pool
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\View coin cred pool ptr cred pool
um cred
k pool
v -> cred
-> pool
-> View coin cred pool ptr cred pool
-> View coin cred pool ptr cred pool
forall cr coin ptr k v pool.
(Ord cr, Monoid coin, Ord ptr) =>
k -> v -> View coin cr pool ptr k v -> View coin cr pool ptr k v
insert' cred
k pool
v View coin cred pool ptr cred pool
um) (UMap coin cred pool ptr -> View coin cred pool ptr cred pool
forall coin cr pl ptr.
UMap coin cr pl ptr -> View coin cr pl ptr cr pl
Delegations UMap coin cred pool ptr
um1) Map cred pool
dels
    um3 :: UMap coin cred pool ptr
um3 = View coin cred pool ptr ptr cred -> UMap coin cred pool ptr
forall coin cr pl ptr k v.
View coin cr pl ptr k v -> UMap coin cr pl ptr
unView (View coin cred pool ptr ptr cred -> UMap coin cred pool ptr)
-> View coin cred pool ptr ptr cred -> UMap coin cred pool ptr
forall a b. (a -> b) -> a -> b
$ (View coin cred pool ptr ptr cred
 -> ptr -> cred -> View coin cred pool ptr ptr cred)
-> View coin cred pool ptr ptr cred
-> Map ptr cred
-> View coin cred pool ptr ptr cred
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\View coin cred pool ptr ptr cred
um ptr
k cred
v -> ptr
-> cred
-> View coin cred pool ptr ptr cred
-> View coin cred pool ptr ptr cred
forall cr coin ptr k v pool.
(Ord cr, Monoid coin, Ord ptr) =>
k -> v -> View coin cr pool ptr k v -> View coin cr pool ptr k v
insert' ptr
k cred
v View coin cred pool ptr ptr cred
um) (UMap coin cred pool ptr -> View coin cred pool ptr ptr cred
forall coin cr pl ptr.
UMap coin cr pl ptr -> View coin cr pl ptr ptr cr
Ptrs UMap coin cred pool ptr
um2) Map ptr cred
ptrss