FIX balancing stuff
This commit is contained in:
parent
87e6dcff8f
commit
c2525fb77c
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue