module Faktory.Job
  ( Job
  , JobId
  , JobOptions
  , perform
  , retry
  , once
  , queue
  , jobtype
  , at
  , in_
  , custom
  , buildJob
  , newJob
  , jobJid
  , jobArg
  , jobOptions
  ) where

import Faktory.Prelude

import Data.Aeson
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NE
import Data.Time (UTCTime)
import Faktory.Client (Client(..))
import Faktory.Connection (ConnectionInfo(..))
import Faktory.JobOptions
import Faktory.Producer (Producer(..), pushJob)
import Faktory.Settings (Namespace, Settings(..))
import GHC.Stack
import System.Random

data Job arg = Job
  { Job arg -> JobId
jobJid :: JobId
  , Job arg -> Maybe UTCTime
jobAt :: Maybe UTCTime
  -- ^ Will be set based on 'JobOptions' when enqueued
  , Job arg -> NonEmpty arg
jobArgs :: NonEmpty arg
  -- ^ Faktory needs to serialize args as a list, but we like a single-argument
  -- interface so that's what we expose. See @'jobArg'@.
  , Job arg -> JobOptions
jobOptions :: JobOptions
  }

-- | Perform a Job with the given options
--
-- @
-- 'perform' 'mempty' SomeJob
-- 'perform' ('queue' "SomeQueue") SomeJob
-- 'perform' 'once' SomeJob
-- 'perform' ('at' someTime <> 'once') SomeJob
-- 'perform' ('in_' 10 <> 'once') SomeJob
-- 'perform' ('in_' 10 <> 'retry' 3) SomeJob
-- @
--
perform
  :: (HasCallStack, ToJSON arg) => JobOptions -> Producer -> arg -> IO JobId
perform :: JobOptions -> Producer -> arg -> IO JobId
perform JobOptions
options Producer
producer arg
arg = do
  Job arg
job <- JobOptions -> Producer -> arg -> IO (Job arg)
forall arg. JobOptions -> Producer -> arg -> IO (Job arg)
buildJob JobOptions
options Producer
producer arg
arg
  Job arg -> JobId
forall arg. Job arg -> JobId
jobJid Job arg
job JobId -> IO () -> IO JobId
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Producer -> Job arg -> IO ()
forall a. (HasCallStack, ToJSON a) => Producer -> a -> IO ()
pushJob Producer
producer Job arg
job

applyOptions :: Namespace -> JobOptions -> Job arg -> IO (Job arg)
applyOptions :: Namespace -> JobOptions -> Job arg -> IO (Job arg)
applyOptions Namespace
namespace JobOptions
options Job arg
job = do
  Maybe UTCTime
scheduledAt <- JobOptions -> IO (Maybe UTCTime)
getAtFromSchedule JobOptions
options
  let namespacedOptions :: JobOptions
namespacedOptions = Namespace -> JobOptions -> JobOptions
namespaceQueue Namespace
namespace (JobOptions -> JobOptions) -> JobOptions -> JobOptions
forall a b. (a -> b) -> a -> b
$ Job arg -> JobOptions
forall arg. Job arg -> JobOptions
jobOptions Job arg
job JobOptions -> JobOptions -> JobOptions
forall a. Semigroup a => a -> a -> a
<> JobOptions
options
  Job arg -> IO (Job arg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Job arg -> IO (Job arg)) -> Job arg -> IO (Job arg)
forall a b. (a -> b) -> a -> b
$ Job arg
job { jobAt :: Maybe UTCTime
jobAt = Maybe UTCTime
scheduledAt, jobOptions :: JobOptions
jobOptions = JobOptions
namespacedOptions }

-- | Construct a 'Job' and apply options and Producer settings
buildJob :: JobOptions -> Producer -> arg -> IO (Job arg)
buildJob :: JobOptions -> Producer -> arg -> IO (Job arg)
buildJob JobOptions
options Producer
producer arg
arg = Namespace -> JobOptions -> Job arg -> IO (Job arg)
forall arg. Namespace -> JobOptions -> Job arg -> IO (Job arg)
applyOptions Namespace
namespace JobOptions
options (Job arg -> IO (Job arg)) -> IO (Job arg) -> IO (Job arg)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< arg -> IO (Job arg)
forall arg. arg -> IO (Job arg)
newJob arg
arg
 where
  namespace :: Namespace
namespace =
    ConnectionInfo -> Namespace
connectionInfoNamespace
      (ConnectionInfo -> Namespace) -> ConnectionInfo -> Namespace
forall a b. (a -> b) -> a -> b
$ Settings -> ConnectionInfo
settingsConnection
      (Settings -> ConnectionInfo) -> Settings -> ConnectionInfo
forall a b. (a -> b) -> a -> b
$ Client -> Settings
clientSettings
      (Client -> Settings) -> Client -> Settings
forall a b. (a -> b) -> a -> b
$ Producer -> Client
producerClient Producer
producer

-- | Construct a 'Job' with default 'JobOptions'
newJob :: arg -> IO (Job arg)
newJob :: arg -> IO (Job arg)
newJob arg
arg = do
  -- Ruby uses 12 random hex
  JobId
jobId <- Int -> JobId -> JobId
forall a. Int -> [a] -> [a]
take Int
12 (JobId -> JobId) -> (StdGen -> JobId) -> StdGen -> JobId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, Char) -> StdGen -> JobId
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (Char
'a', Char
'z') (StdGen -> JobId) -> IO StdGen -> IO JobId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen

  Job arg -> IO (Job arg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Job :: forall arg.
JobId -> Maybe UTCTime -> NonEmpty arg -> JobOptions -> Job arg
Job
    { jobJid :: JobId
jobJid = JobId
jobId
    , jobAt :: Maybe UTCTime
jobAt = Maybe UTCTime
forall a. Maybe a
Nothing
    , jobArgs :: NonEmpty arg
jobArgs = arg -> NonEmpty arg
forall (f :: * -> *) a. Applicative f => a -> f a
pure arg
arg
    , jobOptions :: JobOptions
jobOptions = JobId -> JobOptions
jobtype JobId
"Default"
    }

jobArg :: Job arg -> arg
jobArg :: Job arg -> arg
jobArg Job {JobId
Maybe UTCTime
NonEmpty arg
JobOptions
jobOptions :: JobOptions
jobArgs :: NonEmpty arg
jobAt :: Maybe UTCTime
jobJid :: JobId
jobArgs :: forall arg. Job arg -> NonEmpty arg
jobAt :: forall arg. Job arg -> Maybe UTCTime
jobOptions :: forall arg. Job arg -> JobOptions
jobJid :: forall arg. Job arg -> JobId
..} = NonEmpty arg -> arg
forall a. NonEmpty a -> a
NE.head NonEmpty arg
jobArgs

instance ToJSON args => ToJSON (Job args) where
  toJSON :: Job args -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value) -> (Job args -> [Pair]) -> Job args -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Job args -> [Pair]
forall a arg. (KeyValue a, ToJSON arg) => Job arg -> [a]
toPairs
  toEncoding :: Job args -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (Job args -> Series) -> Job args -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (Job args -> [Series]) -> Job args -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Job args -> [Series]
forall a arg. (KeyValue a, ToJSON arg) => Job arg -> [a]
toPairs

toPairs :: (KeyValue a, ToJSON arg) => Job arg -> [a]
toPairs :: Job arg -> [a]
toPairs Job {JobId
Maybe UTCTime
NonEmpty arg
JobOptions
jobOptions :: JobOptions
jobArgs :: NonEmpty arg
jobAt :: Maybe UTCTime
jobJid :: JobId
jobArgs :: forall arg. Job arg -> NonEmpty arg
jobAt :: forall arg. Job arg -> Maybe UTCTime
jobOptions :: forall arg. Job arg -> JobOptions
jobJid :: forall arg. Job arg -> JobId
..} =
  [ Text
"jid" Text -> JobId -> a
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= JobId
jobJid
  , Text
"at" Text -> Maybe UTCTime -> a
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe UTCTime
jobAt
  , Text
"args" Text -> NonEmpty arg -> a
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= NonEmpty arg
jobArgs
  , Text
"jobtype" Text -> Maybe (Last JobId) -> a
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= JobOptions -> Maybe (Last JobId)
joJobtype JobOptions
jobOptions
  , Text
"retry" Text -> Maybe (Last Int) -> a
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= JobOptions -> Maybe (Last Int)
joRetry JobOptions
jobOptions
  , Text
"queue" Text -> Maybe (Last Queue) -> a
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= JobOptions -> Maybe (Last Queue)
joQueue JobOptions
jobOptions
  , Text
"custom" Text -> Maybe Custom -> a
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= JobOptions -> Maybe Custom
joCustom JobOptions
jobOptions
  ]

-- brittany-disable-next-binding

instance FromJSON args => FromJSON (Job args) where
  parseJSON :: Value -> Parser (Job args)
parseJSON = JobId
-> (Object -> Parser (Job args)) -> Value -> Parser (Job args)
forall a. JobId -> (Object -> Parser a) -> Value -> Parser a
withObject JobId
"Job" ((Object -> Parser (Job args)) -> Value -> Parser (Job args))
-> (Object -> Parser (Job args)) -> Value -> Parser (Job args)
forall a b. (a -> b) -> a -> b
$ \Object
o -> JobId -> Maybe UTCTime -> NonEmpty args -> JobOptions -> Job args
forall arg.
JobId -> Maybe UTCTime -> NonEmpty arg -> JobOptions -> Job arg
Job
    (JobId -> Maybe UTCTime -> NonEmpty args -> JobOptions -> Job args)
-> Parser JobId
-> Parser
     (Maybe UTCTime -> NonEmpty args -> JobOptions -> Job args)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser JobId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"jid"
    Parser (Maybe UTCTime -> NonEmpty args -> JobOptions -> Job args)
-> Parser (Maybe UTCTime)
-> Parser (NonEmpty args -> JobOptions -> Job args)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"at"
    Parser (NonEmpty args -> JobOptions -> Job args)
-> Parser (NonEmpty args) -> Parser (JobOptions -> Job args)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (NonEmpty args)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"args"
    Parser (JobOptions -> Job args)
-> Parser JobOptions -> Parser (Job args)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser JobOptions
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)

type JobId = String