Improve handling on monthly/yearly scheduling.

Avoid back-to-back runs.

1 files changed, 37 insertions, 13 deletions

diff --git a/Utility/Scheduled.hs b/Utility/Scheduled.hs
index 4dfa4d04c..8ae1664f6 100644
--- a/Utility/Scheduled.hs
+++ b/Utility/Scheduled.hs
@@ -67,8 +67,8 @@ data ScheduledTime
 type Hour = Int
 type Minute = Int
 
-{- Next time a Schedule should take effect. The NextTimeWindow is used
- - when a Schedule is allowed to start at some point within the window. -}
+-- | Next time a Schedule should take effect. The NextTimeWindow is used
+-- when a Schedule is allowed to start at some point within the window.
 data NextTime
 	= NextTimeExactly LocalTime
 	| NextTimeWindow LocalTime LocalTime
@@ -84,8 +84,8 @@ nextTime schedule lasttime = do
 	tz <- getTimeZone now
 	return $ calcNextTime schedule lasttime $ utcToLocalTime tz now
 
-{- Calculate the next time that fits a Schedule, based on the
- - last time it occurred, and the current time. -}
+-- | Calculate the next time that fits a Schedule, based on the
+-- last time it occurred, and the current time.
 calcNextTime :: Schedule -> Maybe LocalTime -> LocalTime -> Maybe NextTime
 calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime
 	| scheduledtime == AnyTime = do
@@ -98,10 +98,10 @@ calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime
   	findfromtoday anytime = findfrom recurrance afterday today
 	  where
 	  	today = localDay currenttime
-		afterday = sameaslastday || toolatetoday
+		afterday = sameaslastrun || toolatetoday
 		toolatetoday = not anytime && localTimeOfDay currenttime >= nexttime
-		sameaslastday = lastday == Just today
-	lastday = localDay <$> lasttime
+		sameaslastrun = lastrun == Just today
+	lastrun = localDay <$> lasttime
 	nexttime = case scheduledtime of
 		AnyTime -> TimeOfDay 0 0 0
 		SpecificTime h m -> TimeOfDay h m 0
@@ -121,21 +121,19 @@ calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime
 			| otherwise -> Just $ exactly candidate
 		Weekly Nothing
 			| afterday -> skip 1
-			| otherwise -> case (wday <$> lastday, wday candidate) of
+			| otherwise -> case (wday <$> lastrun, wday candidate) of
 				(Nothing, _) -> Just $ window candidate (addDays 6 candidate)
 				(Just old, curr)
 					| old == curr -> Just $ window candidate (addDays 6 candidate)
 					| otherwise -> skip 1
 		Monthly Nothing
 			| afterday -> skip 1
-			-- any day in the month following lasttime
-			| maybe True (\old -> (mnum candidate > mnum old || ynum candidate > ynum old)) lastday ->
+			| maybe True (candidate `oneMonthPast`) lastrun ->
 				Just $ window candidate (endOfMonth candidate)
 			| otherwise -> skip 1
 		Yearly Nothing
 			| afterday -> skip 1
-			-- any day in the year following lasttime
-			| maybe True (\old -> ynum candidate > ynum old) lastday ->
+			| maybe True (candidate `oneYearPast`) lastrun ->
 				Just $ window candidate (endOfYear candidate)
 			| otherwise -> skip 1
 		Weekly (Just w)
@@ -177,6 +175,32 @@ calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime
 		getday = localDay . startTime
 	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 =
 	let (y,m,_d) = toGregorian day
@@ -201,7 +225,7 @@ yday = snd . toOrdinalDate
 ynum :: Day -> Int
 ynum = fromIntegral . fst . toOrdinalDate
 
-{- Calendar max values. -}
+-- Calendar max values.
 maxyday :: Int
 maxyday = 366 -- with leap days
 maxwnum :: Int