{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE DerivingVia       #-}
{-# LANGUAGE OverloadedStrings #-}
module Database.Bloodhound.Internal.Task where

import           Data.Aeson
import           Data.Text      (Text)
import           Deriving.Aeson

data TaskResponse a = TaskResponse { forall a. TaskResponse a -> Bool
taskResponseCompleted :: Bool
                                   , forall a. TaskResponse a -> Task a
taskResponseTask      :: Task a
                                   , forall a. TaskResponse a -> Maybe a
taskResponseReponse   :: Maybe a
                                   , forall a. TaskResponse a -> Maybe Object
taskResponseError     :: Maybe Object
                                   }
              deriving (Int -> TaskResponse a -> ShowS
[TaskResponse a] -> ShowS
TaskResponse a -> String
(Int -> TaskResponse a -> ShowS)
-> (TaskResponse a -> String)
-> ([TaskResponse a] -> ShowS)
-> Show (TaskResponse a)
forall a. Show a => Int -> TaskResponse a -> ShowS
forall a. Show a => [TaskResponse a] -> ShowS
forall a. Show a => TaskResponse a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> TaskResponse a -> ShowS
showsPrec :: Int -> TaskResponse a -> ShowS
$cshow :: forall a. Show a => TaskResponse a -> String
show :: TaskResponse a -> String
$cshowList :: forall a. Show a => [TaskResponse a] -> ShowS
showList :: [TaskResponse a] -> ShowS
Show, TaskResponse a -> TaskResponse a -> Bool
(TaskResponse a -> TaskResponse a -> Bool)
-> (TaskResponse a -> TaskResponse a -> Bool)
-> Eq (TaskResponse a)
forall a. Eq a => TaskResponse a -> TaskResponse a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => TaskResponse a -> TaskResponse a -> Bool
== :: TaskResponse a -> TaskResponse a -> Bool
$c/= :: forall a. Eq a => TaskResponse a -> TaskResponse a -> Bool
/= :: TaskResponse a -> TaskResponse a -> Bool
Eq, (forall x. TaskResponse a -> Rep (TaskResponse a) x)
-> (forall x. Rep (TaskResponse a) x -> TaskResponse a)
-> Generic (TaskResponse a)
forall x. Rep (TaskResponse a) x -> TaskResponse a
forall x. TaskResponse a -> Rep (TaskResponse a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (TaskResponse a) x -> TaskResponse a
forall a x. TaskResponse a -> Rep (TaskResponse a) x
$cfrom :: forall a x. TaskResponse a -> Rep (TaskResponse a) x
from :: forall x. TaskResponse a -> Rep (TaskResponse a) x
$cto :: forall a x. Rep (TaskResponse a) x -> TaskResponse a
to :: forall x. Rep (TaskResponse a) x -> TaskResponse a
Generic)
              deriving (Value -> Parser [TaskResponse a]
Value -> Parser (TaskResponse a)
(Value -> Parser (TaskResponse a))
-> (Value -> Parser [TaskResponse a]) -> FromJSON (TaskResponse a)
forall a. FromJSON a => Value -> Parser [TaskResponse a]
forall a. FromJSON a => Value -> Parser (TaskResponse a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: forall a. FromJSON a => Value -> Parser (TaskResponse a)
parseJSON :: Value -> Parser (TaskResponse a)
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [TaskResponse a]
parseJSONList :: Value -> Parser [TaskResponse a]
FromJSON)
              via CustomJSON '[ OmitNothingFields
                              , FieldLabelModifier (StripPrefix "taskResponse", CamelToSnake)
                              ] (TaskResponse a)

data Task a = Task { forall a. Task a -> Text
taskNode               :: Text
                   , forall a. Task a -> Int
taskId                 :: Int
                   , forall a. Task a -> Text
taskType               :: Text
                   , forall a. Task a -> Text
taskAction             :: Text
                   , forall a. Task a -> a
taskStatus             :: a
                   , forall a. Task a -> Text
taskDescription        :: Text
                   , forall a. Task a -> Integer
taskStartTimeInMillis  :: Integer
                   , forall a. Task a -> Integer
taskRunningTimeInNanos :: Integer
                   , forall a. Task a -> Bool
taskCancellable        :: Bool
                   }
              deriving (Int -> Task a -> ShowS
[Task a] -> ShowS
Task a -> String
(Int -> Task a -> ShowS)
-> (Task a -> String) -> ([Task a] -> ShowS) -> Show (Task a)
forall a. Show a => Int -> Task a -> ShowS
forall a. Show a => [Task a] -> ShowS
forall a. Show a => Task a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Task a -> ShowS
showsPrec :: Int -> Task a -> ShowS
$cshow :: forall a. Show a => Task a -> String
show :: Task a -> String
$cshowList :: forall a. Show a => [Task a] -> ShowS
showList :: [Task a] -> ShowS
Show, Task a -> Task a -> Bool
(Task a -> Task a -> Bool)
-> (Task a -> Task a -> Bool) -> Eq (Task a)
forall a. Eq a => Task a -> Task a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Task a -> Task a -> Bool
== :: Task a -> Task a -> Bool
$c/= :: forall a. Eq a => Task a -> Task a -> Bool
/= :: Task a -> Task a -> Bool
Eq, (forall x. Task a -> Rep (Task a) x)
-> (forall x. Rep (Task a) x -> Task a) -> Generic (Task a)
forall x. Rep (Task a) x -> Task a
forall x. Task a -> Rep (Task a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Task a) x -> Task a
forall a x. Task a -> Rep (Task a) x
$cfrom :: forall a x. Task a -> Rep (Task a) x
from :: forall x. Task a -> Rep (Task a) x
$cto :: forall a x. Rep (Task a) x -> Task a
to :: forall x. Rep (Task a) x -> Task a
Generic)
              deriving (Value -> Parser [Task a]
Value -> Parser (Task a)
(Value -> Parser (Task a))
-> (Value -> Parser [Task a]) -> FromJSON (Task a)
forall a. FromJSON a => Value -> Parser [Task a]
forall a. FromJSON a => Value -> Parser (Task a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: forall a. FromJSON a => Value -> Parser (Task a)
parseJSON :: Value -> Parser (Task a)
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [Task a]
parseJSONList :: Value -> Parser [Task a]
FromJSON)
              via CustomJSON '[ OmitNothingFields
                              , FieldLabelModifier (StripPrefix "task", CamelToSnake)
                              ] (Task a)

newtype TaskNodeId = TaskNodeId Text
                   deriving (Int -> TaskNodeId -> ShowS
[TaskNodeId] -> ShowS
TaskNodeId -> String
(Int -> TaskNodeId -> ShowS)
-> (TaskNodeId -> String)
-> ([TaskNodeId] -> ShowS)
-> Show TaskNodeId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TaskNodeId -> ShowS
showsPrec :: Int -> TaskNodeId -> ShowS
$cshow :: TaskNodeId -> String
show :: TaskNodeId -> String
$cshowList :: [TaskNodeId] -> ShowS
showList :: [TaskNodeId] -> ShowS
Show, TaskNodeId -> TaskNodeId -> Bool
(TaskNodeId -> TaskNodeId -> Bool)
-> (TaskNodeId -> TaskNodeId -> Bool) -> Eq TaskNodeId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TaskNodeId -> TaskNodeId -> Bool
== :: TaskNodeId -> TaskNodeId -> Bool
$c/= :: TaskNodeId -> TaskNodeId -> Bool
/= :: TaskNodeId -> TaskNodeId -> Bool
Eq)

instance FromJSON TaskNodeId where
  parseJSON :: Value -> Parser TaskNodeId
parseJSON = String
-> (Object -> Parser TaskNodeId) -> Value -> Parser TaskNodeId
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TaskNodeId" ((Object -> Parser TaskNodeId) -> Value -> Parser TaskNodeId)
-> (Object -> Parser TaskNodeId) -> Value -> Parser TaskNodeId
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> TaskNodeId
TaskNodeId (Text -> TaskNodeId) -> Parser Text -> Parser TaskNodeId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"task"