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

------------------------------------------------------------------------------
-- CommitComment

data CommitComment = CommitComment
    { CommitComment -> Text
commitCommentUrl       :: Text
    , CommitComment -> Text
commitCommentHtmlUrl   :: Text
    , CommitComment -> Int
commitCommentId        :: Int
    , CommitComment -> User
commitCommentUser      :: User
    , CommitComment -> Maybe Int
commitCommentPosition  :: Maybe Int
    , CommitComment -> Maybe Int
commitCommentLine      :: Maybe Int
    , CommitComment -> Maybe Text
commitCommentPath      :: Maybe Text
    , CommitComment -> Text
commitCommentCommitId  :: Text
    , CommitComment -> DateTime
commitCommentCreatedAt :: DateTime
    , CommitComment -> DateTime
commitCommentUpdatedAt :: DateTime
    , CommitComment -> Text
commitCommentBody      :: Text
    } deriving (CommitComment -> CommitComment -> Bool
(CommitComment -> CommitComment -> Bool)
-> (CommitComment -> CommitComment -> Bool) -> Eq CommitComment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommitComment -> CommitComment -> Bool
$c/= :: CommitComment -> CommitComment -> Bool
== :: CommitComment -> CommitComment -> Bool
$c== :: CommitComment -> CommitComment -> Bool
Eq, Int -> CommitComment -> ShowS
[CommitComment] -> ShowS
CommitComment -> String
(Int -> CommitComment -> ShowS)
-> (CommitComment -> String)
-> ([CommitComment] -> ShowS)
-> Show CommitComment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommitComment] -> ShowS
$cshowList :: [CommitComment] -> ShowS
show :: CommitComment -> String
$cshow :: CommitComment -> String
showsPrec :: Int -> CommitComment -> ShowS
$cshowsPrec :: Int -> CommitComment -> ShowS
Show, ReadPrec [CommitComment]
ReadPrec CommitComment
Int -> ReadS CommitComment
ReadS [CommitComment]
(Int -> ReadS CommitComment)
-> ReadS [CommitComment]
-> ReadPrec CommitComment
-> ReadPrec [CommitComment]
-> Read CommitComment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CommitComment]
$creadListPrec :: ReadPrec [CommitComment]
readPrec :: ReadPrec CommitComment
$creadPrec :: ReadPrec CommitComment
readList :: ReadS [CommitComment]
$creadList :: ReadS [CommitComment]
readsPrec :: Int -> ReadS CommitComment
$creadsPrec :: Int -> ReadS CommitComment
Read)


instance FromJSON CommitComment where
    parseJSON :: Value -> Parser CommitComment
parseJSON (Object Object
x) = Text
-> Text
-> Int
-> User
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> Text
-> DateTime
-> DateTime
-> Text
-> CommitComment
CommitComment
        (Text
 -> Text
 -> Int
 -> User
 -> Maybe Int
 -> Maybe Int
 -> Maybe Text
 -> Text
 -> DateTime
 -> DateTime
 -> Text
 -> CommitComment)
-> Parser Text
-> Parser
     (Text
      -> Int
      -> User
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Text
      -> DateTime
      -> DateTime
      -> Text
      -> CommitComment)
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
  (Text
   -> Int
   -> User
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Text
   -> DateTime
   -> DateTime
   -> Text
   -> CommitComment)
-> Parser Text
-> Parser
     (Int
      -> User
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Text
      -> DateTime
      -> DateTime
      -> Text
      -> CommitComment)
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
"html_url"
        Parser
  (Int
   -> User
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Text
   -> DateTime
   -> DateTime
   -> Text
   -> CommitComment)
-> Parser Int
-> Parser
     (User
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Text
      -> DateTime
      -> DateTime
      -> Text
      -> CommitComment)
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
  (User
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Text
   -> DateTime
   -> DateTime
   -> Text
   -> CommitComment)
-> Parser User
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Text
      -> DateTime
      -> DateTime
      -> Text
      -> CommitComment)
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
"user"
        Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Text
   -> DateTime
   -> DateTime
   -> Text
   -> CommitComment)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Text
      -> DateTime
      -> DateTime
      -> Text
      -> CommitComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"position"
        Parser
  (Maybe Int
   -> Maybe Text
   -> Text
   -> DateTime
   -> DateTime
   -> Text
   -> CommitComment)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Text -> DateTime -> DateTime -> Text -> CommitComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"line"
        Parser
  (Maybe Text
   -> Text -> DateTime -> DateTime -> Text -> CommitComment)
-> Parser (Maybe Text)
-> Parser (Text -> DateTime -> DateTime -> Text -> CommitComment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
        Parser (Text -> DateTime -> DateTime -> Text -> CommitComment)
-> Parser Text
-> Parser (DateTime -> DateTime -> Text -> CommitComment)
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
"commit_id"
        Parser (DateTime -> DateTime -> Text -> CommitComment)
-> Parser DateTime -> Parser (DateTime -> Text -> CommitComment)
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 -> CommitComment)
-> Parser DateTime -> Parser (Text -> CommitComment)
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 -> CommitComment)
-> Parser Text -> Parser CommitComment
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
"body"

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


instance ToJSON CommitComment where
    toJSON :: CommitComment -> Value
toJSON CommitComment{Int
Maybe Int
Maybe Text
Text
DateTime
User
commitCommentBody :: Text
commitCommentUpdatedAt :: DateTime
commitCommentCreatedAt :: DateTime
commitCommentCommitId :: Text
commitCommentPath :: Maybe Text
commitCommentLine :: Maybe Int
commitCommentPosition :: Maybe Int
commitCommentUser :: User
commitCommentId :: Int
commitCommentHtmlUrl :: Text
commitCommentUrl :: Text
commitCommentBody :: CommitComment -> Text
commitCommentUpdatedAt :: CommitComment -> DateTime
commitCommentCreatedAt :: CommitComment -> DateTime
commitCommentCommitId :: CommitComment -> Text
commitCommentPath :: CommitComment -> Maybe Text
commitCommentLine :: CommitComment -> Maybe Int
commitCommentPosition :: CommitComment -> Maybe Int
commitCommentUser :: CommitComment -> User
commitCommentId :: CommitComment -> Int
commitCommentHtmlUrl :: CommitComment -> Text
commitCommentUrl :: CommitComment -> Text
..} = [Pair] -> Value
object
        [ Key
"url"        Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
commitCommentUrl
        , Key
"html_url"   Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
commitCommentHtmlUrl
        , Key
"id"         Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
commitCommentId
        , Key
"user"       Key -> User -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= User
commitCommentUser
        , Key
"position"   Key -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
commitCommentPosition
        , Key
"line"       Key -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
commitCommentLine
        , Key
"path"       Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
commitCommentPath
        , Key
"commit_id"  Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
commitCommentCommitId
        , Key
"created_at" Key -> DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DateTime
commitCommentCreatedAt
        , Key
"updated_at" Key -> DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DateTime
commitCommentUpdatedAt
        , Key
"body"       Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
commitCommentBody
        ]


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