diff --git a/lib/Internal/Budget.hs b/lib/Internal/Budget.hs index 935bedb..088d533 100644 --- a/lib/Internal/Budget.hs +++ b/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 - n <- workingDays wds prev cur - return $ scale (fromIntegral n) +periodScaler pt prev cur = return scale 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 -workingDays wds start end - | interval > 0 = - 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 +-- ASSUME start < end +workingDays :: [Weekday] -> Day -> Day -> Natural +workingDays wds start end = fromIntegral $ daysFull + daysTail 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 = - combineErrors $ - snd $ - L.mapAccumL (\prevDay day -> (day, f prevDay day)) start days +foldDays f start days + -- TODO throw real error here + | any (start >) days = throwError undefined + | otherwise = + combineErrors $ + snd $ + L.mapAccumL (\prevDay day -> (day, f prevDay day)) start days checkAcntType :: (MonadInsertError m, MonadFinance m)