ENH check period date once
This commit is contained in:
parent
ff0393dc02
commit
092d771f30
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue