{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE StrictData        #-}
module GitHub.Types.Events.PageBuildEvent where

import           Data.Aeson                (FromJSON (..), ToJSON (..), object)
import           Data.Aeson.Types          (Value (..), (.:), (.:?), (.=))
import           Test.QuickCheck.Arbitrary (Arbitrary (..))

import           GitHub.Types.Base
import           GitHub.Types.Event


data PageBuildEvent = PageBuildEvent
    { PageBuildEvent -> Maybe Installation
pageBuildEventInstallation :: Maybe Installation
    , PageBuildEvent -> Organization
pageBuildEventOrganization :: Organization
    , PageBuildEvent -> Repository
pageBuildEventRepository   :: Repository
    , PageBuildEvent -> User
pageBuildEventSender       :: User

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

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

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

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

instance ToJSON PageBuildEvent where
    toJSON :: PageBuildEvent -> Value
toJSON PageBuildEvent{Int
Maybe Installation
Organization
User
PageBuild
Repository
pageBuildEventBuild :: PageBuild
pageBuildEventId :: Int
pageBuildEventSender :: User
pageBuildEventRepository :: Repository
pageBuildEventOrganization :: Organization
pageBuildEventInstallation :: Maybe Installation
pageBuildEventBuild :: PageBuildEvent -> PageBuild
pageBuildEventId :: PageBuildEvent -> Int
pageBuildEventSender :: PageBuildEvent -> User
pageBuildEventRepository :: PageBuildEvent -> Repository
pageBuildEventOrganization :: PageBuildEvent -> Organization
pageBuildEventInstallation :: PageBuildEvent -> Maybe Installation
..} = [Pair] -> Value
object
        [ Key
"installation" Key -> Maybe Installation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Installation
pageBuildEventInstallation
        , Key
"organization" Key -> Organization -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Organization
pageBuildEventOrganization
        , Key
"repository"   Key -> Repository -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Repository
pageBuildEventRepository
        , Key
"sender"       Key -> User -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= User
pageBuildEventSender

        , Key
"id"           Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
pageBuildEventId
        , Key
"build"        Key -> PageBuild -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PageBuild
pageBuildEventBuild
        ]


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

        Gen (Int -> PageBuild -> PageBuildEvent)
-> Gen Int -> Gen (PageBuild -> PageBuildEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
        Gen (PageBuild -> PageBuildEvent)
-> Gen PageBuild -> Gen PageBuildEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen PageBuild
forall a. Arbitrary a => Gen a
arbitrary