FIX undefined error paths

This commit is contained in:
Nathan Dwarshuis 2023-06-19 12:33:50 -04:00
parent 03e75ce549
commit f3d2c1655e
3 changed files with 31 additions and 11 deletions

View File

@ -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'}

View File

@ -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]

View File

@ -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]