{-# LANGUAGE DerivingVia #-}

module Faktory.JobOptions
  ( JobOptions (..)

    -- * Modifiers
  , retry
  , once
  , reserveFor
  , queue
  , jobtype
  , at
  , in_
  , custom

    -- * Enqueue-time modifiers
  , getAtFromSchedule
  , namespaceQueue
  ) where

import Faktory.Prelude

import Data.Aeson
import Data.Semigroup (Last (..))
import Data.Semigroup.Generic
import Data.Time
import Faktory.Job.Custom
import Faktory.Settings.Queue (Namespace, Queue)
import qualified Faktory.Settings.Queue as Settings
import GHC.Generics
import Numeric.Natural (Natural)

-- | Options for the execution of a job
--
-- These can be constructed using '(<>)':
--
-- @
-- let options = 'retry' 1 <> 'jobtype' "MyJob"
-- @
--
-- To enqueue with defaults, use 'mempty'.
--
-- Options use 'Last' semantics, so (e.g.) @'retry' x <>@ will set retries to
-- @x@ only if not already set, and @<> 'retry' x@ will override any
-- already-present retries to @x@.
data JobOptions = JobOptions
  { JobOptions -> Maybe (Last String)
joJobtype :: Maybe (Last String)
  , JobOptions -> Maybe (Last Int)
joRetry :: Maybe (Last Int)
  , JobOptions -> Maybe (Last Queue)
joQueue :: Maybe (Last Queue)
  , JobOptions -> Maybe (Last (Either UTCTime NominalDiffTime))
joSchedule :: Maybe (Last (Either UTCTime NominalDiffTime))
  , JobOptions -> Maybe Custom
joCustom :: Maybe Custom
  , JobOptions -> Maybe (Last Natural)
joReserveFor :: Maybe (Last Natural)
  }
  deriving stock (JobOptions -> JobOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JobOptions -> JobOptions -> Bool
$c/= :: JobOptions -> JobOptions -> Bool
== :: JobOptions -> JobOptions -> Bool
$c== :: JobOptions -> JobOptions -> Bool
Eq, Int -> JobOptions -> ShowS
[JobOptions] -> ShowS
JobOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JobOptions] -> ShowS
$cshowList :: [JobOptions] -> ShowS
show :: JobOptions -> String
$cshow :: JobOptions -> String
showsPrec :: Int -> JobOptions -> ShowS
$cshowsPrec :: Int -> JobOptions -> ShowS
Show, forall x. Rep JobOptions x -> JobOptions
forall x. JobOptions -> Rep JobOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JobOptions x -> JobOptions
$cfrom :: forall x. JobOptions -> Rep JobOptions x
Generic)
  deriving (NonEmpty JobOptions -> JobOptions
JobOptions -> JobOptions -> JobOptions
forall b. Integral b => b -> JobOptions -> JobOptions
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> JobOptions -> JobOptions
$cstimes :: forall b. Integral b => b -> JobOptions -> JobOptions
sconcat :: NonEmpty JobOptions -> JobOptions
$csconcat :: NonEmpty JobOptions -> JobOptions
<> :: JobOptions -> JobOptions -> JobOptions
$c<> :: JobOptions -> JobOptions -> JobOptions
Semigroup, Semigroup JobOptions
JobOptions
[JobOptions] -> JobOptions
JobOptions -> JobOptions -> JobOptions
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [JobOptions] -> JobOptions
$cmconcat :: [JobOptions] -> JobOptions
mappend :: JobOptions -> JobOptions -> JobOptions
$cmappend :: JobOptions -> JobOptions -> JobOptions
mempty :: JobOptions
$cmempty :: JobOptions
Monoid) via GenericSemigroupMonoid JobOptions

-- brittany-disable-next-binding

instance FromJSON JobOptions where
  parseJSON :: Value -> Parser JobOptions
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JobOptions" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe (Last String)
-> Maybe (Last Int)
-> Maybe (Last Queue)
-> Maybe (Last (Either UTCTime NominalDiffTime))
-> Maybe Custom
-> Maybe (Last Natural)
-> JobOptions
JobOptions
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"jobtype"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"retry"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"queue"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Last a
Last forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"at")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"custom"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"reserve_for"

getAtFromSchedule :: JobOptions -> IO (Maybe UTCTime)
getAtFromSchedule :: JobOptions -> IO (Maybe UTCTime)
getAtFromSchedule JobOptions
options = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (forall a. Last a -> a
getLast forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JobOptions -> Maybe (Last (Either UTCTime NominalDiffTime))
joSchedule JobOptions
options) forall a b. (a -> b) -> a -> b
$ \case
  Left UTCTime
t -> forall (f :: * -> *) a. Applicative f => a -> f a
pure UTCTime
t
  Right NominalDiffTime
nd -> NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
nd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime

namespaceQueue :: Namespace -> JobOptions -> JobOptions
namespaceQueue :: Namespace -> JobOptions -> JobOptions
namespaceQueue Namespace
namespace JobOptions
options = case JobOptions -> Maybe (Last Queue)
joQueue JobOptions
options of
  Maybe (Last Queue)
Nothing -> JobOptions
options
  Just (Last Queue
q) -> JobOptions
options forall a. Semigroup a => a -> a -> a
<> Queue -> JobOptions
queue (Namespace -> Queue -> Queue
Settings.namespaceQueue Namespace
namespace Queue
q)

reserveFor :: Natural -> JobOptions
reserveFor :: Natural -> JobOptions
reserveFor Natural
n = forall a. Monoid a => a
mempty {joReserveFor :: Maybe (Last Natural)
joReserveFor = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Last a
Last Natural
n}

retry :: Int -> JobOptions
retry :: Int -> JobOptions
retry Int
n = forall a. Monoid a => a
mempty {joRetry :: Maybe (Last Int)
joRetry = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Last a
Last Int
n}

-- | Equivalent to @'retry' (-1)@: no retries, and move to Dead on failure
once :: JobOptions
once :: JobOptions
once = Int -> JobOptions
retry (-Int
1)

queue :: Queue -> JobOptions
queue :: Queue -> JobOptions
queue Queue
q = forall a. Monoid a => a
mempty {joQueue :: Maybe (Last Queue)
joQueue = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Last a
Last Queue
q}

jobtype :: String -> JobOptions
jobtype :: String -> JobOptions
jobtype String
jt = forall a. Monoid a => a
mempty {joJobtype :: Maybe (Last String)
joJobtype = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Last a
Last String
jt}

at :: UTCTime -> JobOptions
at :: UTCTime -> JobOptions
at UTCTime
t = forall a. Monoid a => a
mempty {joSchedule :: Maybe (Last (Either UTCTime NominalDiffTime))
joSchedule = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Last a
Last forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left UTCTime
t}

in_ :: NominalDiffTime -> JobOptions
in_ :: NominalDiffTime -> JobOptions
in_ NominalDiffTime
i = forall a. Monoid a => a
mempty {joSchedule :: Maybe (Last (Either UTCTime NominalDiffTime))
joSchedule = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Last a
Last forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right NominalDiffTime
i}

custom :: ToJSON a => a -> JobOptions
custom :: forall a. ToJSON a => a -> JobOptions
custom a
v = forall a. Monoid a => a
mempty {joCustom :: Maybe Custom
joCustom = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Custom
toCustom a
v}