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

module GitHub.Data.Actions.WorkflowRuns (
    WorkflowRun(..),
    RunAttempt(..),
    ReviewHistory(..),
    ) where

import GitHub.Data.Actions.Common (WithTotalCount (WithTotalCount))
import GitHub.Data.Definitions
import GitHub.Data.URL            (URL)
import GitHub.Internal.Prelude
import Prelude ()

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

-------------------------------------------------------------------------------
-- Workflow runs
-------------------------------------------------------------------------------

data WorkflowRun  = WorkflowRun
    { WorkflowRun -> Id WorkflowRun
workflowRunWorkflowRunId :: !(Id WorkflowRun)
    , WorkflowRun -> Name WorkflowRun
workflowRunName :: !(Name WorkflowRun)
    , WorkflowRun -> Text
workflowRunHeadBranch :: !Text
    , WorkflowRun -> Text
workflowRunHeadSha :: !Text
    , WorkflowRun -> Text
workflowRunPath :: !Text
    , WorkflowRun -> Text
workflowRunDisplayTitle :: !Text
    , WorkflowRun -> Integer
workflowRunRunNumber :: !Integer
    , WorkflowRun -> Text
workflowRunEvent :: !Text
    , WorkflowRun -> Text
workflowRunStatus :: !Text
    , WorkflowRun -> Maybe Text
workflowRunConclusion :: !(Maybe Text)
    , WorkflowRun -> Integer
workflowRunWorkflowId :: !Integer
    , WorkflowRun -> URL
workflowRunUrl :: !URL
    , WorkflowRun -> URL
workflowRunHtmlUrl :: !URL
    , WorkflowRun -> UTCTime
workflowRunCreatedAt :: !UTCTime
    , WorkflowRun -> UTCTime
workflowRunUpdatedAt :: !UTCTime
    , WorkflowRun -> SimpleUser
workflowRunActor :: !SimpleUser
    , WorkflowRun -> Integer
workflowRunAttempt :: !Integer
    , WorkflowRun -> UTCTime
workflowRunStartedAt :: !UTCTime
    }
  deriving (Int -> WorkflowRun -> ShowS
[WorkflowRun] -> ShowS
WorkflowRun -> String
(Int -> WorkflowRun -> ShowS)
-> (WorkflowRun -> String)
-> ([WorkflowRun] -> ShowS)
-> Show WorkflowRun
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkflowRun -> ShowS
showsPrec :: Int -> WorkflowRun -> ShowS
$cshow :: WorkflowRun -> String
show :: WorkflowRun -> String
$cshowList :: [WorkflowRun] -> ShowS
showList :: [WorkflowRun] -> ShowS
Show, Typeable WorkflowRun
Typeable WorkflowRun =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> WorkflowRun -> c WorkflowRun)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c WorkflowRun)
-> (WorkflowRun -> Constr)
-> (WorkflowRun -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c WorkflowRun))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c WorkflowRun))
-> ((forall b. Data b => b -> b) -> WorkflowRun -> WorkflowRun)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> WorkflowRun -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> WorkflowRun -> r)
-> (forall u. (forall d. Data d => d -> u) -> WorkflowRun -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> WorkflowRun -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> WorkflowRun -> m WorkflowRun)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WorkflowRun -> m WorkflowRun)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WorkflowRun -> m WorkflowRun)
-> Data WorkflowRun
WorkflowRun -> Constr
WorkflowRun -> DataType
(forall b. Data b => b -> b) -> WorkflowRun -> WorkflowRun
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) -> WorkflowRun -> u
forall u. (forall d. Data d => d -> u) -> WorkflowRun -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WorkflowRun -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WorkflowRun -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WorkflowRun -> m WorkflowRun
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WorkflowRun -> m WorkflowRun
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WorkflowRun
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WorkflowRun -> c WorkflowRun
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WorkflowRun)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WorkflowRun)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WorkflowRun -> c WorkflowRun
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WorkflowRun -> c WorkflowRun
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WorkflowRun
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WorkflowRun
$ctoConstr :: WorkflowRun -> Constr
toConstr :: WorkflowRun -> Constr
$cdataTypeOf :: WorkflowRun -> DataType
dataTypeOf :: WorkflowRun -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WorkflowRun)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WorkflowRun)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WorkflowRun)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WorkflowRun)
$cgmapT :: (forall b. Data b => b -> b) -> WorkflowRun -> WorkflowRun
gmapT :: (forall b. Data b => b -> b) -> WorkflowRun -> WorkflowRun
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WorkflowRun -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WorkflowRun -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WorkflowRun -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WorkflowRun -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WorkflowRun -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> WorkflowRun -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WorkflowRun -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WorkflowRun -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WorkflowRun -> m WorkflowRun
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WorkflowRun -> m WorkflowRun
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WorkflowRun -> m WorkflowRun
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WorkflowRun -> m WorkflowRun
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WorkflowRun -> m WorkflowRun
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WorkflowRun -> m WorkflowRun
Data, Typeable, WorkflowRun -> WorkflowRun -> Bool
(WorkflowRun -> WorkflowRun -> Bool)
-> (WorkflowRun -> WorkflowRun -> Bool) -> Eq WorkflowRun
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WorkflowRun -> WorkflowRun -> Bool
== :: WorkflowRun -> WorkflowRun -> Bool
$c/= :: WorkflowRun -> WorkflowRun -> Bool
/= :: WorkflowRun -> WorkflowRun -> Bool
Eq, Eq WorkflowRun
Eq WorkflowRun =>
(WorkflowRun -> WorkflowRun -> Ordering)
-> (WorkflowRun -> WorkflowRun -> Bool)
-> (WorkflowRun -> WorkflowRun -> Bool)
-> (WorkflowRun -> WorkflowRun -> Bool)
-> (WorkflowRun -> WorkflowRun -> Bool)
-> (WorkflowRun -> WorkflowRun -> WorkflowRun)
-> (WorkflowRun -> WorkflowRun -> WorkflowRun)
-> Ord WorkflowRun
WorkflowRun -> WorkflowRun -> Bool
WorkflowRun -> WorkflowRun -> Ordering
WorkflowRun -> WorkflowRun -> WorkflowRun
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 :: WorkflowRun -> WorkflowRun -> Ordering
compare :: WorkflowRun -> WorkflowRun -> Ordering
$c< :: WorkflowRun -> WorkflowRun -> Bool
< :: WorkflowRun -> WorkflowRun -> Bool
$c<= :: WorkflowRun -> WorkflowRun -> Bool
<= :: WorkflowRun -> WorkflowRun -> Bool
$c> :: WorkflowRun -> WorkflowRun -> Bool
> :: WorkflowRun -> WorkflowRun -> Bool
$c>= :: WorkflowRun -> WorkflowRun -> Bool
>= :: WorkflowRun -> WorkflowRun -> Bool
$cmax :: WorkflowRun -> WorkflowRun -> WorkflowRun
max :: WorkflowRun -> WorkflowRun -> WorkflowRun
$cmin :: WorkflowRun -> WorkflowRun -> WorkflowRun
min :: WorkflowRun -> WorkflowRun -> WorkflowRun
Ord, (forall x. WorkflowRun -> Rep WorkflowRun x)
-> (forall x. Rep WorkflowRun x -> WorkflowRun)
-> Generic WorkflowRun
forall x. Rep WorkflowRun x -> WorkflowRun
forall x. WorkflowRun -> Rep WorkflowRun x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WorkflowRun -> Rep WorkflowRun x
from :: forall x. WorkflowRun -> Rep WorkflowRun x
$cto :: forall x. Rep WorkflowRun x -> WorkflowRun
to :: forall x. Rep WorkflowRun x -> WorkflowRun
Generic)

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

data ReviewHistory  = ReviewHistory
    { ReviewHistory -> Text
reviewHistoryState :: !Text
    , ReviewHistory -> Text
reviewHistoryComment :: !Text
    , ReviewHistory -> SimpleUser
reviewHistoryUser :: !SimpleUser

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

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

instance FromJSON WorkflowRun where
    parseJSON :: Value -> Parser WorkflowRun
parseJSON = String
-> (Object -> Parser WorkflowRun) -> Value -> Parser WorkflowRun
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"WorkflowRun" ((Object -> Parser WorkflowRun) -> Value -> Parser WorkflowRun)
-> (Object -> Parser WorkflowRun) -> Value -> Parser WorkflowRun
forall a b. (a -> b) -> a -> b
$ \Object
o -> Id WorkflowRun
-> Name WorkflowRun
-> Text
-> Text
-> Text
-> Text
-> Integer
-> Text
-> Text
-> Maybe Text
-> Integer
-> URL
-> URL
-> UTCTime
-> UTCTime
-> SimpleUser
-> Integer
-> UTCTime
-> WorkflowRun
WorkflowRun
        (Id WorkflowRun
 -> Name WorkflowRun
 -> Text
 -> Text
 -> Text
 -> Text
 -> Integer
 -> Text
 -> Text
 -> Maybe Text
 -> Integer
 -> URL
 -> URL
 -> UTCTime
 -> UTCTime
 -> SimpleUser
 -> Integer
 -> UTCTime
 -> WorkflowRun)
-> Parser (Id WorkflowRun)
-> Parser
     (Name WorkflowRun
      -> Text
      -> Text
      -> Text
      -> Text
      -> Integer
      -> Text
      -> Text
      -> Maybe Text
      -> Integer
      -> URL
      -> URL
      -> UTCTime
      -> UTCTime
      -> SimpleUser
      -> Integer
      -> UTCTime
      -> WorkflowRun)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Id WorkflowRun)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        Parser
  (Name WorkflowRun
   -> Text
   -> Text
   -> Text
   -> Text
   -> Integer
   -> Text
   -> Text
   -> Maybe Text
   -> Integer
   -> URL
   -> URL
   -> UTCTime
   -> UTCTime
   -> SimpleUser
   -> Integer
   -> UTCTime
   -> WorkflowRun)
-> Parser (Name WorkflowRun)
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Integer
      -> Text
      -> Text
      -> Maybe Text
      -> Integer
      -> URL
      -> URL
      -> UTCTime
      -> UTCTime
      -> SimpleUser
      -> Integer
      -> UTCTime
      -> WorkflowRun)
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 (Name WorkflowRun)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
        Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Integer
   -> Text
   -> Text
   -> Maybe Text
   -> Integer
   -> URL
   -> URL
   -> UTCTime
   -> UTCTime
   -> SimpleUser
   -> Integer
   -> UTCTime
   -> WorkflowRun)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Integer
      -> Text
      -> Text
      -> Maybe Text
      -> Integer
      -> URL
      -> URL
      -> UTCTime
      -> UTCTime
      -> SimpleUser
      -> Integer
      -> UTCTime
      -> WorkflowRun)
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_branch"
        Parser
  (Text
   -> Text
   -> Text
   -> Integer
   -> Text
   -> Text
   -> Maybe Text
   -> Integer
   -> URL
   -> URL
   -> UTCTime
   -> UTCTime
   -> SimpleUser
   -> Integer
   -> UTCTime
   -> WorkflowRun)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Integer
      -> Text
      -> Text
      -> Maybe Text
      -> Integer
      -> URL
      -> URL
      -> UTCTime
      -> UTCTime
      -> SimpleUser
      -> Integer
      -> UTCTime
      -> WorkflowRun)
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
  (Text
   -> Text
   -> Integer
   -> Text
   -> Text
   -> Maybe Text
   -> Integer
   -> URL
   -> URL
   -> UTCTime
   -> UTCTime
   -> SimpleUser
   -> Integer
   -> UTCTime
   -> WorkflowRun)
-> Parser Text
-> Parser
     (Text
      -> Integer
      -> Text
      -> Text
      -> Maybe Text
      -> Integer
      -> URL
      -> URL
      -> UTCTime
      -> UTCTime
      -> SimpleUser
      -> Integer
      -> UTCTime
      -> WorkflowRun)
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
"path"
        Parser
  (Text
   -> Integer
   -> Text
   -> Text
   -> Maybe Text
   -> Integer
   -> URL
   -> URL
   -> UTCTime
   -> UTCTime
   -> SimpleUser
   -> Integer
   -> UTCTime
   -> WorkflowRun)
-> Parser Text
-> Parser
     (Integer
      -> Text
      -> Text
      -> Maybe Text
      -> Integer
      -> URL
      -> URL
      -> UTCTime
      -> UTCTime
      -> SimpleUser
      -> Integer
      -> UTCTime
      -> WorkflowRun)
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
"display_title"
        Parser
  (Integer
   -> Text
   -> Text
   -> Maybe Text
   -> Integer
   -> URL
   -> URL
   -> UTCTime
   -> UTCTime
   -> SimpleUser
   -> Integer
   -> UTCTime
   -> WorkflowRun)
-> Parser Integer
-> Parser
     (Text
      -> Text
      -> Maybe Text
      -> Integer
      -> URL
      -> URL
      -> UTCTime
      -> UTCTime
      -> SimpleUser
      -> Integer
      -> UTCTime
      -> WorkflowRun)
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_number"
        Parser
  (Text
   -> Text
   -> Maybe Text
   -> Integer
   -> URL
   -> URL
   -> UTCTime
   -> UTCTime
   -> SimpleUser
   -> Integer
   -> UTCTime
   -> WorkflowRun)
-> Parser Text
-> Parser
     (Text
      -> Maybe Text
      -> Integer
      -> URL
      -> URL
      -> UTCTime
      -> UTCTime
      -> SimpleUser
      -> Integer
      -> UTCTime
      -> WorkflowRun)
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
"event"
        Parser
  (Text
   -> Maybe Text
   -> Integer
   -> URL
   -> URL
   -> UTCTime
   -> UTCTime
   -> SimpleUser
   -> Integer
   -> UTCTime
   -> WorkflowRun)
-> Parser Text
-> Parser
     (Maybe Text
      -> Integer
      -> URL
      -> URL
      -> UTCTime
      -> UTCTime
      -> SimpleUser
      -> Integer
      -> UTCTime
      -> WorkflowRun)
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
  (Maybe Text
   -> Integer
   -> URL
   -> URL
   -> UTCTime
   -> UTCTime
   -> SimpleUser
   -> Integer
   -> UTCTime
   -> WorkflowRun)
-> Parser (Maybe Text)
-> Parser
     (Integer
      -> URL
      -> URL
      -> UTCTime
      -> UTCTime
      -> SimpleUser
      -> Integer
      -> UTCTime
      -> WorkflowRun)
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 (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"conclusion"
        Parser
  (Integer
   -> URL
   -> URL
   -> UTCTime
   -> UTCTime
   -> SimpleUser
   -> Integer
   -> UTCTime
   -> WorkflowRun)
-> Parser Integer
-> Parser
     (URL
      -> URL
      -> UTCTime
      -> UTCTime
      -> SimpleUser
      -> Integer
      -> UTCTime
      -> WorkflowRun)
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
"workflow_id"
        Parser
  (URL
   -> URL
   -> UTCTime
   -> UTCTime
   -> SimpleUser
   -> Integer
   -> UTCTime
   -> WorkflowRun)
-> Parser URL
-> Parser
     (URL
      -> UTCTime
      -> UTCTime
      -> SimpleUser
      -> Integer
      -> UTCTime
      -> WorkflowRun)
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
   -> UTCTime
   -> UTCTime
   -> SimpleUser
   -> Integer
   -> UTCTime
   -> WorkflowRun)
-> Parser URL
-> Parser
     (UTCTime
      -> UTCTime -> SimpleUser -> Integer -> UTCTime -> WorkflowRun)
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
  (UTCTime
   -> UTCTime -> SimpleUser -> Integer -> UTCTime -> WorkflowRun)
-> Parser UTCTime
-> Parser
     (UTCTime -> SimpleUser -> Integer -> UTCTime -> WorkflowRun)
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
"created_at"
        Parser (UTCTime -> SimpleUser -> Integer -> UTCTime -> WorkflowRun)
-> Parser UTCTime
-> Parser (SimpleUser -> Integer -> UTCTime -> WorkflowRun)
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
"updated_at"
        Parser (SimpleUser -> Integer -> UTCTime -> WorkflowRun)
-> Parser SimpleUser -> Parser (Integer -> UTCTime -> WorkflowRun)
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 SimpleUser
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"actor"
        Parser (Integer -> UTCTime -> WorkflowRun)
-> Parser Integer -> Parser (UTCTime -> WorkflowRun)
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 (UTCTime -> WorkflowRun)
-> Parser UTCTime -> Parser WorkflowRun
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
"run_started_at"

instance FromJSON (WithTotalCount WorkflowRun) where
    parseJSON :: Value -> Parser (WithTotalCount WorkflowRun)
parseJSON = String
-> (Object -> Parser (WithTotalCount WorkflowRun))
-> Value
-> Parser (WithTotalCount WorkflowRun)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"WorkflowRunList" ((Object -> Parser (WithTotalCount WorkflowRun))
 -> Value -> Parser (WithTotalCount WorkflowRun))
-> (Object -> Parser (WithTotalCount WorkflowRun))
-> Value
-> Parser (WithTotalCount WorkflowRun)
forall a b. (a -> b) -> a -> b
$ \Object
o -> Vector WorkflowRun -> Int -> WithTotalCount WorkflowRun
forall a. Vector a -> Int -> WithTotalCount a
WithTotalCount
        (Vector WorkflowRun -> Int -> WithTotalCount WorkflowRun)
-> Parser (Vector WorkflowRun)
-> Parser (Int -> WithTotalCount WorkflowRun)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Vector WorkflowRun)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"workflow_runs"
        Parser (Int -> WithTotalCount WorkflowRun)
-> Parser Int -> Parser (WithTotalCount WorkflowRun)
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"

instance FromJSON ReviewHistory where
    parseJSON :: Value -> Parser ReviewHistory
parseJSON = String
-> (Object -> Parser ReviewHistory)
-> Value
-> Parser ReviewHistory
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ReviewHistory" ((Object -> Parser ReviewHistory) -> Value -> Parser ReviewHistory)
-> (Object -> Parser ReviewHistory)
-> Value
-> Parser ReviewHistory
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> SimpleUser -> ReviewHistory
ReviewHistory
        (Text -> Text -> SimpleUser -> ReviewHistory)
-> Parser Text -> Parser (Text -> SimpleUser -> ReviewHistory)
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
"state"
        Parser (Text -> SimpleUser -> ReviewHistory)
-> Parser Text -> Parser (SimpleUser -> ReviewHistory)
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
"comment"
        Parser (SimpleUser -> ReviewHistory)
-> Parser SimpleUser -> Parser ReviewHistory
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 SimpleUser
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"