{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE StrictData        #-}
module GitHub.Types.Events.WorkflowRunEvent 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 WorkflowRunEvent = WorkflowRunEvent
    { WorkflowRunEvent -> Maybe Installation
workflowRunEventInstallation :: Maybe Installation
    , WorkflowRunEvent -> Organization
workflowRunEventOrganization :: Organization
    , WorkflowRunEvent -> Repository
workflowRunEventRepository   :: Repository
    , WorkflowRunEvent -> User
workflowRunEventSender       :: User

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

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

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

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

instance ToJSON WorkflowRunEvent where
    toJSON :: WorkflowRunEvent -> Value
toJSON WorkflowRunEvent{Maybe Installation
Text
Organization
User
Repository
Workflow
WorkflowRun
workflowRunEventWorkflowRun :: WorkflowRun
workflowRunEventWorkflow :: Workflow
workflowRunEventAction :: Text
workflowRunEventSender :: User
workflowRunEventRepository :: Repository
workflowRunEventOrganization :: Organization
workflowRunEventInstallation :: Maybe Installation
workflowRunEventWorkflowRun :: WorkflowRunEvent -> WorkflowRun
workflowRunEventWorkflow :: WorkflowRunEvent -> Workflow
workflowRunEventAction :: WorkflowRunEvent -> Text
workflowRunEventSender :: WorkflowRunEvent -> User
workflowRunEventRepository :: WorkflowRunEvent -> Repository
workflowRunEventOrganization :: WorkflowRunEvent -> Organization
workflowRunEventInstallation :: WorkflowRunEvent -> Maybe Installation
..} = [Pair] -> Value
object
        [ Key
"installation" Key -> Maybe Installation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Installation
workflowRunEventInstallation
        , Key
"organization" Key -> Organization -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Organization
workflowRunEventOrganization
        , Key
"repository"   Key -> Repository -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Repository
workflowRunEventRepository
        , Key
"sender"       Key -> User -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= User
workflowRunEventSender

        , Key
"action"       Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowRunEventAction
        , Key
"workflow"     Key -> Workflow -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Workflow
workflowRunEventWorkflow
        , Key
"workflow_run" Key -> WorkflowRun -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= WorkflowRun
workflowRunEventWorkflowRun
        ]


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

        Gen (Text -> Workflow -> WorkflowRun -> WorkflowRunEvent)
-> Gen Text -> Gen (Workflow -> WorkflowRun -> WorkflowRunEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Workflow -> WorkflowRun -> WorkflowRunEvent)
-> Gen Workflow -> Gen (WorkflowRun -> WorkflowRunEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Workflow
forall a. Arbitrary a => Gen a
arbitrary
        Gen (WorkflowRun -> WorkflowRunEvent)
-> Gen WorkflowRun -> Gen WorkflowRunEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen WorkflowRun
forall a. Arbitrary a => Gen a
arbitrary