{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE StrictData        #-}
module GitHub.Types.Events.ForkEvent 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 ForkEvent = ForkEvent
    { ForkEvent -> Maybe Installation
forkEventInstallation :: Maybe Installation
    , ForkEvent -> Organization
forkEventOrganization :: Organization
    , ForkEvent -> Repository
forkEventRepository   :: Repository
    , ForkEvent -> User
forkEventSender       :: User

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

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

instance FromJSON ForkEvent where
    parseJSON :: Value -> Parser ForkEvent
parseJSON (Object Object
x) = Maybe Installation
-> Organization -> Repository -> User -> Repository -> ForkEvent
ForkEvent
        (Maybe Installation
 -> Organization -> Repository -> User -> Repository -> ForkEvent)
-> Parser (Maybe Installation)
-> Parser
     (Organization -> Repository -> User -> Repository -> ForkEvent)
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 -> Repository -> ForkEvent)
-> Parser Organization
-> Parser (Repository -> User -> Repository -> ForkEvent)
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 -> Repository -> ForkEvent)
-> Parser Repository -> Parser (User -> Repository -> ForkEvent)
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 -> Repository -> ForkEvent)
-> Parser User -> Parser (Repository -> ForkEvent)
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 (Repository -> ForkEvent)
-> Parser Repository -> Parser ForkEvent
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
"forkee"

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

instance ToJSON ForkEvent where
    toJSON :: ForkEvent -> Value
toJSON ForkEvent{Maybe Installation
Organization
User
Repository
forkEventForkee :: Repository
forkEventSender :: User
forkEventRepository :: Repository
forkEventOrganization :: Organization
forkEventInstallation :: Maybe Installation
forkEventForkee :: ForkEvent -> Repository
forkEventSender :: ForkEvent -> User
forkEventRepository :: ForkEvent -> Repository
forkEventOrganization :: ForkEvent -> Organization
forkEventInstallation :: ForkEvent -> Maybe Installation
..} = [Pair] -> Value
object
        [ Key
"installation" Key -> Maybe Installation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Installation
forkEventInstallation
        , Key
"organization" Key -> Organization -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Organization
forkEventOrganization
        , Key
"repository"   Key -> Repository -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Repository
forkEventRepository
        , Key
"sender"       Key -> User -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= User
forkEventSender

        , Key
"forkee"       Key -> Repository -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Repository
forkEventForkee
        ]


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

        Gen (Repository -> ForkEvent) -> Gen Repository -> Gen ForkEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Repository
forall a. Arbitrary a => Gen a
arbitrary