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

------------------------------------------------------------------------------
-- Review

data Review = Review
    { Review -> Int
reviewId                :: Int
    , Review -> User
reviewUser              :: User
    , Review -> Text
reviewAuthorAssociation :: Text
    , Review -> Text
reviewCommitId          :: Text
    , Review -> Maybe Text
reviewBody              :: Maybe Text
    , Review -> DateTime
reviewSubmittedAt       :: DateTime
    , Review -> Text
reviewNodeId            :: Text
    , Review -> Text
reviewState             :: Text
    , Review -> Text
reviewHtmlUrl           :: Text
    , Review -> Text
reviewPullRequestUrl    :: Text
    , Review -> ReviewLinks
reviewLinks             :: ReviewLinks
    } deriving (Review -> Review -> Bool
(Review -> Review -> Bool)
-> (Review -> Review -> Bool) -> Eq Review
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Review -> Review -> Bool
$c/= :: Review -> Review -> Bool
== :: Review -> Review -> Bool
$c== :: Review -> Review -> Bool
Eq, Int -> Review -> ShowS
[Review] -> ShowS
Review -> String
(Int -> Review -> ShowS)
-> (Review -> String) -> ([Review] -> ShowS) -> Show Review
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Review] -> ShowS
$cshowList :: [Review] -> ShowS
show :: Review -> String
$cshow :: Review -> String
showsPrec :: Int -> Review -> ShowS
$cshowsPrec :: Int -> Review -> ShowS
Show, ReadPrec [Review]
ReadPrec Review
Int -> ReadS Review
ReadS [Review]
(Int -> ReadS Review)
-> ReadS [Review]
-> ReadPrec Review
-> ReadPrec [Review]
-> Read Review
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Review]
$creadListPrec :: ReadPrec [Review]
readPrec :: ReadPrec Review
$creadPrec :: ReadPrec Review
readList :: ReadS [Review]
$creadList :: ReadS [Review]
readsPrec :: Int -> ReadS Review
$creadsPrec :: Int -> ReadS Review
Read)


instance FromJSON Review where
    parseJSON :: Value -> Parser Review
parseJSON (Object Object
x) = Int
-> User
-> Text
-> Text
-> Maybe Text
-> DateTime
-> Text
-> Text
-> Text
-> Text
-> ReviewLinks
-> Review
Review
        (Int
 -> User
 -> Text
 -> Text
 -> Maybe Text
 -> DateTime
 -> Text
 -> Text
 -> Text
 -> Text
 -> ReviewLinks
 -> Review)
-> Parser Int
-> Parser
     (User
      -> Text
      -> Text
      -> Maybe Text
      -> DateTime
      -> Text
      -> Text
      -> Text
      -> Text
      -> ReviewLinks
      -> Review)
forall (f :: * -> *) a b. Functor 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
   -> Text
   -> Text
   -> Maybe Text
   -> DateTime
   -> Text
   -> Text
   -> Text
   -> Text
   -> ReviewLinks
   -> Review)
-> Parser User
-> Parser
     (Text
      -> Text
      -> Maybe Text
      -> DateTime
      -> Text
      -> Text
      -> Text
      -> Text
      -> ReviewLinks
      -> Review)
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
  (Text
   -> Text
   -> Maybe Text
   -> DateTime
   -> Text
   -> Text
   -> Text
   -> Text
   -> ReviewLinks
   -> Review)
-> Parser Text
-> Parser
     (Text
      -> Maybe Text
      -> DateTime
      -> Text
      -> Text
      -> Text
      -> Text
      -> ReviewLinks
      -> Review)
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
"author_association"
        Parser
  (Text
   -> Maybe Text
   -> DateTime
   -> Text
   -> Text
   -> Text
   -> Text
   -> ReviewLinks
   -> Review)
-> Parser Text
-> Parser
     (Maybe Text
      -> DateTime
      -> Text
      -> Text
      -> Text
      -> Text
      -> ReviewLinks
      -> Review)
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
  (Maybe Text
   -> DateTime
   -> Text
   -> Text
   -> Text
   -> Text
   -> ReviewLinks
   -> Review)
-> Parser (Maybe Text)
-> Parser
     (DateTime -> Text -> Text -> Text -> Text -> ReviewLinks -> Review)
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
"body"
        Parser
  (DateTime -> Text -> Text -> Text -> Text -> ReviewLinks -> Review)
-> Parser DateTime
-> Parser (Text -> Text -> Text -> Text -> ReviewLinks -> Review)
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
"submitted_at"
        Parser (Text -> Text -> Text -> Text -> ReviewLinks -> Review)
-> Parser Text
-> Parser (Text -> Text -> Text -> ReviewLinks -> Review)
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 (Text -> Text -> Text -> ReviewLinks -> Review)
-> Parser Text -> Parser (Text -> Text -> ReviewLinks -> Review)
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 -> Text -> ReviewLinks -> Review)
-> Parser Text -> Parser (Text -> ReviewLinks -> Review)
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 (Text -> ReviewLinks -> Review)
-> Parser Text -> Parser (ReviewLinks -> Review)
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
"pull_request_url"
        Parser (ReviewLinks -> Review)
-> Parser ReviewLinks -> Parser Review
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser ReviewLinks
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_links"

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


instance ToJSON Review where
    toJSON :: Review -> Value
toJSON Review{Int
Maybe Text
Text
DateTime
ReviewLinks
User
reviewLinks :: ReviewLinks
reviewPullRequestUrl :: Text
reviewHtmlUrl :: Text
reviewState :: Text
reviewNodeId :: Text
reviewSubmittedAt :: DateTime
reviewBody :: Maybe Text
reviewCommitId :: Text
reviewAuthorAssociation :: Text
reviewUser :: User
reviewId :: Int
reviewLinks :: Review -> ReviewLinks
reviewPullRequestUrl :: Review -> Text
reviewHtmlUrl :: Review -> Text
reviewState :: Review -> Text
reviewNodeId :: Review -> Text
reviewSubmittedAt :: Review -> DateTime
reviewBody :: Review -> Maybe Text
reviewCommitId :: Review -> Text
reviewAuthorAssociation :: Review -> Text
reviewUser :: Review -> User
reviewId :: Review -> Int
..} = [Pair] -> Value
object
        [ Key
"id"                 Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
reviewId
        , Key
"user"               Key -> User -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= User
reviewUser
        , Key
"author_association" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reviewAuthorAssociation
        , Key
"commit_id"          Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reviewCommitId
        , Key
"body"               Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
reviewBody
        , Key
"submitted_at"       Key -> DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DateTime
reviewSubmittedAt
        , Key
"node_id"            Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reviewNodeId
        , Key
"state"              Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reviewState
        , Key
"html_url"           Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reviewHtmlUrl
        , Key
"pull_request_url"   Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reviewPullRequestUrl
        , Key
"_links"             Key -> ReviewLinks -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ReviewLinks
reviewLinks
        ]


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