{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE StrictData        #-}
module GitHub.Types.Base.Issue 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.DateTime
import           GitHub.Types.Base.Label
import           GitHub.Types.Base.Milestone
import           GitHub.Types.Base.PullRequestRef
import           GitHub.Types.Base.Reactions
import           GitHub.Types.Base.User

------------------------------------------------------------------------------
-- Issue

data Issue = Issue
    { Issue -> Maybe Text
issueActiveLockReason      :: Maybe Text
    , Issue -> Maybe User
issueAssignee              :: Maybe User
    , Issue -> [User]
issueAssignees             :: [User]
    , Issue -> Text
issueAuthorAssociation     :: Text
    , Issue -> Maybe Text
issueBody                  :: Maybe Text
    , Issue -> Maybe DateTime
issueClosedAt              :: Maybe DateTime
    , Issue -> Int
issueComments              :: Int
    , Issue -> Text
issueCommentsUrl           :: Text
    , Issue -> DateTime
issueCreatedAt             :: DateTime
    , Issue -> Maybe Bool
issueDraft                 :: Maybe Bool
    , Issue -> Text
issueEventsUrl             :: Text
    , Issue -> Text
issueHtmlUrl               :: Text
    , Issue -> Int
issueId                    :: Int
    , Issue -> [Label]
issueLabels                :: [Label]
    , Issue -> Text
issueLabelsUrl             :: Text
    , Issue -> Bool
issueLocked                :: Bool
    , Issue -> Maybe Milestone
issueMilestone             :: Maybe Milestone
    , Issue -> Text
issueNodeId                :: Text
    , Issue -> Int
issueNumber                :: Int
    , Issue -> Maybe Text
issuePerformedViaGithubApp :: Maybe Text
    , Issue -> Maybe PullRequestRef
issuePullRequest           :: Maybe PullRequestRef
    , Issue -> Reactions
issueReactions             :: Reactions
    , Issue -> Text
issueRepositoryUrl         :: Text
    , Issue -> Text
issueState                 :: Text
    , Issue -> Text
issueTimelineUrl           :: Text
    , Issue -> Text
issueTitle                 :: Text
    , Issue -> DateTime
issueUpdatedAt             :: DateTime
    , Issue -> Text
issueUrl                   :: Text
    , Issue -> User
issueUser                  :: User
    } deriving (Issue -> Issue -> Bool
(Issue -> Issue -> Bool) -> (Issue -> Issue -> Bool) -> Eq Issue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Issue -> Issue -> Bool
$c/= :: Issue -> Issue -> Bool
== :: Issue -> Issue -> Bool
$c== :: Issue -> Issue -> Bool
Eq, Int -> Issue -> ShowS
[Issue] -> ShowS
Issue -> String
(Int -> Issue -> ShowS)
-> (Issue -> String) -> ([Issue] -> ShowS) -> Show Issue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Issue] -> ShowS
$cshowList :: [Issue] -> ShowS
show :: Issue -> String
$cshow :: Issue -> String
showsPrec :: Int -> Issue -> ShowS
$cshowsPrec :: Int -> Issue -> ShowS
Show, ReadPrec [Issue]
ReadPrec Issue
Int -> ReadS Issue
ReadS [Issue]
(Int -> ReadS Issue)
-> ReadS [Issue]
-> ReadPrec Issue
-> ReadPrec [Issue]
-> Read Issue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Issue]
$creadListPrec :: ReadPrec [Issue]
readPrec :: ReadPrec Issue
$creadPrec :: ReadPrec Issue
readList :: ReadS [Issue]
$creadList :: ReadS [Issue]
readsPrec :: Int -> ReadS Issue
$creadsPrec :: Int -> ReadS Issue
Read)


instance FromJSON Issue where
    parseJSON :: Value -> Parser Issue
parseJSON (Object Object
x) = Maybe Text
-> Maybe User
-> [User]
-> Text
-> Maybe Text
-> Maybe DateTime
-> Int
-> Text
-> DateTime
-> Maybe Bool
-> Text
-> Text
-> Int
-> [Label]
-> Text
-> Bool
-> Maybe Milestone
-> Text
-> Int
-> Maybe Text
-> Maybe PullRequestRef
-> Reactions
-> Text
-> Text
-> Text
-> Text
-> DateTime
-> Text
-> User
-> Issue
Issue
        (Maybe Text
 -> Maybe User
 -> [User]
 -> Text
 -> Maybe Text
 -> Maybe DateTime
 -> Int
 -> Text
 -> DateTime
 -> Maybe Bool
 -> Text
 -> Text
 -> Int
 -> [Label]
 -> Text
 -> Bool
 -> Maybe Milestone
 -> Text
 -> Int
 -> Maybe Text
 -> Maybe PullRequestRef
 -> Reactions
 -> Text
 -> Text
 -> Text
 -> Text
 -> DateTime
 -> Text
 -> User
 -> Issue)
-> Parser (Maybe Text)
-> Parser
     (Maybe User
      -> [User]
      -> Text
      -> Maybe Text
      -> Maybe DateTime
      -> Int
      -> Text
      -> DateTime
      -> Maybe Bool
      -> Text
      -> Text
      -> Int
      -> [Label]
      -> Text
      -> Bool
      -> Maybe Milestone
      -> Text
      -> Int
      -> Maybe Text
      -> Maybe PullRequestRef
      -> Reactions
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> User
      -> Issue)
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
"active_lock_reason"
        Parser
  (Maybe User
   -> [User]
   -> Text
   -> Maybe Text
   -> Maybe DateTime
   -> Int
   -> Text
   -> DateTime
   -> Maybe Bool
   -> Text
   -> Text
   -> Int
   -> [Label]
   -> Text
   -> Bool
   -> Maybe Milestone
   -> Text
   -> Int
   -> Maybe Text
   -> Maybe PullRequestRef
   -> Reactions
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> User
   -> Issue)
-> Parser (Maybe User)
-> Parser
     ([User]
      -> Text
      -> Maybe Text
      -> Maybe DateTime
      -> Int
      -> Text
      -> DateTime
      -> Maybe Bool
      -> Text
      -> Text
      -> Int
      -> [Label]
      -> Text
      -> Bool
      -> Maybe Milestone
      -> Text
      -> Int
      -> Maybe Text
      -> Maybe PullRequestRef
      -> Reactions
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> User
      -> Issue)
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
  ([User]
   -> Text
   -> Maybe Text
   -> Maybe DateTime
   -> Int
   -> Text
   -> DateTime
   -> Maybe Bool
   -> Text
   -> Text
   -> Int
   -> [Label]
   -> Text
   -> Bool
   -> Maybe Milestone
   -> Text
   -> Int
   -> Maybe Text
   -> Maybe PullRequestRef
   -> Reactions
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> User
   -> Issue)
-> Parser [User]
-> Parser
     (Text
      -> Maybe Text
      -> Maybe DateTime
      -> Int
      -> Text
      -> DateTime
      -> Maybe Bool
      -> Text
      -> Text
      -> Int
      -> [Label]
      -> Text
      -> Bool
      -> Maybe Milestone
      -> Text
      -> Int
      -> Maybe Text
      -> Maybe PullRequestRef
      -> Reactions
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> User
      -> Issue)
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
   -> Maybe Text
   -> Maybe DateTime
   -> Int
   -> Text
   -> DateTime
   -> Maybe Bool
   -> Text
   -> Text
   -> Int
   -> [Label]
   -> Text
   -> Bool
   -> Maybe Milestone
   -> Text
   -> Int
   -> Maybe Text
   -> Maybe PullRequestRef
   -> Reactions
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> User
   -> Issue)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe DateTime
      -> Int
      -> Text
      -> DateTime
      -> Maybe Bool
      -> Text
      -> Text
      -> Int
      -> [Label]
      -> Text
      -> Bool
      -> Maybe Milestone
      -> Text
      -> Int
      -> Maybe Text
      -> Maybe PullRequestRef
      -> Reactions
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> User
      -> Issue)
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
  (Maybe Text
   -> Maybe DateTime
   -> Int
   -> Text
   -> DateTime
   -> Maybe Bool
   -> Text
   -> Text
   -> Int
   -> [Label]
   -> Text
   -> Bool
   -> Maybe Milestone
   -> Text
   -> Int
   -> Maybe Text
   -> Maybe PullRequestRef
   -> Reactions
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> User
   -> Issue)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime
      -> Int
      -> Text
      -> DateTime
      -> Maybe Bool
      -> Text
      -> Text
      -> Int
      -> [Label]
      -> Text
      -> Bool
      -> Maybe Milestone
      -> Text
      -> Int
      -> Maybe Text
      -> Maybe PullRequestRef
      -> Reactions
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> User
      -> Issue)
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
"body"
        Parser
  (Maybe DateTime
   -> Int
   -> Text
   -> DateTime
   -> Maybe Bool
   -> Text
   -> Text
   -> Int
   -> [Label]
   -> Text
   -> Bool
   -> Maybe Milestone
   -> Text
   -> Int
   -> Maybe Text
   -> Maybe PullRequestRef
   -> Reactions
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> User
   -> Issue)
-> Parser (Maybe DateTime)
-> Parser
     (Int
      -> Text
      -> DateTime
      -> Maybe Bool
      -> Text
      -> Text
      -> Int
      -> [Label]
      -> Text
      -> Bool
      -> Maybe Milestone
      -> Text
      -> Int
      -> Maybe Text
      -> Maybe PullRequestRef
      -> Reactions
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> User
      -> Issue)
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
   -> Text
   -> DateTime
   -> Maybe Bool
   -> Text
   -> Text
   -> Int
   -> [Label]
   -> Text
   -> Bool
   -> Maybe Milestone
   -> Text
   -> Int
   -> Maybe Text
   -> Maybe PullRequestRef
   -> Reactions
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> User
   -> Issue)
-> Parser Int
-> Parser
     (Text
      -> DateTime
      -> Maybe Bool
      -> Text
      -> Text
      -> Int
      -> [Label]
      -> Text
      -> Bool
      -> Maybe Milestone
      -> Text
      -> Int
      -> Maybe Text
      -> Maybe PullRequestRef
      -> Reactions
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> User
      -> Issue)
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
"comments"
        Parser
  (Text
   -> DateTime
   -> Maybe Bool
   -> Text
   -> Text
   -> Int
   -> [Label]
   -> Text
   -> Bool
   -> Maybe Milestone
   -> Text
   -> Int
   -> Maybe Text
   -> Maybe PullRequestRef
   -> Reactions
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> User
   -> Issue)
-> Parser Text
-> Parser
     (DateTime
      -> Maybe Bool
      -> Text
      -> Text
      -> Int
      -> [Label]
      -> Text
      -> Bool
      -> Maybe Milestone
      -> Text
      -> Int
      -> Maybe Text
      -> Maybe PullRequestRef
      -> Reactions
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> User
      -> Issue)
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
  (DateTime
   -> Maybe Bool
   -> Text
   -> Text
   -> Int
   -> [Label]
   -> Text
   -> Bool
   -> Maybe Milestone
   -> Text
   -> Int
   -> Maybe Text
   -> Maybe PullRequestRef
   -> Reactions
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> User
   -> Issue)
-> Parser DateTime
-> Parser
     (Maybe Bool
      -> Text
      -> Text
      -> Int
      -> [Label]
      -> Text
      -> Bool
      -> Maybe Milestone
      -> Text
      -> Int
      -> Maybe Text
      -> Maybe PullRequestRef
      -> Reactions
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> User
      -> Issue)
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
  (Maybe Bool
   -> Text
   -> Text
   -> Int
   -> [Label]
   -> Text
   -> Bool
   -> Maybe Milestone
   -> Text
   -> Int
   -> Maybe Text
   -> Maybe PullRequestRef
   -> Reactions
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> User
   -> Issue)
-> Parser (Maybe Bool)
-> Parser
     (Text
      -> Text
      -> Int
      -> [Label]
      -> Text
      -> Bool
      -> Maybe Milestone
      -> Text
      -> Int
      -> Maybe Text
      -> Maybe PullRequestRef
      -> Reactions
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> User
      -> Issue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"draft"
        Parser
  (Text
   -> Text
   -> Int
   -> [Label]
   -> Text
   -> Bool
   -> Maybe Milestone
   -> Text
   -> Int
   -> Maybe Text
   -> Maybe PullRequestRef
   -> Reactions
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> User
   -> Issue)
-> Parser Text
-> Parser
     (Text
      -> Int
      -> [Label]
      -> Text
      -> Bool
      -> Maybe Milestone
      -> Text
      -> Int
      -> Maybe Text
      -> Maybe PullRequestRef
      -> Reactions
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> User
      -> Issue)
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
"events_url"
        Parser
  (Text
   -> Int
   -> [Label]
   -> Text
   -> Bool
   -> Maybe Milestone
   -> Text
   -> Int
   -> Maybe Text
   -> Maybe PullRequestRef
   -> Reactions
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> User
   -> Issue)
-> Parser Text
-> Parser
     (Int
      -> [Label]
      -> Text
      -> Bool
      -> Maybe Milestone
      -> Text
      -> Int
      -> Maybe Text
      -> Maybe PullRequestRef
      -> Reactions
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> User
      -> Issue)
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
  (Int
   -> [Label]
   -> Text
   -> Bool
   -> Maybe Milestone
   -> Text
   -> Int
   -> Maybe Text
   -> Maybe PullRequestRef
   -> Reactions
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> User
   -> Issue)
-> Parser Int
-> Parser
     ([Label]
      -> Text
      -> Bool
      -> Maybe Milestone
      -> Text
      -> Int
      -> Maybe Text
      -> Maybe PullRequestRef
      -> Reactions
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> User
      -> Issue)
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
  ([Label]
   -> Text
   -> Bool
   -> Maybe Milestone
   -> Text
   -> Int
   -> Maybe Text
   -> Maybe PullRequestRef
   -> Reactions
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> User
   -> Issue)
-> Parser [Label]
-> Parser
     (Text
      -> Bool
      -> Maybe Milestone
      -> Text
      -> Int
      -> Maybe Text
      -> Maybe PullRequestRef
      -> Reactions
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> User
      -> Issue)
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"
        Parser
  (Text
   -> Bool
   -> Maybe Milestone
   -> Text
   -> Int
   -> Maybe Text
   -> Maybe PullRequestRef
   -> Reactions
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> User
   -> Issue)
-> Parser Text
-> Parser
     (Bool
      -> Maybe Milestone
      -> Text
      -> Int
      -> Maybe Text
      -> Maybe PullRequestRef
      -> Reactions
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> User
      -> Issue)
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
"labels_url"
        Parser
  (Bool
   -> Maybe Milestone
   -> Text
   -> Int
   -> Maybe Text
   -> Maybe PullRequestRef
   -> Reactions
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> User
   -> Issue)
-> Parser Bool
-> Parser
     (Maybe Milestone
      -> Text
      -> Int
      -> Maybe Text
      -> Maybe PullRequestRef
      -> Reactions
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> User
      -> Issue)
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
  (Maybe Milestone
   -> Text
   -> Int
   -> Maybe Text
   -> Maybe PullRequestRef
   -> Reactions
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> User
   -> Issue)
-> Parser (Maybe Milestone)
-> Parser
     (Text
      -> Int
      -> Maybe Text
      -> Maybe PullRequestRef
      -> Reactions
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> User
      -> Issue)
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
   -> Int
   -> Maybe Text
   -> Maybe PullRequestRef
   -> Reactions
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> User
   -> Issue)
-> Parser Text
-> Parser
     (Int
      -> Maybe Text
      -> Maybe PullRequestRef
      -> Reactions
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> User
      -> Issue)
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
   -> Maybe Text
   -> Maybe PullRequestRef
   -> Reactions
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> User
   -> Issue)
-> Parser Int
-> Parser
     (Maybe Text
      -> Maybe PullRequestRef
      -> Reactions
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> User
      -> Issue)
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
   -> Maybe PullRequestRef
   -> Reactions
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> User
   -> Issue)
-> Parser (Maybe Text)
-> Parser
     (Maybe PullRequestRef
      -> Reactions
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> User
      -> Issue)
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
"performed_via_github_app"
        Parser
  (Maybe PullRequestRef
   -> Reactions
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> User
   -> Issue)
-> Parser (Maybe PullRequestRef)
-> Parser
     (Reactions
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> Text
      -> User
      -> Issue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe PullRequestRef)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pull_request"
        Parser
  (Reactions
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> Text
   -> User
   -> Issue)
-> Parser Reactions
-> Parser
     (Text -> Text -> Text -> Text -> DateTime -> Text -> User -> Issue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Reactions
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reactions"
        Parser
  (Text -> Text -> Text -> Text -> DateTime -> Text -> User -> Issue)
-> Parser Text
-> Parser
     (Text -> Text -> Text -> DateTime -> Text -> User -> Issue)
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
"repository_url"
        Parser (Text -> Text -> Text -> DateTime -> Text -> User -> Issue)
-> Parser Text
-> Parser (Text -> Text -> DateTime -> Text -> User -> Issue)
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
"state"
        Parser (Text -> Text -> DateTime -> Text -> User -> Issue)
-> Parser Text
-> Parser (Text -> DateTime -> Text -> User -> Issue)
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
"timeline_url"
        Parser (Text -> DateTime -> Text -> User -> Issue)
-> Parser Text -> Parser (DateTime -> Text -> User -> Issue)
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 (DateTime -> Text -> User -> Issue)
-> Parser DateTime -> Parser (Text -> User -> Issue)
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 -> User -> Issue)
-> Parser Text -> Parser (User -> Issue)
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 (User -> Issue) -> Parser User -> Parser Issue
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"

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


instance ToJSON Issue where
    toJSON :: Issue -> Value
toJSON Issue{Bool
Int
[Label]
[User]
Maybe Bool
Maybe Text
Maybe DateTime
Maybe PullRequestRef
Maybe User
Maybe Milestone
Text
DateTime
Reactions
User
issueUser :: User
issueUrl :: Text
issueUpdatedAt :: DateTime
issueTitle :: Text
issueTimelineUrl :: Text
issueState :: Text
issueRepositoryUrl :: Text
issueReactions :: Reactions
issuePullRequest :: Maybe PullRequestRef
issuePerformedViaGithubApp :: Maybe Text
issueNumber :: Int
issueNodeId :: Text
issueMilestone :: Maybe Milestone
issueLocked :: Bool
issueLabelsUrl :: Text
issueLabels :: [Label]
issueId :: Int
issueHtmlUrl :: Text
issueEventsUrl :: Text
issueDraft :: Maybe Bool
issueCreatedAt :: DateTime
issueCommentsUrl :: Text
issueComments :: Int
issueClosedAt :: Maybe DateTime
issueBody :: Maybe Text
issueAuthorAssociation :: Text
issueAssignees :: [User]
issueAssignee :: Maybe User
issueActiveLockReason :: Maybe Text
issueUser :: Issue -> User
issueUrl :: Issue -> Text
issueUpdatedAt :: Issue -> DateTime
issueTitle :: Issue -> Text
issueTimelineUrl :: Issue -> Text
issueState :: Issue -> Text
issueRepositoryUrl :: Issue -> Text
issueReactions :: Issue -> Reactions
issuePullRequest :: Issue -> Maybe PullRequestRef
issuePerformedViaGithubApp :: Issue -> Maybe Text
issueNumber :: Issue -> Int
issueNodeId :: Issue -> Text
issueMilestone :: Issue -> Maybe Milestone
issueLocked :: Issue -> Bool
issueLabelsUrl :: Issue -> Text
issueLabels :: Issue -> [Label]
issueId :: Issue -> Int
issueHtmlUrl :: Issue -> Text
issueEventsUrl :: Issue -> Text
issueDraft :: Issue -> Maybe Bool
issueCreatedAt :: Issue -> DateTime
issueCommentsUrl :: Issue -> Text
issueComments :: Issue -> Int
issueClosedAt :: Issue -> Maybe DateTime
issueBody :: Issue -> Maybe Text
issueAuthorAssociation :: Issue -> Text
issueAssignees :: Issue -> [User]
issueAssignee :: Issue -> Maybe User
issueActiveLockReason :: Issue -> Maybe Text
..} = [Pair] -> Value
object
        [ Key
"active_lock_reason"       Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
issueActiveLockReason
        , Key
"assignee"                 Key -> Maybe User -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe User
issueAssignee
        , Key
"assignees"                Key -> [User] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [User]
issueAssignees
        , Key
"author_association"       Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueAuthorAssociation
        , Key
"body"                     Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
issueBody
        , Key
"closed_at"                Key -> Maybe DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe DateTime
issueClosedAt
        , Key
"comments"                 Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
issueComments
        , Key
"comments_url"             Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueCommentsUrl
        , Key
"created_at"               Key -> DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DateTime
issueCreatedAt
        , Key
"draft"                    Key -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
issueDraft
        , Key
"events_url"               Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueEventsUrl
        , Key
"html_url"                 Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueHtmlUrl
        , Key
"id"                       Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
issueId
        , Key
"labels"                   Key -> [Label] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Label]
issueLabels
        , Key
"labels_url"               Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueLabelsUrl
        , Key
"locked"                   Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
issueLocked
        , Key
"milestone"                Key -> Maybe Milestone -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Milestone
issueMilestone
        , Key
"node_id"                  Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueNodeId
        , Key
"number"                   Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
issueNumber
        , Key
"performed_via_github_app" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
issuePerformedViaGithubApp
        , Key
"pull_request"             Key -> Maybe PullRequestRef -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe PullRequestRef
issuePullRequest
        , Key
"reactions"                Key -> Reactions -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Reactions
issueReactions
        , Key
"repository_url"           Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueRepositoryUrl
        , Key
"state"                    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueState
        , Key
"timeline_url"             Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueTimelineUrl
        , Key
"title"                    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueTitle
        , Key
"updated_at"               Key -> DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DateTime
issueUpdatedAt
        , Key
"url"                      Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueUrl
        , Key
"user"                     Key -> User -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= User
issueUser
        ]


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