{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DeriveDataTypeable #-}

-- | Types relating to Discord Guilds (servers)
module Discord.Internal.Types.Guild where

import Data.Time.Clock

import Data.Aeson
import qualified Data.Text as T
import Data.Data (Data)
import Data.Default (Default(..))

import Discord.Internal.Types.Prelude
import Discord.Internal.Types.Color (DiscordColor)
import Discord.Internal.Types.Channel (Channel)
import Discord.Internal.Types.User (User, GuildMember)
import Discord.Internal.Types.Emoji (Emoji, StickerItem)



-- | Guilds in Discord represent a collection of users and channels into an isolated
--   "Server"
--
-- https://discord.com/developers/docs/resources/guild#guild-object
data Guild = Guild
      { Guild -> GuildId
guildId                   :: GuildId              -- ^ Gulid id
      , Guild -> Text
guildName                 :: T.Text               -- ^ Guild name (2 - 100 chars)
      , Guild -> Maybe Text
guildIcon                 :: Maybe T.Text         -- ^ Icon hash
      , Guild -> Maybe Text
guildIconHash             :: Maybe T.Text         -- ^ Icon hash, when returned in template object
      , Guild -> Maybe Text
guildSplash               :: Maybe T.Text         -- ^ Splash hash
      , Guild -> Maybe Text
guildDiscoverySplash      :: Maybe T.Text         -- ^ Discovery splash hash
      , Guild -> Maybe Bool
guildOwner                :: Maybe Bool           -- ^ True is user is the owner of the guild
      , Guild -> GuildId
guildOwnerId              :: UserId               -- ^ Guild owner id
      , Guild -> Maybe Text
guildPermissions          :: Maybe T.Text         -- ^ Total permissions for the user in the guild
      , Guild -> Maybe GuildId
guildAfkId                :: Maybe ChannelId      -- ^ Id of afk channel
      , Guild -> Integer
guildAfkTimeout           :: Integer              -- ^ Afk timeout in seconds
      , Guild -> Maybe Bool
guildWidgetEnabled        :: Maybe Bool           -- ^ Id of embedded channel
      , Guild -> Maybe GuildId
guildWidgetChannelId      :: Maybe ChannelId      -- ^ Id of embedded channel
      , Guild -> Integer
guildVerificationLevel    :: Integer              -- ^ Level of verification
      , Guild -> Integer
guildNotification         :: Integer              -- ^ Level of default notifications
      , Guild -> Integer
guildExplicitFilterLevel  :: Integer              -- ^ Whose media gets scanned
      , Guild -> [Role]
guildRoles                :: [Role]               -- ^ Array of 'Role' objects
      , Guild -> [Emoji]
guildEmojis               :: [Emoji]              -- ^ Array of 'Emoji' objects
      , Guild -> [Text]
guildFeatures             :: [T.Text]             -- ^ Array of guild feature strings
      , Guild -> Integer
guildMultiFactAuth        :: !Integer             -- ^ MFA level for the guild
      , Guild -> Maybe GuildId
guildApplicationId        :: Maybe ApplicationId  -- ^ Application id of the guild if bot created
      , Guild -> Maybe GuildId
guildSystemChannelId      :: Maybe ChannelId      -- ^ Channel where guild notices such as welcome messages and boost events
      , Guild -> Integer
guildSystemChannelFlags   :: Integer              -- ^ Flags on the system channel
      , Guild -> Maybe GuildId
guildRulesChannelId       :: Maybe ChannelId      -- ^ Id of channel with rules/guidelines
      , Guild -> Maybe UTCTime
guildJoinedAt             :: Maybe UTCTime        -- ^ When this guild was joined at
      , Guild -> Maybe Bool
guildLarge                :: Maybe Bool           -- ^ True if this guild is considered large
      , Guild -> Maybe Bool
guildUnavailable          :: Maybe Bool           -- ^ True if the guild is unavailable due to outage
      , Guild -> Maybe Integer
guildMemberCount          :: Maybe Integer        -- ^ Total number of members in the guild
      -- voice_states
      , Guild -> Maybe [GuildMember]
guildMembers              :: Maybe [GuildMember]  -- ^ Users in the guild
      , Guild -> Maybe [Channel]
guildChannels             :: Maybe [Channel]      -- ^ Channels in the guild
      , Guild -> Maybe [Channel]
guildThreads              :: Maybe [Channel]      -- ^ All active threads in the guild that the current user has permission to view
      , Guild -> Maybe [PresenceInfo]
guildPresences            :: Maybe [PresenceInfo] -- ^ Presences of the members in the guild
      , Guild -> Maybe Integer
guildMaxPresences         :: Maybe Integer        -- ^ Maximum number of prescences in the guild
      , Guild -> Maybe Integer
guildMaxMembers           :: Maybe Integer        -- ^ Maximum number of members in the guild
      , Guild -> Maybe Text
guildVanityURL            :: Maybe T.Text         -- ^ Vanity url code for the guild
      , Guild -> Maybe Text
guildDescription          :: Maybe T.Text         -- ^ Description of a commmunity guild
      , Guild -> Maybe Text
guildBanner               :: Maybe T.Text         -- ^ Banner hash
      , Guild -> Integer
guildPremiumTier          :: Integer              -- ^ Premium tier (boost level)
      , Guild -> Maybe Integer
guildSubscriptionCount    :: Maybe Integer        -- ^ Number of boosts the guild has
      , Guild -> Text
guildPreferredLocale      :: T.Text               -- ^ Preferred locale of a community server
      , Guild -> Maybe GuildId
guildPublicUpdatesChannel :: Maybe ChannelId      -- ^ Id of channel where admins and mods get updates
      , Guild -> Maybe Integer
guildMaxVideoUsers        :: Maybe Integer        -- ^ Maximum number of users in video channel
      , Guild -> Maybe Integer
guildApproxMemberCount    :: Maybe Integer        -- ^ Approximate number of members in the guild
      , Guild -> Maybe Integer
guildApproxPresenceCount  :: Maybe Integer        -- ^ Approximate number of non-offline members in the guild
      -- welcome_screen
      , Guild -> Integer
guildNSFWLevel            :: Integer              -- ^ Guild NSFW level
      -- stage_instances
      , Guild -> Maybe [StickerItem]
guildStickers             :: Maybe [StickerItem]  -- ^ Custom guild stickers
      -- guild_scheduled_events
      , Guild -> Bool
guildPremiumBar           :: Bool                 -- ^ Whether the guild has the boost progress bar enabled
      } deriving (Int -> Guild -> ShowS
[Guild] -> ShowS
Guild -> String
(Int -> Guild -> ShowS)
-> (Guild -> String) -> ([Guild] -> ShowS) -> Show Guild
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Guild] -> ShowS
$cshowList :: [Guild] -> ShowS
show :: Guild -> String
$cshow :: Guild -> String
showsPrec :: Int -> Guild -> ShowS
$cshowsPrec :: Int -> Guild -> ShowS
Show, ReadPrec [Guild]
ReadPrec Guild
Int -> ReadS Guild
ReadS [Guild]
(Int -> ReadS Guild)
-> ReadS [Guild]
-> ReadPrec Guild
-> ReadPrec [Guild]
-> Read Guild
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Guild]
$creadListPrec :: ReadPrec [Guild]
readPrec :: ReadPrec Guild
$creadPrec :: ReadPrec Guild
readList :: ReadS [Guild]
$creadList :: ReadS [Guild]
readsPrec :: Int -> ReadS Guild
$creadsPrec :: Int -> ReadS Guild
Read, Guild -> Guild -> Bool
(Guild -> Guild -> Bool) -> (Guild -> Guild -> Bool) -> Eq Guild
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Guild -> Guild -> Bool
$c/= :: Guild -> Guild -> Bool
== :: Guild -> Guild -> Bool
$c== :: Guild -> Guild -> Bool
Eq, Eq Guild
Eq Guild
-> (Guild -> Guild -> Ordering)
-> (Guild -> Guild -> Bool)
-> (Guild -> Guild -> Bool)
-> (Guild -> Guild -> Bool)
-> (Guild -> Guild -> Bool)
-> (Guild -> Guild -> Guild)
-> (Guild -> Guild -> Guild)
-> Ord Guild
Guild -> Guild -> Bool
Guild -> Guild -> Ordering
Guild -> Guild -> Guild
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Guild -> Guild -> Guild
$cmin :: Guild -> Guild -> Guild
max :: Guild -> Guild -> Guild
$cmax :: Guild -> Guild -> Guild
>= :: Guild -> Guild -> Bool
$c>= :: Guild -> Guild -> Bool
> :: Guild -> Guild -> Bool
$c> :: Guild -> Guild -> Bool
<= :: Guild -> Guild -> Bool
$c<= :: Guild -> Guild -> Bool
< :: Guild -> Guild -> Bool
$c< :: Guild -> Guild -> Bool
compare :: Guild -> Guild -> Ordering
$ccompare :: Guild -> Guild -> Ordering
$cp1Ord :: Eq Guild
Ord)

instance FromJSON Guild where
  parseJSON :: Value -> Parser Guild
parseJSON = String -> (Object -> Parser Guild) -> Value -> Parser Guild
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Guild" ((Object -> Parser Guild) -> Value -> Parser Guild)
-> (Object -> Parser Guild) -> Value -> Parser Guild
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    GuildId
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> GuildId
-> Maybe Text
-> Maybe GuildId
-> Integer
-> Maybe Bool
-> Maybe GuildId
-> Integer
-> Integer
-> Integer
-> [Role]
-> [Emoji]
-> [Text]
-> Integer
-> Maybe GuildId
-> Maybe GuildId
-> Integer
-> Maybe GuildId
-> Maybe UTCTime
-> Maybe Bool
-> Maybe Bool
-> Maybe Integer
-> Maybe [GuildMember]
-> Maybe [Channel]
-> Maybe [Channel]
-> Maybe [PresenceInfo]
-> Maybe Integer
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Integer
-> Maybe Integer
-> Text
-> Maybe GuildId
-> Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> Integer
-> Maybe [StickerItem]
-> Bool
-> Guild
Guild (GuildId
 -> Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> GuildId
 -> Maybe Text
 -> Maybe GuildId
 -> Integer
 -> Maybe Bool
 -> Maybe GuildId
 -> Integer
 -> Integer
 -> Integer
 -> [Role]
 -> [Emoji]
 -> [Text]
 -> Integer
 -> Maybe GuildId
 -> Maybe GuildId
 -> Integer
 -> Maybe GuildId
 -> Maybe UTCTime
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Integer
 -> Maybe [GuildMember]
 -> Maybe [Channel]
 -> Maybe [Channel]
 -> Maybe [PresenceInfo]
 -> Maybe Integer
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Integer
 -> Maybe Integer
 -> Text
 -> Maybe GuildId
 -> Maybe Integer
 -> Maybe Integer
 -> Maybe Integer
 -> Integer
 -> Maybe [StickerItem]
 -> Bool
 -> Guild)
-> Parser GuildId
-> Parser
     (Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> GuildId
      -> Maybe Text
      -> Maybe GuildId
      -> Integer
      -> Maybe Bool
      -> Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> Maybe GuildId
      -> Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser GuildId
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"id"
          Parser
  (Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> GuildId
   -> Maybe Text
   -> Maybe GuildId
   -> Integer
   -> Maybe Bool
   -> Maybe GuildId
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Maybe GuildId
   -> Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> GuildId
      -> Maybe Text
      -> Maybe GuildId
      -> Integer
      -> Maybe Bool
      -> Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> Maybe GuildId
      -> Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
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
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> GuildId
   -> Maybe Text
   -> Maybe GuildId
   -> Integer
   -> Maybe Bool
   -> Maybe GuildId
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Maybe GuildId
   -> Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> GuildId
      -> Maybe Text
      -> Maybe GuildId
      -> Integer
      -> Maybe Bool
      -> Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> Maybe GuildId
      -> Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"icon"
          Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> GuildId
   -> Maybe Text
   -> Maybe GuildId
   -> Integer
   -> Maybe Bool
   -> Maybe GuildId
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Maybe GuildId
   -> Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> GuildId
      -> Maybe Text
      -> Maybe GuildId
      -> Integer
      -> Maybe Bool
      -> Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> Maybe GuildId
      -> Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"icon_hash"
          Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> GuildId
   -> Maybe Text
   -> Maybe GuildId
   -> Integer
   -> Maybe Bool
   -> Maybe GuildId
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Maybe GuildId
   -> Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> GuildId
      -> Maybe Text
      -> Maybe GuildId
      -> Integer
      -> Maybe Bool
      -> Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> Maybe GuildId
      -> Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"splash"
          Parser
  (Maybe Text
   -> Maybe Bool
   -> GuildId
   -> Maybe Text
   -> Maybe GuildId
   -> Integer
   -> Maybe Bool
   -> Maybe GuildId
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Maybe GuildId
   -> Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> GuildId
      -> Maybe Text
      -> Maybe GuildId
      -> Integer
      -> Maybe Bool
      -> Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> Maybe GuildId
      -> Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"discovery_splash"
          Parser
  (Maybe Bool
   -> GuildId
   -> Maybe Text
   -> Maybe GuildId
   -> Integer
   -> Maybe Bool
   -> Maybe GuildId
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Maybe GuildId
   -> Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe Bool)
-> Parser
     (GuildId
      -> Maybe Text
      -> Maybe GuildId
      -> Integer
      -> Maybe Bool
      -> Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> Maybe GuildId
      -> Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"owner"
          Parser
  (GuildId
   -> Maybe Text
   -> Maybe GuildId
   -> Integer
   -> Maybe Bool
   -> Maybe GuildId
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Maybe GuildId
   -> Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser GuildId
-> Parser
     (Maybe Text
      -> Maybe GuildId
      -> Integer
      -> Maybe Bool
      -> Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> Maybe GuildId
      -> Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser GuildId
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"owner_id"
          Parser
  (Maybe Text
   -> Maybe GuildId
   -> Integer
   -> Maybe Bool
   -> Maybe GuildId
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Maybe GuildId
   -> Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe Text)
-> Parser
     (Maybe GuildId
      -> Integer
      -> Maybe Bool
      -> Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> Maybe GuildId
      -> Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"permissions"
          Parser
  (Maybe GuildId
   -> Integer
   -> Maybe Bool
   -> Maybe GuildId
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Maybe GuildId
   -> Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe GuildId)
-> Parser
     (Integer
      -> Maybe Bool
      -> Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> Maybe GuildId
      -> Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe GuildId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"afk_channel_id"
          Parser
  (Integer
   -> Maybe Bool
   -> Maybe GuildId
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Maybe GuildId
   -> Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser Integer
-> Parser
     (Maybe Bool
      -> Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> Maybe GuildId
      -> Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"afk_timeout"
          Parser
  (Maybe Bool
   -> Maybe GuildId
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Maybe GuildId
   -> Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe Bool)
-> Parser
     (Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> Maybe GuildId
      -> Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"widget_enabled"
          Parser
  (Maybe GuildId
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Maybe GuildId
   -> Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe GuildId)
-> Parser
     (Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> Maybe GuildId
      -> Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe GuildId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"widget_channel_id"
          Parser
  (Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Maybe GuildId
   -> Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser Integer
-> Parser
     (Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> Maybe GuildId
      -> Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"verification_level"
          Parser
  (Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Maybe GuildId
   -> Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser Integer
-> Parser
     (Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> Maybe GuildId
      -> Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"default_message_notifications"
          Parser
  (Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Maybe GuildId
   -> Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser Integer
-> Parser
     ([Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> Maybe GuildId
      -> Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"explicit_content_filter"
          Parser
  ([Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Maybe GuildId
   -> Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser [Role]
-> Parser
     ([Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> Maybe GuildId
      -> Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [Role]
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"roles"
          Parser
  ([Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Maybe GuildId
   -> Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser [Emoji]
-> Parser
     ([Text]
      -> Integer
      -> Maybe GuildId
      -> Maybe GuildId
      -> Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [Emoji]
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"emojis"
          Parser
  ([Text]
   -> Integer
   -> Maybe GuildId
   -> Maybe GuildId
   -> Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser [Text]
-> Parser
     (Integer
      -> Maybe GuildId
      -> Maybe GuildId
      -> Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
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
"features"
          Parser
  (Integer
   -> Maybe GuildId
   -> Maybe GuildId
   -> Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser Integer
-> Parser
     (Maybe GuildId
      -> Maybe GuildId
      -> Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"mfa_level"
          Parser
  (Maybe GuildId
   -> Maybe GuildId
   -> Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe GuildId)
-> Parser
     (Maybe GuildId
      -> Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe GuildId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"application_id"
          Parser
  (Maybe GuildId
   -> Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe GuildId)
-> Parser
     (Integer
      -> Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe GuildId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"system_channel_id"
          Parser
  (Integer
   -> Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser Integer
-> Parser
     (Maybe GuildId
      -> Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"system_channel_flags"
          Parser
  (Maybe GuildId
   -> Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe GuildId)
-> Parser
     (Maybe UTCTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe GuildId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"rules_channel_id"
          Parser
  (Maybe UTCTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe UTCTime)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"joined_at"
          Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"large"
          Parser
  (Maybe Bool
   -> Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Integer
      -> Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"unavailable"
          Parser
  (Maybe Integer
   -> Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe Integer)
-> Parser
     (Maybe [GuildMember]
      -> Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"member_count"
          -- voice_states
          Parser
  (Maybe [GuildMember]
   -> Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe [GuildMember])
-> Parser
     (Maybe [Channel]
      -> Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [GuildMember])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"members"
          Parser
  (Maybe [Channel]
   -> Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe [Channel])
-> Parser
     (Maybe [Channel]
      -> Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [Channel])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"channels"
          Parser
  (Maybe [Channel]
   -> Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe [Channel])
-> Parser
     (Maybe [PresenceInfo]
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [Channel])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"threads"
          Parser
  (Maybe [PresenceInfo]
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe [PresenceInfo])
-> Parser
     (Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [PresenceInfo])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"presences"
          Parser
  (Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_presences"
          Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_members"
          Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"vanity_url_code"
          Parser
  (Maybe Text
   -> Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
          Parser
  (Maybe Text
   -> Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe Text)
-> Parser
     (Integer
      -> Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"banner"
          Parser
  (Integer
   -> Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser Integer
-> Parser
     (Maybe Integer
      -> Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"premium_tier"
          Parser
  (Maybe Integer
   -> Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe Integer)
-> Parser
     (Text
      -> Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"premium_subscription_count"
          Parser
  (Text
   -> Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser Text
-> Parser
     (Maybe GuildId
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
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
"preferred_locale"
          Parser
  (Maybe GuildId
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe GuildId)
-> Parser
     (Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe GuildId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"public_updates_channel_id"
          Parser
  (Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Integer
      -> Maybe Integer
      -> Integer
      -> Maybe [StickerItem]
      -> Bool
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_video_channel_users"
          Parser
  (Maybe Integer
   -> Maybe Integer
   -> Integer
   -> Maybe [StickerItem]
   -> Bool
   -> Guild)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Integer -> Integer -> Maybe [StickerItem] -> Bool -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"approximate_member_count"
          Parser
  (Maybe Integer -> Integer -> Maybe [StickerItem] -> Bool -> Guild)
-> Parser (Maybe Integer)
-> Parser (Integer -> Maybe [StickerItem] -> Bool -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"approximate_presence_count"
          -- welcome_screen
          Parser (Integer -> Maybe [StickerItem] -> Bool -> Guild)
-> Parser Integer -> Parser (Maybe [StickerItem] -> Bool -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"nsfw_level"
          -- stage_instances
          Parser (Maybe [StickerItem] -> Bool -> Guild)
-> Parser (Maybe [StickerItem]) -> Parser (Bool -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [StickerItem])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"stickers"
          Parser (Bool -> Guild) -> Parser Bool -> Parser Guild
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"premium_progress_bar_enabled"

newtype GuildUnavailable = GuildUnavailable
      { GuildUnavailable -> GuildId
idOnceAvailable :: GuildId
      } deriving (Int -> GuildUnavailable -> ShowS
[GuildUnavailable] -> ShowS
GuildUnavailable -> String
(Int -> GuildUnavailable -> ShowS)
-> (GuildUnavailable -> String)
-> ([GuildUnavailable] -> ShowS)
-> Show GuildUnavailable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuildUnavailable] -> ShowS
$cshowList :: [GuildUnavailable] -> ShowS
show :: GuildUnavailable -> String
$cshow :: GuildUnavailable -> String
showsPrec :: Int -> GuildUnavailable -> ShowS
$cshowsPrec :: Int -> GuildUnavailable -> ShowS
Show, ReadPrec [GuildUnavailable]
ReadPrec GuildUnavailable
Int -> ReadS GuildUnavailable
ReadS [GuildUnavailable]
(Int -> ReadS GuildUnavailable)
-> ReadS [GuildUnavailable]
-> ReadPrec GuildUnavailable
-> ReadPrec [GuildUnavailable]
-> Read GuildUnavailable
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GuildUnavailable]
$creadListPrec :: ReadPrec [GuildUnavailable]
readPrec :: ReadPrec GuildUnavailable
$creadPrec :: ReadPrec GuildUnavailable
readList :: ReadS [GuildUnavailable]
$creadList :: ReadS [GuildUnavailable]
readsPrec :: Int -> ReadS GuildUnavailable
$creadsPrec :: Int -> ReadS GuildUnavailable
Read, GuildUnavailable -> GuildUnavailable -> Bool
(GuildUnavailable -> GuildUnavailable -> Bool)
-> (GuildUnavailable -> GuildUnavailable -> Bool)
-> Eq GuildUnavailable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GuildUnavailable -> GuildUnavailable -> Bool
$c/= :: GuildUnavailable -> GuildUnavailable -> Bool
== :: GuildUnavailable -> GuildUnavailable -> Bool
$c== :: GuildUnavailable -> GuildUnavailable -> Bool
Eq, Eq GuildUnavailable
Eq GuildUnavailable
-> (GuildUnavailable -> GuildUnavailable -> Ordering)
-> (GuildUnavailable -> GuildUnavailable -> Bool)
-> (GuildUnavailable -> GuildUnavailable -> Bool)
-> (GuildUnavailable -> GuildUnavailable -> Bool)
-> (GuildUnavailable -> GuildUnavailable -> Bool)
-> (GuildUnavailable -> GuildUnavailable -> GuildUnavailable)
-> (GuildUnavailable -> GuildUnavailable -> GuildUnavailable)
-> Ord GuildUnavailable
GuildUnavailable -> GuildUnavailable -> Bool
GuildUnavailable -> GuildUnavailable -> Ordering
GuildUnavailable -> GuildUnavailable -> GuildUnavailable
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GuildUnavailable -> GuildUnavailable -> GuildUnavailable
$cmin :: GuildUnavailable -> GuildUnavailable -> GuildUnavailable
max :: GuildUnavailable -> GuildUnavailable -> GuildUnavailable
$cmax :: GuildUnavailable -> GuildUnavailable -> GuildUnavailable
>= :: GuildUnavailable -> GuildUnavailable -> Bool
$c>= :: GuildUnavailable -> GuildUnavailable -> Bool
> :: GuildUnavailable -> GuildUnavailable -> Bool
$c> :: GuildUnavailable -> GuildUnavailable -> Bool
<= :: GuildUnavailable -> GuildUnavailable -> Bool
$c<= :: GuildUnavailable -> GuildUnavailable -> Bool
< :: GuildUnavailable -> GuildUnavailable -> Bool
$c< :: GuildUnavailable -> GuildUnavailable -> Bool
compare :: GuildUnavailable -> GuildUnavailable -> Ordering
$ccompare :: GuildUnavailable -> GuildUnavailable -> Ordering
$cp1Ord :: Eq GuildUnavailable
Ord)

instance FromJSON GuildUnavailable where
  parseJSON :: Value -> Parser GuildUnavailable
parseJSON = String
-> (Object -> Parser GuildUnavailable)
-> Value
-> Parser GuildUnavailable
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GuildUnavailable" ((Object -> Parser GuildUnavailable)
 -> Value -> Parser GuildUnavailable)
-> (Object -> Parser GuildUnavailable)
-> Value
-> Parser GuildUnavailable
forall a b. (a -> b) -> a -> b
$ \Object
o ->
       GuildId -> GuildUnavailable
GuildUnavailable (GuildId -> GuildUnavailable)
-> Parser GuildId -> Parser GuildUnavailable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser GuildId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"

data PresenceInfo = PresenceInfo
  { PresenceInfo -> GuildId
presenceUserId     :: UserId
  -- , presenceRoles   :: [RoleId]
  , PresenceInfo -> Maybe [Activity]
presenceActivities :: Maybe [Activity]
  , PresenceInfo -> Maybe GuildId
presenceGuildId    :: Maybe GuildId
  , PresenceInfo -> Text
presenceStatus     :: T.Text
  } deriving (Int -> PresenceInfo -> ShowS
[PresenceInfo] -> ShowS
PresenceInfo -> String
(Int -> PresenceInfo -> ShowS)
-> (PresenceInfo -> String)
-> ([PresenceInfo] -> ShowS)
-> Show PresenceInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PresenceInfo] -> ShowS
$cshowList :: [PresenceInfo] -> ShowS
show :: PresenceInfo -> String
$cshow :: PresenceInfo -> String
showsPrec :: Int -> PresenceInfo -> ShowS
$cshowsPrec :: Int -> PresenceInfo -> ShowS
Show, ReadPrec [PresenceInfo]
ReadPrec PresenceInfo
Int -> ReadS PresenceInfo
ReadS [PresenceInfo]
(Int -> ReadS PresenceInfo)
-> ReadS [PresenceInfo]
-> ReadPrec PresenceInfo
-> ReadPrec [PresenceInfo]
-> Read PresenceInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PresenceInfo]
$creadListPrec :: ReadPrec [PresenceInfo]
readPrec :: ReadPrec PresenceInfo
$creadPrec :: ReadPrec PresenceInfo
readList :: ReadS [PresenceInfo]
$creadList :: ReadS [PresenceInfo]
readsPrec :: Int -> ReadS PresenceInfo
$creadsPrec :: Int -> ReadS PresenceInfo
Read, PresenceInfo -> PresenceInfo -> Bool
(PresenceInfo -> PresenceInfo -> Bool)
-> (PresenceInfo -> PresenceInfo -> Bool) -> Eq PresenceInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PresenceInfo -> PresenceInfo -> Bool
$c/= :: PresenceInfo -> PresenceInfo -> Bool
== :: PresenceInfo -> PresenceInfo -> Bool
$c== :: PresenceInfo -> PresenceInfo -> Bool
Eq, Eq PresenceInfo
Eq PresenceInfo
-> (PresenceInfo -> PresenceInfo -> Ordering)
-> (PresenceInfo -> PresenceInfo -> Bool)
-> (PresenceInfo -> PresenceInfo -> Bool)
-> (PresenceInfo -> PresenceInfo -> Bool)
-> (PresenceInfo -> PresenceInfo -> Bool)
-> (PresenceInfo -> PresenceInfo -> PresenceInfo)
-> (PresenceInfo -> PresenceInfo -> PresenceInfo)
-> Ord PresenceInfo
PresenceInfo -> PresenceInfo -> Bool
PresenceInfo -> PresenceInfo -> Ordering
PresenceInfo -> PresenceInfo -> PresenceInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PresenceInfo -> PresenceInfo -> PresenceInfo
$cmin :: PresenceInfo -> PresenceInfo -> PresenceInfo
max :: PresenceInfo -> PresenceInfo -> PresenceInfo
$cmax :: PresenceInfo -> PresenceInfo -> PresenceInfo
>= :: PresenceInfo -> PresenceInfo -> Bool
$c>= :: PresenceInfo -> PresenceInfo -> Bool
> :: PresenceInfo -> PresenceInfo -> Bool
$c> :: PresenceInfo -> PresenceInfo -> Bool
<= :: PresenceInfo -> PresenceInfo -> Bool
$c<= :: PresenceInfo -> PresenceInfo -> Bool
< :: PresenceInfo -> PresenceInfo -> Bool
$c< :: PresenceInfo -> PresenceInfo -> Bool
compare :: PresenceInfo -> PresenceInfo -> Ordering
$ccompare :: PresenceInfo -> PresenceInfo -> Ordering
$cp1Ord :: Eq PresenceInfo
Ord)

instance FromJSON PresenceInfo where
  parseJSON :: Value -> Parser PresenceInfo
parseJSON = String
-> (Object -> Parser PresenceInfo) -> Value -> Parser PresenceInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PresenceInfo" ((Object -> Parser PresenceInfo) -> Value -> Parser PresenceInfo)
-> (Object -> Parser PresenceInfo) -> Value -> Parser PresenceInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    GuildId
-> Maybe [Activity] -> Maybe GuildId -> Text -> PresenceInfo
PresenceInfo (GuildId
 -> Maybe [Activity] -> Maybe GuildId -> Text -> PresenceInfo)
-> Parser GuildId
-> Parser
     (Maybe [Activity] -> Maybe GuildId -> Text -> PresenceInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user" Parser Object -> (Object -> Parser GuildId) -> Parser GuildId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser GuildId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"))
                 Parser (Maybe [Activity] -> Maybe GuildId -> Text -> PresenceInfo)
-> Parser (Maybe [Activity])
-> Parser (Maybe GuildId -> Text -> PresenceInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [Activity])
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"activities"
                 Parser (Maybe GuildId -> Text -> PresenceInfo)
-> Parser (Maybe GuildId) -> Parser (Text -> PresenceInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe GuildId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"guild_id"
                 Parser (Text -> PresenceInfo) -> Parser Text -> Parser PresenceInfo
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
"status"

-- | Object for a single activity
--
-- https://discord.com/developers/docs/topics/gateway#activity-object
--
-- When setting a bot's activity, only the name, url, and type are sent - and
-- it seems that not many types are permitted either.
data Activity = 
  Activity
    { Activity -> Text
activityName :: T.Text -- ^ Name of activity
    , Activity -> ActivityType
activityType :: ActivityType -- ^ Type of activity
    , Activity -> Maybe Text
activityUrl :: Maybe T.Text -- ^ URL of the activity (only verified when streaming)
    , Activity -> Integer
activityCreatedAt :: Integer -- ^ unix time in milliseconds
    , Activity -> Maybe ActivityTimestamps
activityTimeStamps :: Maybe ActivityTimestamps -- ^ Start and end times
    , Activity -> Maybe GuildId
activityApplicationId :: Maybe ApplicationId -- ^ Application of the activity
    , Activity -> Maybe Text
activityDetails :: Maybe T.Text -- ^ Details of Activity
    , Activity -> Maybe Text
activityState :: Maybe T.Text -- ^ State of the user's party
    , Activity -> Maybe Emoji
activityEmoji :: Maybe Emoji -- ^ Simplified emoji object
    , Activity -> Maybe ActivityParty
activityParty :: Maybe ActivityParty -- ^ Info for the current player's party
    -- assets
    -- secrets
    , Activity -> Maybe Bool
activityInstance :: Maybe Bool -- ^ Whether or not the activity is an instanced game session
    , Activity -> Maybe Integer
activityFlags :: Maybe Integer -- ^ The flags https://discord.com/developers/docs/topics/gateway#activity-object-activity-flags
    , Activity -> Maybe [ActivityButton]
activityButtons :: Maybe [ActivityButton] -- ^ Custom buttons shown in Rich Presence
    }
  deriving (Int -> Activity -> ShowS
[Activity] -> ShowS
Activity -> String
(Int -> Activity -> ShowS)
-> (Activity -> String) -> ([Activity] -> ShowS) -> Show Activity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Activity] -> ShowS
$cshowList :: [Activity] -> ShowS
show :: Activity -> String
$cshow :: Activity -> String
showsPrec :: Int -> Activity -> ShowS
$cshowsPrec :: Int -> Activity -> ShowS
Show, ReadPrec [Activity]
ReadPrec Activity
Int -> ReadS Activity
ReadS [Activity]
(Int -> ReadS Activity)
-> ReadS [Activity]
-> ReadPrec Activity
-> ReadPrec [Activity]
-> Read Activity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Activity]
$creadListPrec :: ReadPrec [Activity]
readPrec :: ReadPrec Activity
$creadPrec :: ReadPrec Activity
readList :: ReadS [Activity]
$creadList :: ReadS [Activity]
readsPrec :: Int -> ReadS Activity
$creadsPrec :: Int -> ReadS Activity
Read, Activity -> Activity -> Bool
(Activity -> Activity -> Bool)
-> (Activity -> Activity -> Bool) -> Eq Activity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Activity -> Activity -> Bool
$c/= :: Activity -> Activity -> Bool
== :: Activity -> Activity -> Bool
$c== :: Activity -> Activity -> Bool
Eq, Eq Activity
Eq Activity
-> (Activity -> Activity -> Ordering)
-> (Activity -> Activity -> Bool)
-> (Activity -> Activity -> Bool)
-> (Activity -> Activity -> Bool)
-> (Activity -> Activity -> Bool)
-> (Activity -> Activity -> Activity)
-> (Activity -> Activity -> Activity)
-> Ord Activity
Activity -> Activity -> Bool
Activity -> Activity -> Ordering
Activity -> Activity -> Activity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Activity -> Activity -> Activity
$cmin :: Activity -> Activity -> Activity
max :: Activity -> Activity -> Activity
$cmax :: Activity -> Activity -> Activity
>= :: Activity -> Activity -> Bool
$c>= :: Activity -> Activity -> Bool
> :: Activity -> Activity -> Bool
$c> :: Activity -> Activity -> Bool
<= :: Activity -> Activity -> Bool
$c<= :: Activity -> Activity -> Bool
< :: Activity -> Activity -> Bool
$c< :: Activity -> Activity -> Bool
compare :: Activity -> Activity -> Ordering
$ccompare :: Activity -> Activity -> Ordering
$cp1Ord :: Eq Activity
Ord)

instance Default Activity where
  def :: Activity
def = Text
-> ActivityType
-> Maybe Text
-> Integer
-> Maybe ActivityTimestamps
-> Maybe GuildId
-> Maybe Text
-> Maybe Text
-> Maybe Emoji
-> Maybe ActivityParty
-> Maybe Bool
-> Maybe Integer
-> Maybe [ActivityButton]
-> Activity
Activity Text
"discord-haskell" ActivityType
ActivityTypeGame Maybe Text
forall a. Maybe a
Nothing Integer
0 Maybe ActivityTimestamps
forall a. Maybe a
Nothing Maybe GuildId
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Emoji
forall a. Maybe a
Nothing Maybe ActivityParty
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe [ActivityButton]
forall a. Maybe a
Nothing

instance FromJSON Activity where
  parseJSON :: Value -> Parser Activity
parseJSON = String -> (Object -> Parser Activity) -> Value -> Parser Activity
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Activity" ((Object -> Parser Activity) -> Value -> Parser Activity)
-> (Object -> Parser Activity) -> Value -> Parser Activity
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
-> ActivityType
-> Maybe Text
-> Integer
-> Maybe ActivityTimestamps
-> Maybe GuildId
-> Maybe Text
-> Maybe Text
-> Maybe Emoji
-> Maybe ActivityParty
-> Maybe Bool
-> Maybe Integer
-> Maybe [ActivityButton]
-> Activity
Activity (Text
 -> ActivityType
 -> Maybe Text
 -> Integer
 -> Maybe ActivityTimestamps
 -> Maybe GuildId
 -> Maybe Text
 -> Maybe Text
 -> Maybe Emoji
 -> Maybe ActivityParty
 -> Maybe Bool
 -> Maybe Integer
 -> Maybe [ActivityButton]
 -> Activity)
-> Parser Text
-> Parser
     (ActivityType
      -> Maybe Text
      -> Integer
      -> Maybe ActivityTimestamps
      -> Maybe GuildId
      -> Maybe Text
      -> Maybe Text
      -> Maybe Emoji
      -> Maybe ActivityParty
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [ActivityButton]
      -> Activity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"name"
             Parser
  (ActivityType
   -> Maybe Text
   -> Integer
   -> Maybe ActivityTimestamps
   -> Maybe GuildId
   -> Maybe Text
   -> Maybe Text
   -> Maybe Emoji
   -> Maybe ActivityParty
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [ActivityButton]
   -> Activity)
-> Parser ActivityType
-> Parser
     (Maybe Text
      -> Integer
      -> Maybe ActivityTimestamps
      -> Maybe GuildId
      -> Maybe Text
      -> Maybe Text
      -> Maybe Emoji
      -> Maybe ActivityParty
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [ActivityButton]
      -> Activity)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ActivityType
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"type"
             Parser
  (Maybe Text
   -> Integer
   -> Maybe ActivityTimestamps
   -> Maybe GuildId
   -> Maybe Text
   -> Maybe Text
   -> Maybe Emoji
   -> Maybe ActivityParty
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [ActivityButton]
   -> Activity)
-> Parser (Maybe Text)
-> Parser
     (Integer
      -> Maybe ActivityTimestamps
      -> Maybe GuildId
      -> Maybe Text
      -> Maybe Text
      -> Maybe Emoji
      -> Maybe ActivityParty
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [ActivityButton]
      -> Activity)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url"
             Parser
  (Integer
   -> Maybe ActivityTimestamps
   -> Maybe GuildId
   -> Maybe Text
   -> Maybe Text
   -> Maybe Emoji
   -> Maybe ActivityParty
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [ActivityButton]
   -> Activity)
-> Parser Integer
-> Parser
     (Maybe ActivityTimestamps
      -> Maybe GuildId
      -> Maybe Text
      -> Maybe Text
      -> Maybe Emoji
      -> Maybe ActivityParty
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [ActivityButton]
      -> Activity)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"created_at"
             Parser
  (Maybe ActivityTimestamps
   -> Maybe GuildId
   -> Maybe Text
   -> Maybe Text
   -> Maybe Emoji
   -> Maybe ActivityParty
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [ActivityButton]
   -> Activity)
-> Parser (Maybe ActivityTimestamps)
-> Parser
     (Maybe GuildId
      -> Maybe Text
      -> Maybe Text
      -> Maybe Emoji
      -> Maybe ActivityParty
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [ActivityButton]
      -> Activity)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ActivityTimestamps)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"timestamps"
             Parser
  (Maybe GuildId
   -> Maybe Text
   -> Maybe Text
   -> Maybe Emoji
   -> Maybe ActivityParty
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [ActivityButton]
   -> Activity)
-> Parser (Maybe GuildId)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Emoji
      -> Maybe ActivityParty
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [ActivityButton]
      -> Activity)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe GuildId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"application_id"
             Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Emoji
   -> Maybe ActivityParty
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [ActivityButton]
   -> Activity)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Emoji
      -> Maybe ActivityParty
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [ActivityButton]
      -> Activity)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"details"
             Parser
  (Maybe Text
   -> Maybe Emoji
   -> Maybe ActivityParty
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [ActivityButton]
   -> Activity)
-> Parser (Maybe Text)
-> Parser
     (Maybe Emoji
      -> Maybe ActivityParty
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [ActivityButton]
      -> Activity)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"state"
             Parser
  (Maybe Emoji
   -> Maybe ActivityParty
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [ActivityButton]
   -> Activity)
-> Parser (Maybe Emoji)
-> Parser
     (Maybe ActivityParty
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [ActivityButton]
      -> Activity)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Emoji)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"emoji"
             Parser
  (Maybe ActivityParty
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [ActivityButton]
   -> Activity)
-> Parser (Maybe ActivityParty)
-> Parser
     (Maybe Bool -> Maybe Integer -> Maybe [ActivityButton] -> Activity)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ActivityParty)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"party"
             -- assets
             -- secrets
             Parser
  (Maybe Bool -> Maybe Integer -> Maybe [ActivityButton] -> Activity)
-> Parser (Maybe Bool)
-> Parser (Maybe Integer -> Maybe [ActivityButton] -> Activity)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"instance"
             Parser (Maybe Integer -> Maybe [ActivityButton] -> Activity)
-> Parser (Maybe Integer)
-> Parser (Maybe [ActivityButton] -> Activity)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"flags"
             Parser (Maybe [ActivityButton] -> Activity)
-> Parser (Maybe [ActivityButton]) -> Parser Activity
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [ActivityButton])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"buttons"

data ActivityTimestamps = ActivityTimestamps
  { ActivityTimestamps -> Maybe Integer
activityTimestampsStart :: Maybe Integer -- ^ unix time in milliseconds
  , ActivityTimestamps -> Maybe Integer
activityTimestampsEnd :: Maybe Integer -- ^ unix time in milliseconds
  } deriving (Int -> ActivityTimestamps -> ShowS
[ActivityTimestamps] -> ShowS
ActivityTimestamps -> String
(Int -> ActivityTimestamps -> ShowS)
-> (ActivityTimestamps -> String)
-> ([ActivityTimestamps] -> ShowS)
-> Show ActivityTimestamps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivityTimestamps] -> ShowS
$cshowList :: [ActivityTimestamps] -> ShowS
show :: ActivityTimestamps -> String
$cshow :: ActivityTimestamps -> String
showsPrec :: Int -> ActivityTimestamps -> ShowS
$cshowsPrec :: Int -> ActivityTimestamps -> ShowS
Show, ReadPrec [ActivityTimestamps]
ReadPrec ActivityTimestamps
Int -> ReadS ActivityTimestamps
ReadS [ActivityTimestamps]
(Int -> ReadS ActivityTimestamps)
-> ReadS [ActivityTimestamps]
-> ReadPrec ActivityTimestamps
-> ReadPrec [ActivityTimestamps]
-> Read ActivityTimestamps
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ActivityTimestamps]
$creadListPrec :: ReadPrec [ActivityTimestamps]
readPrec :: ReadPrec ActivityTimestamps
$creadPrec :: ReadPrec ActivityTimestamps
readList :: ReadS [ActivityTimestamps]
$creadList :: ReadS [ActivityTimestamps]
readsPrec :: Int -> ReadS ActivityTimestamps
$creadsPrec :: Int -> ReadS ActivityTimestamps
Read, ActivityTimestamps -> ActivityTimestamps -> Bool
(ActivityTimestamps -> ActivityTimestamps -> Bool)
-> (ActivityTimestamps -> ActivityTimestamps -> Bool)
-> Eq ActivityTimestamps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivityTimestamps -> ActivityTimestamps -> Bool
$c/= :: ActivityTimestamps -> ActivityTimestamps -> Bool
== :: ActivityTimestamps -> ActivityTimestamps -> Bool
$c== :: ActivityTimestamps -> ActivityTimestamps -> Bool
Eq, Eq ActivityTimestamps
Eq ActivityTimestamps
-> (ActivityTimestamps -> ActivityTimestamps -> Ordering)
-> (ActivityTimestamps -> ActivityTimestamps -> Bool)
-> (ActivityTimestamps -> ActivityTimestamps -> Bool)
-> (ActivityTimestamps -> ActivityTimestamps -> Bool)
-> (ActivityTimestamps -> ActivityTimestamps -> Bool)
-> (ActivityTimestamps -> ActivityTimestamps -> ActivityTimestamps)
-> (ActivityTimestamps -> ActivityTimestamps -> ActivityTimestamps)
-> Ord ActivityTimestamps
ActivityTimestamps -> ActivityTimestamps -> Bool
ActivityTimestamps -> ActivityTimestamps -> Ordering
ActivityTimestamps -> ActivityTimestamps -> ActivityTimestamps
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ActivityTimestamps -> ActivityTimestamps -> ActivityTimestamps
$cmin :: ActivityTimestamps -> ActivityTimestamps -> ActivityTimestamps
max :: ActivityTimestamps -> ActivityTimestamps -> ActivityTimestamps
$cmax :: ActivityTimestamps -> ActivityTimestamps -> ActivityTimestamps
>= :: ActivityTimestamps -> ActivityTimestamps -> Bool
$c>= :: ActivityTimestamps -> ActivityTimestamps -> Bool
> :: ActivityTimestamps -> ActivityTimestamps -> Bool
$c> :: ActivityTimestamps -> ActivityTimestamps -> Bool
<= :: ActivityTimestamps -> ActivityTimestamps -> Bool
$c<= :: ActivityTimestamps -> ActivityTimestamps -> Bool
< :: ActivityTimestamps -> ActivityTimestamps -> Bool
$c< :: ActivityTimestamps -> ActivityTimestamps -> Bool
compare :: ActivityTimestamps -> ActivityTimestamps -> Ordering
$ccompare :: ActivityTimestamps -> ActivityTimestamps -> Ordering
$cp1Ord :: Eq ActivityTimestamps
Ord)

instance FromJSON ActivityTimestamps where
  parseJSON :: Value -> Parser ActivityTimestamps
parseJSON = String
-> (Object -> Parser ActivityTimestamps)
-> Value
-> Parser ActivityTimestamps
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ActivityTimestamps" ((Object -> Parser ActivityTimestamps)
 -> Value -> Parser ActivityTimestamps)
-> (Object -> Parser ActivityTimestamps)
-> Value
-> Parser ActivityTimestamps
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer -> Maybe Integer -> ActivityTimestamps
ActivityTimestamps (Maybe Integer -> Maybe Integer -> ActivityTimestamps)
-> Parser (Maybe Integer)
-> Parser (Maybe Integer -> ActivityTimestamps)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"start"
                       Parser (Maybe Integer -> ActivityTimestamps)
-> Parser (Maybe Integer) -> Parser ActivityTimestamps
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"end"

data ActivityParty = ActivityParty
  { ActivityParty -> Maybe Text
activityPartyId :: Maybe T.Text
  , ActivityParty -> Maybe (Integer, Integer)
activityPartySize :: Maybe (Integer, Integer)
  } deriving (Int -> ActivityParty -> ShowS
[ActivityParty] -> ShowS
ActivityParty -> String
(Int -> ActivityParty -> ShowS)
-> (ActivityParty -> String)
-> ([ActivityParty] -> ShowS)
-> Show ActivityParty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivityParty] -> ShowS
$cshowList :: [ActivityParty] -> ShowS
show :: ActivityParty -> String
$cshow :: ActivityParty -> String
showsPrec :: Int -> ActivityParty -> ShowS
$cshowsPrec :: Int -> ActivityParty -> ShowS
Show, ReadPrec [ActivityParty]
ReadPrec ActivityParty
Int -> ReadS ActivityParty
ReadS [ActivityParty]
(Int -> ReadS ActivityParty)
-> ReadS [ActivityParty]
-> ReadPrec ActivityParty
-> ReadPrec [ActivityParty]
-> Read ActivityParty
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ActivityParty]
$creadListPrec :: ReadPrec [ActivityParty]
readPrec :: ReadPrec ActivityParty
$creadPrec :: ReadPrec ActivityParty
readList :: ReadS [ActivityParty]
$creadList :: ReadS [ActivityParty]
readsPrec :: Int -> ReadS ActivityParty
$creadsPrec :: Int -> ReadS ActivityParty
Read, ActivityParty -> ActivityParty -> Bool
(ActivityParty -> ActivityParty -> Bool)
-> (ActivityParty -> ActivityParty -> Bool) -> Eq ActivityParty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivityParty -> ActivityParty -> Bool
$c/= :: ActivityParty -> ActivityParty -> Bool
== :: ActivityParty -> ActivityParty -> Bool
$c== :: ActivityParty -> ActivityParty -> Bool
Eq, Eq ActivityParty
Eq ActivityParty
-> (ActivityParty -> ActivityParty -> Ordering)
-> (ActivityParty -> ActivityParty -> Bool)
-> (ActivityParty -> ActivityParty -> Bool)
-> (ActivityParty -> ActivityParty -> Bool)
-> (ActivityParty -> ActivityParty -> Bool)
-> (ActivityParty -> ActivityParty -> ActivityParty)
-> (ActivityParty -> ActivityParty -> ActivityParty)
-> Ord ActivityParty
ActivityParty -> ActivityParty -> Bool
ActivityParty -> ActivityParty -> Ordering
ActivityParty -> ActivityParty -> ActivityParty
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ActivityParty -> ActivityParty -> ActivityParty
$cmin :: ActivityParty -> ActivityParty -> ActivityParty
max :: ActivityParty -> ActivityParty -> ActivityParty
$cmax :: ActivityParty -> ActivityParty -> ActivityParty
>= :: ActivityParty -> ActivityParty -> Bool
$c>= :: ActivityParty -> ActivityParty -> Bool
> :: ActivityParty -> ActivityParty -> Bool
$c> :: ActivityParty -> ActivityParty -> Bool
<= :: ActivityParty -> ActivityParty -> Bool
$c<= :: ActivityParty -> ActivityParty -> Bool
< :: ActivityParty -> ActivityParty -> Bool
$c< :: ActivityParty -> ActivityParty -> Bool
compare :: ActivityParty -> ActivityParty -> Ordering
$ccompare :: ActivityParty -> ActivityParty -> Ordering
$cp1Ord :: Eq ActivityParty
Ord)

instance FromJSON ActivityParty where
  parseJSON :: Value -> Parser ActivityParty
parseJSON = String
-> (Object -> Parser ActivityParty)
-> Value
-> Parser ActivityParty
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ActivityParty" ((Object -> Parser ActivityParty) -> Value -> Parser ActivityParty)
-> (Object -> Parser ActivityParty)
-> Value
-> Parser ActivityParty
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe (Integer, Integer) -> ActivityParty
ActivityParty (Maybe Text -> Maybe (Integer, Integer) -> ActivityParty)
-> Parser (Maybe Text)
-> Parser (Maybe (Integer, Integer) -> ActivityParty)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id"
                  Parser (Maybe (Integer, Integer) -> ActivityParty)
-> Parser (Maybe (Integer, Integer)) -> Parser ActivityParty
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Integer, Integer))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"size"

data ActivityButton = ActivityButton
  { ActivityButton -> Text
activityButtonLabel :: T.Text
  , ActivityButton -> Text
activityButtonUrl :: T.Text
  } deriving (Int -> ActivityButton -> ShowS
[ActivityButton] -> ShowS
ActivityButton -> String
(Int -> ActivityButton -> ShowS)
-> (ActivityButton -> String)
-> ([ActivityButton] -> ShowS)
-> Show ActivityButton
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivityButton] -> ShowS
$cshowList :: [ActivityButton] -> ShowS
show :: ActivityButton -> String
$cshow :: ActivityButton -> String
showsPrec :: Int -> ActivityButton -> ShowS
$cshowsPrec :: Int -> ActivityButton -> ShowS
Show, ReadPrec [ActivityButton]
ReadPrec ActivityButton
Int -> ReadS ActivityButton
ReadS [ActivityButton]
(Int -> ReadS ActivityButton)
-> ReadS [ActivityButton]
-> ReadPrec ActivityButton
-> ReadPrec [ActivityButton]
-> Read ActivityButton
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ActivityButton]
$creadListPrec :: ReadPrec [ActivityButton]
readPrec :: ReadPrec ActivityButton
$creadPrec :: ReadPrec ActivityButton
readList :: ReadS [ActivityButton]
$creadList :: ReadS [ActivityButton]
readsPrec :: Int -> ReadS ActivityButton
$creadsPrec :: Int -> ReadS ActivityButton
Read, ActivityButton -> ActivityButton -> Bool
(ActivityButton -> ActivityButton -> Bool)
-> (ActivityButton -> ActivityButton -> Bool) -> Eq ActivityButton
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivityButton -> ActivityButton -> Bool
$c/= :: ActivityButton -> ActivityButton -> Bool
== :: ActivityButton -> ActivityButton -> Bool
$c== :: ActivityButton -> ActivityButton -> Bool
Eq, Eq ActivityButton
Eq ActivityButton
-> (ActivityButton -> ActivityButton -> Ordering)
-> (ActivityButton -> ActivityButton -> Bool)
-> (ActivityButton -> ActivityButton -> Bool)
-> (ActivityButton -> ActivityButton -> Bool)
-> (ActivityButton -> ActivityButton -> Bool)
-> (ActivityButton -> ActivityButton -> ActivityButton)
-> (ActivityButton -> ActivityButton -> ActivityButton)
-> Ord ActivityButton
ActivityButton -> ActivityButton -> Bool
ActivityButton -> ActivityButton -> Ordering
ActivityButton -> ActivityButton -> ActivityButton
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ActivityButton -> ActivityButton -> ActivityButton
$cmin :: ActivityButton -> ActivityButton -> ActivityButton
max :: ActivityButton -> ActivityButton -> ActivityButton
$cmax :: ActivityButton -> ActivityButton -> ActivityButton
>= :: ActivityButton -> ActivityButton -> Bool
$c>= :: ActivityButton -> ActivityButton -> Bool
> :: ActivityButton -> ActivityButton -> Bool
$c> :: ActivityButton -> ActivityButton -> Bool
<= :: ActivityButton -> ActivityButton -> Bool
$c<= :: ActivityButton -> ActivityButton -> Bool
< :: ActivityButton -> ActivityButton -> Bool
$c< :: ActivityButton -> ActivityButton -> Bool
compare :: ActivityButton -> ActivityButton -> Ordering
$ccompare :: ActivityButton -> ActivityButton -> Ordering
$cp1Ord :: Eq ActivityButton
Ord)

instance FromJSON ActivityButton where
  parseJSON :: Value -> Parser ActivityButton
parseJSON = String
-> (Object -> Parser ActivityButton)
-> Value
-> Parser ActivityButton
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ActivityButton" ((Object -> Parser ActivityButton)
 -> Value -> Parser ActivityButton)
-> (Object -> Parser ActivityButton)
-> Value
-> Parser ActivityButton
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> ActivityButton
ActivityButton (Text -> Text -> ActivityButton)
-> Parser Text -> Parser (Text -> ActivityButton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"label"
                   Parser (Text -> ActivityButton)
-> Parser Text -> Parser ActivityButton
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
"url"

-- | To see what these look like, go to here: 
-- https://discord.com/developers/docs/topics/gateway#activity-object-activity-types
data ActivityType = 
    ActivityTypeGame
  | ActivityTypeStreaming
  | ActivityTypeListening
  | ActivityTypeWatching
  | ActivityTypeCustom
  | ActivityTypeCompeting
  deriving (Int -> ActivityType -> ShowS
[ActivityType] -> ShowS
ActivityType -> String
(Int -> ActivityType -> ShowS)
-> (ActivityType -> String)
-> ([ActivityType] -> ShowS)
-> Show ActivityType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivityType] -> ShowS
$cshowList :: [ActivityType] -> ShowS
show :: ActivityType -> String
$cshow :: ActivityType -> String
showsPrec :: Int -> ActivityType -> ShowS
$cshowsPrec :: Int -> ActivityType -> ShowS
Show, ReadPrec [ActivityType]
ReadPrec ActivityType
Int -> ReadS ActivityType
ReadS [ActivityType]
(Int -> ReadS ActivityType)
-> ReadS [ActivityType]
-> ReadPrec ActivityType
-> ReadPrec [ActivityType]
-> Read ActivityType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ActivityType]
$creadListPrec :: ReadPrec [ActivityType]
readPrec :: ReadPrec ActivityType
$creadPrec :: ReadPrec ActivityType
readList :: ReadS [ActivityType]
$creadList :: ReadS [ActivityType]
readsPrec :: Int -> ReadS ActivityType
$creadsPrec :: Int -> ReadS ActivityType
Read, ActivityType -> ActivityType -> Bool
(ActivityType -> ActivityType -> Bool)
-> (ActivityType -> ActivityType -> Bool) -> Eq ActivityType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivityType -> ActivityType -> Bool
$c/= :: ActivityType -> ActivityType -> Bool
== :: ActivityType -> ActivityType -> Bool
$c== :: ActivityType -> ActivityType -> Bool
Eq, Eq ActivityType
Eq ActivityType
-> (ActivityType -> ActivityType -> Ordering)
-> (ActivityType -> ActivityType -> Bool)
-> (ActivityType -> ActivityType -> Bool)
-> (ActivityType -> ActivityType -> Bool)
-> (ActivityType -> ActivityType -> Bool)
-> (ActivityType -> ActivityType -> ActivityType)
-> (ActivityType -> ActivityType -> ActivityType)
-> Ord ActivityType
ActivityType -> ActivityType -> Bool
ActivityType -> ActivityType -> Ordering
ActivityType -> ActivityType -> ActivityType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ActivityType -> ActivityType -> ActivityType
$cmin :: ActivityType -> ActivityType -> ActivityType
max :: ActivityType -> ActivityType -> ActivityType
$cmax :: ActivityType -> ActivityType -> ActivityType
>= :: ActivityType -> ActivityType -> Bool
$c>= :: ActivityType -> ActivityType -> Bool
> :: ActivityType -> ActivityType -> Bool
$c> :: ActivityType -> ActivityType -> Bool
<= :: ActivityType -> ActivityType -> Bool
$c<= :: ActivityType -> ActivityType -> Bool
< :: ActivityType -> ActivityType -> Bool
$c< :: ActivityType -> ActivityType -> Bool
compare :: ActivityType -> ActivityType -> Ordering
$ccompare :: ActivityType -> ActivityType -> Ordering
$cp1Ord :: Eq ActivityType
Ord, Typeable ActivityType
DataType
Constr
Typeable ActivityType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ActivityType -> c ActivityType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ActivityType)
-> (ActivityType -> Constr)
-> (ActivityType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ActivityType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ActivityType))
-> ((forall b. Data b => b -> b) -> ActivityType -> ActivityType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ActivityType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ActivityType -> r)
-> (forall u. (forall d. Data d => d -> u) -> ActivityType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ActivityType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ActivityType -> m ActivityType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ActivityType -> m ActivityType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ActivityType -> m ActivityType)
-> Data ActivityType
ActivityType -> DataType
ActivityType -> Constr
(forall b. Data b => b -> b) -> ActivityType -> ActivityType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ActivityType -> c ActivityType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ActivityType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ActivityType -> u
forall u. (forall d. Data d => d -> u) -> ActivityType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ActivityType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ActivityType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ActivityType -> m ActivityType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ActivityType -> m ActivityType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ActivityType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ActivityType -> c ActivityType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ActivityType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ActivityType)
$cActivityTypeCompeting :: Constr
$cActivityTypeCustom :: Constr
$cActivityTypeWatching :: Constr
$cActivityTypeListening :: Constr
$cActivityTypeStreaming :: Constr
$cActivityTypeGame :: Constr
$tActivityType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ActivityType -> m ActivityType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ActivityType -> m ActivityType
gmapMp :: (forall d. Data d => d -> m d) -> ActivityType -> m ActivityType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ActivityType -> m ActivityType
gmapM :: (forall d. Data d => d -> m d) -> ActivityType -> m ActivityType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ActivityType -> m ActivityType
gmapQi :: Int -> (forall d. Data d => d -> u) -> ActivityType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ActivityType -> u
gmapQ :: (forall d. Data d => d -> u) -> ActivityType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ActivityType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ActivityType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ActivityType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ActivityType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ActivityType -> r
gmapT :: (forall b. Data b => b -> b) -> ActivityType -> ActivityType
$cgmapT :: (forall b. Data b => b -> b) -> ActivityType -> ActivityType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ActivityType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ActivityType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ActivityType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ActivityType)
dataTypeOf :: ActivityType -> DataType
$cdataTypeOf :: ActivityType -> DataType
toConstr :: ActivityType -> Constr
$ctoConstr :: ActivityType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ActivityType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ActivityType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ActivityType -> c ActivityType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ActivityType -> c ActivityType
$cp1Data :: Typeable ActivityType
Data)

instance InternalDiscordEnum ActivityType where
  discordTypeStartValue :: ActivityType
discordTypeStartValue = ActivityType
ActivityTypeGame
  fromDiscordType :: ActivityType -> Int
fromDiscordType ActivityType
ActivityTypeGame = Int
0
  fromDiscordType ActivityType
ActivityTypeStreaming = Int
1
  fromDiscordType ActivityType
ActivityTypeListening = Int
2
  fromDiscordType ActivityType
ActivityTypeWatching = Int
3
  fromDiscordType ActivityType
ActivityTypeCustom = Int
4
  fromDiscordType ActivityType
ActivityTypeCompeting = Int
5

instance FromJSON ActivityType where
  parseJSON :: Value -> Parser ActivityType
parseJSON = String -> Value -> Parser ActivityType
forall a. InternalDiscordEnum a => String -> Value -> Parser a
discordTypeParseJSON String
"ActivityType"

data PartialGuild = PartialGuild
      { PartialGuild -> GuildId
partialGuildId          :: GuildId
      , PartialGuild -> Text
partialGuildName        :: T.Text
      , PartialGuild -> Maybe Text
partialGuildIcon        :: Maybe T.Text
      , PartialGuild -> Bool
partialGuildOwner       :: Bool
      , PartialGuild -> Text
partialGuildPermissions :: T.Text
      } deriving (Int -> PartialGuild -> ShowS
[PartialGuild] -> ShowS
PartialGuild -> String
(Int -> PartialGuild -> ShowS)
-> (PartialGuild -> String)
-> ([PartialGuild] -> ShowS)
-> Show PartialGuild
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartialGuild] -> ShowS
$cshowList :: [PartialGuild] -> ShowS
show :: PartialGuild -> String
$cshow :: PartialGuild -> String
showsPrec :: Int -> PartialGuild -> ShowS
$cshowsPrec :: Int -> PartialGuild -> ShowS
Show, ReadPrec [PartialGuild]
ReadPrec PartialGuild
Int -> ReadS PartialGuild
ReadS [PartialGuild]
(Int -> ReadS PartialGuild)
-> ReadS [PartialGuild]
-> ReadPrec PartialGuild
-> ReadPrec [PartialGuild]
-> Read PartialGuild
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PartialGuild]
$creadListPrec :: ReadPrec [PartialGuild]
readPrec :: ReadPrec PartialGuild
$creadPrec :: ReadPrec PartialGuild
readList :: ReadS [PartialGuild]
$creadList :: ReadS [PartialGuild]
readsPrec :: Int -> ReadS PartialGuild
$creadsPrec :: Int -> ReadS PartialGuild
Read, PartialGuild -> PartialGuild -> Bool
(PartialGuild -> PartialGuild -> Bool)
-> (PartialGuild -> PartialGuild -> Bool) -> Eq PartialGuild
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartialGuild -> PartialGuild -> Bool
$c/= :: PartialGuild -> PartialGuild -> Bool
== :: PartialGuild -> PartialGuild -> Bool
$c== :: PartialGuild -> PartialGuild -> Bool
Eq, Eq PartialGuild
Eq PartialGuild
-> (PartialGuild -> PartialGuild -> Ordering)
-> (PartialGuild -> PartialGuild -> Bool)
-> (PartialGuild -> PartialGuild -> Bool)
-> (PartialGuild -> PartialGuild -> Bool)
-> (PartialGuild -> PartialGuild -> Bool)
-> (PartialGuild -> PartialGuild -> PartialGuild)
-> (PartialGuild -> PartialGuild -> PartialGuild)
-> Ord PartialGuild
PartialGuild -> PartialGuild -> Bool
PartialGuild -> PartialGuild -> Ordering
PartialGuild -> PartialGuild -> PartialGuild
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PartialGuild -> PartialGuild -> PartialGuild
$cmin :: PartialGuild -> PartialGuild -> PartialGuild
max :: PartialGuild -> PartialGuild -> PartialGuild
$cmax :: PartialGuild -> PartialGuild -> PartialGuild
>= :: PartialGuild -> PartialGuild -> Bool
$c>= :: PartialGuild -> PartialGuild -> Bool
> :: PartialGuild -> PartialGuild -> Bool
$c> :: PartialGuild -> PartialGuild -> Bool
<= :: PartialGuild -> PartialGuild -> Bool
$c<= :: PartialGuild -> PartialGuild -> Bool
< :: PartialGuild -> PartialGuild -> Bool
$c< :: PartialGuild -> PartialGuild -> Bool
compare :: PartialGuild -> PartialGuild -> Ordering
$ccompare :: PartialGuild -> PartialGuild -> Ordering
$cp1Ord :: Eq PartialGuild
Ord)

instance FromJSON PartialGuild where
  parseJSON :: Value -> Parser PartialGuild
parseJSON = String
-> (Object -> Parser PartialGuild) -> Value -> Parser PartialGuild
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PartialGuild" ((Object -> Parser PartialGuild) -> Value -> Parser PartialGuild)
-> (Object -> Parser PartialGuild) -> Value -> Parser PartialGuild
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    GuildId -> Text -> Maybe Text -> Bool -> Text -> PartialGuild
PartialGuild (GuildId -> Text -> Maybe Text -> Bool -> Text -> PartialGuild)
-> Parser GuildId
-> Parser (Text -> Maybe Text -> Bool -> Text -> PartialGuild)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser GuildId
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"id"
                 Parser (Text -> Maybe Text -> Bool -> Text -> PartialGuild)
-> Parser Text
-> Parser (Maybe Text -> Bool -> Text -> PartialGuild)
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 (Maybe Text -> Bool -> Text -> PartialGuild)
-> Parser (Maybe Text) -> Parser (Bool -> Text -> PartialGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"icon"
                 Parser (Bool -> Text -> PartialGuild)
-> Parser Bool -> Parser (Text -> PartialGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:?  Key
"owner" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
                 Parser (Text -> PartialGuild) -> Parser Text -> Parser PartialGuild
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
"permissions"


-- | Roles represent a set of permissions attached to a group of users. Roles have unique
--   names, colors, and can be "pinned" to the side bar, causing their members to be listed separately.
--   Roles are unique per guild, and can have separate permission profiles for the global context
--   (guild) and channel context.
data Role =
    Role {
        Role -> GuildId
roleId      :: RoleId -- ^ The role id
      , Role -> Text
roleName    :: T.Text                    -- ^ The role name
      , Role -> DiscordColor
roleColor   :: DiscordColor              -- ^ Integer representation of color code
      , Role -> Bool
roleHoist   :: Bool                      -- ^ If the role is pinned in the user listing
      , Role -> Integer
rolePos     :: Integer                   -- ^ Position of this role
      , Role -> Text
rolePerms   :: T.Text                    -- ^ Permission bit set
      , Role -> Bool
roleManaged :: Bool                      -- ^ Whether this role is managed by an integration
      , Role -> Bool
roleMention :: Bool                      -- ^ Whether this role is mentionable
    } deriving (Int -> Role -> ShowS
[Role] -> ShowS
Role -> String
(Int -> Role -> ShowS)
-> (Role -> String) -> ([Role] -> ShowS) -> Show Role
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Role] -> ShowS
$cshowList :: [Role] -> ShowS
show :: Role -> String
$cshow :: Role -> String
showsPrec :: Int -> Role -> ShowS
$cshowsPrec :: Int -> Role -> ShowS
Show, ReadPrec [Role]
ReadPrec Role
Int -> ReadS Role
ReadS [Role]
(Int -> ReadS Role)
-> ReadS [Role] -> ReadPrec Role -> ReadPrec [Role] -> Read Role
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Role]
$creadListPrec :: ReadPrec [Role]
readPrec :: ReadPrec Role
$creadPrec :: ReadPrec Role
readList :: ReadS [Role]
$creadList :: ReadS [Role]
readsPrec :: Int -> ReadS Role
$creadsPrec :: Int -> ReadS Role
Read, Role -> Role -> Bool
(Role -> Role -> Bool) -> (Role -> Role -> Bool) -> Eq Role
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Role -> Role -> Bool
$c/= :: Role -> Role -> Bool
== :: Role -> Role -> Bool
$c== :: Role -> Role -> Bool
Eq, Eq Role
Eq Role
-> (Role -> Role -> Ordering)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Role)
-> (Role -> Role -> Role)
-> Ord Role
Role -> Role -> Bool
Role -> Role -> Ordering
Role -> Role -> Role
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Role -> Role -> Role
$cmin :: Role -> Role -> Role
max :: Role -> Role -> Role
$cmax :: Role -> Role -> Role
>= :: Role -> Role -> Bool
$c>= :: Role -> Role -> Bool
> :: Role -> Role -> Bool
$c> :: Role -> Role -> Bool
<= :: Role -> Role -> Bool
$c<= :: Role -> Role -> Bool
< :: Role -> Role -> Bool
$c< :: Role -> Role -> Bool
compare :: Role -> Role -> Ordering
$ccompare :: Role -> Role -> Ordering
$cp1Ord :: Eq Role
Ord)

instance FromJSON Role where
  parseJSON :: Value -> Parser Role
parseJSON = String -> (Object -> Parser Role) -> Value -> Parser Role
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Role" ((Object -> Parser Role) -> Value -> Parser Role)
-> (Object -> Parser Role) -> Value -> Parser Role
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    GuildId
-> Text
-> DiscordColor
-> Bool
-> Integer
-> Text
-> Bool
-> Bool
-> Role
Role (GuildId
 -> Text
 -> DiscordColor
 -> Bool
 -> Integer
 -> Text
 -> Bool
 -> Bool
 -> Role)
-> Parser GuildId
-> Parser
     (Text
      -> DiscordColor -> Bool -> Integer -> Text -> Bool -> Bool -> Role)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser GuildId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
         Parser
  (Text
   -> DiscordColor -> Bool -> Integer -> Text -> Bool -> Bool -> Role)
-> Parser Text
-> Parser
     (DiscordColor -> Bool -> Integer -> Text -> Bool -> Bool -> Role)
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
  (DiscordColor -> Bool -> Integer -> Text -> Bool -> Bool -> Role)
-> Parser DiscordColor
-> Parser (Bool -> Integer -> Text -> Bool -> Bool -> Role)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser DiscordColor
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"color"
         Parser (Bool -> Integer -> Text -> Bool -> Bool -> Role)
-> Parser Bool -> Parser (Integer -> Text -> Bool -> Bool -> Role)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hoist"
         Parser (Integer -> Text -> Bool -> Bool -> Role)
-> Parser Integer -> Parser (Text -> Bool -> Bool -> Role)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"position"
         Parser (Text -> Bool -> Bool -> Role)
-> Parser Text -> Parser (Bool -> Bool -> Role)
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
"permissions"
         Parser (Bool -> Bool -> Role)
-> Parser Bool -> Parser (Bool -> Role)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"managed"
         Parser (Bool -> Role) -> Parser Bool -> Parser Role
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mentionable"

-- | VoiceRegion is only refrenced in Guild endpoints, will be moved when voice support is added
data VoiceRegion = VoiceRegion
      { VoiceRegion -> Text
voiceRegionId          :: T.Text      -- ^ Unique id of the region
      , VoiceRegion -> Text
voiceRegionName        :: T.Text      -- ^ Name of the region
      , VoiceRegion -> Bool
voiceRegionVip         :: Bool        -- ^ True if this is a VIP only server
      , VoiceRegion -> Bool
voiceRegionOptimal     :: Bool        -- ^ True for the closest server to a client
      , VoiceRegion -> Bool
voiceRegionDeprecated  :: Bool        -- ^ Whether this is a deprecated region
      , VoiceRegion -> Bool
voiceRegionCustom      :: Bool        -- ^ Whether this is a custom region
      } deriving (Int -> VoiceRegion -> ShowS
[VoiceRegion] -> ShowS
VoiceRegion -> String
(Int -> VoiceRegion -> ShowS)
-> (VoiceRegion -> String)
-> ([VoiceRegion] -> ShowS)
-> Show VoiceRegion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VoiceRegion] -> ShowS
$cshowList :: [VoiceRegion] -> ShowS
show :: VoiceRegion -> String
$cshow :: VoiceRegion -> String
showsPrec :: Int -> VoiceRegion -> ShowS
$cshowsPrec :: Int -> VoiceRegion -> ShowS
Show, ReadPrec [VoiceRegion]
ReadPrec VoiceRegion
Int -> ReadS VoiceRegion
ReadS [VoiceRegion]
(Int -> ReadS VoiceRegion)
-> ReadS [VoiceRegion]
-> ReadPrec VoiceRegion
-> ReadPrec [VoiceRegion]
-> Read VoiceRegion
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VoiceRegion]
$creadListPrec :: ReadPrec [VoiceRegion]
readPrec :: ReadPrec VoiceRegion
$creadPrec :: ReadPrec VoiceRegion
readList :: ReadS [VoiceRegion]
$creadList :: ReadS [VoiceRegion]
readsPrec :: Int -> ReadS VoiceRegion
$creadsPrec :: Int -> ReadS VoiceRegion
Read, VoiceRegion -> VoiceRegion -> Bool
(VoiceRegion -> VoiceRegion -> Bool)
-> (VoiceRegion -> VoiceRegion -> Bool) -> Eq VoiceRegion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VoiceRegion -> VoiceRegion -> Bool
$c/= :: VoiceRegion -> VoiceRegion -> Bool
== :: VoiceRegion -> VoiceRegion -> Bool
$c== :: VoiceRegion -> VoiceRegion -> Bool
Eq, Eq VoiceRegion
Eq VoiceRegion
-> (VoiceRegion -> VoiceRegion -> Ordering)
-> (VoiceRegion -> VoiceRegion -> Bool)
-> (VoiceRegion -> VoiceRegion -> Bool)
-> (VoiceRegion -> VoiceRegion -> Bool)
-> (VoiceRegion -> VoiceRegion -> Bool)
-> (VoiceRegion -> VoiceRegion -> VoiceRegion)
-> (VoiceRegion -> VoiceRegion -> VoiceRegion)
-> Ord VoiceRegion
VoiceRegion -> VoiceRegion -> Bool
VoiceRegion -> VoiceRegion -> Ordering
VoiceRegion -> VoiceRegion -> VoiceRegion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VoiceRegion -> VoiceRegion -> VoiceRegion
$cmin :: VoiceRegion -> VoiceRegion -> VoiceRegion
max :: VoiceRegion -> VoiceRegion -> VoiceRegion
$cmax :: VoiceRegion -> VoiceRegion -> VoiceRegion
>= :: VoiceRegion -> VoiceRegion -> Bool
$c>= :: VoiceRegion -> VoiceRegion -> Bool
> :: VoiceRegion -> VoiceRegion -> Bool
$c> :: VoiceRegion -> VoiceRegion -> Bool
<= :: VoiceRegion -> VoiceRegion -> Bool
$c<= :: VoiceRegion -> VoiceRegion -> Bool
< :: VoiceRegion -> VoiceRegion -> Bool
$c< :: VoiceRegion -> VoiceRegion -> Bool
compare :: VoiceRegion -> VoiceRegion -> Ordering
$ccompare :: VoiceRegion -> VoiceRegion -> Ordering
$cp1Ord :: Eq VoiceRegion
Ord)

instance FromJSON VoiceRegion where
  parseJSON :: Value -> Parser VoiceRegion
parseJSON = String
-> (Object -> Parser VoiceRegion) -> Value -> Parser VoiceRegion
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"VoiceRegion" ((Object -> Parser VoiceRegion) -> Value -> Parser VoiceRegion)
-> (Object -> Parser VoiceRegion) -> Value -> Parser VoiceRegion
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> Bool -> Bool -> Bool -> Bool -> VoiceRegion
VoiceRegion (Text -> Text -> Bool -> Bool -> Bool -> Bool -> VoiceRegion)
-> Parser Text
-> Parser (Text -> Bool -> Bool -> Bool -> Bool -> VoiceRegion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
                Parser (Text -> Bool -> Bool -> Bool -> Bool -> VoiceRegion)
-> Parser Text
-> Parser (Bool -> Bool -> Bool -> Bool -> VoiceRegion)
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 (Bool -> Bool -> Bool -> Bool -> VoiceRegion)
-> Parser Bool -> Parser (Bool -> Bool -> Bool -> VoiceRegion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"vip"
                Parser (Bool -> Bool -> Bool -> VoiceRegion)
-> Parser Bool -> Parser (Bool -> Bool -> VoiceRegion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"optimal"
                Parser (Bool -> Bool -> VoiceRegion)
-> Parser Bool -> Parser (Bool -> VoiceRegion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"deprecated"
                Parser (Bool -> VoiceRegion) -> Parser Bool -> Parser VoiceRegion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"custom"

-- | Info about a Ban
data GuildBan = GuildBan
      { GuildBan -> Text
guildBanReason  :: T.Text
      , GuildBan -> User
guildBanUser    :: User
      } deriving (Int -> GuildBan -> ShowS
[GuildBan] -> ShowS
GuildBan -> String
(Int -> GuildBan -> ShowS)
-> (GuildBan -> String) -> ([GuildBan] -> ShowS) -> Show GuildBan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuildBan] -> ShowS
$cshowList :: [GuildBan] -> ShowS
show :: GuildBan -> String
$cshow :: GuildBan -> String
showsPrec :: Int -> GuildBan -> ShowS
$cshowsPrec :: Int -> GuildBan -> ShowS
Show, ReadPrec [GuildBan]
ReadPrec GuildBan
Int -> ReadS GuildBan
ReadS [GuildBan]
(Int -> ReadS GuildBan)
-> ReadS [GuildBan]
-> ReadPrec GuildBan
-> ReadPrec [GuildBan]
-> Read GuildBan
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GuildBan]
$creadListPrec :: ReadPrec [GuildBan]
readPrec :: ReadPrec GuildBan
$creadPrec :: ReadPrec GuildBan
readList :: ReadS [GuildBan]
$creadList :: ReadS [GuildBan]
readsPrec :: Int -> ReadS GuildBan
$creadsPrec :: Int -> ReadS GuildBan
Read, GuildBan -> GuildBan -> Bool
(GuildBan -> GuildBan -> Bool)
-> (GuildBan -> GuildBan -> Bool) -> Eq GuildBan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GuildBan -> GuildBan -> Bool
$c/= :: GuildBan -> GuildBan -> Bool
== :: GuildBan -> GuildBan -> Bool
$c== :: GuildBan -> GuildBan -> Bool
Eq, Eq GuildBan
Eq GuildBan
-> (GuildBan -> GuildBan -> Ordering)
-> (GuildBan -> GuildBan -> Bool)
-> (GuildBan -> GuildBan -> Bool)
-> (GuildBan -> GuildBan -> Bool)
-> (GuildBan -> GuildBan -> Bool)
-> (GuildBan -> GuildBan -> GuildBan)
-> (GuildBan -> GuildBan -> GuildBan)
-> Ord GuildBan
GuildBan -> GuildBan -> Bool
GuildBan -> GuildBan -> Ordering
GuildBan -> GuildBan -> GuildBan
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GuildBan -> GuildBan -> GuildBan
$cmin :: GuildBan -> GuildBan -> GuildBan
max :: GuildBan -> GuildBan -> GuildBan
$cmax :: GuildBan -> GuildBan -> GuildBan
>= :: GuildBan -> GuildBan -> Bool
$c>= :: GuildBan -> GuildBan -> Bool
> :: GuildBan -> GuildBan -> Bool
$c> :: GuildBan -> GuildBan -> Bool
<= :: GuildBan -> GuildBan -> Bool
$c<= :: GuildBan -> GuildBan -> Bool
< :: GuildBan -> GuildBan -> Bool
$c< :: GuildBan -> GuildBan -> Bool
compare :: GuildBan -> GuildBan -> Ordering
$ccompare :: GuildBan -> GuildBan -> Ordering
$cp1Ord :: Eq GuildBan
Ord)

instance FromJSON GuildBan where
  parseJSON :: Value -> Parser GuildBan
parseJSON = String -> (Object -> Parser GuildBan) -> Value -> Parser GuildBan
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GuildBan" ((Object -> Parser GuildBan) -> Value -> Parser GuildBan)
-> (Object -> Parser GuildBan) -> Value -> Parser GuildBan
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> User -> GuildBan
GuildBan (Text -> User -> GuildBan)
-> Parser Text -> Parser (User -> GuildBan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reason" Parser (User -> GuildBan) -> Parser User -> Parser GuildBan
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser User
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"

-- | Represents a code to add a user to a guild
data Invite = Invite
      { Invite -> Text
inviteCode  :: T.Text    -- ^ The invite code
      , Invite -> Maybe GuildId
inviteGuildId :: Maybe GuildId -- ^ The guild the code will invite to
      , Invite -> GuildId
inviteChannelId :: ChannelId -- ^ The channel the code will invite to
      } deriving (Int -> Invite -> ShowS
[Invite] -> ShowS
Invite -> String
(Int -> Invite -> ShowS)
-> (Invite -> String) -> ([Invite] -> ShowS) -> Show Invite
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Invite] -> ShowS
$cshowList :: [Invite] -> ShowS
show :: Invite -> String
$cshow :: Invite -> String
showsPrec :: Int -> Invite -> ShowS
$cshowsPrec :: Int -> Invite -> ShowS
Show, ReadPrec [Invite]
ReadPrec Invite
Int -> ReadS Invite
ReadS [Invite]
(Int -> ReadS Invite)
-> ReadS [Invite]
-> ReadPrec Invite
-> ReadPrec [Invite]
-> Read Invite
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Invite]
$creadListPrec :: ReadPrec [Invite]
readPrec :: ReadPrec Invite
$creadPrec :: ReadPrec Invite
readList :: ReadS [Invite]
$creadList :: ReadS [Invite]
readsPrec :: Int -> ReadS Invite
$creadsPrec :: Int -> ReadS Invite
Read, Invite -> Invite -> Bool
(Invite -> Invite -> Bool)
-> (Invite -> Invite -> Bool) -> Eq Invite
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Invite -> Invite -> Bool
$c/= :: Invite -> Invite -> Bool
== :: Invite -> Invite -> Bool
$c== :: Invite -> Invite -> Bool
Eq, Eq Invite
Eq Invite
-> (Invite -> Invite -> Ordering)
-> (Invite -> Invite -> Bool)
-> (Invite -> Invite -> Bool)
-> (Invite -> Invite -> Bool)
-> (Invite -> Invite -> Bool)
-> (Invite -> Invite -> Invite)
-> (Invite -> Invite -> Invite)
-> Ord Invite
Invite -> Invite -> Bool
Invite -> Invite -> Ordering
Invite -> Invite -> Invite
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Invite -> Invite -> Invite
$cmin :: Invite -> Invite -> Invite
max :: Invite -> Invite -> Invite
$cmax :: Invite -> Invite -> Invite
>= :: Invite -> Invite -> Bool
$c>= :: Invite -> Invite -> Bool
> :: Invite -> Invite -> Bool
$c> :: Invite -> Invite -> Bool
<= :: Invite -> Invite -> Bool
$c<= :: Invite -> Invite -> Bool
< :: Invite -> Invite -> Bool
$c< :: Invite -> Invite -> Bool
compare :: Invite -> Invite -> Ordering
$ccompare :: Invite -> Invite -> Ordering
$cp1Ord :: Eq Invite
Ord)

instance FromJSON Invite where
  parseJSON :: Value -> Parser Invite
parseJSON = String -> (Object -> Parser Invite) -> Value -> Parser Invite
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Invite" ((Object -> Parser Invite) -> Value -> Parser Invite)
-> (Object -> Parser Invite) -> Value -> Parser Invite
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Maybe GuildId -> GuildId -> Invite
Invite (Text -> Maybe GuildId -> GuildId -> Invite)
-> Parser Text -> Parser (Maybe GuildId -> GuildId -> Invite)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code"
           Parser (Maybe GuildId -> GuildId -> Invite)
-> Parser (Maybe GuildId) -> Parser (GuildId -> Invite)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (do Maybe Object
g <- Object
o Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"guild"
                   case Maybe Object
g of Just Object
g2 -> Object
g2 Object -> Key -> Parser (Maybe GuildId)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
                             Maybe Object
Nothing -> Maybe GuildId -> Parser (Maybe GuildId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe GuildId
forall a. Maybe a
Nothing)
           Parser (GuildId -> Invite) -> Parser GuildId -> Parser Invite
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"channel") Parser Object -> (Object -> Parser GuildId) -> Parser GuildId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser GuildId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"))

-- | Invite code with additional metadata
data InviteWithMeta = InviteWithMeta Invite InviteMeta

instance FromJSON InviteWithMeta where
  parseJSON :: Value -> Parser InviteWithMeta
parseJSON Value
ob = Invite -> InviteMeta -> InviteWithMeta
InviteWithMeta (Invite -> InviteMeta -> InviteWithMeta)
-> Parser Invite -> Parser (InviteMeta -> InviteWithMeta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Invite
forall a. FromJSON a => Value -> Parser a
parseJSON Value
ob Parser (InviteMeta -> InviteWithMeta)
-> Parser InviteMeta -> Parser InviteWithMeta
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser InviteMeta
forall a. FromJSON a => Value -> Parser a
parseJSON Value
ob

-- | Additional metadata about an invite.
data InviteMeta = InviteMeta
    { InviteMeta -> User
inviteCreator :: User    -- ^ The user that created the invite
    , InviteMeta -> Integer
inviteUses    :: Integer -- ^ Number of times the invite has been used
    , InviteMeta -> Integer
inviteMax     :: Integer -- ^ Max number of times the invite can be used
    , InviteMeta -> Integer
inviteAge     :: Integer -- ^ The duration (in seconds) after which the invite expires
    , InviteMeta -> Bool
inviteTemp    :: Bool    -- ^ Whether this invite only grants temporary membership
    , InviteMeta -> UTCTime
inviteCreated :: UTCTime -- ^ When the invite was created
    , InviteMeta -> Bool
inviteRevoked :: Bool    -- ^ If the invite is revoked
    } deriving (Int -> InviteMeta -> ShowS
[InviteMeta] -> ShowS
InviteMeta -> String
(Int -> InviteMeta -> ShowS)
-> (InviteMeta -> String)
-> ([InviteMeta] -> ShowS)
-> Show InviteMeta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InviteMeta] -> ShowS
$cshowList :: [InviteMeta] -> ShowS
show :: InviteMeta -> String
$cshow :: InviteMeta -> String
showsPrec :: Int -> InviteMeta -> ShowS
$cshowsPrec :: Int -> InviteMeta -> ShowS
Show, ReadPrec [InviteMeta]
ReadPrec InviteMeta
Int -> ReadS InviteMeta
ReadS [InviteMeta]
(Int -> ReadS InviteMeta)
-> ReadS [InviteMeta]
-> ReadPrec InviteMeta
-> ReadPrec [InviteMeta]
-> Read InviteMeta
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InviteMeta]
$creadListPrec :: ReadPrec [InviteMeta]
readPrec :: ReadPrec InviteMeta
$creadPrec :: ReadPrec InviteMeta
readList :: ReadS [InviteMeta]
$creadList :: ReadS [InviteMeta]
readsPrec :: Int -> ReadS InviteMeta
$creadsPrec :: Int -> ReadS InviteMeta
Read, InviteMeta -> InviteMeta -> Bool
(InviteMeta -> InviteMeta -> Bool)
-> (InviteMeta -> InviteMeta -> Bool) -> Eq InviteMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InviteMeta -> InviteMeta -> Bool
$c/= :: InviteMeta -> InviteMeta -> Bool
== :: InviteMeta -> InviteMeta -> Bool
$c== :: InviteMeta -> InviteMeta -> Bool
Eq, Eq InviteMeta
Eq InviteMeta
-> (InviteMeta -> InviteMeta -> Ordering)
-> (InviteMeta -> InviteMeta -> Bool)
-> (InviteMeta -> InviteMeta -> Bool)
-> (InviteMeta -> InviteMeta -> Bool)
-> (InviteMeta -> InviteMeta -> Bool)
-> (InviteMeta -> InviteMeta -> InviteMeta)
-> (InviteMeta -> InviteMeta -> InviteMeta)
-> Ord InviteMeta
InviteMeta -> InviteMeta -> Bool
InviteMeta -> InviteMeta -> Ordering
InviteMeta -> InviteMeta -> InviteMeta
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InviteMeta -> InviteMeta -> InviteMeta
$cmin :: InviteMeta -> InviteMeta -> InviteMeta
max :: InviteMeta -> InviteMeta -> InviteMeta
$cmax :: InviteMeta -> InviteMeta -> InviteMeta
>= :: InviteMeta -> InviteMeta -> Bool
$c>= :: InviteMeta -> InviteMeta -> Bool
> :: InviteMeta -> InviteMeta -> Bool
$c> :: InviteMeta -> InviteMeta -> Bool
<= :: InviteMeta -> InviteMeta -> Bool
$c<= :: InviteMeta -> InviteMeta -> Bool
< :: InviteMeta -> InviteMeta -> Bool
$c< :: InviteMeta -> InviteMeta -> Bool
compare :: InviteMeta -> InviteMeta -> Ordering
$ccompare :: InviteMeta -> InviteMeta -> Ordering
$cp1Ord :: Eq InviteMeta
Ord)

instance FromJSON InviteMeta where
  parseJSON :: Value -> Parser InviteMeta
parseJSON = String
-> (Object -> Parser InviteMeta) -> Value -> Parser InviteMeta
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"InviteMeta" ((Object -> Parser InviteMeta) -> Value -> Parser InviteMeta)
-> (Object -> Parser InviteMeta) -> Value -> Parser InviteMeta
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    User
-> Integer
-> Integer
-> Integer
-> Bool
-> UTCTime
-> Bool
-> InviteMeta
InviteMeta (User
 -> Integer
 -> Integer
 -> Integer
 -> Bool
 -> UTCTime
 -> Bool
 -> InviteMeta)
-> Parser User
-> Parser
     (Integer
      -> Integer -> Integer -> Bool -> UTCTime -> Bool -> InviteMeta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser User
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"inviter"
               Parser
  (Integer
   -> Integer -> Integer -> Bool -> UTCTime -> Bool -> InviteMeta)
-> Parser Integer
-> Parser
     (Integer -> Integer -> Bool -> UTCTime -> Bool -> InviteMeta)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"uses"
               Parser
  (Integer -> Integer -> Bool -> UTCTime -> Bool -> InviteMeta)
-> Parser Integer
-> Parser (Integer -> Bool -> UTCTime -> Bool -> InviteMeta)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"max_uses"
               Parser (Integer -> Bool -> UTCTime -> Bool -> InviteMeta)
-> Parser Integer -> Parser (Bool -> UTCTime -> Bool -> InviteMeta)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"max_age"
               Parser (Bool -> UTCTime -> Bool -> InviteMeta)
-> Parser Bool -> Parser (UTCTime -> Bool -> InviteMeta)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"temporary"
               Parser (UTCTime -> Bool -> InviteMeta)
-> Parser UTCTime -> Parser (Bool -> InviteMeta)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
               Parser (Bool -> InviteMeta) -> Parser Bool -> Parser InviteMeta
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"revoked"

-- | Represents the behavior of a third party account link.
data Integration = Integration
      { Integration -> GuildId
integrationId       :: !Snowflake -- ^ Integration id
      , Integration -> Text
integrationName     :: T.Text                    -- ^ Integration name
      , Integration -> Text
integrationType     :: T.Text                    -- ^ Integration type (Twitch, Youtube, ect.)
      , Integration -> Bool
integrationEnabled  :: Bool                      -- ^ Is the integration enabled
      , Integration -> Bool
integrationSyncing  :: Bool                      -- ^ Is the integration syncing
      , Integration -> GuildId
integrationRole     :: RoleId                 -- ^ Id the integration uses for "subscribers"
      , Integration -> Integer
integrationBehavior :: Integer                   -- ^ The behavior of expiring subscribers
      , Integration -> Integer
integrationGrace    :: Integer                   -- ^ The grace period before expiring subscribers
      , Integration -> User
integrationOwner    :: User                      -- ^ The user of the integration
      , Integration -> IntegrationAccount
integrationAccount  :: IntegrationAccount        -- ^ The account the integration links to
      , Integration -> UTCTime
integrationSync     :: UTCTime                   -- ^ When the integration was last synced
      } deriving (Int -> Integration -> ShowS
[Integration] -> ShowS
Integration -> String
(Int -> Integration -> ShowS)
-> (Integration -> String)
-> ([Integration] -> ShowS)
-> Show Integration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Integration] -> ShowS
$cshowList :: [Integration] -> ShowS
show :: Integration -> String
$cshow :: Integration -> String
showsPrec :: Int -> Integration -> ShowS
$cshowsPrec :: Int -> Integration -> ShowS
Show, ReadPrec [Integration]
ReadPrec Integration
Int -> ReadS Integration
ReadS [Integration]
(Int -> ReadS Integration)
-> ReadS [Integration]
-> ReadPrec Integration
-> ReadPrec [Integration]
-> Read Integration
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Integration]
$creadListPrec :: ReadPrec [Integration]
readPrec :: ReadPrec Integration
$creadPrec :: ReadPrec Integration
readList :: ReadS [Integration]
$creadList :: ReadS [Integration]
readsPrec :: Int -> ReadS Integration
$creadsPrec :: Int -> ReadS Integration
Read, Integration -> Integration -> Bool
(Integration -> Integration -> Bool)
-> (Integration -> Integration -> Bool) -> Eq Integration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Integration -> Integration -> Bool
$c/= :: Integration -> Integration -> Bool
== :: Integration -> Integration -> Bool
$c== :: Integration -> Integration -> Bool
Eq, Eq Integration
Eq Integration
-> (Integration -> Integration -> Ordering)
-> (Integration -> Integration -> Bool)
-> (Integration -> Integration -> Bool)
-> (Integration -> Integration -> Bool)
-> (Integration -> Integration -> Bool)
-> (Integration -> Integration -> Integration)
-> (Integration -> Integration -> Integration)
-> Ord Integration
Integration -> Integration -> Bool
Integration -> Integration -> Ordering
Integration -> Integration -> Integration
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Integration -> Integration -> Integration
$cmin :: Integration -> Integration -> Integration
max :: Integration -> Integration -> Integration
$cmax :: Integration -> Integration -> Integration
>= :: Integration -> Integration -> Bool
$c>= :: Integration -> Integration -> Bool
> :: Integration -> Integration -> Bool
$c> :: Integration -> Integration -> Bool
<= :: Integration -> Integration -> Bool
$c<= :: Integration -> Integration -> Bool
< :: Integration -> Integration -> Bool
$c< :: Integration -> Integration -> Bool
compare :: Integration -> Integration -> Ordering
$ccompare :: Integration -> Integration -> Ordering
$cp1Ord :: Eq Integration
Ord)

instance FromJSON Integration where
  parseJSON :: Value -> Parser Integration
parseJSON = String
-> (Object -> Parser Integration) -> Value -> Parser Integration
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Integration" ((Object -> Parser Integration) -> Value -> Parser Integration)
-> (Object -> Parser Integration) -> Value -> Parser Integration
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    GuildId
-> Text
-> Text
-> Bool
-> Bool
-> GuildId
-> Integer
-> Integer
-> User
-> IntegrationAccount
-> UTCTime
-> Integration
Integration (GuildId
 -> Text
 -> Text
 -> Bool
 -> Bool
 -> GuildId
 -> Integer
 -> Integer
 -> User
 -> IntegrationAccount
 -> UTCTime
 -> Integration)
-> Parser GuildId
-> Parser
     (Text
      -> Text
      -> Bool
      -> Bool
      -> GuildId
      -> Integer
      -> Integer
      -> User
      -> IntegrationAccount
      -> UTCTime
      -> Integration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser GuildId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
                Parser
  (Text
   -> Text
   -> Bool
   -> Bool
   -> GuildId
   -> Integer
   -> Integer
   -> User
   -> IntegrationAccount
   -> UTCTime
   -> Integration)
-> Parser Text
-> Parser
     (Text
      -> Bool
      -> Bool
      -> GuildId
      -> Integer
      -> Integer
      -> User
      -> IntegrationAccount
      -> UTCTime
      -> Integration)
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
  (Text
   -> Bool
   -> Bool
   -> GuildId
   -> Integer
   -> Integer
   -> User
   -> IntegrationAccount
   -> UTCTime
   -> Integration)
-> Parser Text
-> Parser
     (Bool
      -> Bool
      -> GuildId
      -> Integer
      -> Integer
      -> User
      -> IntegrationAccount
      -> UTCTime
      -> Integration)
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
"type"
                Parser
  (Bool
   -> Bool
   -> GuildId
   -> Integer
   -> Integer
   -> User
   -> IntegrationAccount
   -> UTCTime
   -> Integration)
-> Parser Bool
-> Parser
     (Bool
      -> GuildId
      -> Integer
      -> Integer
      -> User
      -> IntegrationAccount
      -> UTCTime
      -> Integration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"enabled"
                Parser
  (Bool
   -> GuildId
   -> Integer
   -> Integer
   -> User
   -> IntegrationAccount
   -> UTCTime
   -> Integration)
-> Parser Bool
-> Parser
     (GuildId
      -> Integer
      -> Integer
      -> User
      -> IntegrationAccount
      -> UTCTime
      -> Integration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"syncing"
                Parser
  (GuildId
   -> Integer
   -> Integer
   -> User
   -> IntegrationAccount
   -> UTCTime
   -> Integration)
-> Parser GuildId
-> Parser
     (Integer
      -> Integer -> User -> IntegrationAccount -> UTCTime -> Integration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser GuildId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"role_id"
                Parser
  (Integer
   -> Integer -> User -> IntegrationAccount -> UTCTime -> Integration)
-> Parser Integer
-> Parser
     (Integer -> User -> IntegrationAccount -> UTCTime -> Integration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expire_behavior"
                Parser
  (Integer -> User -> IntegrationAccount -> UTCTime -> Integration)
-> Parser Integer
-> Parser (User -> IntegrationAccount -> UTCTime -> Integration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expire_grace_period"
                Parser (User -> IntegrationAccount -> UTCTime -> Integration)
-> Parser User
-> Parser (IntegrationAccount -> UTCTime -> Integration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser User
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
                Parser (IntegrationAccount -> UTCTime -> Integration)
-> Parser IntegrationAccount -> Parser (UTCTime -> Integration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser IntegrationAccount
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"account"
                Parser (UTCTime -> Integration)
-> Parser UTCTime -> Parser Integration
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"synced_at"

-- | Represents a third party account link.
data IntegrationAccount = IntegrationAccount
    { IntegrationAccount -> Text
accountId   :: T.Text -- ^ The id of the account.
    , IntegrationAccount -> Text
accountName :: T.Text -- ^ The name of the account.
    } deriving (Int -> IntegrationAccount -> ShowS
[IntegrationAccount] -> ShowS
IntegrationAccount -> String
(Int -> IntegrationAccount -> ShowS)
-> (IntegrationAccount -> String)
-> ([IntegrationAccount] -> ShowS)
-> Show IntegrationAccount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IntegrationAccount] -> ShowS
$cshowList :: [IntegrationAccount] -> ShowS
show :: IntegrationAccount -> String
$cshow :: IntegrationAccount -> String
showsPrec :: Int -> IntegrationAccount -> ShowS
$cshowsPrec :: Int -> IntegrationAccount -> ShowS
Show, ReadPrec [IntegrationAccount]
ReadPrec IntegrationAccount
Int -> ReadS IntegrationAccount
ReadS [IntegrationAccount]
(Int -> ReadS IntegrationAccount)
-> ReadS [IntegrationAccount]
-> ReadPrec IntegrationAccount
-> ReadPrec [IntegrationAccount]
-> Read IntegrationAccount
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IntegrationAccount]
$creadListPrec :: ReadPrec [IntegrationAccount]
readPrec :: ReadPrec IntegrationAccount
$creadPrec :: ReadPrec IntegrationAccount
readList :: ReadS [IntegrationAccount]
$creadList :: ReadS [IntegrationAccount]
readsPrec :: Int -> ReadS IntegrationAccount
$creadsPrec :: Int -> ReadS IntegrationAccount
Read, IntegrationAccount -> IntegrationAccount -> Bool
(IntegrationAccount -> IntegrationAccount -> Bool)
-> (IntegrationAccount -> IntegrationAccount -> Bool)
-> Eq IntegrationAccount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntegrationAccount -> IntegrationAccount -> Bool
$c/= :: IntegrationAccount -> IntegrationAccount -> Bool
== :: IntegrationAccount -> IntegrationAccount -> Bool
$c== :: IntegrationAccount -> IntegrationAccount -> Bool
Eq, Eq IntegrationAccount
Eq IntegrationAccount
-> (IntegrationAccount -> IntegrationAccount -> Ordering)
-> (IntegrationAccount -> IntegrationAccount -> Bool)
-> (IntegrationAccount -> IntegrationAccount -> Bool)
-> (IntegrationAccount -> IntegrationAccount -> Bool)
-> (IntegrationAccount -> IntegrationAccount -> Bool)
-> (IntegrationAccount -> IntegrationAccount -> IntegrationAccount)
-> (IntegrationAccount -> IntegrationAccount -> IntegrationAccount)
-> Ord IntegrationAccount
IntegrationAccount -> IntegrationAccount -> Bool
IntegrationAccount -> IntegrationAccount -> Ordering
IntegrationAccount -> IntegrationAccount -> IntegrationAccount
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IntegrationAccount -> IntegrationAccount -> IntegrationAccount
$cmin :: IntegrationAccount -> IntegrationAccount -> IntegrationAccount
max :: IntegrationAccount -> IntegrationAccount -> IntegrationAccount
$cmax :: IntegrationAccount -> IntegrationAccount -> IntegrationAccount
>= :: IntegrationAccount -> IntegrationAccount -> Bool
$c>= :: IntegrationAccount -> IntegrationAccount -> Bool
> :: IntegrationAccount -> IntegrationAccount -> Bool
$c> :: IntegrationAccount -> IntegrationAccount -> Bool
<= :: IntegrationAccount -> IntegrationAccount -> Bool
$c<= :: IntegrationAccount -> IntegrationAccount -> Bool
< :: IntegrationAccount -> IntegrationAccount -> Bool
$c< :: IntegrationAccount -> IntegrationAccount -> Bool
compare :: IntegrationAccount -> IntegrationAccount -> Ordering
$ccompare :: IntegrationAccount -> IntegrationAccount -> Ordering
$cp1Ord :: Eq IntegrationAccount
Ord)

instance FromJSON IntegrationAccount where
  parseJSON :: Value -> Parser IntegrationAccount
parseJSON = String
-> (Object -> Parser IntegrationAccount)
-> Value
-> Parser IntegrationAccount
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"IntegrationAccount" ((Object -> Parser IntegrationAccount)
 -> Value -> Parser IntegrationAccount)
-> (Object -> Parser IntegrationAccount)
-> Value
-> Parser IntegrationAccount
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> IntegrationAccount
IntegrationAccount (Text -> Text -> IntegrationAccount)
-> Parser Text -> Parser (Text -> IntegrationAccount)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id" Parser (Text -> IntegrationAccount)
-> Parser Text -> Parser IntegrationAccount
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"

-- | Represents an image to be used in third party sites to link to a discord channel
data GuildWidget = GuildWidget
      { GuildWidget -> Bool
widgetEnabled :: Bool      -- ^ Whether the widget is enabled
      , GuildWidget -> GuildId
widgetChannelId :: ChannelId -- ^ The widget channel id
      } deriving (Int -> GuildWidget -> ShowS
[GuildWidget] -> ShowS
GuildWidget -> String
(Int -> GuildWidget -> ShowS)
-> (GuildWidget -> String)
-> ([GuildWidget] -> ShowS)
-> Show GuildWidget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuildWidget] -> ShowS
$cshowList :: [GuildWidget] -> ShowS
show :: GuildWidget -> String
$cshow :: GuildWidget -> String
showsPrec :: Int -> GuildWidget -> ShowS
$cshowsPrec :: Int -> GuildWidget -> ShowS
Show, ReadPrec [GuildWidget]
ReadPrec GuildWidget
Int -> ReadS GuildWidget
ReadS [GuildWidget]
(Int -> ReadS GuildWidget)
-> ReadS [GuildWidget]
-> ReadPrec GuildWidget
-> ReadPrec [GuildWidget]
-> Read GuildWidget
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GuildWidget]
$creadListPrec :: ReadPrec [GuildWidget]
readPrec :: ReadPrec GuildWidget
$creadPrec :: ReadPrec GuildWidget
readList :: ReadS [GuildWidget]
$creadList :: ReadS [GuildWidget]
readsPrec :: Int -> ReadS GuildWidget
$creadsPrec :: Int -> ReadS GuildWidget
Read, GuildWidget -> GuildWidget -> Bool
(GuildWidget -> GuildWidget -> Bool)
-> (GuildWidget -> GuildWidget -> Bool) -> Eq GuildWidget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GuildWidget -> GuildWidget -> Bool
$c/= :: GuildWidget -> GuildWidget -> Bool
== :: GuildWidget -> GuildWidget -> Bool
$c== :: GuildWidget -> GuildWidget -> Bool
Eq, Eq GuildWidget
Eq GuildWidget
-> (GuildWidget -> GuildWidget -> Ordering)
-> (GuildWidget -> GuildWidget -> Bool)
-> (GuildWidget -> GuildWidget -> Bool)
-> (GuildWidget -> GuildWidget -> Bool)
-> (GuildWidget -> GuildWidget -> Bool)
-> (GuildWidget -> GuildWidget -> GuildWidget)
-> (GuildWidget -> GuildWidget -> GuildWidget)
-> Ord GuildWidget
GuildWidget -> GuildWidget -> Bool
GuildWidget -> GuildWidget -> Ordering
GuildWidget -> GuildWidget -> GuildWidget
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GuildWidget -> GuildWidget -> GuildWidget
$cmin :: GuildWidget -> GuildWidget -> GuildWidget
max :: GuildWidget -> GuildWidget -> GuildWidget
$cmax :: GuildWidget -> GuildWidget -> GuildWidget
>= :: GuildWidget -> GuildWidget -> Bool
$c>= :: GuildWidget -> GuildWidget -> Bool
> :: GuildWidget -> GuildWidget -> Bool
$c> :: GuildWidget -> GuildWidget -> Bool
<= :: GuildWidget -> GuildWidget -> Bool
$c<= :: GuildWidget -> GuildWidget -> Bool
< :: GuildWidget -> GuildWidget -> Bool
$c< :: GuildWidget -> GuildWidget -> Bool
compare :: GuildWidget -> GuildWidget -> Ordering
$ccompare :: GuildWidget -> GuildWidget -> Ordering
$cp1Ord :: Eq GuildWidget
Ord)

instance FromJSON GuildWidget where
  parseJSON :: Value -> Parser GuildWidget
parseJSON = String
-> (Object -> Parser GuildWidget) -> Value -> Parser GuildWidget
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GuildWidget" ((Object -> Parser GuildWidget) -> Value -> Parser GuildWidget)
-> (Object -> Parser GuildWidget) -> Value -> Parser GuildWidget
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Bool -> GuildId -> GuildWidget
GuildWidget (Bool -> GuildId -> GuildWidget)
-> Parser Bool -> Parser (GuildId -> GuildWidget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"enabled" Parser (GuildId -> GuildWidget)
-> Parser GuildId -> Parser GuildWidget
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser GuildId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channel_id"

instance ToJSON GuildWidget where
  toJSON :: GuildWidget -> Value
toJSON (GuildWidget Bool
enabled GuildId
snowflake) = [Pair] -> Value
object
    [ Key
"enabled"   Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
enabled
    , Key
"channel_id" Key -> GuildId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= GuildId
snowflake
    ]