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

-- | 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 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.Components (Emoji)



-- | 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
guildSplash              :: Maybe T.Text    -- ^ Splash hash
      , Guild -> GuildId
guildOwnerId             :: UserId       -- ^ Guild owner id
      , Guild -> Maybe Text
guildPermissions         :: Maybe T.Text
      , Guild -> Maybe Text
guildRegion              :: Maybe T.Text    -- ^ Guild voice region
      , 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
      , Guild -> [Role]
guildRoles               :: [Role]           -- ^ Array of 'Role' objects
      , Guild -> [Emoji]
guildEmojis              :: [Emoji]          -- ^ Array of 'Emoji' objects
      , Guild -> [Text]
guildFeatures            :: [T.Text]
      , Guild -> Integer
guildMultiFactAuth       :: !Integer
      , Guild -> Maybe GuildId
guildApplicationId       :: Maybe Snowflake
      } 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
-> GuildId
-> Maybe Text
-> Maybe Text
-> Maybe GuildId
-> Integer
-> Maybe Bool
-> Maybe GuildId
-> Integer
-> Integer
-> Integer
-> [Role]
-> [Emoji]
-> [Text]
-> Integer
-> Maybe GuildId
-> Guild
Guild (GuildId
 -> Text
 -> Maybe Text
 -> Maybe Text
 -> GuildId
 -> Maybe Text
 -> Maybe Text
 -> Maybe GuildId
 -> Integer
 -> Maybe Bool
 -> Maybe GuildId
 -> Integer
 -> Integer
 -> Integer
 -> [Role]
 -> [Emoji]
 -> [Text]
 -> Integer
 -> Maybe GuildId
 -> Guild)
-> Parser GuildId
-> Parser
     (Text
      -> Maybe Text
      -> Maybe Text
      -> GuildId
      -> Maybe Text
      -> Maybe Text
      -> Maybe GuildId
      -> Integer
      -> Maybe Bool
      -> Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> 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
   -> GuildId
   -> Maybe Text
   -> Maybe Text
   -> Maybe GuildId
   -> Integer
   -> Maybe Bool
   -> Maybe GuildId
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Guild)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Text
      -> GuildId
      -> Maybe Text
      -> Maybe Text
      -> Maybe GuildId
      -> Integer
      -> Maybe Bool
      -> Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> 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
   -> GuildId
   -> Maybe Text
   -> Maybe Text
   -> Maybe GuildId
   -> Integer
   -> Maybe Bool
   -> Maybe GuildId
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Guild)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> GuildId
      -> Maybe Text
      -> Maybe Text
      -> Maybe GuildId
      -> Integer
      -> Maybe Bool
      -> Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> 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
   -> GuildId
   -> Maybe Text
   -> Maybe Text
   -> Maybe GuildId
   -> Integer
   -> Maybe Bool
   -> Maybe GuildId
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Guild)
-> Parser (Maybe Text)
-> Parser
     (GuildId
      -> Maybe Text
      -> Maybe Text
      -> Maybe GuildId
      -> Integer
      -> Maybe Bool
      -> Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> 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
  (GuildId
   -> Maybe Text
   -> Maybe Text
   -> Maybe GuildId
   -> Integer
   -> Maybe Bool
   -> Maybe GuildId
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Guild)
-> Parser GuildId
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe GuildId
      -> Integer
      -> Maybe Bool
      -> Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> 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 Text
   -> Maybe GuildId
   -> Integer
   -> Maybe Bool
   -> Maybe GuildId
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Guild)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe GuildId
      -> Integer
      -> Maybe Bool
      -> Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> 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 Text
   -> Maybe GuildId
   -> Integer
   -> Maybe Bool
   -> Maybe GuildId
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Guild)
-> Parser (Maybe Text)
-> Parser
     (Maybe GuildId
      -> Integer
      -> Maybe Bool
      -> Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> 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
"region"
          Parser
  (Maybe GuildId
   -> Integer
   -> Maybe Bool
   -> Maybe GuildId
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe GuildId
   -> Guild)
-> Parser (Maybe GuildId)
-> Parser
     (Integer
      -> Maybe Bool
      -> Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> 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
   -> Guild)
-> Parser Integer
-> Parser
     (Maybe Bool
      -> Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> 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
   -> Guild)
-> Parser (Maybe Bool)
-> Parser
     (Maybe GuildId
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> 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
   -> Guild)
-> Parser (Maybe GuildId)
-> Parser
     (Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> 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
   -> Guild)
-> Parser Integer
-> Parser
     (Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> 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
   -> Guild)
-> Parser Integer
-> Parser
     (Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe GuildId
      -> 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
   -> Guild)
-> Parser Integer
-> Parser
     ([Role] -> [Emoji] -> [Text] -> Integer -> Maybe GuildId -> 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 -> Guild)
-> Parser [Role]
-> Parser ([Emoji] -> [Text] -> Integer -> Maybe GuildId -> 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 -> Guild)
-> Parser [Emoji]
-> Parser ([Text] -> Integer -> Maybe GuildId -> 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 -> Guild)
-> Parser [Text] -> Parser (Integer -> Maybe GuildId -> 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 -> Guild)
-> Parser Integer -> Parser (Maybe GuildId -> 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 -> Guild)
-> Parser (Maybe GuildId) -> Parser 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"

data 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 GuildInfo = GuildInfo
      { GuildInfo -> UTCTime
guildJoinedAt    :: UTCTime
      , GuildInfo -> Bool
guildLarge       :: Bool
      , GuildInfo -> Integer
guildMemberCount :: Integer
   -- , guildVoiceStates :: [VoiceState]  -- (without guildid) todo have to add voice state data type
      , GuildInfo -> [GuildMember]
guildMembers     :: [GuildMember]
      , GuildInfo -> [Channel]
guildChannels    :: [Channel]     -- ^ Channels in the guild (sent in GuildCreate)
   -- , guildPresences   :: [Presence]
      } deriving (Int -> GuildInfo -> ShowS
[GuildInfo] -> ShowS
GuildInfo -> String
(Int -> GuildInfo -> ShowS)
-> (GuildInfo -> String)
-> ([GuildInfo] -> ShowS)
-> Show GuildInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuildInfo] -> ShowS
$cshowList :: [GuildInfo] -> ShowS
show :: GuildInfo -> String
$cshow :: GuildInfo -> String
showsPrec :: Int -> GuildInfo -> ShowS
$cshowsPrec :: Int -> GuildInfo -> ShowS
Show, ReadPrec [GuildInfo]
ReadPrec GuildInfo
Int -> ReadS GuildInfo
ReadS [GuildInfo]
(Int -> ReadS GuildInfo)
-> ReadS [GuildInfo]
-> ReadPrec GuildInfo
-> ReadPrec [GuildInfo]
-> Read GuildInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GuildInfo]
$creadListPrec :: ReadPrec [GuildInfo]
readPrec :: ReadPrec GuildInfo
$creadPrec :: ReadPrec GuildInfo
readList :: ReadS [GuildInfo]
$creadList :: ReadS [GuildInfo]
readsPrec :: Int -> ReadS GuildInfo
$creadsPrec :: Int -> ReadS GuildInfo
Read, GuildInfo -> GuildInfo -> Bool
(GuildInfo -> GuildInfo -> Bool)
-> (GuildInfo -> GuildInfo -> Bool) -> Eq GuildInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GuildInfo -> GuildInfo -> Bool
$c/= :: GuildInfo -> GuildInfo -> Bool
== :: GuildInfo -> GuildInfo -> Bool
$c== :: GuildInfo -> GuildInfo -> Bool
Eq, Eq GuildInfo
Eq GuildInfo
-> (GuildInfo -> GuildInfo -> Ordering)
-> (GuildInfo -> GuildInfo -> Bool)
-> (GuildInfo -> GuildInfo -> Bool)
-> (GuildInfo -> GuildInfo -> Bool)
-> (GuildInfo -> GuildInfo -> Bool)
-> (GuildInfo -> GuildInfo -> GuildInfo)
-> (GuildInfo -> GuildInfo -> GuildInfo)
-> Ord GuildInfo
GuildInfo -> GuildInfo -> Bool
GuildInfo -> GuildInfo -> Ordering
GuildInfo -> GuildInfo -> GuildInfo
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 :: GuildInfo -> GuildInfo -> GuildInfo
$cmin :: GuildInfo -> GuildInfo -> GuildInfo
max :: GuildInfo -> GuildInfo -> GuildInfo
$cmax :: GuildInfo -> GuildInfo -> GuildInfo
>= :: GuildInfo -> GuildInfo -> Bool
$c>= :: GuildInfo -> GuildInfo -> Bool
> :: GuildInfo -> GuildInfo -> Bool
$c> :: GuildInfo -> GuildInfo -> Bool
<= :: GuildInfo -> GuildInfo -> Bool
$c<= :: GuildInfo -> GuildInfo -> Bool
< :: GuildInfo -> GuildInfo -> Bool
$c< :: GuildInfo -> GuildInfo -> Bool
compare :: GuildInfo -> GuildInfo -> Ordering
$ccompare :: GuildInfo -> GuildInfo -> Ordering
$cp1Ord :: Eq GuildInfo
Ord)

instance FromJSON GuildInfo where
  parseJSON :: Value -> Parser GuildInfo
parseJSON = String -> (Object -> Parser GuildInfo) -> Value -> Parser GuildInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GuildInfo" ((Object -> Parser GuildInfo) -> Value -> Parser GuildInfo)
-> (Object -> Parser GuildInfo) -> Value -> Parser GuildInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    UTCTime
-> Bool -> Integer -> [GuildMember] -> [Channel] -> GuildInfo
GuildInfo (UTCTime
 -> Bool -> Integer -> [GuildMember] -> [Channel] -> GuildInfo)
-> Parser UTCTime
-> Parser
     (Bool -> Integer -> [GuildMember] -> [Channel] -> GuildInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"joined_at"
              Parser (Bool -> Integer -> [GuildMember] -> [Channel] -> GuildInfo)
-> Parser Bool
-> Parser (Integer -> [GuildMember] -> [Channel] -> GuildInfo)
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
"large"
              Parser (Integer -> [GuildMember] -> [Channel] -> GuildInfo)
-> Parser Integer
-> Parser ([GuildMember] -> [Channel] -> GuildInfo)
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
"member_count"
           -- <*> o .: "voice_states"
              Parser ([GuildMember] -> [Channel] -> GuildInfo)
-> Parser [GuildMember] -> Parser ([Channel] -> GuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [GuildMember]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"members"
              Parser ([Channel] -> GuildInfo)
-> Parser [Channel] -> Parser GuildInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [Channel]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channels"

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
    ]