ENH check all income accounts

This commit is contained in:
Nathan Dwarshuis 2023-05-29 17:06:38 -04:00
parent 1555e9071f
commit b586f958cb
1 changed files with 31 additions and 14 deletions

View File

@ -134,6 +134,9 @@ sortAllo a@Allocation {alloAmts = as} = do
--------------------------------------------------------------------------------
-- Income
-- TODO this will scan the interval allocations fully each time
-- iteration which is a total waste, but the fix requires turning this
-- loop into a fold which I don't feel like doing now :(
insertIncome
:: (MonadInsertError m, MonadFinance m)
=> CommitRId
@ -157,18 +160,23 @@ insertIncome
, incToBal
, incGross
, incPayPeriod
} = do
-- TODO check that the other accounts are not income somewhere here
_ <- checkAcntType IncomeT $ taAcnt incFrom
precision <- lookupCurrencyPrec incCurrency
} =
combineErrorM
(combineError incRes nonIncRes (,))
(combineError precRes dayRes (,))
$ \_ (precision, days) -> do
let gross = roundPrecision precision incGross
-- TODO this will scan the interval allocations fully each time
-- iteration which is a total waste, but the fix requires turning this
-- loop into a fold which I don't feel like doing now :(
days <- askDays incWhen localInterval
res <- foldDays (allocate precision gross) start days
return $ concat res
concat <$> foldDays (allocate precision gross) start days
where
incRes = isIncomeAcnt $ taAcnt incFrom
nonIncRes =
mapErrors isNotIncomeAcnt $
taAcnt incToBal
: (alloAcnt <$> incPretax)
++ (alloAcnt <$> incTaxes)
++ (alloAcnt <$> incPosttax)
precRes = lookupCurrencyPrec incCurrency
dayRes = askDays incWhen localInterval
start = fromGregorian' $ pStart incPayPeriod
pType' = pType incPayPeriod
meta = BudgetMeta key name
@ -254,19 +262,25 @@ foldDays f start days = case NE.nonEmpty days of
snd $
L.mapAccumL (\prevDay day -> (day, f prevDay day)) start days
isIncomeAcnt :: (MonadInsertError m, MonadFinance m) => AcntID -> m ()
isIncomeAcnt = checkAcntType IncomeT
isNotIncomeAcnt :: (MonadInsertError m, MonadFinance m) => AcntID -> m ()
isNotIncomeAcnt = checkAcntTypes (AssetT :| [EquityT, ExpenseT, LiabilityT])
checkAcntType
:: (MonadInsertError m, MonadFinance m)
=> AcntType
-> AcntID
-> m AcntID
-> m ()
checkAcntType t = checkAcntTypes (t :| [])
checkAcntTypes
:: (MonadInsertError m, MonadFinance m)
=> NE.NonEmpty AcntType
-> AcntID
-> m AcntID
checkAcntTypes ts i = go =<< lookupAccountType i
-> m ()
checkAcntTypes ts i = void $ go =<< lookupAccountType i
where
go t
| t `L.elem` ts = return i
@ -499,6 +513,9 @@ initialCurrency :: BudgetCurrency -> CurID
initialCurrency (NoX c) = c
initialCurrency (X Exchange {xFromCur = c}) = c
alloAcnt :: Allocation w v -> AcntID
alloAcnt = taAcnt . alloTo
data UnbalancedValue = UnbalancedValue
{ cvType :: !BudgetTransferType
, cvValue :: !Rational