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

------------------------------------------------------------------------------
-- PushCommit

data PushCommit = PushCommit
    { PushCommit -> [Text]
pushCommitAdded     :: [Text]
    , PushCommit -> Author
pushCommitAuthor    :: Author
    , PushCommit -> Maybe Author
pushCommitCommitter :: Maybe Author
    , PushCommit -> Bool
pushCommitDistinct  :: Bool
    , PushCommit -> Text
pushCommitId        :: Text
    , PushCommit -> Text
pushCommitMessage   :: Text
    , PushCommit -> [Text]
pushCommitModified  :: [Text]
    , PushCommit -> [Text]
pushCommitRemoved   :: [Text]
    , PushCommit -> Text
pushCommitTimestamp :: Text
    , PushCommit -> Text
pushCommitTreeId    :: Text
    , PushCommit -> Text
pushCommitUrl       :: Text
    } deriving (PushCommit -> PushCommit -> Bool
(PushCommit -> PushCommit -> Bool)
-> (PushCommit -> PushCommit -> Bool) -> Eq PushCommit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PushCommit -> PushCommit -> Bool
$c/= :: PushCommit -> PushCommit -> Bool
== :: PushCommit -> PushCommit -> Bool
$c== :: PushCommit -> PushCommit -> Bool
Eq, Int -> PushCommit -> ShowS
[PushCommit] -> ShowS
PushCommit -> String
(Int -> PushCommit -> ShowS)
-> (PushCommit -> String)
-> ([PushCommit] -> ShowS)
-> Show PushCommit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PushCommit] -> ShowS
$cshowList :: [PushCommit] -> ShowS
show :: PushCommit -> String
$cshow :: PushCommit -> String
showsPrec :: Int -> PushCommit -> ShowS
$cshowsPrec :: Int -> PushCommit -> ShowS
Show, ReadPrec [PushCommit]
ReadPrec PushCommit
Int -> ReadS PushCommit
ReadS [PushCommit]
(Int -> ReadS PushCommit)
-> ReadS [PushCommit]
-> ReadPrec PushCommit
-> ReadPrec [PushCommit]
-> Read PushCommit
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PushCommit]
$creadListPrec :: ReadPrec [PushCommit]
readPrec :: ReadPrec PushCommit
$creadPrec :: ReadPrec PushCommit
readList :: ReadS [PushCommit]
$creadList :: ReadS [PushCommit]
readsPrec :: Int -> ReadS PushCommit
$creadsPrec :: Int -> ReadS PushCommit
Read)


instance FromJSON PushCommit where
    parseJSON :: Value -> Parser PushCommit
parseJSON (Object Object
x) = [Text]
-> Author
-> Maybe Author
-> Bool
-> Text
-> Text
-> [Text]
-> [Text]
-> Text
-> Text
-> Text
-> PushCommit
PushCommit
        ([Text]
 -> Author
 -> Maybe Author
 -> Bool
 -> Text
 -> Text
 -> [Text]
 -> [Text]
 -> Text
 -> Text
 -> Text
 -> PushCommit)
-> Parser [Text]
-> Parser
     (Author
      -> Maybe Author
      -> Bool
      -> Text
      -> Text
      -> [Text]
      -> [Text]
      -> Text
      -> Text
      -> Text
      -> PushCommit)
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
"added"
        Parser
  (Author
   -> Maybe Author
   -> Bool
   -> Text
   -> Text
   -> [Text]
   -> [Text]
   -> Text
   -> Text
   -> Text
   -> PushCommit)
-> Parser Author
-> Parser
     (Maybe Author
      -> Bool
      -> Text
      -> Text
      -> [Text]
      -> [Text]
      -> Text
      -> Text
      -> Text
      -> PushCommit)
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
"author"
        Parser
  (Maybe Author
   -> Bool
   -> Text
   -> Text
   -> [Text]
   -> [Text]
   -> Text
   -> Text
   -> Text
   -> PushCommit)
-> Parser (Maybe Author)
-> Parser
     (Bool
      -> Text
      -> Text
      -> [Text]
      -> [Text]
      -> Text
      -> Text
      -> Text
      -> PushCommit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe Author)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"committer"
        Parser
  (Bool
   -> Text
   -> Text
   -> [Text]
   -> [Text]
   -> Text
   -> Text
   -> Text
   -> PushCommit)
-> Parser Bool
-> Parser
     (Text
      -> Text -> [Text] -> [Text] -> Text -> Text -> Text -> PushCommit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"distinct"
        Parser
  (Text
   -> Text -> [Text] -> [Text] -> Text -> Text -> Text -> PushCommit)
-> Parser Text
-> Parser
     (Text -> [Text] -> [Text] -> Text -> Text -> Text -> PushCommit)
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] -> Text -> Text -> Text -> PushCommit)
-> Parser Text
-> Parser ([Text] -> [Text] -> Text -> Text -> Text -> PushCommit)
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] -> Text -> Text -> Text -> PushCommit)
-> Parser [Text]
-> Parser ([Text] -> Text -> Text -> Text -> PushCommit)
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
"modified"
        Parser ([Text] -> Text -> Text -> Text -> PushCommit)
-> Parser [Text] -> Parser (Text -> Text -> Text -> PushCommit)
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
"removed"
        Parser (Text -> Text -> Text -> PushCommit)
-> Parser Text -> Parser (Text -> Text -> PushCommit)
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 -> Text -> PushCommit)
-> Parser Text -> Parser (Text -> PushCommit)
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"
        Parser (Text -> PushCommit) -> Parser Text -> Parser PushCommit
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 PushCommit
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"PushCommit"


instance ToJSON PushCommit where
    toJSON :: PushCommit -> Value
toJSON PushCommit{Bool
[Text]
Maybe Author
Text
Author
pushCommitUrl :: Text
pushCommitTreeId :: Text
pushCommitTimestamp :: Text
pushCommitRemoved :: [Text]
pushCommitModified :: [Text]
pushCommitMessage :: Text
pushCommitId :: Text
pushCommitDistinct :: Bool
pushCommitCommitter :: Maybe Author
pushCommitAuthor :: Author
pushCommitAdded :: [Text]
pushCommitUrl :: PushCommit -> Text
pushCommitTreeId :: PushCommit -> Text
pushCommitTimestamp :: PushCommit -> Text
pushCommitRemoved :: PushCommit -> [Text]
pushCommitModified :: PushCommit -> [Text]
pushCommitMessage :: PushCommit -> Text
pushCommitId :: PushCommit -> Text
pushCommitDistinct :: PushCommit -> Bool
pushCommitCommitter :: PushCommit -> Maybe Author
pushCommitAuthor :: PushCommit -> Author
pushCommitAdded :: PushCommit -> [Text]
..} = [Pair] -> Value
object
        [ Key
"added"        Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
pushCommitAdded
        , Key
"author"       Key -> Author -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Author
pushCommitAuthor
        , Key
"committer"    Key -> Maybe Author -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Author
pushCommitCommitter
        , Key
"distinct"     Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
pushCommitDistinct
        , Key
"id"           Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pushCommitId
        , Key
"message"      Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pushCommitMessage
        , Key
"modified"     Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
pushCommitModified
        , Key
"removed"      Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
pushCommitRemoved
        , Key
"timestamp"    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pushCommitTimestamp
        , Key
"tree_id"      Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pushCommitTreeId
        , Key
"url"          Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pushCommitUrl
        ]


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