{-# 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
data =
{ :: Text
, ReviewComment -> Text
reviewCommentBody :: 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
} 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