{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE StrictData        #-}
module GitHub.Types.Base.Deployment 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.DateTime
import           GitHub.Types.Base.DeploymentPayload
import           GitHub.Types.Base.User

------------------------------------------------------------------------------
-- Deployment

data Deployment = Deployment
    { Deployment -> Text
deploymentUrl                   :: Text
    , Deployment -> Int
deploymentId                    :: Int
    , Deployment -> Text
deploymentNodeId                :: Text
    , Deployment -> Text
deploymentSha                   :: Text
    , Deployment -> Text
deploymentRef                   :: Text
    , Deployment -> Text
deploymentTask                  :: Text
    , Deployment -> Maybe DeploymentPayload
deploymentPayload               :: Maybe DeploymentPayload
    , Deployment -> Text
deploymentEnvironment           :: Text
    , Deployment -> Text
deploymentOriginalEnvironment   :: Text
    , Deployment -> Bool
deploymentProductionEnvironment :: Bool
    , Deployment -> Bool
deploymentTransientEnvironment  :: Bool
    , Deployment -> Maybe Text
deploymentDescription           :: Maybe Text
    , Deployment -> User
deploymentCreator               :: User
    , Deployment -> DateTime
deploymentCreatedAt             :: DateTime
    , Deployment -> DateTime
deploymentUpdatedAt             :: DateTime
    , Deployment -> Text
deploymentStatusesUrl           :: Text
    , Deployment -> Text
deploymentRepositoryUrl         :: Text
    } deriving (Deployment -> Deployment -> Bool
(Deployment -> Deployment -> Bool)
-> (Deployment -> Deployment -> Bool) -> Eq Deployment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Deployment -> Deployment -> Bool
$c/= :: Deployment -> Deployment -> Bool
== :: Deployment -> Deployment -> Bool
$c== :: Deployment -> Deployment -> Bool
Eq, Int -> Deployment -> ShowS
[Deployment] -> ShowS
Deployment -> String
(Int -> Deployment -> ShowS)
-> (Deployment -> String)
-> ([Deployment] -> ShowS)
-> Show Deployment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Deployment] -> ShowS
$cshowList :: [Deployment] -> ShowS
show :: Deployment -> String
$cshow :: Deployment -> String
showsPrec :: Int -> Deployment -> ShowS
$cshowsPrec :: Int -> Deployment -> ShowS
Show, ReadPrec [Deployment]
ReadPrec Deployment
Int -> ReadS Deployment
ReadS [Deployment]
(Int -> ReadS Deployment)
-> ReadS [Deployment]
-> ReadPrec Deployment
-> ReadPrec [Deployment]
-> Read Deployment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Deployment]
$creadListPrec :: ReadPrec [Deployment]
readPrec :: ReadPrec Deployment
$creadPrec :: ReadPrec Deployment
readList :: ReadS [Deployment]
$creadList :: ReadS [Deployment]
readsPrec :: Int -> ReadS Deployment
$creadsPrec :: Int -> ReadS Deployment
Read)

instance FromJSON Deployment where
    parseJSON :: Value -> Parser Deployment
parseJSON (Object Object
x) = Text
-> Int
-> Text
-> Text
-> Text
-> Text
-> Maybe DeploymentPayload
-> Text
-> Text
-> Bool
-> Bool
-> Maybe Text
-> User
-> DateTime
-> DateTime
-> Text
-> Text
-> Deployment
Deployment
        (Text
 -> Int
 -> Text
 -> Text
 -> Text
 -> Text
 -> Maybe DeploymentPayload
 -> Text
 -> Text
 -> Bool
 -> Bool
 -> Maybe Text
 -> User
 -> DateTime
 -> DateTime
 -> Text
 -> Text
 -> Deployment)
-> Parser Text
-> Parser
     (Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe DeploymentPayload
      -> Text
      -> Text
      -> Bool
      -> Bool
      -> Maybe Text
      -> User
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Deployment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
        Parser
  (Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe DeploymentPayload
   -> Text
   -> Text
   -> Bool
   -> Bool
   -> Maybe Text
   -> User
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Deployment)
-> Parser Int
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Maybe DeploymentPayload
      -> Text
      -> Text
      -> Bool
      -> Bool
      -> Maybe Text
      -> User
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Deployment)
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
   -> Text
   -> Maybe DeploymentPayload
   -> Text
   -> Text
   -> Bool
   -> Bool
   -> Maybe Text
   -> User
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Deployment)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Maybe DeploymentPayload
      -> Text
      -> Text
      -> Bool
      -> Bool
      -> Maybe Text
      -> User
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Deployment)
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
"node_id"
        Parser
  (Text
   -> Text
   -> Text
   -> Maybe DeploymentPayload
   -> Text
   -> Text
   -> Bool
   -> Bool
   -> Maybe Text
   -> User
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Deployment)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Maybe DeploymentPayload
      -> Text
      -> Text
      -> Bool
      -> Bool
      -> Maybe Text
      -> User
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Deployment)
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
   -> Text
   -> Maybe DeploymentPayload
   -> Text
   -> Text
   -> Bool
   -> Bool
   -> Maybe Text
   -> User
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Deployment)
-> Parser Text
-> Parser
     (Text
      -> Maybe DeploymentPayload
      -> Text
      -> Text
      -> Bool
      -> Bool
      -> Maybe Text
      -> User
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Deployment)
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
"ref"
        Parser
  (Text
   -> Maybe DeploymentPayload
   -> Text
   -> Text
   -> Bool
   -> Bool
   -> Maybe Text
   -> User
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Deployment)
-> Parser Text
-> Parser
     (Maybe DeploymentPayload
      -> Text
      -> Text
      -> Bool
      -> Bool
      -> Maybe Text
      -> User
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Deployment)
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
"task"
        Parser
  (Maybe DeploymentPayload
   -> Text
   -> Text
   -> Bool
   -> Bool
   -> Maybe Text
   -> User
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Deployment)
-> Parser (Maybe DeploymentPayload)
-> Parser
     (Text
      -> Text
      -> Bool
      -> Bool
      -> Maybe Text
      -> User
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Deployment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe DeploymentPayload)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"payload"
        Parser
  (Text
   -> Text
   -> Bool
   -> Bool
   -> Maybe Text
   -> User
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Deployment)
-> Parser Text
-> Parser
     (Text
      -> Bool
      -> Bool
      -> Maybe Text
      -> User
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Deployment)
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
"environment"
        Parser
  (Text
   -> Bool
   -> Bool
   -> Maybe Text
   -> User
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Deployment)
-> Parser Text
-> Parser
     (Bool
      -> Bool
      -> Maybe Text
      -> User
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Deployment)
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
"original_environment"
        Parser
  (Bool
   -> Bool
   -> Maybe Text
   -> User
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Deployment)
-> Parser Bool
-> Parser
     (Bool
      -> Maybe Text
      -> User
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Deployment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"production_environment"
        Parser
  (Bool
   -> Maybe Text
   -> User
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Deployment)
-> Parser Bool
-> Parser
     (Maybe Text
      -> User -> DateTime -> DateTime -> Text -> Text -> Deployment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"transient_environment"
        Parser
  (Maybe Text
   -> User -> DateTime -> DateTime -> Text -> Text -> Deployment)
-> Parser (Maybe Text)
-> Parser
     (User -> DateTime -> DateTime -> Text -> Text -> Deployment)
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
"description"
        Parser (User -> DateTime -> DateTime -> Text -> Text -> Deployment)
-> Parser User
-> Parser (DateTime -> DateTime -> Text -> Text -> Deployment)
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
"creator"
        Parser (DateTime -> DateTime -> Text -> Text -> Deployment)
-> Parser DateTime
-> Parser (DateTime -> Text -> Text -> Deployment)
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 (DateTime -> Text -> Text -> Deployment)
-> Parser DateTime -> Parser (Text -> Text -> Deployment)
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"
        Parser (Text -> Text -> Deployment)
-> Parser Text -> Parser (Text -> Deployment)
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
"statuses_url"
        Parser (Text -> Deployment) -> Parser Text -> Parser Deployment
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
"repository_url"

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

instance ToJSON Deployment where
    toJSON :: Deployment -> Value
toJSON Deployment{Bool
Int
Maybe Text
Maybe DeploymentPayload
Text
DateTime
User
deploymentRepositoryUrl :: Text
deploymentStatusesUrl :: Text
deploymentUpdatedAt :: DateTime
deploymentCreatedAt :: DateTime
deploymentCreator :: User
deploymentDescription :: Maybe Text
deploymentTransientEnvironment :: Bool
deploymentProductionEnvironment :: Bool
deploymentOriginalEnvironment :: Text
deploymentEnvironment :: Text
deploymentPayload :: Maybe DeploymentPayload
deploymentTask :: Text
deploymentRef :: Text
deploymentSha :: Text
deploymentNodeId :: Text
deploymentId :: Int
deploymentUrl :: Text
deploymentRepositoryUrl :: Deployment -> Text
deploymentStatusesUrl :: Deployment -> Text
deploymentUpdatedAt :: Deployment -> DateTime
deploymentCreatedAt :: Deployment -> DateTime
deploymentCreator :: Deployment -> User
deploymentDescription :: Deployment -> Maybe Text
deploymentTransientEnvironment :: Deployment -> Bool
deploymentProductionEnvironment :: Deployment -> Bool
deploymentOriginalEnvironment :: Deployment -> Text
deploymentEnvironment :: Deployment -> Text
deploymentPayload :: Deployment -> Maybe DeploymentPayload
deploymentTask :: Deployment -> Text
deploymentRef :: Deployment -> Text
deploymentSha :: Deployment -> Text
deploymentNodeId :: Deployment -> Text
deploymentId :: Deployment -> Int
deploymentUrl :: Deployment -> Text
..} = [Pair] -> Value
object
        [ Key
"url"                    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deploymentUrl
        , Key
"id"                     Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
deploymentId
        , Key
"node_id"                Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deploymentNodeId
        , Key
"sha"                    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deploymentSha
        , Key
"ref"                    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deploymentRef
        , Key
"task"                   Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deploymentTask
        , Key
"payload"                Key -> Maybe DeploymentPayload -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe DeploymentPayload
deploymentPayload
        , Key
"environment"            Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deploymentEnvironment
        , Key
"original_environment"   Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deploymentOriginalEnvironment
        , Key
"production_environment" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
deploymentProductionEnvironment
        , Key
"transient_environment"  Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
deploymentTransientEnvironment
        , Key
"description"            Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
deploymentDescription
        , Key
"creator"                Key -> User -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= User
deploymentCreator
        , Key
"created_at"             Key -> DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DateTime
deploymentCreatedAt
        , Key
"updated_at"             Key -> DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DateTime
deploymentUpdatedAt
        , Key
"statuses_url"           Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deploymentStatusesUrl
        , Key
"repository_url"         Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deploymentRepositoryUrl
        ]


instance Arbitrary Deployment where
    arbitrary :: Gen Deployment
arbitrary = Text
-> Int
-> Text
-> Text
-> Text
-> Text
-> Maybe DeploymentPayload
-> Text
-> Text
-> Bool
-> Bool
-> Maybe Text
-> User
-> DateTime
-> DateTime
-> Text
-> Text
-> Deployment
Deployment
        (Text
 -> Int
 -> Text
 -> Text
 -> Text
 -> Text
 -> Maybe DeploymentPayload
 -> Text
 -> Text
 -> Bool
 -> Bool
 -> Maybe Text
 -> User
 -> DateTime
 -> DateTime
 -> Text
 -> Text
 -> Deployment)
-> Gen Text
-> Gen
     (Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe DeploymentPayload
      -> Text
      -> Text
      -> Bool
      -> Bool
      -> Maybe Text
      -> User
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Deployment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe DeploymentPayload
   -> Text
   -> Text
   -> Bool
   -> Bool
   -> Maybe Text
   -> User
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Deployment)
-> Gen Int
-> Gen
     (Text
      -> Text
      -> Text
      -> Text
      -> Maybe DeploymentPayload
      -> Text
      -> Text
      -> Bool
      -> Bool
      -> Maybe Text
      -> User
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Deployment)
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
   -> Text
   -> Maybe DeploymentPayload
   -> Text
   -> Text
   -> Bool
   -> Bool
   -> Maybe Text
   -> User
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Deployment)
-> Gen Text
-> Gen
     (Text
      -> Text
      -> Text
      -> Maybe DeploymentPayload
      -> Text
      -> Text
      -> Bool
      -> Bool
      -> Maybe Text
      -> User
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Deployment)
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
   -> Text
   -> Maybe DeploymentPayload
   -> Text
   -> Text
   -> Bool
   -> Bool
   -> Maybe Text
   -> User
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Deployment)
-> Gen Text
-> Gen
     (Text
      -> Text
      -> Maybe DeploymentPayload
      -> Text
      -> Text
      -> Bool
      -> Bool
      -> Maybe Text
      -> User
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Deployment)
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 DeploymentPayload
   -> Text
   -> Text
   -> Bool
   -> Bool
   -> Maybe Text
   -> User
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Deployment)
-> Gen Text
-> Gen
     (Text
      -> Maybe DeploymentPayload
      -> Text
      -> Text
      -> Bool
      -> Bool
      -> Maybe Text
      -> User
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Deployment)
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 DeploymentPayload
   -> Text
   -> Text
   -> Bool
   -> Bool
   -> Maybe Text
   -> User
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Deployment)
-> Gen Text
-> Gen
     (Maybe DeploymentPayload
      -> Text
      -> Text
      -> Bool
      -> Bool
      -> Maybe Text
      -> User
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Deployment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Maybe DeploymentPayload
   -> Text
   -> Text
   -> Bool
   -> Bool
   -> Maybe Text
   -> User
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Deployment)
-> Gen (Maybe DeploymentPayload)
-> Gen
     (Text
      -> Text
      -> Bool
      -> Bool
      -> Maybe Text
      -> User
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Deployment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe DeploymentPayload)
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Text
   -> Bool
   -> Bool
   -> Maybe Text
   -> User
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Deployment)
-> Gen Text
-> Gen
     (Text
      -> Bool
      -> Bool
      -> Maybe Text
      -> User
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Deployment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Bool
   -> Bool
   -> Maybe Text
   -> User
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Deployment)
-> Gen Text
-> Gen
     (Bool
      -> Bool
      -> Maybe Text
      -> User
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Deployment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Bool
   -> Bool
   -> Maybe Text
   -> User
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Deployment)
-> Gen Bool
-> Gen
     (Bool
      -> Maybe Text
      -> User
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Deployment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Bool
   -> Maybe Text
   -> User
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Deployment)
-> Gen Bool
-> Gen
     (Maybe Text
      -> User -> DateTime -> DateTime -> Text -> Text -> Deployment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Maybe Text
   -> User -> DateTime -> DateTime -> Text -> Text -> Deployment)
-> Gen (Maybe Text)
-> Gen (User -> DateTime -> DateTime -> Text -> Text -> Deployment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Text)
forall a. Arbitrary a => Gen a
arbitrary
        Gen (User -> DateTime -> DateTime -> Text -> Text -> Deployment)
-> Gen User
-> Gen (DateTime -> DateTime -> Text -> Text -> Deployment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen User
forall a. Arbitrary a => Gen a
arbitrary
        Gen (DateTime -> DateTime -> Text -> Text -> Deployment)
-> Gen DateTime -> Gen (DateTime -> Text -> Text -> Deployment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen DateTime
forall a. Arbitrary a => Gen a
arbitrary
        Gen (DateTime -> Text -> Text -> Deployment)
-> Gen DateTime -> Gen (Text -> Text -> Deployment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen DateTime
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> Text -> Deployment)
-> Gen Text -> Gen (Text -> Deployment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> Deployment) -> Gen Text -> Gen Deployment
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary