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)
|
MatchFail -> (matched, r : unmatched)
|
||||||
in go (m, u, resetZipper z') rs
|
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
|
balanceTxs
|
||||||
:: (MonadInsertError m, MonadFinance m)
|
:: (MonadInsertError m, MonadFinance m)
|
||||||
=> [(CommitR, DeferredTx)]
|
=> [(CommitR, DeferredTx)]
|
||||||
-> m [(CommitR, KeyTx)]
|
-> m [(CommitR, KeyTx)]
|
||||||
balanceTxs ts = do
|
balanceTxs ts = do
|
||||||
keyts <- mapErrors resolveTx balTs
|
keyts <- mapErrors resolveTx $ snd $ L.mapAccumL go M.empty ts'
|
||||||
return $ zip cs keyts
|
return $ zip cs keyts
|
||||||
where
|
where
|
||||||
(cs, ts') = L.unzip $ L.sortOn (dtxDate . snd) ts
|
(cs, ts') = L.unzip $ L.sortOn (dtxDate . snd) ts
|
||||||
go bals t@Tx {dtxEntries} =
|
go bals t@Tx {dtxEntries} =
|
||||||
second (\es -> t {dtxEntries = concat es}) $
|
second (\es -> t {dtxEntries = concat es}) $
|
||||||
L.mapAccumL balanceEntrySet bals dtxEntries
|
L.mapAccumL balanceEntrySet bals dtxEntries
|
||||||
balTs = snd $ L.mapAccumL go M.empty ts'
|
|
||||||
|
|
||||||
type EntryBals = M.Map (AcntID, CurID) Rational
|
type EntryBals = M.Map (AcntID, CurID) Rational
|
||||||
|
|
||||||
|
@ -384,14 +381,12 @@ balanceEntry
|
||||||
-> EntryBals
|
-> EntryBals
|
||||||
-> Entry AcntID (Deferred Rational) TagID
|
-> Entry AcntID (Deferred Rational) TagID
|
||||||
-> (EntryBals, Entry AcntID Rational TagID)
|
-> (EntryBals, Entry AcntID Rational TagID)
|
||||||
balanceEntry curID bals e@Entry {eValue = Deferred toBal v, eAcnt}
|
balanceEntry curID bals e@Entry {eValue = Deferred toBal v, eAcnt} =
|
||||||
| toBal = (bals, e {eValue = v})
|
(mapAdd_ key newVal bals, e {eValue = newVal})
|
||||||
| otherwise = (bals', e {eValue = newVal})
|
|
||||||
where
|
where
|
||||||
key = (eAcnt, curID)
|
key = (eAcnt, curID)
|
||||||
curBal = M.findWithDefault 0 key bals
|
curBal = M.findWithDefault 0 key bals
|
||||||
newVal = v - curBal
|
newVal = if toBal then v - curBal else v
|
||||||
bals' = mapAdd_ key newVal bals
|
|
||||||
|
|
||||||
-- -- reimplementation from future version :/
|
-- -- reimplementation from future version :/
|
||||||
-- mapAccumM
|
-- mapAccumM
|
||||||
|
|
Loading…
Reference in New Issue