ENH check period date once

lib/Internal/Budget.hs

@@ -20,7 +20,7 @@ import RIO.Time
 -- 3. propagate all balances forward, and while doing so assign values to each
 --    transaction (some of which depend on the 'current' balance of the
 --    target account)
--- 4. assign shadow transactions (TODO)
+-- 4. assign shadow transactions
 -- 5. insert all transactions
 
 insertBudget
@@ -203,20 +203,18 @@ insertIncome
               then throwError $ InsertException [IncomeError day name balance]
               else return (bal : fmap (allo2Trans meta day incFrom) (pre ++ tax ++ post))
 
--- TODO we probably don't need to check for 1/0 each time
 periodScaler
   :: PeriodType
   -> Day
   -> Day
   -> InsertExcept PeriodScaler
-periodScaler pt prev cur = do
+periodScaler pt prev cur = return scale
-  n <- workingDays wds prev cur
-  return $ scale (fromIntegral n)
   where
+    n = fromIntegral $ workingDays wds prev cur
     wds = case pt of
       Hourly HourlyPeriod {hpWorkingDays} -> hpWorkingDays
       Daily ds -> ds
-    scale n precision x = case pt of
+    scale precision x = case pt of
       Hourly HourlyPeriod {hpAnnualHours, hpDailyHours} ->
         fromRational (rnd $ x / fromIntegral hpAnnualHours)
           * fromIntegral hpDailyHours
@@ -225,17 +223,14 @@ periodScaler pt prev cur = do
       where
         rnd = roundPrecision precision
 
-workingDays :: [Weekday] -> Day -> Day -> InsertExcept Natural
+-- ASSUME start < end
-workingDays wds start end
+workingDays :: [Weekday] -> Day -> Day -> Natural
-  | interval > 0 =
+workingDays wds start end = fromIntegral $ daysFull + daysTail
-      let (nFull, nPart) = divMod interval 7
-          daysFull = fromIntegral (length wds') * nFull
-          daysTail = fromIntegral $ length $ takeWhile (< nPart) wds'
-       in return $ fromIntegral $ daysFull + daysTail
-  -- TODO make an error here that says something to the effect of "Period must be positive"
-  | otherwise = throwError $ InsertException undefined
   where
     interval = diffDays end start
+    (nFull, nPart) = divMod interval 7
+    daysFull = fromIntegral (length wds') * nFull
+    daysTail = fromIntegral $ length $ takeWhile (< nPart) wds'
     startDay = dayOfWeek start
     wds' = L.sort $ (\x -> diff (fromWeekday x) startDay) <$> L.nub wds
     diff a b = fromIntegral $ mod (fromEnum a - fromEnum b) 7
@@ -246,10 +241,13 @@ foldDays
   -> Day
   -> [Day]
   -> m [a]
-foldDays f start days =
+foldDays f start days
-  combineErrors $
+  -- TODO throw real error here
-    snd $
+  | any (start >) days = throwError undefined
-      L.mapAccumL (\prevDay day -> (day, f prevDay day)) start days
+  | otherwise =
+      combineErrors $
+        snd $
+          L.mapAccumL (\prevDay day -> (day, f prevDay day)) start days
 
 checkAcntType
   :: (MonadInsertError m, MonadFinance m)