ENH make income balance errors more sane
This commit is contained in:
parent
1253cd5b61
commit
bb1c79b9a4
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue