{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Provides actions for Channel API interactions
module Discord.Internal.Rest.Guild
  ( GuildRequest(..)
  , CreateGuildChannelOpts(..)
  , ModifyGuildOpts(..)
  , AddGuildMemberOpts(..)
  , ModifyGuildMemberOpts(..)
  , GuildMembersTiming(..)
  , CreateGuildBanOpts(..)
  , ModifyGuildRoleOpts(..)
  , CreateGuildIntegrationOpts(..)
  , ModifyGuildIntegrationOpts(..)
  ) where


import Data.Aeson
import Network.HTTP.Req ((/:), (/~))
import qualified Network.HTTP.Req as R
import qualified Data.Text as T

import Discord.Internal.Rest.Prelude
import Discord.Internal.Types
import Data.Default (Default(..))

instance Request (GuildRequest a) where
  majorRoute :: GuildRequest a -> String
majorRoute = forall a. GuildRequest a -> String
guildMajorRoute
  jsonRequest :: GuildRequest a -> JsonRequest
jsonRequest = forall a. GuildRequest a -> JsonRequest
guildJsonRequest

-- | Data constructor for requests. See <https://discord.com/developers/docs/resources/ API>
data GuildRequest a where
  -- -- Creating a guild with the API is annoying. Do it manually.
  -- -- https://discord.com/developers/docs/resources/guild#create-guild

  -- | Returns the new 'Guild' object for the given id
  GetGuild                 :: GuildId -> GuildRequest Guild
  -- | Modify a guild's settings. Returns the updated 'Guild' object on success. Fires a
  --   Guild Update 'Event'.
  ModifyGuild              :: GuildId -> ModifyGuildOpts -> GuildRequest Guild
  -- | Delete a guild permanently. User must be owner. Fires a Guild Delete 'Event'.
  DeleteGuild              :: GuildId -> GuildRequest ()
  -- | Returns a list of guild 'Channel' objects
  GetGuildChannels         :: GuildId -> GuildRequest [Channel]
  -- | Create a new 'Channel' object for the guild. Requires 'MANAGE_CHANNELS'
  --   permission. Returns the new 'Channel' object on success. Fires a Channel Create
  --   'Event'
  CreateGuildChannel       :: GuildId -> T.Text -> [Overwrite] -> CreateGuildChannelOpts -> GuildRequest Channel
  -- | Modify the positions of a set of channel objects for the guild. Requires
  --   'MANAGE_CHANNELS' permission. Returns a list of all of the guild's 'Channel'
  --   objects on success. Fires multiple Channel Update 'Event's.
  ModifyGuildChannelPositions      :: GuildId -> [(ChannelId,Int)] -> GuildRequest [Channel]
  -- | Returns a guild 'Member' object for the specified user
  GetGuildMember           :: GuildId -> UserId -> GuildRequest GuildMember
  -- | Returns a list of guild 'Member' objects that are members of the guild.
  ListGuildMembers         :: GuildId -> GuildMembersTiming -> GuildRequest [GuildMember]
  -- | Adds a user to the guild, provided you have a valid oauth2 access token
  --   for the user with the guilds.join scope. Returns the guild 'Member' as the body.
  --   Fires a Guild Member Add 'Event'. Requires the bot to have the
  --   CREATE_INSTANT_INVITE permission.
  AddGuildMember           :: GuildId -> UserId -> AddGuildMemberOpts
                                      -> GuildRequest ()
  -- | Modify attributes of a guild 'Member'. Fires a Guild Member Update 'Event'.
  ModifyGuildMember        :: GuildId -> UserId -> ModifyGuildMemberOpts -> GuildRequest GuildMember
  -- | Modify the nickname of the current user
  ModifyCurrentUserNick    :: GuildId -> T.Text -> GuildRequest ()
  -- | Add a member to a guild role. Requires 'MANAGE_ROLES' permission.
  AddGuildMemberRole    :: GuildId -> UserId -> RoleId -> GuildRequest ()
  -- | Remove a member from a guild role. Requires 'MANAGE_ROLES' permission.
  RemoveGuildMemberRole    :: GuildId -> UserId -> RoleId -> GuildRequest ()
  -- | Remove a member from a guild. Requires 'KICK_MEMBER' permission. Fires a
  --   Guild Member Remove 'Event'.
  RemoveGuildMember        :: GuildId -> UserId -> GuildRequest ()
  -- | Returns a list of 'Ban' objects for users that are banned from this guild. Requires the
  --   'BAN_MEMBERS' permission
  GetGuildBans             :: GuildId -> GuildRequest [GuildBan]
  -- | Returns a 'Ban' object for the user banned from this guild. Requires the
  --   'BAN_MEMBERS' permission
  GetGuildBan              :: GuildId -> UserId -> GuildRequest GuildBan
  -- | Create a guild ban, and optionally Delete previous messages sent by the banned
  --   user. Requires the 'BAN_MEMBERS' permission. Fires a Guild Ban Add 'Event'.
  CreateGuildBan           :: GuildId -> UserId -> CreateGuildBanOpts -> GuildRequest ()
  -- | Remove the ban for a user. Requires the 'BAN_MEMBERS' permissions.
  --   Fires a Guild Ban Remove 'Event'.
  RemoveGuildBan           :: GuildId -> UserId -> GuildRequest ()
  -- | Returns a list of 'Role' objects for the guild. Requires the 'MANAGE_ROLES'
  --   permission
  GetGuildRoles            :: GuildId -> GuildRequest [Role]
  -- | Create a new 'Role' for the guild. Requires the 'MANAGE_ROLES' permission.
  --   Returns the new role object on success. Fires a Guild Role Create 'Event'.
  CreateGuildRole          :: GuildId -> ModifyGuildRoleOpts -> GuildRequest Role
  -- | Modify the positions of a set of role objects for the guild. Requires the
  --   'MANAGE_ROLES' permission. Returns a list of all of the guild's 'Role' objects
  --   on success. Fires multiple Guild Role Update 'Event's.
  ModifyGuildRolePositions :: GuildId -> [(RoleId, Integer)] -> GuildRequest [Role]
  -- | Modify a guild role. Requires the 'MANAGE_ROLES' permission. Returns the
  --   updated 'Role' on success. Fires a Guild Role Update 'Event's.
  ModifyGuildRole          :: GuildId -> RoleId -> ModifyGuildRoleOpts -> GuildRequest Role
  -- | Delete a guild role. Requires the 'MANAGE_ROLES' permission. Fires a Guild Role
  --   Delete 'Event'.
  DeleteGuildRole          :: GuildId -> RoleId -> GuildRequest ()
  -- | Returns an object with one 'pruned' key indicating the number of members
  --   that would be removed in a prune operation. Requires the 'KICK_MEMBERS'
  --   permission.
  GetGuildPruneCount       :: GuildId -> Integer -> GuildRequest Object
  -- | Begin a prune operation. Requires the 'KICK_MEMBERS' permission. Returns an
  --   object with one 'pruned' key indicating the number of members that were removed
  --   in the prune operation. Fires multiple Guild Member Remove 'Events'.
  BeginGuildPrune          :: GuildId -> Integer -> GuildRequest Object
  -- | Returns a list of 'VoiceRegion' objects for the guild. Unlike the similar /voice
  --   route, this returns VIP servers when the guild is VIP-enabled.
  GetGuildVoiceRegions     :: GuildId -> GuildRequest [VoiceRegion]
  -- | Returns a list of 'Invite' objects for the guild. Requires the 'MANAGE_GUILD'
  --   permission.
  GetGuildInvites          :: GuildId -> GuildRequest [Invite]
  -- | Return a list of 'Integration' objects for the guild. Requires the 'MANAGE_GUILD'
  --   permission.
  GetGuildIntegrations     :: GuildId -> GuildRequest [Integration]
  -- | Attach an 'Integration' object from the current user to the guild. Requires the
  --   'MANAGE_GUILD' permission. Fires a Guild Integrations Update 'Event'.
  CreateGuildIntegration   :: GuildId -> IntegrationId -> CreateGuildIntegrationOpts -> GuildRequest ()
  -- | Modify the behavior and settings of a 'Integration' object for the guild.
  --   Requires the 'MANAGE_GUILD' permission. Fires a Guild Integrations Update 'Event'.
  ModifyGuildIntegration   :: GuildId -> IntegrationId -> ModifyGuildIntegrationOpts
                                      -> GuildRequest ()
  -- | Delete the attached 'Integration' object for the guild. Requires the
  --   'MANAGE_GUILD' permission. Fires a Guild Integrations Update 'Event'.
  DeleteGuildIntegration   :: GuildId -> IntegrationId -> GuildRequest ()
  -- | Sync an 'Integration'. Requires the 'MANAGE_GUILD' permission.
  SyncGuildIntegration     :: GuildId -> IntegrationId -> GuildRequest ()
  -- | Returns the 'GuildWidget' object. Requires the 'MANAGE_GUILD' permission.
  GetGuildWidget            :: GuildId -> GuildRequest GuildWidget
  -- | Modify a 'GuildWidget' object for the guild. All attributes may be passed in with
  --   JSON and modified. Requires the 'MANAGE_GUILD' permission. Returns the updated
  --   'GuildWidget' object.
  ModifyGuildWidget         :: GuildId -> GuildWidget -> GuildRequest GuildWidget
  -- | Vanity URL
  GetGuildVanityURL        :: GuildId -> GuildRequest T.Text

-- | Options for `ModifyGuildIntegration`
data ModifyGuildIntegrationOpts = ModifyGuildIntegrationOpts
  { ModifyGuildIntegrationOpts -> Integer
modifyGuildIntegrationOptsExpireBehavior :: Integer
  , ModifyGuildIntegrationOpts -> Integer
modifyGuildIntegrationOptsExpireGraceSeconds :: Integer
  , ModifyGuildIntegrationOpts -> Bool
modifyGuildIntegrationOptsEmoticonsEnabled :: Bool
  } deriving (Int -> ModifyGuildIntegrationOpts -> ShowS
[ModifyGuildIntegrationOpts] -> ShowS
ModifyGuildIntegrationOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyGuildIntegrationOpts] -> ShowS
$cshowList :: [ModifyGuildIntegrationOpts] -> ShowS
show :: ModifyGuildIntegrationOpts -> String
$cshow :: ModifyGuildIntegrationOpts -> String
showsPrec :: Int -> ModifyGuildIntegrationOpts -> ShowS
$cshowsPrec :: Int -> ModifyGuildIntegrationOpts -> ShowS
Show, ReadPrec [ModifyGuildIntegrationOpts]
ReadPrec ModifyGuildIntegrationOpts
Int -> ReadS ModifyGuildIntegrationOpts
ReadS [ModifyGuildIntegrationOpts]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyGuildIntegrationOpts]
$creadListPrec :: ReadPrec [ModifyGuildIntegrationOpts]
readPrec :: ReadPrec ModifyGuildIntegrationOpts
$creadPrec :: ReadPrec ModifyGuildIntegrationOpts
readList :: ReadS [ModifyGuildIntegrationOpts]
$creadList :: ReadS [ModifyGuildIntegrationOpts]
readsPrec :: Int -> ReadS ModifyGuildIntegrationOpts
$creadsPrec :: Int -> ReadS ModifyGuildIntegrationOpts
Read, ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts -> Bool
$c/= :: ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts -> Bool
== :: ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts -> Bool
$c== :: ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts -> Bool
Eq, Eq ModifyGuildIntegrationOpts
ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts -> Bool
ModifyGuildIntegrationOpts
-> ModifyGuildIntegrationOpts -> Ordering
ModifyGuildIntegrationOpts
-> ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts
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 :: ModifyGuildIntegrationOpts
-> ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts
$cmin :: ModifyGuildIntegrationOpts
-> ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts
max :: ModifyGuildIntegrationOpts
-> ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts
$cmax :: ModifyGuildIntegrationOpts
-> ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts
>= :: ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts -> Bool
$c>= :: ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts -> Bool
> :: ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts -> Bool
$c> :: ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts -> Bool
<= :: ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts -> Bool
$c<= :: ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts -> Bool
< :: ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts -> Bool
$c< :: ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts -> Bool
compare :: ModifyGuildIntegrationOpts
-> ModifyGuildIntegrationOpts -> Ordering
$ccompare :: ModifyGuildIntegrationOpts
-> ModifyGuildIntegrationOpts -> Ordering
Ord)

instance ToJSON ModifyGuildIntegrationOpts where
  toJSON :: ModifyGuildIntegrationOpts -> Value
toJSON ModifyGuildIntegrationOpts{Bool
Integer
modifyGuildIntegrationOptsEmoticonsEnabled :: Bool
modifyGuildIntegrationOptsExpireGraceSeconds :: Integer
modifyGuildIntegrationOptsExpireBehavior :: Integer
modifyGuildIntegrationOptsEmoticonsEnabled :: ModifyGuildIntegrationOpts -> Bool
modifyGuildIntegrationOptsExpireGraceSeconds :: ModifyGuildIntegrationOpts -> Integer
modifyGuildIntegrationOptsExpireBehavior :: ModifyGuildIntegrationOpts -> Integer
..} = [Maybe Pair] -> Value
objectFromMaybes
         [ AesonKey
"expire_grace_period" forall a. ToJSON a => AesonKey -> a -> Maybe Pair
.== Integer
modifyGuildIntegrationOptsExpireGraceSeconds
         , AesonKey
"expire_behavior" forall a. ToJSON a => AesonKey -> a -> Maybe Pair
.== Integer
modifyGuildIntegrationOptsExpireBehavior
         , AesonKey
"enable_emoticons" forall a. ToJSON a => AesonKey -> a -> Maybe Pair
.== Bool
modifyGuildIntegrationOptsEmoticonsEnabled ]

-- | Options for `CreateGuildIntegration`
newtype CreateGuildIntegrationOpts = CreateGuildIntegrationOpts
  { CreateGuildIntegrationOpts -> Text
createGuildIntegrationOptsType :: T.Text
  } deriving (Int -> CreateGuildIntegrationOpts -> ShowS
[CreateGuildIntegrationOpts] -> ShowS
CreateGuildIntegrationOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateGuildIntegrationOpts] -> ShowS
$cshowList :: [CreateGuildIntegrationOpts] -> ShowS
show :: CreateGuildIntegrationOpts -> String
$cshow :: CreateGuildIntegrationOpts -> String
showsPrec :: Int -> CreateGuildIntegrationOpts -> ShowS
$cshowsPrec :: Int -> CreateGuildIntegrationOpts -> ShowS
Show, ReadPrec [CreateGuildIntegrationOpts]
ReadPrec CreateGuildIntegrationOpts
Int -> ReadS CreateGuildIntegrationOpts
ReadS [CreateGuildIntegrationOpts]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateGuildIntegrationOpts]
$creadListPrec :: ReadPrec [CreateGuildIntegrationOpts]
readPrec :: ReadPrec CreateGuildIntegrationOpts
$creadPrec :: ReadPrec CreateGuildIntegrationOpts
readList :: ReadS [CreateGuildIntegrationOpts]
$creadList :: ReadS [CreateGuildIntegrationOpts]
readsPrec :: Int -> ReadS CreateGuildIntegrationOpts
$creadsPrec :: Int -> ReadS CreateGuildIntegrationOpts
Read, CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts -> Bool
$c/= :: CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts -> Bool
== :: CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts -> Bool
$c== :: CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts -> Bool
Eq, Eq CreateGuildIntegrationOpts
CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts -> Bool
CreateGuildIntegrationOpts
-> CreateGuildIntegrationOpts -> Ordering
CreateGuildIntegrationOpts
-> CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts
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 :: CreateGuildIntegrationOpts
-> CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts
$cmin :: CreateGuildIntegrationOpts
-> CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts
max :: CreateGuildIntegrationOpts
-> CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts
$cmax :: CreateGuildIntegrationOpts
-> CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts
>= :: CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts -> Bool
$c>= :: CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts -> Bool
> :: CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts -> Bool
$c> :: CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts -> Bool
<= :: CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts -> Bool
$c<= :: CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts -> Bool
< :: CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts -> Bool
$c< :: CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts -> Bool
compare :: CreateGuildIntegrationOpts
-> CreateGuildIntegrationOpts -> Ordering
$ccompare :: CreateGuildIntegrationOpts
-> CreateGuildIntegrationOpts -> Ordering
Ord)

instance ToJSON CreateGuildIntegrationOpts where
  toJSON :: CreateGuildIntegrationOpts -> Value
toJSON CreateGuildIntegrationOpts{Text
createGuildIntegrationOptsType :: Text
createGuildIntegrationOptsType :: CreateGuildIntegrationOpts -> Text
..} = [Maybe Pair] -> Value
objectFromMaybes
                       [AesonKey
"type" forall a. ToJSON a => AesonKey -> a -> Maybe Pair
.== Text
createGuildIntegrationOptsType]

-- | Options for `CreateGuildBan`
data CreateGuildBanOpts = CreateGuildBanOpts
  { CreateGuildBanOpts -> Maybe Int
createGuildBanOptsDeleteLastNMessages :: Maybe Int
  , CreateGuildBanOpts -> Maybe Text
createGuildBanOptsReason              :: Maybe T.Text
  } deriving (Int -> CreateGuildBanOpts -> ShowS
[CreateGuildBanOpts] -> ShowS
CreateGuildBanOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateGuildBanOpts] -> ShowS
$cshowList :: [CreateGuildBanOpts] -> ShowS
show :: CreateGuildBanOpts -> String
$cshow :: CreateGuildBanOpts -> String
showsPrec :: Int -> CreateGuildBanOpts -> ShowS
$cshowsPrec :: Int -> CreateGuildBanOpts -> ShowS
Show, ReadPrec [CreateGuildBanOpts]
ReadPrec CreateGuildBanOpts
Int -> ReadS CreateGuildBanOpts
ReadS [CreateGuildBanOpts]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateGuildBanOpts]
$creadListPrec :: ReadPrec [CreateGuildBanOpts]
readPrec :: ReadPrec CreateGuildBanOpts
$creadPrec :: ReadPrec CreateGuildBanOpts
readList :: ReadS [CreateGuildBanOpts]
$creadList :: ReadS [CreateGuildBanOpts]
readsPrec :: Int -> ReadS CreateGuildBanOpts
$creadsPrec :: Int -> ReadS CreateGuildBanOpts
Read, CreateGuildBanOpts -> CreateGuildBanOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateGuildBanOpts -> CreateGuildBanOpts -> Bool
$c/= :: CreateGuildBanOpts -> CreateGuildBanOpts -> Bool
== :: CreateGuildBanOpts -> CreateGuildBanOpts -> Bool
$c== :: CreateGuildBanOpts -> CreateGuildBanOpts -> Bool
Eq, Eq CreateGuildBanOpts
CreateGuildBanOpts -> CreateGuildBanOpts -> Bool
CreateGuildBanOpts -> CreateGuildBanOpts -> Ordering
CreateGuildBanOpts -> CreateGuildBanOpts -> CreateGuildBanOpts
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 :: CreateGuildBanOpts -> CreateGuildBanOpts -> CreateGuildBanOpts
$cmin :: CreateGuildBanOpts -> CreateGuildBanOpts -> CreateGuildBanOpts
max :: CreateGuildBanOpts -> CreateGuildBanOpts -> CreateGuildBanOpts
$cmax :: CreateGuildBanOpts -> CreateGuildBanOpts -> CreateGuildBanOpts
>= :: CreateGuildBanOpts -> CreateGuildBanOpts -> Bool
$c>= :: CreateGuildBanOpts -> CreateGuildBanOpts -> Bool
> :: CreateGuildBanOpts -> CreateGuildBanOpts -> Bool
$c> :: CreateGuildBanOpts -> CreateGuildBanOpts -> Bool
<= :: CreateGuildBanOpts -> CreateGuildBanOpts -> Bool
$c<= :: CreateGuildBanOpts -> CreateGuildBanOpts -> Bool
< :: CreateGuildBanOpts -> CreateGuildBanOpts -> Bool
$c< :: CreateGuildBanOpts -> CreateGuildBanOpts -> Bool
compare :: CreateGuildBanOpts -> CreateGuildBanOpts -> Ordering
$ccompare :: CreateGuildBanOpts -> CreateGuildBanOpts -> Ordering
Ord)

instance ToJSON CreateGuildBanOpts where
  toJSON :: CreateGuildBanOpts -> Value
toJSON CreateGuildBanOpts{Maybe Int
Maybe Text
createGuildBanOptsReason :: Maybe Text
createGuildBanOptsDeleteLastNMessages :: Maybe Int
createGuildBanOptsReason :: CreateGuildBanOpts -> Maybe Text
createGuildBanOptsDeleteLastNMessages :: CreateGuildBanOpts -> Maybe Int
..} = [Maybe Pair] -> Value
objectFromMaybes
                       [ AesonKey
"delete_message_days"
                           forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Int
createGuildBanOptsDeleteLastNMessages
                       , AesonKey
"reason" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Text
createGuildBanOptsReason]

-- | Options for `ModifyGuildRole`
data ModifyGuildRoleOpts = ModifyGuildRoleOpts
  { ModifyGuildRoleOpts -> Maybe Text
modifyGuildRoleOptsName            :: Maybe T.Text
  , ModifyGuildRoleOpts -> Maybe Text
modifyGuildRoleOptsPermissions     :: Maybe T.Text
  , ModifyGuildRoleOpts -> Maybe DiscordColor
modifyGuildRoleOptsColor           :: Maybe DiscordColor
  , ModifyGuildRoleOpts -> Maybe Bool
modifyGuildRoleOptsSeparateSidebar :: Maybe Bool
  , ModifyGuildRoleOpts -> Maybe Bool
modifyGuildRoleOptsMentionable     :: Maybe Bool
  } deriving (Int -> ModifyGuildRoleOpts -> ShowS
[ModifyGuildRoleOpts] -> ShowS
ModifyGuildRoleOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyGuildRoleOpts] -> ShowS
$cshowList :: [ModifyGuildRoleOpts] -> ShowS
show :: ModifyGuildRoleOpts -> String
$cshow :: ModifyGuildRoleOpts -> String
showsPrec :: Int -> ModifyGuildRoleOpts -> ShowS
$cshowsPrec :: Int -> ModifyGuildRoleOpts -> ShowS
Show, ReadPrec [ModifyGuildRoleOpts]
ReadPrec ModifyGuildRoleOpts
Int -> ReadS ModifyGuildRoleOpts
ReadS [ModifyGuildRoleOpts]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyGuildRoleOpts]
$creadListPrec :: ReadPrec [ModifyGuildRoleOpts]
readPrec :: ReadPrec ModifyGuildRoleOpts
$creadPrec :: ReadPrec ModifyGuildRoleOpts
readList :: ReadS [ModifyGuildRoleOpts]
$creadList :: ReadS [ModifyGuildRoleOpts]
readsPrec :: Int -> ReadS ModifyGuildRoleOpts
$creadsPrec :: Int -> ReadS ModifyGuildRoleOpts
Read, ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Bool
$c/= :: ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Bool
== :: ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Bool
$c== :: ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Bool
Eq, Eq ModifyGuildRoleOpts
ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Bool
ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Ordering
ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> ModifyGuildRoleOpts
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 :: ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> ModifyGuildRoleOpts
$cmin :: ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> ModifyGuildRoleOpts
max :: ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> ModifyGuildRoleOpts
$cmax :: ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> ModifyGuildRoleOpts
>= :: ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Bool
$c>= :: ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Bool
> :: ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Bool
$c> :: ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Bool
<= :: ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Bool
$c<= :: ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Bool
< :: ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Bool
$c< :: ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Bool
compare :: ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Ordering
$ccompare :: ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Ordering
Ord)

instance ToJSON ModifyGuildRoleOpts where
  toJSON :: ModifyGuildRoleOpts -> Value
toJSON ModifyGuildRoleOpts{Maybe Bool
Maybe Text
Maybe DiscordColor
modifyGuildRoleOptsMentionable :: Maybe Bool
modifyGuildRoleOptsSeparateSidebar :: Maybe Bool
modifyGuildRoleOptsColor :: Maybe DiscordColor
modifyGuildRoleOptsPermissions :: Maybe Text
modifyGuildRoleOptsName :: Maybe Text
modifyGuildRoleOptsMentionable :: ModifyGuildRoleOpts -> Maybe Bool
modifyGuildRoleOptsSeparateSidebar :: ModifyGuildRoleOpts -> Maybe Bool
modifyGuildRoleOptsColor :: ModifyGuildRoleOpts -> Maybe DiscordColor
modifyGuildRoleOptsPermissions :: ModifyGuildRoleOpts -> Maybe Text
modifyGuildRoleOptsName :: ModifyGuildRoleOpts -> Maybe Text
..} = [Maybe Pair] -> Value
objectFromMaybes
                       [AesonKey
"name" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Text
modifyGuildRoleOptsName,
                        AesonKey
"permissions" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Text
modifyGuildRoleOptsPermissions,
                        AesonKey
"color" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe DiscordColor
modifyGuildRoleOptsColor,
                        AesonKey
"hoist" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Bool
modifyGuildRoleOptsSeparateSidebar,
                        AesonKey
"mentionable" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Bool
modifyGuildRoleOptsMentionable]

-- | Options for `AddGuildMember`
data AddGuildMemberOpts = AddGuildMemberOpts
  { AddGuildMemberOpts -> Text
addGuildMemberOptsAccessToken :: T.Text
  , AddGuildMemberOpts -> Maybe Text
addGuildMemberOptsNickname    :: Maybe T.Text
  , AddGuildMemberOpts -> Maybe [RoleId]
addGuildMemberOptsRoles       :: Maybe [RoleId]
  , AddGuildMemberOpts -> Maybe Bool
addGuildMemberOptsIsMuted     :: Maybe Bool
  , AddGuildMemberOpts -> Maybe Bool
addGuildMemberOptsIsDeafened  :: Maybe Bool
  } deriving (Int -> AddGuildMemberOpts -> ShowS
[AddGuildMemberOpts] -> ShowS
AddGuildMemberOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddGuildMemberOpts] -> ShowS
$cshowList :: [AddGuildMemberOpts] -> ShowS
show :: AddGuildMemberOpts -> String
$cshow :: AddGuildMemberOpts -> String
showsPrec :: Int -> AddGuildMemberOpts -> ShowS
$cshowsPrec :: Int -> AddGuildMemberOpts -> ShowS
Show, ReadPrec [AddGuildMemberOpts]
ReadPrec AddGuildMemberOpts
Int -> ReadS AddGuildMemberOpts
ReadS [AddGuildMemberOpts]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddGuildMemberOpts]
$creadListPrec :: ReadPrec [AddGuildMemberOpts]
readPrec :: ReadPrec AddGuildMemberOpts
$creadPrec :: ReadPrec AddGuildMemberOpts
readList :: ReadS [AddGuildMemberOpts]
$creadList :: ReadS [AddGuildMemberOpts]
readsPrec :: Int -> ReadS AddGuildMemberOpts
$creadsPrec :: Int -> ReadS AddGuildMemberOpts
Read, AddGuildMemberOpts -> AddGuildMemberOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddGuildMemberOpts -> AddGuildMemberOpts -> Bool
$c/= :: AddGuildMemberOpts -> AddGuildMemberOpts -> Bool
== :: AddGuildMemberOpts -> AddGuildMemberOpts -> Bool
$c== :: AddGuildMemberOpts -> AddGuildMemberOpts -> Bool
Eq, Eq AddGuildMemberOpts
AddGuildMemberOpts -> AddGuildMemberOpts -> Bool
AddGuildMemberOpts -> AddGuildMemberOpts -> Ordering
AddGuildMemberOpts -> AddGuildMemberOpts -> AddGuildMemberOpts
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 :: AddGuildMemberOpts -> AddGuildMemberOpts -> AddGuildMemberOpts
$cmin :: AddGuildMemberOpts -> AddGuildMemberOpts -> AddGuildMemberOpts
max :: AddGuildMemberOpts -> AddGuildMemberOpts -> AddGuildMemberOpts
$cmax :: AddGuildMemberOpts -> AddGuildMemberOpts -> AddGuildMemberOpts
>= :: AddGuildMemberOpts -> AddGuildMemberOpts -> Bool
$c>= :: AddGuildMemberOpts -> AddGuildMemberOpts -> Bool
> :: AddGuildMemberOpts -> AddGuildMemberOpts -> Bool
$c> :: AddGuildMemberOpts -> AddGuildMemberOpts -> Bool
<= :: AddGuildMemberOpts -> AddGuildMemberOpts -> Bool
$c<= :: AddGuildMemberOpts -> AddGuildMemberOpts -> Bool
< :: AddGuildMemberOpts -> AddGuildMemberOpts -> Bool
$c< :: AddGuildMemberOpts -> AddGuildMemberOpts -> Bool
compare :: AddGuildMemberOpts -> AddGuildMemberOpts -> Ordering
$ccompare :: AddGuildMemberOpts -> AddGuildMemberOpts -> Ordering
Ord)

instance ToJSON AddGuildMemberOpts where
  toJSON :: AddGuildMemberOpts -> Value
toJSON AddGuildMemberOpts{Maybe Bool
Maybe [RoleId]
Maybe Text
Text
addGuildMemberOptsIsDeafened :: Maybe Bool
addGuildMemberOptsIsMuted :: Maybe Bool
addGuildMemberOptsRoles :: Maybe [RoleId]
addGuildMemberOptsNickname :: Maybe Text
addGuildMemberOptsAccessToken :: Text
addGuildMemberOptsIsDeafened :: AddGuildMemberOpts -> Maybe Bool
addGuildMemberOptsIsMuted :: AddGuildMemberOpts -> Maybe Bool
addGuildMemberOptsRoles :: AddGuildMemberOpts -> Maybe [RoleId]
addGuildMemberOptsNickname :: AddGuildMemberOpts -> Maybe Text
addGuildMemberOptsAccessToken :: AddGuildMemberOpts -> Text
..} = [Maybe Pair] -> Value
objectFromMaybes
                                  [AesonKey
"access_token" forall a. ToJSON a => AesonKey -> a -> Maybe Pair
.== Text
addGuildMemberOptsAccessToken,
                                   AesonKey
"nick" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Text
addGuildMemberOptsNickname,
                                   AesonKey
"roles" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe [RoleId]
addGuildMemberOptsRoles,
                                   AesonKey
"mute" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Bool
addGuildMemberOptsIsMuted,
                                   AesonKey
"deaf" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Bool
addGuildMemberOptsIsDeafened]

-- | Options for `ModifyGuildMember`
data ModifyGuildMemberOpts = ModifyGuildMemberOpts
  { ModifyGuildMemberOpts -> Maybe Text
modifyGuildMemberOptsNickname      :: Maybe T.Text
  , ModifyGuildMemberOpts -> Maybe [RoleId]
modifyGuildMemberOptsRoles         :: Maybe [RoleId]
  , ModifyGuildMemberOpts -> Maybe Bool
modifyGuildMemberOptsIsMuted       :: Maybe Bool
  , ModifyGuildMemberOpts -> Maybe Bool
modifyGuildMemberOptsIsDeafened    :: Maybe Bool
  , ModifyGuildMemberOpts -> Maybe ChannelId
modifyGuildMemberOptsMoveToChannel :: Maybe ChannelId
  , ModifyGuildMemberOpts -> Maybe (Maybe UTCTime)
modifyGuildMemberOptsTimeoutUntil  :: Maybe (Maybe UTCTime) -- ^ If `Just Nothing`, the timeout will be removed.
  } deriving (Int -> ModifyGuildMemberOpts -> ShowS
[ModifyGuildMemberOpts] -> ShowS
ModifyGuildMemberOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyGuildMemberOpts] -> ShowS
$cshowList :: [ModifyGuildMemberOpts] -> ShowS
show :: ModifyGuildMemberOpts -> String
$cshow :: ModifyGuildMemberOpts -> String
showsPrec :: Int -> ModifyGuildMemberOpts -> ShowS
$cshowsPrec :: Int -> ModifyGuildMemberOpts -> ShowS
Show, ReadPrec [ModifyGuildMemberOpts]
ReadPrec ModifyGuildMemberOpts
Int -> ReadS ModifyGuildMemberOpts
ReadS [ModifyGuildMemberOpts]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyGuildMemberOpts]
$creadListPrec :: ReadPrec [ModifyGuildMemberOpts]
readPrec :: ReadPrec ModifyGuildMemberOpts
$creadPrec :: ReadPrec ModifyGuildMemberOpts
readList :: ReadS [ModifyGuildMemberOpts]
$creadList :: ReadS [ModifyGuildMemberOpts]
readsPrec :: Int -> ReadS ModifyGuildMemberOpts
$creadsPrec :: Int -> ReadS ModifyGuildMemberOpts
Read, ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Bool
$c/= :: ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Bool
== :: ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Bool
$c== :: ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Bool
Eq, Eq ModifyGuildMemberOpts
ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Bool
ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Ordering
ModifyGuildMemberOpts
-> ModifyGuildMemberOpts -> ModifyGuildMemberOpts
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 :: ModifyGuildMemberOpts
-> ModifyGuildMemberOpts -> ModifyGuildMemberOpts
$cmin :: ModifyGuildMemberOpts
-> ModifyGuildMemberOpts -> ModifyGuildMemberOpts
max :: ModifyGuildMemberOpts
-> ModifyGuildMemberOpts -> ModifyGuildMemberOpts
$cmax :: ModifyGuildMemberOpts
-> ModifyGuildMemberOpts -> ModifyGuildMemberOpts
>= :: ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Bool
$c>= :: ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Bool
> :: ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Bool
$c> :: ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Bool
<= :: ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Bool
$c<= :: ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Bool
< :: ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Bool
$c< :: ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Bool
compare :: ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Ordering
$ccompare :: ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Ordering
Ord)

instance Default ModifyGuildMemberOpts where
  def :: ModifyGuildMemberOpts
def = Maybe Text
-> Maybe [RoleId]
-> Maybe Bool
-> Maybe Bool
-> Maybe ChannelId
-> Maybe (Maybe UTCTime)
-> ModifyGuildMemberOpts
ModifyGuildMemberOpts forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

instance ToJSON ModifyGuildMemberOpts where
  toJSON :: ModifyGuildMemberOpts -> Value
toJSON ModifyGuildMemberOpts{Maybe Bool
Maybe [RoleId]
Maybe (Maybe UTCTime)
Maybe Text
Maybe ChannelId
modifyGuildMemberOptsTimeoutUntil :: Maybe (Maybe UTCTime)
modifyGuildMemberOptsMoveToChannel :: Maybe ChannelId
modifyGuildMemberOptsIsDeafened :: Maybe Bool
modifyGuildMemberOptsIsMuted :: Maybe Bool
modifyGuildMemberOptsRoles :: Maybe [RoleId]
modifyGuildMemberOptsNickname :: Maybe Text
modifyGuildMemberOptsTimeoutUntil :: ModifyGuildMemberOpts -> Maybe (Maybe UTCTime)
modifyGuildMemberOptsMoveToChannel :: ModifyGuildMemberOpts -> Maybe ChannelId
modifyGuildMemberOptsIsDeafened :: ModifyGuildMemberOpts -> Maybe Bool
modifyGuildMemberOptsIsMuted :: ModifyGuildMemberOpts -> Maybe Bool
modifyGuildMemberOptsRoles :: ModifyGuildMemberOpts -> Maybe [RoleId]
modifyGuildMemberOptsNickname :: ModifyGuildMemberOpts -> Maybe Text
..} = [Maybe Pair] -> Value
objectFromMaybes
                                  [AesonKey
"nick" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Text
modifyGuildMemberOptsNickname,
                                   AesonKey
"roles" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe [RoleId]
modifyGuildMemberOptsRoles,
                                   AesonKey
"mute" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Bool
modifyGuildMemberOptsIsMuted,
                                   AesonKey
"deaf" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Bool
modifyGuildMemberOptsIsDeafened,
                                   AesonKey
"channel_id" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe ChannelId
modifyGuildMemberOptsMoveToChannel,
                                   AesonKey
"communication_disabled_until" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe (Maybe UTCTime)
modifyGuildMemberOptsTimeoutUntil]

-- | Options for `CreateGuildChannel`
data CreateGuildChannelOpts
  -- | Create a text channel
  = CreateGuildChannelOptsText {
    CreateGuildChannelOpts -> Maybe Text
createGuildChannelOptsTopic :: Maybe T.Text
  , CreateGuildChannelOpts -> Maybe Integer
createGuildChannelOptsUserMessageRateDelay :: Maybe Integer
  , CreateGuildChannelOpts -> Maybe Bool
createGuildChannelOptsIsNSFW :: Maybe Bool
  , CreateGuildChannelOpts -> Maybe ChannelId
createGuildChannelOptsCategoryId :: Maybe ChannelId }
  -- | Create a voice channel
  | CreateGuildChannelOptsVoice {
    CreateGuildChannelOpts -> Maybe Integer
createGuildChannelOptsBitrate :: Maybe Integer
  , CreateGuildChannelOpts -> Maybe Integer
createGuildChannelOptsMaxUsers :: Maybe Integer
  , createGuildChannelOptsCategoryId :: Maybe ChannelId }
  -- | Create a category
  | CreateGuildChannelOptsCategory
  deriving (Int -> CreateGuildChannelOpts -> ShowS
[CreateGuildChannelOpts] -> ShowS
CreateGuildChannelOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateGuildChannelOpts] -> ShowS
$cshowList :: [CreateGuildChannelOpts] -> ShowS
show :: CreateGuildChannelOpts -> String
$cshow :: CreateGuildChannelOpts -> String
showsPrec :: Int -> CreateGuildChannelOpts -> ShowS
$cshowsPrec :: Int -> CreateGuildChannelOpts -> ShowS
Show, ReadPrec [CreateGuildChannelOpts]
ReadPrec CreateGuildChannelOpts
Int -> ReadS CreateGuildChannelOpts
ReadS [CreateGuildChannelOpts]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateGuildChannelOpts]
$creadListPrec :: ReadPrec [CreateGuildChannelOpts]
readPrec :: ReadPrec CreateGuildChannelOpts
$creadPrec :: ReadPrec CreateGuildChannelOpts
readList :: ReadS [CreateGuildChannelOpts]
$creadList :: ReadS [CreateGuildChannelOpts]
readsPrec :: Int -> ReadS CreateGuildChannelOpts
$creadsPrec :: Int -> ReadS CreateGuildChannelOpts
Read, CreateGuildChannelOpts -> CreateGuildChannelOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateGuildChannelOpts -> CreateGuildChannelOpts -> Bool
$c/= :: CreateGuildChannelOpts -> CreateGuildChannelOpts -> Bool
== :: CreateGuildChannelOpts -> CreateGuildChannelOpts -> Bool
$c== :: CreateGuildChannelOpts -> CreateGuildChannelOpts -> Bool
Eq, Eq CreateGuildChannelOpts
CreateGuildChannelOpts -> CreateGuildChannelOpts -> Bool
CreateGuildChannelOpts -> CreateGuildChannelOpts -> Ordering
CreateGuildChannelOpts
-> CreateGuildChannelOpts -> CreateGuildChannelOpts
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 :: CreateGuildChannelOpts
-> CreateGuildChannelOpts -> CreateGuildChannelOpts
$cmin :: CreateGuildChannelOpts
-> CreateGuildChannelOpts -> CreateGuildChannelOpts
max :: CreateGuildChannelOpts
-> CreateGuildChannelOpts -> CreateGuildChannelOpts
$cmax :: CreateGuildChannelOpts
-> CreateGuildChannelOpts -> CreateGuildChannelOpts
>= :: CreateGuildChannelOpts -> CreateGuildChannelOpts -> Bool
$c>= :: CreateGuildChannelOpts -> CreateGuildChannelOpts -> Bool
> :: CreateGuildChannelOpts -> CreateGuildChannelOpts -> Bool
$c> :: CreateGuildChannelOpts -> CreateGuildChannelOpts -> Bool
<= :: CreateGuildChannelOpts -> CreateGuildChannelOpts -> Bool
$c<= :: CreateGuildChannelOpts -> CreateGuildChannelOpts -> Bool
< :: CreateGuildChannelOpts -> CreateGuildChannelOpts -> Bool
$c< :: CreateGuildChannelOpts -> CreateGuildChannelOpts -> Bool
compare :: CreateGuildChannelOpts -> CreateGuildChannelOpts -> Ordering
$ccompare :: CreateGuildChannelOpts -> CreateGuildChannelOpts -> Ordering
Ord)

-- | Converts a channel name, a list of permissions and other channel options into a JSON Value 
createChannelOptsToJSON :: T.Text -> [Overwrite] -> CreateGuildChannelOpts -> Value
createChannelOptsToJSON :: Text -> [Overwrite] -> CreateGuildChannelOpts -> Value
createChannelOptsToJSON Text
name [Overwrite]
perms CreateGuildChannelOpts
opts = [Maybe Pair] -> Value
objectFromMaybes [Maybe Pair]
optsJSON
  where
  optsJSON :: [Maybe Pair]
optsJSON = case CreateGuildChannelOpts
opts of
    CreateGuildChannelOptsText{Maybe Bool
Maybe Integer
Maybe Text
Maybe ChannelId
createGuildChannelOptsCategoryId :: Maybe ChannelId
createGuildChannelOptsIsNSFW :: Maybe Bool
createGuildChannelOptsUserMessageRateDelay :: Maybe Integer
createGuildChannelOptsTopic :: Maybe Text
createGuildChannelOptsCategoryId :: CreateGuildChannelOpts -> Maybe ChannelId
createGuildChannelOptsIsNSFW :: CreateGuildChannelOpts -> Maybe Bool
createGuildChannelOptsUserMessageRateDelay :: CreateGuildChannelOpts -> Maybe Integer
createGuildChannelOptsTopic :: CreateGuildChannelOpts -> Maybe Text
..} ->
                          [AesonKey
"name" forall a. ToJSON a => AesonKey -> a -> Maybe Pair
.== Text -> Value
String Text
name
                          ,AesonKey
"type" forall a. ToJSON a => AesonKey -> a -> Maybe Pair
.== Scientific -> Value
Number Scientific
0
                          ,AesonKey
"permission_overwrites" forall a. ToJSON a => AesonKey -> a -> Maybe Pair
.== [Overwrite]
perms
                          ,AesonKey
"topic" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Text
createGuildChannelOptsTopic
                          ,AesonKey
"rate_limit_per_user" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Integer
createGuildChannelOptsUserMessageRateDelay
                          ,AesonKey
"nsfw" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Bool
createGuildChannelOptsIsNSFW
                          ,AesonKey
"parent_id" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe ChannelId
createGuildChannelOptsCategoryId]
    CreateGuildChannelOptsVoice{Maybe Integer
Maybe ChannelId
createGuildChannelOptsCategoryId :: Maybe ChannelId
createGuildChannelOptsMaxUsers :: Maybe Integer
createGuildChannelOptsBitrate :: Maybe Integer
createGuildChannelOptsMaxUsers :: CreateGuildChannelOpts -> Maybe Integer
createGuildChannelOptsBitrate :: CreateGuildChannelOpts -> Maybe Integer
createGuildChannelOptsCategoryId :: CreateGuildChannelOpts -> Maybe ChannelId
..} ->
                          [AesonKey
"name" forall a. ToJSON a => AesonKey -> a -> Maybe Pair
.== Text -> Value
String Text
name
                          ,AesonKey
"type" forall a. ToJSON a => AesonKey -> a -> Maybe Pair
.== Scientific -> Value
Number Scientific
2
                          ,AesonKey
"permission_overwrites" forall a. ToJSON a => AesonKey -> a -> Maybe Pair
.== [Overwrite]
perms
                          ,AesonKey
"bitrate" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Integer
createGuildChannelOptsBitrate
                          ,AesonKey
"user_limit" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Integer
createGuildChannelOptsMaxUsers
                          ,AesonKey
"parent_id" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe ChannelId
createGuildChannelOptsCategoryId]
    CreateGuildChannelOpts
CreateGuildChannelOptsCategory ->
                          [AesonKey
"name" forall a. ToJSON a => AesonKey -> a -> Maybe Pair
.== Text -> Value
String Text
name
                          ,AesonKey
"type" forall a. ToJSON a => AesonKey -> a -> Maybe Pair
.== Scientific -> Value
Number Scientific
4
                          ,AesonKey
"permission_overwrites" forall a. ToJSON a => AesonKey -> a -> Maybe Pair
.== [Overwrite]
perms]


-- | Options for `ModifyGuild`
--
-- See <https://discord.com/developers/docs/resources/guild#modify-guild>
data ModifyGuildOpts = ModifyGuildOpts
  { ModifyGuildOpts -> Maybe Text
modifyGuildOptsName         :: Maybe T.Text
  , ModifyGuildOpts -> Maybe ChannelId
modifyGuildOptsAFKChannelId :: Maybe ChannelId
  , ModifyGuildOpts -> Maybe Text
modifyGuildOptsIcon         :: Maybe T.Text
  , ModifyGuildOpts -> Maybe UserId
modifyGuildOptsOwnerId      :: Maybe UserId
   -- Region
   -- VerificationLevel
   -- DefaultMessageNotification
   -- ExplicitContentFilter
  } deriving (Int -> ModifyGuildOpts -> ShowS
[ModifyGuildOpts] -> ShowS
ModifyGuildOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyGuildOpts] -> ShowS
$cshowList :: [ModifyGuildOpts] -> ShowS
show :: ModifyGuildOpts -> String
$cshow :: ModifyGuildOpts -> String
showsPrec :: Int -> ModifyGuildOpts -> ShowS
$cshowsPrec :: Int -> ModifyGuildOpts -> ShowS
Show, ReadPrec [ModifyGuildOpts]
ReadPrec ModifyGuildOpts
Int -> ReadS ModifyGuildOpts
ReadS [ModifyGuildOpts]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyGuildOpts]
$creadListPrec :: ReadPrec [ModifyGuildOpts]
readPrec :: ReadPrec ModifyGuildOpts
$creadPrec :: ReadPrec ModifyGuildOpts
readList :: ReadS [ModifyGuildOpts]
$creadList :: ReadS [ModifyGuildOpts]
readsPrec :: Int -> ReadS ModifyGuildOpts
$creadsPrec :: Int -> ReadS ModifyGuildOpts
Read, ModifyGuildOpts -> ModifyGuildOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyGuildOpts -> ModifyGuildOpts -> Bool
$c/= :: ModifyGuildOpts -> ModifyGuildOpts -> Bool
== :: ModifyGuildOpts -> ModifyGuildOpts -> Bool
$c== :: ModifyGuildOpts -> ModifyGuildOpts -> Bool
Eq, Eq ModifyGuildOpts
ModifyGuildOpts -> ModifyGuildOpts -> Bool
ModifyGuildOpts -> ModifyGuildOpts -> Ordering
ModifyGuildOpts -> ModifyGuildOpts -> ModifyGuildOpts
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 :: ModifyGuildOpts -> ModifyGuildOpts -> ModifyGuildOpts
$cmin :: ModifyGuildOpts -> ModifyGuildOpts -> ModifyGuildOpts
max :: ModifyGuildOpts -> ModifyGuildOpts -> ModifyGuildOpts
$cmax :: ModifyGuildOpts -> ModifyGuildOpts -> ModifyGuildOpts
>= :: ModifyGuildOpts -> ModifyGuildOpts -> Bool
$c>= :: ModifyGuildOpts -> ModifyGuildOpts -> Bool
> :: ModifyGuildOpts -> ModifyGuildOpts -> Bool
$c> :: ModifyGuildOpts -> ModifyGuildOpts -> Bool
<= :: ModifyGuildOpts -> ModifyGuildOpts -> Bool
$c<= :: ModifyGuildOpts -> ModifyGuildOpts -> Bool
< :: ModifyGuildOpts -> ModifyGuildOpts -> Bool
$c< :: ModifyGuildOpts -> ModifyGuildOpts -> Bool
compare :: ModifyGuildOpts -> ModifyGuildOpts -> Ordering
$ccompare :: ModifyGuildOpts -> ModifyGuildOpts -> Ordering
Ord)

instance ToJSON ModifyGuildOpts where
  toJSON :: ModifyGuildOpts -> Value
toJSON ModifyGuildOpts{Maybe Text
Maybe UserId
Maybe ChannelId
modifyGuildOptsOwnerId :: Maybe UserId
modifyGuildOptsIcon :: Maybe Text
modifyGuildOptsAFKChannelId :: Maybe ChannelId
modifyGuildOptsName :: Maybe Text
modifyGuildOptsOwnerId :: ModifyGuildOpts -> Maybe UserId
modifyGuildOptsIcon :: ModifyGuildOpts -> Maybe Text
modifyGuildOptsAFKChannelId :: ModifyGuildOpts -> Maybe ChannelId
modifyGuildOptsName :: ModifyGuildOpts -> Maybe Text
..} = [Maybe Pair] -> Value
objectFromMaybes
                                  [AesonKey
"name" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Text
modifyGuildOptsName,
                                   AesonKey
"afk_channel_id" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe ChannelId
modifyGuildOptsAFKChannelId,
                                   AesonKey
"icon" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Text
modifyGuildOptsIcon,
                                   AesonKey
"owner_id" forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe UserId
modifyGuildOptsOwnerId]

data GuildMembersTiming = GuildMembersTiming
                          { GuildMembersTiming -> Maybe Int
guildMembersTimingLimit :: Maybe Int
                          , GuildMembersTiming -> Maybe UserId
guildMembersTimingAfter :: Maybe UserId
                          } deriving (Int -> GuildMembersTiming -> ShowS
[GuildMembersTiming] -> ShowS
GuildMembersTiming -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuildMembersTiming] -> ShowS
$cshowList :: [GuildMembersTiming] -> ShowS
show :: GuildMembersTiming -> String
$cshow :: GuildMembersTiming -> String
showsPrec :: Int -> GuildMembersTiming -> ShowS
$cshowsPrec :: Int -> GuildMembersTiming -> ShowS
Show, ReadPrec [GuildMembersTiming]
ReadPrec GuildMembersTiming
Int -> ReadS GuildMembersTiming
ReadS [GuildMembersTiming]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GuildMembersTiming]
$creadListPrec :: ReadPrec [GuildMembersTiming]
readPrec :: ReadPrec GuildMembersTiming
$creadPrec :: ReadPrec GuildMembersTiming
readList :: ReadS [GuildMembersTiming]
$creadList :: ReadS [GuildMembersTiming]
readsPrec :: Int -> ReadS GuildMembersTiming
$creadsPrec :: Int -> ReadS GuildMembersTiming
Read, GuildMembersTiming -> GuildMembersTiming -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GuildMembersTiming -> GuildMembersTiming -> Bool
$c/= :: GuildMembersTiming -> GuildMembersTiming -> Bool
== :: GuildMembersTiming -> GuildMembersTiming -> Bool
$c== :: GuildMembersTiming -> GuildMembersTiming -> Bool
Eq, Eq GuildMembersTiming
GuildMembersTiming -> GuildMembersTiming -> Bool
GuildMembersTiming -> GuildMembersTiming -> Ordering
GuildMembersTiming -> GuildMembersTiming -> GuildMembersTiming
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 :: GuildMembersTiming -> GuildMembersTiming -> GuildMembersTiming
$cmin :: GuildMembersTiming -> GuildMembersTiming -> GuildMembersTiming
max :: GuildMembersTiming -> GuildMembersTiming -> GuildMembersTiming
$cmax :: GuildMembersTiming -> GuildMembersTiming -> GuildMembersTiming
>= :: GuildMembersTiming -> GuildMembersTiming -> Bool
$c>= :: GuildMembersTiming -> GuildMembersTiming -> Bool
> :: GuildMembersTiming -> GuildMembersTiming -> Bool
$c> :: GuildMembersTiming -> GuildMembersTiming -> Bool
<= :: GuildMembersTiming -> GuildMembersTiming -> Bool
$c<= :: GuildMembersTiming -> GuildMembersTiming -> Bool
< :: GuildMembersTiming -> GuildMembersTiming -> Bool
$c< :: GuildMembersTiming -> GuildMembersTiming -> Bool
compare :: GuildMembersTiming -> GuildMembersTiming -> Ordering
$ccompare :: GuildMembersTiming -> GuildMembersTiming -> Ordering
Ord)

guildMembersTimingToQuery :: GuildMembersTiming -> R.Option 'R.Https
guildMembersTimingToQuery :: GuildMembersTiming -> Option 'Https
guildMembersTimingToQuery (GuildMembersTiming Maybe Int
mLimit Maybe UserId
mAfter) =
  let limit :: Option 'Https
limit = case Maybe Int
mLimit of
              Maybe Int
Nothing -> forall a. Monoid a => a
mempty
              Just Int
lim -> Text
"limit" forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=: Int
lim
      after :: Option 'Https
after = case Maybe UserId
mAfter of
              Maybe UserId
Nothing -> forall a. Monoid a => a
mempty
              Just UserId
aft -> Text
"after" forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=: forall a. Show a => a -> String
show UserId
aft
  in Option 'Https
limit forall a. Semigroup a => a -> a -> a
<> Option 'Https
after

guildMajorRoute :: GuildRequest a -> String
guildMajorRoute :: forall a. GuildRequest a -> String
guildMajorRoute GuildRequest a
c = case GuildRequest a
c of
  (GetGuild GuildId
g) ->                         String
"guild " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (ModifyGuild GuildId
g ModifyGuildOpts
_) ->                    String
"guild " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (DeleteGuild GuildId
g) ->                      String
"guild " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (GetGuildChannels GuildId
g) ->            String
"guild_chan " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (CreateGuildChannel GuildId
g Text
_ [Overwrite]
_ CreateGuildChannelOpts
_) ->    String
"guild_chan " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (ModifyGuildChannelPositions GuildId
g [(ChannelId, Int)]
_) -> String
"guild_chan " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (GetGuildMember GuildId
g UserId
_) ->            String
"guild_memb " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (ListGuildMembers GuildId
g GuildMembersTiming
_) ->         String
"guild_membs " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (AddGuildMember GuildId
g UserId
_ AddGuildMemberOpts
_) ->         String
"guild_membs " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (ModifyGuildMember GuildId
g UserId
_ ModifyGuildMemberOpts
_) ->      String
"guild_membs " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (ModifyCurrentUserNick GuildId
g Text
_) ->    String
"guild_membs " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (AddGuildMemberRole GuildId
g UserId
_ RoleId
_) ->     String
"guild_membs " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (RemoveGuildMemberRole GuildId
g UserId
_ RoleId
_) ->  String
"guild_membs " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (RemoveGuildMember GuildId
g UserId
_) ->        String
"guild_membs " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (GetGuildBan GuildId
g UserId
_) ->               String
"guild_bans " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (GetGuildBans GuildId
g) ->                String
"guild_bans " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (CreateGuildBan GuildId
g UserId
_ CreateGuildBanOpts
_) ->           String
"guild_ban " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (RemoveGuildBan GuildId
g UserId
_) ->             String
"guild_ban " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (GetGuildRoles GuildId
g) ->              String
"guild_roles " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (CreateGuildRole GuildId
g ModifyGuildRoleOpts
_) ->          String
"guild_roles " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (ModifyGuildRolePositions GuildId
g [(RoleId, Integer)]
_) -> String
"guild_roles " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (ModifyGuildRole GuildId
g RoleId
_ ModifyGuildRoleOpts
_) ->         String
"guild_role " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (DeleteGuildRole GuildId
g RoleId
_) ->           String
"guild_role " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (GetGuildPruneCount GuildId
g Integer
_) ->       String
"guild_prune " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (BeginGuildPrune GuildId
g Integer
_) ->          String
"guild_prune " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (GetGuildVoiceRegions GuildId
g) ->       String
"guild_voice " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (GetGuildInvites GuildId
g) ->            String
"guild_invit " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (GetGuildIntegrations GuildId
g) ->       String
"guild_integ " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (CreateGuildIntegration GuildId
g IntegrationId
_ CreateGuildIntegrationOpts
_) -> String
"guild_integ " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (ModifyGuildIntegration GuildId
g IntegrationId
_ ModifyGuildIntegrationOpts
_) -> String
"guild_intgr " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (DeleteGuildIntegration GuildId
g IntegrationId
_) ->   String
"guild_intgr " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (SyncGuildIntegration GuildId
g IntegrationId
_) ->      String
"guild_sync " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (GetGuildWidget GuildId
g) ->            String
"guild_widget " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (ModifyGuildWidget GuildId
g GuildWidget
_) ->       String
"guild_widget " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g
  (GetGuildVanityURL GuildId
g) ->                String
"guild " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show GuildId
g


guilds :: R.Url 'R.Https
guilds :: Url 'Https
guilds = Url 'Https
baseUrl forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"guilds"

guildJsonRequest :: GuildRequest r -> JsonRequest
guildJsonRequest :: forall a. GuildRequest a -> JsonRequest
guildJsonRequest GuildRequest r
c = case GuildRequest r
c of
  (GetGuild GuildId
guild) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild) forall a. Monoid a => a
mempty

  (ModifyGuild GuildId
guild ModifyGuildOpts
patch) ->
      forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Patch (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild) (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> ReqBodyJson a
R.ReqBodyJson ModifyGuildOpts
patch)) forall a. Monoid a => a
mempty

  (DeleteGuild GuildId
guild) ->
      Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild) forall a. Monoid a => a
mempty

  (GetGuildChannels GuildId
guild) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"channels") forall a. Monoid a => a
mempty

  (CreateGuildChannel GuildId
guild Text
name [Overwrite]
perms CreateGuildChannelOpts
patch) ->
      forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Post (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"channels")
           (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> ReqBodyJson a
R.ReqBodyJson (Text -> [Overwrite] -> CreateGuildChannelOpts -> Value
createChannelOptsToJSON Text
name [Overwrite]
perms CreateGuildChannelOpts
patch))) forall a. Monoid a => a
mempty

  (ModifyGuildChannelPositions GuildId
guild [(ChannelId, Int)]
newlocs) ->
      let patch :: [Value]
patch = forall a b. (a -> b) -> [a] -> [b]
map (\(ChannelId
a, Int
b) -> [Pair] -> Value
object [(AesonKey
"id", forall a. ToJSON a => a -> Value
toJSON ChannelId
a)
                                         ,(AesonKey
"position", forall a. ToJSON a => a -> Value
toJSON Int
b)]) [(ChannelId, Int)]
newlocs
      in forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Patch (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"channels") (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> ReqBodyJson a
R.ReqBodyJson [Value]
patch)) forall a. Monoid a => a
mempty

  (GetGuildMember GuildId
guild UserId
member) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"members" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ UserId
member) forall a. Monoid a => a
mempty

  (ListGuildMembers GuildId
guild GuildMembersTiming
range) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"members") (GuildMembersTiming -> Option 'Https
guildMembersTimingToQuery GuildMembersTiming
range)

  (AddGuildMember GuildId
guild UserId
user AddGuildMemberOpts
patch) ->
      forall a.
HttpBody a =>
Url 'Https -> a -> Option 'Https -> JsonRequest
Put (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"members" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ UserId
user) (forall a. a -> ReqBodyJson a
R.ReqBodyJson AddGuildMemberOpts
patch) forall a. Monoid a => a
mempty

  (ModifyGuildMember GuildId
guild UserId
member ModifyGuildMemberOpts
patch) ->
      forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Patch (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"members" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ UserId
member) (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> ReqBodyJson a
R.ReqBodyJson ModifyGuildMemberOpts
patch)) forall a. Monoid a => a
mempty

  (ModifyCurrentUserNick GuildId
guild Text
name) ->
      let patch :: Value
patch = [Pair] -> Value
object [AesonKey
"nick" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= Text
name]
      in forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Patch (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"members/@me/nick") (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> ReqBodyJson a
R.ReqBodyJson Value
patch)) forall a. Monoid a => a
mempty

  (AddGuildMemberRole GuildId
guild UserId
user RoleId
role) ->
      let body :: ReqBodyJson Value
body = forall a. a -> ReqBodyJson a
R.ReqBodyJson ([Pair] -> Value
object [])
      in forall a.
HttpBody a =>
Url 'Https -> a -> Option 'Https -> JsonRequest
Put (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"members" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ UserId
user forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"roles" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ RoleId
role) ReqBodyJson Value
body forall a. Monoid a => a
mempty

  (RemoveGuildMemberRole GuildId
guild UserId
user RoleId
role) ->
      Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"members" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ UserId
user forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"roles" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ RoleId
role) forall a. Monoid a => a
mempty

  (RemoveGuildMember GuildId
guild UserId
user) ->
      Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"members" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ UserId
user) forall a. Monoid a => a
mempty

  (GetGuildBan GuildId
guild UserId
user) -> Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"bans" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ UserId
user) forall a. Monoid a => a
mempty

  (GetGuildBans GuildId
guild) -> Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"bans") forall a. Monoid a => a
mempty

  (CreateGuildBan GuildId
guild UserId
user CreateGuildBanOpts
patch) ->
      forall a.
HttpBody a =>
Url 'Https -> a -> Option 'Https -> JsonRequest
Put (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"bans" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ UserId
user) (forall a. a -> ReqBodyJson a
R.ReqBodyJson CreateGuildBanOpts
patch) forall a. Monoid a => a
mempty

  (RemoveGuildBan GuildId
guild UserId
ban) ->
      Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"bans" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ UserId
ban) forall a. Monoid a => a
mempty

  (GetGuildRoles GuildId
guild) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"roles") forall a. Monoid a => a
mempty

  (CreateGuildRole GuildId
guild ModifyGuildRoleOpts
patch) ->
      forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Post (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"roles") (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> ReqBodyJson a
R.ReqBodyJson ModifyGuildRoleOpts
patch)) forall a. Monoid a => a
mempty

  (ModifyGuildRolePositions GuildId
guild [(RoleId, Integer)]
patch) ->
      let body :: [Value]
body = forall a b. (a -> b) -> [a] -> [b]
map (\(RoleId
role, Integer
pos) -> [Pair] -> Value
object [AesonKey
"id"forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.=RoleId
role, AesonKey
"position"forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.=Integer
pos]) [(RoleId, Integer)]
patch
      in forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Patch (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"roles") (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> ReqBodyJson a
R.ReqBodyJson [Value]
body)) forall a. Monoid a => a
mempty

  (ModifyGuildRole GuildId
guild RoleId
role ModifyGuildRoleOpts
patch) ->
      forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Patch (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"roles" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ RoleId
role) (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> ReqBodyJson a
R.ReqBodyJson ModifyGuildRoleOpts
patch)) forall a. Monoid a => a
mempty

  (DeleteGuildRole GuildId
guild RoleId
role) ->
      Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"roles" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ RoleId
role) forall a. Monoid a => a
mempty

  (GetGuildPruneCount GuildId
guild Integer
days) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"prune") (Text
"days" forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=: Integer
days)

  (BeginGuildPrune GuildId
guild Integer
days) ->
      forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Post (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"prune") (forall (f :: * -> *) a. Applicative f => a -> f a
pure NoReqBody
R.NoReqBody) (Text
"days" forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=: Integer
days)

  (GetGuildVoiceRegions GuildId
guild) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"regions") forall a. Monoid a => a
mempty

  (GetGuildInvites GuildId
guild) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"invites") forall a. Monoid a => a
mempty

  (GetGuildIntegrations GuildId
guild) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"integrations") forall a. Monoid a => a
mempty

  (CreateGuildIntegration GuildId
guild IntegrationId
iid CreateGuildIntegrationOpts
opts) ->
      let patch :: Value
patch = [Pair] -> Value
object [AesonKey
"type" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= CreateGuildIntegrationOpts -> Text
createGuildIntegrationOptsType CreateGuildIntegrationOpts
opts, AesonKey
"id" forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= IntegrationId
iid]
      in forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Post (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"integrations") (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> ReqBodyJson a
R.ReqBodyJson Value
patch)) forall a. Monoid a => a
mempty

  (ModifyGuildIntegration GuildId
guild IntegrationId
iid ModifyGuildIntegrationOpts
patch) ->
      let body :: RestIO (ReqBodyJson ModifyGuildIntegrationOpts)
body = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> ReqBodyJson a
R.ReqBodyJson ModifyGuildIntegrationOpts
patch)
      in forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Patch (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"integrations" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ IntegrationId
iid) RestIO (ReqBodyJson ModifyGuildIntegrationOpts)
body forall a. Monoid a => a
mempty

  (DeleteGuildIntegration GuildId
guild IntegrationId
integ) ->
      Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"integrations" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ IntegrationId
integ) forall a. Monoid a => a
mempty

  (SyncGuildIntegration GuildId
guild IntegrationId
integ) ->
      forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Post (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"integrations" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ IntegrationId
integ) (forall (f :: * -> *) a. Applicative f => a -> f a
pure NoReqBody
R.NoReqBody) forall a. Monoid a => a
mempty

  (GetGuildWidget GuildId
guild) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"integrations") forall a. Monoid a => a
mempty

  (ModifyGuildWidget GuildId
guild GuildWidget
patch) ->
      forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Patch (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"widget") (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> ReqBodyJson a
R.ReqBodyJson GuildWidget
patch)) forall a. Monoid a => a
mempty

  (GetGuildVanityURL GuildId
guild) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
guilds forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
guild forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"vanity-url") forall a. Monoid a => a
mempty