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

------------------------------------------------------------------------------
-- CheckOutput

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


instance FromJSON CheckOutput where
    parseJSON :: Value -> Parser CheckOutput
parseJSON (Object Object
x) = Int
-> Text -> Maybe Text -> Maybe Text -> Maybe Text -> CheckOutput
CheckOutput
        (Int
 -> Text -> Maybe Text -> Maybe Text -> Maybe Text -> CheckOutput)
-> Parser Int
-> Parser
     (Text -> Maybe Text -> Maybe Text -> Maybe Text -> CheckOutput)
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
"annotations_count"
        Parser
  (Text -> Maybe Text -> Maybe Text -> Maybe Text -> CheckOutput)
-> Parser Text
-> Parser (Maybe Text -> Maybe Text -> Maybe Text -> CheckOutput)
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
"annotations_url"
        Parser (Maybe Text -> Maybe Text -> Maybe Text -> CheckOutput)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> CheckOutput)
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
"summary"
        Parser (Maybe Text -> Maybe Text -> CheckOutput)
-> Parser (Maybe Text) -> Parser (Maybe Text -> CheckOutput)
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
"text"
        Parser (Maybe Text -> CheckOutput)
-> Parser (Maybe Text) -> Parser CheckOutput
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
"title"

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


instance ToJSON CheckOutput where
    toJSON :: CheckOutput -> Value
toJSON CheckOutput{Int
Maybe Text
Text
checkOutputTitle :: Maybe Text
checkOutputText :: Maybe Text
checkOutputSummary :: Maybe Text
checkOutputAnnotationsUrl :: Text
checkOutputAnnotationsCount :: Int
checkOutputTitle :: CheckOutput -> Maybe Text
checkOutputText :: CheckOutput -> Maybe Text
checkOutputSummary :: CheckOutput -> Maybe Text
checkOutputAnnotationsUrl :: CheckOutput -> Text
checkOutputAnnotationsCount :: CheckOutput -> Int
..} = [Pair] -> Value
object
        [ Key
"annotations_count" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
checkOutputAnnotationsCount
        , Key
"annotations_url"   Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
checkOutputAnnotationsUrl
        , Key
"summary"           Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
checkOutputSummary
        , Key
"text"              Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
checkOutputText
        , Key
"title"             Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
checkOutputTitle
        ]


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