diff --git a/lib/Internal/History.hs b/lib/Internal/History.hs index 6465976..fcce8ee 100644 --- a/lib/Internal/History.hs +++ b/lib/Internal/History.hs @@ -339,21 +339,21 @@ balanceTxs => [EntryBin] -> m ([UEBalanced], [KeyTx CommitR]) balanceTxs es = - (first concat . partitionEithers . catMaybes) + first concat . partitionEithers . catMaybes <$> evalStateT (mapErrors go $ L.sortOn binDate es) M.empty where go (ToUpdate utx) = fmap (Just . Left) $ liftInnerS $ rebalanceEntrySet utx go (ToRead ReadEntry {reCurrency, reAcnt, reValue}) = do modify $ mapAdd_ (reAcnt, reCurrency) reValue return Nothing - go (ToInsert (t@Tx {txEntries, txDate})) = + go (ToInsert t@Tx {txEntries}) = (\es' -> Just $ Right $ t {txEntries = concat es'}) - <$> mapM (balanceEntrySet txDate) txEntries + <$> mapErrors balanceEntrySet txEntries binDate :: EntryBin -> Day -binDate (ToUpdate (UpdateEntrySet {utDate})) = utDate +binDate (ToUpdate UpdateEntrySet {utDate}) = utDate binDate (ToRead ReadEntry {reDate}) = reDate -binDate (ToInsert (Tx {txDate})) = txDate +binDate (ToInsert Tx {txDate}) = txDate type EntryBals = M.Map (AccountRId, CurrencyRId) Rational @@ -383,10 +383,10 @@ rebalanceEntrySet ++ (UET_Balance <$> utFromUnk) ++ (UET_Linked <$> utPairs) fs' <- mapM goFrom fs - let f0val = utTotalValue - (sum $ fmap value fs') + let f0val = utTotalValue - sum (fmap value fs') let f0 = utFrom0 {ueValue = EntryValue f0val} let (tpairs, fs'') = partitionEithers $ concatMap flatten fs' - let tsLink0 = fmap (\e -> e {ueValue = EntryValue $ -f0val * (unLinkScale $ ueValue e)}) utToUnkLink0 + let tsLink0 = fmap (\e -> e {ueValue = EntryValue $ -f0val * unLinkScale (ueValue e)}) utToUnkLink0 let ts = L.sortOn idx2 $ (UET_Linked <$> (tpairs ++ tsLink0)) @@ -394,10 +394,10 @@ rebalanceEntrySet ++ (UET_ReadOnly <$> utToRO) (tsRO, tsUnk) <- partitionEithers <$> mapM goTo ts let t0val = - (EntryValue utTotalValue) - - (sum $ (fmap ueValue tsRO) ++ (fmap ueValue tsUnk)) + EntryValue utTotalValue + - sum (fmap ueValue tsRO ++ fmap ueValue tsUnk) let t0 = utTo0 {ueValue = t0val} - return $ (f0 : (fmap (fmap (EntryValue . unBalanceTarget)) fs'')) ++ (t0 : tsUnk) + return $ (f0 : fmap (fmap (EntryValue . unBalanceTarget)) fs'') ++ (t0 : tsUnk) where project f _ _ (UET_ReadOnly e) = f e project _ f _ (UET_Balance e) = f e @@ -409,7 +409,7 @@ rebalanceEntrySet (unEntryValue . ueValue) (unBalanceTarget . ueValue) (unBalanceTarget . ueValue . fst) - flatten = project (const []) ((: []) . Right) (\(a, bs) -> (Right a) : (Left <$> bs)) + flatten = project (const []) ((: []) . Right) (\(a, bs) -> Right a : (Left <$> bs)) -- TODO the following is wetter than the average groupie goFrom (UET_ReadOnly e) = do modify $ mapAdd_ (ueAcnt e, utCurrency) (unEntryValue $ ueValue e) @@ -426,7 +426,7 @@ rebalanceEntrySet let newVal = unBalanceTarget (ueValue e0) - curBal modify $ mapAdd_ key newVal return $ - UET_Linked $ + UET_Linked ( e0 {ueValue = BalanceTarget newVal} , fmap (\e -> e {ueValue = EntryValue $ (-newVal) * unLinkScale (ueValue e)}) es ) @@ -445,11 +445,9 @@ rebalanceEntrySet balanceEntrySet :: (MonadInsertError m, MonadFinance m) - => Day - -> DeferredEntrySet + => DeferredEntrySet -> StateT EntryBals m [KeyEntry] balanceEntrySet - day EntrySet { esFrom = HalfEntrySet {hesPrimary = f0, hesOther = fs} , esTo = HalfEntrySet {hesPrimary = t0, hesOther = ts} @@ -482,7 +480,7 @@ doEntries -> NonEmpty Int -> StateT EntryBals m [FullEntry AccountRId CurrencyRId TagRId] doEntries f curID tot e es (i0 :| iN) = do - es' <- mapM (uncurry f) $ zip iN es + es' <- mapErrors (uncurry f) $ zip iN es let val0 = tot - entrySum es' e' <- balanceEntry (\_ _ -> return (val0, Nothing)) curID i0 e return $ e' : es' @@ -505,6 +503,8 @@ balanceLinked from curID precision acntID lg = case lg of let res = fmap (go lngScale) $ from V.!? fromIntegral lngIndex case res of Just v -> return $ (v, Just $ EntryLinked lngIndex $ toRational lngScale) + -- TODO this error would be much more informative if I had access to the + -- file from which it came Nothing -> throwError undefined (LinkDeferred d) -> liftInnerS $ balanceDeferred curID acntID d where