diff --git a/lib/Internal/History.hs b/lib/Internal/History.hs index 3b481c6..e6a24ec 100644 --- a/lib/Internal/History.hs +++ b/lib/Internal/History.hs @@ -339,8 +339,8 @@ balanceTxs ts = do return $ zip cs keyts where (cs, ts') = L.unzip $ L.sortOn (txDate . snd) ts - go t@Tx {txEntries} = - (\es -> t {txEntries = concat es}) <$> mapM balanceEntrySet txEntries + go t@Tx {txEntries, txDate} = + (\es -> t {txEntries = concat es}) <$> mapM (balanceEntrySet txDate) txEntries type EntryBals = M.Map (AcntID, CurID) Rational @@ -348,9 +348,11 @@ type EntryBals = M.Map (AcntID, CurID) Rational -- will be looked up for every entry rather then the entire entry set balanceEntrySet :: (MonadInsertError m, MonadFinance m) - => DeferredEntrySet + => Day + -> DeferredEntrySet -> StateT EntryBals m [BalEntry] balanceEntrySet + day EntrySet { esFrom = HalfEntrySet {hesPrimary = f0, hesOther = fs} , esTo = HalfEntrySet {hesPrimary = t0, hesOther = ts} @@ -361,7 +363,7 @@ balanceEntrySet let (lts, dts) = partitionEithers $ splitLinked <$> ts fs' <- doEntries fs esTotalValue f0 let fv = V.fromList $ fmap eValue fs' - lts' <- lift $ mapErrors (resolveLinked fv esCurrency) lts + lts' <- lift $ mapErrors (resolveLinked fv esCurrency day) lts ts' <- doEntries (dts ++ lts') (-esTotalValue) t0 return $ toFull <$> fs' ++ ts' where @@ -380,12 +382,13 @@ resolveLinked :: (MonadInsertError m, MonadFinance m) => Vector Rational -> CurID - -> Entry a LinkedNumGetter t - -> m (Entry a (Deferred Rational) t) -resolveLinked from cur e@Entry {eValue = LinkedNumGetter {lngIndex, lngScale}} = do + -> Day + -> Entry AcntID LinkedNumGetter TagID + -> m (Entry AcntID (Deferred Rational) TagID) +resolveLinked from cur day e@Entry {eValue = LinkedNumGetter {lngIndex, lngScale}} = do curMap <- askDBState kmCurrency case from V.!? fromIntegral lngIndex of - Nothing -> throwError undefined + Nothing -> throwError $ InsertException [IndexError e day] Just v -> do v' <- liftExcept $ roundPrecisionCur cur curMap $ lngScale * fromRational v return $ e {eValue = Deferred False v'} diff --git a/lib/Internal/Types/Main.hs b/lib/Internal/Types/Main.hs index 4495db2..a5f520c 100644 --- a/lib/Internal/Types/Main.hs +++ b/lib/Internal/Types/Main.hs @@ -221,9 +221,10 @@ data InsertError | InsertIOError !T.Text | ParseError !T.Text | ConversionError !T.Text + | IndexError !(Entry AcntID LinkedNumGetter TagID) !Day + | RoundError !CurID | LookupError !LookupSuberr !T.Text - | -- | BalanceError !BalanceType !CurID ![Entry AcntID (Maybe Rational) CurID TagID] - IncomeError !Day !T.Text !Rational + | IncomeError !Day !T.Text !Rational | PatternError !Natural !Natural !(Maybe Natural) !PatternSuberr | DaySpanError !Gregorian !(Maybe Gregorian) | StatementError ![TxRecord] ![MatchRe] diff --git a/lib/Internal/Utils.hs b/lib/Internal/Utils.hs index af8ca25..ac3d062 100644 --- a/lib/Internal/Utils.hs +++ b/lib/Internal/Utils.hs @@ -708,7 +708,7 @@ roundPrecisionCur :: CurID -> CurrencyMap -> Double -> InsertExcept Rational roundPrecisionCur c m x = case M.lookup c m of Just (_, n) -> return $ roundPrecision n x - Nothing -> throwError $ InsertException [undefined] + Nothing -> throwError $ InsertException [RoundError c] acntPath2Text :: AcntPath -> T.Text acntPath2Text (AcntPath t cs) = T.intercalate "/" (atName t : cs) @@ -786,6 +786,22 @@ showError other = case other of , singleQuote $ showT next ] ] + (IndexError Entry {eValue = LinkedNumGetter {lngIndex}, eAcnt} day) -> + [ T.unwords + [ "No credit entry for index" + , singleQuote $ showT lngIndex + , "for entry with account" + , singleQuote eAcnt + , "on" + , showT day + ] + ] + (RoundError cur) -> + [ T.unwords + [ "Could not look up precision for currency" + , singleQuote cur + ] + ] showGregorian_ :: Gregorian -> T.Text showGregorian_ Gregorian {gYear, gMonth, gDay} = T.intercalate "-" $ showT <$> [gYear, gMonth, gDay]