FIX balancing stuff

This commit is contained in:
Nathan Dwarshuis 2023-06-18 00:14:06 -04:00
parent 87e6dcff8f
commit c2525fb77c
1 changed files with 4 additions and 9 deletions

View File

@ -332,21 +332,18 @@ matchNonDates ms = go ([], [], initZipper ms)
MatchFail -> (matched, r : unmatched)
in go (m, u, resetZipper z') rs
-- TDOO should use a better type here to squish down all the entry sets
-- which at this point in the chain should not be necessary
balanceTxs
:: (MonadInsertError m, MonadFinance m)
=> [(CommitR, DeferredTx)]
-> m [(CommitR, KeyTx)]
balanceTxs ts = do
keyts <- mapErrors resolveTx balTs
keyts <- mapErrors resolveTx $ snd $ L.mapAccumL go M.empty ts'
return $ zip cs keyts
where
(cs, ts') = L.unzip $ L.sortOn (dtxDate . snd) ts
go bals t@Tx {dtxEntries} =
second (\es -> t {dtxEntries = concat es}) $
L.mapAccumL balanceEntrySet bals dtxEntries
balTs = snd $ L.mapAccumL go M.empty ts'
type EntryBals = M.Map (AcntID, CurID) Rational
@ -384,14 +381,12 @@ balanceEntry
-> EntryBals
-> Entry AcntID (Deferred Rational) TagID
-> (EntryBals, Entry AcntID Rational TagID)
balanceEntry curID bals e@Entry {eValue = Deferred toBal v, eAcnt}
| toBal = (bals, e {eValue = v})
| otherwise = (bals', e {eValue = newVal})
balanceEntry curID bals e@Entry {eValue = Deferred toBal v, eAcnt} =
(mapAdd_ key newVal bals, e {eValue = newVal})
where
key = (eAcnt, curID)
curBal = M.findWithDefault 0 key bals
newVal = v - curBal
bals' = mapAdd_ key newVal bals
newVal = if toBal then v - curBal else v
-- -- reimplementation from future version :/
-- mapAccumM