{-# 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
(Int -> JobStep -> ShowS)
-> (JobStep -> String) -> ([JobStep] -> ShowS) -> Show JobStep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JobStep -> ShowS
showsPrec :: Int -> JobStep -> ShowS
$cshow :: JobStep -> String
show :: JobStep -> String
$cshowList :: [JobStep] -> ShowS
showList :: [JobStep] -> ShowS
Show, Typeable JobStep
Typeable JobStep =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> JobStep -> c JobStep)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JobStep)
-> (JobStep -> Constr)
-> (JobStep -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> JobStep -> JobStep)
-> (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 u. (forall d. Data d => d -> u) -> JobStep -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> JobStep -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JobStep -> m JobStep)
-> Data JobStep
JobStep -> Constr
JobStep -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JobStep -> c JobStep
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JobStep -> c JobStep
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JobStep
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JobStep
$ctoConstr :: JobStep -> Constr
toConstr :: JobStep -> Constr
$cdataTypeOf :: JobStep -> DataType
dataTypeOf :: JobStep -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JobStep)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JobStep)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JobStep)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JobStep)
$cgmapT :: (forall b. Data b => b -> b) -> JobStep -> JobStep
gmapT :: (forall b. Data b => b -> b) -> JobStep -> JobStep
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JobStep -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JobStep -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JobStep -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> JobStep -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JobStep -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JobStep -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JobStep -> m JobStep
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JobStep -> m JobStep
Data, Typeable, JobStep -> JobStep -> Bool
(JobStep -> JobStep -> Bool)
-> (JobStep -> JobStep -> Bool) -> Eq JobStep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JobStep -> JobStep -> Bool
== :: JobStep -> JobStep -> Bool
$c/= :: JobStep -> JobStep -> Bool
/= :: JobStep -> JobStep -> Bool
Eq, Eq JobStep
Eq JobStep =>
(JobStep -> JobStep -> Ordering)
-> (JobStep -> JobStep -> Bool)
-> (JobStep -> JobStep -> Bool)
-> (JobStep -> JobStep -> Bool)
-> (JobStep -> JobStep -> Bool)
-> (JobStep -> JobStep -> JobStep)
-> (JobStep -> JobStep -> JobStep)
-> Ord 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
$ccompare :: JobStep -> JobStep -> Ordering
compare :: JobStep -> JobStep -> Ordering
$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
>= :: JobStep -> JobStep -> Bool
$cmax :: JobStep -> JobStep -> JobStep
max :: JobStep -> JobStep -> JobStep
$cmin :: JobStep -> JobStep -> JobStep
min :: JobStep -> JobStep -> JobStep
Ord, (forall x. JobStep -> Rep JobStep x)
-> (forall x. Rep JobStep x -> JobStep) -> Generic JobStep
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
$cfrom :: forall x. JobStep -> Rep JobStep x
from :: forall x. JobStep -> Rep JobStep x
$cto :: forall x. Rep JobStep x -> JobStep
to :: forall x. Rep JobStep x -> JobStep
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
(Int -> Job -> ShowS)
-> (Job -> String) -> ([Job] -> ShowS) -> Show Job
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Job -> ShowS
showsPrec :: Int -> Job -> ShowS
$cshow :: Job -> String
show :: Job -> String
$cshowList :: [Job] -> ShowS
showList :: [Job] -> ShowS
Show, Typeable Job
Typeable Job =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Job -> c Job)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Job)
-> (Job -> Constr)
-> (Job -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Job -> Job)
-> (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 u. (forall d. Data d => d -> u) -> Job -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Job -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Job -> m Job)
-> Data Job
Job -> Constr
Job -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Job -> c Job
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Job -> c Job
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Job
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Job
$ctoConstr :: Job -> Constr
toConstr :: Job -> Constr
$cdataTypeOf :: Job -> DataType
dataTypeOf :: Job -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Job)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Job)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Job)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Job)
$cgmapT :: (forall b. Data b => b -> b) -> Job -> Job
gmapT :: (forall b. Data b => b -> b) -> Job -> Job
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Job -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Job -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Job -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Job -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Job -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Job -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Job -> m Job
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Job -> m Job
Data, Typeable, Job -> Job -> Bool
(Job -> Job -> Bool) -> (Job -> Job -> Bool) -> Eq Job
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Job -> Job -> Bool
== :: Job -> Job -> Bool
$c/= :: Job -> Job -> Bool
/= :: Job -> Job -> Bool
Eq, Eq Job
Eq Job =>
(Job -> Job -> Ordering)
-> (Job -> Job -> Bool)
-> (Job -> Job -> Bool)
-> (Job -> Job -> Bool)
-> (Job -> Job -> Bool)
-> (Job -> Job -> Job)
-> (Job -> Job -> Job)
-> Ord 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
$ccompare :: Job -> Job -> Ordering
compare :: Job -> Job -> Ordering
$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
>= :: Job -> Job -> Bool
$cmax :: Job -> Job -> Job
max :: Job -> Job -> Job
$cmin :: Job -> Job -> Job
min :: Job -> Job -> Job
Ord, (forall x. Job -> Rep Job x)
-> (forall x. Rep Job x -> Job) -> Generic Job
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
$cfrom :: forall x. Job -> Rep Job x
from :: forall x. Job -> Rep Job x
$cto :: forall x. Rep Job x -> Job
to :: forall x. Rep Job x -> Job
Generic)

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

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

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

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