{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE StrictData        #-}
module GitHub.Types.Base.ReviewComment 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.ReviewCommentLinks
import           GitHub.Types.Base.User

------------------------------------------------------------------------------
-- ReviewComment

data ReviewComment = ReviewComment
    { ReviewComment -> Text
reviewCommentAuthorAssociation   :: Text
    , ReviewComment -> Text
reviewCommentBody                :: Text
    , ReviewComment -> Text
reviewCommentCommitId            :: Text
    , ReviewComment -> DateTime
reviewCommentCreatedAt           :: DateTime
    , ReviewComment -> Text
reviewCommentDiffHunk            :: Text
    , ReviewComment -> Text
reviewCommentHtmlUrl             :: Text
    , ReviewComment -> Int
reviewCommentId                  :: Int
    , ReviewComment -> Int
reviewCommentLine                :: Int
    , ReviewComment -> ReviewCommentLinks
reviewCommentLinks               :: ReviewCommentLinks
    , ReviewComment -> Text
reviewCommentNodeId              :: Text
    , ReviewComment -> Text
reviewCommentOriginalCommitId    :: Text
    , ReviewComment -> Int
reviewCommentOriginalLine        :: Int
    , ReviewComment -> Maybe Int
reviewCommentOriginalPosition    :: Maybe Int
    , ReviewComment -> Maybe Int
reviewCommentOriginalStartLine   :: Maybe Int
    , ReviewComment -> Maybe Text
reviewCommentPath                :: Maybe Text
    , ReviewComment -> Maybe Int
reviewCommentPosition            :: Maybe Int
    , ReviewComment -> Int
reviewCommentPullRequestReviewId :: Int
    , ReviewComment -> Text
reviewCommentPullRequestUrl      :: Text
    , ReviewComment -> Text
reviewCommentSide                :: Text
    , ReviewComment -> Maybe Int
reviewCommentStartLine           :: Maybe Int
    , ReviewComment -> Maybe Text
reviewCommentStartSide           :: Maybe Text
    , ReviewComment -> DateTime
reviewCommentUpdatedAt           :: DateTime
    , ReviewComment -> Text
reviewCommentUrl                 :: Text
    , ReviewComment -> User
reviewCommentUser                :: User
    } deriving (ReviewComment -> ReviewComment -> Bool
(ReviewComment -> ReviewComment -> Bool)
-> (ReviewComment -> ReviewComment -> Bool) -> Eq ReviewComment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReviewComment -> ReviewComment -> Bool
$c/= :: ReviewComment -> ReviewComment -> Bool
== :: ReviewComment -> ReviewComment -> Bool
$c== :: ReviewComment -> ReviewComment -> Bool
Eq, Int -> ReviewComment -> ShowS
[ReviewComment] -> ShowS
ReviewComment -> String
(Int -> ReviewComment -> ShowS)
-> (ReviewComment -> String)
-> ([ReviewComment] -> ShowS)
-> Show ReviewComment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReviewComment] -> ShowS
$cshowList :: [ReviewComment] -> ShowS
show :: ReviewComment -> String
$cshow :: ReviewComment -> String
showsPrec :: Int -> ReviewComment -> ShowS
$cshowsPrec :: Int -> ReviewComment -> ShowS
Show, ReadPrec [ReviewComment]
ReadPrec ReviewComment
Int -> ReadS ReviewComment
ReadS [ReviewComment]
(Int -> ReadS ReviewComment)
-> ReadS [ReviewComment]
-> ReadPrec ReviewComment
-> ReadPrec [ReviewComment]
-> Read ReviewComment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReviewComment]
$creadListPrec :: ReadPrec [ReviewComment]
readPrec :: ReadPrec ReviewComment
$creadPrec :: ReadPrec ReviewComment
readList :: ReadS [ReviewComment]
$creadList :: ReadS [ReviewComment]
readsPrec :: Int -> ReadS ReviewComment
$creadsPrec :: Int -> ReadS ReviewComment
Read)


instance FromJSON ReviewComment where
    parseJSON :: Value -> Parser ReviewComment
parseJSON (Object Object
x) = Text
-> Text
-> Text
-> DateTime
-> Text
-> Text
-> Int
-> Int
-> ReviewCommentLinks
-> Text
-> Text
-> Int
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> Maybe Int
-> Int
-> Text
-> Text
-> Maybe Int
-> Maybe Text
-> DateTime
-> Text
-> User
-> ReviewComment
ReviewComment
        (Text
 -> Text
 -> Text
 -> DateTime
 -> Text
 -> Text
 -> Int
 -> Int
 -> ReviewCommentLinks
 -> Text
 -> Text
 -> Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Text
 -> Maybe Int
 -> Int
 -> Text
 -> Text
 -> Maybe Int
 -> Maybe Text
 -> DateTime
 -> Text
 -> User
 -> ReviewComment)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> DateTime
      -> Text
      -> Text
      -> Int
      -> Int
      -> ReviewCommentLinks
      -> Text
      -> Text
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
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
"author_association"
        Parser
  (Text
   -> Text
   -> DateTime
   -> Text
   -> Text
   -> Int
   -> Int
   -> ReviewCommentLinks
   -> Text
   -> Text
   -> Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Parser Text
-> Parser
     (Text
      -> DateTime
      -> Text
      -> Text
      -> Int
      -> Int
      -> ReviewCommentLinks
      -> Text
      -> Text
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
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
  (Text
   -> DateTime
   -> Text
   -> Text
   -> Int
   -> Int
   -> ReviewCommentLinks
   -> Text
   -> Text
   -> Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Parser Text
-> Parser
     (DateTime
      -> Text
      -> Text
      -> Int
      -> Int
      -> ReviewCommentLinks
      -> Text
      -> Text
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
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
"commit_id"
        Parser
  (DateTime
   -> Text
   -> Text
   -> Int
   -> Int
   -> ReviewCommentLinks
   -> Text
   -> Text
   -> Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Parser DateTime
-> Parser
     (Text
      -> Text
      -> Int
      -> Int
      -> ReviewCommentLinks
      -> Text
      -> Text
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
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
  (Text
   -> Text
   -> Int
   -> Int
   -> ReviewCommentLinks
   -> Text
   -> Text
   -> Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Parser Text
-> Parser
     (Text
      -> Int
      -> Int
      -> ReviewCommentLinks
      -> Text
      -> Text
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
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_hunk"
        Parser
  (Text
   -> Int
   -> Int
   -> ReviewCommentLinks
   -> Text
   -> Text
   -> Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Parser Text
-> Parser
     (Int
      -> Int
      -> ReviewCommentLinks
      -> Text
      -> Text
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
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
   -> Int
   -> ReviewCommentLinks
   -> Text
   -> Text
   -> Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Parser Int
-> Parser
     (Int
      -> ReviewCommentLinks
      -> Text
      -> Text
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        Parser
  (Int
   -> ReviewCommentLinks
   -> Text
   -> Text
   -> Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Parser Int
-> Parser
     (ReviewCommentLinks
      -> Text
      -> Text
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
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
"line"
        Parser
  (ReviewCommentLinks
   -> Text
   -> Text
   -> Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Parser ReviewCommentLinks
-> Parser
     (Text
      -> Text
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser ReviewCommentLinks
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_links"
        Parser
  (Text
   -> Text
   -> Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Parser Text
-> Parser
     (Text
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
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
   -> Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Parser Text
-> Parser
     (Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
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
"original_commit_id"
        Parser
  (Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Parser Int
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
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
"original_line"
        Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"original_position"
        Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"original_start_line"
        Parser
  (Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
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
"path"
        Parser
  (Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Parser (Maybe Int)
-> Parser
     (Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"position"
        Parser
  (Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Parser Int
-> Parser
     (Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
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
"pull_request_review_id"
        Parser
  (Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Parser Text
-> Parser
     (Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
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
"pull_request_url"
        Parser
  (Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Parser Text
-> Parser
     (Maybe Int
      -> Maybe Text -> DateTime -> Text -> User -> ReviewComment)
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
"side"
        Parser
  (Maybe Int
   -> Maybe Text -> DateTime -> Text -> User -> ReviewComment)
-> Parser (Maybe Int)
-> Parser (Maybe Text -> DateTime -> Text -> User -> ReviewComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"start_line"
        Parser (Maybe Text -> DateTime -> Text -> User -> ReviewComment)
-> Parser (Maybe Text)
-> Parser (DateTime -> Text -> User -> ReviewComment)
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
"start_side"
        Parser (DateTime -> Text -> User -> ReviewComment)
-> Parser DateTime -> Parser (Text -> User -> ReviewComment)
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 -> ReviewComment)
-> Parser Text -> Parser (User -> ReviewComment)
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 -> ReviewComment)
-> Parser User -> Parser ReviewComment
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 ReviewComment
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ReviewComment"


instance ToJSON ReviewComment where
    toJSON :: ReviewComment -> Value
toJSON ReviewComment{Int
Maybe Int
Maybe Text
Text
DateTime
ReviewCommentLinks
User
reviewCommentUser :: User
reviewCommentUrl :: Text
reviewCommentUpdatedAt :: DateTime
reviewCommentStartSide :: Maybe Text
reviewCommentStartLine :: Maybe Int
reviewCommentSide :: Text
reviewCommentPullRequestUrl :: Text
reviewCommentPullRequestReviewId :: Int
reviewCommentPosition :: Maybe Int
reviewCommentPath :: Maybe Text
reviewCommentOriginalStartLine :: Maybe Int
reviewCommentOriginalPosition :: Maybe Int
reviewCommentOriginalLine :: Int
reviewCommentOriginalCommitId :: Text
reviewCommentNodeId :: Text
reviewCommentLinks :: ReviewCommentLinks
reviewCommentLine :: Int
reviewCommentId :: Int
reviewCommentHtmlUrl :: Text
reviewCommentDiffHunk :: Text
reviewCommentCreatedAt :: DateTime
reviewCommentCommitId :: Text
reviewCommentBody :: Text
reviewCommentAuthorAssociation :: Text
reviewCommentUser :: ReviewComment -> User
reviewCommentUrl :: ReviewComment -> Text
reviewCommentUpdatedAt :: ReviewComment -> DateTime
reviewCommentStartSide :: ReviewComment -> Maybe Text
reviewCommentStartLine :: ReviewComment -> Maybe Int
reviewCommentSide :: ReviewComment -> Text
reviewCommentPullRequestUrl :: ReviewComment -> Text
reviewCommentPullRequestReviewId :: ReviewComment -> Int
reviewCommentPosition :: ReviewComment -> Maybe Int
reviewCommentPath :: ReviewComment -> Maybe Text
reviewCommentOriginalStartLine :: ReviewComment -> Maybe Int
reviewCommentOriginalPosition :: ReviewComment -> Maybe Int
reviewCommentOriginalLine :: ReviewComment -> Int
reviewCommentOriginalCommitId :: ReviewComment -> Text
reviewCommentNodeId :: ReviewComment -> Text
reviewCommentLinks :: ReviewComment -> ReviewCommentLinks
reviewCommentLine :: ReviewComment -> Int
reviewCommentId :: ReviewComment -> Int
reviewCommentHtmlUrl :: ReviewComment -> Text
reviewCommentDiffHunk :: ReviewComment -> Text
reviewCommentCreatedAt :: ReviewComment -> DateTime
reviewCommentCommitId :: ReviewComment -> Text
reviewCommentBody :: ReviewComment -> Text
reviewCommentAuthorAssociation :: ReviewComment -> Text
..} = [Pair] -> Value
object
        [ Key
"author_association"     Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reviewCommentAuthorAssociation
        , Key
"body"                   Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reviewCommentBody
        , Key
"commit_id"              Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reviewCommentCommitId
        , Key
"created_at"             Key -> DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DateTime
reviewCommentCreatedAt
        , Key
"diff_hunk"              Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reviewCommentDiffHunk
        , Key
"html_url"               Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reviewCommentHtmlUrl
        , Key
"id"                     Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
reviewCommentId
        , Key
"line"                   Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
reviewCommentLine
        , Key
"_links"                 Key -> ReviewCommentLinks -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ReviewCommentLinks
reviewCommentLinks
        , Key
"node_id"                Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reviewCommentNodeId
        , Key
"original_commit_id"     Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reviewCommentOriginalCommitId
        , Key
"original_line"          Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
reviewCommentOriginalLine
        , Key
"original_position"      Key -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
reviewCommentOriginalPosition
        , Key
"original_start_line"    Key -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
reviewCommentOriginalStartLine
        , Key
"path"                   Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
reviewCommentPath
        , Key
"position"               Key -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
reviewCommentPosition
        , Key
"pull_request_review_id" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
reviewCommentPullRequestReviewId
        , Key
"pull_request_url"       Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reviewCommentPullRequestUrl
        , Key
"side"                   Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reviewCommentSide
        , Key
"start_line"             Key -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
reviewCommentStartLine
        , Key
"start_side"             Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
reviewCommentStartSide
        , Key
"updated_at"             Key -> DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DateTime
reviewCommentUpdatedAt
        , Key
"url"                    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reviewCommentUrl
        , Key
"user"                   Key -> User -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= User
reviewCommentUser
        ]


instance Arbitrary ReviewComment where
    arbitrary :: Gen ReviewComment
arbitrary = Text
-> Text
-> Text
-> DateTime
-> Text
-> Text
-> Int
-> Int
-> ReviewCommentLinks
-> Text
-> Text
-> Int
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> Maybe Int
-> Int
-> Text
-> Text
-> Maybe Int
-> Maybe Text
-> DateTime
-> Text
-> User
-> ReviewComment
ReviewComment
        (Text
 -> Text
 -> Text
 -> DateTime
 -> Text
 -> Text
 -> Int
 -> Int
 -> ReviewCommentLinks
 -> Text
 -> Text
 -> Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Text
 -> Maybe Int
 -> Int
 -> Text
 -> Text
 -> Maybe Int
 -> Maybe Text
 -> DateTime
 -> Text
 -> User
 -> ReviewComment)
-> Gen Text
-> Gen
     (Text
      -> Text
      -> DateTime
      -> Text
      -> Text
      -> Int
      -> Int
      -> ReviewCommentLinks
      -> Text
      -> Text
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Text
   -> DateTime
   -> Text
   -> Text
   -> Int
   -> Int
   -> ReviewCommentLinks
   -> Text
   -> Text
   -> Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Gen Text
-> Gen
     (Text
      -> DateTime
      -> Text
      -> Text
      -> Int
      -> Int
      -> ReviewCommentLinks
      -> Text
      -> Text
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
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
   -> Text
   -> Int
   -> Int
   -> ReviewCommentLinks
   -> Text
   -> Text
   -> Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Gen Text
-> Gen
     (DateTime
      -> Text
      -> Text
      -> Int
      -> Int
      -> ReviewCommentLinks
      -> Text
      -> Text
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
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
   -> Text
   -> Int
   -> Int
   -> ReviewCommentLinks
   -> Text
   -> Text
   -> Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Gen DateTime
-> Gen
     (Text
      -> Text
      -> Int
      -> Int
      -> ReviewCommentLinks
      -> Text
      -> Text
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen DateTime
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Text
   -> Int
   -> Int
   -> ReviewCommentLinks
   -> Text
   -> Text
   -> Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Gen Text
-> Gen
     (Text
      -> Int
      -> Int
      -> ReviewCommentLinks
      -> Text
      -> Text
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Int
   -> Int
   -> ReviewCommentLinks
   -> Text
   -> Text
   -> Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Gen Text
-> Gen
     (Int
      -> Int
      -> ReviewCommentLinks
      -> Text
      -> Text
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Int
   -> Int
   -> ReviewCommentLinks
   -> Text
   -> Text
   -> Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Gen Int
-> Gen
     (Int
      -> ReviewCommentLinks
      -> Text
      -> Text
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Int
   -> ReviewCommentLinks
   -> Text
   -> Text
   -> Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Gen Int
-> Gen
     (ReviewCommentLinks
      -> Text
      -> Text
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (ReviewCommentLinks
   -> Text
   -> Text
   -> Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Gen ReviewCommentLinks
-> Gen
     (Text
      -> Text
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ReviewCommentLinks
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Text
   -> Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Gen Text
-> Gen
     (Text
      -> Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
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
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Gen Text
-> Gen
     (Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
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 Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Gen Int
-> Gen
     (Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Gen (Maybe Int)
-> Gen
     (Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Int)
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Gen (Maybe Int)
-> Gen
     (Maybe Text
      -> Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Int)
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Maybe Text
   -> Maybe Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Gen (Maybe Text)
-> Gen
     (Maybe Int
      -> Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
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 Int
   -> Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Gen (Maybe Int)
-> Gen
     (Int
      -> Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Int)
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Int
   -> Text
   -> Text
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Gen Int
-> Gen
     (Text
      -> Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
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
   -> Maybe Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Gen Text
-> Gen
     (Text
      -> Maybe Int
      -> Maybe Text
      -> DateTime
      -> Text
      -> User
      -> ReviewComment)
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 Int
   -> Maybe Text
   -> DateTime
   -> Text
   -> User
   -> ReviewComment)
-> Gen Text
-> Gen
     (Maybe Int
      -> Maybe Text -> DateTime -> Text -> User -> ReviewComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Maybe Int
   -> Maybe Text -> DateTime -> Text -> User -> ReviewComment)
-> Gen (Maybe Int)
-> Gen (Maybe Text -> DateTime -> Text -> User -> ReviewComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Int)
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Maybe Text -> DateTime -> Text -> User -> ReviewComment)
-> Gen (Maybe Text)
-> Gen (DateTime -> Text -> User -> ReviewComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Text)
forall a. Arbitrary a => Gen a
arbitrary
        Gen (DateTime -> Text -> User -> ReviewComment)
-> Gen DateTime -> Gen (Text -> User -> ReviewComment)
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 -> ReviewComment)
-> Gen Text -> Gen (User -> ReviewComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (User -> ReviewComment) -> Gen User -> Gen ReviewComment
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen User
forall a. Arbitrary a => Gen a
arbitrary