{-# 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.DRep (DRep)
import Cardano.Ledger.Era (Era (EraCrypto))
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.TxIn (TxIn (..))
import Cardano.Ledger.UMap (
  RDPair (..),
  UMap (..),
  compactCoinOrError,
  dRepMap,
  depositMap,
  invPtrMap,
  rewardMap,
  sPoolMap,
  unify,
 )
import qualified Cardano.Ledger.UMap as UM
import Cardano.Ledger.UTxO (UTxO (..))
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 c) (Map (Credential 'Staking c) Coin)
iRReservesL :: forall c.
Lens' (InstantaneousRewards c) (Map (Credential 'Staking c) Coin)
iRReservesL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall c.
InstantaneousRewards c -> Map (Credential 'Staking c) Coin
iRReserves (\InstantaneousRewards c
ds Map (Credential 'Staking c) Coin
u -> InstantaneousRewards c
ds {iRReserves :: Map (Credential 'Staking c) Coin
iRReserves = Map (Credential 'Staking c) Coin
u})

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

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

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

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

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

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

-- IncrementalStake

isCredMapL :: Lens' (IncrementalStake c) (Map (Credential 'Staking c) Coin)
isCredMapL :: forall c.
Lens' (IncrementalStake c) (Map (Credential 'Staking c) Coin)
isCredMapL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Compactible a => CompactForm a -> a
fromCompact forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
IncrementalStake c
-> Map (Credential 'Staking c) (CompactForm Coin)
credMap) (\IncrementalStake c
ds Map (Credential 'Staking c) Coin
u -> IncrementalStake c
ds {credMap :: Map (Credential 'Staking c) (CompactForm Coin)
credMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HasCallStack => Coin -> CompactForm Coin
compactCoinOrError Map (Credential 'Staking c) Coin
u})

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- Conversion Lenses

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

idLens :: Lens' a a
idLens :: forall a. Lens' a a
idLens = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\a
x -> a
x) (\a
_ a
y -> a
y)

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

mapCompactFormCoinL :: Lens' (Map a (CompactForm Coin)) (Map a Coin)
mapCompactFormCoinL :: forall a. Lens' (Map a (CompactForm Coin)) (Map a Coin)
mapCompactFormCoinL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall a. Compactible a => CompactForm a -> a
fromCompact) (\Map a (CompactForm Coin)
_ Map a Coin
y -> forall a b k. (a -> b) -> Map k a -> Map k b
Map.map HasCallStack => 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 = 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 forall s a. s -> Getting a s a -> a
^. Lens' x y
xy, a
a forall s a. s -> Getting a s a -> a
^. Lens' a b
ab)
    setter :: (x, a) -> (y, b) -> (x, a)
setter (x
x, a
a) (y
y, b
b) = (x
x forall a b. a -> (a -> b) -> b
& Lens' x y
xy forall s t a b. ASetter s t a b -> b -> s -> t
.~ y
y, a
a forall a b. a -> (a -> b) -> b
& Lens' a b
ab 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 (EraCrypto era)) (TxOutF era) -> UTxO era
utxoFL :: Proof era -> Lens' (Map (TxIn (EraCrypto era)) (TxOutF era)) (UTxO era)
utxoFL :: forall era.
Proof era
-> Lens' (Map (TxIn (EraCrypto era)) (TxOutF era)) (UTxO era)
utxoFL Proof era
p = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. Map (TxIn (EraCrypto era)) (TxOutF era) -> UTxO era
liftUTxO (\Map (TxIn (EraCrypto era)) (TxOutF era)
_ (UTxO Map (TxIn (EraCrypto era)) (TxOut era)
new) -> (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall era. Proof era -> TxOut era -> TxOutF era
TxOutF Proof era
p) Map (TxIn (EraCrypto era)) (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. Lens' (a, b) a
fstL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens 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. Lens' (a, b) b
sndL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a b. (a, b) -> b
snd (\(a
a, b
_) b
b -> (a
a, b
b))