{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Types for the @cron_schedules@ table.
--
-- The table stores both the code-defined defaults and user overrides separately.
-- On worker init, only the @default_*@ columns are upserted -- user overrides
-- (@override_*@, @enabled@) are preserved.
module Arbiter.Core.CronSchedule
  ( -- * Types
    CronScheduleRow (..)
  , CronScheduleUpdate (..)

    -- * Effective values
  , effectiveExpression
  , effectiveOverlap
  , effectiveTimezone

    -- * DDL
  , cronSchedulesTable
  , createCronSchedulesTableSQL
  , addTimezoneColumnSQL
  ) where

import Control.Applicative ((<|>))
import Data.Aeson
  ( FromJSON (..)
  , ToJSON (..)
  , defaultOptions
  , genericToEncoding
  , genericToJSON
  , omitNothingFields
  , withObject
  , (.:)
  , (.:?)
  )
import Data.Aeson qualified as Aeson
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Time (UTCTime)
import GHC.Generics (Generic)

import Arbiter.Core.Job.Schema (quoteIdentifier)

-- | A row from the @cron_schedules@ table.
data CronScheduleRow = CronScheduleRow
  { CronScheduleRow -> Text
name :: Text
  , CronScheduleRow -> Text
defaultExpression :: Text
  , CronScheduleRow -> Text
defaultOverlap :: Text
  , CronScheduleRow -> Maybe Text
defaultTimezone :: Maybe Text
  -- ^ Code-defined IANA tz name. @NULL@ = UTC.
  , CronScheduleRow -> Maybe Text
overrideExpression :: Maybe Text
  , CronScheduleRow -> Maybe Text
overrideOverlap :: Maybe Text
  , CronScheduleRow -> Maybe Text
overrideTimezone :: Maybe Text
  -- ^ User override. @NULL@ = use default. To force UTC when the default is
  -- not UTC, set to @\"UTC\"@.
  , CronScheduleRow -> Bool
enabled :: Bool
  , CronScheduleRow -> Maybe UTCTime
lastFiredAt :: Maybe UTCTime
  , CronScheduleRow -> Maybe UTCTime
lastCheckedAt :: Maybe UTCTime
  , CronScheduleRow -> UTCTime
createdAt :: UTCTime
  , CronScheduleRow -> UTCTime
updatedAt :: UTCTime
  }
  deriving stock (CronScheduleRow -> CronScheduleRow -> Bool
(CronScheduleRow -> CronScheduleRow -> Bool)
-> (CronScheduleRow -> CronScheduleRow -> Bool)
-> Eq CronScheduleRow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CronScheduleRow -> CronScheduleRow -> Bool
== :: CronScheduleRow -> CronScheduleRow -> Bool
$c/= :: CronScheduleRow -> CronScheduleRow -> Bool
/= :: CronScheduleRow -> CronScheduleRow -> Bool
Eq, (forall x. CronScheduleRow -> Rep CronScheduleRow x)
-> (forall x. Rep CronScheduleRow x -> CronScheduleRow)
-> Generic CronScheduleRow
forall x. Rep CronScheduleRow x -> CronScheduleRow
forall x. CronScheduleRow -> Rep CronScheduleRow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CronScheduleRow -> Rep CronScheduleRow x
from :: forall x. CronScheduleRow -> Rep CronScheduleRow x
$cto :: forall x. Rep CronScheduleRow x -> CronScheduleRow
to :: forall x. Rep CronScheduleRow x -> CronScheduleRow
Generic, Int -> CronScheduleRow -> ShowS
[CronScheduleRow] -> ShowS
CronScheduleRow -> String
(Int -> CronScheduleRow -> ShowS)
-> (CronScheduleRow -> String)
-> ([CronScheduleRow] -> ShowS)
-> Show CronScheduleRow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CronScheduleRow -> ShowS
showsPrec :: Int -> CronScheduleRow -> ShowS
$cshow :: CronScheduleRow -> String
show :: CronScheduleRow -> String
$cshowList :: [CronScheduleRow] -> ShowS
showList :: [CronScheduleRow] -> ShowS
Show)
  deriving anyclass (Maybe CronScheduleRow
Value -> Parser [CronScheduleRow]
Value -> Parser CronScheduleRow
(Value -> Parser CronScheduleRow)
-> (Value -> Parser [CronScheduleRow])
-> Maybe CronScheduleRow
-> FromJSON CronScheduleRow
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser CronScheduleRow
parseJSON :: Value -> Parser CronScheduleRow
$cparseJSONList :: Value -> Parser [CronScheduleRow]
parseJSONList :: Value -> Parser [CronScheduleRow]
$comittedField :: Maybe CronScheduleRow
omittedField :: Maybe CronScheduleRow
FromJSON, [CronScheduleRow] -> Encoding
[CronScheduleRow] -> Value
CronScheduleRow -> Bool
CronScheduleRow -> Encoding
CronScheduleRow -> Value
(CronScheduleRow -> Value)
-> (CronScheduleRow -> Encoding)
-> ([CronScheduleRow] -> Value)
-> ([CronScheduleRow] -> Encoding)
-> (CronScheduleRow -> Bool)
-> ToJSON CronScheduleRow
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CronScheduleRow -> Value
toJSON :: CronScheduleRow -> Value
$ctoEncoding :: CronScheduleRow -> Encoding
toEncoding :: CronScheduleRow -> Encoding
$ctoJSONList :: [CronScheduleRow] -> Value
toJSONList :: [CronScheduleRow] -> Value
$ctoEncodingList :: [CronScheduleRow] -> Encoding
toEncodingList :: [CronScheduleRow] -> Encoding
$comitField :: CronScheduleRow -> Bool
omitField :: CronScheduleRow -> Bool
ToJSON)

-- | Effective expression: override if set, else default.
effectiveExpression :: CronScheduleRow -> Text
effectiveExpression :: CronScheduleRow -> Text
effectiveExpression CronScheduleRow {defaultExpression :: CronScheduleRow -> Text
defaultExpression = Text
def, overrideExpression :: CronScheduleRow -> Maybe Text
overrideExpression = Maybe Text
mOvr} = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
def Maybe Text
mOvr

-- | Effective overlap policy: override if set, else default.
effectiveOverlap :: CronScheduleRow -> Text
effectiveOverlap :: CronScheduleRow -> Text
effectiveOverlap CronScheduleRow {defaultOverlap :: CronScheduleRow -> Text
defaultOverlap = Text
def, overrideOverlap :: CronScheduleRow -> Maybe Text
overrideOverlap = Maybe Text
mOvr} = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
def Maybe Text
mOvr

-- | Effective timezone: override if set, else default. 'Nothing' means UTC.
effectiveTimezone :: CronScheduleRow -> Maybe Text
effectiveTimezone :: CronScheduleRow -> Maybe Text
effectiveTimezone CronScheduleRow {defaultTimezone :: CronScheduleRow -> Maybe Text
defaultTimezone = Maybe Text
mDef, overrideTimezone :: CronScheduleRow -> Maybe Text
overrideTimezone = Maybe Text
mOvr} = Maybe Text
mOvr Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
mDef

-- | Patch update for a cron schedule.
--
-- Each field uses @Maybe (Maybe a)@:
--
--   * @Nothing@ = don't change
--   * @Just Nothing@ = reset to default (set column to NULL)
--   * @Just (Just x)@ = set to @x@
data CronScheduleUpdate = CronScheduleUpdate
  { CronScheduleUpdate -> Maybe (Maybe Text)
overrideExpression :: Maybe (Maybe Text)
  , CronScheduleUpdate -> Maybe (Maybe Text)
overrideOverlap :: Maybe (Maybe Text)
  , CronScheduleUpdate -> Maybe (Maybe Text)
overrideTimezone :: Maybe (Maybe Text)
  , CronScheduleUpdate -> Maybe Bool
enabled :: Maybe Bool
  }
  deriving stock (CronScheduleUpdate -> CronScheduleUpdate -> Bool
(CronScheduleUpdate -> CronScheduleUpdate -> Bool)
-> (CronScheduleUpdate -> CronScheduleUpdate -> Bool)
-> Eq CronScheduleUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CronScheduleUpdate -> CronScheduleUpdate -> Bool
== :: CronScheduleUpdate -> CronScheduleUpdate -> Bool
$c/= :: CronScheduleUpdate -> CronScheduleUpdate -> Bool
/= :: CronScheduleUpdate -> CronScheduleUpdate -> Bool
Eq, (forall x. CronScheduleUpdate -> Rep CronScheduleUpdate x)
-> (forall x. Rep CronScheduleUpdate x -> CronScheduleUpdate)
-> Generic CronScheduleUpdate
forall x. Rep CronScheduleUpdate x -> CronScheduleUpdate
forall x. CronScheduleUpdate -> Rep CronScheduleUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CronScheduleUpdate -> Rep CronScheduleUpdate x
from :: forall x. CronScheduleUpdate -> Rep CronScheduleUpdate x
$cto :: forall x. Rep CronScheduleUpdate x -> CronScheduleUpdate
to :: forall x. Rep CronScheduleUpdate x -> CronScheduleUpdate
Generic, Int -> CronScheduleUpdate -> ShowS
[CronScheduleUpdate] -> ShowS
CronScheduleUpdate -> String
(Int -> CronScheduleUpdate -> ShowS)
-> (CronScheduleUpdate -> String)
-> ([CronScheduleUpdate] -> ShowS)
-> Show CronScheduleUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CronScheduleUpdate -> ShowS
showsPrec :: Int -> CronScheduleUpdate -> ShowS
$cshow :: CronScheduleUpdate -> String
show :: CronScheduleUpdate -> String
$cshowList :: [CronScheduleUpdate] -> ShowS
showList :: [CronScheduleUpdate] -> ShowS
Show)

updateOptions :: Aeson.Options
updateOptions :: Options
updateOptions = Options
defaultOptions {omitNothingFields = True}

instance ToJSON CronScheduleUpdate where
  toJSON :: CronScheduleUpdate -> Value
toJSON = Options -> CronScheduleUpdate -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
updateOptions
  toEncoding :: CronScheduleUpdate -> Encoding
toEncoding = Options -> CronScheduleUpdate -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
updateOptions

-- @.:?@ can't distinguish missing from null for @Maybe (Maybe a)@ (both
-- yield @Nothing@), so we check key membership first.
instance FromJSON CronScheduleUpdate where
  parseJSON :: Value -> Parser CronScheduleUpdate
parseJSON = String
-> (Object -> Parser CronScheduleUpdate)
-> Value
-> Parser CronScheduleUpdate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CronScheduleUpdate" ((Object -> Parser CronScheduleUpdate)
 -> Value -> Parser CronScheduleUpdate)
-> (Object -> Parser CronScheduleUpdate)
-> Value
-> Parser CronScheduleUpdate
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    oe <-
      if Key -> Object -> Bool
forall a. Key -> KeyMap a -> Bool
KeyMap.member (Text -> Key
Key.fromText Text
"overrideExpression") Object
o
        then Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just (Maybe Text -> Maybe (Maybe Text))
-> Parser (Maybe Text) -> Parser (Maybe (Maybe Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"overrideExpression"
        else Maybe (Maybe Text) -> Parser (Maybe (Maybe Text))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Maybe Text)
forall a. Maybe a
Nothing
    oo <-
      if KeyMap.member (Key.fromText "overrideOverlap") o
        then Just <$> o .: "overrideOverlap"
        else pure Nothing
    ot <-
      if KeyMap.member (Key.fromText "overrideTimezone") o
        then Just <$> o .: "overrideTimezone"
        else pure Nothing
    en <- o .:? "enabled"
    pure CronScheduleUpdate {overrideExpression = oe, overrideOverlap = oo, overrideTimezone = ot, enabled = en}

-- | Qualified table name for the cron_schedules table.
cronSchedulesTable :: Text -> Text
cronSchedulesTable :: Text -> Text
cronSchedulesTable Text
schemaName = Text -> Text
quoteIdentifier Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".cron_schedules"

-- | DDL for the @cron_schedules@ table.
createCronSchedulesTableSQL :: Text -> Text
createCronSchedulesTableSQL :: Text -> Text
createCronSchedulesTableSQL Text
schemaName =
  [Text] -> Text
T.unlines
    [ Text
"CREATE TABLE IF NOT EXISTS " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cronSchedulesTable Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ("
    , Text
"  name TEXT PRIMARY KEY,"
    , Text
"  default_expression TEXT NOT NULL,"
    , Text
"  default_overlap TEXT NOT NULL CHECK (default_overlap IN ('SkipOverlap', 'AllowOverlap')),"
    , Text
"  override_expression TEXT,"
    , Text
"  override_overlap TEXT CHECK (override_overlap IS NULL OR override_overlap IN ('SkipOverlap', 'AllowOverlap')),"
    , Text
"  enabled BOOLEAN NOT NULL DEFAULT TRUE,"
    , Text
"  last_fired_at TIMESTAMPTZ,"
    , Text
"  last_checked_at TIMESTAMPTZ,"
    , Text
"  created_at TIMESTAMPTZ NOT NULL DEFAULT NOW(),"
    , Text
"  updated_at TIMESTAMPTZ NOT NULL DEFAULT NOW()"
    , Text
");"
    ]

-- | Idempotent migration adding the timezone columns to an existing table.
addTimezoneColumnSQL :: Text -> Text
addTimezoneColumnSQL :: Text -> Text
addTimezoneColumnSQL Text
schemaName =
  [Text] -> Text
T.unlines
    [ Text
"ALTER TABLE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cronSchedulesTable Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ADD COLUMN IF NOT EXISTS default_timezone TEXT;"
    , Text
"ALTER TABLE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cronSchedulesTable Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ADD COLUMN IF NOT EXISTS override_timezone TEXT;"
    ]