ENH check all income accounts

lib/Internal/Budget.hs

@@ -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
+    combineErrorM
-    _ <- checkAcntType IncomeT $ taAcnt incFrom
+      (combineError incRes nonIncRes (,))
-    precision <- lookupCurrencyPrec incCurrency
+      (combineError precRes dayRes (,))
+      $ \_ (precision, days) -> do
         let gross = roundPrecision precision incGross
-    -- TODO this will scan the interval allocations fully each time
+        concat <$> foldDays (allocate precision gross) start days
-    -- 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
     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
+  -> m ()
-checkAcntTypes ts i = go =<< lookupAccountType i
+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