{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE StrictData        #-}
module GitHub.Types.Events.StatusEvent 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 StatusEvent = StatusEvent
    { StatusEvent -> Maybe Installation
statusEventInstallation :: Maybe Installation
    , StatusEvent -> Organization
statusEventOrganization :: Organization
    , StatusEvent -> Repository
statusEventRepository   :: Repository
    , StatusEvent -> User
statusEventSender       :: User

    , StatusEvent -> Maybe Text
statusEventAvatarUrl    :: Maybe Text
    , StatusEvent -> [Branch]
statusEventBranches     :: [Branch]
    , StatusEvent -> StatusCommit
statusEventCommit       :: StatusCommit
    , StatusEvent -> Text
statusEventContext      :: Text
    , StatusEvent -> DateTime
statusEventCreatedAt    :: DateTime
    , StatusEvent -> Text
statusEventDescription  :: Text
    , StatusEvent -> Int
statusEventId           :: Int
    , StatusEvent -> Text
statusEventName         :: Text
    , StatusEvent -> Text
statusEventSha          :: Text
    , StatusEvent -> Text
statusEventState        :: Text
    , StatusEvent -> Maybe Text
statusEventTargetUrl    :: Maybe Text
    , StatusEvent -> DateTime
statusEventUpdatedAt    :: DateTime
    } deriving (StatusEvent -> StatusEvent -> Bool
(StatusEvent -> StatusEvent -> Bool)
-> (StatusEvent -> StatusEvent -> Bool) -> Eq StatusEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatusEvent -> StatusEvent -> Bool
$c/= :: StatusEvent -> StatusEvent -> Bool
== :: StatusEvent -> StatusEvent -> Bool
$c== :: StatusEvent -> StatusEvent -> Bool
Eq, Int -> StatusEvent -> ShowS
[StatusEvent] -> ShowS
StatusEvent -> String
(Int -> StatusEvent -> ShowS)
-> (StatusEvent -> String)
-> ([StatusEvent] -> ShowS)
-> Show StatusEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StatusEvent] -> ShowS
$cshowList :: [StatusEvent] -> ShowS
show :: StatusEvent -> String
$cshow :: StatusEvent -> String
showsPrec :: Int -> StatusEvent -> ShowS
$cshowsPrec :: Int -> StatusEvent -> ShowS
Show, ReadPrec [StatusEvent]
ReadPrec StatusEvent
Int -> ReadS StatusEvent
ReadS [StatusEvent]
(Int -> ReadS StatusEvent)
-> ReadS [StatusEvent]
-> ReadPrec StatusEvent
-> ReadPrec [StatusEvent]
-> Read StatusEvent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StatusEvent]
$creadListPrec :: ReadPrec [StatusEvent]
readPrec :: ReadPrec StatusEvent
$creadPrec :: ReadPrec StatusEvent
readList :: ReadS [StatusEvent]
$creadList :: ReadS [StatusEvent]
readsPrec :: Int -> ReadS StatusEvent
$creadsPrec :: Int -> ReadS StatusEvent
Read)

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

instance FromJSON StatusEvent where
    parseJSON :: Value -> Parser StatusEvent
parseJSON (Object Object
x) = Maybe Installation
-> Organization
-> Repository
-> User
-> Maybe Text
-> [Branch]
-> StatusCommit
-> Text
-> DateTime
-> Text
-> Int
-> Text
-> Text
-> Text
-> Maybe Text
-> DateTime
-> StatusEvent
StatusEvent
        (Maybe Installation
 -> Organization
 -> Repository
 -> User
 -> Maybe Text
 -> [Branch]
 -> StatusCommit
 -> Text
 -> DateTime
 -> Text
 -> Int
 -> Text
 -> Text
 -> Text
 -> Maybe Text
 -> DateTime
 -> StatusEvent)
-> Parser (Maybe Installation)
-> Parser
     (Organization
      -> Repository
      -> User
      -> Maybe Text
      -> [Branch]
      -> StatusCommit
      -> Text
      -> DateTime
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> DateTime
      -> StatusEvent)
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
   -> Maybe Text
   -> [Branch]
   -> StatusCommit
   -> Text
   -> DateTime
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> DateTime
   -> StatusEvent)
-> Parser Organization
-> Parser
     (Repository
      -> User
      -> Maybe Text
      -> [Branch]
      -> StatusCommit
      -> Text
      -> DateTime
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> DateTime
      -> StatusEvent)
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
   -> Maybe Text
   -> [Branch]
   -> StatusCommit
   -> Text
   -> DateTime
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> DateTime
   -> StatusEvent)
-> Parser Repository
-> Parser
     (User
      -> Maybe Text
      -> [Branch]
      -> StatusCommit
      -> Text
      -> DateTime
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> DateTime
      -> StatusEvent)
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
   -> Maybe Text
   -> [Branch]
   -> StatusCommit
   -> Text
   -> DateTime
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> DateTime
   -> StatusEvent)
-> Parser User
-> Parser
     (Maybe Text
      -> [Branch]
      -> StatusCommit
      -> Text
      -> DateTime
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> DateTime
      -> StatusEvent)
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
  (Maybe Text
   -> [Branch]
   -> StatusCommit
   -> Text
   -> DateTime
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> DateTime
   -> StatusEvent)
-> Parser (Maybe Text)
-> Parser
     ([Branch]
      -> StatusCommit
      -> Text
      -> DateTime
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> DateTime
      -> StatusEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"avatar_url"
        Parser
  ([Branch]
   -> StatusCommit
   -> Text
   -> DateTime
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> DateTime
   -> StatusEvent)
-> Parser [Branch]
-> Parser
     (StatusCommit
      -> Text
      -> DateTime
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> DateTime
      -> StatusEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser [Branch]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"branches"
        Parser
  (StatusCommit
   -> Text
   -> DateTime
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> DateTime
   -> StatusEvent)
-> Parser StatusCommit
-> Parser
     (Text
      -> DateTime
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> DateTime
      -> StatusEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser StatusCommit
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"commit"
        Parser
  (Text
   -> DateTime
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> DateTime
   -> StatusEvent)
-> Parser Text
-> Parser
     (DateTime
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> DateTime
      -> StatusEvent)
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
"context"
        Parser
  (DateTime
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> DateTime
   -> StatusEvent)
-> Parser DateTime
-> Parser
     (Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> DateTime
      -> StatusEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser DateTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
        Parser
  (Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> DateTime
   -> StatusEvent)
-> Parser Text
-> Parser
     (Int
      -> Text -> Text -> Text -> Maybe Text -> DateTime -> StatusEvent)
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
"description"
        Parser
  (Int
   -> Text -> Text -> Text -> Maybe Text -> DateTime -> StatusEvent)
-> Parser Int
-> Parser
     (Text -> Text -> Text -> Maybe Text -> DateTime -> StatusEvent)
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
  (Text -> Text -> Text -> Maybe Text -> DateTime -> StatusEvent)
-> Parser Text
-> Parser (Text -> Text -> Maybe Text -> DateTime -> StatusEvent)
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
"name"
        Parser (Text -> Text -> Maybe Text -> DateTime -> StatusEvent)
-> Parser Text
-> Parser (Text -> Maybe Text -> DateTime -> StatusEvent)
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
"sha"
        Parser (Text -> Maybe Text -> DateTime -> StatusEvent)
-> Parser Text -> Parser (Maybe Text -> DateTime -> StatusEvent)
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
"state"
        Parser (Maybe Text -> DateTime -> StatusEvent)
-> Parser (Maybe Text) -> Parser (DateTime -> StatusEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"target_url"
        Parser (DateTime -> StatusEvent)
-> Parser DateTime -> Parser StatusEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser DateTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"

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

instance ToJSON StatusEvent where
    toJSON :: StatusEvent -> Value
toJSON StatusEvent{Int
[Branch]
Maybe Text
Maybe Installation
Text
DateTime
Organization
User
Repository
StatusCommit
statusEventUpdatedAt :: DateTime
statusEventTargetUrl :: Maybe Text
statusEventState :: Text
statusEventSha :: Text
statusEventName :: Text
statusEventId :: Int
statusEventDescription :: Text
statusEventCreatedAt :: DateTime
statusEventContext :: Text
statusEventCommit :: StatusCommit
statusEventBranches :: [Branch]
statusEventAvatarUrl :: Maybe Text
statusEventSender :: User
statusEventRepository :: Repository
statusEventOrganization :: Organization
statusEventInstallation :: Maybe Installation
statusEventUpdatedAt :: StatusEvent -> DateTime
statusEventTargetUrl :: StatusEvent -> Maybe Text
statusEventState :: StatusEvent -> Text
statusEventSha :: StatusEvent -> Text
statusEventName :: StatusEvent -> Text
statusEventId :: StatusEvent -> Int
statusEventDescription :: StatusEvent -> Text
statusEventCreatedAt :: StatusEvent -> DateTime
statusEventContext :: StatusEvent -> Text
statusEventCommit :: StatusEvent -> StatusCommit
statusEventBranches :: StatusEvent -> [Branch]
statusEventAvatarUrl :: StatusEvent -> Maybe Text
statusEventSender :: StatusEvent -> User
statusEventRepository :: StatusEvent -> Repository
statusEventOrganization :: StatusEvent -> Organization
statusEventInstallation :: StatusEvent -> Maybe Installation
..} = [Pair] -> Value
object
        [ Key
"installation" Key -> Maybe Installation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Installation
statusEventInstallation
        , Key
"organization" Key -> Organization -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Organization
statusEventOrganization
        , Key
"repository"   Key -> Repository -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Repository
statusEventRepository
        , Key
"sender"       Key -> User -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= User
statusEventSender

        , Key
"avatar_url"   Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
statusEventAvatarUrl
        , Key
"branches"     Key -> [Branch] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Branch]
statusEventBranches
        , Key
"commit"       Key -> StatusCommit -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StatusCommit
statusEventCommit
        , Key
"context"      Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
statusEventContext
        , Key
"created_at"   Key -> DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DateTime
statusEventCreatedAt
        , Key
"description"  Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
statusEventDescription
        , Key
"id"           Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
statusEventId
        , Key
"name"         Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
statusEventName
        , Key
"sha"          Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
statusEventSha
        , Key
"state"        Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
statusEventState
        , Key
"target_url"   Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
statusEventTargetUrl
        , Key
"updated_at"   Key -> DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DateTime
statusEventUpdatedAt
        ]


instance Arbitrary StatusEvent where
    arbitrary :: Gen StatusEvent
arbitrary = Maybe Installation
-> Organization
-> Repository
-> User
-> Maybe Text
-> [Branch]
-> StatusCommit
-> Text
-> DateTime
-> Text
-> Int
-> Text
-> Text
-> Text
-> Maybe Text
-> DateTime
-> StatusEvent
StatusEvent
        (Maybe Installation
 -> Organization
 -> Repository
 -> User
 -> Maybe Text
 -> [Branch]
 -> StatusCommit
 -> Text
 -> DateTime
 -> Text
 -> Int
 -> Text
 -> Text
 -> Text
 -> Maybe Text
 -> DateTime
 -> StatusEvent)
-> Gen (Maybe Installation)
-> Gen
     (Organization
      -> Repository
      -> User
      -> Maybe Text
      -> [Branch]
      -> StatusCommit
      -> Text
      -> DateTime
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> DateTime
      -> StatusEvent)
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
   -> Maybe Text
   -> [Branch]
   -> StatusCommit
   -> Text
   -> DateTime
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> DateTime
   -> StatusEvent)
-> Gen Organization
-> Gen
     (Repository
      -> User
      -> Maybe Text
      -> [Branch]
      -> StatusCommit
      -> Text
      -> DateTime
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> DateTime
      -> StatusEvent)
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
   -> Maybe Text
   -> [Branch]
   -> StatusCommit
   -> Text
   -> DateTime
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> DateTime
   -> StatusEvent)
-> Gen Repository
-> Gen
     (User
      -> Maybe Text
      -> [Branch]
      -> StatusCommit
      -> Text
      -> DateTime
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> DateTime
      -> StatusEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Repository
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (User
   -> Maybe Text
   -> [Branch]
   -> StatusCommit
   -> Text
   -> DateTime
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> DateTime
   -> StatusEvent)
-> Gen User
-> Gen
     (Maybe Text
      -> [Branch]
      -> StatusCommit
      -> Text
      -> DateTime
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> DateTime
      -> StatusEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen User
forall a. Arbitrary a => Gen a
arbitrary

        Gen
  (Maybe Text
   -> [Branch]
   -> StatusCommit
   -> Text
   -> DateTime
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> DateTime
   -> StatusEvent)
-> Gen (Maybe Text)
-> Gen
     ([Branch]
      -> StatusCommit
      -> Text
      -> DateTime
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> DateTime
      -> StatusEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Text)
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  ([Branch]
   -> StatusCommit
   -> Text
   -> DateTime
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> DateTime
   -> StatusEvent)
-> Gen [Branch]
-> Gen
     (StatusCommit
      -> Text
      -> DateTime
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> DateTime
      -> StatusEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [Branch]
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (StatusCommit
   -> Text
   -> DateTime
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> DateTime
   -> StatusEvent)
-> Gen StatusCommit
-> Gen
     (Text
      -> DateTime
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> DateTime
      -> StatusEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen StatusCommit
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> DateTime
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> DateTime
   -> StatusEvent)
-> Gen Text
-> Gen
     (DateTime
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> DateTime
      -> StatusEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (DateTime
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> DateTime
   -> StatusEvent)
-> Gen DateTime
-> Gen
     (Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Maybe Text
      -> DateTime
      -> StatusEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen DateTime
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Maybe Text
   -> DateTime
   -> StatusEvent)
-> Gen Text
-> Gen
     (Int
      -> Text -> Text -> Text -> Maybe Text -> DateTime -> StatusEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Int
   -> Text -> Text -> Text -> Maybe Text -> DateTime -> StatusEvent)
-> Gen Int
-> Gen
     (Text -> Text -> Text -> Maybe Text -> DateTime -> StatusEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> Text -> Text -> Maybe Text -> DateTime -> StatusEvent)
-> Gen Text
-> Gen (Text -> Text -> Maybe Text -> DateTime -> StatusEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> Text -> Maybe Text -> DateTime -> StatusEvent)
-> Gen Text -> Gen (Text -> Maybe Text -> DateTime -> StatusEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> Maybe Text -> DateTime -> StatusEvent)
-> Gen Text -> Gen (Maybe Text -> DateTime -> StatusEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Maybe Text -> DateTime -> StatusEvent)
-> Gen (Maybe Text) -> Gen (DateTime -> StatusEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Text)
forall a. Arbitrary a => Gen a
arbitrary
        Gen (DateTime -> StatusEvent) -> Gen DateTime -> Gen StatusEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen DateTime
forall a. Arbitrary a => Gen a
arbitrary