diff --git a/src/Cron.hs b/src/Cron.hs index a17230f15..2620aec12 100644 --- a/src/Cron.hs +++ b/src/Cron.hs @@ -165,37 +165,66 @@ nextCronMatch :: TZ -- ^ Timezone of the `Cron`-Entry -> UTCTime -- ^ Current time, used only for `CronCalendar` -> Cron -> CronNextMatch UTCTime -nextCronMatch tz mPrev now c@Cron{..} - | isNothing mPrev - = execRef now False cronInitial - | Just prevT <- mPrev - = case cronRepeat of - CronRepeatOnChange - | not $ matchesCron tz Nothing prevT c - -> let - cutoffTime = addUTCTime cronRateLimit prevT - in case execRef now False cronInitial of - MatchAsap - | now < cutoffTime -> MatchAt cutoffTime - MatchAt ts - | ts < cutoffTime -> MatchAt cutoffTime - other -> other - CronRepeatScheduled cronNext - -> case cronNext of - CronAsap - | addUTCTime cronRateLimit prevT <= now - -> MatchAsap - | otherwise - -> MatchAt $ addUTCTime cronRateLimit prevT - cronNext - -> execRef (addUTCTime cronRateLimit prevT) True cronNext - _other -> MatchNone +nextCronMatch tz mPrev now c@Cron{..} = case notAfter of + MatchAsap -> MatchNone + MatchAt ts + | MatchAt ts' <- nextMatch + , ts' <= ts -> MatchAt ts' + | MatchAsap <- nextMatch + , now <= ts -> MatchAsap + | otherwise -> MatchNone + MatchNone -> nextMatch where - execRef ref wasExecd cronAbsolute = case cronAbsolute of - CronAsap -> MatchAsap + nextMatch = nextCronMatch' tz mPrev now c + notAfter + | Right c' <- cronNotAfter + , Just ref <- notAfterRef + = execRef' ref False c' + | Left diff <- cronNotAfter + , Just ref <- notAfterRef + = MatchAt $ diff `addUTCTime` ref + | otherwise = MatchNone + notAfterRef + | Just prevT <- mPrev = Just prevT + | otherwise = case execRef' now False cronInitial of + MatchAt t -> Just t + MatchNone -> Nothing + + nextCronMatch' tz mPrev now c@Cron{..} + | isNothing mPrev + = execRef now False cronInitial + | Just prevT <- mPrev + = case cronRepeat of + CronRepeatOnChange + | not $ matchesCron tz Nothing prevT c + -> let + cutoffTime = addUTCTime cronRateLimit prevT + in case execRef now False cronInitial of + MatchAsap + | now < cutoffTime -> MatchAt cutoffTime + MatchAt ts + | ts < cutoffTime -> MatchAt cutoffTime + other -> other + CronRepeatScheduled cronNext + -> case cronNext of + CronAsap + | addUTCTime cronRateLimit prevT <= now + -> MatchAsap + | otherwise + -> MatchAt $ addUTCTime cronRateLimit prevT + cronNext + -> execRef (addUTCTime cronRateLimit prevT) True cronNext + _other -> MatchNone + + execRef ref wasExecd cronAbsolute = case execRef' ref wasExecd cronAbsolute of + MatchAt t + | t <= ref -> MatchAsap + other -> other + + execRef' ref wasExecd cronAbsolute = case cronAbsolute of + CronAsap -> MatchAt ref CronTimestamp{ cronTimestamp = localTimeToUTCTZ tz -> ts } - | ref <= ts -> MatchAt ts - | not wasExecd -> MatchAsap + | ref <= ts || not wasExecd -> MatchAt ts | otherwise -> MatchNone CronCalendar{..} -> listToMatch $ do let CronDate{..} = toCronDate $ utcToLocalTimeTZ tz ref @@ -213,6 +242,7 @@ nextCronMatch tz mPrev now c@Cron{..} localDay <- maybeToList $ fromGregorianValid (fromIntegral cronYear) (fromIntegral cronMonth) (fromIntegral cronDayOfMonth) let localTimeOfDay = TimeOfDay (fromIntegral cronHour) (fromIntegral cronMinute) (fromIntegral cronSecond) return $ localTimeToUTCTZ tz LocalTime{..} + CronNotScheduled -> MatchNone matchesCron :: TZ -- ^ Timezone of the `Cron`-Entry -> Maybe UTCTime -- ^ Previous execution of the job diff --git a/src/Cron/Types.hs b/src/Cron/Types.hs index bb6753f73..fa95477f0 100644 --- a/src/Cron/Types.hs +++ b/src/Cron/Types.hs @@ -57,6 +57,7 @@ data Cron = Cron { cronInitial :: CronAbsolute , cronRepeat :: CronRepeat , cronRateLimit :: NominalDiffTime + , cronNotAfter :: Either NominalDiffTime CronAbsolute } deriving (Eq, Show) diff --git a/src/Jobs/Crontab.hs b/src/Jobs/Crontab.hs index 955c09ee4..f57952528 100644 --- a/src/Jobs/Crontab.hs +++ b/src/Jobs/Crontab.hs @@ -33,6 +33,7 @@ determineCrontab = execWriterT $ do { cronInitial = CronAsap , cronRepeat = CronRepeatScheduled CronAsap , cronRateLimit = interval + , cronNotAfter = Right CronNotScheduled } Nothing -> return () @@ -42,6 +43,7 @@ determineCrontab = execWriterT $ do { cronInitial = CronAsap , cronRepeat = CronRepeatScheduled CronAsap , cronRateLimit = appJobCronInterval + , cronNotAfter = Right CronNotScheduled } let @@ -52,6 +54,7 @@ determineCrontab = execWriterT $ do { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ sheetActiveFrom , cronRepeat = CronRepeatOnChange -- Allow repetition of the notification (if something changes), but wait at least an hour , cronRateLimit = appNotificationRateLimit + , cronNotAfter = Right . CronTimestamp $ utcToLocalTimeTZ appTZ sheetActiveTo } tell $ HashMap.singleton (JobCtlQueue $ JobQueueNotification NotificationSheetInactive{..}) @@ -59,5 +62,6 @@ determineCrontab = execWriterT $ do { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ . max sheetActiveFrom $ addUTCTime (-nominalDay) sheetActiveTo , cronRepeat = CronRepeatOnChange , cronRateLimit = appNotificationRateLimit + , cronNotAfter = Right . CronTimestamp $ utcToLocalTimeTZ appTZ sheetActiveTo } runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ sheetJobs