Improve handling on monthly/yearly scheduling.
Avoid back-to-back runs.
This commit is contained in:
parent
d955cfe78a
commit
b815988d16
1 changed files with 37 additions and 13 deletions
|
@ -67,8 +67,8 @@ data ScheduledTime
|
||||||
type Hour = Int
|
type Hour = Int
|
||||||
type Minute = Int
|
type Minute = Int
|
||||||
|
|
||||||
{- Next time a Schedule should take effect. The NextTimeWindow is used
|
-- | Next time a Schedule should take effect. The NextTimeWindow is used
|
||||||
- when a Schedule is allowed to start at some point within the window. -}
|
-- when a Schedule is allowed to start at some point within the window.
|
||||||
data NextTime
|
data NextTime
|
||||||
= NextTimeExactly LocalTime
|
= NextTimeExactly LocalTime
|
||||||
| NextTimeWindow LocalTime LocalTime
|
| NextTimeWindow LocalTime LocalTime
|
||||||
|
@ -84,8 +84,8 @@ nextTime schedule lasttime = do
|
||||||
tz <- getTimeZone now
|
tz <- getTimeZone now
|
||||||
return $ calcNextTime schedule lasttime $ utcToLocalTime tz now
|
return $ calcNextTime schedule lasttime $ utcToLocalTime tz now
|
||||||
|
|
||||||
{- Calculate the next time that fits a Schedule, based on the
|
-- | Calculate the next time that fits a Schedule, based on the
|
||||||
- last time it occurred, and the current time. -}
|
-- last time it occurred, and the current time.
|
||||||
calcNextTime :: Schedule -> Maybe LocalTime -> LocalTime -> Maybe NextTime
|
calcNextTime :: Schedule -> Maybe LocalTime -> LocalTime -> Maybe NextTime
|
||||||
calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime
|
calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime
|
||||||
| scheduledtime == AnyTime = do
|
| scheduledtime == AnyTime = do
|
||||||
|
@ -98,10 +98,10 @@ calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime
|
||||||
findfromtoday anytime = findfrom recurrance afterday today
|
findfromtoday anytime = findfrom recurrance afterday today
|
||||||
where
|
where
|
||||||
today = localDay currenttime
|
today = localDay currenttime
|
||||||
afterday = sameaslastday || toolatetoday
|
afterday = sameaslastrun || toolatetoday
|
||||||
toolatetoday = not anytime && localTimeOfDay currenttime >= nexttime
|
toolatetoday = not anytime && localTimeOfDay currenttime >= nexttime
|
||||||
sameaslastday = lastday == Just today
|
sameaslastrun = lastrun == Just today
|
||||||
lastday = localDay <$> lasttime
|
lastrun = localDay <$> lasttime
|
||||||
nexttime = case scheduledtime of
|
nexttime = case scheduledtime of
|
||||||
AnyTime -> TimeOfDay 0 0 0
|
AnyTime -> TimeOfDay 0 0 0
|
||||||
SpecificTime h m -> TimeOfDay h m 0
|
SpecificTime h m -> TimeOfDay h m 0
|
||||||
|
@ -121,21 +121,19 @@ calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime
|
||||||
| otherwise -> Just $ exactly candidate
|
| otherwise -> Just $ exactly candidate
|
||||||
Weekly Nothing
|
Weekly Nothing
|
||||||
| afterday -> skip 1
|
| afterday -> skip 1
|
||||||
| otherwise -> case (wday <$> lastday, wday candidate) of
|
| otherwise -> case (wday <$> lastrun, wday candidate) of
|
||||||
(Nothing, _) -> Just $ window candidate (addDays 6 candidate)
|
(Nothing, _) -> Just $ window candidate (addDays 6 candidate)
|
||||||
(Just old, curr)
|
(Just old, curr)
|
||||||
| old == curr -> Just $ window candidate (addDays 6 candidate)
|
| old == curr -> Just $ window candidate (addDays 6 candidate)
|
||||||
| otherwise -> skip 1
|
| otherwise -> skip 1
|
||||||
Monthly Nothing
|
Monthly Nothing
|
||||||
| afterday -> skip 1
|
| afterday -> skip 1
|
||||||
-- any day in the month following lasttime
|
| maybe True (candidate `oneMonthPast`) lastrun ->
|
||||||
| maybe True (\old -> (mnum candidate > mnum old || ynum candidate > ynum old)) lastday ->
|
|
||||||
Just $ window candidate (endOfMonth candidate)
|
Just $ window candidate (endOfMonth candidate)
|
||||||
| otherwise -> skip 1
|
| otherwise -> skip 1
|
||||||
Yearly Nothing
|
Yearly Nothing
|
||||||
| afterday -> skip 1
|
| afterday -> skip 1
|
||||||
-- any day in the year following lasttime
|
| maybe True (candidate `oneYearPast`) lastrun ->
|
||||||
| maybe True (\old -> ynum candidate > ynum old) lastday ->
|
|
||||||
Just $ window candidate (endOfYear candidate)
|
Just $ window candidate (endOfYear candidate)
|
||||||
| otherwise -> skip 1
|
| otherwise -> skip 1
|
||||||
Weekly (Just w)
|
Weekly (Just w)
|
||||||
|
@ -177,6 +175,32 @@ calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime
|
||||||
getday = localDay . startTime
|
getday = localDay . startTime
|
||||||
divisible n v = v `rem` n == 0
|
divisible n v = v `rem` n == 0
|
||||||
|
|
||||||
|
-- Check if the new Day occurs one month or more past the old Day.
|
||||||
|
oneMonthPast :: Day -> Day -> Bool
|
||||||
|
new `oneMonthPast` old
|
||||||
|
| mday new >= mday old && (new `newerMonth` old || new `newerYear` old) = True
|
||||||
|
| new `skippedAMonth` old || new `skippedAYear` old = True
|
||||||
|
| otherwise = False
|
||||||
|
|
||||||
|
-- Check if the new Day occurs one year or more past the old Day.
|
||||||
|
oneYearPast :: Day -> Day -> Bool
|
||||||
|
new `oneYearPast` old
|
||||||
|
| yday new >= yday old && new `newerYear` old = True
|
||||||
|
| new `skippedAYear` old = True
|
||||||
|
| otherwise = False
|
||||||
|
|
||||||
|
newerMonth :: Day -> Day -> Bool
|
||||||
|
new `newerMonth` old = mnum new > mnum old
|
||||||
|
|
||||||
|
newerYear :: Day -> Day -> Bool
|
||||||
|
new `newerYear` old = ynum new > ynum old
|
||||||
|
|
||||||
|
skippedAMonth :: Day -> Day -> Bool
|
||||||
|
new `skippedAMonth` old = mnum new > mnum old + 1
|
||||||
|
|
||||||
|
skippedAYear :: Day -> Day -> Bool
|
||||||
|
new `skippedAYear` old = ynum new > ynum old + 1
|
||||||
|
|
||||||
endOfMonth :: Day -> Day
|
endOfMonth :: Day -> Day
|
||||||
endOfMonth day =
|
endOfMonth day =
|
||||||
let (y,m,_d) = toGregorian day
|
let (y,m,_d) = toGregorian day
|
||||||
|
@ -201,7 +225,7 @@ yday = snd . toOrdinalDate
|
||||||
ynum :: Day -> Int
|
ynum :: Day -> Int
|
||||||
ynum = fromIntegral . fst . toOrdinalDate
|
ynum = fromIntegral . fst . toOrdinalDate
|
||||||
|
|
||||||
{- Calendar max values. -}
|
-- Calendar max values.
|
||||||
maxyday :: Int
|
maxyday :: Int
|
||||||
maxyday = 366 -- with leap days
|
maxyday = 366 -- with leap days
|
||||||
maxwnum :: Int
|
maxwnum :: Int
|
||||||
|
|
Loading…
Add table
Reference in a new issue