{-# LANGUAGE OverloadedStrings #-}

-- | Cron declarations, validation, and timezone calculations.
module Arbiter.Worker.Cron.Types
  ( CronJob (..)
  , OverlapPolicy (..)
  , BackfillPolicy (..)
  , TickKind (..)
  , cronJob
  , cronJobInTimezone
  , overlapPolicyToText
  , overlapPolicyFromText
  , validateCronScheduleUpdate
  , updateCronScheduleChecked
  , resolveTZ
  , matchesInTimezone
  , nextRunInTimezone
  , nextRunFromExpression
  , truncateToMinute
  , formatMinute
  , enumMinutes
  , oneMinute
  ) where

import Arbiter.Core.CronSchedule qualified as CS
import Arbiter.Core.HighLevel qualified as HL
import Arbiter.Core.Job.Types (JobWrite)
import Arbiter.Core.MonadArbiter (MonadArbiter)
import Control.Applicative ((<|>))
import Control.Monad (join, unless)
import Data.Either (isRight)
import Data.Int (Int64)
import Data.List (find, unfoldr)
import Data.Maybe (isJust)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding (encodeUtf8)
import Data.Time
  ( LocalTime
  , NominalDiffTime
  , UTCTime (..)
  , addUTCTime
  , defaultTimeLocale
  , formatTime
  , localTimeToUTC
  , secondsToDiffTime
  , utc
  , utcToLocalTime
  )
import Data.Time.Zones (LocalToUTCResult (..), TZ, localTimeToUTCFull, utcToLocalTimeTZ)
import Data.Time.Zones.All (fromTZName, tzByLabel)
import GHC.Generics (Generic)
import System.Cron (CronSchedule, nextMatch, parseCronSchedule, scheduleMatches)
import System.Cron.Types qualified as Cron

-- | Cron tick overlap policy.
data OverlapPolicy
  = -- | At most one pending or running job per schedule.
    SkipOverlap
  | -- | One job per tick. Concurrent execution of prior ticks is allowed.
    AllowOverlap
  deriving stock (OverlapPolicy -> OverlapPolicy -> Bool
(OverlapPolicy -> OverlapPolicy -> Bool)
-> (OverlapPolicy -> OverlapPolicy -> Bool) -> Eq OverlapPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OverlapPolicy -> OverlapPolicy -> Bool
== :: OverlapPolicy -> OverlapPolicy -> Bool
$c/= :: OverlapPolicy -> OverlapPolicy -> Bool
/= :: OverlapPolicy -> OverlapPolicy -> Bool
Eq, (forall x. OverlapPolicy -> Rep OverlapPolicy x)
-> (forall x. Rep OverlapPolicy x -> OverlapPolicy)
-> Generic OverlapPolicy
forall x. Rep OverlapPolicy x -> OverlapPolicy
forall x. OverlapPolicy -> Rep OverlapPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OverlapPolicy -> Rep OverlapPolicy x
from :: forall x. OverlapPolicy -> Rep OverlapPolicy x
$cto :: forall x. Rep OverlapPolicy x -> OverlapPolicy
to :: forall x. Rep OverlapPolicy x -> OverlapPolicy
Generic, Int -> OverlapPolicy -> ShowS
[OverlapPolicy] -> ShowS
OverlapPolicy -> String
(Int -> OverlapPolicy -> ShowS)
-> (OverlapPolicy -> String)
-> ([OverlapPolicy] -> ShowS)
-> Show OverlapPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OverlapPolicy -> ShowS
showsPrec :: Int -> OverlapPolicy -> ShowS
$cshow :: OverlapPolicy -> String
show :: OverlapPolicy -> String
$cshowList :: [OverlapPolicy] -> ShowS
showList :: [OverlapPolicy] -> ShowS
Show)

-- | Bound on replay of missed ticks. Applies at startup and mid-flight.
data BackfillPolicy
  = -- | Drop missed minutes silently. Default.
    NoBackfill
  | -- | Replay minutes missed in the last given number of seconds. A 'SkipOverlap'
    -- schedule replays only the earliest one.
    Backfill NominalDiffTime
  deriving stock (BackfillPolicy -> BackfillPolicy -> Bool
(BackfillPolicy -> BackfillPolicy -> Bool)
-> (BackfillPolicy -> BackfillPolicy -> Bool) -> Eq BackfillPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BackfillPolicy -> BackfillPolicy -> Bool
== :: BackfillPolicy -> BackfillPolicy -> Bool
$c/= :: BackfillPolicy -> BackfillPolicy -> Bool
/= :: BackfillPolicy -> BackfillPolicy -> Bool
Eq, (forall x. BackfillPolicy -> Rep BackfillPolicy x)
-> (forall x. Rep BackfillPolicy x -> BackfillPolicy)
-> Generic BackfillPolicy
forall x. Rep BackfillPolicy x -> BackfillPolicy
forall x. BackfillPolicy -> Rep BackfillPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BackfillPolicy -> Rep BackfillPolicy x
from :: forall x. BackfillPolicy -> Rep BackfillPolicy x
$cto :: forall x. Rep BackfillPolicy x -> BackfillPolicy
to :: forall x. Rep BackfillPolicy x -> BackfillPolicy
Generic, Int -> BackfillPolicy -> ShowS
[BackfillPolicy] -> ShowS
BackfillPolicy -> String
(Int -> BackfillPolicy -> ShowS)
-> (BackfillPolicy -> String)
-> ([BackfillPolicy] -> ShowS)
-> Show BackfillPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BackfillPolicy -> ShowS
showsPrec :: Int -> BackfillPolicy -> ShowS
$cshow :: BackfillPolicy -> String
show :: BackfillPolicy -> String
$cshowList :: [BackfillPolicy] -> ShowS
showList :: [BackfillPolicy] -> ShowS
Show)

-- | Whether a tick is for the current minute or a replay of a past minute.
data TickKind
  = -- | The current scheduler minute.
    Live
  | -- | A past minute, replayed at startup or in mid-flight catch-up.
    Replay
  deriving stock (TickKind -> TickKind -> Bool
(TickKind -> TickKind -> Bool)
-> (TickKind -> TickKind -> Bool) -> Eq TickKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TickKind -> TickKind -> Bool
== :: TickKind -> TickKind -> Bool
$c/= :: TickKind -> TickKind -> Bool
/= :: TickKind -> TickKind -> Bool
Eq, (forall x. TickKind -> Rep TickKind x)
-> (forall x. Rep TickKind x -> TickKind) -> Generic TickKind
forall x. Rep TickKind x -> TickKind
forall x. TickKind -> Rep TickKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TickKind -> Rep TickKind x
from :: forall x. TickKind -> Rep TickKind x
$cto :: forall x. Rep TickKind x -> TickKind
to :: forall x. Rep TickKind x -> TickKind
Generic, Int -> TickKind -> ShowS
[TickKind] -> ShowS
TickKind -> String
(Int -> TickKind -> ShowS)
-> (TickKind -> String) -> ([TickKind] -> ShowS) -> Show TickKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TickKind -> ShowS
showsPrec :: Int -> TickKind -> ShowS
$cshow :: TickKind -> String
show :: TickKind -> String
$cshowList :: [TickKind] -> ShowS
showList :: [TickKind] -> ShowS
Show)

-- | Convert an 'OverlapPolicy' to its text representation.
overlapPolicyToText :: OverlapPolicy -> Text
overlapPolicyToText :: OverlapPolicy -> Text
overlapPolicyToText OverlapPolicy
SkipOverlap = Text
"SkipOverlap"
overlapPolicyToText OverlapPolicy
AllowOverlap = Text
"AllowOverlap"

-- | Parse an 'OverlapPolicy' from text.
overlapPolicyFromText :: Text -> Maybe OverlapPolicy
overlapPolicyFromText :: Text -> Maybe OverlapPolicy
overlapPolicyFromText Text
"SkipOverlap" = OverlapPolicy -> Maybe OverlapPolicy
forall a. a -> Maybe a
Just OverlapPolicy
SkipOverlap
overlapPolicyFromText Text
"AllowOverlap" = OverlapPolicy -> Maybe OverlapPolicy
forall a. a -> Maybe a
Just OverlapPolicy
AllowOverlap
overlapPolicyFromText Text
_ = Maybe OverlapPolicy
forall a. Maybe a
Nothing

-- | Check a cron patch before it is written. At tick time a bad override stops
-- firing or falls back to the default.
validateCronScheduleUpdate :: CS.CronScheduleUpdate -> Either Text ()
validateCronScheduleUpdate :: CronScheduleUpdate -> Either Text ()
validateCronScheduleUpdate
  CS.CronScheduleUpdate {overrideExpression :: CronScheduleUpdate -> Maybe (Maybe Text)
CS.overrideExpression = Maybe (Maybe Text)
mExpr, overrideOverlap :: CronScheduleUpdate -> Maybe (Maybe Text)
CS.overrideOverlap = Maybe (Maybe Text)
mOverlap, overrideTimezone :: CronScheduleUpdate -> Maybe (Maybe Text)
CS.overrideTimezone = Maybe (Maybe Text)
mTz} = do
    Maybe (Maybe Text) -> (Text -> Bool) -> Text -> Either Text ()
forall {t :: * -> *} {a} {a}.
(Foldable t, Monad t) =>
t (t a) -> (a -> Bool) -> a -> Either a ()
check Maybe (Maybe Text)
mExpr (Either String CronSchedule -> Bool
forall a b. Either a b -> Bool
isRight (Either String CronSchedule -> Bool)
-> (Text -> Either String CronSchedule) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String CronSchedule
parseCronSchedule) Text
"Invalid cron expression"
    Maybe (Maybe Text) -> (Text -> Bool) -> Text -> Either Text ()
forall {t :: * -> *} {a} {a}.
(Foldable t, Monad t) =>
t (t a) -> (a -> Bool) -> a -> Either a ()
check Maybe (Maybe Text)
mOverlap (Maybe OverlapPolicy -> Bool
forall a. Maybe a -> Bool
isJust (Maybe OverlapPolicy -> Bool)
-> (Text -> Maybe OverlapPolicy) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe OverlapPolicy
overlapPolicyFromText) Text
"Invalid overlap policy: must be SkipOverlap or AllowOverlap"
    Maybe (Maybe Text) -> (Text -> Bool) -> Text -> Either Text ()
forall {t :: * -> *} {a} {a}.
(Foldable t, Monad t) =>
t (t a) -> (a -> Bool) -> a -> Either a ()
check Maybe (Maybe Text)
mTz (Maybe TZ -> Bool
forall a. Maybe a -> Bool
isJust (Maybe TZ -> Bool) -> (Text -> Maybe TZ) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe TZ
resolveTZ) Text
"Invalid timezone: must be an IANA tz name (e.g. America/New_York)"
    where
      check :: t (t a) -> (a -> Bool) -> a -> Either a ()
check t (t a)
field a -> Bool
ok a
message = Bool -> Either a () -> Either a ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((a -> Bool) -> t a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all a -> Bool
ok (t (t a) -> t a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join t (t a)
field)) (a -> Either a ()
forall a b. a -> Either a b
Left a
message)

-- | 'Arbiter.Core.HighLevel.updateCronScheduleUnchecked' behind
-- 'validateCronScheduleUpdate'. Returns rows affected, 0 for an unknown name or an
-- empty patch.
updateCronScheduleChecked
  :: (MonadArbiter m)
  => Text
  -> CS.CronScheduleUpdate
  -> m (Either Text Int64)
updateCronScheduleChecked :: forall (m :: * -> *).
MonadArbiter m =>
Text -> CronScheduleUpdate -> m (Either Text Int64)
updateCronScheduleChecked Text
scheduleName CronScheduleUpdate
upd =
  (() -> m Int64) -> Either Text () -> m (Either Text Int64)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either Text a -> f (Either Text b)
traverse (m Int64 -> () -> m Int64
forall a b. a -> b -> a
const (Text -> CronScheduleUpdate -> m Int64
forall (m :: * -> *).
MonadArbiter m =>
Text -> CronScheduleUpdate -> m Int64
HL.updateCronScheduleUnchecked Text
scheduleName CronScheduleUpdate
upd)) (CronScheduleUpdate -> Either Text ()
validateCronScheduleUpdate CronScheduleUpdate
upd)

-- | A cron schedule. Built with 'cronJob', or 'cronJobInTimezone' for a non-UTC one.
data CronJob payload = CronJob
  { forall payload. CronJob payload -> Text
name :: Text
  -- ^ Name for logs and dedup keys.
  , forall payload. CronJob payload -> Text
cronExpression :: Text
  -- ^ The cron expression the schedule row stores.
  , forall payload. CronJob payload -> OverlapPolicy
overlap :: OverlapPolicy
  -- ^ How to handle overlapping ticks.
  , forall payload. CronJob payload -> BackfillPolicy
backfill :: BackfillPolicy
  -- ^ How to replay missed ticks, at startup and mid-flight. Default: 'NoBackfill'.
  , forall payload. CronJob payload -> Maybe Text
timezone :: Maybe Text
  -- ^ IANA tz name (e.g. @\"America\/New_York\"@). 'Nothing' means UTC.
  -- The @override_timezone@ DB column wins if set.
  , forall payload. CronJob payload -> Bool
initiallyEnabled :: Bool
  -- ^ Default: 'True'. 'False' registers the schedule disabled.
  , forall payload.
CronJob payload -> TickKind -> UTCTime -> JobWrite payload
builder :: TickKind -> UTCTime -> JobWrite payload
  -- ^ Build a job for the given tick time and 'TickKind'.
  }
  deriving stock ((forall x. CronJob payload -> Rep (CronJob payload) x)
-> (forall x. Rep (CronJob payload) x -> CronJob payload)
-> Generic (CronJob payload)
forall x. Rep (CronJob payload) x -> CronJob payload
forall x. CronJob payload -> Rep (CronJob payload) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall payload x. Rep (CronJob payload) x -> CronJob payload
forall payload x. CronJob payload -> Rep (CronJob payload) x
$cfrom :: forall payload x. CronJob payload -> Rep (CronJob payload) x
from :: forall x. CronJob payload -> Rep (CronJob payload) x
$cto :: forall payload x. Rep (CronJob payload) x -> CronJob payload
to :: forall x. Rep (CronJob payload) x -> CronJob payload
Generic)

-- | Build a 'CronJob' evaluated in UTC. A bad expression returns @Left@.
-- 'cronJobInTimezone' is the local-time form. Set 'backfill' and 'initiallyEnabled' by
-- record update.
--
-- @
-- cronJob "nightly-report" "0 3 * * *" SkipOverlap
--   (\\_kind _tick -> defaultJob (GenerateReport "nightly"))
-- @
cronJob
  :: Text
  -- ^ Schedule name (used in dedup keys and logging)
  -> Text
  -- ^ Cron expression (5-field: minute hour day-of-month month day-of-week)
  -> OverlapPolicy
  -- ^ Overlap policy
  -> (TickKind -> UTCTime -> JobWrite payload)
  -- ^ Job builder. Receives the tick kind and the tick time.
  -> Either String (CronJob payload)
cronJob :: forall payload.
Text
-> Text
-> OverlapPolicy
-> (TickKind -> UTCTime -> JobWrite payload)
-> Either String (CronJob payload)
cronJob Text
cronName Text
expr OverlapPolicy
overlapPolicy TickKind -> UTCTime -> JobWrite payload
build =
  CronJob
    { name :: Text
name = Text
cronName
    , cronExpression :: Text
cronExpression = Text
expr
    , overlap :: OverlapPolicy
overlap = OverlapPolicy
overlapPolicy
    , backfill :: BackfillPolicy
backfill = BackfillPolicy
NoBackfill
    , timezone :: Maybe Text
timezone = Maybe Text
forall a. Maybe a
Nothing
    , initiallyEnabled :: Bool
initiallyEnabled = Bool
True
    , builder :: TickKind -> UTCTime -> JobWrite payload
builder = TickKind -> UTCTime -> JobWrite payload
build
    }
    CronJob payload
-> Either String CronSchedule -> Either String (CronJob payload)
forall a b. a -> Either String b -> Either String a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Either String CronSchedule
parseCronSchedule Text
expr

-- | Like 'cronJob' but evaluated in a specific timezone. The tz name is
-- validated eagerly against the bundled @tzdata@ database.
cronJobInTimezone
  :: Text
  -- ^ Schedule name
  -> Text
  -- ^ IANA tz name (e.g. @\"America\/New_York\"@)
  -> Text
  -- ^ Cron expression (5-field)
  -> OverlapPolicy
  -- ^ Overlap policy
  -> (TickKind -> UTCTime -> JobWrite payload)
  -- ^ Job builder
  -> Either String (CronJob payload)
cronJobInTimezone :: forall payload.
Text
-> Text
-> Text
-> OverlapPolicy
-> (TickKind -> UTCTime -> JobWrite payload)
-> Either String (CronJob payload)
cronJobInTimezone Text
cronName Text
tzName Text
expr OverlapPolicy
overlapPolicy TickKind -> UTCTime -> JobWrite payload
build =
  case Text -> Maybe TZ
resolveTZ Text
tzName of
    Maybe TZ
Nothing -> String -> Either String (CronJob payload)
forall a b. a -> Either a b
Left (String -> Either String (CronJob payload))
-> String -> Either String (CronJob payload)
forall a b. (a -> b) -> a -> b
$ String
"Unknown timezone: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
tzName
    Just TZ
_ -> (CronJob payload -> CronJob payload)
-> Either String (CronJob payload)
-> Either String (CronJob payload)
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CronJob payload
job -> CronJob payload
job {timezone = Just tzName}) (Text
-> Text
-> OverlapPolicy
-> (TickKind -> UTCTime -> JobWrite payload)
-> Either String (CronJob payload)
forall payload.
Text
-> Text
-> OverlapPolicy
-> (TickKind -> UTCTime -> JobWrite payload)
-> Either String (CronJob payload)
cronJob Text
cronName Text
expr OverlapPolicy
overlapPolicy TickKind -> UTCTime -> JobWrite payload
build)

-- | Look up an IANA tz name in the bundled @tzdata@ database.
resolveTZ :: Text -> Maybe TZ
resolveTZ :: Text -> Maybe TZ
resolveTZ Text
name = (TZLabel -> TZ) -> Maybe TZLabel -> Maybe TZ
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TZLabel -> TZ
tzByLabel (ByteString -> Maybe TZLabel
fromTZName (Text -> ByteString
encodeUtf8 Text
name))

-- | Match a cron schedule against a UTC tick in the given timezone.
-- 'Nothing' means UTC. An unknown tz name returns 'False'. A fixed-time schedule
-- skips the second reading of a repeated local hour. A wildcard one runs through both.
matchesInTimezone :: Maybe Text -> CronSchedule -> UTCTime -> Bool
matchesInTimezone :: Maybe Text -> CronSchedule -> UTCTime -> Bool
matchesInTimezone Maybe Text
Nothing CronSchedule
sched UTCTime
tick = CronSchedule -> UTCTime -> Bool
scheduleMatches CronSchedule
sched UTCTime
tick
matchesInTimezone (Just Text
tzName) CronSchedule
sched UTCTime
tick =
  case Text -> Maybe TZ
resolveTZ Text
tzName of
    Maybe TZ
Nothing -> Bool
False
    Just TZ
zone ->
      let local :: LocalTime
local = TZ -> UTCTime -> LocalTime
utcToLocalTimeTZ TZ
zone UTCTime
tick
       in CronSchedule -> UTCTime -> Bool
scheduleMatches CronSchedule
sched (TimeZone -> LocalTime -> UTCTime
localTimeToUTC TimeZone
utc LocalTime
local) Bool -> Bool -> Bool
&& (CronSchedule -> Bool
wildcard CronSchedule
sched Bool -> Bool -> Bool
|| Bool -> Bool
not (TZ -> LocalTime -> UTCTime -> Bool
secondReading TZ
zone LocalTime
local UTCTime
tick))

-- | A schedule whose minute or hour field starts with @*@, as Vixie cron classifies it.
wildcard :: CronSchedule -> Bool
wildcard :: CronSchedule -> Bool
wildcard CronSchedule
sched = (CronField -> Bool) -> [CronField] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any CronField -> Bool
startsWithStar [MinuteSpec -> CronField
Cron.minuteSpec (CronSchedule -> MinuteSpec
Cron.minute CronSchedule
sched), HourSpec -> CronField
Cron.hourSpec (CronSchedule -> HourSpec
Cron.hour CronSchedule
sched)]
  where
    startsWithStar :: CronField -> Bool
startsWithStar (Cron.Field BaseField
Cron.Star) = Bool
True
    startsWithStar (Cron.StepField' StepField
step) = StepField -> BaseField
Cron.sfField StepField
step BaseField -> BaseField -> Bool
forall a. Eq a => a -> a -> Bool
== BaseField
Cron.Star
    startsWithStar CronField
_ = Bool
False

-- | Whether @tick@ is the second reading of an ambiguous @local@.
secondReading :: TZ -> LocalTime -> UTCTime -> Bool
secondReading :: TZ -> LocalTime -> UTCTime -> Bool
secondReading TZ
zone LocalTime
local UTCTime
tick = case TZ -> LocalTime -> LocalToUTCResult
localTimeToUTCFull TZ
zone LocalTime
local of
  LTUAmbiguous UTCTime
_ UTCTime
second TimeZone
_ TimeZone
_ -> UTCTime
tick UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
>= UTCTime
second
  LocalToUTCResult
_ -> Bool
False

-- | The first tick after @now@ that @sched@ matches in the given timezone.
-- 'Nothing' means UTC. An unknown tz name returns 'Nothing'.
nextRunInTimezone :: Maybe Text -> CronSchedule -> UTCTime -> Maybe UTCTime
nextRunInTimezone :: Maybe Text -> CronSchedule -> UTCTime -> Maybe UTCTime
nextRunInTimezone Maybe Text
Nothing CronSchedule
sched UTCTime
now = CronSchedule -> UTCTime -> Maybe UTCTime
nextMatch CronSchedule
sched UTCTime
now
nextRunInTimezone (Just Text
tzName) CronSchedule
sched UTCTime
now = do
  zone <- Text -> Maybe TZ
resolveTZ Text
tzName
  replayed zone <|> seek zone (localTimeToUTC utc (utcToLocalTimeTZ zone now))
  where
    -- A replayed minute runs ahead of @now@ in UTC while reading behind it locally.
    replayed :: TZ -> Maybe UTCTime
replayed TZ
zone = do
      endsAt <- TZ -> UTCTime -> Maybe UTCTime
replayEnd TZ
zone UTCTime
now
      find (matchesInTimezone (Just tzName) sched) (enumMinutes (addUTCTime oneMinute (truncateToMinute now)) endsAt)
    seek :: TZ -> UTCTime -> Maybe UTCTime
seek TZ
zone UTCTime
from = do
      localMinute <- CronSchedule -> UTCTime -> Maybe UTCTime
nextMatch CronSchedule
sched UTCTime
from
      find
        (\UTCTime
tick -> UTCTime
tick UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> UTCTime
now Bool -> Bool -> Bool
&& Maybe Text -> CronSchedule -> UTCTime -> Bool
matchesInTimezone (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
tzName) CronSchedule
sched UTCTime
tick)
        (ticksWearing zone (utcToLocalTime utc localMinute))
        <|> seek zone localMinute

-- | When @tick@ is in the first pass of a repeated local hour, when that hour reads again.
replayEnd :: TZ -> UTCTime -> Maybe UTCTime
replayEnd :: TZ -> UTCTime -> Maybe UTCTime
replayEnd TZ
zone UTCTime
tick = case TZ -> LocalTime -> LocalToUTCResult
localTimeToUTCFull TZ
zone (TZ -> UTCTime -> LocalTime
utcToLocalTimeTZ TZ
zone UTCTime
tick) of
  LTUAmbiguous UTCTime
_ UTCTime
second TimeZone
_ TimeZone
_ | UTCTime
tick UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
second -> UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
second
  LocalToUTCResult
_ -> Maybe UTCTime
forall a. Maybe a
Nothing

-- | Every UTC tick whose local clock in @zone@ reads @local@, earliest first.
ticksWearing :: TZ -> LocalTime -> [UTCTime]
ticksWearing :: TZ -> LocalTime -> [UTCTime]
ticksWearing TZ
zone LocalTime
local = case TZ -> LocalTime -> LocalToUTCResult
localTimeToUTCFull TZ
zone LocalTime
local of
  LTUUnique UTCTime
tick TimeZone
_ -> [UTCTime
tick]
  LTUAmbiguous UTCTime
first UTCTime
second TimeZone
_ TimeZone
_ -> [UTCTime
first, UTCTime
second]
  LTUNone UTCTime
_ TimeZone
_ -> []

-- | 'nextRunInTimezone' over an unparsed expression. A bad one returns 'Nothing'.
nextRunFromExpression :: Maybe Text -> Text -> UTCTime -> Maybe UTCTime
nextRunFromExpression :: Maybe Text -> Text -> UTCTime -> Maybe UTCTime
nextRunFromExpression Maybe Text
tzName Text
expr UTCTime
now =
  (String -> Maybe UTCTime)
-> (CronSchedule -> Maybe UTCTime)
-> Either String CronSchedule
-> Maybe UTCTime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe UTCTime -> String -> Maybe UTCTime
forall a b. a -> b -> a
const Maybe UTCTime
forall a. Maybe a
Nothing) (\CronSchedule
sched -> Maybe Text -> CronSchedule -> UTCTime -> Maybe UTCTime
nextRunInTimezone Maybe Text
tzName CronSchedule
sched UTCTime
now) (Text -> Either String CronSchedule
parseCronSchedule Text
expr)

-- | Truncate a 'UTCTime' to the current minute (zero out seconds).
truncateToMinute :: UTCTime -> UTCTime
truncateToMinute :: UTCTime -> UTCTime
truncateToMinute UTCTime
tick =
  let secs :: DiffTime
secs = UTCTime -> DiffTime
utctDayTime UTCTime
tick
      truncated :: DiffTime
truncated = Integer -> DiffTime
secondsToDiffTime (DiffTime -> Integer
forall b. Integral b => DiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor DiffTime
secs Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
secondsPerMinute Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
secondsPerMinute)
   in UTCTime
tick {utctDayTime = truncated}

-- | Seconds in one minute.
secondsPerMinute :: Integer
secondsPerMinute :: Integer
secondsPerMinute = Integer
60

-- | One minute, the cron tick step.
oneMinute :: NominalDiffTime
oneMinute :: NominalDiffTime
oneMinute = Integer -> NominalDiffTime
forall a. Num a => Integer -> a
fromInteger Integer
secondsPerMinute

-- | Format a 'UTCTime' as @YYYY-MM-DDTHH:MM@ for dedup key buckets.
formatMinute :: UTCTime -> Text
formatMinute :: UTCTime -> Text
formatMinute = String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%Y-%m-%dT%H:%M"

-- | Enumerate all minute-boundary times from @start@ through @end@ (inclusive).
-- Both @start@ and @end@ should be truncated to minute boundaries.
enumMinutes :: UTCTime -> UTCTime -> [UTCTime]
enumMinutes :: UTCTime -> UTCTime -> [UTCTime]
enumMinutes UTCTime
start UTCTime
end =
  (UTCTime -> Maybe (UTCTime, UTCTime)) -> UTCTime -> [UTCTime]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr
    (\UTCTime
minute -> if UTCTime
minute UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> UTCTime
end then Maybe (UTCTime, UTCTime)
forall a. Maybe a
Nothing else (UTCTime, UTCTime) -> Maybe (UTCTime, UTCTime)
forall a. a -> Maybe a
Just (UTCTime
minute, NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
oneMinute UTCTime
minute))
    UTCTime
start