{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE StrictData        #-}
module GitHub.Types.Base.WorkflowRun where

import           Data.Aeson                         (FromJSON (..), ToJSON (..),
                                                     object)
import           Data.Aeson.Types                   (Value (..), (.:), (.=))
import           Data.Text                          (Text)
import           Test.QuickCheck.Arbitrary          (Arbitrary (..))

import           GitHub.Types.Base.CheckCommit
import           GitHub.Types.Base.CheckPullRequest
import           GitHub.Types.Base.SimpleRepository

------------------------------------------------------------------------------
-- WorkflowRun

data WorkflowRun = WorkflowRun
    { WorkflowRun -> Maybe Text
workflowRunConclusion         :: Maybe Text
    , WorkflowRun -> SimpleRepository
workflowRunRepository         :: SimpleRepository
    , WorkflowRun -> SimpleRepository
workflowRunHeadRepository     :: SimpleRepository
    , WorkflowRun -> Text
workflowRunHeadBranch         :: Text
    , WorkflowRun -> CheckCommit
workflowRunHeadCommit         :: CheckCommit
    , WorkflowRun -> Text
workflowRunHeadSha            :: Text
    , WorkflowRun -> Int
workflowRunId                 :: Int
    , WorkflowRun -> Int
workflowRunWorkflowId         :: Int
    , WorkflowRun -> Text
workflowRunNodeId             :: Text
    , WorkflowRun -> Int
workflowRunCheckSuiteId       :: Int
    , WorkflowRun -> Text
workflowRunCheckSuiteNodeId   :: Text
    , WorkflowRun -> [CheckPullRequest]
workflowRunPullRequests       :: [CheckPullRequest]
    , WorkflowRun -> Text
workflowRunStatus             :: Text
    , WorkflowRun -> Text
workflowRunUrl                :: Text
    , WorkflowRun -> Text
workflowRunJobsUrl            :: Text
    , WorkflowRun -> Text
workflowRunLogsUrl            :: Text
    , WorkflowRun -> Text
workflowRunCheckSuiteUrl      :: Text
    , WorkflowRun -> Text
workflowRunArtifactsUrl       :: Text
    , WorkflowRun -> Text
workflowRunCancelUrl          :: Text
    , WorkflowRun -> Maybe Text
workflowRunPreviousAttemptUrl :: Maybe Text
    , WorkflowRun -> Text
workflowRunWorkflowUrl        :: Text
    , WorkflowRun -> Text
workflowRunRerunUrl           :: Text
    , WorkflowRun -> Text
workflowRunHtmlUrl            :: Text
    , WorkflowRun -> Text
workflowRunRunStartedAt       :: Text
    , WorkflowRun -> Text
workflowRunUpdatedAt          :: Text
    , WorkflowRun -> Text
workflowRunCreatedAt          :: Text
    , WorkflowRun -> Int
workflowRunRunNumber          :: Int
    , WorkflowRun -> Int
workflowRunRunAttempt         :: Int
    , WorkflowRun -> Text
workflowRunEvent              :: Text
    , WorkflowRun -> Text
workflowRunName               :: Text
    } deriving (WorkflowRun -> WorkflowRun -> Bool
(WorkflowRun -> WorkflowRun -> Bool)
-> (WorkflowRun -> WorkflowRun -> Bool) -> Eq WorkflowRun
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WorkflowRun -> WorkflowRun -> Bool
$c/= :: WorkflowRun -> WorkflowRun -> Bool
== :: WorkflowRun -> WorkflowRun -> Bool
$c== :: WorkflowRun -> WorkflowRun -> Bool
Eq, 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
showList :: [WorkflowRun] -> ShowS
$cshowList :: [WorkflowRun] -> ShowS
show :: WorkflowRun -> String
$cshow :: WorkflowRun -> String
showsPrec :: Int -> WorkflowRun -> ShowS
$cshowsPrec :: Int -> WorkflowRun -> ShowS
Show, ReadPrec [WorkflowRun]
ReadPrec WorkflowRun
Int -> ReadS WorkflowRun
ReadS [WorkflowRun]
(Int -> ReadS WorkflowRun)
-> ReadS [WorkflowRun]
-> ReadPrec WorkflowRun
-> ReadPrec [WorkflowRun]
-> Read WorkflowRun
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WorkflowRun]
$creadListPrec :: ReadPrec [WorkflowRun]
readPrec :: ReadPrec WorkflowRun
$creadPrec :: ReadPrec WorkflowRun
readList :: ReadS [WorkflowRun]
$creadList :: ReadS [WorkflowRun]
readsPrec :: Int -> ReadS WorkflowRun
$creadsPrec :: Int -> ReadS WorkflowRun
Read)


instance FromJSON WorkflowRun where
    parseJSON :: Value -> Parser WorkflowRun
parseJSON (Object Object
x) = Maybe Text
-> SimpleRepository
-> SimpleRepository
-> Text
-> CheckCommit
-> Text
-> Int
-> Int
-> Text
-> Int
-> Text
-> [CheckPullRequest]
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Maybe Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Int
-> Int
-> Text
-> Text
-> WorkflowRun
WorkflowRun
        (Maybe Text
 -> SimpleRepository
 -> SimpleRepository
 -> Text
 -> CheckCommit
 -> Text
 -> Int
 -> Int
 -> Text
 -> Int
 -> Text
 -> [CheckPullRequest]
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Maybe Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> Int
 -> Text
 -> Text
 -> WorkflowRun)
-> Parser (Maybe Text)
-> Parser
     (SimpleRepository
      -> SimpleRepository
      -> Text
      -> CheckCommit
      -> Text
      -> Int
      -> Int
      -> Text
      -> Int
      -> Text
      -> [CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
x Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"conclusion"
        Parser
  (SimpleRepository
   -> SimpleRepository
   -> Text
   -> CheckCommit
   -> Text
   -> Int
   -> Int
   -> Text
   -> Int
   -> Text
   -> [CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser SimpleRepository
-> Parser
     (SimpleRepository
      -> Text
      -> CheckCommit
      -> Text
      -> Int
      -> Int
      -> Text
      -> Int
      -> Text
      -> [CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser SimpleRepository
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"repository"
        Parser
  (SimpleRepository
   -> Text
   -> CheckCommit
   -> Text
   -> Int
   -> Int
   -> Text
   -> Int
   -> Text
   -> [CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser SimpleRepository
-> Parser
     (Text
      -> CheckCommit
      -> Text
      -> Int
      -> Int
      -> Text
      -> Int
      -> Text
      -> [CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser SimpleRepository
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"head_repository"
        Parser
  (Text
   -> CheckCommit
   -> Text
   -> Int
   -> Int
   -> Text
   -> Int
   -> Text
   -> [CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser Text
-> Parser
     (CheckCommit
      -> Text
      -> Int
      -> Int
      -> Text
      -> Int
      -> Text
      -> [CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"head_branch"
        Parser
  (CheckCommit
   -> Text
   -> Int
   -> Int
   -> Text
   -> Int
   -> Text
   -> [CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser CheckCommit
-> Parser
     (Text
      -> Int
      -> Int
      -> Text
      -> Int
      -> Text
      -> [CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser CheckCommit
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"head_commit"
        Parser
  (Text
   -> Int
   -> Int
   -> Text
   -> Int
   -> Text
   -> [CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser Text
-> Parser
     (Int
      -> Int
      -> Text
      -> Int
      -> Text
      -> [CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"head_sha"
        Parser
  (Int
   -> Int
   -> Text
   -> Int
   -> Text
   -> [CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser Int
-> Parser
     (Int
      -> Text
      -> Int
      -> Text
      -> [CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        Parser
  (Int
   -> Text
   -> Int
   -> Text
   -> [CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser Int
-> Parser
     (Text
      -> Int
      -> Text
      -> [CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"workflow_id"
        Parser
  (Text
   -> Int
   -> Text
   -> [CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser Text
-> Parser
     (Int
      -> Text
      -> [CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
        Parser
  (Int
   -> Text
   -> [CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser Int
-> Parser
     (Text
      -> [CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"check_suite_id"
        Parser
  (Text
   -> [CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser Text
-> Parser
     ([CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"check_suite_node_id"
        Parser
  ([CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser [CheckPullRequest]
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser [CheckPullRequest]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pull_requests"
        Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
        Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
        Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"jobs_url"
        Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"logs_url"
        Parser
  (Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"check_suite_url"
        Parser
  (Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser Text
-> Parser
     (Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"artifacts_url"
        Parser
  (Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser Text
-> Parser
     (Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cancel_url"
        Parser
  (Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser (Maybe Text)
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"previous_attempt_url"
        Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"workflow_url"
        Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"rerun_url"
        Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Parser Text
-> Parser
     (Text -> Text -> Text -> Int -> Int -> Text -> Text -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"html_url"
        Parser
  (Text -> Text -> Text -> Int -> Int -> Text -> Text -> WorkflowRun)
-> Parser Text
-> Parser
     (Text -> Text -> Int -> Int -> Text -> Text -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"run_started_at"
        Parser (Text -> Text -> Int -> Int -> Text -> Text -> WorkflowRun)
-> Parser Text
-> Parser (Text -> Int -> Int -> Text -> Text -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
        Parser (Text -> Int -> Int -> Text -> Text -> WorkflowRun)
-> Parser Text
-> Parser (Int -> Int -> Text -> Text -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
        Parser (Int -> Int -> Text -> Text -> WorkflowRun)
-> Parser Int -> Parser (Int -> Text -> Text -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"run_number"
        Parser (Int -> Text -> Text -> WorkflowRun)
-> Parser Int -> Parser (Text -> Text -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"run_attempt"
        Parser (Text -> Text -> WorkflowRun)
-> Parser Text -> Parser (Text -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event"
        Parser (Text -> WorkflowRun) -> Parser Text -> Parser WorkflowRun
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"

    parseJSON Value
_ = String -> Parser WorkflowRun
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"WorkflowRun"


instance ToJSON WorkflowRun where
    toJSON :: WorkflowRun -> Value
toJSON WorkflowRun{Int
[CheckPullRequest]
Maybe Text
Text
CheckCommit
SimpleRepository
workflowRunName :: Text
workflowRunEvent :: Text
workflowRunRunAttempt :: Int
workflowRunRunNumber :: Int
workflowRunCreatedAt :: Text
workflowRunUpdatedAt :: Text
workflowRunRunStartedAt :: Text
workflowRunHtmlUrl :: Text
workflowRunRerunUrl :: Text
workflowRunWorkflowUrl :: Text
workflowRunPreviousAttemptUrl :: Maybe Text
workflowRunCancelUrl :: Text
workflowRunArtifactsUrl :: Text
workflowRunCheckSuiteUrl :: Text
workflowRunLogsUrl :: Text
workflowRunJobsUrl :: Text
workflowRunUrl :: Text
workflowRunStatus :: Text
workflowRunPullRequests :: [CheckPullRequest]
workflowRunCheckSuiteNodeId :: Text
workflowRunCheckSuiteId :: Int
workflowRunNodeId :: Text
workflowRunWorkflowId :: Int
workflowRunId :: Int
workflowRunHeadSha :: Text
workflowRunHeadCommit :: CheckCommit
workflowRunHeadBranch :: Text
workflowRunHeadRepository :: SimpleRepository
workflowRunRepository :: SimpleRepository
workflowRunConclusion :: Maybe Text
workflowRunName :: WorkflowRun -> Text
workflowRunEvent :: WorkflowRun -> Text
workflowRunRunAttempt :: WorkflowRun -> Int
workflowRunRunNumber :: WorkflowRun -> Int
workflowRunCreatedAt :: WorkflowRun -> Text
workflowRunUpdatedAt :: WorkflowRun -> Text
workflowRunRunStartedAt :: WorkflowRun -> Text
workflowRunHtmlUrl :: WorkflowRun -> Text
workflowRunRerunUrl :: WorkflowRun -> Text
workflowRunWorkflowUrl :: WorkflowRun -> Text
workflowRunPreviousAttemptUrl :: WorkflowRun -> Maybe Text
workflowRunCancelUrl :: WorkflowRun -> Text
workflowRunArtifactsUrl :: WorkflowRun -> Text
workflowRunCheckSuiteUrl :: WorkflowRun -> Text
workflowRunLogsUrl :: WorkflowRun -> Text
workflowRunJobsUrl :: WorkflowRun -> Text
workflowRunUrl :: WorkflowRun -> Text
workflowRunStatus :: WorkflowRun -> Text
workflowRunPullRequests :: WorkflowRun -> [CheckPullRequest]
workflowRunCheckSuiteNodeId :: WorkflowRun -> Text
workflowRunCheckSuiteId :: WorkflowRun -> Int
workflowRunNodeId :: WorkflowRun -> Text
workflowRunWorkflowId :: WorkflowRun -> Int
workflowRunId :: WorkflowRun -> Int
workflowRunHeadSha :: WorkflowRun -> Text
workflowRunHeadCommit :: WorkflowRun -> CheckCommit
workflowRunHeadBranch :: WorkflowRun -> Text
workflowRunHeadRepository :: WorkflowRun -> SimpleRepository
workflowRunRepository :: WorkflowRun -> SimpleRepository
workflowRunConclusion :: WorkflowRun -> Maybe Text
..} = [Pair] -> Value
object
        [ Key
"conclusion"              Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
workflowRunConclusion
        , Key
"repository"              Key -> SimpleRepository -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SimpleRepository
workflowRunRepository
        , Key
"head_repository"         Key -> SimpleRepository -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SimpleRepository
workflowRunHeadRepository
        , Key
"head_branch"             Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowRunHeadBranch
        , Key
"head_commit"             Key -> CheckCommit -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CheckCommit
workflowRunHeadCommit
        , Key
"head_sha"                Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowRunHeadSha
        , Key
"id"                      Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
workflowRunId
        , Key
"workflow_id"             Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
workflowRunWorkflowId
        , Key
"node_id"                 Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowRunNodeId
        , Key
"check_suite_id"          Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
workflowRunCheckSuiteId
        , Key
"check_suite_node_id"     Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowRunCheckSuiteNodeId
        , Key
"pull_requests"           Key -> [CheckPullRequest] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [CheckPullRequest]
workflowRunPullRequests
        , Key
"status"                  Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowRunStatus
        , Key
"url"                     Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowRunUrl
        , Key
"jobs_url"                Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowRunJobsUrl
        , Key
"logs_url"                Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowRunLogsUrl
        , Key
"check_suite_url"         Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowRunCheckSuiteUrl
        , Key
"artifacts_url"           Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowRunArtifactsUrl
        , Key
"cancel_url"              Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowRunCancelUrl
        , Key
"previous_attempt_url"    Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
workflowRunPreviousAttemptUrl
        , Key
"workflow_url"            Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowRunWorkflowUrl
        , Key
"rerun_url"               Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowRunRerunUrl
        , Key
"html_url"                Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowRunHtmlUrl
        , Key
"run_started_at"          Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowRunRunStartedAt
        , Key
"updated_at"              Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowRunUpdatedAt
        , Key
"created_at"              Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowRunCreatedAt
        , Key
"run_number"              Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
workflowRunRunNumber
        , Key
"run_attempt"             Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
workflowRunRunAttempt
        , Key
"event"                   Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowRunEvent
        , Key
"name"                    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowRunName
        ]


instance Arbitrary WorkflowRun where
    arbitrary :: Gen WorkflowRun
arbitrary = Maybe Text
-> SimpleRepository
-> SimpleRepository
-> Text
-> CheckCommit
-> Text
-> Int
-> Int
-> Text
-> Int
-> Text
-> [CheckPullRequest]
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Maybe Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Int
-> Int
-> Text
-> Text
-> WorkflowRun
WorkflowRun
        (Maybe Text
 -> SimpleRepository
 -> SimpleRepository
 -> Text
 -> CheckCommit
 -> Text
 -> Int
 -> Int
 -> Text
 -> Int
 -> Text
 -> [CheckPullRequest]
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Maybe Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Int
 -> Int
 -> Text
 -> Text
 -> WorkflowRun)
-> Gen (Maybe Text)
-> Gen
     (SimpleRepository
      -> SimpleRepository
      -> Text
      -> CheckCommit
      -> Text
      -> Int
      -> Int
      -> Text
      -> Int
      -> Text
      -> [CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe Text)
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (SimpleRepository
   -> SimpleRepository
   -> Text
   -> CheckCommit
   -> Text
   -> Int
   -> Int
   -> Text
   -> Int
   -> Text
   -> [CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen SimpleRepository
-> Gen
     (SimpleRepository
      -> Text
      -> CheckCommit
      -> Text
      -> Int
      -> Int
      -> Text
      -> Int
      -> Text
      -> [CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SimpleRepository
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (SimpleRepository
   -> Text
   -> CheckCommit
   -> Text
   -> Int
   -> Int
   -> Text
   -> Int
   -> Text
   -> [CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen SimpleRepository
-> Gen
     (Text
      -> CheckCommit
      -> Text
      -> Int
      -> Int
      -> Text
      -> Int
      -> Text
      -> [CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SimpleRepository
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> CheckCommit
   -> Text
   -> Int
   -> Int
   -> Text
   -> Int
   -> Text
   -> [CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen Text
-> Gen
     (CheckCommit
      -> Text
      -> Int
      -> Int
      -> Text
      -> Int
      -> Text
      -> [CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (CheckCommit
   -> Text
   -> Int
   -> Int
   -> Text
   -> Int
   -> Text
   -> [CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen CheckCommit
-> Gen
     (Text
      -> Int
      -> Int
      -> Text
      -> Int
      -> Text
      -> [CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen CheckCommit
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Int
   -> Int
   -> Text
   -> Int
   -> Text
   -> [CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen Text
-> Gen
     (Int
      -> Int
      -> Text
      -> Int
      -> Text
      -> [CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Int
   -> Int
   -> Text
   -> Int
   -> Text
   -> [CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen Int
-> Gen
     (Int
      -> Text
      -> Int
      -> Text
      -> [CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Int
   -> Text
   -> Int
   -> Text
   -> [CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen Int
-> Gen
     (Text
      -> Int
      -> Text
      -> [CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Int
   -> Text
   -> [CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen Text
-> Gen
     (Int
      -> Text
      -> [CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Int
   -> Text
   -> [CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen Int
-> Gen
     (Text
      -> [CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> [CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen Text
-> Gen
     ([CheckPullRequest]
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  ([CheckPullRequest]
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen [CheckPullRequest]
-> Gen
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [CheckPullRequest]
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen Text
-> Gen
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen Text
-> Gen
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen Text
-> Gen
     (Text
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen Text
-> Gen
     (Text
      -> Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen Text
-> Gen
     (Text
      -> Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen Text
-> Gen
     (Text
      -> Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen Text
-> Gen
     (Maybe Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Maybe Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen (Maybe Text)
-> Gen
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Text)
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen Text
-> Gen
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen Text
-> Gen
     (Text
      -> Text
      -> Text
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Text
   -> Text
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> WorkflowRun)
-> Gen Text
-> Gen
     (Text -> Text -> Text -> Int -> Int -> Text -> Text -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text -> Text -> Text -> Int -> Int -> Text -> Text -> WorkflowRun)
-> Gen Text
-> Gen (Text -> Text -> Int -> Int -> Text -> Text -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> Text -> Int -> Int -> Text -> Text -> WorkflowRun)
-> Gen Text
-> Gen (Text -> Int -> Int -> Text -> Text -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> Int -> Int -> Text -> Text -> WorkflowRun)
-> Gen Text -> Gen (Int -> Int -> Text -> Text -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Int -> Int -> Text -> Text -> WorkflowRun)
-> Gen Int -> Gen (Int -> Text -> Text -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Int -> Text -> Text -> WorkflowRun)
-> Gen Int -> Gen (Text -> Text -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> Text -> WorkflowRun)
-> Gen Text -> Gen (Text -> WorkflowRun)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> WorkflowRun) -> Gen Text -> Gen WorkflowRun
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary