module Faktory.Ent.Batch.Status
  ( jobBatchId
  , BatchStatus (..)
  , batchStatus
  ) where

import Faktory.Prelude

import Control.Applicative ((<|>))
import Control.Error.Util (hush)
import Data.Aeson
import Data.ByteString.Lazy as BSL
import Data.Text.Encoding (encodeUtf8)
import Data.Time (UTCTime)
import Faktory.Client
import Faktory.Ent.Batch
import Faktory.Job (Job, jobOptions)
import Faktory.Job.Custom
import Faktory.JobOptions (JobOptions (..))
import Faktory.Producer
import GHC.Generics

data BatchStatus = BatchStatus
  { BatchStatus -> BatchId
bid :: BatchId
  , BatchStatus -> Int
total :: Int
  , BatchStatus -> Int
pending :: Int
  , BatchStatus -> Int
failed :: Int
  , BatchStatus -> UTCTime
created_at :: UTCTime
  , BatchStatus -> Text
description :: Text
  }
  deriving stock ((forall x. BatchStatus -> Rep BatchStatus x)
-> (forall x. Rep BatchStatus x -> BatchStatus)
-> Generic BatchStatus
forall x. Rep BatchStatus x -> BatchStatus
forall x. BatchStatus -> Rep BatchStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BatchStatus -> Rep BatchStatus x
from :: forall x. BatchStatus -> Rep BatchStatus x
$cto :: forall x. Rep BatchStatus x -> BatchStatus
to :: forall x. Rep BatchStatus x -> BatchStatus
Generic)
  deriving anyclass (Maybe BatchStatus
Value -> Parser [BatchStatus]
Value -> Parser BatchStatus
(Value -> Parser BatchStatus)
-> (Value -> Parser [BatchStatus])
-> Maybe BatchStatus
-> FromJSON BatchStatus
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser BatchStatus
parseJSON :: Value -> Parser BatchStatus
$cparseJSONList :: Value -> Parser [BatchStatus]
parseJSONList :: Value -> Parser [BatchStatus]
$comittedField :: Maybe BatchStatus
omittedField :: Maybe BatchStatus
FromJSON)

newtype ReadCustomBatchId = ReadCustomBatchId
  { ReadCustomBatchId -> BatchId
_bid :: BatchId
  }
  deriving stock (Int -> ReadCustomBatchId -> ShowS
[ReadCustomBatchId] -> ShowS
ReadCustomBatchId -> String
(Int -> ReadCustomBatchId -> ShowS)
-> (ReadCustomBatchId -> String)
-> ([ReadCustomBatchId] -> ShowS)
-> Show ReadCustomBatchId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReadCustomBatchId -> ShowS
showsPrec :: Int -> ReadCustomBatchId -> ShowS
$cshow :: ReadCustomBatchId -> String
show :: ReadCustomBatchId -> String
$cshowList :: [ReadCustomBatchId] -> ShowS
showList :: [ReadCustomBatchId] -> ShowS
Show, ReadCustomBatchId -> ReadCustomBatchId -> Bool
(ReadCustomBatchId -> ReadCustomBatchId -> Bool)
-> (ReadCustomBatchId -> ReadCustomBatchId -> Bool)
-> Eq ReadCustomBatchId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReadCustomBatchId -> ReadCustomBatchId -> Bool
== :: ReadCustomBatchId -> ReadCustomBatchId -> Bool
$c/= :: ReadCustomBatchId -> ReadCustomBatchId -> Bool
/= :: ReadCustomBatchId -> ReadCustomBatchId -> Bool
Eq, (forall x. ReadCustomBatchId -> Rep ReadCustomBatchId x)
-> (forall x. Rep ReadCustomBatchId x -> ReadCustomBatchId)
-> Generic ReadCustomBatchId
forall x. Rep ReadCustomBatchId x -> ReadCustomBatchId
forall x. ReadCustomBatchId -> Rep ReadCustomBatchId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReadCustomBatchId -> Rep ReadCustomBatchId x
from :: forall x. ReadCustomBatchId -> Rep ReadCustomBatchId x
$cto :: forall x. Rep ReadCustomBatchId x -> ReadCustomBatchId
to :: forall x. Rep ReadCustomBatchId x -> ReadCustomBatchId
Generic)

instance FromJSON ReadCustomBatchId where
  -- Faktory seems to use the key '_bid' when enqueuing callback jobs and 'bid' for normal jobs...
  parseJSON :: Value -> Parser ReadCustomBatchId
parseJSON Value
v = Key -> Value -> Parser ReadCustomBatchId
withParser Key
"_bid" Value
v Parser ReadCustomBatchId
-> Parser ReadCustomBatchId -> Parser ReadCustomBatchId
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Key -> Value -> Parser ReadCustomBatchId
withParser Key
"bid" Value
v
   where
    withParser :: Key -> Value -> Parser ReadCustomBatchId
withParser Key
s =
      String
-> (Object -> Parser ReadCustomBatchId)
-> Value
-> Parser ReadCustomBatchId
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ReadCustomBatchId" ((Object -> Parser ReadCustomBatchId)
 -> Value -> Parser ReadCustomBatchId)
-> (Object -> Parser ReadCustomBatchId)
-> Value
-> Parser ReadCustomBatchId
forall a b. (a -> b) -> a -> b
$ \Object
o -> BatchId -> ReadCustomBatchId
ReadCustomBatchId (BatchId -> ReadCustomBatchId)
-> Parser BatchId -> Parser ReadCustomBatchId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser BatchId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
s

jobBatchId :: Job arg -> Maybe BatchId
jobBatchId :: forall arg. Job arg -> Maybe BatchId
jobBatchId Job arg
job = do
  Custom
custom <- JobOptions -> Maybe Custom
joCustom (JobOptions -> Maybe Custom) -> JobOptions -> Maybe Custom
forall a b. (a -> b) -> a -> b
$ Job arg -> JobOptions
forall arg. Job arg -> JobOptions
jobOptions Job arg
job
  ReadCustomBatchId -> BatchId
_bid (ReadCustomBatchId -> BatchId)
-> Maybe ReadCustomBatchId -> Maybe BatchId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String ReadCustomBatchId -> Maybe ReadCustomBatchId
forall a b. Either a b -> Maybe b
hush (Custom -> Either String ReadCustomBatchId
forall a. FromJSON a => Custom -> Either String a
fromCustom Custom
custom)

batchStatus :: Producer -> BatchId -> IO (Either String (Maybe BatchStatus))
batchStatus :: Producer -> BatchId -> IO (Either String (Maybe BatchStatus))
batchStatus Producer
producer (BatchId Text
bid) =
  Client
-> ByteString
-> [ByteString]
-> IO (Either String (Maybe BatchStatus))
forall a.
FromJSON a =>
Client
-> ByteString -> [ByteString] -> IO (Either String (Maybe a))
commandJSON
    (Producer -> Client
producerClient Producer
producer)
    ByteString
"BATCH STATUS"
    [ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
bid]