{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE StrictData        #-}
module GitHub.Types.Base.SimplePullRequest 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.Commit
import           GitHub.Types.Base.DateTime
import           GitHub.Types.Base.Label
import           GitHub.Types.Base.Milestone
import           GitHub.Types.Base.PullRequestLinks
import           GitHub.Types.Base.Team
import           GitHub.Types.Base.User

------------------------------------------------------------------------------
-- SimplePullRequest

data SimplePullRequest = SimplePullRequest
    { SimplePullRequest -> Text
simplePullRequestState              :: Text
    , SimplePullRequest -> Text
simplePullRequestReviewCommentUrl   :: Text
    , SimplePullRequest -> [User]
simplePullRequestAssignees          :: [User]
    , SimplePullRequest -> Text
simplePullRequestAuthorAssociation  :: Text
    , SimplePullRequest -> Bool
simplePullRequestDraft              :: Bool
    , SimplePullRequest -> Bool
simplePullRequestLocked             :: Bool
    , SimplePullRequest -> Commit
simplePullRequestBase               :: Commit
    , SimplePullRequest -> Text
simplePullRequestBody               :: Text
    , SimplePullRequest -> Commit
simplePullRequestHead               :: Commit
    , SimplePullRequest -> Text
simplePullRequestUrl                :: Text
    , SimplePullRequest -> Maybe Milestone
simplePullRequestMilestone          :: Maybe Milestone
    , SimplePullRequest -> Text
simplePullRequestStatusesUrl        :: Text
    , SimplePullRequest -> Maybe DateTime
simplePullRequestMergedAt           :: Maybe DateTime
    , SimplePullRequest -> Text
simplePullRequestCommitsUrl         :: Text
    , SimplePullRequest -> Maybe User
simplePullRequestAssignee           :: Maybe User
    , SimplePullRequest -> Text
simplePullRequestDiffUrl            :: Text
    , SimplePullRequest -> User
simplePullRequestUser               :: User
    , SimplePullRequest -> Text
simplePullRequestCommentsUrl        :: Text
    , SimplePullRequest -> PullRequestLinks
simplePullRequestLinks              :: PullRequestLinks
    , SimplePullRequest -> DateTime
simplePullRequestUpdatedAt          :: DateTime
    , SimplePullRequest -> Text
simplePullRequestPatchUrl           :: Text
    , SimplePullRequest -> DateTime
simplePullRequestCreatedAt          :: DateTime
    , SimplePullRequest -> Int
simplePullRequestId                 :: Int
    , SimplePullRequest -> Text
simplePullRequestNodeId             :: Text
    , SimplePullRequest -> Text
simplePullRequestIssueUrl           :: Text
    , SimplePullRequest -> Text
simplePullRequestTitle              :: Text
    , SimplePullRequest -> Maybe DateTime
simplePullRequestClosedAt           :: Maybe DateTime
    , SimplePullRequest -> Int
simplePullRequestNumber             :: Int
    , SimplePullRequest -> Maybe Text
simplePullRequestMergeCommitSha     :: Maybe Text
    , SimplePullRequest -> Text
simplePullRequestReviewCommentsUrl  :: Text
    , SimplePullRequest -> Text
simplePullRequestHtmlUrl            :: Text
    , SimplePullRequest -> [User]
simplePullRequestRequestedReviewers :: [User]
    , SimplePullRequest -> [Team]
simplePullRequestRequestedTeams     :: [Team]
    , SimplePullRequest -> [Label]
simplePullRequestLabels             :: [Label]
    } deriving (SimplePullRequest -> SimplePullRequest -> Bool
(SimplePullRequest -> SimplePullRequest -> Bool)
-> (SimplePullRequest -> SimplePullRequest -> Bool)
-> Eq SimplePullRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimplePullRequest -> SimplePullRequest -> Bool
$c/= :: SimplePullRequest -> SimplePullRequest -> Bool
== :: SimplePullRequest -> SimplePullRequest -> Bool
$c== :: SimplePullRequest -> SimplePullRequest -> Bool
Eq, Int -> SimplePullRequest -> ShowS
[SimplePullRequest] -> ShowS
SimplePullRequest -> String
(Int -> SimplePullRequest -> ShowS)
-> (SimplePullRequest -> String)
-> ([SimplePullRequest] -> ShowS)
-> Show SimplePullRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimplePullRequest] -> ShowS
$cshowList :: [SimplePullRequest] -> ShowS
show :: SimplePullRequest -> String
$cshow :: SimplePullRequest -> String
showsPrec :: Int -> SimplePullRequest -> ShowS
$cshowsPrec :: Int -> SimplePullRequest -> ShowS
Show, ReadPrec [SimplePullRequest]
ReadPrec SimplePullRequest
Int -> ReadS SimplePullRequest
ReadS [SimplePullRequest]
(Int -> ReadS SimplePullRequest)
-> ReadS [SimplePullRequest]
-> ReadPrec SimplePullRequest
-> ReadPrec [SimplePullRequest]
-> Read SimplePullRequest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SimplePullRequest]
$creadListPrec :: ReadPrec [SimplePullRequest]
readPrec :: ReadPrec SimplePullRequest
$creadPrec :: ReadPrec SimplePullRequest
readList :: ReadS [SimplePullRequest]
$creadList :: ReadS [SimplePullRequest]
readsPrec :: Int -> ReadS SimplePullRequest
$creadsPrec :: Int -> ReadS SimplePullRequest
Read)


instance FromJSON SimplePullRequest where
    parseJSON :: Value -> Parser SimplePullRequest
parseJSON (Object Object
x) = Text
-> Text
-> [User]
-> Text
-> Bool
-> Bool
-> Commit
-> Text
-> Commit
-> Text
-> Maybe Milestone
-> Text
-> Maybe DateTime
-> Text
-> Maybe User
-> Text
-> User
-> Text
-> PullRequestLinks
-> DateTime
-> Text
-> DateTime
-> Int
-> Text
-> Text
-> Text
-> Maybe DateTime
-> Int
-> Maybe Text
-> Text
-> Text
-> [User]
-> [Team]
-> [Label]
-> SimplePullRequest
SimplePullRequest
        (Text
 -> Text
 -> [User]
 -> Text
 -> Bool
 -> Bool
 -> Commit
 -> Text
 -> Commit
 -> Text
 -> Maybe Milestone
 -> Text
 -> Maybe DateTime
 -> Text
 -> Maybe User
 -> Text
 -> User
 -> Text
 -> PullRequestLinks
 -> DateTime
 -> Text
 -> DateTime
 -> Int
 -> Text
 -> Text
 -> Text
 -> Maybe DateTime
 -> Int
 -> Maybe Text
 -> Text
 -> Text
 -> [User]
 -> [Team]
 -> [Label]
 -> SimplePullRequest)
-> Parser Text
-> Parser
     (Text
      -> [User]
      -> Text
      -> Bool
      -> Bool
      -> Commit
      -> Text
      -> Commit
      -> Text
      -> Maybe Milestone
      -> Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"state"
        Parser
  (Text
   -> [User]
   -> Text
   -> Bool
   -> Bool
   -> Commit
   -> Text
   -> Commit
   -> Text
   -> Maybe Milestone
   -> Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser Text
-> Parser
     ([User]
      -> Text
      -> Bool
      -> Bool
      -> Commit
      -> Text
      -> Commit
      -> Text
      -> Maybe Milestone
      -> Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
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
"review_comment_url"
        Parser
  ([User]
   -> Text
   -> Bool
   -> Bool
   -> Commit
   -> Text
   -> Commit
   -> Text
   -> Maybe Milestone
   -> Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser [User]
-> Parser
     (Text
      -> Bool
      -> Bool
      -> Commit
      -> Text
      -> Commit
      -> Text
      -> Maybe Milestone
      -> Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser [User]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"assignees"
        Parser
  (Text
   -> Bool
   -> Bool
   -> Commit
   -> Text
   -> Commit
   -> Text
   -> Maybe Milestone
   -> Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser Text
-> Parser
     (Bool
      -> Bool
      -> Commit
      -> Text
      -> Commit
      -> Text
      -> Maybe Milestone
      -> Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
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
"author_association"
        Parser
  (Bool
   -> Bool
   -> Commit
   -> Text
   -> Commit
   -> Text
   -> Maybe Milestone
   -> Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser Bool
-> Parser
     (Bool
      -> Commit
      -> Text
      -> Commit
      -> Text
      -> Maybe Milestone
      -> Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"draft"
        Parser
  (Bool
   -> Commit
   -> Text
   -> Commit
   -> Text
   -> Maybe Milestone
   -> Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser Bool
-> Parser
     (Commit
      -> Text
      -> Commit
      -> Text
      -> Maybe Milestone
      -> Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locked"
        Parser
  (Commit
   -> Text
   -> Commit
   -> Text
   -> Maybe Milestone
   -> Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser Commit
-> Parser
     (Text
      -> Commit
      -> Text
      -> Maybe Milestone
      -> Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Commit
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"base"
        Parser
  (Text
   -> Commit
   -> Text
   -> Maybe Milestone
   -> Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser Text
-> Parser
     (Commit
      -> Text
      -> Maybe Milestone
      -> Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
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
"body"
        Parser
  (Commit
   -> Text
   -> Maybe Milestone
   -> Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser Commit
-> Parser
     (Text
      -> Maybe Milestone
      -> Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Commit
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"head"
        Parser
  (Text
   -> Maybe Milestone
   -> Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser Text
-> Parser
     (Maybe Milestone
      -> Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
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
  (Maybe Milestone
   -> Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser (Maybe Milestone)
-> Parser
     (Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe Milestone)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"milestone"
        Parser
  (Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser Text
-> Parser
     (Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
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
"statuses_url"
        Parser
  (Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser (Maybe DateTime)
-> Parser
     (Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"merged_at"
        Parser
  (Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser Text
-> Parser
     (Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
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
"commits_url"
        Parser
  (Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser (Maybe User)
-> Parser
     (Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"assignee"
        Parser
  (Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser Text
-> Parser
     (User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
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
"diff_url"
        Parser
  (User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser User
-> Parser
     (Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser User
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
        Parser
  (Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser Text
-> Parser
     (PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
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
"comments_url"
        Parser
  (PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser PullRequestLinks
-> Parser
     (DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser PullRequestLinks
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_links"
        Parser
  (DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser DateTime
-> Parser
     (Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser DateTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
        Parser
  (Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser Text
-> Parser
     (DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
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
"patch_url"
        Parser
  (DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser DateTime
-> Parser
     (Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser DateTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
        Parser
  (Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser Int
-> Parser
     (Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
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
  (Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
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
  (Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser Text
-> Parser
     (Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
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
"issue_url"
        Parser
  (Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser Text
-> Parser
     (Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
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
"title"
        Parser
  (Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser (Maybe DateTime)
-> Parser
     (Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"closed_at"
        Parser
  (Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser Int
-> Parser
     (Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
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
"number"
        Parser
  (Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Parser (Maybe Text)
-> Parser
     (Text -> Text -> [User] -> [Team] -> [Label] -> SimplePullRequest)
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
"merge_commit_sha"
        Parser
  (Text -> Text -> [User] -> [Team] -> [Label] -> SimplePullRequest)
-> Parser Text
-> Parser
     (Text -> [User] -> [Team] -> [Label] -> SimplePullRequest)
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
"review_comments_url"
        Parser (Text -> [User] -> [Team] -> [Label] -> SimplePullRequest)
-> Parser Text
-> Parser ([User] -> [Team] -> [Label] -> SimplePullRequest)
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 ([User] -> [Team] -> [Label] -> SimplePullRequest)
-> Parser [User] -> Parser ([Team] -> [Label] -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser [User]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"requested_reviewers"
        Parser ([Team] -> [Label] -> SimplePullRequest)
-> Parser [Team] -> Parser ([Label] -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser [Team]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"requested_teams"
        Parser ([Label] -> SimplePullRequest)
-> Parser [Label] -> Parser SimplePullRequest
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser [Label]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"labels"

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


instance ToJSON SimplePullRequest where
    toJSON :: SimplePullRequest -> Value
toJSON SimplePullRequest{Bool
Int
[Label]
[Team]
[User]
Maybe Text
Maybe DateTime
Maybe User
Maybe Milestone
Text
DateTime
PullRequestLinks
User
Commit
simplePullRequestLabels :: [Label]
simplePullRequestRequestedTeams :: [Team]
simplePullRequestRequestedReviewers :: [User]
simplePullRequestHtmlUrl :: Text
simplePullRequestReviewCommentsUrl :: Text
simplePullRequestMergeCommitSha :: Maybe Text
simplePullRequestNumber :: Int
simplePullRequestClosedAt :: Maybe DateTime
simplePullRequestTitle :: Text
simplePullRequestIssueUrl :: Text
simplePullRequestNodeId :: Text
simplePullRequestId :: Int
simplePullRequestCreatedAt :: DateTime
simplePullRequestPatchUrl :: Text
simplePullRequestUpdatedAt :: DateTime
simplePullRequestLinks :: PullRequestLinks
simplePullRequestCommentsUrl :: Text
simplePullRequestUser :: User
simplePullRequestDiffUrl :: Text
simplePullRequestAssignee :: Maybe User
simplePullRequestCommitsUrl :: Text
simplePullRequestMergedAt :: Maybe DateTime
simplePullRequestStatusesUrl :: Text
simplePullRequestMilestone :: Maybe Milestone
simplePullRequestUrl :: Text
simplePullRequestHead :: Commit
simplePullRequestBody :: Text
simplePullRequestBase :: Commit
simplePullRequestLocked :: Bool
simplePullRequestDraft :: Bool
simplePullRequestAuthorAssociation :: Text
simplePullRequestAssignees :: [User]
simplePullRequestReviewCommentUrl :: Text
simplePullRequestState :: Text
simplePullRequestLabels :: SimplePullRequest -> [Label]
simplePullRequestRequestedTeams :: SimplePullRequest -> [Team]
simplePullRequestRequestedReviewers :: SimplePullRequest -> [User]
simplePullRequestHtmlUrl :: SimplePullRequest -> Text
simplePullRequestReviewCommentsUrl :: SimplePullRequest -> Text
simplePullRequestMergeCommitSha :: SimplePullRequest -> Maybe Text
simplePullRequestNumber :: SimplePullRequest -> Int
simplePullRequestClosedAt :: SimplePullRequest -> Maybe DateTime
simplePullRequestTitle :: SimplePullRequest -> Text
simplePullRequestIssueUrl :: SimplePullRequest -> Text
simplePullRequestNodeId :: SimplePullRequest -> Text
simplePullRequestId :: SimplePullRequest -> Int
simplePullRequestCreatedAt :: SimplePullRequest -> DateTime
simplePullRequestPatchUrl :: SimplePullRequest -> Text
simplePullRequestUpdatedAt :: SimplePullRequest -> DateTime
simplePullRequestLinks :: SimplePullRequest -> PullRequestLinks
simplePullRequestCommentsUrl :: SimplePullRequest -> Text
simplePullRequestUser :: SimplePullRequest -> User
simplePullRequestDiffUrl :: SimplePullRequest -> Text
simplePullRequestAssignee :: SimplePullRequest -> Maybe User
simplePullRequestCommitsUrl :: SimplePullRequest -> Text
simplePullRequestMergedAt :: SimplePullRequest -> Maybe DateTime
simplePullRequestStatusesUrl :: SimplePullRequest -> Text
simplePullRequestMilestone :: SimplePullRequest -> Maybe Milestone
simplePullRequestUrl :: SimplePullRequest -> Text
simplePullRequestHead :: SimplePullRequest -> Commit
simplePullRequestBody :: SimplePullRequest -> Text
simplePullRequestBase :: SimplePullRequest -> Commit
simplePullRequestLocked :: SimplePullRequest -> Bool
simplePullRequestDraft :: SimplePullRequest -> Bool
simplePullRequestAuthorAssociation :: SimplePullRequest -> Text
simplePullRequestAssignees :: SimplePullRequest -> [User]
simplePullRequestReviewCommentUrl :: SimplePullRequest -> Text
simplePullRequestState :: SimplePullRequest -> Text
..} = [Pair] -> Value
object
        [ Key
"state"                Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
simplePullRequestState
        , Key
"review_comment_url"   Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
simplePullRequestReviewCommentUrl
        , Key
"assignees"            Key -> [User] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [User]
simplePullRequestAssignees
        , Key
"author_association"   Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
simplePullRequestAuthorAssociation
        , Key
"draft"                Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
simplePullRequestDraft
        , Key
"locked"               Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
simplePullRequestLocked
        , Key
"base"                 Key -> Commit -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Commit
simplePullRequestBase
        , Key
"body"                 Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
simplePullRequestBody
        , Key
"head"                 Key -> Commit -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Commit
simplePullRequestHead
        , Key
"url"                  Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
simplePullRequestUrl
        , Key
"milestone"            Key -> Maybe Milestone -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Milestone
simplePullRequestMilestone
        , Key
"statuses_url"         Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
simplePullRequestStatusesUrl
        , Key
"merged_at"            Key -> Maybe DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe DateTime
simplePullRequestMergedAt
        , Key
"commits_url"          Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
simplePullRequestCommitsUrl
        , Key
"assignee"             Key -> Maybe User -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe User
simplePullRequestAssignee
        , Key
"diff_url"             Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
simplePullRequestDiffUrl
        , Key
"user"                 Key -> User -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= User
simplePullRequestUser
        , Key
"comments_url"         Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
simplePullRequestCommentsUrl
        , Key
"_links"               Key -> PullRequestLinks -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PullRequestLinks
simplePullRequestLinks
        , Key
"updated_at"           Key -> DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DateTime
simplePullRequestUpdatedAt
        , Key
"patch_url"            Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
simplePullRequestPatchUrl
        , Key
"created_at"           Key -> DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DateTime
simplePullRequestCreatedAt
        , Key
"id"                   Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
simplePullRequestId
        , Key
"node_id"              Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
simplePullRequestNodeId
        , Key
"issue_url"            Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
simplePullRequestIssueUrl
        , Key
"title"                Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
simplePullRequestTitle
        , Key
"closed_at"            Key -> Maybe DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe DateTime
simplePullRequestClosedAt
        , Key
"number"               Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
simplePullRequestNumber
        , Key
"merge_commit_sha"     Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
simplePullRequestMergeCommitSha
        , Key
"review_comments_url"  Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
simplePullRequestReviewCommentsUrl
        , Key
"html_url"             Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
simplePullRequestHtmlUrl
        , Key
"requested_reviewers"  Key -> [User] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [User]
simplePullRequestRequestedReviewers
        , Key
"requested_teams"      Key -> [Team] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Team]
simplePullRequestRequestedTeams
        , Key
"labels"               Key -> [Label] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Label]
simplePullRequestLabels
        ]


instance Arbitrary SimplePullRequest where
    arbitrary :: Gen SimplePullRequest
arbitrary = Text
-> Text
-> [User]
-> Text
-> Bool
-> Bool
-> Commit
-> Text
-> Commit
-> Text
-> Maybe Milestone
-> Text
-> Maybe DateTime
-> Text
-> Maybe User
-> Text
-> User
-> Text
-> PullRequestLinks
-> DateTime
-> Text
-> DateTime
-> Int
-> Text
-> Text
-> Text
-> Maybe DateTime
-> Int
-> Maybe Text
-> Text
-> Text
-> [User]
-> [Team]
-> [Label]
-> SimplePullRequest
SimplePullRequest
        (Text
 -> Text
 -> [User]
 -> Text
 -> Bool
 -> Bool
 -> Commit
 -> Text
 -> Commit
 -> Text
 -> Maybe Milestone
 -> Text
 -> Maybe DateTime
 -> Text
 -> Maybe User
 -> Text
 -> User
 -> Text
 -> PullRequestLinks
 -> DateTime
 -> Text
 -> DateTime
 -> Int
 -> Text
 -> Text
 -> Text
 -> Maybe DateTime
 -> Int
 -> Maybe Text
 -> Text
 -> Text
 -> [User]
 -> [Team]
 -> [Label]
 -> SimplePullRequest)
-> Gen Text
-> Gen
     (Text
      -> [User]
      -> Text
      -> Bool
      -> Bool
      -> Commit
      -> Text
      -> Commit
      -> Text
      -> Maybe Milestone
      -> Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> [User]
   -> Text
   -> Bool
   -> Bool
   -> Commit
   -> Text
   -> Commit
   -> Text
   -> Maybe Milestone
   -> Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen Text
-> Gen
     ([User]
      -> Text
      -> Bool
      -> Bool
      -> Commit
      -> Text
      -> Commit
      -> Text
      -> Maybe Milestone
      -> Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  ([User]
   -> Text
   -> Bool
   -> Bool
   -> Commit
   -> Text
   -> Commit
   -> Text
   -> Maybe Milestone
   -> Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen [User]
-> Gen
     (Text
      -> Bool
      -> Bool
      -> Commit
      -> Text
      -> Commit
      -> Text
      -> Maybe Milestone
      -> Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [User]
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Bool
   -> Bool
   -> Commit
   -> Text
   -> Commit
   -> Text
   -> Maybe Milestone
   -> Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen Text
-> Gen
     (Bool
      -> Bool
      -> Commit
      -> Text
      -> Commit
      -> Text
      -> Maybe Milestone
      -> Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Bool
   -> Bool
   -> Commit
   -> Text
   -> Commit
   -> Text
   -> Maybe Milestone
   -> Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen Bool
-> Gen
     (Bool
      -> Commit
      -> Text
      -> Commit
      -> Text
      -> Maybe Milestone
      -> Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Bool
   -> Commit
   -> Text
   -> Commit
   -> Text
   -> Maybe Milestone
   -> Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen Bool
-> Gen
     (Commit
      -> Text
      -> Commit
      -> Text
      -> Maybe Milestone
      -> Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Commit
   -> Text
   -> Commit
   -> Text
   -> Maybe Milestone
   -> Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen Commit
-> Gen
     (Text
      -> Commit
      -> Text
      -> Maybe Milestone
      -> Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Commit
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Commit
   -> Text
   -> Maybe Milestone
   -> Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen Text
-> Gen
     (Commit
      -> Text
      -> Maybe Milestone
      -> Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Commit
   -> Text
   -> Maybe Milestone
   -> Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen Commit
-> Gen
     (Text
      -> Maybe Milestone
      -> Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Commit
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Maybe Milestone
   -> Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen Text
-> Gen
     (Maybe Milestone
      -> Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Maybe Milestone
   -> Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen (Maybe Milestone)
-> Gen
     (Text
      -> Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Milestone)
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen Text
-> Gen
     (Maybe DateTime
      -> Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Maybe DateTime
   -> Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen (Maybe DateTime)
-> Gen
     (Text
      -> Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe DateTime)
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen Text
-> Gen
     (Maybe User
      -> Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Maybe User
   -> Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen (Maybe User)
-> Gen
     (Text
      -> User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe User)
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen Text
-> Gen
     (User
      -> Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (User
   -> Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen User
-> Gen
     (Text
      -> PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen User
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen Text
-> Gen
     (PullRequestLinks
      -> DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (PullRequestLinks
   -> DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen PullRequestLinks
-> Gen
     (DateTime
      -> Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen PullRequestLinks
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (DateTime
   -> Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen DateTime
-> Gen
     (Text
      -> DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen DateTime
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen Text
-> Gen
     (DateTime
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (DateTime
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen DateTime
-> Gen
     (Int
      -> Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen DateTime
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Int
   -> Text
   -> Text
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen Int
-> Gen
     (Text
      -> Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
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
   -> Text
   -> Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen Text
-> Gen
     (Text
      -> Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
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 DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen Text
-> Gen
     (Text
      -> Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
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 DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen Text
-> Gen
     (Maybe DateTime
      -> Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Maybe DateTime
   -> Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen (Maybe DateTime)
-> Gen
     (Int
      -> Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe DateTime)
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Int
   -> Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen Int
-> Gen
     (Maybe Text
      -> Text
      -> Text
      -> [User]
      -> [Team]
      -> [Label]
      -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Maybe Text
   -> Text
   -> Text
   -> [User]
   -> [Team]
   -> [Label]
   -> SimplePullRequest)
-> Gen (Maybe Text)
-> Gen
     (Text -> Text -> [User] -> [Team] -> [Label] -> SimplePullRequest)
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 -> [User] -> [Team] -> [Label] -> SimplePullRequest)
-> Gen Text
-> Gen (Text -> [User] -> [Team] -> [Label] -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> [User] -> [Team] -> [Label] -> SimplePullRequest)
-> Gen Text
-> Gen ([User] -> [Team] -> [Label] -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen ([User] -> [Team] -> [Label] -> SimplePullRequest)
-> Gen [User] -> Gen ([Team] -> [Label] -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [User]
forall a. Arbitrary a => Gen a
arbitrary
        Gen ([Team] -> [Label] -> SimplePullRequest)
-> Gen [Team] -> Gen ([Label] -> SimplePullRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [Team]
forall a. Arbitrary a => Gen a
arbitrary
        Gen ([Label] -> SimplePullRequest)
-> Gen [Label] -> Gen SimplePullRequest
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [Label]
forall a. Arbitrary a => Gen a
arbitrary