ENH make income balance errors more sane

This commit is contained in:
Nathan Dwarshuis 2023-01-27 21:05:25 -05:00
parent 1253cd5b61
commit bb1c79b9a4
3 changed files with 27 additions and 10 deletions

View File

@ -179,19 +179,17 @@ sumAllocations = sum . concatMap (fmap amtValue . alloAmts)
sumTaxes :: [Tax] -> Rational sumTaxes :: [Tax] -> Rational
sumTaxes = sum . fmap (dec2Rat . taxValue) sumTaxes = sum . fmap (dec2Rat . taxValue)
-- TODO these errors could be more descriptive by including an indicator balancePostTax :: DatePat -> Rational -> [RawAllocation] -> EitherErr [BalAllocation]
-- of the budget itself balancePostTax dp bal as
balancePostTax :: Rational -> [RawAllocation] -> EitherErr [BalAllocation] | null as = err NoAllocations
balancePostTax bal as
| null as = Left $ AllocationError NoAllocations
| otherwise = case partitionEithers $ fmap hasVal as of | otherwise = case partitionEithers $ fmap hasVal as of
([([empty], nonmissing)], bs) -> ([([empty], nonmissing)], bs) ->
let s = bal - sumAllocations (nonmissing : bs) let s = bal - sumAllocations (nonmissing : bs)
in if s < 0 in if s < 0
then Left $ AllocationError ExceededTotal then err ExceededTotal
else Right $ mapAmts (empty {amtValue = s} :) nonmissing : bs else Right $ mapAmts (empty {amtValue = s} :) nonmissing : bs
([], _) -> Left $ AllocationError MissingBlank ([], _) -> err MissingBlank
_ -> Left $ AllocationError TooManyBlanks _ -> err TooManyBlanks
where where
hasVal a@Allocation {alloAmts = xs} = hasVal a@Allocation {alloAmts = xs} =
case partitionEithers $ fmap maybeAmt xs of case partitionEithers $ fmap maybeAmt xs of
@ -199,6 +197,7 @@ balancePostTax bal as
(unbal, bs) -> Left (unbal, a {alloAmts = bs}) (unbal, bs) -> Left (unbal, a {alloAmts = bs})
maybeAmt a@Amount {amtValue = Just v} = Right a {amtValue = v} maybeAmt a@Amount {amtValue = Just v} = Right a {amtValue = v}
maybeAmt a = Left a maybeAmt a = Left a
err t = Left $ AllocationError t dp
-- TODO lens reinvention -- TODO lens reinvention
mapAmts :: ([Amount a] -> [Amount b]) -> Allocation a -> Allocation b mapAmts :: ([Amount a] -> [Amount b]) -> Allocation a -> Allocation b

View File

@ -140,14 +140,20 @@ type AcntID = T.Text
deriving instance Eq TimeUnit deriving instance Eq TimeUnit
deriving instance Show TimeUnit
deriving instance Hashable TimeUnit deriving instance Hashable TimeUnit
deriving instance Eq Weekday deriving instance Eq Weekday
deriving instance Show Weekday
deriving instance Hashable Weekday deriving instance Hashable Weekday
deriving instance Eq WeekdayPat deriving instance Eq WeekdayPat
deriving instance Show WeekdayPat
deriving instance Hashable WeekdayPat deriving instance Hashable WeekdayPat
deriving instance Show RepeatPat deriving instance Show RepeatPat
@ -190,14 +196,20 @@ instance Ord GregorianM where
deriving instance Eq ModPat deriving instance Eq ModPat
deriving instance Show ModPat
deriving instance Hashable ModPat deriving instance Hashable ModPat
deriving instance Eq CronPat deriving instance Eq CronPat
deriving instance Show CronPat
deriving instance Hashable CronPat deriving instance Hashable CronPat
deriving instance Eq DatePat deriving instance Eq DatePat
deriving instance Show DatePat
deriving instance Hashable DatePat deriving instance Hashable DatePat
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -526,7 +538,7 @@ data InsertError
| ConversionError T.Text | ConversionError T.Text
| LookupError LookupField T.Text | LookupError LookupField T.Text
| BalanceError BalanceType CurID [RawSplit] | BalanceError BalanceType CurID [RawSplit]
| AllocationError AllocationSuberr | AllocationError AllocationSuberr DatePat
| StatementError [TxRecord] [Match] | StatementError [TxRecord] [Match]
deriving (Show) deriving (Show)

View File

@ -293,7 +293,13 @@ showError other = (: []) $ case other of
(ConversionError x) -> T.append "Could not convert to rational number: " x (ConversionError x) -> T.append "Could not convert to rational number: " x
-- TODO use the field indicator -- TODO use the field indicator
(LookupError _ f) -> T.append "Could not find field: " f (LookupError _ f) -> T.append "Could not find field: " f
(AllocationError _) -> "Could not balance allocation" (AllocationError t dp) -> T.concat [msg, ": datepattern=", showT dp]
where
msg = case t of
NoAllocations -> "No post-tax allocations present"
ExceededTotal -> "Allocations exceed total income"
MissingBlank -> "No blank allocation to balance"
TooManyBlanks -> "Cannot balance multiple blank allocations"
(BalanceError t cur rss) -> (BalanceError t cur rss) ->
T.concat T.concat
[ msg [ msg