{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE StrictData        #-}
module GitHub.Types.Events.DeploymentStatusEvent 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 DeploymentStatusEvent = DeploymentStatusEvent
    { DeploymentStatusEvent -> Maybe Installation
deploymentStatusEventInstallation     :: Maybe Installation
    , DeploymentStatusEvent -> Organization
deploymentStatusEventOrganization     :: Organization
    , DeploymentStatusEvent -> Repository
deploymentStatusEventRepository       :: Repository
    , DeploymentStatusEvent -> User
deploymentStatusEventSender           :: User

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

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

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

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

instance ToJSON DeploymentStatusEvent where
    toJSON :: DeploymentStatusEvent -> Value
toJSON DeploymentStatusEvent{Maybe Installation
Text
Organization
User
DeploymentStatus
Deployment
Repository
deploymentStatusEventDeploymentStatus :: DeploymentStatus
deploymentStatusEventDeployment :: Deployment
deploymentStatusEventAction :: Text
deploymentStatusEventSender :: User
deploymentStatusEventRepository :: Repository
deploymentStatusEventOrganization :: Organization
deploymentStatusEventInstallation :: Maybe Installation
deploymentStatusEventDeploymentStatus :: DeploymentStatusEvent -> DeploymentStatus
deploymentStatusEventDeployment :: DeploymentStatusEvent -> Deployment
deploymentStatusEventAction :: DeploymentStatusEvent -> Text
deploymentStatusEventSender :: DeploymentStatusEvent -> User
deploymentStatusEventRepository :: DeploymentStatusEvent -> Repository
deploymentStatusEventOrganization :: DeploymentStatusEvent -> Organization
deploymentStatusEventInstallation :: DeploymentStatusEvent -> Maybe Installation
..} = [Pair] -> Value
object
        [ Key
"installation"       Key -> Maybe Installation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Installation
deploymentStatusEventInstallation
        , Key
"organization"       Key -> Organization -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Organization
deploymentStatusEventOrganization
        , Key
"repository"         Key -> Repository -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Repository
deploymentStatusEventRepository
        , Key
"sender"             Key -> User -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= User
deploymentStatusEventSender

        , Key
"action"             Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deploymentStatusEventAction
        , Key
"deployment"         Key -> Deployment -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Deployment
deploymentStatusEventDeployment
        , Key
"deployment_status"  Key -> DeploymentStatus -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DeploymentStatus
deploymentStatusEventDeploymentStatus
        ]


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

        Gen
  (Text -> Deployment -> DeploymentStatus -> DeploymentStatusEvent)
-> Gen Text
-> Gen (Deployment -> DeploymentStatus -> DeploymentStatusEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Deployment -> DeploymentStatus -> DeploymentStatusEvent)
-> Gen Deployment
-> Gen (DeploymentStatus -> DeploymentStatusEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Deployment
forall a. Arbitrary a => Gen a
arbitrary
        Gen (DeploymentStatus -> DeploymentStatusEvent)
-> Gen DeploymentStatus -> Gen DeploymentStatusEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen DeploymentStatus
forall a. Arbitrary a => Gen a
arbitrary