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 = sum . fmap (dec2Rat . taxValue)
-- TODO these errors could be more descriptive by including an indicator
-- of the budget itself
balancePostTax :: Rational -> [RawAllocation] -> EitherErr [BalAllocation]
balancePostTax bal as
| null as = Left $ AllocationError NoAllocations
balancePostTax :: DatePat -> Rational -> [RawAllocation] -> EitherErr [BalAllocation]
balancePostTax dp bal as
| null as = err NoAllocations
| otherwise = case partitionEithers $ fmap hasVal as of
([([empty], nonmissing)], bs) ->
let s = bal - sumAllocations (nonmissing : bs)
in if s < 0
then Left $ AllocationError ExceededTotal
then err ExceededTotal
else Right $ mapAmts (empty {amtValue = s} :) nonmissing : bs
([], _) -> Left $ AllocationError MissingBlank
_ -> Left $ AllocationError TooManyBlanks
([], _) -> err MissingBlank
_ -> err TooManyBlanks
where
hasVal a@Allocation {alloAmts = xs} =
case partitionEithers $ fmap maybeAmt xs of
@ -199,6 +197,7 @@ balancePostTax bal as
(unbal, bs) -> Left (unbal, a {alloAmts = bs})
maybeAmt a@Amount {amtValue = Just v} = Right a {amtValue = v}
maybeAmt a = Left a
err t = Left $ AllocationError t dp
-- TODO lens reinvention
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 Show TimeUnit
deriving instance Hashable TimeUnit
deriving instance Eq Weekday
deriving instance Show Weekday
deriving instance Hashable Weekday
deriving instance Eq WeekdayPat
deriving instance Show WeekdayPat
deriving instance Hashable WeekdayPat
deriving instance Show RepeatPat
@ -190,14 +196,20 @@ instance Ord GregorianM where
deriving instance Eq ModPat
deriving instance Show ModPat
deriving instance Hashable ModPat
deriving instance Eq CronPat
deriving instance Show CronPat
deriving instance Hashable CronPat
deriving instance Eq DatePat
deriving instance Show DatePat
deriving instance Hashable DatePat
--------------------------------------------------------------------------------
@ -526,7 +538,7 @@ data InsertError
| ConversionError T.Text
| LookupError LookupField T.Text
| BalanceError BalanceType CurID [RawSplit]
| AllocationError AllocationSuberr
| AllocationError AllocationSuberr DatePat
| StatementError [TxRecord] [Match]
deriving (Show)

View File

@ -293,7 +293,13 @@ showError other = (: []) $ case other of
(ConversionError x) -> T.append "Could not convert to rational number: " x
-- TODO use the field indicator
(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) ->
T.concat
[ msg