{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | Data structures pertaining to Discord User
module Discord.Internal.Types.ApplicationInfo where

import Data.Aeson
import qualified Data.Text as T
import Discord.Internal.Types.Prelude

-- | Structure containing partial information about an Application
data FullApplication = FullApplication
  { FullApplication -> ApplicationId
fullApplicationID :: ApplicationId
  , FullApplication -> Text
fullApplicationName :: T.Text
  , FullApplication -> Int
fullApplicationFlags :: Int
  } deriving (Int -> FullApplication -> ShowS
[FullApplication] -> ShowS
FullApplication -> String
(Int -> FullApplication -> ShowS)
-> (FullApplication -> String)
-> ([FullApplication] -> ShowS)
-> Show FullApplication
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FullApplication -> ShowS
showsPrec :: Int -> FullApplication -> ShowS
$cshow :: FullApplication -> String
show :: FullApplication -> String
$cshowList :: [FullApplication] -> ShowS
showList :: [FullApplication] -> ShowS
Show, FullApplication -> FullApplication -> Bool
(FullApplication -> FullApplication -> Bool)
-> (FullApplication -> FullApplication -> Bool)
-> Eq FullApplication
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FullApplication -> FullApplication -> Bool
== :: FullApplication -> FullApplication -> Bool
$c/= :: FullApplication -> FullApplication -> Bool
/= :: FullApplication -> FullApplication -> Bool
Eq, ReadPrec [FullApplication]
ReadPrec FullApplication
Int -> ReadS FullApplication
ReadS [FullApplication]
(Int -> ReadS FullApplication)
-> ReadS [FullApplication]
-> ReadPrec FullApplication
-> ReadPrec [FullApplication]
-> Read FullApplication
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS FullApplication
readsPrec :: Int -> ReadS FullApplication
$creadList :: ReadS [FullApplication]
readList :: ReadS [FullApplication]
$creadPrec :: ReadPrec FullApplication
readPrec :: ReadPrec FullApplication
$creadListPrec :: ReadPrec [FullApplication]
readListPrec :: ReadPrec [FullApplication]
Read)

instance FromJSON FullApplication where
  parseJSON :: Value -> Parser FullApplication
parseJSON = String
-> (Object -> Parser FullApplication)
-> Value
-> Parser FullApplication
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"FullApplication" ((Object -> Parser FullApplication)
 -> Value -> Parser FullApplication)
-> (Object -> Parser FullApplication)
-> Value
-> Parser FullApplication
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    ApplicationId -> Text -> Int -> FullApplication
FullApplication (ApplicationId -> Text -> Int -> FullApplication)
-> Parser ApplicationId -> Parser (Text -> Int -> FullApplication)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
                    Parser (Text -> Int -> FullApplication)
-> Parser Text -> Parser (Int -> FullApplication)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                    Parser (Int -> FullApplication)
-> Parser Int -> Parser FullApplication
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"flags"