{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE StrictData        #-}
module GitHub.Types.Events.IssueCommentEvent 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
import           GitHub.Types.Event


data IssueCommentEvent = IssueCommentEvent
    { IssueCommentEvent -> Maybe Installation
issueCommentEventInstallation :: Maybe Installation
    , IssueCommentEvent -> Organization
issueCommentEventOrganization :: Organization
    , IssueCommentEvent -> Repository
issueCommentEventRepository   :: Repository
    , IssueCommentEvent -> User
issueCommentEventSender       :: User

    , IssueCommentEvent -> Text
issueCommentEventAction       :: Text
    , IssueCommentEvent -> Maybe Changes
issueCommentEventChanges      :: Maybe Changes
    , IssueCommentEvent -> IssueComment
issueCommentEventComment      :: IssueComment
    , IssueCommentEvent -> Issue
issueCommentEventIssue        :: Issue
    } deriving (IssueCommentEvent -> IssueCommentEvent -> Bool
(IssueCommentEvent -> IssueCommentEvent -> Bool)
-> (IssueCommentEvent -> IssueCommentEvent -> Bool)
-> Eq IssueCommentEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IssueCommentEvent -> IssueCommentEvent -> Bool
$c/= :: IssueCommentEvent -> IssueCommentEvent -> Bool
== :: IssueCommentEvent -> IssueCommentEvent -> Bool
$c== :: IssueCommentEvent -> IssueCommentEvent -> Bool
Eq, Int -> IssueCommentEvent -> ShowS
[IssueCommentEvent] -> ShowS
IssueCommentEvent -> String
(Int -> IssueCommentEvent -> ShowS)
-> (IssueCommentEvent -> String)
-> ([IssueCommentEvent] -> ShowS)
-> Show IssueCommentEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IssueCommentEvent] -> ShowS
$cshowList :: [IssueCommentEvent] -> ShowS
show :: IssueCommentEvent -> String
$cshow :: IssueCommentEvent -> String
showsPrec :: Int -> IssueCommentEvent -> ShowS
$cshowsPrec :: Int -> IssueCommentEvent -> ShowS
Show, ReadPrec [IssueCommentEvent]
ReadPrec IssueCommentEvent
Int -> ReadS IssueCommentEvent
ReadS [IssueCommentEvent]
(Int -> ReadS IssueCommentEvent)
-> ReadS [IssueCommentEvent]
-> ReadPrec IssueCommentEvent
-> ReadPrec [IssueCommentEvent]
-> Read IssueCommentEvent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IssueCommentEvent]
$creadListPrec :: ReadPrec [IssueCommentEvent]
readPrec :: ReadPrec IssueCommentEvent
$creadPrec :: ReadPrec IssueCommentEvent
readList :: ReadS [IssueCommentEvent]
$creadList :: ReadS [IssueCommentEvent]
readsPrec :: Int -> ReadS IssueCommentEvent
$creadsPrec :: Int -> ReadS IssueCommentEvent
Read)

instance Event IssueCommentEvent where
    typeName :: TypeName IssueCommentEvent
typeName = Text -> TypeName IssueCommentEvent
forall a. Text -> TypeName a
TypeName Text
"IssueCommentEvent"
    eventName :: EventName IssueCommentEvent
eventName = Text -> EventName IssueCommentEvent
forall a. Text -> EventName a
EventName Text
"issue_comment"

instance FromJSON IssueCommentEvent where
    parseJSON :: Value -> Parser IssueCommentEvent
parseJSON (Object Object
x) = Maybe Installation
-> Organization
-> Repository
-> User
-> Text
-> Maybe Changes
-> IssueComment
-> Issue
-> IssueCommentEvent
IssueCommentEvent
        (Maybe Installation
 -> Organization
 -> Repository
 -> User
 -> Text
 -> Maybe Changes
 -> IssueComment
 -> Issue
 -> IssueCommentEvent)
-> Parser (Maybe Installation)
-> Parser
     (Organization
      -> Repository
      -> User
      -> Text
      -> Maybe Changes
      -> IssueComment
      -> Issue
      -> IssueCommentEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
x Object -> Key -> Parser (Maybe Installation)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"installation"
        Parser
  (Organization
   -> Repository
   -> User
   -> Text
   -> Maybe Changes
   -> IssueComment
   -> Issue
   -> IssueCommentEvent)
-> Parser Organization
-> Parser
     (Repository
      -> User
      -> Text
      -> Maybe Changes
      -> IssueComment
      -> Issue
      -> IssueCommentEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Organization
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"organization"
        Parser
  (Repository
   -> User
   -> Text
   -> Maybe Changes
   -> IssueComment
   -> Issue
   -> IssueCommentEvent)
-> Parser Repository
-> Parser
     (User
      -> Text
      -> Maybe Changes
      -> IssueComment
      -> Issue
      -> IssueCommentEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Repository
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"repository"
        Parser
  (User
   -> Text
   -> Maybe Changes
   -> IssueComment
   -> Issue
   -> IssueCommentEvent)
-> Parser User
-> Parser
     (Text
      -> Maybe Changes -> IssueComment -> Issue -> IssueCommentEvent)
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
"sender"

        Parser
  (Text
   -> Maybe Changes -> IssueComment -> Issue -> IssueCommentEvent)
-> Parser Text
-> Parser
     (Maybe Changes -> IssueComment -> Issue -> IssueCommentEvent)
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
"action"
        Parser
  (Maybe Changes -> IssueComment -> Issue -> IssueCommentEvent)
-> Parser (Maybe Changes)
-> Parser (IssueComment -> Issue -> IssueCommentEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe Changes)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"changes"
        Parser (IssueComment -> Issue -> IssueCommentEvent)
-> Parser IssueComment -> Parser (Issue -> IssueCommentEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser IssueComment
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"comment"
        Parser (Issue -> IssueCommentEvent)
-> Parser Issue -> Parser IssueCommentEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Issue
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"issue"

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

instance ToJSON IssueCommentEvent where
    toJSON :: IssueCommentEvent -> Value
toJSON IssueCommentEvent{Maybe Changes
Maybe Installation
Text
Organization
User
IssueComment
Issue
Repository
issueCommentEventIssue :: Issue
issueCommentEventComment :: IssueComment
issueCommentEventChanges :: Maybe Changes
issueCommentEventAction :: Text
issueCommentEventSender :: User
issueCommentEventRepository :: Repository
issueCommentEventOrganization :: Organization
issueCommentEventInstallation :: Maybe Installation
issueCommentEventIssue :: IssueCommentEvent -> Issue
issueCommentEventComment :: IssueCommentEvent -> IssueComment
issueCommentEventChanges :: IssueCommentEvent -> Maybe Changes
issueCommentEventAction :: IssueCommentEvent -> Text
issueCommentEventSender :: IssueCommentEvent -> User
issueCommentEventRepository :: IssueCommentEvent -> Repository
issueCommentEventOrganization :: IssueCommentEvent -> Organization
issueCommentEventInstallation :: IssueCommentEvent -> Maybe Installation
..} = [Pair] -> Value
object
        [ Key
"installation" Key -> Maybe Installation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Installation
issueCommentEventInstallation
        , Key
"organization" Key -> Organization -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Organization
issueCommentEventOrganization
        , Key
"repository"   Key -> Repository -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Repository
issueCommentEventRepository
        , Key
"sender"       Key -> User -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= User
issueCommentEventSender

        , Key
"action"       Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
issueCommentEventAction
        , Key
"changes"      Key -> Maybe Changes -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Changes
issueCommentEventChanges
        , Key
"comment"      Key -> IssueComment -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= IssueComment
issueCommentEventComment
        , Key
"issue"        Key -> Issue -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Issue
issueCommentEventIssue
        ]


instance Arbitrary IssueCommentEvent where
    arbitrary :: Gen IssueCommentEvent
arbitrary = Maybe Installation
-> Organization
-> Repository
-> User
-> Text
-> Maybe Changes
-> IssueComment
-> Issue
-> IssueCommentEvent
IssueCommentEvent
        (Maybe Installation
 -> Organization
 -> Repository
 -> User
 -> Text
 -> Maybe Changes
 -> IssueComment
 -> Issue
 -> IssueCommentEvent)
-> Gen (Maybe Installation)
-> Gen
     (Organization
      -> Repository
      -> User
      -> Text
      -> Maybe Changes
      -> IssueComment
      -> Issue
      -> IssueCommentEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe Installation)
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Organization
   -> Repository
   -> User
   -> Text
   -> Maybe Changes
   -> IssueComment
   -> Issue
   -> IssueCommentEvent)
-> Gen Organization
-> Gen
     (Repository
      -> User
      -> Text
      -> Maybe Changes
      -> IssueComment
      -> Issue
      -> IssueCommentEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Organization
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Repository
   -> User
   -> Text
   -> Maybe Changes
   -> IssueComment
   -> Issue
   -> IssueCommentEvent)
-> Gen Repository
-> Gen
     (User
      -> Text
      -> Maybe Changes
      -> IssueComment
      -> Issue
      -> IssueCommentEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Repository
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (User
   -> Text
   -> Maybe Changes
   -> IssueComment
   -> Issue
   -> IssueCommentEvent)
-> Gen User
-> Gen
     (Text
      -> Maybe Changes -> IssueComment -> Issue -> IssueCommentEvent)
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 Changes -> IssueComment -> Issue -> IssueCommentEvent)
-> Gen Text
-> Gen
     (Maybe Changes -> IssueComment -> Issue -> IssueCommentEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Maybe Changes -> IssueComment -> Issue -> IssueCommentEvent)
-> Gen (Maybe Changes)
-> Gen (IssueComment -> Issue -> IssueCommentEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Changes)
forall a. Arbitrary a => Gen a
arbitrary
        Gen (IssueComment -> Issue -> IssueCommentEvent)
-> Gen IssueComment -> Gen (Issue -> IssueCommentEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen IssueComment
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Issue -> IssueCommentEvent)
-> Gen Issue -> Gen IssueCommentEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Issue
forall a. Arbitrary a => Gen a
arbitrary