{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE StrictData        #-}
module GitHub.Types.Events.CommitCommentEvent 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 CommitCommentEvent = CommitCommentEvent
    { CommitCommentEvent -> Maybe Installation
commitCommentEventInstallation :: Maybe Installation
    , CommitCommentEvent -> Organization
commitCommentEventOrganization :: Organization
    , CommitCommentEvent -> Repository
commitCommentEventRepository   :: Repository
    , CommitCommentEvent -> User
commitCommentEventSender       :: User

    , CommitCommentEvent -> Text
commitCommentEventAction       :: Text
    , CommitCommentEvent -> CommitComment
commitCommentEventComment      :: CommitComment
    } deriving (CommitCommentEvent -> CommitCommentEvent -> Bool
(CommitCommentEvent -> CommitCommentEvent -> Bool)
-> (CommitCommentEvent -> CommitCommentEvent -> Bool)
-> Eq CommitCommentEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommitCommentEvent -> CommitCommentEvent -> Bool
$c/= :: CommitCommentEvent -> CommitCommentEvent -> Bool
== :: CommitCommentEvent -> CommitCommentEvent -> Bool
$c== :: CommitCommentEvent -> CommitCommentEvent -> Bool
Eq, Int -> CommitCommentEvent -> ShowS
[CommitCommentEvent] -> ShowS
CommitCommentEvent -> String
(Int -> CommitCommentEvent -> ShowS)
-> (CommitCommentEvent -> String)
-> ([CommitCommentEvent] -> ShowS)
-> Show CommitCommentEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommitCommentEvent] -> ShowS
$cshowList :: [CommitCommentEvent] -> ShowS
show :: CommitCommentEvent -> String
$cshow :: CommitCommentEvent -> String
showsPrec :: Int -> CommitCommentEvent -> ShowS
$cshowsPrec :: Int -> CommitCommentEvent -> ShowS
Show, ReadPrec [CommitCommentEvent]
ReadPrec CommitCommentEvent
Int -> ReadS CommitCommentEvent
ReadS [CommitCommentEvent]
(Int -> ReadS CommitCommentEvent)
-> ReadS [CommitCommentEvent]
-> ReadPrec CommitCommentEvent
-> ReadPrec [CommitCommentEvent]
-> Read CommitCommentEvent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CommitCommentEvent]
$creadListPrec :: ReadPrec [CommitCommentEvent]
readPrec :: ReadPrec CommitCommentEvent
$creadPrec :: ReadPrec CommitCommentEvent
readList :: ReadS [CommitCommentEvent]
$creadList :: ReadS [CommitCommentEvent]
readsPrec :: Int -> ReadS CommitCommentEvent
$creadsPrec :: Int -> ReadS CommitCommentEvent
Read)

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

instance FromJSON CommitCommentEvent where
    parseJSON :: Value -> Parser CommitCommentEvent
parseJSON (Object Object
x) = Maybe Installation
-> Organization
-> Repository
-> User
-> Text
-> CommitComment
-> CommitCommentEvent
CommitCommentEvent
        (Maybe Installation
 -> Organization
 -> Repository
 -> User
 -> Text
 -> CommitComment
 -> CommitCommentEvent)
-> Parser (Maybe Installation)
-> Parser
     (Organization
      -> Repository
      -> User
      -> Text
      -> CommitComment
      -> CommitCommentEvent)
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
   -> CommitComment
   -> CommitCommentEvent)
-> Parser Organization
-> Parser
     (Repository -> User -> Text -> CommitComment -> CommitCommentEvent)
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 -> CommitComment -> CommitCommentEvent)
-> Parser Repository
-> Parser (User -> Text -> CommitComment -> CommitCommentEvent)
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 -> CommitComment -> CommitCommentEvent)
-> Parser User
-> Parser (Text -> CommitComment -> CommitCommentEvent)
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 -> CommitComment -> CommitCommentEvent)
-> Parser Text -> Parser (CommitComment -> CommitCommentEvent)
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 (CommitComment -> CommitCommentEvent)
-> Parser CommitComment -> Parser CommitCommentEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser CommitComment
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"comment"

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

instance ToJSON CommitCommentEvent where
    toJSON :: CommitCommentEvent -> Value
toJSON CommitCommentEvent{Maybe Installation
Text
Organization
User
CommitComment
Repository
commitCommentEventComment :: CommitComment
commitCommentEventAction :: Text
commitCommentEventSender :: User
commitCommentEventRepository :: Repository
commitCommentEventOrganization :: Organization
commitCommentEventInstallation :: Maybe Installation
commitCommentEventComment :: CommitCommentEvent -> CommitComment
commitCommentEventAction :: CommitCommentEvent -> Text
commitCommentEventSender :: CommitCommentEvent -> User
commitCommentEventRepository :: CommitCommentEvent -> Repository
commitCommentEventOrganization :: CommitCommentEvent -> Organization
commitCommentEventInstallation :: CommitCommentEvent -> Maybe Installation
..} = [Pair] -> Value
object
        [ Key
"installation" Key -> Maybe Installation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Installation
commitCommentEventInstallation
        , Key
"organization" Key -> Organization -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Organization
commitCommentEventOrganization
        , Key
"repository"   Key -> Repository -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Repository
commitCommentEventRepository
        , Key
"sender"       Key -> User -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= User
commitCommentEventSender

        , Key
"action"       Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
commitCommentEventAction
        , Key
"comment"      Key -> CommitComment -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CommitComment
commitCommentEventComment
        ]


instance Arbitrary CommitCommentEvent where
    arbitrary :: Gen CommitCommentEvent
arbitrary = Maybe Installation
-> Organization
-> Repository
-> User
-> Text
-> CommitComment
-> CommitCommentEvent
CommitCommentEvent
        (Maybe Installation
 -> Organization
 -> Repository
 -> User
 -> Text
 -> CommitComment
 -> CommitCommentEvent)
-> Gen (Maybe Installation)
-> Gen
     (Organization
      -> Repository
      -> User
      -> Text
      -> CommitComment
      -> CommitCommentEvent)
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
   -> CommitComment
   -> CommitCommentEvent)
-> Gen Organization
-> Gen
     (Repository -> User -> Text -> CommitComment -> CommitCommentEvent)
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 -> CommitComment -> CommitCommentEvent)
-> Gen Repository
-> Gen (User -> Text -> CommitComment -> CommitCommentEvent)
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 -> CommitComment -> CommitCommentEvent)
-> Gen User -> Gen (Text -> CommitComment -> CommitCommentEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen User
forall a. Arbitrary a => Gen a
arbitrary

        Gen (Text -> CommitComment -> CommitCommentEvent)
-> Gen Text -> Gen (CommitComment -> CommitCommentEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (CommitComment -> CommitCommentEvent)
-> Gen CommitComment -> Gen CommitCommentEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen CommitComment
forall a. Arbitrary a => Gen a
arbitrary