fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix modular behaviour of cron

Browse Source
This commit is contained in:
Gregor Kleen 2018-10-10 13:18:33 +02:00
parent 62bfc47d8c
commit ee08b641bb
1 changed files with 32 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
src/Cron.hs
View File

@ -117,40 +117,41 @@ listToMatch :: [a] -> CronNextMatch a
listToMatch [] = MatchNone
listToMatch (t:_) = MatchAt t
genMatch :: Int -- ^ Period
genMatch :: Int -- ^ Period
-> Bool -- ^ Modular
-> Natural -- ^ Start value
-> CronMatch
-> [Natural]
genMatch p st CronMatchAny = take p [st..]
genMatch _ _ CronMatchNone = []
genMatch p _ (CronMatchSome set) = take p . Set.toAscList $ toNullable set
genMatch p st (CronMatchStep step) = do
genMatch p m st CronMatchAny = take p $ map (bool id (succ . (`mod` fromIntegral p)) m) [st..]
genMatch _ _ _ CronMatchNone = []
genMatch p m _ (CronMatchSome set) = take p . map (bool id (succ . (`mod` fromIntegral p)) m) . Set.toAscList $ toNullable set
genMatch p m st (CronMatchStep step) = do
start <- [st..st + step]
guard $ (start `mod` step) == 0
take (ceiling $ fromIntegral p % step) [start,start + step..]
genMatch p st (CronMatchContiguous from to) = take p $ [max st from..to]
genMatch _ _ (CronMatchIntersect CronMatchNone _) = []
genMatch _ _ (CronMatchIntersect _ CronMatchNone) = []
genMatch p st (CronMatchIntersect CronMatchAny other) = genMatch p st other
genMatch p st (CronMatchIntersect other CronMatchAny) = genMatch p st other
genMatch p st (CronMatchIntersect (CronMatchStep st1) (CronMatchStep st2))
= genMatch p st . CronMatchStep $ lcm st1 st2
genMatch p st (CronMatchIntersect aGen bGen)
take (ceiling $ fromIntegral p % step) $ map (bool id (succ . (`mod` fromIntegral p)) m) [start,start + step..]
genMatch p m st (CronMatchContiguous from to) = take p . map (bool id (succ . (`mod` fromIntegral p)) m) $ [max st from..to]
genMatch _ _ _ (CronMatchIntersect CronMatchNone _) = []
genMatch _ _ _ (CronMatchIntersect _ CronMatchNone) = []
genMatch p m st (CronMatchIntersect CronMatchAny other) = genMatch p m st other
genMatch p m st (CronMatchIntersect other CronMatchAny) = genMatch p m st other
genMatch p m st (CronMatchIntersect (CronMatchStep st1) (CronMatchStep st2))
= genMatch p m st . CronMatchStep $ lcm st1 st2
genMatch p m st (CronMatchIntersect aGen bGen)
| [] <- as' = []
| (a:as) <- as' = mergeAnd (a:as) (genMatch p a bGen)
| (a:as) <- as' = mergeAnd (a:as) (genMatch p m a bGen)
where
as' = genMatch p st aGen
as' = genMatch p m st aGen
mergeAnd [] _ = []
mergeAnd _ [] = []
mergeAnd (a:as) (b:bs)
| a < b = mergeAnd as (b:bs)
| a == b = a : mergeAnd as bs
| a > b = mergeAnd (a:as) bs
genMatch p st (CronMatchUnion CronMatchNone other) = genMatch p st other
genMatch p st (CronMatchUnion other CronMatchNone) = genMatch p st other
genMatch p st (CronMatchUnion CronMatchAny _) = genMatch p st CronMatchAny
genMatch p st (CronMatchUnion _ CronMatchAny) = genMatch p st CronMatchAny
genMatch p st (CronMatchUnion aGen bGen) = merge (genMatch p st aGen) (genMatch p st bGen)
genMatch p m st (CronMatchUnion CronMatchNone other) = genMatch p m st other
genMatch p m st (CronMatchUnion other CronMatchNone) = genMatch p m st other
genMatch p m st (CronMatchUnion CronMatchAny _) = genMatch p m st CronMatchAny
genMatch p m st (CronMatchUnion _ CronMatchAny) = genMatch p m st CronMatchAny
genMatch p m st (CronMatchUnion aGen bGen) = merge (genMatch p m st aGen) (genMatch p m st bGen)
where
merge [] bs = bs
merge as [] = as
@ -188,16 +189,16 @@ nextCronMatch tz mPrev now c@Cron{..}
| otherwise -> MatchNone
CronCalendar{..} -> listToMatch $ do
let CronDate{..} = toCronDate $ utcToLocalTimeTZ tz ref
cronYear <- genMatch 400 cdYear cronYear
cronWeekOfYear <- genMatch 53 cdWeekOfYear cronWeekOfYear
cronDayOfYear <- genMatch 366 cdDayOfYear cronDayOfYear
cronMonth <- genMatch 12 cdMonth cronMonth
cronWeekOfMonth <- genMatch 5 cdWeekOfMonth cronWeekOfMonth
cronDayOfMonth <- genMatch 31 cdDayOfMonth cronDayOfMonth
cronDayOfWeek <- genMatch 7 cdDayOfWeek cronDayOfWeek
cronHour <- genMatch 24 cdHour cronHour
cronMinute <- genMatch 60 cdMinute cronMinute
cronSecond <- genMatch 60 cdSecond cronSecond
cronYear <- genMatch 400 False cdYear cronYear
cronWeekOfYear <- genMatch 53 True cdWeekOfYear cronWeekOfYear
cronDayOfYear <- genMatch 366 True cdDayOfYear cronDayOfYear
cronMonth <- genMatch 12 True cdMonth cronMonth
cronWeekOfMonth <- genMatch 5 True cdWeekOfMonth cronWeekOfMonth
cronDayOfMonth <- genMatch 31 True cdDayOfMonth cronDayOfMonth
cronDayOfWeek <- genMatch 7 True cdDayOfWeek cronDayOfWeek
cronHour <- genMatch 24 True cdHour cronHour
cronMinute <- genMatch 60 True cdMinute cronMinute
cronSecond <- genMatch 60 True cdSecond cronSecond
guard $ consistentCronDate CronDate{..}
localDay <- maybeToList $ fromGregorianValid (fromIntegral cronYear) (fromIntegral cronMonth) (fromIntegral cronDayOfMonth)
let localTimeOfDay = TimeOfDay (fromIntegral cronHour) (fromIntegral cronMinute) (fromIntegral cronSecond)