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

------------------------------------------------------------------------------
-- CheckCommit

data CheckCommit = CheckCommit
    { CheckCommit -> Author
checkCommitAuthor    :: Author
    , CheckCommit -> Author
checkCommitCommitter :: Author
    , CheckCommit -> Text
checkCommitId        :: Text
    , CheckCommit -> Text
checkCommitMessage   :: Text
    , CheckCommit -> Text
checkCommitTimestamp :: Text
    , CheckCommit -> Text
checkCommitTreeId    :: Text
    } deriving (CheckCommit -> CheckCommit -> Bool
(CheckCommit -> CheckCommit -> Bool)
-> (CheckCommit -> CheckCommit -> Bool) -> Eq CheckCommit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckCommit -> CheckCommit -> Bool
$c/= :: CheckCommit -> CheckCommit -> Bool
== :: CheckCommit -> CheckCommit -> Bool
$c== :: CheckCommit -> CheckCommit -> Bool
Eq, Int -> CheckCommit -> ShowS
[CheckCommit] -> ShowS
CheckCommit -> String
(Int -> CheckCommit -> ShowS)
-> (CheckCommit -> String)
-> ([CheckCommit] -> ShowS)
-> Show CheckCommit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CheckCommit] -> ShowS
$cshowList :: [CheckCommit] -> ShowS
show :: CheckCommit -> String
$cshow :: CheckCommit -> String
showsPrec :: Int -> CheckCommit -> ShowS
$cshowsPrec :: Int -> CheckCommit -> ShowS
Show, ReadPrec [CheckCommit]
ReadPrec CheckCommit
Int -> ReadS CheckCommit
ReadS [CheckCommit]
(Int -> ReadS CheckCommit)
-> ReadS [CheckCommit]
-> ReadPrec CheckCommit
-> ReadPrec [CheckCommit]
-> Read CheckCommit
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CheckCommit]
$creadListPrec :: ReadPrec [CheckCommit]
readPrec :: ReadPrec CheckCommit
$creadPrec :: ReadPrec CheckCommit
readList :: ReadS [CheckCommit]
$creadList :: ReadS [CheckCommit]
readsPrec :: Int -> ReadS CheckCommit
$creadsPrec :: Int -> ReadS CheckCommit
Read)


instance FromJSON CheckCommit where
    parseJSON :: Value -> Parser CheckCommit
parseJSON (Object Object
x) = Author -> Author -> Text -> Text -> Text -> Text -> CheckCommit
CheckCommit
        (Author -> Author -> Text -> Text -> Text -> Text -> CheckCommit)
-> Parser Author
-> Parser (Author -> Text -> Text -> Text -> Text -> CheckCommit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
x Object -> Key -> Parser Author
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"author"
        Parser (Author -> Text -> Text -> Text -> Text -> CheckCommit)
-> Parser Author
-> Parser (Text -> Text -> Text -> Text -> CheckCommit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Author
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"committer"
        Parser (Text -> Text -> Text -> Text -> CheckCommit)
-> Parser Text -> Parser (Text -> Text -> Text -> CheckCommit)
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
"id"
        Parser (Text -> Text -> Text -> CheckCommit)
-> Parser Text -> Parser (Text -> Text -> CheckCommit)
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
"message"
        Parser (Text -> Text -> CheckCommit)
-> Parser Text -> Parser (Text -> CheckCommit)
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
"timestamp"
        Parser (Text -> CheckCommit) -> Parser Text -> Parser CheckCommit
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
"tree_id"

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


instance ToJSON CheckCommit where
    toJSON :: CheckCommit -> Value
toJSON CheckCommit{Text
Author
checkCommitTreeId :: Text
checkCommitTimestamp :: Text
checkCommitMessage :: Text
checkCommitId :: Text
checkCommitCommitter :: Author
checkCommitAuthor :: Author
checkCommitTreeId :: CheckCommit -> Text
checkCommitTimestamp :: CheckCommit -> Text
checkCommitMessage :: CheckCommit -> Text
checkCommitId :: CheckCommit -> Text
checkCommitCommitter :: CheckCommit -> Author
checkCommitAuthor :: CheckCommit -> Author
..} = [Pair] -> Value
object
        [ Key
"author"       Key -> Author -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Author
checkCommitAuthor
        , Key
"committer"    Key -> Author -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Author
checkCommitCommitter
        , Key
"id"           Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
checkCommitId
        , Key
"message"      Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
checkCommitMessage
        , Key
"timestamp"    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
checkCommitTimestamp
        , Key
"tree_id"      Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
checkCommitTreeId
        ]


instance Arbitrary CheckCommit where
    arbitrary :: Gen CheckCommit
arbitrary = Author -> Author -> Text -> Text -> Text -> Text -> CheckCommit
CheckCommit
        (Author -> Author -> Text -> Text -> Text -> Text -> CheckCommit)
-> Gen Author
-> Gen (Author -> Text -> Text -> Text -> Text -> CheckCommit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Author
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Author -> Text -> Text -> Text -> Text -> CheckCommit)
-> Gen Author -> Gen (Text -> Text -> Text -> Text -> CheckCommit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Author
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> Text -> Text -> Text -> CheckCommit)
-> Gen Text -> Gen (Text -> Text -> Text -> CheckCommit)
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 -> CheckCommit)
-> Gen Text -> Gen (Text -> Text -> CheckCommit)
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 -> CheckCommit)
-> Gen Text -> Gen (Text -> CheckCommit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> CheckCommit) -> Gen Text -> Gen CheckCommit
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary