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

------------------------------------------------------------------------------
-- IssueComment

data IssueComment = IssueComment
    { IssueComment -> Text
issueCommentAuthorAssociation     :: Text
    , IssueComment -> Text
issueCommentBody                  :: Text
    , IssueComment -> DateTime
issueCommentCreatedAt             :: DateTime
    , IssueComment -> Text
issueCommentHtmlUrl               :: Text
    , IssueComment -> Int
issueCommentId                    :: Int
    , IssueComment -> Text
issueCommentNodeId                :: Text
    , IssueComment -> Text
issueCommentIssueUrl              :: Text
    , IssueComment -> Maybe Bool
issueCommentPerformedViaGithubApp :: Maybe Bool
    , IssueComment -> Reactions
issueCommentReactions             :: Reactions
    , IssueComment -> DateTime
issueCommentUpdatedAt             :: DateTime
    , IssueComment -> Text
issueCommentUrl                   :: Text
    , IssueComment -> User
issueCommentUser                  :: User
    } deriving (IssueComment -> IssueComment -> Bool
(IssueComment -> IssueComment -> Bool)
-> (IssueComment -> IssueComment -> Bool) -> Eq IssueComment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IssueComment -> IssueComment -> Bool
$c/= :: IssueComment -> IssueComment -> Bool
== :: IssueComment -> IssueComment -> Bool
$c== :: IssueComment -> IssueComment -> Bool
Eq, Int -> IssueComment -> ShowS
[IssueComment] -> ShowS
IssueComment -> String
(Int -> IssueComment -> ShowS)
-> (IssueComment -> String)
-> ([IssueComment] -> ShowS)
-> Show IssueComment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IssueComment] -> ShowS
$cshowList :: [IssueComment] -> ShowS
show :: IssueComment -> String
$cshow :: IssueComment -> String
showsPrec :: Int -> IssueComment -> ShowS
$cshowsPrec :: Int -> IssueComment -> ShowS
Show, ReadPrec [IssueComment]
ReadPrec IssueComment
Int -> ReadS IssueComment
ReadS [IssueComment]
(Int -> ReadS IssueComment)
-> ReadS [IssueComment]
-> ReadPrec IssueComment
-> ReadPrec [IssueComment]
-> Read IssueComment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IssueComment]
$creadListPrec :: ReadPrec [IssueComment]
readPrec :: ReadPrec IssueComment
$creadPrec :: ReadPrec IssueComment
readList :: ReadS [IssueComment]
$creadList :: ReadS [IssueComment]
readsPrec :: Int -> ReadS IssueComment
$creadsPrec :: Int -> ReadS IssueComment
Read)


instance FromJSON IssueComment where
    parseJSON :: Value -> Parser IssueComment
parseJSON (Object Object
x) = Text
-> Text
-> DateTime
-> Text
-> Int
-> Text
-> Text
-> Maybe Bool
-> Reactions
-> DateTime
-> Text
-> User
-> IssueComment
IssueComment
        (Text
 -> Text
 -> DateTime
 -> Text
 -> Int
 -> Text
 -> Text
 -> Maybe Bool
 -> Reactions
 -> DateTime
 -> Text
 -> User
 -> IssueComment)
-> Parser Text
-> Parser
     (Text
      -> DateTime
      -> Text
      -> Int
      -> Text
      -> Text
      -> Maybe Bool
      -> Reactions
      -> DateTime
      -> Text
      -> User
      -> IssueComment)
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
   -> DateTime
   -> Text
   -> Int
   -> Text
   -> Text
   -> Maybe Bool
   -> Reactions
   -> DateTime
   -> Text
   -> User
   -> IssueComment)
-> Parser Text
-> Parser
     (DateTime
      -> Text
      -> Int
      -> Text
      -> Text
      -> Maybe Bool
      -> Reactions
      -> DateTime
      -> Text
      -> User
      -> IssueComment)
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
  (DateTime
   -> Text
   -> Int
   -> Text
   -> Text
   -> Maybe Bool
   -> Reactions
   -> DateTime
   -> Text
   -> User
   -> IssueComment)
-> Parser DateTime
-> Parser
     (Text
      -> Int
      -> Text
      -> Text
      -> Maybe Bool
      -> Reactions
      -> DateTime
      -> Text
      -> User
      -> IssueComment)
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
   -> Int
   -> Text
   -> Text
   -> Maybe Bool
   -> Reactions
   -> DateTime
   -> Text
   -> User
   -> IssueComment)
-> Parser Text
-> Parser
     (Int
      -> Text
      -> Text
      -> Maybe Bool
      -> Reactions
      -> DateTime
      -> Text
      -> User
      -> IssueComment)
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
   -> Text
   -> Text
   -> Maybe Bool
   -> Reactions
   -> DateTime
   -> Text
   -> User
   -> IssueComment)
-> Parser Int
-> Parser
     (Text
      -> Text
      -> Maybe Bool
      -> Reactions
      -> DateTime
      -> Text
      -> User
      -> IssueComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        Parser
  (Text
   -> Text
   -> Maybe Bool
   -> Reactions
   -> DateTime
   -> Text
   -> User
   -> IssueComment)
-> Parser Text
-> Parser
     (Text
      -> Maybe Bool
      -> Reactions
      -> DateTime
      -> Text
      -> User
      -> IssueComment)
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
   -> Maybe Bool
   -> Reactions
   -> DateTime
   -> Text
   -> User
   -> IssueComment)
-> Parser Text
-> Parser
     (Maybe Bool
      -> Reactions -> DateTime -> Text -> User -> IssueComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"issue_url"
        Parser
  (Maybe Bool
   -> Reactions -> DateTime -> Text -> User -> IssueComment)
-> Parser (Maybe Bool)
-> Parser (Reactions -> DateTime -> Text -> User -> IssueComment)
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
"performed_via_github_app"
        Parser (Reactions -> DateTime -> Text -> User -> IssueComment)
-> Parser Reactions
-> Parser (DateTime -> Text -> User -> IssueComment)
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 (DateTime -> Text -> User -> IssueComment)
-> Parser DateTime -> Parser (Text -> User -> IssueComment)
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 -> IssueComment)
-> Parser Text -> Parser (User -> IssueComment)
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 -> IssueComment) -> Parser User -> Parser IssueComment
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 IssueComment
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"IssueComment"


instance ToJSON IssueComment where
    toJSON :: IssueComment -> Value
toJSON IssueComment{Int
Maybe Bool
Text
DateTime
Reactions
User
issueCommentUser :: User
issueCommentUrl :: Text
issueCommentUpdatedAt :: DateTime
issueCommentReactions :: Reactions
issueCommentPerformedViaGithubApp :: Maybe Bool
issueCommentIssueUrl :: Text
issueCommentNodeId :: Text
issueCommentId :: Int
issueCommentHtmlUrl :: Text
issueCommentCreatedAt :: DateTime
issueCommentBody :: Text
issueCommentAuthorAssociation :: Text
issueCommentUser :: IssueComment -> User
issueCommentUrl :: IssueComment -> Text
issueCommentUpdatedAt :: IssueComment -> DateTime
issueCommentReactions :: IssueComment -> Reactions
issueCommentPerformedViaGithubApp :: IssueComment -> Maybe Bool
issueCommentIssueUrl :: IssueComment -> Text
issueCommentNodeId :: IssueComment -> Text
issueCommentId :: IssueComment -> Int
issueCommentHtmlUrl :: IssueComment -> Text
issueCommentCreatedAt :: IssueComment -> DateTime
issueCommentBody :: IssueComment -> Text
issueCommentAuthorAssociation :: IssueComment -> Text
..} = [Pair] -> Value
object
        [ Key
"author_association"       Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueCommentAuthorAssociation
        , Key
"body"                     Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueCommentBody
        , Key
"created_at"               Key -> DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DateTime
issueCommentCreatedAt
        , Key
"html_url"                 Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueCommentHtmlUrl
        , Key
"id"                       Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
issueCommentId
        , Key
"node_id"                  Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueCommentNodeId
        , Key
"issue_url"                Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueCommentIssueUrl
        , Key
"performed_via_github_app" Key -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
issueCommentPerformedViaGithubApp
        , Key
"reactions"                Key -> Reactions -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Reactions
issueCommentReactions
        , Key
"updated_at"               Key -> DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DateTime
issueCommentUpdatedAt
        , Key
"url"                      Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueCommentUrl
        , Key
"user"                     Key -> User -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= User
issueCommentUser
        ]


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