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

------------------------------------------------------------------------------
-- CheckApp

data CheckApp = CheckApp
    { CheckApp -> Text
checkAppCreatedAt   :: Text
    , CheckApp -> Text
checkAppDescription :: Text
    , CheckApp -> [Text]
checkAppEvents      :: [Text]
    , CheckApp -> Text
checkAppExternalUrl :: Text
    , CheckApp -> Text
checkAppHtmlUrl     :: Text
    , CheckApp -> Int
checkAppId          :: Int
    , CheckApp -> Text
checkAppName        :: Text
    , CheckApp -> Text
checkAppNodeId      :: Text
    , CheckApp -> User
checkAppOwner       :: User
    , CheckApp -> Permissions
checkAppPermissions :: Permissions
    , CheckApp -> Text
checkAppSlug        :: Text
    , CheckApp -> Text
checkAppUpdatedAt   :: Text
    } deriving (CheckApp -> CheckApp -> Bool
(CheckApp -> CheckApp -> Bool)
-> (CheckApp -> CheckApp -> Bool) -> Eq CheckApp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckApp -> CheckApp -> Bool
$c/= :: CheckApp -> CheckApp -> Bool
== :: CheckApp -> CheckApp -> Bool
$c== :: CheckApp -> CheckApp -> Bool
Eq, Int -> CheckApp -> ShowS
[CheckApp] -> ShowS
CheckApp -> String
(Int -> CheckApp -> ShowS)
-> (CheckApp -> String) -> ([CheckApp] -> ShowS) -> Show CheckApp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CheckApp] -> ShowS
$cshowList :: [CheckApp] -> ShowS
show :: CheckApp -> String
$cshow :: CheckApp -> String
showsPrec :: Int -> CheckApp -> ShowS
$cshowsPrec :: Int -> CheckApp -> ShowS
Show, ReadPrec [CheckApp]
ReadPrec CheckApp
Int -> ReadS CheckApp
ReadS [CheckApp]
(Int -> ReadS CheckApp)
-> ReadS [CheckApp]
-> ReadPrec CheckApp
-> ReadPrec [CheckApp]
-> Read CheckApp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CheckApp]
$creadListPrec :: ReadPrec [CheckApp]
readPrec :: ReadPrec CheckApp
$creadPrec :: ReadPrec CheckApp
readList :: ReadS [CheckApp]
$creadList :: ReadS [CheckApp]
readsPrec :: Int -> ReadS CheckApp
$creadsPrec :: Int -> ReadS CheckApp
Read)


instance FromJSON CheckApp where
    parseJSON :: Value -> Parser CheckApp
parseJSON (Object Object
x) = Text
-> Text
-> [Text]
-> Text
-> Text
-> Int
-> Text
-> Text
-> User
-> Permissions
-> Text
-> Text
-> CheckApp
CheckApp
        (Text
 -> Text
 -> [Text]
 -> Text
 -> Text
 -> Int
 -> Text
 -> Text
 -> User
 -> Permissions
 -> Text
 -> Text
 -> CheckApp)
-> Parser Text
-> Parser
     (Text
      -> [Text]
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> User
      -> Permissions
      -> Text
      -> Text
      -> CheckApp)
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
"created_at"
        Parser
  (Text
   -> [Text]
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> User
   -> Permissions
   -> Text
   -> Text
   -> CheckApp)
-> Parser Text
-> Parser
     ([Text]
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> User
      -> Permissions
      -> Text
      -> Text
      -> CheckApp)
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
"description"
        Parser
  ([Text]
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> User
   -> Permissions
   -> Text
   -> Text
   -> CheckApp)
-> Parser [Text]
-> Parser
     (Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> User
      -> Permissions
      -> Text
      -> Text
      -> CheckApp)
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
"events"
        Parser
  (Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> User
   -> Permissions
   -> Text
   -> Text
   -> CheckApp)
-> Parser Text
-> Parser
     (Text
      -> Int
      -> Text
      -> Text
      -> User
      -> Permissions
      -> Text
      -> Text
      -> CheckApp)
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
"external_url"
        Parser
  (Text
   -> Int
   -> Text
   -> Text
   -> User
   -> Permissions
   -> Text
   -> Text
   -> CheckApp)
-> Parser Text
-> Parser
     (Int
      -> Text -> Text -> User -> Permissions -> Text -> Text -> CheckApp)
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
  (Int
   -> Text -> Text -> User -> Permissions -> Text -> Text -> CheckApp)
-> Parser Int
-> Parser
     (Text -> Text -> User -> Permissions -> Text -> Text -> CheckApp)
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 -> User -> Permissions -> Text -> Text -> CheckApp)
-> Parser Text
-> Parser (Text -> User -> Permissions -> Text -> Text -> CheckApp)
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
"name"
        Parser (Text -> User -> Permissions -> Text -> Text -> CheckApp)
-> Parser Text
-> Parser (User -> Permissions -> Text -> Text -> CheckApp)
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 (User -> Permissions -> Text -> Text -> CheckApp)
-> Parser User -> Parser (Permissions -> Text -> Text -> CheckApp)
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
"owner"
        Parser (Permissions -> Text -> Text -> CheckApp)
-> Parser Permissions -> Parser (Text -> Text -> CheckApp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Permissions
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"permissions"
        Parser (Text -> Text -> CheckApp)
-> Parser Text -> Parser (Text -> CheckApp)
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
"slug"
        Parser (Text -> CheckApp) -> Parser Text -> Parser CheckApp
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
"updated_at"

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


instance ToJSON CheckApp where
    toJSON :: CheckApp -> Value
toJSON CheckApp{Int
[Text]
Text
Permissions
User
checkAppUpdatedAt :: Text
checkAppSlug :: Text
checkAppPermissions :: Permissions
checkAppOwner :: User
checkAppNodeId :: Text
checkAppName :: Text
checkAppId :: Int
checkAppHtmlUrl :: Text
checkAppExternalUrl :: Text
checkAppEvents :: [Text]
checkAppDescription :: Text
checkAppCreatedAt :: Text
checkAppUpdatedAt :: CheckApp -> Text
checkAppSlug :: CheckApp -> Text
checkAppPermissions :: CheckApp -> Permissions
checkAppOwner :: CheckApp -> User
checkAppNodeId :: CheckApp -> Text
checkAppName :: CheckApp -> Text
checkAppId :: CheckApp -> Int
checkAppHtmlUrl :: CheckApp -> Text
checkAppExternalUrl :: CheckApp -> Text
checkAppEvents :: CheckApp -> [Text]
checkAppDescription :: CheckApp -> Text
checkAppCreatedAt :: CheckApp -> Text
..} = [Pair] -> Value
object
        [ Key
"created_at"   Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
checkAppCreatedAt
        , Key
"description"  Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
checkAppDescription
        , Key
"events"       Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
checkAppEvents
        , Key
"external_url" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
checkAppExternalUrl
        , Key
"html_url"     Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
checkAppHtmlUrl
        , Key
"id"           Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
checkAppId
        , Key
"name"         Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
checkAppName
        , Key
"node_id"      Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
checkAppNodeId
        , Key
"owner"        Key -> User -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= User
checkAppOwner
        , Key
"permissions"  Key -> Permissions -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Permissions
checkAppPermissions
        , Key
"slug"         Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
checkAppSlug
        , Key
"updated_at"   Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
checkAppUpdatedAt
        ]


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