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

-- | Provides actions for Channel API interactions
module Discord.Internal.Rest.Guild
  ( GuildRequest(..)
  , CreateGuildChannelOpts(..)
  , CreateGuildOpts(..)
  , 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

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

-- | Data constructor for requests. See <https://discord.com/developers/docs/resources/ API>
data GuildRequest a where
  CreateGuild              :: CreateGuildOpts -> GuildRequest 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 ()
  -- | 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 'GuildEmbed' object. Requires the 'MANAGE_GUILD' permission.
  GetGuildEmbed            :: GuildId -> GuildRequest GuildEmbed
  -- | Modify a 'GuildEmbed' object for the guild. All attributes may be passed in with
  --   JSON and modified. Requires the 'MANAGE_GUILD' permission. Returns the updated
  --   'GuildEmbed' object.
  ModifyGuildEmbed         :: GuildId -> GuildEmbed -> GuildRequest GuildEmbed
  -- | Vanity URL
  GetGuildVanityURL        :: GuildId -> GuildRequest T.Text

data CreateGuildOpts = CreateGuildOpts
  { CreateGuildOpts -> Text
createGuildOptsName :: T.Text
  , CreateGuildOpts -> [Channel]
createGuildOptsChannels :: [Channel]
  } deriving (Int -> CreateGuildOpts -> ShowS
[CreateGuildOpts] -> ShowS
CreateGuildOpts -> String
(Int -> CreateGuildOpts -> ShowS)
-> (CreateGuildOpts -> String)
-> ([CreateGuildOpts] -> ShowS)
-> Show CreateGuildOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateGuildOpts] -> ShowS
$cshowList :: [CreateGuildOpts] -> ShowS
show :: CreateGuildOpts -> String
$cshow :: CreateGuildOpts -> String
showsPrec :: Int -> CreateGuildOpts -> ShowS
$cshowsPrec :: Int -> CreateGuildOpts -> ShowS
Show, CreateGuildOpts -> CreateGuildOpts -> Bool
(CreateGuildOpts -> CreateGuildOpts -> Bool)
-> (CreateGuildOpts -> CreateGuildOpts -> Bool)
-> Eq CreateGuildOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateGuildOpts -> CreateGuildOpts -> Bool
$c/= :: CreateGuildOpts -> CreateGuildOpts -> Bool
== :: CreateGuildOpts -> CreateGuildOpts -> Bool
$c== :: CreateGuildOpts -> CreateGuildOpts -> Bool
Eq, Eq CreateGuildOpts
Eq CreateGuildOpts
-> (CreateGuildOpts -> CreateGuildOpts -> Ordering)
-> (CreateGuildOpts -> CreateGuildOpts -> Bool)
-> (CreateGuildOpts -> CreateGuildOpts -> Bool)
-> (CreateGuildOpts -> CreateGuildOpts -> Bool)
-> (CreateGuildOpts -> CreateGuildOpts -> Bool)
-> (CreateGuildOpts -> CreateGuildOpts -> CreateGuildOpts)
-> (CreateGuildOpts -> CreateGuildOpts -> CreateGuildOpts)
-> Ord CreateGuildOpts
CreateGuildOpts -> CreateGuildOpts -> Bool
CreateGuildOpts -> CreateGuildOpts -> Ordering
CreateGuildOpts -> CreateGuildOpts -> CreateGuildOpts
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 :: CreateGuildOpts -> CreateGuildOpts -> CreateGuildOpts
$cmin :: CreateGuildOpts -> CreateGuildOpts -> CreateGuildOpts
max :: CreateGuildOpts -> CreateGuildOpts -> CreateGuildOpts
$cmax :: CreateGuildOpts -> CreateGuildOpts -> CreateGuildOpts
>= :: CreateGuildOpts -> CreateGuildOpts -> Bool
$c>= :: CreateGuildOpts -> CreateGuildOpts -> Bool
> :: CreateGuildOpts -> CreateGuildOpts -> Bool
$c> :: CreateGuildOpts -> CreateGuildOpts -> Bool
<= :: CreateGuildOpts -> CreateGuildOpts -> Bool
$c<= :: CreateGuildOpts -> CreateGuildOpts -> Bool
< :: CreateGuildOpts -> CreateGuildOpts -> Bool
$c< :: CreateGuildOpts -> CreateGuildOpts -> Bool
compare :: CreateGuildOpts -> CreateGuildOpts -> Ordering
$ccompare :: CreateGuildOpts -> CreateGuildOpts -> Ordering
$cp1Ord :: Eq CreateGuildOpts
Ord)

instance ToJSON CreateGuildOpts where
  toJSON :: CreateGuildOpts -> Value
toJSON CreateGuildOpts{[Channel]
Text
createGuildOptsChannels :: [Channel]
createGuildOptsName :: Text
createGuildOptsChannels :: CreateGuildOpts -> [Channel]
createGuildOptsName :: CreateGuildOpts -> Text
..} =  [Pair] -> Value
object [(Key
name, Value
val) | (Key
name, Just Value
val) <-
         [ (Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
createGuildOptsName )
         , (Key
"channels", [Channel] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Channel] -> Value) -> Maybe [Channel] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Channel] -> Maybe [Channel]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Channel]
createGuildOptsChannels ) ]]

data ModifyGuildIntegrationOpts = ModifyGuildIntegrationOpts
  { ModifyGuildIntegrationOpts -> Integer
modifyGuildIntegrationOptsExpireBehavior :: Integer
  , ModifyGuildIntegrationOpts -> Integer
modifyGuildIntegrationOptsExpireGraceSeconds :: Integer
  , ModifyGuildIntegrationOpts -> Bool
modifyGuildIntegrationOptsEmoticonsEnabled :: Bool
  } deriving (Int -> ModifyGuildIntegrationOpts -> ShowS
[ModifyGuildIntegrationOpts] -> ShowS
ModifyGuildIntegrationOpts -> String
(Int -> ModifyGuildIntegrationOpts -> ShowS)
-> (ModifyGuildIntegrationOpts -> String)
-> ([ModifyGuildIntegrationOpts] -> ShowS)
-> Show ModifyGuildIntegrationOpts
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, ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts -> Bool
(ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts -> Bool)
-> (ModifyGuildIntegrationOpts
    -> ModifyGuildIntegrationOpts -> Bool)
-> Eq ModifyGuildIntegrationOpts
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
Eq ModifyGuildIntegrationOpts
-> (ModifyGuildIntegrationOpts
    -> ModifyGuildIntegrationOpts -> Ordering)
-> (ModifyGuildIntegrationOpts
    -> ModifyGuildIntegrationOpts -> Bool)
-> (ModifyGuildIntegrationOpts
    -> ModifyGuildIntegrationOpts -> Bool)
-> (ModifyGuildIntegrationOpts
    -> ModifyGuildIntegrationOpts -> Bool)
-> (ModifyGuildIntegrationOpts
    -> ModifyGuildIntegrationOpts -> Bool)
-> (ModifyGuildIntegrationOpts
    -> ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts)
-> (ModifyGuildIntegrationOpts
    -> ModifyGuildIntegrationOpts -> ModifyGuildIntegrationOpts)
-> Ord 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
$cp1Ord :: Eq ModifyGuildIntegrationOpts
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
..} =  [Pair] -> Value
object [(Key
name, Value
val) | (Key
name, Just Value
val) <-
         [ (Key
"expire_grace_period", Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> Maybe Integer -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Maybe Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
modifyGuildIntegrationOptsExpireGraceSeconds )
         , (Key
"expire_behavior", Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> Maybe Integer -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Maybe Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
modifyGuildIntegrationOptsExpireBehavior )
         , (Key
"enable_emoticons", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Maybe Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
modifyGuildIntegrationOptsEmoticonsEnabled ) ]]

data CreateGuildIntegrationOpts = CreateGuildIntegrationOpts
  { CreateGuildIntegrationOpts -> Text
createGuildIntegrationOptsType :: T.Text
  } deriving (Int -> CreateGuildIntegrationOpts -> ShowS
[CreateGuildIntegrationOpts] -> ShowS
CreateGuildIntegrationOpts -> String
(Int -> CreateGuildIntegrationOpts -> ShowS)
-> (CreateGuildIntegrationOpts -> String)
-> ([CreateGuildIntegrationOpts] -> ShowS)
-> Show CreateGuildIntegrationOpts
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, CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts -> Bool
(CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts -> Bool)
-> (CreateGuildIntegrationOpts
    -> CreateGuildIntegrationOpts -> Bool)
-> Eq CreateGuildIntegrationOpts
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
Eq CreateGuildIntegrationOpts
-> (CreateGuildIntegrationOpts
    -> CreateGuildIntegrationOpts -> Ordering)
-> (CreateGuildIntegrationOpts
    -> CreateGuildIntegrationOpts -> Bool)
-> (CreateGuildIntegrationOpts
    -> CreateGuildIntegrationOpts -> Bool)
-> (CreateGuildIntegrationOpts
    -> CreateGuildIntegrationOpts -> Bool)
-> (CreateGuildIntegrationOpts
    -> CreateGuildIntegrationOpts -> Bool)
-> (CreateGuildIntegrationOpts
    -> CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts)
-> (CreateGuildIntegrationOpts
    -> CreateGuildIntegrationOpts -> CreateGuildIntegrationOpts)
-> Ord 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
$cp1Ord :: Eq CreateGuildIntegrationOpts
Ord)

instance ToJSON CreateGuildIntegrationOpts where
  toJSON :: CreateGuildIntegrationOpts -> Value
toJSON CreateGuildIntegrationOpts{Text
createGuildIntegrationOptsType :: Text
createGuildIntegrationOptsType :: CreateGuildIntegrationOpts -> Text
..} =  [Pair] -> Value
object [(Key
name, Value
val) | (Key
name, Just Value
val) <-
                       [(Key
"type", Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
createGuildIntegrationOptsType ) ]]

data CreateGuildBanOpts = CreateGuildBanOpts
  { CreateGuildBanOpts -> Maybe Int
createGuildBanOptsDeleteLastNMessages :: Maybe Int
  , CreateGuildBanOpts -> Maybe Text
createGuildBanOptsReason              :: Maybe T.Text
  } deriving (Int -> CreateGuildBanOpts -> ShowS
[CreateGuildBanOpts] -> ShowS
CreateGuildBanOpts -> String
(Int -> CreateGuildBanOpts -> ShowS)
-> (CreateGuildBanOpts -> String)
-> ([CreateGuildBanOpts] -> ShowS)
-> Show CreateGuildBanOpts
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, CreateGuildBanOpts -> CreateGuildBanOpts -> Bool
(CreateGuildBanOpts -> CreateGuildBanOpts -> Bool)
-> (CreateGuildBanOpts -> CreateGuildBanOpts -> Bool)
-> Eq CreateGuildBanOpts
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
Eq CreateGuildBanOpts
-> (CreateGuildBanOpts -> CreateGuildBanOpts -> Ordering)
-> (CreateGuildBanOpts -> CreateGuildBanOpts -> Bool)
-> (CreateGuildBanOpts -> CreateGuildBanOpts -> Bool)
-> (CreateGuildBanOpts -> CreateGuildBanOpts -> Bool)
-> (CreateGuildBanOpts -> CreateGuildBanOpts -> Bool)
-> (CreateGuildBanOpts -> CreateGuildBanOpts -> CreateGuildBanOpts)
-> (CreateGuildBanOpts -> CreateGuildBanOpts -> CreateGuildBanOpts)
-> Ord 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
$cp1Ord :: Eq CreateGuildBanOpts
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
..} =  [Pair] -> Value
object [(Key
name, Value
val) | (Key
name, Just Value
val) <-
                       [(Key
"delete-message-days",
                             Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Value) -> Maybe Int -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
createGuildBanOptsDeleteLastNMessages ),
                        (Key
"reason", Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
createGuildBanOptsReason )]]

data ModifyGuildRoleOpts = ModifyGuildRoleOpts
  { ModifyGuildRoleOpts -> Maybe Text
modifyGuildRoleOptsName            :: Maybe T.Text
  , ModifyGuildRoleOpts -> Maybe Integer
modifyGuildRoleOptsPermissions     :: Maybe Integer
  , ModifyGuildRoleOpts -> Maybe Integer
modifyGuildRoleOptsColor           :: Maybe ColorInteger
  , ModifyGuildRoleOpts -> Maybe Bool
modifyGuildRoleOptsSeparateSidebar :: Maybe Bool
  , ModifyGuildRoleOpts -> Maybe Bool
modifyGuildRoleOptsMentionable     :: Maybe Bool
  } deriving (Int -> ModifyGuildRoleOpts -> ShowS
[ModifyGuildRoleOpts] -> ShowS
ModifyGuildRoleOpts -> String
(Int -> ModifyGuildRoleOpts -> ShowS)
-> (ModifyGuildRoleOpts -> String)
-> ([ModifyGuildRoleOpts] -> ShowS)
-> Show ModifyGuildRoleOpts
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, ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Bool
(ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Bool)
-> (ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Bool)
-> Eq ModifyGuildRoleOpts
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
Eq ModifyGuildRoleOpts
-> (ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Ordering)
-> (ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Bool)
-> (ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Bool)
-> (ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Bool)
-> (ModifyGuildRoleOpts -> ModifyGuildRoleOpts -> Bool)
-> (ModifyGuildRoleOpts
    -> ModifyGuildRoleOpts -> ModifyGuildRoleOpts)
-> (ModifyGuildRoleOpts
    -> ModifyGuildRoleOpts -> ModifyGuildRoleOpts)
-> Ord 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
$cp1Ord :: Eq ModifyGuildRoleOpts
Ord)

instance ToJSON ModifyGuildRoleOpts where
  toJSON :: ModifyGuildRoleOpts -> Value
toJSON ModifyGuildRoleOpts{Maybe Bool
Maybe Integer
Maybe Text
modifyGuildRoleOptsMentionable :: Maybe Bool
modifyGuildRoleOptsSeparateSidebar :: Maybe Bool
modifyGuildRoleOptsColor :: Maybe Integer
modifyGuildRoleOptsPermissions :: Maybe Integer
modifyGuildRoleOptsName :: Maybe Text
modifyGuildRoleOptsMentionable :: ModifyGuildRoleOpts -> Maybe Bool
modifyGuildRoleOptsSeparateSidebar :: ModifyGuildRoleOpts -> Maybe Bool
modifyGuildRoleOptsColor :: ModifyGuildRoleOpts -> Maybe Integer
modifyGuildRoleOptsPermissions :: ModifyGuildRoleOpts -> Maybe Integer
modifyGuildRoleOptsName :: ModifyGuildRoleOpts -> Maybe Text
..} =  [Pair] -> Value
object [(Key
name, Value
val) | (Key
name, Just Value
val) <-
                       [(Key
"name",        Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
modifyGuildRoleOptsName ),
                        (Key
"permissions", Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> Maybe Integer -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
modifyGuildRoleOptsPermissions ),
                        (Key
"color",       Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> Maybe Integer -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
modifyGuildRoleOptsColor ),
                        (Key
"hoist",       Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
modifyGuildRoleOptsSeparateSidebar ),
                        (Key
"mentionable", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
modifyGuildRoleOptsMentionable )]]

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
(Int -> AddGuildMemberOpts -> ShowS)
-> (AddGuildMemberOpts -> String)
-> ([AddGuildMemberOpts] -> ShowS)
-> Show AddGuildMemberOpts
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, AddGuildMemberOpts -> AddGuildMemberOpts -> Bool
(AddGuildMemberOpts -> AddGuildMemberOpts -> Bool)
-> (AddGuildMemberOpts -> AddGuildMemberOpts -> Bool)
-> Eq AddGuildMemberOpts
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
Eq AddGuildMemberOpts
-> (AddGuildMemberOpts -> AddGuildMemberOpts -> Ordering)
-> (AddGuildMemberOpts -> AddGuildMemberOpts -> Bool)
-> (AddGuildMemberOpts -> AddGuildMemberOpts -> Bool)
-> (AddGuildMemberOpts -> AddGuildMemberOpts -> Bool)
-> (AddGuildMemberOpts -> AddGuildMemberOpts -> Bool)
-> (AddGuildMemberOpts -> AddGuildMemberOpts -> AddGuildMemberOpts)
-> (AddGuildMemberOpts -> AddGuildMemberOpts -> AddGuildMemberOpts)
-> Ord 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
$cp1Ord :: Eq AddGuildMemberOpts
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
..} =  [Pair] -> Value
object [(Key
name, Value
val) | (Key
name, Just Value
val) <-
                                  [(Key
"access_token", Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
addGuildMemberOptsAccessToken ),
                                   (Key
"nick",   Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
addGuildMemberOptsNickname ),
                                   (Key
"roles",  [RoleId] -> Value
forall a. ToJSON a => a -> Value
toJSON ([RoleId] -> Value) -> Maybe [RoleId] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [RoleId]
addGuildMemberOptsRoles ),
                                   (Key
"mute",   Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
addGuildMemberOptsIsMuted ),
                                   (Key
"deaf",   Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
addGuildMemberOptsIsDeafened )]]

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 RoleId
modifyGuildMemberOptsMoveToChannel :: Maybe ChannelId
  } deriving (Int -> ModifyGuildMemberOpts -> ShowS
[ModifyGuildMemberOpts] -> ShowS
ModifyGuildMemberOpts -> String
(Int -> ModifyGuildMemberOpts -> ShowS)
-> (ModifyGuildMemberOpts -> String)
-> ([ModifyGuildMemberOpts] -> ShowS)
-> Show ModifyGuildMemberOpts
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, ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Bool
(ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Bool)
-> (ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Bool)
-> Eq ModifyGuildMemberOpts
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
Eq ModifyGuildMemberOpts
-> (ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Ordering)
-> (ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Bool)
-> (ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Bool)
-> (ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Bool)
-> (ModifyGuildMemberOpts -> ModifyGuildMemberOpts -> Bool)
-> (ModifyGuildMemberOpts
    -> ModifyGuildMemberOpts -> ModifyGuildMemberOpts)
-> (ModifyGuildMemberOpts
    -> ModifyGuildMemberOpts -> ModifyGuildMemberOpts)
-> Ord 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
$cp1Ord :: Eq ModifyGuildMemberOpts
Ord)

instance ToJSON ModifyGuildMemberOpts where
  toJSON :: ModifyGuildMemberOpts -> Value
toJSON ModifyGuildMemberOpts{Maybe Bool
Maybe [RoleId]
Maybe Text
Maybe RoleId
modifyGuildMemberOptsMoveToChannel :: Maybe RoleId
modifyGuildMemberOptsIsDeafened :: Maybe Bool
modifyGuildMemberOptsIsMuted :: Maybe Bool
modifyGuildMemberOptsRoles :: Maybe [RoleId]
modifyGuildMemberOptsNickname :: Maybe Text
modifyGuildMemberOptsMoveToChannel :: ModifyGuildMemberOpts -> Maybe RoleId
modifyGuildMemberOptsIsDeafened :: ModifyGuildMemberOpts -> Maybe Bool
modifyGuildMemberOptsIsMuted :: ModifyGuildMemberOpts -> Maybe Bool
modifyGuildMemberOptsRoles :: ModifyGuildMemberOpts -> Maybe [RoleId]
modifyGuildMemberOptsNickname :: ModifyGuildMemberOpts -> Maybe Text
..} =  [Pair] -> Value
object [(Key
name, Value
val) | (Key
name, Just Value
val) <-
                                  [(Key
"nick",  Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
modifyGuildMemberOptsNickname ),
                                   (Key
"roles", [RoleId] -> Value
forall a. ToJSON a => a -> Value
toJSON ([RoleId] -> Value) -> Maybe [RoleId] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [RoleId]
modifyGuildMemberOptsRoles ),
                                   (Key
"mute",  Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
modifyGuildMemberOptsIsMuted ),
                                   (Key
"deaf",  Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
modifyGuildMemberOptsIsDeafened ),
                                   (Key
"channel_id", RoleId -> Value
forall a. ToJSON a => a -> Value
toJSON (RoleId -> Value) -> Maybe RoleId -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RoleId
modifyGuildMemberOptsMoveToChannel)]]
data CreateGuildChannelOpts
  = CreateGuildChannelOptsText {
    CreateGuildChannelOpts -> Maybe Text
createGuildChannelOptsTopic :: Maybe T.Text
  , CreateGuildChannelOpts -> Maybe Integer
createGuildChannelOptsUserMessageRateDelay :: Maybe Integer
  , CreateGuildChannelOpts -> Maybe Bool
createGuildChannelOptsIsNSFW :: Maybe Bool
  , CreateGuildChannelOpts -> Maybe RoleId
createGuildChannelOptsCategoryId :: Maybe ChannelId }
  | CreateGuildChannelOptsVoice {
    CreateGuildChannelOpts -> Maybe Integer
createGuildChannelOptsBitrate :: Maybe Integer
  , CreateGuildChannelOpts -> Maybe Integer
createGuildChannelOptsMaxUsers :: Maybe Integer
  , createGuildChannelOptsCategoryId :: Maybe ChannelId }
  | CreateGuildChannelOptsCategory
  deriving (Int -> CreateGuildChannelOpts -> ShowS
[CreateGuildChannelOpts] -> ShowS
CreateGuildChannelOpts -> String
(Int -> CreateGuildChannelOpts -> ShowS)
-> (CreateGuildChannelOpts -> String)
-> ([CreateGuildChannelOpts] -> ShowS)
-> Show CreateGuildChannelOpts
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, CreateGuildChannelOpts -> CreateGuildChannelOpts -> Bool
(CreateGuildChannelOpts -> CreateGuildChannelOpts -> Bool)
-> (CreateGuildChannelOpts -> CreateGuildChannelOpts -> Bool)
-> Eq CreateGuildChannelOpts
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
Eq CreateGuildChannelOpts
-> (CreateGuildChannelOpts -> CreateGuildChannelOpts -> Ordering)
-> (CreateGuildChannelOpts -> CreateGuildChannelOpts -> Bool)
-> (CreateGuildChannelOpts -> CreateGuildChannelOpts -> Bool)
-> (CreateGuildChannelOpts -> CreateGuildChannelOpts -> Bool)
-> (CreateGuildChannelOpts -> CreateGuildChannelOpts -> Bool)
-> (CreateGuildChannelOpts
    -> CreateGuildChannelOpts -> CreateGuildChannelOpts)
-> (CreateGuildChannelOpts
    -> CreateGuildChannelOpts -> CreateGuildChannelOpts)
-> Ord 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
$cp1Ord :: Eq CreateGuildChannelOpts
Ord)

createChannelOptsToJSON :: T.Text -> [Overwrite] -> CreateGuildChannelOpts -> Value
createChannelOptsToJSON :: Text -> [Overwrite] -> CreateGuildChannelOpts -> Value
createChannelOptsToJSON Text
name [Overwrite]
perms CreateGuildChannelOpts
opts = [Pair] -> Value
object [(Key
key, Value
val) | (Key
key, Just Value
val) <- [(Key, Maybe Value)]
optsJSON]
  where
  optsJSON :: [(Key, Maybe Value)]
optsJSON = case CreateGuildChannelOpts
opts of
    CreateGuildChannelOptsText{Maybe Bool
Maybe Integer
Maybe Text
Maybe RoleId
createGuildChannelOptsCategoryId :: Maybe RoleId
createGuildChannelOptsIsNSFW :: Maybe Bool
createGuildChannelOptsUserMessageRateDelay :: Maybe Integer
createGuildChannelOptsTopic :: Maybe Text
createGuildChannelOptsCategoryId :: CreateGuildChannelOpts -> Maybe RoleId
createGuildChannelOptsIsNSFW :: CreateGuildChannelOpts -> Maybe Bool
createGuildChannelOptsUserMessageRateDelay :: CreateGuildChannelOpts -> Maybe Integer
createGuildChannelOptsTopic :: CreateGuildChannelOpts -> Maybe Text
..} ->
                          [(Key
"name",                  Value -> Maybe Value
forall a. a -> Maybe a
Just (Text -> Value
String Text
name))
                          ,(Key
"type",                  Value -> Maybe Value
forall a. a -> Maybe a
Just (Scientific -> Value
Number Scientific
0))
                          ,(Key
"permission_overwrites", [Overwrite] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Overwrite] -> Value) -> Maybe [Overwrite] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Overwrite] -> Maybe [Overwrite]
forall a. a -> Maybe a
Just [Overwrite]
perms)
                          ,(Key
"topic",                 Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
createGuildChannelOptsTopic)
                          ,(Key
"rate_limit_per_user",   Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> Maybe Integer -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
createGuildChannelOptsUserMessageRateDelay)
                          ,(Key
"nsfw",                  Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
createGuildChannelOptsIsNSFW)
                          ,(Key
"parent_id",             RoleId -> Value
forall a. ToJSON a => a -> Value
toJSON (RoleId -> Value) -> Maybe RoleId -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RoleId
createGuildChannelOptsCategoryId)]
    CreateGuildChannelOptsVoice{Maybe Integer
Maybe RoleId
createGuildChannelOptsCategoryId :: Maybe RoleId
createGuildChannelOptsMaxUsers :: Maybe Integer
createGuildChannelOptsBitrate :: Maybe Integer
createGuildChannelOptsMaxUsers :: CreateGuildChannelOpts -> Maybe Integer
createGuildChannelOptsBitrate :: CreateGuildChannelOpts -> Maybe Integer
createGuildChannelOptsCategoryId :: CreateGuildChannelOpts -> Maybe RoleId
..} ->
                          [(Key
"name",                  Value -> Maybe Value
forall a. a -> Maybe a
Just (Text -> Value
String Text
name))
                          ,(Key
"type",                  Value -> Maybe Value
forall a. a -> Maybe a
Just (Scientific -> Value
Number Scientific
2))
                          ,(Key
"permission_overwrites", [Overwrite] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Overwrite] -> Value) -> Maybe [Overwrite] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Overwrite] -> Maybe [Overwrite]
forall a. a -> Maybe a
Just [Overwrite]
perms)
                          ,(Key
"bitrate",               Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> Maybe Integer -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
createGuildChannelOptsBitrate)
                          ,(Key
"user_limit",            Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> Maybe Integer -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
createGuildChannelOptsMaxUsers)
                          ,(Key
"parent_id",             RoleId -> Value
forall a. ToJSON a => a -> Value
toJSON (RoleId -> Value) -> Maybe RoleId -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RoleId
createGuildChannelOptsCategoryId)]
    CreateGuildChannelOpts
CreateGuildChannelOptsCategory ->
                          [(Key
"name",                  Value -> Maybe Value
forall a. a -> Maybe a
Just (Text -> Value
String Text
name))
                          ,(Key
"type",                  Value -> Maybe Value
forall a. a -> Maybe a
Just (Scientific -> Value
Number Scientific
4))
                          ,(Key
"permission_overwrites", [Overwrite] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Overwrite] -> Value) -> Maybe [Overwrite] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Overwrite] -> Maybe [Overwrite]
forall a. a -> Maybe a
Just [Overwrite]
perms)]


-- | https://discord.com/developers/docs/resources/guild#modify-guild
data ModifyGuildOpts = ModifyGuildOpts
  { ModifyGuildOpts -> Maybe Text
modifyGuildOptsName         :: Maybe T.Text
  , ModifyGuildOpts -> Maybe RoleId
modifyGuildOptsAFKChannelId :: Maybe ChannelId
  , ModifyGuildOpts -> Maybe Text
modifyGuildOptsIcon         :: Maybe T.Text
  , ModifyGuildOpts -> Maybe RoleId
modifyGuildOptsOwnerId      :: Maybe UserId
   -- Region
   -- VerificationLevel
   -- DefaultMessageNotification
   -- ExplicitContentFilter
  } deriving (Int -> ModifyGuildOpts -> ShowS
[ModifyGuildOpts] -> ShowS
ModifyGuildOpts -> String
(Int -> ModifyGuildOpts -> ShowS)
-> (ModifyGuildOpts -> String)
-> ([ModifyGuildOpts] -> ShowS)
-> Show ModifyGuildOpts
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, ModifyGuildOpts -> ModifyGuildOpts -> Bool
(ModifyGuildOpts -> ModifyGuildOpts -> Bool)
-> (ModifyGuildOpts -> ModifyGuildOpts -> Bool)
-> Eq ModifyGuildOpts
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
Eq ModifyGuildOpts
-> (ModifyGuildOpts -> ModifyGuildOpts -> Ordering)
-> (ModifyGuildOpts -> ModifyGuildOpts -> Bool)
-> (ModifyGuildOpts -> ModifyGuildOpts -> Bool)
-> (ModifyGuildOpts -> ModifyGuildOpts -> Bool)
-> (ModifyGuildOpts -> ModifyGuildOpts -> Bool)
-> (ModifyGuildOpts -> ModifyGuildOpts -> ModifyGuildOpts)
-> (ModifyGuildOpts -> ModifyGuildOpts -> ModifyGuildOpts)
-> Ord 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
$cp1Ord :: Eq ModifyGuildOpts
Ord)

instance ToJSON ModifyGuildOpts where
  toJSON :: ModifyGuildOpts -> Value
toJSON ModifyGuildOpts{Maybe Text
Maybe RoleId
modifyGuildOptsOwnerId :: Maybe RoleId
modifyGuildOptsIcon :: Maybe Text
modifyGuildOptsAFKChannelId :: Maybe RoleId
modifyGuildOptsName :: Maybe Text
modifyGuildOptsOwnerId :: ModifyGuildOpts -> Maybe RoleId
modifyGuildOptsIcon :: ModifyGuildOpts -> Maybe Text
modifyGuildOptsAFKChannelId :: ModifyGuildOpts -> Maybe RoleId
modifyGuildOptsName :: ModifyGuildOpts -> Maybe Text
..} =  [Pair] -> Value
object [(Key
name, Value
val) | (Key
name, Just Value
val) <-
                                  [(Key
"name",            Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  Maybe Text
modifyGuildOptsName ),
                                   (Key
"afk_channel_id",  RoleId -> Value
forall a. ToJSON a => a -> Value
toJSON (RoleId -> Value) -> Maybe RoleId -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  Maybe RoleId
modifyGuildOptsAFKChannelId ),
                                   (Key
"icon",            Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  Maybe Text
modifyGuildOptsIcon ),
                                   (Key
"owner_id",        RoleId -> Value
forall a. ToJSON a => a -> Value
toJSON (RoleId -> Value) -> Maybe RoleId -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  Maybe RoleId
modifyGuildOptsOwnerId )] ]

data GuildMembersTiming = GuildMembersTiming
                          { GuildMembersTiming -> Maybe Int
guildMembersTimingLimit :: Maybe Int
                          , GuildMembersTiming -> Maybe RoleId
guildMembersTimingAfter :: Maybe UserId
                          } deriving (Int -> GuildMembersTiming -> ShowS
[GuildMembersTiming] -> ShowS
GuildMembersTiming -> String
(Int -> GuildMembersTiming -> ShowS)
-> (GuildMembersTiming -> String)
-> ([GuildMembersTiming] -> ShowS)
-> Show GuildMembersTiming
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, GuildMembersTiming -> GuildMembersTiming -> Bool
(GuildMembersTiming -> GuildMembersTiming -> Bool)
-> (GuildMembersTiming -> GuildMembersTiming -> Bool)
-> Eq GuildMembersTiming
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
Eq GuildMembersTiming
-> (GuildMembersTiming -> GuildMembersTiming -> Ordering)
-> (GuildMembersTiming -> GuildMembersTiming -> Bool)
-> (GuildMembersTiming -> GuildMembersTiming -> Bool)
-> (GuildMembersTiming -> GuildMembersTiming -> Bool)
-> (GuildMembersTiming -> GuildMembersTiming -> Bool)
-> (GuildMembersTiming -> GuildMembersTiming -> GuildMembersTiming)
-> (GuildMembersTiming -> GuildMembersTiming -> GuildMembersTiming)
-> Ord 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
$cp1Ord :: Eq GuildMembersTiming
Ord)

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

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


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

guildJsonRequest :: GuildRequest r -> JsonRequest
guildJsonRequest :: GuildRequest r -> JsonRequest
guildJsonRequest GuildRequest r
c = case GuildRequest r
c of
  (CreateGuild CreateGuildOpts
opts) ->
      Url 'Https
-> RestIO (ReqBodyJson CreateGuildOpts)
-> Option 'Https
-> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Post (Url 'Https
guilds) (ReqBodyJson CreateGuildOpts -> RestIO (ReqBodyJson CreateGuildOpts)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CreateGuildOpts -> ReqBodyJson CreateGuildOpts
forall a. a -> ReqBodyJson a
R.ReqBodyJson CreateGuildOpts
opts)) Option 'Https
forall a. Monoid a => a
mempty

  (GetGuild RoleId
guild) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
guilds Url 'Https -> RoleId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// RoleId
guild) Option 'Https
forall a. Monoid a => a
mempty

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  (GetGuildEmbed RoleId
guild) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
guilds Url 'Https -> RoleId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// RoleId
guild Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"integrations") Option 'Https
forall a. Monoid a => a
mempty

  (ModifyGuildEmbed RoleId
guild GuildEmbed
patch) ->
      Url 'Https
-> RestIO (ReqBodyJson GuildEmbed) -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Patch (Url 'Https
guilds Url 'Https -> RoleId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// RoleId
guild Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"embed") (ReqBodyJson GuildEmbed -> RestIO (ReqBodyJson GuildEmbed)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GuildEmbed -> ReqBodyJson GuildEmbed
forall a. a -> ReqBodyJson a
R.ReqBodyJson GuildEmbed
patch)) Option 'Https
forall a. Monoid a => a
mempty

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