FIX failure to track last entry when updating full entrysets

This commit is contained in:
Nathan Dwarshuis 2023-07-27 00:17:53 -04:00
parent 0c5401cd0b
commit 7609171ab4
1 changed files with 9 additions and 10 deletions

View File

@ -693,14 +693,12 @@ rebalanceTotalEntrySet
, utTotalValue , utTotalValue
} = } =
do do
(fval, fs, tpairs) <- rebalanceDebit bc utFromRO utFromUnk (fval, fs, tpairs) <- rebalanceDebit utCurrency utFromRO utFromUnk
let f0val = utTotalValue - fval let f0val = utTotalValue - fval
modify $ mapAdd_ (f0Acnt, bc) f0val modify $ mapAdd_ (f0Acnt, utCurrency) f0val
let tsLinked = tpairs ++ (unlink f0val <$> f0links) let tsLinked = tpairs ++ (unlink f0val <$> f0links)
ts <- rebalanceCredit bc utTotalValue utTo0 utToUnk utToRO tsLinked ts <- rebalanceCredit utCurrency utTotalValue utTo0 utToUnk utToRO tsLinked
return (f0 {ueValue = StaticValue f0val} : fs ++ ts) return (f0 {ueValue = StaticValue f0val} : fs ++ ts)
where
bc = utCurrency
rebalanceFullEntrySet :: FullUpdateEntrySet -> State EntryBals [UEBalanced] rebalanceFullEntrySet :: FullUpdateEntrySet -> State EntryBals [UEBalanced]
rebalanceFullEntrySet rebalanceFullEntrySet
@ -714,14 +712,13 @@ rebalanceFullEntrySet
, utCurrency , utCurrency
} = } =
do do
(ftot, fs, tpairs) <- rebalanceDebit bc rs ls (ftot, fs, tpairs) <- rebalanceDebit utCurrency rs ls
ts <- rebalanceCredit bc ftot utTo0 utToUnk utToRO tpairs ts <- rebalanceCredit utCurrency ftot utTo0 utToUnk utToRO tpairs
return (fs ++ ts) return (fs ++ ts)
where where
(rs, ls) = case utFrom0 of (rs, ls) = case utFrom0 of
Left x -> (x : utFromRO, utFromUnk) Left x -> (x : utFromRO, utFromUnk)
Right x -> (utFromRO, x : utFromUnk) Right x -> (utFromRO, x : utFromUnk)
bc = utCurrency
rebalanceDebit rebalanceDebit
:: BCKey :: BCKey
@ -755,7 +752,7 @@ rebalanceCredit
-> [UE_RO] -> [UE_RO]
-> [UEBalanced] -> [UEBalanced]
-> State EntryBals [UEBalanced] -> State EntryBals [UEBalanced]
rebalanceCredit k tot t0 us rs bs = do rebalanceCredit k tot t0@UpdateEntry {ueAcnt = t0Acnt} us rs bs = do
(tval, ts) <- (tval, ts) <-
fmap (second catMaybes) $ fmap (second catMaybes) $
sumM goTo $ sumM goTo $
@ -763,7 +760,9 @@ rebalanceCredit k tot t0 us rs bs = do
(UETLinked <$> bs) (UETLinked <$> bs)
++ (UETUnk <$> us) ++ (UETUnk <$> us)
++ (UETReadOnly <$> rs) ++ (UETReadOnly <$> rs)
return (t0 {ueValue = StaticValue (-(tot + tval))} : ts) let t0val = -(tot + tval)
modify $ mapAdd_ (t0Acnt, k) t0val
return (t0 {ueValue = StaticValue t0val} : ts)
where where
idx = projectUET ueIndex ueIndex ueIndex idx = projectUET ueIndex ueIndex ueIndex
goTo (UETReadOnly e) = (,Nothing) <$> updateFixed k e goTo (UETReadOnly e) = (,Nothing) <$> updateFixed k e