diff --git a/src/Cron.hs b/src/Cron.hs index 600eb873c..53a7a01b3 100644 --- a/src/Cron.hs +++ b/src/Cron.hs @@ -150,10 +150,11 @@ genMatch p m st (CronMatchUnion aGen bGen) = merge (genMatch p m st aGen) (genMa nextCronMatch :: TZ -- ^ Timezone of the `Cron`-Entry -> Maybe UTCTime -- ^ Time of last execution of the job + -> NominalDiffTime -- ^ Scheduling precision -> UTCTime -- ^ Current time, used only for `CronCalendar` -> Cron -> CronNextMatch UTCTime -nextCronMatch tz mPrev now c@Cron{..} = case notAfter of +nextCronMatch tz mPrev prec now c@Cron{..} = case notAfter of MatchAsap -> MatchNone MatchAt ts | MatchAt ts' <- nextMatch @@ -183,7 +184,7 @@ nextCronMatch tz mPrev now c@Cron{..} = case notAfter of Just prevT -> case cronRepeat of CronRepeatOnChange - | not $ matchesCron tz Nothing prevT c + | not $ matchesCron tz Nothing prec prevT c -> let cutoffTime = addUTCTime cronRateLimit prevT in case execRef now False cronInitial of @@ -240,13 +241,14 @@ nextCronMatch tz mPrev now c@Cron{..} = case notAfter of matchesCron :: TZ -- ^ Timezone of the `Cron`-Entry -> Maybe UTCTime -- ^ Previous execution of the job + -> NominalDiffTime -- ^ Scheduling precision -> UTCTime -- ^ "Current" time -> Cron -> Bool -- ^ @matchesCron tz prev prec now c@ determines whether the given `Cron` -- specification @c@ should match @now@, under the assumption that the next -- check will occur no earlier than @now + prec@. -matchesCron tz mPrev now cron = case nextCronMatch tz mPrev now cron of +matchesCron tz mPrev prec now cron = case nextCronMatch tz mPrev prec now cron of MatchAsap -> True MatchNone -> False - MatchAt ts -> ts <= now + MatchAt ts -> ts <= addUTCTime prec now diff --git a/src/Jobs.hs b/src/Jobs.hs index 50bb56e5d..45a5f74f6 100644 --- a/src/Jobs.hs +++ b/src/Jobs.hs @@ -207,7 +207,7 @@ execCrontab = evalStateT go HashMap.empty | otherwise = Just (jobCtl, t) where - t = nextCronMatch appTZ (getMax <$> HashMap.lookup jobCtl lastTimes) now cron + t = nextCronMatch appTZ (getMax <$> HashMap.lookup jobCtl lastTimes) acc now cron waitUntil :: (Eq a, MonadResourceBase m, MonadLogger m) => TMVar a -> a -> UTCTime -> m Bool waitUntil crontabTV crontab nextTime = runResourceT $ do