diff --git a/lib/Internal/History.hs b/lib/Internal/History.hs index 6de2fe9..a87b65d 100644 --- a/lib/Internal/History.hs +++ b/lib/Internal/History.hs @@ -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