{-# LANGUAGE DerivingVia #-}
module Faktory.JobOptions
( JobOptions (..)
, retry
, once
, reserveFor
, queue
, jobtype
, at
, in_
, custom
, 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)
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
(JobOptions -> JobOptions -> Bool)
-> (JobOptions -> JobOptions -> Bool) -> Eq JobOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JobOptions -> JobOptions -> Bool
== :: JobOptions -> JobOptions -> Bool
$c/= :: JobOptions -> JobOptions -> Bool
/= :: JobOptions -> JobOptions -> Bool
Eq, Int -> JobOptions -> ShowS
[JobOptions] -> ShowS
JobOptions -> String
(Int -> JobOptions -> ShowS)
-> (JobOptions -> String)
-> ([JobOptions] -> ShowS)
-> Show JobOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JobOptions -> ShowS
showsPrec :: Int -> JobOptions -> ShowS
$cshow :: JobOptions -> String
show :: JobOptions -> String
$cshowList :: [JobOptions] -> ShowS
showList :: [JobOptions] -> ShowS
Show, (forall x. JobOptions -> Rep JobOptions x)
-> (forall x. Rep JobOptions x -> JobOptions) -> Generic JobOptions
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
$cfrom :: forall x. JobOptions -> Rep JobOptions x
from :: forall x. JobOptions -> Rep JobOptions x
$cto :: forall x. Rep JobOptions x -> JobOptions
to :: forall x. Rep JobOptions x -> JobOptions
Generic)
deriving (NonEmpty JobOptions -> JobOptions
JobOptions -> JobOptions -> JobOptions
(JobOptions -> JobOptions -> JobOptions)
-> (NonEmpty JobOptions -> JobOptions)
-> (forall b. Integral b => b -> JobOptions -> JobOptions)
-> Semigroup 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
$c<> :: JobOptions -> JobOptions -> JobOptions
<> :: JobOptions -> JobOptions -> JobOptions
$csconcat :: NonEmpty JobOptions -> JobOptions
sconcat :: NonEmpty JobOptions -> JobOptions
$cstimes :: forall b. Integral b => b -> JobOptions -> JobOptions
stimes :: forall b. Integral b => b -> JobOptions -> JobOptions
Semigroup, Semigroup JobOptions
JobOptions
Semigroup JobOptions =>
JobOptions
-> (JobOptions -> JobOptions -> JobOptions)
-> ([JobOptions] -> JobOptions)
-> Monoid JobOptions
[JobOptions] -> JobOptions
JobOptions -> JobOptions -> JobOptions
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: JobOptions
mempty :: JobOptions
$cmappend :: JobOptions -> JobOptions -> JobOptions
mappend :: JobOptions -> JobOptions -> JobOptions
$cmconcat :: [JobOptions] -> JobOptions
mconcat :: [JobOptions] -> JobOptions
Monoid) via GenericSemigroupMonoid JobOptions
instance FromJSON JobOptions where
parseJSON :: Value -> Parser JobOptions
parseJSON = String
-> (Object -> Parser JobOptions) -> Value -> Parser JobOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JobOptions" ((Object -> Parser JobOptions) -> Value -> Parser JobOptions)
-> (Object -> Parser JobOptions) -> Value -> Parser 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
(Maybe (Last String)
-> Maybe (Last Int)
-> Maybe (Last Queue)
-> Maybe (Last (Either UTCTime NominalDiffTime))
-> Maybe Custom
-> Maybe (Last Natural)
-> JobOptions)
-> Parser (Maybe (Last String))
-> Parser
(Maybe (Last Int)
-> Maybe (Last Queue)
-> Maybe (Last (Either UTCTime NominalDiffTime))
-> Maybe Custom
-> Maybe (Last Natural)
-> JobOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe (Last String))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"jobtype"
Parser
(Maybe (Last Int)
-> Maybe (Last Queue)
-> Maybe (Last (Either UTCTime NominalDiffTime))
-> Maybe Custom
-> Maybe (Last Natural)
-> JobOptions)
-> Parser (Maybe (Last Int))
-> Parser
(Maybe (Last Queue)
-> Maybe (Last (Either UTCTime NominalDiffTime))
-> Maybe Custom
-> Maybe (Last Natural)
-> JobOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Last Int))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"retry"
Parser
(Maybe (Last Queue)
-> Maybe (Last (Either UTCTime NominalDiffTime))
-> Maybe Custom
-> Maybe (Last Natural)
-> JobOptions)
-> Parser (Maybe (Last Queue))
-> Parser
(Maybe (Last (Either UTCTime NominalDiffTime))
-> Maybe Custom -> Maybe (Last Natural) -> JobOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Last Queue))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"queue"
Parser
(Maybe (Last (Either UTCTime NominalDiffTime))
-> Maybe Custom -> Maybe (Last Natural) -> JobOptions)
-> Parser (Maybe (Last (Either UTCTime NominalDiffTime)))
-> Parser (Maybe Custom -> Maybe (Last Natural) -> JobOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((UTCTime -> Last (Either UTCTime NominalDiffTime))
-> Maybe UTCTime -> Maybe (Last (Either UTCTime NominalDiffTime))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either UTCTime NominalDiffTime
-> Last (Either UTCTime NominalDiffTime)
forall a. a -> Last a
Last (Either UTCTime NominalDiffTime
-> Last (Either UTCTime NominalDiffTime))
-> (UTCTime -> Either UTCTime NominalDiffTime)
-> UTCTime
-> Last (Either UTCTime NominalDiffTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Either UTCTime NominalDiffTime
forall a b. a -> Either a b
Left) (Maybe UTCTime -> Maybe (Last (Either UTCTime NominalDiffTime)))
-> Parser (Maybe UTCTime)
-> Parser (Maybe (Last (Either UTCTime NominalDiffTime)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"at")
Parser (Maybe Custom -> Maybe (Last Natural) -> JobOptions)
-> Parser (Maybe Custom)
-> Parser (Maybe (Last Natural) -> JobOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Custom)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"custom"
Parser (Maybe (Last Natural) -> JobOptions)
-> Parser (Maybe (Last Natural)) -> Parser JobOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Last Natural))
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 = Maybe (Either UTCTime NominalDiffTime)
-> (Either UTCTime NominalDiffTime -> IO UTCTime)
-> IO (Maybe UTCTime)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Last (Either UTCTime NominalDiffTime)
-> Either UTCTime NominalDiffTime
forall a. Last a -> a
getLast (Last (Either UTCTime NominalDiffTime)
-> Either UTCTime NominalDiffTime)
-> Maybe (Last (Either UTCTime NominalDiffTime))
-> Maybe (Either UTCTime NominalDiffTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JobOptions -> Maybe (Last (Either UTCTime NominalDiffTime))
joSchedule JobOptions
options) ((Either UTCTime NominalDiffTime -> IO UTCTime)
-> IO (Maybe UTCTime))
-> (Either UTCTime NominalDiffTime -> IO UTCTime)
-> IO (Maybe UTCTime)
forall a b. (a -> b) -> a -> b
$ \case
Left UTCTime
t -> UTCTime -> IO UTCTime
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UTCTime
t
Right NominalDiffTime
nd -> NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
nd (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
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 JobOptions -> JobOptions -> JobOptions
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 = JobOptions
forall a. Monoid a => a
mempty {joReserveFor = Just $ Last n}
retry :: Int -> JobOptions
retry :: Int -> JobOptions
retry Int
n = JobOptions
forall a. Monoid a => a
mempty {joRetry = Just $ Last n}
once :: JobOptions
once :: JobOptions
once = Int -> JobOptions
retry (-Int
1)
queue :: Queue -> JobOptions
queue :: Queue -> JobOptions
queue Queue
q = JobOptions
forall a. Monoid a => a
mempty {joQueue = Just $ Last q}
jobtype :: String -> JobOptions
jobtype :: String -> JobOptions
jobtype String
jt = JobOptions
forall a. Monoid a => a
mempty {joJobtype = Just $ Last jt}
at :: UTCTime -> JobOptions
at :: UTCTime -> JobOptions
at UTCTime
t = JobOptions
forall a. Monoid a => a
mempty {joSchedule = Just $ Last $ Left t}
in_ :: NominalDiffTime -> JobOptions
in_ :: NominalDiffTime -> JobOptions
in_ NominalDiffTime
i = JobOptions
forall a. Monoid a => a
mempty {joSchedule = Just $ Last $ Right i}
custom :: ToJSON a => a -> JobOptions
custom :: forall a. ToJSON a => a -> JobOptions
custom a
v = JobOptions
forall a. Monoid a => a
mempty {joCustom = Just $ toCustom v}