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. 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
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 (Int -> ReadCustomBatchId -> ShowS
[ReadCustomBatchId] -> ShowS
ReadCustomBatchId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadCustomBatchId] -> ShowS
$cshowList :: [ReadCustomBatchId] -> ShowS
show :: ReadCustomBatchId -> String
$cshow :: ReadCustomBatchId -> String
showsPrec :: Int -> ReadCustomBatchId -> ShowS
$cshowsPrec :: Int -> ReadCustomBatchId -> ShowS
Show,ReadCustomBatchId -> ReadCustomBatchId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadCustomBatchId -> ReadCustomBatchId -> Bool
$c/= :: ReadCustomBatchId -> ReadCustomBatchId -> Bool
== :: ReadCustomBatchId -> ReadCustomBatchId -> Bool
$c== :: ReadCustomBatchId -> ReadCustomBatchId -> Bool
Eq,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)

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 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 =
      forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ReadCustomBatchId" forall a b. (a -> b) -> a -> b
$ \Object
o -> BatchId -> ReadCustomBatchId
ReadCustomBatchId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o 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 forall a b. (a -> b) -> a -> b
$ forall arg. Job arg -> JobOptions
jobOptions Job arg
job
  ReadCustomBatchId -> BatchId
_bid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Either a b -> Maybe b
hush (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) = 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 forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
bid]