{-# LANGUAGE OverloadedStrings #-}

module Database.Bloodhound.Internal.Versions.Common.Types.Task where

import Data.Aeson
import Data.Text (Text)
import GHC.Generics
import Optics.Lens

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 stock (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, 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, (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)

instance (FromJSON a) => FromJSON (TaskResponse a) where
  parseJSON :: Value -> Parser (TaskResponse a)
parseJSON = String
-> (Object -> Parser (TaskResponse a))
-> Value
-> Parser (TaskResponse a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TaskResponse" ((Object -> Parser (TaskResponse a))
 -> Value -> Parser (TaskResponse a))
-> (Object -> Parser (TaskResponse a))
-> Value
-> Parser (TaskResponse a)
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Bool -> Task a -> Maybe a -> Maybe Object -> TaskResponse a
forall a.
Bool -> Task a -> Maybe a -> Maybe Object -> TaskResponse a
TaskResponse
      (Bool -> Task a -> Maybe a -> Maybe Object -> TaskResponse a)
-> Parser Bool
-> Parser (Task a -> Maybe a -> Maybe Object -> TaskResponse a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"completed"
      Parser (Task a -> Maybe a -> Maybe Object -> TaskResponse a)
-> Parser (Task a)
-> Parser (Maybe a -> Maybe Object -> TaskResponse a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Task a)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"task"
      Parser (Maybe a -> Maybe Object -> TaskResponse a)
-> Parser (Maybe a) -> Parser (Maybe Object -> TaskResponse a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe a)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"reponse"
      Parser (Maybe Object -> TaskResponse a)
-> Parser (Maybe Object) -> Parser (TaskResponse a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error"

taskResponseCompletedLens :: Lens' (TaskResponse a) Bool
taskResponseCompletedLens :: forall a. Lens' (TaskResponse a) Bool
taskResponseCompletedLens = (TaskResponse a -> Bool)
-> (TaskResponse a -> Bool -> TaskResponse a)
-> Lens (TaskResponse a) (TaskResponse a) Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TaskResponse a -> Bool
forall a. TaskResponse a -> Bool
taskResponseCompleted (\TaskResponse a
x Bool
y -> TaskResponse a
x {taskResponseCompleted = y})

taskResponseTaskLens :: Lens' (TaskResponse a) (Task a)
taskResponseTaskLens :: forall a. Lens' (TaskResponse a) (Task a)
taskResponseTaskLens = (TaskResponse a -> Task a)
-> (TaskResponse a -> Task a -> TaskResponse a)
-> Lens (TaskResponse a) (TaskResponse a) (Task a) (Task a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TaskResponse a -> Task a
forall a. TaskResponse a -> Task a
taskResponseTask (\TaskResponse a
x Task a
y -> TaskResponse a
x {taskResponseTask = y})

taskResponseReponseLens :: Lens' (TaskResponse a) (Maybe a)
taskResponseReponseLens :: forall a. Lens' (TaskResponse a) (Maybe a)
taskResponseReponseLens = (TaskResponse a -> Maybe a)
-> (TaskResponse a -> Maybe a -> TaskResponse a)
-> Lens (TaskResponse a) (TaskResponse a) (Maybe a) (Maybe a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TaskResponse a -> Maybe a
forall a. TaskResponse a -> Maybe a
taskResponseReponse (\TaskResponse a
x Maybe a
y -> TaskResponse a
x {taskResponseReponse = y})

taskResponseErrorLens :: Lens' (TaskResponse a) (Maybe Object)
taskResponseErrorLens :: forall a. Lens' (TaskResponse a) (Maybe Object)
taskResponseErrorLens = (TaskResponse a -> Maybe Object)
-> (TaskResponse a -> Maybe Object -> TaskResponse a)
-> Lens
     (TaskResponse a) (TaskResponse a) (Maybe Object) (Maybe Object)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TaskResponse a -> Maybe Object
forall a. TaskResponse a -> Maybe Object
taskResponseError (\TaskResponse a
x Maybe Object
y -> TaskResponse a
x {taskResponseError = y})

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 stock (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, 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, (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)

instance (FromJSON a) => FromJSON (Task a) where
  parseJSON :: Value -> Parser (Task a)
parseJSON = String -> (Object -> Parser (Task a)) -> Value -> Parser (Task a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Task" ((Object -> Parser (Task a)) -> Value -> Parser (Task a))
-> (Object -> Parser (Task a)) -> Value -> Parser (Task a)
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Text
-> Int
-> Text
-> Text
-> a
-> Text
-> Integer
-> Integer
-> Bool
-> Task a
forall a.
Text
-> Int
-> Text
-> Text
-> a
-> Text
-> Integer
-> Integer
-> Bool
-> Task a
Task
      (Text
 -> Int
 -> Text
 -> Text
 -> a
 -> Text
 -> Integer
 -> Integer
 -> Bool
 -> Task a)
-> Parser Text
-> Parser
     (Int
      -> Text
      -> Text
      -> a
      -> Text
      -> Integer
      -> Integer
      -> Bool
      -> Task a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node"
      Parser
  (Int
   -> Text
   -> Text
   -> a
   -> Text
   -> Integer
   -> Integer
   -> Bool
   -> Task a)
-> Parser Int
-> Parser
     (Text -> Text -> a -> Text -> Integer -> Integer -> Bool -> Task a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      Parser
  (Text -> Text -> a -> Text -> Integer -> Integer -> Bool -> Task a)
-> Parser Text
-> Parser
     (Text -> a -> Text -> Integer -> Integer -> Bool -> Task a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      Parser (Text -> a -> Text -> Integer -> Integer -> Bool -> Task a)
-> Parser Text
-> Parser (a -> Text -> Integer -> Integer -> Bool -> Task a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"action"
      Parser (a -> Text -> Integer -> Integer -> Bool -> Task a)
-> Parser a
-> Parser (Text -> Integer -> Integer -> Bool -> Task a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
      Parser (Text -> Integer -> Integer -> Bool -> Task a)
-> Parser Text -> Parser (Integer -> Integer -> Bool -> Task a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
      Parser (Integer -> Integer -> Bool -> Task a)
-> Parser Integer -> Parser (Integer -> Bool -> Task a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"start_time_in_millis"
      Parser (Integer -> Bool -> Task a)
-> Parser Integer -> Parser (Bool -> Task a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"running_time_in_nanos"
      Parser (Bool -> Task a) -> Parser Bool -> Parser (Task a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cancellable"

newtype TaskNodeId = TaskNodeId Text
  deriving stock (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, 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)

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"

taskNodeLens :: Lens' (Task a) Text
taskNodeLens :: forall a. Lens' (Task a) Text
taskNodeLens = (Task a -> Text)
-> (Task a -> Text -> Task a) -> Lens (Task a) (Task a) Text Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Task a -> Text
forall a. Task a -> Text
taskNode (\Task a
x Text
y -> Task a
x {taskNode = y})

taskIdLens :: Lens' (Task a) Int
taskIdLens :: forall a. Lens' (Task a) Int
taskIdLens = (Task a -> Int)
-> (Task a -> Int -> Task a) -> Lens (Task a) (Task a) Int Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Task a -> Int
forall a. Task a -> Int
taskId (\Task a
x Int
y -> Task a
x {taskId = y})

taskTypeLens :: Lens' (Task a) Text
taskTypeLens :: forall a. Lens' (Task a) Text
taskTypeLens = (Task a -> Text)
-> (Task a -> Text -> Task a) -> Lens (Task a) (Task a) Text Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Task a -> Text
forall a. Task a -> Text
taskType (\Task a
x Text
y -> Task a
x {taskType = y})

taskActionLens :: Lens' (Task a) Text
taskActionLens :: forall a. Lens' (Task a) Text
taskActionLens = (Task a -> Text)
-> (Task a -> Text -> Task a) -> Lens (Task a) (Task a) Text Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Task a -> Text
forall a. Task a -> Text
taskAction (\Task a
x Text
y -> Task a
x {taskAction = y})

taskStatusLens :: Lens' (Task a) a
taskStatusLens :: forall a. Lens' (Task a) a
taskStatusLens = (Task a -> a)
-> (Task a -> a -> Task a) -> Lens (Task a) (Task a) a a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Task a -> a
forall a. Task a -> a
taskStatus (\Task a
x a
y -> Task a
x {taskStatus = y})

taskDescriptionLens :: Lens' (Task a) Text
taskDescriptionLens :: forall a. Lens' (Task a) Text
taskDescriptionLens = (Task a -> Text)
-> (Task a -> Text -> Task a) -> Lens (Task a) (Task a) Text Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Task a -> Text
forall a. Task a -> Text
taskDescription (\Task a
x Text
y -> Task a
x {taskDescription = y})

taskStartTimeInMillisLens :: Lens' (Task a) Integer
taskStartTimeInMillisLens :: forall a. Lens' (Task a) Integer
taskStartTimeInMillisLens = (Task a -> Integer)
-> (Task a -> Integer -> Task a)
-> Lens (Task a) (Task a) Integer Integer
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Task a -> Integer
forall a. Task a -> Integer
taskStartTimeInMillis (\Task a
x Integer
y -> Task a
x {taskStartTimeInMillis = y})

taskRunningTimeInNanosLens :: Lens' (Task a) Integer
taskRunningTimeInNanosLens :: forall a. Lens' (Task a) Integer
taskRunningTimeInNanosLens = (Task a -> Integer)
-> (Task a -> Integer -> Task a)
-> Lens (Task a) (Task a) Integer Integer
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Task a -> Integer
forall a. Task a -> Integer
taskRunningTimeInNanos (\Task a
x Integer
y -> Task a
x {taskRunningTimeInNanos = y})

taskCancellableLens :: Lens' (Task a) Bool
taskCancellableLens :: forall a. Lens' (Task a) Bool
taskCancellableLens = (Task a -> Bool)
-> (Task a -> Bool -> Task a) -> Lens (Task a) (Task a) Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Task a -> Bool
forall a. Task a -> Bool
taskCancellable (\Task a
x Bool
y -> Task a
x {taskCancellable = y})