{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures    #-}

module GitHub.Data.Actions.WorkflowJobs (
    JobStep(..),
    Job(..),
    ) where

import Prelude ()
import GitHub.Internal.Prelude
       (Applicative ((<*>)), Data, Eq, FromJSON (parseJSON), Generic, Integer,
       Ord, Show, Text, Typeable, UTCTime, Vector, withObject, ($), (.:),
       (<$>))

import GitHub.Data.Id                   (Id)
import GitHub.Data.Name                 (Name)
import GitHub.Data.URL                  (URL)

import GitHub.Data.Actions.Common       (WithTotalCount (WithTotalCount))
import GitHub.Data.Actions.WorkflowRuns (WorkflowRun)

-------------------------------------------------------------------------------
-- Workflow jobs
-------------------------------------------------------------------------------

data JobStep = JobStep
    { JobStep -> Name JobStep
jobStepName        :: !(Name JobStep)
    , JobStep -> Text
jobStepStatus      :: !Text
    , JobStep -> Text
jobStepConclusion  :: !Text
    , JobStep -> Integer
jobStepNumber      :: !Integer
    , JobStep -> UTCTime
jobStepStartedAt   :: !UTCTime
    , JobStep -> UTCTime
jobStepCompletedAt :: !UTCTime
    }
  deriving (Int -> JobStep -> ShowS
[JobStep] -> ShowS
JobStep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JobStep] -> ShowS
$cshowList :: [JobStep] -> ShowS
show :: JobStep -> String
$cshow :: JobStep -> String
showsPrec :: Int -> JobStep -> ShowS
$cshowsPrec :: Int -> JobStep -> ShowS
Show, Typeable JobStep
JobStep -> DataType
JobStep -> Constr
(forall b. Data b => b -> b) -> JobStep -> JobStep
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> JobStep -> u
forall u. (forall d. Data d => d -> u) -> JobStep -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JobStep -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JobStep -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JobStep -> m JobStep
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JobStep -> m JobStep
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JobStep
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JobStep -> c JobStep
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JobStep)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JobStep)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JobStep -> m JobStep
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JobStep -> m JobStep
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JobStep -> m JobStep
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JobStep -> m JobStep
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JobStep -> m JobStep
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JobStep -> m JobStep
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JobStep -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JobStep -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> JobStep -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JobStep -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JobStep -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JobStep -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JobStep -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JobStep -> r
gmapT :: (forall b. Data b => b -> b) -> JobStep -> JobStep
$cgmapT :: (forall b. Data b => b -> b) -> JobStep -> JobStep
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JobStep)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JobStep)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JobStep)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JobStep)
dataTypeOf :: JobStep -> DataType
$cdataTypeOf :: JobStep -> DataType
toConstr :: JobStep -> Constr
$ctoConstr :: JobStep -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JobStep
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JobStep
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JobStep -> c JobStep
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JobStep -> c JobStep
Data, Typeable, JobStep -> JobStep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JobStep -> JobStep -> Bool
$c/= :: JobStep -> JobStep -> Bool
== :: JobStep -> JobStep -> Bool
$c== :: JobStep -> JobStep -> Bool
Eq, Eq JobStep
JobStep -> JobStep -> Bool
JobStep -> JobStep -> Ordering
JobStep -> JobStep -> JobStep
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: JobStep -> JobStep -> JobStep
$cmin :: JobStep -> JobStep -> JobStep
max :: JobStep -> JobStep -> JobStep
$cmax :: JobStep -> JobStep -> JobStep
>= :: JobStep -> JobStep -> Bool
$c>= :: JobStep -> JobStep -> Bool
> :: JobStep -> JobStep -> Bool
$c> :: JobStep -> JobStep -> Bool
<= :: JobStep -> JobStep -> Bool
$c<= :: JobStep -> JobStep -> Bool
< :: JobStep -> JobStep -> Bool
$c< :: JobStep -> JobStep -> Bool
compare :: JobStep -> JobStep -> Ordering
$ccompare :: JobStep -> JobStep -> Ordering
Ord, forall x. Rep JobStep x -> JobStep
forall x. JobStep -> Rep JobStep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JobStep x -> JobStep
$cfrom :: forall x. JobStep -> Rep JobStep x
Generic)

data Job = Job
    { Job -> Id Job
jobId              :: !(Id Job)
    , Job -> Id WorkflowRun
jobRunId           :: !(Id WorkflowRun)
    , Job -> URL
jobRunUrl          :: !URL
    , Job -> Integer
jobRunAttempt      :: !Integer
    , Job -> Text
jobNodeId          :: !Text
    , Job -> Text
jobHeadSha         :: !Text
    , Job -> URL
jobUrl             :: !URL
    , Job -> URL
jobHtmlUrl         :: !URL
    , Job -> Text
jobStatus          :: !Text
    , Job -> Text
jobConclusion      :: !Text
    , Job -> UTCTime
jobStartedAt       :: !UTCTime
    , Job -> UTCTime
jobCompletedAt     :: !UTCTime
    , Job -> Vector JobStep
jobSteps           :: !(Vector JobStep)
    , Job -> URL
jobRunCheckUrl     :: !URL
    , Job -> Vector Text
jobLabels          :: !(Vector Text)
    , Job -> Integer
jobRunnerId        :: !Integer
    , Job -> Text
jobRunnerName      :: !Text
    , Job -> Integer
jobRunnerGroupId   :: !Integer
    , Job -> Text
jobRunnerGroupName :: !Text
    }
  deriving (Int -> Job -> ShowS
[Job] -> ShowS
Job -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Job] -> ShowS
$cshowList :: [Job] -> ShowS
show :: Job -> String
$cshow :: Job -> String
showsPrec :: Int -> Job -> ShowS
$cshowsPrec :: Int -> Job -> ShowS
Show, Typeable Job
Job -> DataType
Job -> Constr
(forall b. Data b => b -> b) -> Job -> Job
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Job -> u
forall u. (forall d. Data d => d -> u) -> Job -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Job -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Job -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Job -> m Job
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Job -> m Job
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Job
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Job -> c Job
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Job)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Job)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Job -> m Job
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Job -> m Job
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Job -> m Job
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Job -> m Job
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Job -> m Job
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Job -> m Job
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Job -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Job -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Job -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Job -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Job -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Job -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Job -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Job -> r
gmapT :: (forall b. Data b => b -> b) -> Job -> Job
$cgmapT :: (forall b. Data b => b -> b) -> Job -> Job
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Job)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Job)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Job)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Job)
dataTypeOf :: Job -> DataType
$cdataTypeOf :: Job -> DataType
toConstr :: Job -> Constr
$ctoConstr :: Job -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Job
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Job
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Job -> c Job
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Job -> c Job
Data, Typeable, Job -> Job -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Job -> Job -> Bool
$c/= :: Job -> Job -> Bool
== :: Job -> Job -> Bool
$c== :: Job -> Job -> Bool
Eq, Eq Job
Job -> Job -> Bool
Job -> Job -> Ordering
Job -> Job -> Job
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Job -> Job -> Job
$cmin :: Job -> Job -> Job
max :: Job -> Job -> Job
$cmax :: Job -> Job -> Job
>= :: Job -> Job -> Bool
$c>= :: Job -> Job -> Bool
> :: Job -> Job -> Bool
$c> :: Job -> Job -> Bool
<= :: Job -> Job -> Bool
$c<= :: Job -> Job -> Bool
< :: Job -> Job -> Bool
$c< :: Job -> Job -> Bool
compare :: Job -> Job -> Ordering
$ccompare :: Job -> Job -> Ordering
Ord, forall x. Rep Job x -> Job
forall x. Job -> Rep Job x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Job x -> Job
$cfrom :: forall x. Job -> Rep Job x
Generic)

-------------------------------------------------------------------------------
-- JSON instances
-------------------------------------------------------------------------------

instance FromJSON JobStep where
    parseJSON :: Value -> Parser JobStep
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JobStep" forall a b. (a -> b) -> a -> b
$ \Object
o -> Name JobStep
-> Text -> Text -> Integer -> UTCTime -> UTCTime -> JobStep
JobStep
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"conclusion"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"started_at"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"completed_at"

instance FromJSON Job where
    parseJSON :: Value -> Parser Job
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Job" forall a b. (a -> b) -> a -> b
$ \Object
o -> Id Job
-> Id WorkflowRun
-> URL
-> Integer
-> Text
-> Text
-> URL
-> URL
-> Text
-> Text
-> UTCTime
-> UTCTime
-> Vector JobStep
-> URL
-> Vector Text
-> Integer
-> Text
-> Integer
-> Text
-> Job
Job
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"run_id"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"run_url"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"run_attempt"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"head_sha"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"html_url"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"conclusion"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"started_at"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"completed_at"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"steps"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"check_run_url"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"labels"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"runner_id"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"runner_name"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"runner_group_id"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"runner_group_name"

instance FromJSON (WithTotalCount Job) where
    parseJSON :: Value -> Parser (WithTotalCount Job)
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JobList" forall a b. (a -> b) -> a -> b
$ \Object
o -> forall a. Vector a -> Int -> WithTotalCount a
WithTotalCount
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"jobs"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_count"