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

------------------------------------------------------------------------------
-- Installation

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


instance FromJSON Installation where
    parseJSON :: Value -> Parser Installation
parseJSON (Object Object
x) = Int -> Text -> Installation
Installation
        (Int -> Text -> Installation)
-> Parser Int -> Parser (Text -> Installation)
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 (Text -> Installation) -> Parser Text -> Parser Installation
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"

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


instance ToJSON Installation where
    toJSON :: Installation -> Value
toJSON Installation{Int
Text
installationNodeId :: Text
installationId :: Int
installationNodeId :: Installation -> Text
installationId :: Installation -> Int
..} = [Pair] -> Value
object
        [ Key
"id"      Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
installationId
        , Key
"node_id" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
installationNodeId
        ]


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