{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE StrictData        #-}
module GitHub.Types.Base.Invitation where

import           Data.Aeson                (FromJSON (..), ToJSON (..), object)
import           Data.Aeson.Types          (Value (..), (.:), (.=))
import           Data.Text                 (Text)
import           Data.Text.Arbitrary       ()
import           Test.QuickCheck.Arbitrary (Arbitrary (..))

------------------------------------------------------------------------------
-- Invitation

data Invitation = Invitation
    { Invitation -> Maybe Text
invitationEmail :: Maybe Text
    , Invitation -> Int
invitationId    :: Int
    , Invitation -> Text
invitationLogin :: Text
    , Invitation -> Text
invitationRole  :: Text
    } deriving (Invitation -> Invitation -> Bool
(Invitation -> Invitation -> Bool)
-> (Invitation -> Invitation -> Bool) -> Eq Invitation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Invitation -> Invitation -> Bool
$c/= :: Invitation -> Invitation -> Bool
== :: Invitation -> Invitation -> Bool
$c== :: Invitation -> Invitation -> Bool
Eq, Int -> Invitation -> ShowS
[Invitation] -> ShowS
Invitation -> String
(Int -> Invitation -> ShowS)
-> (Invitation -> String)
-> ([Invitation] -> ShowS)
-> Show Invitation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Invitation] -> ShowS
$cshowList :: [Invitation] -> ShowS
show :: Invitation -> String
$cshow :: Invitation -> String
showsPrec :: Int -> Invitation -> ShowS
$cshowsPrec :: Int -> Invitation -> ShowS
Show, ReadPrec [Invitation]
ReadPrec Invitation
Int -> ReadS Invitation
ReadS [Invitation]
(Int -> ReadS Invitation)
-> ReadS [Invitation]
-> ReadPrec Invitation
-> ReadPrec [Invitation]
-> Read Invitation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Invitation]
$creadListPrec :: ReadPrec [Invitation]
readPrec :: ReadPrec Invitation
$creadPrec :: ReadPrec Invitation
readList :: ReadS [Invitation]
$creadList :: ReadS [Invitation]
readsPrec :: Int -> ReadS Invitation
$creadsPrec :: Int -> ReadS Invitation
Read)


instance FromJSON Invitation where
    parseJSON :: Value -> Parser Invitation
parseJSON (Object Object
x) = Maybe Text -> Int -> Text -> Text -> Invitation
Invitation
        (Maybe Text -> Int -> Text -> Text -> Invitation)
-> Parser (Maybe Text)
-> Parser (Int -> Text -> Text -> Invitation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
x Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"email"
        Parser (Int -> Text -> Text -> Invitation)
-> Parser Int -> Parser (Text -> Text -> Invitation)
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 (Text -> Text -> Invitation)
-> Parser Text -> Parser (Text -> Invitation)
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
"login"
        Parser (Text -> Invitation) -> Parser Text -> Parser Invitation
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
"role"

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


instance ToJSON Invitation where
    toJSON :: Invitation -> Value
toJSON Invitation{Int
Maybe Text
Text
invitationRole :: Text
invitationLogin :: Text
invitationId :: Int
invitationEmail :: Maybe Text
invitationRole :: Invitation -> Text
invitationLogin :: Invitation -> Text
invitationId :: Invitation -> Int
invitationEmail :: Invitation -> Maybe Text
..} = [Pair] -> Value
object
        [ Key
"email"            Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
invitationEmail
        , Key
"id"               Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
invitationId
        , Key
"login"            Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
invitationLogin
        , Key
"role"             Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
invitationRole
        ]


instance Arbitrary Invitation where
    arbitrary :: Gen Invitation
arbitrary = Maybe Text -> Int -> Text -> Text -> Invitation
Invitation
        (Maybe Text -> Int -> Text -> Text -> Invitation)
-> Gen (Maybe Text) -> Gen (Int -> Text -> Text -> Invitation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe Text)
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Int -> Text -> Text -> Invitation)
-> Gen Int -> Gen (Text -> Text -> Invitation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> Text -> Invitation)
-> Gen Text -> Gen (Text -> Invitation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> Invitation) -> Gen Text -> Gen Invitation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary