{-# LANGUAGE LambdaCase #-}

module GitHub.Data.Deployments
    ( DeploymentQueryOption (..)
    , renderDeploymentQueryOption

    , Deployment (..)
    , CreateDeployment (..)

    , DeploymentStatus (..)
    , DeploymentStatusState (..)
    , CreateDeploymentStatus (..)
    ) where


import GitHub.Internal.Prelude
import Prelude ()

import Control.Arrow (second)

import Data.ByteString (ByteString)

import GitHub.Data.Definitions (SimpleUser)
import GitHub.Data.Id          (Id)
import GitHub.Data.Name        (Name)
import GitHub.Data.URL         (URL)

import qualified Data.Aeson         as JSON
import qualified Data.Text          as T
import qualified Data.Text.Encoding as T

data DeploymentQueryOption
    = DeploymentQuerySha         !Text
    | DeploymentQueryRef         !Text
    | DeploymentQueryTask        !Text
    | DeploymentQueryEnvironment !Text
      deriving (Int -> DeploymentQueryOption -> ShowS
[DeploymentQueryOption] -> ShowS
DeploymentQueryOption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeploymentQueryOption] -> ShowS
$cshowList :: [DeploymentQueryOption] -> ShowS
show :: DeploymentQueryOption -> String
$cshow :: DeploymentQueryOption -> String
showsPrec :: Int -> DeploymentQueryOption -> ShowS
$cshowsPrec :: Int -> DeploymentQueryOption -> ShowS
Show, Typeable DeploymentQueryOption
DeploymentQueryOption -> DataType
DeploymentQueryOption -> Constr
(forall b. Data b => b -> b)
-> DeploymentQueryOption -> DeploymentQueryOption
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> DeploymentQueryOption -> u
forall u.
(forall d. Data d => d -> u) -> DeploymentQueryOption -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeploymentQueryOption -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeploymentQueryOption -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeploymentQueryOption -> m DeploymentQueryOption
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeploymentQueryOption -> m DeploymentQueryOption
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeploymentQueryOption
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeploymentQueryOption
-> c DeploymentQueryOption
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeploymentQueryOption)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeploymentQueryOption)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeploymentQueryOption -> m DeploymentQueryOption
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeploymentQueryOption -> m DeploymentQueryOption
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeploymentQueryOption -> m DeploymentQueryOption
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeploymentQueryOption -> m DeploymentQueryOption
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeploymentQueryOption -> m DeploymentQueryOption
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeploymentQueryOption -> m DeploymentQueryOption
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DeploymentQueryOption -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DeploymentQueryOption -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> DeploymentQueryOption -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> DeploymentQueryOption -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeploymentQueryOption -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeploymentQueryOption -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeploymentQueryOption -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeploymentQueryOption -> r
gmapT :: (forall b. Data b => b -> b)
-> DeploymentQueryOption -> DeploymentQueryOption
$cgmapT :: (forall b. Data b => b -> b)
-> DeploymentQueryOption -> DeploymentQueryOption
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeploymentQueryOption)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeploymentQueryOption)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeploymentQueryOption)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeploymentQueryOption)
dataTypeOf :: DeploymentQueryOption -> DataType
$cdataTypeOf :: DeploymentQueryOption -> DataType
toConstr :: DeploymentQueryOption -> Constr
$ctoConstr :: DeploymentQueryOption -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeploymentQueryOption
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeploymentQueryOption
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeploymentQueryOption
-> c DeploymentQueryOption
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeploymentQueryOption
-> c DeploymentQueryOption
Data, Typeable, DeploymentQueryOption -> DeploymentQueryOption -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeploymentQueryOption -> DeploymentQueryOption -> Bool
$c/= :: DeploymentQueryOption -> DeploymentQueryOption -> Bool
== :: DeploymentQueryOption -> DeploymentQueryOption -> Bool
$c== :: DeploymentQueryOption -> DeploymentQueryOption -> Bool
Eq, Eq DeploymentQueryOption
DeploymentQueryOption -> DeploymentQueryOption -> Bool
DeploymentQueryOption -> DeploymentQueryOption -> Ordering
DeploymentQueryOption
-> DeploymentQueryOption -> DeploymentQueryOption
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DeploymentQueryOption
-> DeploymentQueryOption -> DeploymentQueryOption
$cmin :: DeploymentQueryOption
-> DeploymentQueryOption -> DeploymentQueryOption
max :: DeploymentQueryOption
-> DeploymentQueryOption -> DeploymentQueryOption
$cmax :: DeploymentQueryOption
-> DeploymentQueryOption -> DeploymentQueryOption
>= :: DeploymentQueryOption -> DeploymentQueryOption -> Bool
$c>= :: DeploymentQueryOption -> DeploymentQueryOption -> Bool
> :: DeploymentQueryOption -> DeploymentQueryOption -> Bool
$c> :: DeploymentQueryOption -> DeploymentQueryOption -> Bool
<= :: DeploymentQueryOption -> DeploymentQueryOption -> Bool
$c<= :: DeploymentQueryOption -> DeploymentQueryOption -> Bool
< :: DeploymentQueryOption -> DeploymentQueryOption -> Bool
$c< :: DeploymentQueryOption -> DeploymentQueryOption -> Bool
compare :: DeploymentQueryOption -> DeploymentQueryOption -> Ordering
$ccompare :: DeploymentQueryOption -> DeploymentQueryOption -> Ordering
Ord, forall x. Rep DeploymentQueryOption x -> DeploymentQueryOption
forall x. DeploymentQueryOption -> Rep DeploymentQueryOption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeploymentQueryOption x -> DeploymentQueryOption
$cfrom :: forall x. DeploymentQueryOption -> Rep DeploymentQueryOption x
Generic)

instance NFData DeploymentQueryOption where rnf :: DeploymentQueryOption -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary DeploymentQueryOption

renderDeploymentQueryOption :: DeploymentQueryOption -> (ByteString, ByteString)
renderDeploymentQueryOption :: DeploymentQueryOption -> (ByteString, ByteString)
renderDeploymentQueryOption =
    forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        DeploymentQuerySha         Text
sha  -> (ByteString
"sha",         Text
sha)
        DeploymentQueryRef         Text
ref  -> (ByteString
"ref",         Text
ref)
        DeploymentQueryTask        Text
task -> (ByteString
"task",        Text
task)
        DeploymentQueryEnvironment Text
env  -> (ByteString
"environment", Text
env)

data Deployment a = Deployment
    { forall a. Deployment a -> URL
deploymentUrl           :: !URL
    , forall a. Deployment a -> Id (Deployment a)
deploymentId            :: !(Id   (Deployment a))
    , forall a. Deployment a -> Name (Deployment a)
deploymentSha           :: !(Name (Deployment a))
    , forall a. Deployment a -> Text
deploymentRef           :: !Text
    , forall a. Deployment a -> Text
deploymentTask          :: !Text
    , forall a. Deployment a -> Maybe a
deploymentPayload       :: !(Maybe a)
    , forall a. Deployment a -> Text
deploymentEnvironment   :: !Text
    , forall a. Deployment a -> Text
deploymentDescription   :: !Text
    , forall a. Deployment a -> SimpleUser
deploymentCreator       :: !SimpleUser
    , forall a. Deployment a -> UTCTime
deploymentCreatedAt     :: !UTCTime
    , forall a. Deployment a -> UTCTime
deploymentUpdatedAt     :: !UTCTime
    , forall a. Deployment a -> URL
deploymentStatusesUrl   :: !URL
    , forall a. Deployment a -> URL
deploymentRepositoryUrl :: !URL
    } deriving (Int -> Deployment a -> ShowS
forall a. Show a => Int -> Deployment a -> ShowS
forall a. Show a => [Deployment a] -> ShowS
forall a. Show a => Deployment a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Deployment a] -> ShowS
$cshowList :: forall a. Show a => [Deployment a] -> ShowS
show :: Deployment a -> String
$cshow :: forall a. Show a => Deployment a -> String
showsPrec :: Int -> Deployment a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Deployment a -> ShowS
Show, Deployment a -> DataType
Deployment a -> Constr
forall {a}. Data a => Typeable (Deployment a)
forall a. Data a => Deployment a -> DataType
forall a. Data a => Deployment a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> Deployment a -> Deployment a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Deployment a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Deployment a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Deployment a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Deployment a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Deployment a -> m (Deployment a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Deployment a -> m (Deployment a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Deployment a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Deployment a -> c (Deployment a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Deployment a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Deployment a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Deployment a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Deployment a -> c (Deployment a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Deployment a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Deployment a -> m (Deployment a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Deployment a -> m (Deployment a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Deployment a -> m (Deployment a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Deployment a -> m (Deployment a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Deployment a -> m (Deployment a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Deployment a -> m (Deployment a)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Deployment a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Deployment a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Deployment a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Deployment a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Deployment a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Deployment a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Deployment a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Deployment a -> r
gmapT :: (forall b. Data b => b -> b) -> Deployment a -> Deployment a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Deployment a -> Deployment a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Deployment a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Deployment a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Deployment a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Deployment a))
dataTypeOf :: Deployment a -> DataType
$cdataTypeOf :: forall a. Data a => Deployment a -> DataType
toConstr :: Deployment a -> Constr
$ctoConstr :: forall a. Data a => Deployment a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Deployment a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Deployment a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Deployment a -> c (Deployment a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Deployment a -> c (Deployment a)
Data, Typeable, Deployment a -> Deployment a -> Bool
forall a. Eq a => Deployment a -> Deployment a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Deployment a -> Deployment a -> Bool
$c/= :: forall a. Eq a => Deployment a -> Deployment a -> Bool
== :: Deployment a -> Deployment a -> Bool
$c== :: forall a. Eq a => Deployment a -> Deployment a -> Bool
Eq, Deployment a -> Deployment a -> Bool
Deployment a -> Deployment a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Deployment a)
forall a. Ord a => Deployment a -> Deployment a -> Bool
forall a. Ord a => Deployment a -> Deployment a -> Ordering
forall a. Ord a => Deployment a -> Deployment a -> Deployment a
min :: Deployment a -> Deployment a -> Deployment a
$cmin :: forall a. Ord a => Deployment a -> Deployment a -> Deployment a
max :: Deployment a -> Deployment a -> Deployment a
$cmax :: forall a. Ord a => Deployment a -> Deployment a -> Deployment a
>= :: Deployment a -> Deployment a -> Bool
$c>= :: forall a. Ord a => Deployment a -> Deployment a -> Bool
> :: Deployment a -> Deployment a -> Bool
$c> :: forall a. Ord a => Deployment a -> Deployment a -> Bool
<= :: Deployment a -> Deployment a -> Bool
$c<= :: forall a. Ord a => Deployment a -> Deployment a -> Bool
< :: Deployment a -> Deployment a -> Bool
$c< :: forall a. Ord a => Deployment a -> Deployment a -> Bool
compare :: Deployment a -> Deployment a -> Ordering
$ccompare :: forall a. Ord a => Deployment a -> Deployment a -> Ordering
Ord, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Deployment a) x -> Deployment a
forall a x. Deployment a -> Rep (Deployment a) x
$cto :: forall a x. Rep (Deployment a) x -> Deployment a
$cfrom :: forall a x. Deployment a -> Rep (Deployment a) x
Generic)

instance NFData a => NFData (Deployment a) where rnf :: Deployment a -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary a => Binary (Deployment a)

instance FromJSON a => FromJSON (Deployment a) where
    parseJSON :: Value -> Parser (Deployment a)
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GitHub Deployment" forall a b. (a -> b) -> a -> b
$ \Object
o ->
        forall a.
URL
-> Id (Deployment a)
-> Name (Deployment a)
-> Text
-> Text
-> Maybe a
-> Text
-> Text
-> SimpleUser
-> UTCTime
-> UTCTime
-> URL
-> URL
-> Deployment a
Deployment
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sha"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ref"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"task"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"payload"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"environment"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"creator"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"statuses_url"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"repository_url"

data CreateDeployment a = CreateDeployment
    { forall a. CreateDeployment a -> Text
createDeploymentRef              :: !Text
    -- ^ Required. The ref to deploy. This can be a branch, tag, or SHA.
    , forall a. CreateDeployment a -> Maybe Text
createDeploymentTask             :: !(Maybe Text)
    -- ^ Specifies a task to execute (e.g., deploy or deploy:migrations).
    -- Default: deploy
    , forall a. CreateDeployment a -> Maybe Bool
createDeploymentAutoMerge        :: !(Maybe Bool)
    -- ^ Attempts to automatically merge the default branch into the requested
    -- ref, if it is behind the default branch. Default: true
    , forall a. CreateDeployment a -> Maybe (Vector Text)
createDeploymentRequiredContexts :: !(Maybe (Vector Text))
    -- ^ The status contexts to verify against commit status checks. If this
    -- parameter is omitted, then all unique contexts will be verified before a
    -- deployment is created. To bypass checking entirely pass an empty array.
    -- Defaults to all unique contexts.
    , forall a. CreateDeployment a -> Maybe a
createDeploymentPayload          :: !(Maybe a)
    -- ^ JSON payload with extra information about the deployment. Default: ""
    , forall a. CreateDeployment a -> Maybe Text
createDeploymentEnvironment      :: !(Maybe Text)
    -- ^ Name for the target deployment environment (e.g., production, staging,
    -- qa). Default: production
    , forall a. CreateDeployment a -> Maybe Text
createDeploymentDescription      :: !(Maybe Text)
    -- ^ Short description of the deployment. Default: ""
    } deriving (Int -> CreateDeployment a -> ShowS
forall a. Show a => Int -> CreateDeployment a -> ShowS
forall a. Show a => [CreateDeployment a] -> ShowS
forall a. Show a => CreateDeployment a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDeployment a] -> ShowS
$cshowList :: forall a. Show a => [CreateDeployment a] -> ShowS
show :: CreateDeployment a -> String
$cshow :: forall a. Show a => CreateDeployment a -> String
showsPrec :: Int -> CreateDeployment a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CreateDeployment a -> ShowS
Show, CreateDeployment a -> DataType
CreateDeployment a -> Constr
forall {a}. Data a => Typeable (CreateDeployment a)
forall a. Data a => CreateDeployment a -> DataType
forall a. Data a => CreateDeployment a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b)
-> CreateDeployment a -> CreateDeployment a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> CreateDeployment a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> CreateDeployment a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateDeployment a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateDeployment a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> CreateDeployment a -> m (CreateDeployment a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> CreateDeployment a -> m (CreateDeployment a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CreateDeployment a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateDeployment a
-> c (CreateDeployment a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (CreateDeployment a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CreateDeployment a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CreateDeployment a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateDeployment a
-> c (CreateDeployment a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (CreateDeployment a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateDeployment a -> m (CreateDeployment a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> CreateDeployment a -> m (CreateDeployment a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateDeployment a -> m (CreateDeployment a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> CreateDeployment a -> m (CreateDeployment a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateDeployment a -> m (CreateDeployment a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> CreateDeployment a -> m (CreateDeployment a)
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateDeployment a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> CreateDeployment a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> CreateDeployment a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> CreateDeployment a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateDeployment a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateDeployment a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateDeployment a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateDeployment a -> r
gmapT :: (forall b. Data b => b -> b)
-> CreateDeployment a -> CreateDeployment a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b)
-> CreateDeployment a -> CreateDeployment a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CreateDeployment a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CreateDeployment a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (CreateDeployment a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (CreateDeployment a))
dataTypeOf :: CreateDeployment a -> DataType
$cdataTypeOf :: forall a. Data a => CreateDeployment a -> DataType
toConstr :: CreateDeployment a -> Constr
$ctoConstr :: forall a. Data a => CreateDeployment a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CreateDeployment a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CreateDeployment a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateDeployment a
-> c (CreateDeployment a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateDeployment a
-> c (CreateDeployment a)
Data, Typeable, CreateDeployment a -> CreateDeployment a -> Bool
forall a. Eq a => CreateDeployment a -> CreateDeployment a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDeployment a -> CreateDeployment a -> Bool
$c/= :: forall a. Eq a => CreateDeployment a -> CreateDeployment a -> Bool
== :: CreateDeployment a -> CreateDeployment a -> Bool
$c== :: forall a. Eq a => CreateDeployment a -> CreateDeployment a -> Bool
Eq, CreateDeployment a -> CreateDeployment a -> Bool
CreateDeployment a -> CreateDeployment a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (CreateDeployment a)
forall a. Ord a => CreateDeployment a -> CreateDeployment a -> Bool
forall a.
Ord a =>
CreateDeployment a -> CreateDeployment a -> Ordering
forall a.
Ord a =>
CreateDeployment a -> CreateDeployment a -> CreateDeployment a
min :: CreateDeployment a -> CreateDeployment a -> CreateDeployment a
$cmin :: forall a.
Ord a =>
CreateDeployment a -> CreateDeployment a -> CreateDeployment a
max :: CreateDeployment a -> CreateDeployment a -> CreateDeployment a
$cmax :: forall a.
Ord a =>
CreateDeployment a -> CreateDeployment a -> CreateDeployment a
>= :: CreateDeployment a -> CreateDeployment a -> Bool
$c>= :: forall a. Ord a => CreateDeployment a -> CreateDeployment a -> Bool
> :: CreateDeployment a -> CreateDeployment a -> Bool
$c> :: forall a. Ord a => CreateDeployment a -> CreateDeployment a -> Bool
<= :: CreateDeployment a -> CreateDeployment a -> Bool
$c<= :: forall a. Ord a => CreateDeployment a -> CreateDeployment a -> Bool
< :: CreateDeployment a -> CreateDeployment a -> Bool
$c< :: forall a. Ord a => CreateDeployment a -> CreateDeployment a -> Bool
compare :: CreateDeployment a -> CreateDeployment a -> Ordering
$ccompare :: forall a.
Ord a =>
CreateDeployment a -> CreateDeployment a -> Ordering
Ord, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (CreateDeployment a) x -> CreateDeployment a
forall a x. CreateDeployment a -> Rep (CreateDeployment a) x
$cto :: forall a x. Rep (CreateDeployment a) x -> CreateDeployment a
$cfrom :: forall a x. CreateDeployment a -> Rep (CreateDeployment a) x
Generic)

instance NFData a => NFData (CreateDeployment a) where rnf :: CreateDeployment a -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary a => Binary (CreateDeployment a)

instance ToJSON a => ToJSON (CreateDeployment a) where
    toJSON :: CreateDeployment a -> Value
toJSON CreateDeployment a
x =
        [Pair] -> Value
JSON.object forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes
            [ forall a. a -> Maybe a
Just (Key
"ref"          forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=      forall a. CreateDeployment a -> Text
createDeploymentRef CreateDeployment a
x)
            , (Key
"task"              forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. CreateDeployment a -> Maybe Text
createDeploymentTask CreateDeployment a
x
            , (Key
"auto_merge"        forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. CreateDeployment a -> Maybe Bool
createDeploymentAutoMerge CreateDeployment a
x
            , (Key
"required_contexts" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. CreateDeployment a -> Maybe (Vector Text)
createDeploymentRequiredContexts CreateDeployment a
x
            , (Key
"payload"           forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. CreateDeployment a -> Maybe a
createDeploymentPayload CreateDeployment a
x
            , (Key
"environment"       forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. CreateDeployment a -> Maybe Text
createDeploymentEnvironment CreateDeployment a
x
            , (Key
"description"       forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. CreateDeployment a -> Maybe Text
createDeploymentDescription CreateDeployment a
x
            ]

data DeploymentStatus = DeploymentStatus
    { DeploymentStatus -> URL
deploymentStatusUrl           :: !URL
    , DeploymentStatus -> Id DeploymentStatus
deploymentStatusId            :: !(Id DeploymentStatus)
    , DeploymentStatus -> DeploymentStatusState
deploymentStatusState         :: !DeploymentStatusState
    , DeploymentStatus -> SimpleUser
deploymentStatusCreator       :: !SimpleUser
    , DeploymentStatus -> Text
deploymentStatusDescription   :: !Text
    , DeploymentStatus -> URL
deploymentStatusTargetUrl     :: !URL
    , DeploymentStatus -> UTCTime
deploymentStatusCreatedAt     :: !UTCTime
    , DeploymentStatus -> UTCTime
deploymentStatusUpdatedAt     :: !UTCTime
    , DeploymentStatus -> URL
deploymentStatusDeploymentUrl :: !URL
    , DeploymentStatus -> URL
deploymentStatusRepositoryUrl :: !URL
    } deriving (Int -> DeploymentStatus -> ShowS
[DeploymentStatus] -> ShowS
DeploymentStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeploymentStatus] -> ShowS
$cshowList :: [DeploymentStatus] -> ShowS
show :: DeploymentStatus -> String
$cshow :: DeploymentStatus -> String
showsPrec :: Int -> DeploymentStatus -> ShowS
$cshowsPrec :: Int -> DeploymentStatus -> ShowS
Show, Typeable DeploymentStatus
DeploymentStatus -> DataType
DeploymentStatus -> Constr
(forall b. Data b => b -> b)
-> DeploymentStatus -> DeploymentStatus
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> DeploymentStatus -> u
forall u. (forall d. Data d => d -> u) -> DeploymentStatus -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeploymentStatus -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeploymentStatus -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeploymentStatus -> m DeploymentStatus
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeploymentStatus -> m DeploymentStatus
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeploymentStatus
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DeploymentStatus -> c DeploymentStatus
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeploymentStatus)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeploymentStatus)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeploymentStatus -> m DeploymentStatus
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeploymentStatus -> m DeploymentStatus
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeploymentStatus -> m DeploymentStatus
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeploymentStatus -> m DeploymentStatus
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeploymentStatus -> m DeploymentStatus
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeploymentStatus -> m DeploymentStatus
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DeploymentStatus -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DeploymentStatus -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> DeploymentStatus -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DeploymentStatus -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeploymentStatus -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeploymentStatus -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeploymentStatus -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeploymentStatus -> r
gmapT :: (forall b. Data b => b -> b)
-> DeploymentStatus -> DeploymentStatus
$cgmapT :: (forall b. Data b => b -> b)
-> DeploymentStatus -> DeploymentStatus
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeploymentStatus)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeploymentStatus)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeploymentStatus)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeploymentStatus)
dataTypeOf :: DeploymentStatus -> DataType
$cdataTypeOf :: DeploymentStatus -> DataType
toConstr :: DeploymentStatus -> Constr
$ctoConstr :: DeploymentStatus -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeploymentStatus
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeploymentStatus
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DeploymentStatus -> c DeploymentStatus
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DeploymentStatus -> c DeploymentStatus
Data, Typeable, DeploymentStatus -> DeploymentStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeploymentStatus -> DeploymentStatus -> Bool
$c/= :: DeploymentStatus -> DeploymentStatus -> Bool
== :: DeploymentStatus -> DeploymentStatus -> Bool
$c== :: DeploymentStatus -> DeploymentStatus -> Bool
Eq, Eq DeploymentStatus
DeploymentStatus -> DeploymentStatus -> Bool
DeploymentStatus -> DeploymentStatus -> Ordering
DeploymentStatus -> DeploymentStatus -> DeploymentStatus
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DeploymentStatus -> DeploymentStatus -> DeploymentStatus
$cmin :: DeploymentStatus -> DeploymentStatus -> DeploymentStatus
max :: DeploymentStatus -> DeploymentStatus -> DeploymentStatus
$cmax :: DeploymentStatus -> DeploymentStatus -> DeploymentStatus
>= :: DeploymentStatus -> DeploymentStatus -> Bool
$c>= :: DeploymentStatus -> DeploymentStatus -> Bool
> :: DeploymentStatus -> DeploymentStatus -> Bool
$c> :: DeploymentStatus -> DeploymentStatus -> Bool
<= :: DeploymentStatus -> DeploymentStatus -> Bool
$c<= :: DeploymentStatus -> DeploymentStatus -> Bool
< :: DeploymentStatus -> DeploymentStatus -> Bool
$c< :: DeploymentStatus -> DeploymentStatus -> Bool
compare :: DeploymentStatus -> DeploymentStatus -> Ordering
$ccompare :: DeploymentStatus -> DeploymentStatus -> Ordering
Ord, forall x. Rep DeploymentStatus x -> DeploymentStatus
forall x. DeploymentStatus -> Rep DeploymentStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeploymentStatus x -> DeploymentStatus
$cfrom :: forall x. DeploymentStatus -> Rep DeploymentStatus x
Generic)

instance NFData DeploymentStatus where rnf :: DeploymentStatus -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary DeploymentStatus

instance FromJSON DeploymentStatus where
    parseJSON :: Value -> Parser DeploymentStatus
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GitHub DeploymentStatus" forall a b. (a -> b) -> a -> b
$ \Object
o ->
        URL
-> Id DeploymentStatus
-> DeploymentStatusState
-> SimpleUser
-> Text
-> URL
-> UTCTime
-> UTCTime
-> URL
-> URL
-> DeploymentStatus
DeploymentStatus
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"state"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"creator"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"target_url"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"deployment_url"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"repository_url"

data DeploymentStatusState
    = DeploymentStatusError
    | DeploymentStatusFailure
    | DeploymentStatusPending
    | DeploymentStatusSuccess
    | DeploymentStatusInactive
      deriving (Int -> DeploymentStatusState -> ShowS
[DeploymentStatusState] -> ShowS
DeploymentStatusState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeploymentStatusState] -> ShowS
$cshowList :: [DeploymentStatusState] -> ShowS
show :: DeploymentStatusState -> String
$cshow :: DeploymentStatusState -> String
showsPrec :: Int -> DeploymentStatusState -> ShowS
$cshowsPrec :: Int -> DeploymentStatusState -> ShowS
Show, Typeable DeploymentStatusState
DeploymentStatusState -> DataType
DeploymentStatusState -> Constr
(forall b. Data b => b -> b)
-> DeploymentStatusState -> DeploymentStatusState
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> DeploymentStatusState -> u
forall u.
(forall d. Data d => d -> u) -> DeploymentStatusState -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeploymentStatusState -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeploymentStatusState -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeploymentStatusState -> m DeploymentStatusState
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeploymentStatusState -> m DeploymentStatusState
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeploymentStatusState
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeploymentStatusState
-> c DeploymentStatusState
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeploymentStatusState)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeploymentStatusState)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeploymentStatusState -> m DeploymentStatusState
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeploymentStatusState -> m DeploymentStatusState
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeploymentStatusState -> m DeploymentStatusState
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeploymentStatusState -> m DeploymentStatusState
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeploymentStatusState -> m DeploymentStatusState
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeploymentStatusState -> m DeploymentStatusState
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DeploymentStatusState -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DeploymentStatusState -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> DeploymentStatusState -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> DeploymentStatusState -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeploymentStatusState -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeploymentStatusState -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeploymentStatusState -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeploymentStatusState -> r
gmapT :: (forall b. Data b => b -> b)
-> DeploymentStatusState -> DeploymentStatusState
$cgmapT :: (forall b. Data b => b -> b)
-> DeploymentStatusState -> DeploymentStatusState
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeploymentStatusState)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeploymentStatusState)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeploymentStatusState)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeploymentStatusState)
dataTypeOf :: DeploymentStatusState -> DataType
$cdataTypeOf :: DeploymentStatusState -> DataType
toConstr :: DeploymentStatusState -> Constr
$ctoConstr :: DeploymentStatusState -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeploymentStatusState
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeploymentStatusState
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeploymentStatusState
-> c DeploymentStatusState
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeploymentStatusState
-> c DeploymentStatusState
Data, Typeable, DeploymentStatusState -> DeploymentStatusState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeploymentStatusState -> DeploymentStatusState -> Bool
$c/= :: DeploymentStatusState -> DeploymentStatusState -> Bool
== :: DeploymentStatusState -> DeploymentStatusState -> Bool
$c== :: DeploymentStatusState -> DeploymentStatusState -> Bool
Eq, Eq DeploymentStatusState
DeploymentStatusState -> DeploymentStatusState -> Bool
DeploymentStatusState -> DeploymentStatusState -> Ordering
DeploymentStatusState
-> DeploymentStatusState -> DeploymentStatusState
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DeploymentStatusState
-> DeploymentStatusState -> DeploymentStatusState
$cmin :: DeploymentStatusState
-> DeploymentStatusState -> DeploymentStatusState
max :: DeploymentStatusState
-> DeploymentStatusState -> DeploymentStatusState
$cmax :: DeploymentStatusState
-> DeploymentStatusState -> DeploymentStatusState
>= :: DeploymentStatusState -> DeploymentStatusState -> Bool
$c>= :: DeploymentStatusState -> DeploymentStatusState -> Bool
> :: DeploymentStatusState -> DeploymentStatusState -> Bool
$c> :: DeploymentStatusState -> DeploymentStatusState -> Bool
<= :: DeploymentStatusState -> DeploymentStatusState -> Bool
$c<= :: DeploymentStatusState -> DeploymentStatusState -> Bool
< :: DeploymentStatusState -> DeploymentStatusState -> Bool
$c< :: DeploymentStatusState -> DeploymentStatusState -> Bool
compare :: DeploymentStatusState -> DeploymentStatusState -> Ordering
$ccompare :: DeploymentStatusState -> DeploymentStatusState -> Ordering
Ord, forall x. Rep DeploymentStatusState x -> DeploymentStatusState
forall x. DeploymentStatusState -> Rep DeploymentStatusState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeploymentStatusState x -> DeploymentStatusState
$cfrom :: forall x. DeploymentStatusState -> Rep DeploymentStatusState x
Generic)

instance NFData DeploymentStatusState where rnf :: DeploymentStatusState -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary DeploymentStatusState

instance ToJSON DeploymentStatusState where
    toJSON :: DeploymentStatusState -> Value
toJSON = \case
        DeploymentStatusState
DeploymentStatusError    -> Value
"error"
        DeploymentStatusState
DeploymentStatusFailure  -> Value
"failure"
        DeploymentStatusState
DeploymentStatusPending  -> Value
"pending"
        DeploymentStatusState
DeploymentStatusSuccess  -> Value
"success"
        DeploymentStatusState
DeploymentStatusInactive -> Value
"inactive"

instance FromJSON DeploymentStatusState where
    parseJSON :: Value -> Parser DeploymentStatusState
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"DeploymentStatusState" forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text -> Text
T.toLower Text
t of
        Text
"error"    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DeploymentStatusState
DeploymentStatusError
        Text
"failure"  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DeploymentStatusState
DeploymentStatusFailure
        Text
"pending"  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DeploymentStatusState
DeploymentStatusPending
        Text
"success"  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DeploymentStatusState
DeploymentStatusSuccess
        Text
"inactive" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DeploymentStatusState
DeploymentStatusInactive
        Text
_          -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown DeploymentStatusState: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t

data CreateDeploymentStatus = CreateDeploymentStatus
    { CreateDeploymentStatus -> DeploymentStatusState
createDeploymentStatusState       :: !DeploymentStatusState
    -- ^ Required. The state of the status. Can be one of error, failure,
    -- pending, or success.
    , CreateDeploymentStatus -> Maybe Text
createDeploymentStatusTargetUrl   :: !(Maybe Text) -- TODO: should this be URL?
    -- ^ The target URL to associate with this status. This URL should contain
    -- output to keep the user updated while the task is running or serve as
    -- historical information for what happened in the deployment. Default: ""
    , CreateDeploymentStatus -> Maybe Text
createDeploymentStatusDescription :: !(Maybe Text)
    -- ^ A short description of the status. Maximum length of 140 characters.
    -- Default: ""
    } deriving (Int -> CreateDeploymentStatus -> ShowS
[CreateDeploymentStatus] -> ShowS
CreateDeploymentStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDeploymentStatus] -> ShowS
$cshowList :: [CreateDeploymentStatus] -> ShowS
show :: CreateDeploymentStatus -> String
$cshow :: CreateDeploymentStatus -> String
showsPrec :: Int -> CreateDeploymentStatus -> ShowS
$cshowsPrec :: Int -> CreateDeploymentStatus -> ShowS
Show, Typeable CreateDeploymentStatus
CreateDeploymentStatus -> DataType
CreateDeploymentStatus -> Constr
(forall b. Data b => b -> b)
-> CreateDeploymentStatus -> CreateDeploymentStatus
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CreateDeploymentStatus -> u
forall u.
(forall d. Data d => d -> u) -> CreateDeploymentStatus -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateDeploymentStatus
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateDeploymentStatus
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateDeploymentStatus -> m CreateDeploymentStatus
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateDeploymentStatus -> m CreateDeploymentStatus
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateDeploymentStatus
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateDeploymentStatus
-> c CreateDeploymentStatus
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateDeploymentStatus)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateDeploymentStatus)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateDeploymentStatus -> m CreateDeploymentStatus
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateDeploymentStatus -> m CreateDeploymentStatus
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateDeploymentStatus -> m CreateDeploymentStatus
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateDeploymentStatus -> m CreateDeploymentStatus
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateDeploymentStatus -> m CreateDeploymentStatus
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateDeploymentStatus -> m CreateDeploymentStatus
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateDeploymentStatus -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateDeploymentStatus -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateDeploymentStatus -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CreateDeploymentStatus -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateDeploymentStatus
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateDeploymentStatus
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateDeploymentStatus
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CreateDeploymentStatus
-> r
gmapT :: (forall b. Data b => b -> b)
-> CreateDeploymentStatus -> CreateDeploymentStatus
$cgmapT :: (forall b. Data b => b -> b)
-> CreateDeploymentStatus -> CreateDeploymentStatus
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateDeploymentStatus)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateDeploymentStatus)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateDeploymentStatus)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateDeploymentStatus)
dataTypeOf :: CreateDeploymentStatus -> DataType
$cdataTypeOf :: CreateDeploymentStatus -> DataType
toConstr :: CreateDeploymentStatus -> Constr
$ctoConstr :: CreateDeploymentStatus -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateDeploymentStatus
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateDeploymentStatus
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateDeploymentStatus
-> c CreateDeploymentStatus
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateDeploymentStatus
-> c CreateDeploymentStatus
Data, Typeable, CreateDeploymentStatus -> CreateDeploymentStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDeploymentStatus -> CreateDeploymentStatus -> Bool
$c/= :: CreateDeploymentStatus -> CreateDeploymentStatus -> Bool
== :: CreateDeploymentStatus -> CreateDeploymentStatus -> Bool
$c== :: CreateDeploymentStatus -> CreateDeploymentStatus -> Bool
Eq, Eq CreateDeploymentStatus
CreateDeploymentStatus -> CreateDeploymentStatus -> Bool
CreateDeploymentStatus -> CreateDeploymentStatus -> Ordering
CreateDeploymentStatus
-> CreateDeploymentStatus -> CreateDeploymentStatus
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CreateDeploymentStatus
-> CreateDeploymentStatus -> CreateDeploymentStatus
$cmin :: CreateDeploymentStatus
-> CreateDeploymentStatus -> CreateDeploymentStatus
max :: CreateDeploymentStatus
-> CreateDeploymentStatus -> CreateDeploymentStatus
$cmax :: CreateDeploymentStatus
-> CreateDeploymentStatus -> CreateDeploymentStatus
>= :: CreateDeploymentStatus -> CreateDeploymentStatus -> Bool
$c>= :: CreateDeploymentStatus -> CreateDeploymentStatus -> Bool
> :: CreateDeploymentStatus -> CreateDeploymentStatus -> Bool
$c> :: CreateDeploymentStatus -> CreateDeploymentStatus -> Bool
<= :: CreateDeploymentStatus -> CreateDeploymentStatus -> Bool
$c<= :: CreateDeploymentStatus -> CreateDeploymentStatus -> Bool
< :: CreateDeploymentStatus -> CreateDeploymentStatus -> Bool
$c< :: CreateDeploymentStatus -> CreateDeploymentStatus -> Bool
compare :: CreateDeploymentStatus -> CreateDeploymentStatus -> Ordering
$ccompare :: CreateDeploymentStatus -> CreateDeploymentStatus -> Ordering
Ord, forall x. Rep CreateDeploymentStatus x -> CreateDeploymentStatus
forall x. CreateDeploymentStatus -> Rep CreateDeploymentStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDeploymentStatus x -> CreateDeploymentStatus
$cfrom :: forall x. CreateDeploymentStatus -> Rep CreateDeploymentStatus x
Generic)

instance NFData CreateDeploymentStatus where rnf :: CreateDeploymentStatus -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary CreateDeploymentStatus

instance ToJSON CreateDeploymentStatus where
    toJSON :: CreateDeploymentStatus -> Value
toJSON CreateDeploymentStatus
x =
        [Pair] -> Value
JSON.object forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes
            [ forall a. a -> Maybe a
Just (Key
"state"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CreateDeploymentStatus -> DeploymentStatusState
createDeploymentStatusState CreateDeploymentStatus
x)
            , (Key
"target_url"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CreateDeploymentStatus -> Maybe Text
createDeploymentStatusTargetUrl CreateDeploymentStatus
x
            , (Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CreateDeploymentStatus -> Maybe Text
createDeploymentStatusDescription CreateDeploymentStatus
x
            ]