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

import Faktory.Prelude

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
$cto :: forall x. Rep BatchStatus x -> BatchStatus
$cfrom :: forall x. BatchStatus -> Rep BatchStatus x
Generic
  deriving anyclass Value -> Parser [BatchStatus]
Value -> Parser BatchStatus
(Value -> Parser BatchStatus)
-> (Value -> Parser [BatchStatus]) -> FromJSON BatchStatus
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [BatchStatus]
$cparseJSONList :: Value -> Parser [BatchStatus]
parseJSON :: Value -> Parser BatchStatus
$cparseJSON :: Value -> Parser BatchStatus
FromJSON

newtype ReadCustomBatchId = ReadCustomBatchId
  { ReadCustomBatchId -> BatchId
_bid :: BatchId
  }
  deriving stock (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
$cto :: forall x. Rep ReadCustomBatchId x -> ReadCustomBatchId
$cfrom :: forall x. ReadCustomBatchId -> Rep ReadCustomBatchId x
Generic
  deriving anyclass Value -> Parser [ReadCustomBatchId]
Value -> Parser ReadCustomBatchId
(Value -> Parser ReadCustomBatchId)
-> (Value -> Parser [ReadCustomBatchId])
-> FromJSON ReadCustomBatchId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ReadCustomBatchId]
$cparseJSONList :: Value -> Parser [ReadCustomBatchId]
parseJSON :: Value -> Parser ReadCustomBatchId
$cparseJSON :: Value -> Parser ReadCustomBatchId
FromJSON

jobBatchId :: Job arg -> Maybe BatchId
jobBatchId :: 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]