Use union override and union override with plus operators

IntersectMBO · Jun 27, 2019 · 0815773 · 0815773
1 parent 0815021
commit 0815773
Show file tree

Hide file tree

Showing 4 changed files with 27 additions and 24 deletions.
diff --git a/shelley/chain-and-ledger/executable-spec/src/LedgerState.hs b/shelley/chain-and-ledger/executable-spec/src/LedgerState.hs
@@ -136,7 +136,7 @@ import           Delegation.PoolParams (Delegation (..), PoolParams (..), Reward
 
 import           BaseTypes
 
-import           Ledger.Core ((◁), (▷))
+import           Ledger.Core ((◁), (▷), (∪+))
 
 -- | Representation of a list of pairs of key pairs, e.g., pay and stake keys
 type KeyPairs dsignAlgo = [(KeyPair dsignAlgo, KeyPair dsignAlgo)]
@@ -1104,7 +1104,7 @@ applyRUpd ru (EpochState as ss ls pp) = es'
   where treasury' = _treasury as + deltaT ru
         reserves' = _reserves as + deltaR ru
         rew       = _rewards $ _dstate $ _delegationState ls
-        rewards'  = Map.union (rs ru) rew  -- prefer rs
+        rewards'  = rew ∪+ (rs ru)
         fees'     = (_fees $ _utxoState ls) + deltaF ru
         dstate'   = _dstate $ _delegationState ls
         utxo'     = _utxoState ls

diff --git a/shelley/chain-and-ledger/executable-spec/src/STS/Delegs.hs b/shelley/chain-and-ledger/executable-spec/src/STS/Delegs.hs
@@ -23,6 +23,8 @@ import           Control.State.Transition
 
 import           STS.Delpl
 
+import           Ledger.Core ((∪))
+
 data DELEGS hashAlgo dsignAlgo
 
 instance
@@ -67,7 +69,7 @@ delegsTransition = do
       let dms'' = Map.fromList [(gk, vk) | ((_, gk), vk) <- Map.toList curr]
       pure $ dpstate { _dstate = ds { _rewards = rewards'
                                     , _fdms = fdms''
-                                    , _dms = Dms $ Map.union dms'' dms'}}
+                                    , _dms = Dms $ dms'' ∪ dms'}}
     cert:_certs -> do
       let ptr = Ptr _slot txIx (fromIntegral $ length _certs)
       let isDelegationRegistered = case cert of

diff --git a/shelley/chain-and-ledger/executable-spec/src/STS/PoolReap.hs b/shelley/chain-and-ledger/executable-spec/src/STS/PoolReap.hs
@@ -9,11 +9,7 @@ where
 import qualified Data.Map.Strict               as Map
 import qualified Data.Set                      as Set
 
-import           Lens.Micro                     ( (^.)
-                                                , (&)
-                                                , (.~)
-                                                , (%~)
-                                                )
+import           Lens.Micro                     ((^.))
 
 import           LedgerState
 import           PParams
@@ -23,7 +19,7 @@ import           Coin
 
 import           Control.State.Transition
 
-import           Ledger.Core ((◁))
+import           Ledger.Core ((◁), (⋪), (∪+))
 
 data POOLREAP hashAlgo dsignAlgo
 
@@ -60,18 +56,21 @@ poolReapTransition = do
         Map.partitionWithKey (\k _ -> k `Set.member` domRewards) refunds'
   let unclaimed             = Map.foldl (+) (Coin 0) unclaimed'
   let StakePools stakePools = ps ^. stPools
+
+  let treasury' = (_treasury a) + unclaimed
+
+  let rewards'  = (_rewards ds) ∪+ refunds
+  let delegations' = Map.filter (flip Set.notMember retired) (_delegations ds)
+
+  let stPools' = StakePools $ retired ⋪ stakePools
+  let pParams' = retired ⋪ (_pParams ps)
+  let retiring' = retired ⋪ (_retiring ps)
+  let cs' = retired ⋪ (_cCounters ps)
   pure
-    ( a & treasury %~ (+) unclaimed
-    , ds
-    &  rewards
-    %~ flip Map.union refunds
-    &  delegations
-    %~ flip Map.withoutKeys retired
-    , ps
-    &  stPools
-    .~ (StakePools $ Map.withoutKeys stakePools retired)
-    &  pParams
-    %~ flip Map.withoutKeys retired
-    &  retiring
-    %~ flip Map.withoutKeys retired
-    )
+    ( a { _treasury = treasury' }
+    , ds { _rewards = rewards'
+         , _delegations = delegations' }
+    , ps { _stPools = stPools'
+         , _pParams = pParams'
+         , _retiring = retiring'
+         , _cCounters = cs'})
diff --git a/shelley/chain-and-ledger/executable-spec/src/Updates.hs b/shelley/chain-and-ledger/executable-spec/src/Updates.hs
@@ -33,6 +33,8 @@ import           Slot
 
 import           Numeric.Natural
 
+import           Ledger.Core ((∪))
+
 newtype ApVer = ApVer Natural
   deriving (Show, Ord, Eq, ToCBOR)
 
@@ -151,7 +153,7 @@ updatePPup
   => PPUpdate dsignAlgo
   -> PPUpdate dsignAlgo
   -> PPUpdate dsignAlgo
-updatePPup (PPUpdate pup0') (PPUpdate pup1') = PPUpdate $ Map.union pup1' pup0'
+updatePPup (PPUpdate pup0') (PPUpdate pup1') = PPUpdate $ (pup1' ∪ pup0')
 
 newAVs :: Applications -> Map.Map Slot Applications -> Applications
 newAVs avs favs = if not $ Map.null favs