ENH check period date once

This commit is contained in:
Nathan Dwarshuis 2023-05-29 16:36:59 -04:00
parent ff0393dc02
commit 092d771f30
1 changed files with 17 additions and 19 deletions

View File

@ -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,7 +241,10 @@ foldDays
-> Day
-> [Day]
-> m [a]
foldDays f 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