FIX actually throw error when folding periods/days
This commit is contained in:
parent
092d771f30
commit
1555e9071f
|
@ -1,6 +1,7 @@
|
|||
module Internal.Budget (insertBudget) where
|
||||
|
||||
import Control.Monad.Except
|
||||
import Data.Foldable
|
||||
import Database.Persist.Monad
|
||||
import Internal.Database.Ops
|
||||
import Internal.Types.Main
|
||||
|
@ -235,16 +236,20 @@ workingDays wds start end = fromIntegral $ daysFull + daysTail
|
|||
wds' = L.sort $ (\x -> diff (fromWeekday x) startDay) <$> L.nub wds
|
||||
diff a b = fromIntegral $ mod (fromEnum a - fromEnum b) 7
|
||||
|
||||
-- ASSUME days is a sorted list
|
||||
foldDays
|
||||
:: MonadInsertError m
|
||||
=> (Day -> Day -> m a)
|
||||
-> Day
|
||||
-> [Day]
|
||||
-> m [a]
|
||||
foldDays f start days
|
||||
-- TODO throw real error here
|
||||
| any (start >) days = throwError undefined
|
||||
| otherwise =
|
||||
foldDays f start days = case NE.nonEmpty days of
|
||||
Nothing -> return []
|
||||
Just ds
|
||||
| any (start >) ds ->
|
||||
throwError $
|
||||
InsertException [PeriodError start $ minimum ds]
|
||||
| otherwise ->
|
||||
combineErrors $
|
||||
snd $
|
||||
L.mapAccumL (\prevDay day -> (day, f prevDay day)) start days
|
||||
|
|
Loading…
Reference in New Issue