{-# 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
  , formatMinuteInTimezone
  , truncateToMinute
  , formatMinute
  , enumMinutes
  ) 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)

-- | How overlapping cron ticks are deduplicated.
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 missed minutes up to the given duration.
    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 = Live | 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 Maybe (Maybe Text)
mExpr Maybe (Maybe Text)
mOverlap Maybe (Maybe Text)
mTz Maybe Bool
_) = 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 = not found).
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
  -- ^ Human-readable name for logging and dedup keys
  , forall payload. CronJob payload -> Text
cronExpression :: Text
  -- ^ Original cron expression text (for DB storage)
  , 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 -> TickKind -> UTCTime -> JobWrite payload
builder :: TickKind -> UTCTime -> JobWrite payload
  -- ^ Build a job for the given tick time. 'Replay' is passed for any tick
  -- whose minute is not the current scheduler minute (startup or mid-flight
  -- catch-up). 'Live' is passed for the current minute boundary.
  }
  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'. A bad expression returns @Left@. The expression is
-- evaluated in UTC. 'cronJobInTimezone' is the local-time form. Set 'backfill'
-- 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
  -> (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
    , 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
  -> (TickKind -> UTCTime -> JobWrite payload)
  -> 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, evaluated in @tz@.
-- 'Nothing' means UTC. An unknown tz name returns 'False'.
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
          asUtc :: UTCTime
asUtc = TimeZone -> LocalTime -> UTCTime
localTimeToUTC TimeZone
utc LocalTime
local
       in CronSchedule -> UTCTime -> Bool
scheduleMatches CronSchedule
sched UTCTime
asUtc

-- | The first tick after @now@ that @sched@ matches, evaluated in @tz@.
-- 'Nothing' means UTC. An unknown tz name returns 'Nothing'.
--
-- A replayed local minute is reported. Its insert is deduped while the earlier run
-- is still live.
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 60 (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 (> now) (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 @tz@ 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)

-- | Format a UTC tick as @YYYY-MM-DDTHH:MM@ in the given timezone.
-- DST fall-back maps two UTC instants to the same local minute. Dedup keys
-- built from it collapse those to a single fire.
formatMinuteInTimezone :: Maybe Text -> UTCTime -> Text
formatMinuteInTimezone :: Maybe Text -> UTCTime -> Text
formatMinuteInTimezone Maybe Text
tzName UTCTime
tick =
  Text -> (TZ -> Text) -> Maybe TZ -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (UTCTime -> Text
formatMinute UTCTime
tick) TZ -> Text
localMinute (Maybe Text
tzName Maybe Text -> (Text -> Maybe TZ) -> Maybe TZ
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe TZ
resolveTZ)
  where
    localMinute :: TZ -> Text
localMinute TZ
zone = String -> Text
T.pack (TimeLocale -> String -> LocalTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%Y-%m-%dT%H:%M" (TZ -> UTCTime -> LocalTime
utcToLocalTimeTZ TZ
zone UTCTime
tick))

-- | 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
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60)
   in UTCTime
tick {utctDayTime = truncated}

-- | 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
60 UTCTime
minute))
    UTCTime
start