{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RankNTypes #-}

-- | Define Lenses that facilitate accessing the types in the Var Model.
--   Note the types in the Model, are often wrapped in a newtype in the real state,
--   or they are embedded in something like UMap to save space. So we need interesting
--   Lenses to make this possible.
--   Many other (more standard) Lenses are defined in Cardano.Ledger.Shelley.LedgerState
module Test.Cardano.Ledger.Constrained.Lenses where

import Cardano.Ledger.BaseTypes (SlotNo)
import Cardano.Ledger.Coin (Coin (..), CompactForm, DeltaCoin)
import Cardano.Ledger.Compactible (Compactible (fromCompact))
import Cardano.Ledger.Credential (Credential, Ptr)
import Cardano.Ledger.Keys (GenDelegPair (..), GenDelegs (..), KeyHash, KeyRole (..))
import Cardano.Ledger.Shelley.LedgerState hiding (deltaReserves, deltaTreasury, rewards)
import qualified Cardano.Ledger.Shelley.LedgerState as LS (deltaReserves, deltaTreasury)
import Cardano.Ledger.Shelley.PoolRank (Likelihood (..), LogWeight (..), NonMyopic (..))
import Cardano.Ledger.Shelley.State
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Ledger.UMap (
  RDPair (..),
  UMap (..),
  compactCoinOrError,
  dRepMap,
  depositMap,
  invPtrMap,
  rewardMap,
  sPoolMap,
  unify,
 )
import qualified Cardano.Ledger.UMap as UM
import Data.Foldable (Foldable (..))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict (StrictMaybe (..))
import Data.Sequence.Strict (StrictSeq, fromList)
import Data.Set (Set)
import Lens.Micro
import Test.Cardano.Ledger.Constrained.Classes (TxOutF (..), liftUTxO)
import Test.Cardano.Ledger.Generic.Proof (Proof)

-- ====================================================
-- Lenses
{- A lens for a record field name 'mm'  looks like this.
   Of course the types will change. This example makes a lens
   for an Int field inside of NewEpoch state

mmL :: Lens' (NewEpochState era) Int
mmL = lens mm (\ds u -> ds { mm = u })

-}

-- ===================================
-- InstantaneousRewards

iRReservesL :: Lens' InstantaneousRewards (Map (Credential 'Staking) Coin)
iRReservesL :: Lens' InstantaneousRewards (Map (Credential 'Staking) Coin)
iRReservesL = (InstantaneousRewards -> Map (Credential 'Staking) Coin)
-> (InstantaneousRewards
    -> Map (Credential 'Staking) Coin -> InstantaneousRewards)
-> Lens' InstantaneousRewards (Map (Credential 'Staking) Coin)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens InstantaneousRewards -> Map (Credential 'Staking) Coin
iRReserves (\InstantaneousRewards
ds Map (Credential 'Staking) Coin
u -> InstantaneousRewards
ds {iRReserves = u})

iRTreasuryL :: Lens' InstantaneousRewards (Map (Credential 'Staking) Coin)
iRTreasuryL :: Lens' InstantaneousRewards (Map (Credential 'Staking) Coin)
iRTreasuryL = (InstantaneousRewards -> Map (Credential 'Staking) Coin)
-> (InstantaneousRewards
    -> Map (Credential 'Staking) Coin -> InstantaneousRewards)
-> Lens' InstantaneousRewards (Map (Credential 'Staking) Coin)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens InstantaneousRewards -> Map (Credential 'Staking) Coin
iRTreasury (\InstantaneousRewards
ds Map (Credential 'Staking) Coin
u -> InstantaneousRewards
ds {iRTreasury = u})

deltaReservesL :: Lens' InstantaneousRewards DeltaCoin
deltaReservesL :: Lens' InstantaneousRewards DeltaCoin
deltaReservesL = (InstantaneousRewards -> DeltaCoin)
-> (InstantaneousRewards -> DeltaCoin -> InstantaneousRewards)
-> Lens' InstantaneousRewards DeltaCoin
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens InstantaneousRewards -> DeltaCoin
LS.deltaReserves (\InstantaneousRewards
ds DeltaCoin
u -> InstantaneousRewards
ds {LS.deltaReserves = u})

deltaTreasuryL :: Lens' InstantaneousRewards DeltaCoin
deltaTreasuryL :: Lens' InstantaneousRewards DeltaCoin
deltaTreasuryL = (InstantaneousRewards -> DeltaCoin)
-> (InstantaneousRewards -> DeltaCoin -> InstantaneousRewards)
-> Lens' InstantaneousRewards DeltaCoin
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens InstantaneousRewards -> DeltaCoin
LS.deltaTreasury (\InstantaneousRewards
ds DeltaCoin
u -> InstantaneousRewards
ds {LS.deltaTreasury = u})

unGenDelegsL :: Lens' GenDelegs (Map (KeyHash 'Genesis) GenDelegPair)
unGenDelegsL :: Lens' GenDelegs (Map (KeyHash 'Genesis) GenDelegPair)
unGenDelegsL = (GenDelegs -> Map (KeyHash 'Genesis) GenDelegPair)
-> (GenDelegs -> Map (KeyHash 'Genesis) GenDelegPair -> GenDelegs)
-> Lens' GenDelegs (Map (KeyHash 'Genesis) GenDelegPair)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GenDelegs -> Map (KeyHash 'Genesis) GenDelegPair
unGenDelegs (\(GenDelegs Map (KeyHash 'Genesis) GenDelegPair
_) Map (KeyHash 'Genesis) GenDelegPair
new -> Map (KeyHash 'Genesis) GenDelegPair -> GenDelegs
GenDelegs Map (KeyHash 'Genesis) GenDelegPair
new)

-- Lenses for (FutureGenDeleg c)
fGenDelegSlotL :: Lens' FutureGenDeleg SlotNo
fGenDelegSlotL :: Lens' FutureGenDeleg SlotNo
fGenDelegSlotL = (FutureGenDeleg -> SlotNo)
-> (FutureGenDeleg -> SlotNo -> FutureGenDeleg)
-> Lens' FutureGenDeleg SlotNo
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FutureGenDeleg -> SlotNo
fGenDelegSlot (\FutureGenDeleg
ds SlotNo
u -> FutureGenDeleg
ds {fGenDelegSlot = u})

fGenDelegGenKeyHashL :: Lens' FutureGenDeleg (KeyHash 'Genesis)
fGenDelegGenKeyHashL :: Lens' FutureGenDeleg (KeyHash 'Genesis)
fGenDelegGenKeyHashL = (FutureGenDeleg -> KeyHash 'Genesis)
-> (FutureGenDeleg -> KeyHash 'Genesis -> FutureGenDeleg)
-> Lens' FutureGenDeleg (KeyHash 'Genesis)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FutureGenDeleg -> KeyHash 'Genesis
fGenDelegGenKeyHash (\FutureGenDeleg
ds KeyHash 'Genesis
u -> FutureGenDeleg
ds {fGenDelegGenKeyHash = u})

-- IncrementalStake

isCredMapL :: EraStake era => Lens' (InstantStake era) (Map (Credential 'Staking) Coin)
isCredMapL :: forall era.
EraStake era =>
Lens' (InstantStake era) (Map (Credential 'Staking) Coin)
isCredMapL =
  (InstantStake era -> Map (Credential 'Staking) Coin)
-> (InstantStake era
    -> Map (Credential 'Staking) Coin -> InstantStake era)
-> Lens
     (InstantStake era)
     (InstantStake era)
     (Map (Credential 'Staking) Coin)
     (Map (Credential 'Staking) Coin)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (\InstantStake era
is -> (CompactForm Coin -> Coin)
-> Map (Credential 'Staking) (CompactForm Coin)
-> Map (Credential 'Staking) Coin
forall a b.
(a -> b)
-> Map (Credential 'Staking) a -> Map (Credential 'Staking) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (InstantStake era
is InstantStake era
-> Getting
     (Map (Credential 'Staking) (CompactForm Coin))
     (InstantStake era)
     (Map (Credential 'Staking) (CompactForm Coin))
-> Map (Credential 'Staking) (CompactForm Coin)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (Credential 'Staking) (CompactForm Coin))
  (InstantStake era)
  (Map (Credential 'Staking) (CompactForm Coin))
forall era.
EraStake era =>
Lens'
  (InstantStake era) (Map (Credential 'Staking) (CompactForm Coin))
Lens'
  (InstantStake era) (Map (Credential 'Staking) (CompactForm Coin))
instantStakeCredentialsL))
    (\InstantStake era
is Map (Credential 'Staking) Coin
m -> InstantStake era
is InstantStake era
-> (InstantStake era -> InstantStake era) -> InstantStake era
forall a b. a -> (a -> b) -> b
& (Map (Credential 'Staking) (CompactForm Coin)
 -> Identity (Map (Credential 'Staking) (CompactForm Coin)))
-> InstantStake era -> Identity (InstantStake era)
forall era.
EraStake era =>
Lens'
  (InstantStake era) (Map (Credential 'Staking) (CompactForm Coin))
Lens'
  (InstantStake era) (Map (Credential 'Staking) (CompactForm Coin))
instantStakeCredentialsL ((Map (Credential 'Staking) (CompactForm Coin)
  -> Identity (Map (Credential 'Staking) (CompactForm Coin)))
 -> InstantStake era -> Identity (InstantStake era))
-> Map (Credential 'Staking) (CompactForm Coin)
-> InstantStake era
-> InstantStake era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Coin -> CompactForm Coin)
-> Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) (CompactForm Coin)
forall a b.
(a -> b)
-> Map (Credential 'Staking) a -> Map (Credential 'Staking) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
compactCoinOrError Map (Credential 'Staking) Coin
m)

isPtrMapL :: Lens' (ShelleyInstantStake era) (Map Ptr Coin)
isPtrMapL :: forall era (f :: * -> *).
Functor f =>
(Map Ptr Coin -> f (Map Ptr Coin))
-> ShelleyInstantStake era -> f (ShelleyInstantStake era)
isPtrMapL = (ShelleyInstantStake era -> Map Ptr Coin)
-> (ShelleyInstantStake era
    -> Map Ptr Coin -> ShelleyInstantStake era)
-> Lens
     (ShelleyInstantStake era)
     (ShelleyInstantStake era)
     (Map Ptr Coin)
     (Map Ptr Coin)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ((CompactForm Coin -> Coin)
-> Map Ptr (CompactForm Coin) -> Map Ptr Coin
forall a b. (a -> b) -> Map Ptr a -> Map Ptr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (Map Ptr (CompactForm Coin) -> Map Ptr Coin)
-> (ShelleyInstantStake era -> Map Ptr (CompactForm Coin))
-> ShelleyInstantStake era
-> Map Ptr Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyInstantStake era -> Map Ptr (CompactForm Coin)
forall era. ShelleyInstantStake era -> Map Ptr (CompactForm Coin)
sisPtrStake) (\ShelleyInstantStake era
ds Map Ptr Coin
u -> ShelleyInstantStake era
ds {sisPtrStake = fmap compactCoinOrError u})

-- ===============================================
-- NonMyopic

nmLikelihoodsL :: Lens' NonMyopic (Map (KeyHash 'StakePool) [Float])
nmLikelihoodsL :: Lens' NonMyopic (Map (KeyHash 'StakePool) [Float])
nmLikelihoodsL =
  (NonMyopic -> Map (KeyHash 'StakePool) [Float])
-> (NonMyopic -> Map (KeyHash 'StakePool) [Float] -> NonMyopic)
-> Lens' NonMyopic (Map (KeyHash 'StakePool) [Float])
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    ((Likelihood -> [Float])
-> Map (KeyHash 'StakePool) Likelihood
-> Map (KeyHash 'StakePool) [Float]
forall a b.
(a -> b)
-> Map (KeyHash 'StakePool) a -> Map (KeyHash 'StakePool) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Likelihood -> [Float]
fromLikelihood (Map (KeyHash 'StakePool) Likelihood
 -> Map (KeyHash 'StakePool) [Float])
-> (NonMyopic -> Map (KeyHash 'StakePool) Likelihood)
-> NonMyopic
-> Map (KeyHash 'StakePool) [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonMyopic -> Map (KeyHash 'StakePool) Likelihood
likelihoodsNM)
    (\NonMyopic
ds Map (KeyHash 'StakePool) [Float]
u -> NonMyopic
ds {likelihoodsNM = fmap toLikelihood u})
  where
    fromLikelihood :: Likelihood -> [Float]
fromLikelihood (Likelihood StrictSeq LogWeight
ls) = LogWeight -> Float
unLogWeight (LogWeight -> Float) -> [LogWeight] -> [Float]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq LogWeight -> [LogWeight]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq LogWeight
ls
    toLikelihood :: [Float] -> Likelihood
toLikelihood = StrictSeq LogWeight -> Likelihood
Likelihood (StrictSeq LogWeight -> Likelihood)
-> ([Float] -> StrictSeq LogWeight) -> [Float] -> Likelihood
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LogWeight] -> StrictSeq LogWeight
forall a. [a] -> StrictSeq a
fromList ([LogWeight] -> StrictSeq LogWeight)
-> ([Float] -> [LogWeight]) -> [Float] -> StrictSeq LogWeight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> LogWeight) -> [Float] -> [LogWeight]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> LogWeight
LogWeight

nmRewardPotL :: Lens' NonMyopic Coin
nmRewardPotL :: Lens' NonMyopic Coin
nmRewardPotL = (NonMyopic -> Coin)
-> (NonMyopic -> Coin -> NonMyopic) -> Lens' NonMyopic Coin
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens NonMyopic -> Coin
rewardPotNM (\NonMyopic
ds Coin
u -> NonMyopic
ds {rewardPotNM = u})

-- ======================================================
-- (Virtual) UMap

spRewL :: Lens' Split (Map (Credential 'Staking) Coin)
spRewL :: Lens' Split (Map (Credential 'Staking) Coin)
spRewL = (Split -> Map (Credential 'Staking) Coin)
-> (Split -> Map (Credential 'Staking) Coin -> Split)
-> Lens' Split (Map (Credential 'Staking) Coin)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Split -> Map (Credential 'Staking) Coin
spRew (\Split
ds Map (Credential 'Staking) Coin
u -> Split
ds {spRew = u})

spDepL :: Lens' Split (Map (Credential 'Staking) Coin)
spDepL :: Lens' Split (Map (Credential 'Staking) Coin)
spDepL = (Split -> Map (Credential 'Staking) Coin)
-> (Split -> Map (Credential 'Staking) Coin -> Split)
-> Lens' Split (Map (Credential 'Staking) Coin)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Split -> Map (Credential 'Staking) Coin
spDep (\Split
ds Map (Credential 'Staking) Coin
u -> Split
ds {spDep = u})

spDelL :: Lens' Split (Map (Credential 'Staking) (KeyHash 'StakePool))
spDelL :: Lens' Split (Map (Credential 'Staking) (KeyHash 'StakePool))
spDelL = (Split -> Map (Credential 'Staking) (KeyHash 'StakePool))
-> (Split
    -> Map (Credential 'Staking) (KeyHash 'StakePool) -> Split)
-> Lens' Split (Map (Credential 'Staking) (KeyHash 'StakePool))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Split -> Map (Credential 'Staking) (KeyHash 'StakePool)
spDel (\Split
ds Map (Credential 'Staking) (KeyHash 'StakePool)
u -> Split
ds {spDel = u})

spRevPtrL :: Lens' Split (Map (Credential 'Staking) (Set Ptr))
spRevPtrL :: Lens' Split (Map (Credential 'Staking) (Set Ptr))
spRevPtrL = (Split -> Map (Credential 'Staking) (Set Ptr))
-> (Split -> Map (Credential 'Staking) (Set Ptr) -> Split)
-> Lens' Split (Map (Credential 'Staking) (Set Ptr))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Split -> Map (Credential 'Staking) (Set Ptr)
spRevPtr (\Split
ds Map (Credential 'Staking) (Set Ptr)
u -> Split
ds {spRevPtr = u})

spPtrL :: Lens' Split (Map Ptr (Credential 'Staking))
spPtrL :: Lens' Split (Map Ptr (Credential 'Staking))
spPtrL = (Split -> Map Ptr (Credential 'Staking))
-> (Split -> Map Ptr (Credential 'Staking) -> Split)
-> Lens' Split (Map Ptr (Credential 'Staking))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Split -> Map Ptr (Credential 'Staking)
spPtr (\Split
ds Map Ptr (Credential 'Staking)
u -> Split
ds {spPtr = u})

spDRepL :: Lens' Split (Map (Credential 'Staking) DRep)
spDRepL :: Lens' Split (Map (Credential 'Staking) DRep)
spDRepL = (Split -> Map (Credential 'Staking) DRep)
-> (Split -> Map (Credential 'Staking) DRep -> Split)
-> Lens' Split (Map (Credential 'Staking) DRep)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Split -> Map (Credential 'Staking) DRep
spDRep (\Split
ds Map (Credential 'Staking) DRep
u -> Split
ds {spDRep = u})

-- ========================================================================================
-- Mapping the abstract names: rewards, delegations, ptrs, credDeposits through the UMap

-- | Abstract view of the UMap
data Split = Split
  { Split -> Map (Credential 'Staking) Coin
spRew :: Map (Credential 'Staking) Coin
  , Split -> Map (Credential 'Staking) Coin
spDep :: Map (Credential 'Staking) Coin
  , Split -> Map (Credential 'Staking) (KeyHash 'StakePool)
spDel :: Map (Credential 'Staking) (KeyHash 'StakePool)
  , Split -> Map (Credential 'Staking) DRep
spDRep :: Map (Credential 'Staking) DRep
  , Split -> Map (Credential 'Staking) (Set Ptr)
spRevPtr :: Map (Credential 'Staking) (Set Ptr)
  , Split -> Map Ptr (Credential 'Staking)
spPtr :: Map Ptr (Credential 'Staking)
  }

-- | The abstraction function, from concrete (UMap) to abstract (Split)
splitUMap :: UMap -> Split
splitUMap :: UMap -> Split
splitUMap UMap
um =
  Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) (KeyHash 'StakePool)
-> Map (Credential 'Staking) DRep
-> Map (Credential 'Staking) (Set Ptr)
-> Map Ptr (Credential 'Staking)
-> Split
Split (UMap -> Map (Credential 'Staking) Coin
rewardMap UMap
um) (UMap -> Map (Credential 'Staking) Coin
depositMap UMap
um) (UMap -> Map (Credential 'Staking) (KeyHash 'StakePool)
sPoolMap UMap
um) (UMap -> Map (Credential 'Staking) DRep
dRepMap UMap
um) (UMap -> Map (Credential 'Staking) (Set Ptr)
invPtrMap UMap
um) (UMap -> Map Ptr (Credential 'Staking)
UM.ptrMap UMap
um)

-- | The concretization function from abstract (Split) to concrete (UMap)
unSplitUMap :: Split -> UMap
unSplitUMap :: Split -> UMap
unSplitUMap (Split Map (Credential 'Staking) Coin
rew Map (Credential 'Staking) Coin
dep Map (Credential 'Staking) (KeyHash 'StakePool)
deleg Map (Credential 'Staking) DRep
drep Map (Credential 'Staking) (Set Ptr)
_revptr Map Ptr (Credential 'Staking)
ptr) = Map (Credential 'Staking) RDPair
-> Map Ptr (Credential 'Staking)
-> Map (Credential 'Staking) (KeyHash 'StakePool)
-> Map (Credential 'Staking) DRep
-> UMap
unify (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) RDPair
forall {k}. Ord k => Map k Coin -> Map k Coin -> Map k RDPair
merge Map (Credential 'Staking) Coin
rew Map (Credential 'Staking) Coin
dep) Map Ptr (Credential 'Staking)
ptr Map (Credential 'Staking) (KeyHash 'StakePool)
deleg Map (Credential 'Staking) DRep
drep
  where
    merge :: Map k Coin -> Map k Coin -> Map k RDPair
merge Map k Coin
x Map k Coin
y | Map k Coin -> Set k
forall k a. Map k a -> Set k
Map.keysSet Map k Coin
x Set k -> Set k -> Bool
forall a. Eq a => a -> a -> Bool
/= Map k Coin -> Set k
forall k a. Map k a -> Set k
Map.keysSet Map k Coin
y = [Char] -> Map k RDPair
forall a. HasCallStack => [Char] -> a
error [Char]
"different domains"
    merge Map k Coin
x Map k Coin
y = (Coin -> Coin -> RDPair)
-> Map k Coin -> Map k Coin -> Map k RDPair
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith Coin -> Coin -> RDPair
rdpair Map k Coin
x Map k Coin
y
    rdpair :: Coin -> Coin -> RDPair
rdpair Coin
x Coin
y = CompactForm Coin -> CompactForm Coin -> RDPair
RDPair (HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
compactCoinOrError Coin
x) (HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
compactCoinOrError Coin
y)

-- Lenses that reach through the concrete  (UMap) using abstract inputs

rewardsUMapL :: Lens' UMap (Map (Credential 'Staking) Coin)
rewardsUMapL :: Lens' UMap (Map (Credential 'Staking) Coin)
rewardsUMapL = (UMap -> Map (Credential 'Staking) Coin)
-> (UMap -> Map (Credential 'Staking) Coin -> UMap)
-> Lens' UMap (Map (Credential 'Staking) Coin)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UMap -> Map (Credential 'Staking) Coin
rewardMap UMap -> Map (Credential 'Staking) Coin -> UMap
delta
  where
    delta :: UMap -> Map (Credential 'Staking) Coin -> UMap
delta UMap
um Map (Credential 'Staking) Coin
new = Split -> UMap
unSplitUMap (Split
split {spRew = new})
      where
        split :: Split
split = UMap -> Split
splitUMap UMap
um

stakeDepositsUMapL :: Lens' UMap (Map (Credential 'Staking) Coin)
stakeDepositsUMapL :: Lens' UMap (Map (Credential 'Staking) Coin)
stakeDepositsUMapL = (UMap -> Map (Credential 'Staking) Coin)
-> (UMap -> Map (Credential 'Staking) Coin -> UMap)
-> Lens' UMap (Map (Credential 'Staking) Coin)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UMap -> Map (Credential 'Staking) Coin
depositMap UMap -> Map (Credential 'Staking) Coin -> UMap
delta
  where
    delta :: UMap -> Map (Credential 'Staking) Coin -> UMap
delta UMap
um Map (Credential 'Staking) Coin
new = Split -> UMap
unSplitUMap (Split
split {spDep = new})
      where
        split :: Split
split = UMap -> Split
splitUMap UMap
um

ptrsUMapL :: Lens' UMap (Map Ptr (Credential 'Staking))
ptrsUMapL :: Lens' UMap (Map Ptr (Credential 'Staking))
ptrsUMapL = (UMap -> Map Ptr (Credential 'Staking))
-> (UMap -> Map Ptr (Credential 'Staking) -> UMap)
-> Lens' UMap (Map Ptr (Credential 'Staking))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UMap -> Map Ptr (Credential 'Staking)
UM.ptrMap (\(UMap Map (Credential 'Staking) UMElem
x Map Ptr (Credential 'Staking)
_) Map Ptr (Credential 'Staking)
p -> Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UMap
UMap Map (Credential 'Staking) UMElem
x Map Ptr (Credential 'Staking)
p)

delegationsUMapL :: Lens' UMap (Map (Credential 'Staking) (KeyHash 'StakePool))
delegationsUMapL :: Lens' UMap (Map (Credential 'Staking) (KeyHash 'StakePool))
delegationsUMapL = (UMap -> Map (Credential 'Staking) (KeyHash 'StakePool))
-> (UMap -> Map (Credential 'Staking) (KeyHash 'StakePool) -> UMap)
-> Lens' UMap (Map (Credential 'Staking) (KeyHash 'StakePool))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UMap -> Map (Credential 'Staking) (KeyHash 'StakePool)
sPoolMap UMap -> Map (Credential 'Staking) (KeyHash 'StakePool) -> UMap
delta
  where
    delta :: UMap -> Map (Credential 'Staking) (KeyHash 'StakePool) -> UMap
delta UMap
um Map (Credential 'Staking) (KeyHash 'StakePool)
new = Split -> UMap
unSplitUMap (Split
split {spDel = new})
      where
        split :: Split
split = UMap -> Split
splitUMap UMap
um

drepUMapL :: Lens' UMap (Map (Credential 'Staking) DRep)
drepUMapL :: Lens' UMap (Map (Credential 'Staking) DRep)
drepUMapL = (UMap -> Map (Credential 'Staking) DRep)
-> (UMap -> Map (Credential 'Staking) DRep -> UMap)
-> Lens' UMap (Map (Credential 'Staking) DRep)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UMap -> Map (Credential 'Staking) DRep
dRepMap UMap -> Map (Credential 'Staking) DRep -> UMap
delta
  where
    delta :: UMap -> Map (Credential 'Staking) DRep -> UMap
delta UMap
um Map (Credential 'Staking) DRep
new = Split -> UMap
unSplitUMap ((UMap -> Split
splitUMap UMap
um) {spDRep = new})

-- Conversion Lenses

strictMaybeToMaybeL :: Lens' (StrictMaybe x) (Maybe x)
strictMaybeToMaybeL :: forall x (f :: * -> *).
Functor f =>
(Maybe x -> f (Maybe x)) -> StrictMaybe x -> f (StrictMaybe x)
strictMaybeToMaybeL = (StrictMaybe x -> Maybe x)
-> (StrictMaybe x -> Maybe x -> StrictMaybe x)
-> Lens (StrictMaybe x) (StrictMaybe x) (Maybe x) (Maybe x)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens StrictMaybe x -> Maybe x
forall {a}. StrictMaybe a -> Maybe a
ff StrictMaybe x -> Maybe x -> StrictMaybe x
forall {p} {a}. p -> Maybe a -> StrictMaybe a
gg
  where
    ff :: StrictMaybe a -> Maybe a
ff (SJust a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
    ff StrictMaybe a
SNothing = Maybe a
forall a. Maybe a
Nothing
    gg :: p -> Maybe a -> StrictMaybe a
gg p
_ (Just a
x) = a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust a
x
    gg p
_ Maybe a
Nothing = StrictMaybe a
forall a. StrictMaybe a
SNothing

idLens :: Lens' a a
idLens :: forall a (f :: * -> *). Functor f => (a -> f a) -> a -> f a
idLens = (a -> a) -> (a -> a -> a) -> Lens a a a a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens a -> a
forall a. a -> a
id (\a
_ a
y -> a
y)

strictSeqListL :: Lens' (StrictSeq a) [a]
strictSeqListL :: forall a (f :: * -> *).
Functor f =>
([a] -> f [a]) -> StrictSeq a -> f (StrictSeq a)
strictSeqListL = (StrictSeq a -> [a])
-> (StrictSeq a -> [a] -> StrictSeq a)
-> Lens (StrictSeq a) (StrictSeq a) [a] [a]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens StrictSeq a -> [a]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (\StrictSeq a
_ [a]
y -> [a] -> StrictSeq a
forall a. [a] -> StrictSeq a
fromList [a]
y)

mapCompactFormCoinL :: Lens' (Map a (CompactForm Coin)) (Map a Coin)
mapCompactFormCoinL :: forall a (f :: * -> *).
Functor f =>
(Map a Coin -> f (Map a Coin))
-> Map a (CompactForm Coin) -> f (Map a (CompactForm Coin))
mapCompactFormCoinL = (Map a (CompactForm Coin) -> Map a Coin)
-> (Map a (CompactForm Coin)
    -> Map a Coin -> Map a (CompactForm Coin))
-> Lens
     (Map a (CompactForm Coin))
     (Map a (CompactForm Coin))
     (Map a Coin)
     (Map a Coin)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ((CompactForm Coin -> Coin)
-> Map a (CompactForm Coin) -> Map a Coin
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact) (\Map a (CompactForm Coin)
_ Map a Coin
y -> (Coin -> CompactForm Coin)
-> Map a Coin -> Map a (CompactForm Coin)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
compactCoinOrError Map a Coin
y)

pairL :: Lens' x y -> Lens' a b -> Lens' (x, a) (y, b)
pairL :: forall x y a b. Lens' x y -> Lens' a b -> Lens' (x, a) (y, b)
pairL Lens' x y
xy Lens' a b
ab = ((x, a) -> (y, b))
-> ((x, a) -> (y, b) -> (x, a)) -> Lens (x, a) (x, a) (y, b) (y, b)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (x, a) -> (y, b)
getter (x, a) -> (y, b) -> (x, a)
setter
  where
    getter :: (x, a) -> (y, b)
getter (x
x, a
a) = (x
x x -> Getting y x y -> y
forall s a. s -> Getting a s a -> a
^. Getting y x y
Lens' x y
xy, a
a a -> Getting b a b -> b
forall s a. s -> Getting a s a -> a
^. Getting b a b
Lens' a b
ab)
    setter :: (x, a) -> (y, b) -> (x, a)
setter (x
x, a
a) (y
y, b
b) = (x
x x -> (x -> x) -> x
forall a b. a -> (a -> b) -> b
& (y -> Identity y) -> x -> Identity x
Lens' x y
xy ((y -> Identity y) -> x -> Identity x) -> y -> x -> x
forall s t a b. ASetter s t a b -> b -> s -> t
.~ y
y, a
a a -> (a -> a) -> a
forall a b. a -> (a -> b) -> b
& (b -> Identity b) -> a -> Identity a
Lens' a b
ab ((b -> Identity b) -> a -> Identity a) -> b -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
b)

-- | Lens to convert from the abstract type UtxO type of the Model, to the concrete UTxO type.
--   The mode uses the type family abstraction TxOutF, and does not wrap the map
--   with the UtxO constructor. Note the getter is 'liftUTxO' from Test.Cardano.Ledger.Constrained.Classes
--   liftUTxO :: Map (TxIn ) (TxOutF era) -> UTxO era
utxoFL :: Proof era -> Lens' (Map TxIn (TxOutF era)) (UTxO era)
utxoFL :: forall era. Proof era -> Lens' (Map TxIn (TxOutF era)) (UTxO era)
utxoFL Proof era
p = (Map TxIn (TxOutF era) -> UTxO era)
-> (Map TxIn (TxOutF era) -> UTxO era -> Map TxIn (TxOutF era))
-> Lens
     (Map TxIn (TxOutF era))
     (Map TxIn (TxOutF era))
     (UTxO era)
     (UTxO era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Map TxIn (TxOutF era) -> UTxO era
forall era. Map TxIn (TxOutF era) -> UTxO era
liftUTxO (\Map TxIn (TxOutF era)
_ (UTxO Map TxIn (TxOut era)
new) -> (TxOut era -> TxOutF era)
-> Map TxIn (TxOut era) -> Map TxIn (TxOutF era)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Proof era -> TxOut era -> TxOutF era
forall era. Proof era -> TxOut era -> TxOutF era
TxOutF Proof era
p) Map TxIn (TxOut era)
new)

-- ======================================================================
-- Don't tell me that these have impementations in Lens.Micro( _1, _2 )
-- The problem with this, is that it needs special pragmas to work, and without
-- these pragmas, causes ghci to hang.
-- In addition there is NO documentation (only examples in Lens.Micro)
-- and who remembers this any way?
-- Way easier to remember these because they use the Cardano.Ledger Lens naming conventions

fstL :: Lens' (a, b) a
fstL :: forall a b (f :: * -> *).
Functor f =>
(a -> f a) -> (a, b) -> f (a, b)
fstL = ((a, b) -> a) -> ((a, b) -> a -> (a, b)) -> Lens (a, b) (a, b) a a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (a, b) -> a
forall a b. (a, b) -> a
fst (\(a
_, b
b) a
a -> (a
a, b
b))

sndL :: Lens' (a, b) b
sndL :: forall a b (f :: * -> *).
Functor f =>
(b -> f b) -> (a, b) -> f (a, b)
sndL = ((a, b) -> b) -> ((a, b) -> b -> (a, b)) -> Lens (a, b) (a, b) b b
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (a, b) -> b
forall a b. (a, b) -> b
snd (\(a
a, b
_) b
b -> (a
a, b
b))