diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,12 @@ # Changelog for Calamity +## 0.1.25.0 + ++ Changed how `ModifyGuildMemberData`, and `ModifyGuildRoleData` are implemented + to allow for the parameters to be optional and nullable. ++ Changed `EditMessage` to use `EditMessageData` instead of `Maybe Text -> Maybe + Embed`, allowing for the parameters to be optional and nullable. + ## 0.1.24.2 + Add event handlers for voice state update events: `'VoiceStateUpdateEvt` @@ -76,15 +83,15 @@ * Add raw message events: `RawMessageUpdateEvt`, `RawMessageDeleteEvt`, `RawMessageDeleteBulkEvt`, `RawMessageReactionAddEvt`, `RawMessageReactionRemoveEvt`, `RawMessageReactionRemoveAllEvt`. - + * Fixed bulk message deletes firing a message delete per deleted message, instead of a bulk message delete event (I'm not sure how I did that). - + * Add `animated` field to `Partial Emoji`s. * Make show instances for `Partial Emoji` and `RawEmoji` show to their discord representation. - + ## 0.1.17.2 *2020-07-04* diff --git a/calamity.cabal b/calamity.cabal --- a/calamity.cabal +++ b/calamity.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: a5c065a71cfed945f41be7a4a6f14517749ae7e80ebeb56e60944a845ef100a4 +-- hash: 71d166a4c21a7ffb9bf5da8669b3c29f3ba92c9447240a50efd0fad4c1804208 name: calamity -version: 0.1.24.2 +version: 0.1.25.0 synopsis: A library for writing discord bots in haskell description: Please see the README on GitHub at category: Network, Web diff --git a/src/Calamity/Commands/CommandUtils.hs b/src/Calamity/Commands/CommandUtils.hs --- a/src/Calamity/Commands/CommandUtils.hs +++ b/src/Calamity/Commands/CommandUtils.hs @@ -82,7 +82,7 @@ -- -- @ -- 'buildCommand' @\'['Named' "user" ('Snowflake' 'User'), 'Named' "reason" ('KleeneStarConcat' 'S.Text')] --- "ban" 'Nothing' [] ('const' "Ban a user") $ \ctx uid r -> case (ctx 'Control.Lens.^.' #guild) of +-- "ban" 'Nothing' [] ('const' "Ban a user") $ \\ctx uid r -> case (ctx 'Control.Lens.^.' #guild) of -- 'Just' guild -> do -- 'Control.Monad.void' . 'Calamity.HTTP.invoke' $ 'Calamity.HTTP.Guild.CreateGuildBan' guild uid ('Calamity.HTTP.Guild.CreateGuildBanData' 'Nothing' $ 'Just' r) -- 'Control.Monad.void' $ 'Calamity.Types.Tellable.tell' ctx ("Banned user `" '<>' 'TextShow.showt' uid '<>' "` with reason: " '<>' r) diff --git a/src/Calamity/Commands/Dsl.hs b/src/Calamity/Commands/Dsl.hs --- a/src/Calamity/Commands/Dsl.hs +++ b/src/Calamity/Commands/Dsl.hs @@ -58,7 +58,7 @@ -- -- @ -- 'hide' '$' do --- 'command' \@'[] "test" \ctx -> 'pure' () +-- 'command' \@'[] "test" \\ctx -> 'pure' () -- @ -- -- In the above block, any command declared inside 'hide' will have it's @@ -78,7 +78,7 @@ -- 'Calamity.Client.runBotIO' ('Calamity.BotToken' token) -- $ 'Calamity.Commands.Utils.addCommands' $ do -- 'Calamity.Commands.Help.helpCommand' --- 'Calamity.Commands.Dsl.command' \@'[] "test" \ctx -> +-- 'Calamity.Commands.Dsl.command' \@'[] "test" \\ctx -> -- 'Control.Monad.void' $ 'Calamity.Types.Tellable.tell' \@'L.Text' ctx "hi" -- @ -- diff --git a/src/Calamity/HTTP/Channel.hs b/src/Calamity/HTTP/Channel.hs --- a/src/Calamity/HTTP/Channel.hs +++ b/src/Calamity/HTTP/Channel.hs @@ -1,14 +1,19 @@ -- | Channel endpoints module Calamity.HTTP.Channel ( - ChannelRequest (..), - CreateMessageOptions (..), - ChannelUpdate (..), - AllowedMentionType (..), - AllowedMentions (..), - ChannelMessagesQuery (..), - GetReactionsOptions (..), - CreateChannelInviteOptions (..), - GroupDMAddRecipientOptions (..), + ChannelRequest (..), + CreateMessageOptions (..), + EditMessageData (..), + editMessageContent, + editMessageEmbed, + editMessageFlags, + editMessageAllowedMentions, + ChannelUpdate (..), + AllowedMentionType (..), + AllowedMentions (..), + ChannelMessagesQuery (..), + GetReactionsOptions (..), + CreateChannelInviteOptions (..), + GroupDMAddRecipientOptions (..), ) where import Calamity.HTTP.Internal.Request @@ -23,12 +28,14 @@ import Data.ByteString.Lazy (ByteString) import Data.Default.Class import Data.Generics.Product.Subtype (upcast) +import qualified Data.HashMap.Strict as H import Data.Text (Text) import qualified Data.Text as S +import Data.Word import GHC.Generics +import Network.HTTP.Client.MultipartFormData import Network.HTTP.Req import Network.Mime -import Network.HTTP.Client.MultipartFormData import TextShow data CreateMessageOptions = CreateMessageOptions @@ -76,6 +83,31 @@ deriving (Show, Generic) deriving (ToJSON) via CalamityJSON CreateMessageJson +-- | Parameters to the Edit Message endpoint. +-- +-- Use the provided methods (@editMessageX@) to create a value with the +-- field set, use the Semigroup instance to union the values. +-- +-- ==== Examples +-- +-- >>> encode $ editMessageContent (Just "test") <> editMessageFlags Nothing +-- "{\"nick\":\"test\",\"deaf\":null}" +newtype EditMessageData = EditMessageData Object + deriving (Show, Generic) + deriving newtype (ToJSON, Semigroup, Monoid) + +editMessageContent :: Maybe Text -> EditMessageData +editMessageContent v = EditMessageData $ H.fromList [("content", toJSON v)] + +editMessageEmbed :: Maybe Embed -> EditMessageData +editMessageEmbed v = EditMessageData $ H.fromList [("embed", toJSON v)] + +editMessageFlags :: Maybe Word64 -> EditMessageData +editMessageFlags v = EditMessageData $ H.fromList [("flags", toJSON v)] + +editMessageAllowedMentions :: Maybe AllowedMentions -> EditMessageData +editMessageAllowedMentions v = EditMessageData $ H.fromList [("allowed_mentions", toJSON v)] + data ChannelUpdate = ChannelUpdate { name :: Maybe Text , position :: Maybe Int @@ -132,7 +164,7 @@ data ChannelRequest a where CreateMessage :: (HasID Channel c) => c -> CreateMessageOptions -> ChannelRequest Message GetMessage :: (HasID Channel c, HasID Message m) => c -> m -> ChannelRequest Message - EditMessage :: (HasID Channel c, HasID Message m) => c -> m -> Maybe Text -> Maybe Embed -> ChannelRequest Message + EditMessage :: (HasID Channel c, HasID Message m) => c -> m -> EditMessageData -> ChannelRequest Message DeleteMessage :: (HasID Channel c, HasID Message m) => c -> m -> ChannelRequest () BulkDeleteMessages :: (HasID Channel c, HasID Message m) => c -> [m] -> ChannelRequest () GetChannel :: (HasID Channel c) => c -> ChannelRequest Channel @@ -203,7 +235,7 @@ baseRoute cid // S "messages" // ID @Message // S "reactions" & giveID mid & buildRoute - route (EditMessage (getID -> cid) (getID @Message -> mid) _ _) = + route (EditMessage (getID -> cid) (getID @Message -> mid) _) = baseRoute cid // S "messages" // ID @Message & giveID mid & buildRoute @@ -284,7 +316,7 @@ <> "limit" =:? (showt <$> limit) ) action (DeleteAllReactions _ _) = deleteWith - action (EditMessage _ _ content embed) = patchWith' (ReqBodyJson $ object ["content" .= content, "embed" .= embed]) + action (EditMessage _ _ o) = patchWith' (ReqBodyJson o) action (DeleteMessage _ _) = deleteWith action (BulkDeleteMessages _ (map (getID @Message) -> ids)) = postWith' (ReqBodyJson $ object ["messages" .= ids]) action (GetChannelInvites _) = getWith diff --git a/src/Calamity/HTTP/Guild.hs b/src/Calamity/HTTP/Guild.hs --- a/src/Calamity/HTTP/Guild.hs +++ b/src/Calamity/HTTP/Guild.hs @@ -1,16 +1,26 @@ -- | Guild endpoints module Calamity.HTTP.Guild ( - GuildRequest (..), - CreateGuildData (..), - ModifyGuildData (..), - ChannelCreateData (..), - ChannelPosition (..), - ListMembersOptions (..), - AddGuildMemberData (..), - ModifyGuildMemberData (..), - CreateGuildBanData (..), - ModifyGuildRoleData (..), - ModifyGuildRolePositionsData (..), + GuildRequest (..), + CreateGuildData (..), + ModifyGuildData (..), + ChannelCreateData (..), + ChannelPosition (..), + ListMembersOptions (..), + AddGuildMemberData (..), + ModifyGuildMemberData (..), + modifyGuildMemberNick, + modifyGuildMemberRoles, + modifyGuildMemberMute, + modifyGuildMemberDeaf, + modifyGuildMemberChannelID, + CreateGuildBanData (..), + ModifyGuildRoleData (..), + modifyGuildRoleName, + modifyGuildRolePermissions, + modifyGuildRoleColour, + modifyGuildRoleHoist, + modifyGuildRoleMentionable, + ModifyGuildRolePositionsData (..), ) where import Calamity.HTTP.Internal.Request @@ -23,19 +33,15 @@ import Calamity.Types.Model.User import Calamity.Types.Model.Voice import Calamity.Types.Snowflake - import Control.Lens hiding ((.=)) - import Data.Aeson import Data.Aeson.Lens import Data.Colour (Colour) import Data.Default.Class +import qualified Data.HashMap.Strict as H import Data.Text (Text) - import GHC.Generics - import Network.HTTP.Req - import TextShow data CreateGuildData = CreateGuildData @@ -106,31 +112,68 @@ deriving (Show, Generic) deriving (ToJSON) via CalamityJSON AddGuildMemberData -data ModifyGuildMemberData = ModifyGuildMemberData - { nick :: Maybe Text - , roles :: Maybe [Snowflake Role] - , mute :: Maybe Bool - , deaf :: Maybe Bool - , channelID :: Maybe (Snowflake VoiceChannel) - } - deriving (Show, Generic, Default) - deriving (ToJSON) via CalamityJSON ModifyGuildMemberData +-- | Parameters to the Modify Guild Member endpoint. +-- +-- Use the provided methods (@modifyGuildMemberX@) to create a value with the +-- field set, use the Semigroup instance to union the values. +-- +-- ==== Examples +-- +-- >>> encode $ modifyGuildMemberNick (Just "test") <> modifyGuildMemberDeaf Nothing +-- "{\"nick\":\"test\",\"deaf\":null}" +newtype ModifyGuildMemberData = ModifyGuildMemberData Object + deriving (Show, Generic) + deriving newtype (ToJSON, Semigroup, Monoid) +modifyGuildMemberNick :: Maybe Text -> ModifyGuildMemberData +modifyGuildMemberNick v = ModifyGuildMemberData $ H.fromList [("nick", toJSON v)] + +modifyGuildMemberRoles :: Maybe [Snowflake Role] -> ModifyGuildMemberData +modifyGuildMemberRoles v = ModifyGuildMemberData $ H.fromList [("roles", toJSON v)] + +modifyGuildMemberMute :: Maybe Bool -> ModifyGuildMemberData +modifyGuildMemberMute v = ModifyGuildMemberData $ H.fromList [("mute", toJSON v)] + +modifyGuildMemberDeaf :: Maybe Bool -> ModifyGuildMemberData +modifyGuildMemberDeaf v = ModifyGuildMemberData $ H.fromList [("deaf", toJSON v)] + +modifyGuildMemberChannelID :: Maybe (Snowflake VoiceChannel) -> ModifyGuildMemberData +modifyGuildMemberChannelID v = ModifyGuildMemberData $ H.fromList [("channel_id", toJSON v)] + data CreateGuildBanData = CreateGuildBanData { deleteMessageDays :: Maybe Integer , reason :: Maybe Text } deriving (Show, Generic, Default) -data ModifyGuildRoleData = ModifyGuildRoleData - { name :: Maybe Text - , permissions :: Maybe Permissions - , color :: Maybe (Colour Double) - , hoist :: Maybe Bool - , mentionable :: Maybe Bool - } - deriving (Show, Generic, Default) - deriving (ToJSON) via CalamityJSON ModifyGuildRoleData +-- | Parameters to the Modify Guild Role endpoint. +-- +-- Use the provided methods (@modifyGuildRoleX@) to create a value with the +-- field set, use the Semigroup instance to union the values. +-- +-- ==== Examples +-- +-- >>> encode $ modifyGuildRoleName (Just "test") <> modifyGuildRolePermissions Nothing +-- "{\"name\":\"test\",\"permissions\":null}" +newtype ModifyGuildRoleData = ModifyGuildRoleData Object + deriving (Show, Generic) + deriving newtype (ToJSON, Semigroup, Monoid) + + +modifyGuildRoleName :: Maybe Text -> ModifyGuildRoleData +modifyGuildRoleName v = ModifyGuildRoleData $ H.fromList [("name", toJSON v)] + +modifyGuildRolePermissions :: Maybe Permissions -> ModifyGuildRoleData +modifyGuildRolePermissions v = ModifyGuildRoleData $ H.fromList [("permissions", toJSON v)] + +modifyGuildRoleColour :: Maybe (Colour Double) -> ModifyGuildRoleData +modifyGuildRoleColour v = ModifyGuildRoleData $ H.fromList [("colour", toJSON v)] + +modifyGuildRoleHoist :: Maybe Bool -> ModifyGuildRoleData +modifyGuildRoleHoist v = ModifyGuildRoleData $ H.fromList [("hoist", toJSON v)] + +modifyGuildRoleMentionable :: Maybe Bool -> ModifyGuildRoleData +modifyGuildRoleMentionable v = ModifyGuildRoleData $ H.fromList [("mentionable", toJSON v)] data ModifyGuildRolePositionsData = ModifyGuildRolePositionsData { id :: Snowflake Role