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

------------------------------------------------------------------------------
-- DeploymentStatus

data DeploymentStatus = DeploymentStatus
    { DeploymentStatus -> Text
deploymentStatusUrl            :: Text
    , DeploymentStatus -> Int
deploymentStatusId             :: Int
    , DeploymentStatus -> Text
deploymentStatusState          :: Text
    , DeploymentStatus -> Text
deploymentStatusNodeId         :: Text
    , DeploymentStatus -> User
deploymentStatusCreator        :: User
    , DeploymentStatus -> Text
deploymentStatusDescription    :: Text
    , DeploymentStatus -> Text
deploymentStatusEnvironment    :: Text
    , DeploymentStatus -> Text
deploymentStatusTargetUrl      :: Text
    , DeploymentStatus -> Text
deploymentStatusLogUrl         :: Text
    , DeploymentStatus -> DateTime
deploymentStatusCreatedAt      :: DateTime
    , DeploymentStatus -> DateTime
deploymentStatusUpdatedAt      :: DateTime
    , DeploymentStatus -> Text
deploymentStatusDeploymentUrl  :: Text
    , DeploymentStatus -> Text
deploymentStatusRepositoryUrl  :: Text
    , DeploymentStatus -> Text
deploymentStatusEnvironmentUrl :: Text
    } deriving (DeploymentStatus -> DeploymentStatus -> Bool
(DeploymentStatus -> DeploymentStatus -> Bool)
-> (DeploymentStatus -> DeploymentStatus -> Bool)
-> Eq DeploymentStatus
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, Int -> DeploymentStatus -> ShowS
[DeploymentStatus] -> ShowS
DeploymentStatus -> String
(Int -> DeploymentStatus -> ShowS)
-> (DeploymentStatus -> String)
-> ([DeploymentStatus] -> ShowS)
-> Show DeploymentStatus
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, ReadPrec [DeploymentStatus]
ReadPrec DeploymentStatus
Int -> ReadS DeploymentStatus
ReadS [DeploymentStatus]
(Int -> ReadS DeploymentStatus)
-> ReadS [DeploymentStatus]
-> ReadPrec DeploymentStatus
-> ReadPrec [DeploymentStatus]
-> Read DeploymentStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeploymentStatus]
$creadListPrec :: ReadPrec [DeploymentStatus]
readPrec :: ReadPrec DeploymentStatus
$creadPrec :: ReadPrec DeploymentStatus
readList :: ReadS [DeploymentStatus]
$creadList :: ReadS [DeploymentStatus]
readsPrec :: Int -> ReadS DeploymentStatus
$creadsPrec :: Int -> ReadS DeploymentStatus
Read)

instance FromJSON DeploymentStatus where
    parseJSON :: Value -> Parser DeploymentStatus
parseJSON (Object Object
x) = Text
-> Int
-> Text
-> Text
-> User
-> Text
-> Text
-> Text
-> Text
-> DateTime
-> DateTime
-> Text
-> Text
-> Text
-> DeploymentStatus
DeploymentStatus
        (Text
 -> Int
 -> Text
 -> Text
 -> User
 -> Text
 -> Text
 -> Text
 -> Text
 -> DateTime
 -> DateTime
 -> Text
 -> Text
 -> Text
 -> DeploymentStatus)
-> Parser Text
-> Parser
     (Int
      -> Text
      -> Text
      -> User
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Text
      -> DeploymentStatus)
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
   -> User
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Text
   -> DeploymentStatus)
-> Parser Int
-> Parser
     (Text
      -> Text
      -> User
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Text
      -> DeploymentStatus)
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
   -> User
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Text
   -> DeploymentStatus)
-> Parser Text
-> Parser
     (Text
      -> User
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Text
      -> DeploymentStatus)
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
  (Text
   -> User
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Text
   -> DeploymentStatus)
-> Parser Text
-> Parser
     (User
      -> Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Text
      -> DeploymentStatus)
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
  (User
   -> Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Text
   -> DeploymentStatus)
-> Parser User
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Text
      -> DeploymentStatus)
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
  (Text
   -> Text
   -> Text
   -> Text
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Text
   -> DeploymentStatus)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Text
      -> DeploymentStatus)
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
  (Text
   -> Text
   -> Text
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Text
   -> DeploymentStatus)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Text
      -> DeploymentStatus)
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
   -> Text
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Text
   -> DeploymentStatus)
-> Parser Text
-> Parser
     (Text
      -> DateTime
      -> DateTime
      -> Text
      -> Text
      -> Text
      -> DeploymentStatus)
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
"target_url"
        Parser
  (Text
   -> DateTime
   -> DateTime
   -> Text
   -> Text
   -> Text
   -> DeploymentStatus)
-> Parser Text
-> Parser
     (DateTime -> DateTime -> Text -> Text -> Text -> DeploymentStatus)
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
"log_url"
        Parser
  (DateTime -> DateTime -> Text -> Text -> Text -> DeploymentStatus)
-> Parser DateTime
-> Parser (DateTime -> Text -> Text -> Text -> DeploymentStatus)
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 -> Text -> DeploymentStatus)
-> Parser DateTime
-> Parser (Text -> Text -> Text -> DeploymentStatus)
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 -> Text -> DeploymentStatus)
-> Parser Text -> Parser (Text -> Text -> DeploymentStatus)
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
"deployment_url"
        Parser (Text -> Text -> DeploymentStatus)
-> Parser Text -> Parser (Text -> DeploymentStatus)
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"
        Parser (Text -> DeploymentStatus)
-> Parser Text -> Parser DeploymentStatus
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_url"

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

instance ToJSON DeploymentStatus where
    toJSON :: DeploymentStatus -> Value
toJSON DeploymentStatus{Int
Text
DateTime
User
deploymentStatusEnvironmentUrl :: Text
deploymentStatusRepositoryUrl :: Text
deploymentStatusDeploymentUrl :: Text
deploymentStatusUpdatedAt :: DateTime
deploymentStatusCreatedAt :: DateTime
deploymentStatusLogUrl :: Text
deploymentStatusTargetUrl :: Text
deploymentStatusEnvironment :: Text
deploymentStatusDescription :: Text
deploymentStatusCreator :: User
deploymentStatusNodeId :: Text
deploymentStatusState :: Text
deploymentStatusId :: Int
deploymentStatusUrl :: Text
deploymentStatusEnvironmentUrl :: DeploymentStatus -> Text
deploymentStatusRepositoryUrl :: DeploymentStatus -> Text
deploymentStatusDeploymentUrl :: DeploymentStatus -> Text
deploymentStatusUpdatedAt :: DeploymentStatus -> DateTime
deploymentStatusCreatedAt :: DeploymentStatus -> DateTime
deploymentStatusLogUrl :: DeploymentStatus -> Text
deploymentStatusTargetUrl :: DeploymentStatus -> Text
deploymentStatusEnvironment :: DeploymentStatus -> Text
deploymentStatusDescription :: DeploymentStatus -> Text
deploymentStatusCreator :: DeploymentStatus -> User
deploymentStatusNodeId :: DeploymentStatus -> Text
deploymentStatusState :: DeploymentStatus -> Text
deploymentStatusId :: DeploymentStatus -> Int
deploymentStatusUrl :: DeploymentStatus -> Text
..} = [Pair] -> Value
object
        [ Key
"url"             Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deploymentStatusUrl
        , Key
"id"              Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
deploymentStatusId
        , Key
"state"           Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deploymentStatusState
        , Key
"node_id"         Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deploymentStatusNodeId
        , Key
"creator"         Key -> User -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= User
deploymentStatusCreator
        , Key
"description"     Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deploymentStatusDescription
        , Key
"environment"     Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deploymentStatusEnvironment
        , Key
"target_url"      Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deploymentStatusTargetUrl
        , Key
"log_url"         Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deploymentStatusLogUrl
        , Key
"created_at"      Key -> DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DateTime
deploymentStatusCreatedAt
        , Key
"updated_at"      Key -> DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DateTime
deploymentStatusUpdatedAt
        , Key
"deployment_url"  Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deploymentStatusDeploymentUrl
        , Key
"repository_url"  Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deploymentStatusRepositoryUrl
        , Key
"environment_url" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deploymentStatusEnvironmentUrl
        ]


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