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

------------------------------------------------------------------------------
-- CheckCommitRef

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


instance FromJSON CheckCommitRef where
    parseJSON :: Value -> Parser CheckCommitRef
parseJSON (Object Object
x) = Text -> Text -> CheckCommitRepo -> CheckCommitRef
CheckCommitRef
        (Text -> Text -> CheckCommitRepo -> CheckCommitRef)
-> Parser Text
-> Parser (Text -> CheckCommitRepo -> CheckCommitRef)
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
"sha"
        Parser (Text -> CheckCommitRepo -> CheckCommitRef)
-> Parser Text -> Parser (CheckCommitRepo -> CheckCommitRef)
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
"ref"
        Parser (CheckCommitRepo -> CheckCommitRef)
-> Parser CheckCommitRepo -> Parser CheckCommitRef
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser CheckCommitRepo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"repo"

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


instance ToJSON CheckCommitRef where
    toJSON :: CheckCommitRef -> Value
toJSON CheckCommitRef{Text
CheckCommitRepo
checkCommitRefRepo :: CheckCommitRepo
checkCommitRefRef :: Text
checkCommitRefSha :: Text
checkCommitRefRepo :: CheckCommitRef -> CheckCommitRepo
checkCommitRefRef :: CheckCommitRef -> Text
checkCommitRefSha :: CheckCommitRef -> Text
..} = [Pair] -> Value
object
        [ Key
"sha"          Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
checkCommitRefSha
        , Key
"ref"          Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
checkCommitRefRef
        , Key
"repo"         Key -> CheckCommitRepo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CheckCommitRepo
checkCommitRefRepo
        ]


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