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

------------------------------------------------------------------------------
-- PageBuild

data PageBuild = PageBuild
    { PageBuild -> Text
pageBuildCommit    :: Text
    , PageBuild -> DateTime
pageBuildCreatedAt :: DateTime
    , PageBuild -> Int
pageBuildDuration  :: Int
    , PageBuild -> PageBuildError
pageBuildError     :: PageBuildError
    , PageBuild -> User
pageBuildPusher    :: User
    , PageBuild -> Text
pageBuildStatus    :: Text
    , PageBuild -> DateTime
pageBuildUpdatedAt :: DateTime
    , PageBuild -> Text
pageBuildUrl       :: Text
    } deriving (PageBuild -> PageBuild -> Bool
(PageBuild -> PageBuild -> Bool)
-> (PageBuild -> PageBuild -> Bool) -> Eq PageBuild
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PageBuild -> PageBuild -> Bool
$c/= :: PageBuild -> PageBuild -> Bool
== :: PageBuild -> PageBuild -> Bool
$c== :: PageBuild -> PageBuild -> Bool
Eq, Int -> PageBuild -> ShowS
[PageBuild] -> ShowS
PageBuild -> String
(Int -> PageBuild -> ShowS)
-> (PageBuild -> String)
-> ([PageBuild] -> ShowS)
-> Show PageBuild
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PageBuild] -> ShowS
$cshowList :: [PageBuild] -> ShowS
show :: PageBuild -> String
$cshow :: PageBuild -> String
showsPrec :: Int -> PageBuild -> ShowS
$cshowsPrec :: Int -> PageBuild -> ShowS
Show, ReadPrec [PageBuild]
ReadPrec PageBuild
Int -> ReadS PageBuild
ReadS [PageBuild]
(Int -> ReadS PageBuild)
-> ReadS [PageBuild]
-> ReadPrec PageBuild
-> ReadPrec [PageBuild]
-> Read PageBuild
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PageBuild]
$creadListPrec :: ReadPrec [PageBuild]
readPrec :: ReadPrec PageBuild
$creadPrec :: ReadPrec PageBuild
readList :: ReadS [PageBuild]
$creadList :: ReadS [PageBuild]
readsPrec :: Int -> ReadS PageBuild
$creadsPrec :: Int -> ReadS PageBuild
Read)


instance FromJSON PageBuild where
    parseJSON :: Value -> Parser PageBuild
parseJSON (Object Object
x) = Text
-> DateTime
-> Int
-> PageBuildError
-> User
-> Text
-> DateTime
-> Text
-> PageBuild
PageBuild
        (Text
 -> DateTime
 -> Int
 -> PageBuildError
 -> User
 -> Text
 -> DateTime
 -> Text
 -> PageBuild)
-> Parser Text
-> Parser
     (DateTime
      -> Int
      -> PageBuildError
      -> User
      -> Text
      -> DateTime
      -> Text
      -> PageBuild)
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
"commit"
        Parser
  (DateTime
   -> Int
   -> PageBuildError
   -> User
   -> Text
   -> DateTime
   -> Text
   -> PageBuild)
-> Parser DateTime
-> Parser
     (Int
      -> PageBuildError -> User -> Text -> DateTime -> Text -> PageBuild)
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
  (Int
   -> PageBuildError -> User -> Text -> DateTime -> Text -> PageBuild)
-> Parser Int
-> Parser
     (PageBuildError -> User -> Text -> DateTime -> Text -> PageBuild)
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
"duration"
        Parser
  (PageBuildError -> User -> Text -> DateTime -> Text -> PageBuild)
-> Parser PageBuildError
-> Parser (User -> Text -> DateTime -> Text -> PageBuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser PageBuildError
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error"
        Parser (User -> Text -> DateTime -> Text -> PageBuild)
-> Parser User -> Parser (Text -> DateTime -> Text -> PageBuild)
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
"pusher"
        Parser (Text -> DateTime -> Text -> PageBuild)
-> Parser Text -> Parser (DateTime -> Text -> PageBuild)
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
"status"
        Parser (DateTime -> Text -> PageBuild)
-> Parser DateTime -> Parser (Text -> PageBuild)
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 -> PageBuild) -> Parser Text -> Parser PageBuild
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
"url"

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


instance ToJSON PageBuild where
    toJSON :: PageBuild -> Value
toJSON PageBuild{Int
Text
DateTime
PageBuildError
User
pageBuildUrl :: Text
pageBuildUpdatedAt :: DateTime
pageBuildStatus :: Text
pageBuildPusher :: User
pageBuildError :: PageBuildError
pageBuildDuration :: Int
pageBuildCreatedAt :: DateTime
pageBuildCommit :: Text
pageBuildUrl :: PageBuild -> Text
pageBuildUpdatedAt :: PageBuild -> DateTime
pageBuildStatus :: PageBuild -> Text
pageBuildPusher :: PageBuild -> User
pageBuildError :: PageBuild -> PageBuildError
pageBuildDuration :: PageBuild -> Int
pageBuildCreatedAt :: PageBuild -> DateTime
pageBuildCommit :: PageBuild -> Text
..} = [Pair] -> Value
object
        [ Key
"commit"     Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pageBuildCommit
        , Key
"created_at" Key -> DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DateTime
pageBuildCreatedAt
        , Key
"duration"   Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
pageBuildDuration
        , Key
"error"      Key -> PageBuildError -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PageBuildError
pageBuildError
        , Key
"pusher"     Key -> User -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= User
pageBuildPusher
        , Key
"status"     Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pageBuildStatus
        , Key
"updated_at" Key -> DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DateTime
pageBuildUpdatedAt
        , Key
"url"        Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pageBuildUrl
        ]


instance Arbitrary PageBuild where
    arbitrary :: Gen PageBuild
arbitrary = Text
-> DateTime
-> Int
-> PageBuildError
-> User
-> Text
-> DateTime
-> Text
-> PageBuild
PageBuild
        (Text
 -> DateTime
 -> Int
 -> PageBuildError
 -> User
 -> Text
 -> DateTime
 -> Text
 -> PageBuild)
-> Gen Text
-> Gen
     (DateTime
      -> Int
      -> PageBuildError
      -> User
      -> Text
      -> DateTime
      -> Text
      -> PageBuild)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (DateTime
   -> Int
   -> PageBuildError
   -> User
   -> Text
   -> DateTime
   -> Text
   -> PageBuild)
-> Gen DateTime
-> Gen
     (Int
      -> PageBuildError -> User -> Text -> DateTime -> Text -> PageBuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen DateTime
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Int
   -> PageBuildError -> User -> Text -> DateTime -> Text -> PageBuild)
-> Gen Int
-> Gen
     (PageBuildError -> User -> Text -> DateTime -> Text -> PageBuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (PageBuildError -> User -> Text -> DateTime -> Text -> PageBuild)
-> Gen PageBuildError
-> Gen (User -> Text -> DateTime -> Text -> PageBuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen PageBuildError
forall a. Arbitrary a => Gen a
arbitrary
        Gen (User -> Text -> DateTime -> Text -> PageBuild)
-> Gen User -> Gen (Text -> DateTime -> Text -> PageBuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen User
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> DateTime -> Text -> PageBuild)
-> Gen Text -> Gen (DateTime -> Text -> PageBuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (DateTime -> Text -> PageBuild)
-> Gen DateTime -> Gen (Text -> PageBuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen DateTime
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> PageBuild) -> Gen Text -> Gen PageBuild
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary