discord-haskell 1.11.0 → 1.12.0

raw patch · 23 files changed

+1442/−1304 lines, 23 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• changelog.md +4/−0
• discord-haskell.cabal +14/−2
• examples/ping-pong.hs +1/−1
• src/Discord/Interactions.hs +4/−3
• src/Discord/Internal/Gateway/Cache.hs +0/−3
• src/Discord/Internal/Rest.hs +1/−1
• src/Discord/Internal/Rest/ApplicationCommands.hs +15/−17
• src/Discord/Internal/Rest/Channel.hs +31/−41
• src/Discord/Internal/Rest/Guild.hs +2/−2
• src/Discord/Internal/Rest/Interactions.hs +18/−11
• src/Discord/Internal/Rest/Prelude.hs +2/−1
• src/Discord/Internal/Types.hs +22/−29
• src/Discord/Internal/Types/ApplicationCommands.hs +405/−405
• src/Discord/Internal/Types/Channel.hs +73/−80
• src/Discord/Internal/Types/Color.hs +164/−0
• src/Discord/Internal/Types/Components.hs +223/−201
• src/Discord/Internal/Types/Embed.hs +40/−25
• src/Discord/Internal/Types/Events.hs +7/−7
• src/Discord/Internal/Types/Gateway.hs +3/−3
• src/Discord/Internal/Types/Guild.hs +3/−2
• src/Discord/Internal/Types/Interactions.hs +361/−429
• src/Discord/Internal/Types/Prelude.hs +43/−41
• src/Discord/Types.hs +6/−0

@@ -6,6 +6,10 @@  ## master +## 1.12.0++[L0neGamer](https://github.com/aquarial/discord-haskell/pull/96) breaking changes and fixes to application commands, interactions, and components, and updates elsewhere+ ## 1.11.0  [L0neGamer](https://github.com/aquarial/discord-haskell/pull/88) did a LOT of work wrangling the discord API for interactions and commands!

@@ -1,7 +1,7 @@ cabal-version:       2.0 name:                discord-haskell -- library version is also noted at src/Discord/Rest/Prelude.hs-version:             1.11.0+version:             1.12.0 description:         Functions and data types to write discord bots.                      Official discord docs <https://discord.com/developers/docs/reference>.                      .@@ -34,8 +34,19 @@                      , text                      , unliftio                      , discord-haskell-                     -- , req               {- needed for slash commands -} +-- executable interaction-commands+--   main-is:             examples/interaction-commands.hs+--   default-language:    Haskell2010+--   ghc-options:         -Wall+--                        -fno-warn-type-defaults -fno-warn-unused-record-wildcards+--                        -threaded+--   build-depends:       base+--                      , text+--                      , unliftio+--                      , discord-haskell+--                      , bytestring+ library   ghc-options:         -Wall                        -fno-warn-type-defaults -fno-warn-unused-record-wildcards@@ -73,6 +84,7 @@                      , Discord.Internal.Types.ApplicationCommands                      , Discord.Internal.Types.Interactions                      , Discord.Internal.Types.Components+                     , Discord.Internal.Types.Color   build-depends:                        base >= 4 && <5                      , aeson

@@ -23,7 +23,7 @@ --                                <server id>           <channel id> -- https://discord.com/channels/2385235298674262408/4286572469284672046 testserverid :: Snowflake-testserverid = 453207241294610442+testserverid = -1  -- | Replies "pong" to every message that starts with "ping" pingpongExample :: IO ()

@@ -1,7 +1,8 @@ module Discord.Interactions-  ( module Discord.Internal.Types.ApplicationCommands-  , module Discord.Internal.Types.Interactions-  ) where+  ( module Discord.Internal.Types.ApplicationCommands,+    module Discord.Internal.Types.Interactions,+  )+where  import Discord.Internal.Types.ApplicationCommands import Discord.Internal.Types.Interactions

@@ -54,9 +54,6 @@  adjustCache :: Cache -> EventInternalParse -> Cache adjustCache minfo event = case event of-  --InternalChannelCreate Channel-  --InternalChannelUpdate Channel-  --InternalChannelDelete Channel   InternalGuildCreate guild info ->     let newChans = map (setChanGuildID (guildId guild)) $ guildChannels info         g = M.insert (guildId guild) (guild, info { guildChannels = newChans }) (cacheGuilds minfo)

@@ -44,7 +44,7 @@   r <- readMVar m   pure $ case eitherDecode <$> r of     Right (Right o) -> Right o-    (Right (Left er)) -> Left (RestCallInternalNoParse er (case r of +    (Right (Left er)) -> Left (RestCallInternalNoParse er (case r of       Right x -> x       Left _ -> ""))     Left e -> Left e

@@ -1,35 +1,36 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-}  module Discord.Internal.Rest.ApplicationCommands where -import Data.Aeson (ToJSON (toJSON), Value)-import Network.HTTP.Req as R-+import Data.Aeson (Value) import Discord.Internal.Rest.Prelude import Discord.Internal.Types import Discord.Internal.Types.ApplicationCommands-+    ( ApplicationCommandPermissions,+      GuildApplicationCommandPermissions(GuildApplicationCommandPermissions),+      EditApplicationCommand,+      CreateApplicationCommand,+      ApplicationCommand )+import Network.HTTP.Req as R  instance Request (ApplicationCommandRequest a) where   jsonRequest = applicationCommandJsonRequest   majorRoute = applicationCommandMajorRoute  data ApplicationCommandRequest a where-  GetGlobalApplicationCommands :: ApplicationId -> ApplicationCommandRequest [InternalApplicationCommand]-  CreateGlobalApplicationCommand :: ApplicationId -> CreateApplicationCommand -> ApplicationCommandRequest InternalApplicationCommand-  GetGlobalApplicationCommand :: ApplicationId -> ApplicationCommandId -> ApplicationCommandRequest InternalApplicationCommand-  EditGlobalApplicationCommand :: ApplicationId -> ApplicationCommandId -> EditApplicationCommand -> ApplicationCommandRequest InternalApplicationCommand+  GetGlobalApplicationCommands :: ApplicationId -> ApplicationCommandRequest [ApplicationCommand]+  CreateGlobalApplicationCommand :: ApplicationId -> CreateApplicationCommand -> ApplicationCommandRequest ApplicationCommand+  GetGlobalApplicationCommand :: ApplicationId -> ApplicationCommandId -> ApplicationCommandRequest ApplicationCommand+  EditGlobalApplicationCommand :: ApplicationId -> ApplicationCommandId -> EditApplicationCommand -> ApplicationCommandRequest ApplicationCommand   DeleteGlobalApplicationCommand :: ApplicationId -> ApplicationCommandId -> ApplicationCommandRequest ()   BulkOverWriteGlobalApplicationCommand :: ApplicationId -> [CreateApplicationCommand] -> ApplicationCommandRequest ()-  GetGuildApplicationCommands :: ApplicationId -> GuildId -> ApplicationCommandRequest [InternalApplicationCommand]-  CreateGuildApplicationCommand :: ApplicationId -> GuildId -> CreateApplicationCommand -> ApplicationCommandRequest InternalApplicationCommand-  GetGuildApplicationCommand :: ApplicationId -> GuildId -> ApplicationCommandId -> ApplicationCommandRequest InternalApplicationCommand-  EditGuildApplicationCommand :: ApplicationId -> GuildId -> ApplicationCommandId -> CreateApplicationCommand -> ApplicationCommandRequest InternalApplicationCommand+  GetGuildApplicationCommands :: ApplicationId -> GuildId -> ApplicationCommandRequest [ApplicationCommand]+  CreateGuildApplicationCommand :: ApplicationId -> GuildId -> CreateApplicationCommand -> ApplicationCommandRequest ApplicationCommand+  GetGuildApplicationCommand :: ApplicationId -> GuildId -> ApplicationCommandId -> ApplicationCommandRequest ApplicationCommand+  EditGuildApplicationCommand :: ApplicationId -> GuildId -> ApplicationCommandId -> CreateApplicationCommand -> ApplicationCommandRequest ApplicationCommand   DeleteGuildApplicationCommand :: ApplicationId -> GuildId -> ApplicationCommandId -> ApplicationCommandRequest ()   BulkOverWriteGuildApplicationCommand :: ApplicationId -> GuildId -> [CreateApplicationCommand] -> ApplicationCommandRequest ()   GetGuildApplicationCommandPermissions :: ApplicationId -> GuildId -> ApplicationCommandRequest GuildApplicationCommandPermissions@@ -38,9 +39,6 @@   -- | The only parameters needed in the GuildApplicationCommandPermissions   -- objects are id and permissions.   BatchEditApplicationCommandPermissions :: ApplicationId -> GuildId -> [GuildApplicationCommandPermissions] -> ApplicationCommandRequest [GuildApplicationCommandPermissions]---- TODO: permissions checks--- GetGuildApplicationCommandPermissions :: ApplicationId -> GuildID -> ApplicationCommandR  applications :: ApplicationId -> R.Url 'R.Https applications s = baseUrl /: "applications" // s

@@ -26,12 +26,13 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Network.HTTP.Client (RequestBody (RequestBodyBS))-import Network.HTTP.Client.MultipartFormData (partFileRequestBody, partBS, PartM)+import Network.HTTP.Client.MultipartFormData (partFileRequestBody, partBS) import Network.HTTP.Req ((/:)) import qualified Network.HTTP.Req as R  import Discord.Internal.Rest.Prelude import Discord.Internal.Types+import Control.Monad (join)  instance Request (ChannelRequest a) where   majorRoute = channelMajorRoute@@ -51,8 +52,6 @@   GetChannelMessage       :: (ChannelId, MessageId) -> ChannelRequest Message   -- | Sends a message to a channel.   CreateMessage           :: ChannelId -> T.Text -> ChannelRequest Message-  -- | Sends a message with an Embed to a channel.-  CreateMessageEmbed      :: ChannelId -> T.Text -> CreateEmbed -> ChannelRequest Message   -- | Sends a message with a file to a channel.   CreateMessageUploadFile :: ChannelId -> T.Text -> B.ByteString -> ChannelRequest Message   -- | Sends a message with granular controls.@@ -102,18 +101,18 @@ data MessageDetailedOpts = MessageDetailedOpts   { messageDetailedContent                  :: T.Text   , messageDetailedTTS                      :: Bool-  , messageDetailedEmbed                    :: Maybe CreateEmbed+  , messageDetailedEmbeds                    :: Maybe [CreateEmbed]   , messageDetailedFile                     :: Maybe (T.Text, B.ByteString)   , messageDetailedAllowedMentions          :: Maybe AllowedMentions   , messageDetailedReference                :: Maybe MessageReference-  , messageDetailedComponents               :: Maybe [Component]+  , messageDetailedComponents               :: Maybe [ComponentActionRow]   , messageDetailedStickerIds               :: Maybe [StickerId]-  } deriving (Show, Read, Eq, Ord)+  } deriving (Show, Eq, Ord, Read)  instance Default MessageDetailedOpts where   def = MessageDetailedOpts { messageDetailedContent         = ""                             , messageDetailedTTS             = False-                            , messageDetailedEmbed           = Nothing+                            , messageDetailedEmbeds          = Nothing                             , messageDetailedFile            = Nothing                             , messageDetailedAllowedMentions = Nothing                             , messageDetailedReference       = Nothing@@ -217,7 +216,6 @@   (GetChannelMessages chan _) ->            "msg " <> show chan   (GetChannelMessage (chan, _)) ->      "get_msg " <> show chan   (CreateMessage chan _) ->                 "msg " <> show chan-  (CreateMessageEmbed chan _ _) ->          "msg " <> show chan   (CreateMessageUploadFile chan _ _) ->     "msg " <> show chan   (CreateMessageDetailed chan _) ->         "msg " <> show chan   (CreateReaction (chan, _) _) ->     "add_react " <> show chan@@ -249,16 +247,6 @@     (_, Just a) -> "custom:" <> a     (_, Nothing) -> noAngles -maybeEmbed :: Maybe CreateEmbed -> [PartM IO]-maybeEmbed = --maybe [] $ \embed -> ["embed" .= createEmbed embed]-      let mkPart (name,content) = partFileRequestBody name (T.unpack name) (RequestBodyBS content)-          uploads CreateEmbed{..} = [(n,c) | (n, Just (CreateEmbedImageUpload c)) <--                                          [ ("author.png", createEmbedAuthorIcon)-                                          , ("thumbnail.png", createEmbedThumbnail)-                                          , ("image.png", createEmbedImage)-                                          , ("footer.png", createEmbedFooterIcon) ]]-      in maybe [] (map mkPart . uploads)- channels :: R.Url 'R.Https channels = baseUrl /: "channels" @@ -274,7 +262,7 @@       Delete (channels // chan) mempty    (GetChannelMessages chan (n,timing)) ->-      let n' = if n < 1 then 1 else (if n > 100 then 100 else n)+      let n' = max 1 (min 100 n)           options = "limit" R.=: n' <> messageTimingToQuery timing       in Get (channels // chan /: "messages") options @@ -286,35 +274,37 @@           body = pure $ R.ReqBodyJson $ object content       in Post (channels // chan /: "messages") body mempty -  (CreateMessageEmbed chan msg embed) ->-      let partJson = partBS "payload_json" $ BL.toStrict $ encode $ toJSON $ object ["content" .= msg, "embed" .= createEmbed embed]-          body = R.reqBodyMultipart (partJson : maybeEmbed (Just embed))-      in Post (channels // chan /: "messages") body mempty-   (CreateMessageUploadFile chan fileName file) ->       let part = partFileRequestBody "file" (T.unpack fileName) $ RequestBodyBS file           body = R.reqBodyMultipart [part]       in Post (channels // chan /: "messages") body mempty    (CreateMessageDetailed chan msgOpts) ->-      let fileUpload = messageDetailedFile msgOpts-          filePart = case fileUpload of-            Nothing -> []-            Just f  -> [partFileRequestBody "file" (T.unpack $ fst f)-              $ RequestBodyBS $ snd f]+    let fileUpload = messageDetailedFile msgOpts+        filePart =+          ( case fileUpload of+              Nothing -> []+              Just f ->+                [ partFileRequestBody+                    "file"+                    (T.unpack $ fst f)+                    (RequestBodyBS $ snd f)+                ]+          )+            ++ join (maybe [] (maybeEmbed . Just <$>) (messageDetailedEmbeds msgOpts)) -          payloadData =  object $ [ "content" .= messageDetailedContent msgOpts-                                 , "tts"     .= messageDetailedTTS msgOpts ] ++-                                 [ name .= value | (name, Just value) <--                                    [ ("embed", toJSON . createEmbed <$> messageDetailedEmbed msgOpts)-                                    , ("allowed_mentions", toJSON <$> messageDetailedAllowedMentions msgOpts)-                                    , ("message_reference", toJSON <$> messageDetailedReference msgOpts)-                                    , ("components", toJSON . (filterOutIncorrectEmoji <$>) <$> messageDetailedComponents msgOpts)-                                    , ("sticker_ids", toJSON <$> messageDetailedStickerIds msgOpts)-                                    ] ]-          payloadPart = partBS "payload_json" $ BL.toStrict $ encode $ toJSON payloadData+        payloadData =  object $ [ "content" .= messageDetailedContent msgOpts+                                , "tts"     .= messageDetailedTTS msgOpts ] +++                                [ name .= value | (name, Just value) <-+                                  [ ("embeds", toJSON . (createEmbed <$>) <$> messageDetailedEmbeds msgOpts)+                                  , ("allowed_mentions", toJSON <$> messageDetailedAllowedMentions msgOpts)+                                  , ("message_reference", toJSON <$> messageDetailedReference msgOpts)+                                  , ("components", toJSON <$> messageDetailedComponents msgOpts)+                                  , ("sticker_ids", toJSON <$> messageDetailedStickerIds msgOpts)+                                  ] ]+        payloadPart = partBS "payload_json" $ BL.toStrict $ encode payloadData -          body = R.reqBodyMultipart (payloadPart : filePart)+        body = R.reqBodyMultipart (payloadPart : filePart)       in Post (channels // chan /: "messages") body mempty    (CreateReaction (chan, msgid) emoji) ->@@ -336,7 +326,7 @@    (GetReactions (chan, msgid) emoji (n, timing)) ->       let e = cleanupEmoji emoji-          n' = if n < 1 then 1 else (if n > 100 then 100 else n)+          n' = max 1 (min 100 n)           options = "limit" R.=: n' <> reactionTimingToQuery timing       in Get (channels // chan /: "messages" // msgid /: "reactions" /: e) options 

@@ -132,7 +132,7 @@   -- | Sync an 'Integration'. Requires the 'MANAGE_GUILD' permission.   SyncGuildIntegration     :: GuildId -> IntegrationId -> GuildRequest ()   -- | Returns the 'GuildWidget' object. Requires the 'MANAGE_GUILD' permission.-  GetGuildWidget            :: GuildId -> GuildRequest GuildWidget +  GetGuildWidget            :: GuildId -> GuildRequest GuildWidget   -- | Modify a 'GuildWidget' object for the guild. All attributes may be passed in with   --   JSON and modified. Requires the 'MANAGE_GUILD' permission. Returns the updated   --   'GuildWidget' object.@@ -174,7 +174,7 @@ data ModifyGuildRoleOpts = ModifyGuildRoleOpts   { modifyGuildRoleOptsName            :: Maybe T.Text   , modifyGuildRoleOptsPermissions     :: Maybe T.Text-  , modifyGuildRoleOptsColor           :: Maybe ColorInteger+  , modifyGuildRoleOptsColor           :: Maybe DiscordColor   , modifyGuildRoleOptsSeparateSidebar :: Maybe Bool   , modifyGuildRoleOptsMentionable     :: Maybe Bool   } deriving (Show, Read, Eq, Ord)

@@ -1,25 +1,24 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TypeApplications #-}  module Discord.Internal.Rest.Interactions where -import Data.Aeson (ToJSON (toJSON), Value)-import Network.HTTP.Req as R-+import Data.Aeson (encode)+import qualified Data.ByteString.Lazy as BL import Discord.Internal.Rest.Prelude import Discord.Internal.Types import Discord.Internal.Types.Interactions+import Network.HTTP.Client.MultipartFormData (PartM, partBS)+import Network.HTTP.Req as R  data InteractionResponseRequest a where   CreateInteractionResponse :: InteractionId -> InteractionToken -> InteractionResponse -> InteractionResponseRequest ()   GetOriginalInteractionResponse :: ApplicationId -> InteractionToken -> InteractionResponseRequest Message-  EditOriginalInteractionResponse :: ApplicationId -> InteractionToken -> InteractionCallbackMessages -> InteractionResponseRequest Message+  EditOriginalInteractionResponse :: ApplicationId -> InteractionToken -> InteractionResponseMessage -> InteractionResponseRequest Message   DeleteOriginalInteractionResponse :: ApplicationId -> InteractionToken -> InteractionResponseRequest ()-  CreateFollowupInteractionMessage :: ApplicationId -> InteractionToken -> InteractionCallbackMessages  -> InteractionResponseRequest Message+  CreateFollowupInteractionMessage :: ApplicationId -> InteractionToken -> InteractionResponseMessage -> InteractionResponseRequest Message   GetFollowupInteractionMessage :: ApplicationId -> InteractionToken -> MessageId -> InteractionResponseRequest Message   EditFollowupInteractionMessage :: ApplicationId -> InteractionToken -> MessageId -> InteractionResponse -> InteractionResponseRequest Message   DeleteFollowupInteractionMessage :: ApplicationId -> InteractionToken -> MessageId -> InteractionResponseRequest ()@@ -49,11 +48,11 @@   (GetOriginalInteractionResponse aid it) ->     Get (interaction aid it /: "@original") mempty   (EditOriginalInteractionResponse aid it i) ->-    Patch (interaction aid it /: "@original") (convert i) mempty+    Patch (interaction aid it /: "@original") (convertIRM i) mempty   (DeleteOriginalInteractionResponse aid it) ->     Delete (interaction aid it /: "@original") mempty   (CreateFollowupInteractionMessage aid it i) ->-    Post (baseUrl /: "webhooks" // aid /: it) (convert i) mempty+    Post (baseUrl /: "webhooks" // aid /: it) (convertIRM i) mempty   (GetFollowupInteractionMessage aid it mid) ->     Get (interaction aid it // mid) mempty   (EditFollowupInteractionMessage aid it mid i) ->@@ -61,5 +60,13 @@   (DeleteFollowupInteractionMessage aid it mid) ->     Delete (interaction aid it // mid) mempty   where-    convert :: (ToJSON a) => a -> RestIO (ReqBodyJson Value)-    convert = (pure @RestIO) . R.ReqBodyJson . toJSON+    convert :: InteractionResponse -> RestIO ReqBodyMultipart+    convert ir@(InteractionResponseChannelMessage irm) = R.reqBodyMultipart (partBS "payload_json" (BL.toStrict $ encode ir) : convert' irm)+    convert ir@(InteractionResponseUpdateMessage irm) = R.reqBodyMultipart (partBS "payload_json" (BL.toStrict $ encode ir) : convert' irm)+    convert ir = R.reqBodyMultipart [partBS "payload_json" $ BL.toStrict $ encode ir]+    convertIRM :: InteractionResponseMessage -> RestIO ReqBodyMultipart+    convertIRM irm = R.reqBodyMultipart (partBS "payload_json" (BL.toStrict $ encode irm) : convert' irm)+    convert' :: InteractionResponseMessage -> [PartM IO]+    convert' InteractionResponseMessage {..} = case interactionResponseMessageEmbeds of+      Nothing -> []+      Just f -> (maybeEmbed . Just) =<< f

@@ -12,6 +12,7 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE + import qualified Network.HTTP.Req as R  import Discord.Internal.Types@@ -29,7 +30,7 @@   where   -- | https://discord.com/developers/docs/reference#user-agent   -- Second place where the library version is noted-  agent = "DiscordBot (https://github.com/aquarial/discord-haskell, 1.11.0)"+  agent = "DiscordBot (https://github.com/aquarial/discord-haskell, 1.12.0)"  -- Append to an URL infixl 5 //

@@ -1,38 +1,31 @@--- | Provides types and encoding/decoding code. Types should be identical to those provided---   in the Discord API documentation.+-- | Re-export ALL the internal type modules. Hiding is in Discord.Types module Discord.Internal.Types-  ( module Discord.Internal.Types.Prelude-  , module Discord.Internal.Types.Channel-  , module Discord.Internal.Types.Events-  , module Discord.Internal.Types.Gateway-  , module Discord.Internal.Types.Guild-  , module Discord.Internal.Types.User-  , module Discord.Internal.Types.Embed-  , module Discord.Internal.Types.Components---, module Discord.Internal.Types.ApplicationCommands---, module Discord.Internal.Types.Interactions-  , module Data.Aeson-  , module Data.Time.Clock-  , userFacingEvent-  ) where+  ( module Discord.Internal.Types.Prelude,+    module Discord.Internal.Types.Channel,+    module Discord.Internal.Types.Color,+    module Discord.Internal.Types.Events,+    module Discord.Internal.Types.Gateway,+    module Discord.Internal.Types.Guild,+    module Discord.Internal.Types.User,+    module Discord.Internal.Types.Embed,+    module Discord.Internal.Types.Components,+    module Data.Aeson,+    module Data.Time.Clock,+    userFacingEvent,+  )+where +import Data.Aeson (Object, ToJSON (toJSON))+import Data.Time.Clock (UTCTime (..)) import Discord.Internal.Types.Channel+import Discord.Internal.Types.Color+import Discord.Internal.Types.Components+import Discord.Internal.Types.Embed import Discord.Internal.Types.Events import Discord.Internal.Types.Gateway import Discord.Internal.Types.Guild-import Discord.Internal.Types.User-import Discord.Internal.Types.Embed import Discord.Internal.Types.Prelude-import Discord.Internal.Types.Components---- import Discord.Internal.Types.ApplicationCommands-import Discord.Internal.Types.Interactions---import Data.Aeson (Object)-import Data.Time.Clock (UTCTime(..))-import Data.Maybe (fromMaybe)-+import Discord.Internal.Types.User  userFacingEvent :: EventInternalParse -> Event userFacingEvent event = case event of@@ -67,5 +60,5 @@   InternalPresenceUpdate a -> PresenceUpdate a   InternalTypingStart a -> TypingStart a   InternalUserUpdate a -> UserUpdate a-  InternalInteractionCreate a -> InteractionCreate (fromMaybe (InteractionUnknown a) (fromInternal a))+  InternalInteractionCreate a -> InteractionCreate a   InternalUnknownEvent a b -> UnknownEvent a b

@@ -10,246 +10,369 @@  module Discord.Internal.Types.ApplicationCommands   ( ApplicationCommand (..),+    ApplicationCommandOptions (..),     ApplicationCommandOptionSubcommandOrGroup (..),     ApplicationCommandOptionSubcommand (..),     ApplicationCommandOptionValue (..),-    InternalApplicationCommand (..),-    CreateApplicationCommand (..),     createApplicationCommandChatInput,     createApplicationCommandUser,     createApplicationCommandMessage,+    CreateApplicationCommand (..),     EditApplicationCommand (..),-    ApplicationCommandType (..),-    InternalApplicationCommandOption (..),-    ApplicationCommandOptionType (..),-    InternalApplicationCommandOptionChoice,+    defaultEditApplicationCommand,     Choice (..),     ApplicationCommandChannelType (..),     GuildApplicationCommandPermissions (..),     ApplicationCommandPermissions (..),-    ApplicationCommandPermissionType (..),-    StringNumberValue (..),   ) where -import Control.Applicative import Data.Aeson-import Data.Char (isLower)+import Data.Aeson.Types (Pair, Parser) import Data.Data (Data)-import Data.Default (Default (..))-import Data.Maybe (fromJust, fromMaybe)+import Data.Foldable (Foldable (toList)) import Data.Scientific (Scientific) import qualified Data.Text as T-import Discord.Internal.Types.Prelude (ApplicationCommandId, ApplicationId, GuildId, Internals (..), Snowflake, makeTable, toMaybeJSON)+import Discord.Internal.Types.Prelude (ApplicationCommandId, ApplicationId, GuildId, InternalDiscordEnum (..), Snowflake, discordTypeParseJSON, toMaybeJSON) +-- | The structure for an application command. data ApplicationCommand   = ApplicationCommandUser-      { applicationCommandId :: ApplicationCommandId,+      { -- | The id of the application command.+        applicationCommandId :: ApplicationCommandId,+        -- | The id of the application the command comes from.         applicationCommandApplicationId :: ApplicationId,+        -- | The guild the application command is registered in.         applicationCommandGuildId :: Maybe GuildId,+        -- | The name of the application command.         applicationCommandName :: T.Text,-        applicationCommandDefaultPermission :: Maybe Bool,+        -- | Whether the command is enabled by default when the app is added to a guild.+        applicationCommandDefaultPermission :: Bool,+        -- | Autoincrementing version identifier updated during substantial record changes.         applicationCommandVersion :: Snowflake       }   | ApplicationCommandMessage-      { applicationCommandId :: ApplicationCommandId,+      { -- | The id of the application command.+        applicationCommandId :: ApplicationCommandId,+        -- | The id of the application the command comes from.         applicationCommandApplicationId :: ApplicationId,+        -- | The guild the application command is registered in.         applicationCommandGuildId :: Maybe GuildId,+        -- | The name of the application command.         applicationCommandName :: T.Text,-        applicationCommandDefaultPermission :: Maybe Bool,+        -- | Whether the command is enabled by default when the app is added to a guild.+        applicationCommandDefaultPermission :: Bool,+        -- | Autoincrementing version identifier updated during substantial record changes.         applicationCommandVersion :: Snowflake       }   | ApplicationCommandChatInput-      { applicationCommandId :: ApplicationCommandId,+      { -- | The id of the application command.+        applicationCommandId :: ApplicationCommandId,+        -- | The id of the application the command comes from.         applicationCommandApplicationId :: ApplicationId,+        -- | The guild the application command is registered in.         applicationCommandGuildId :: Maybe GuildId,+        -- | The name of the application command.         applicationCommandName :: T.Text,+        -- | The description of the application command.         applicationCommandDescription :: T.Text,+        -- | The parameters for the command.         applicationCommandOptions :: Maybe ApplicationCommandOptions,-        applicationCommandDefaultPermission :: Maybe Bool,+        -- | Whether the command is enabled by default when the app is added to a guild.+        applicationCommandDefaultPermission :: Bool,+        -- | Autoincrementing version identifier updated during substantial record changes.         applicationCommandVersion :: Snowflake       }-  | ApplicationCommandUnknown InternalApplicationCommand   deriving (Show, Eq, Read) +instance FromJSON ApplicationCommand where+  parseJSON =+    withObject+      "ApplicationCommand"+      ( \v -> do+          acid <- v .: "id"+          aid <- v .: "application_id"+          gid <- v .:? "guild_id"+          name <- v .: "name"+          defPerm <- v .:? "default_permission" .!= True+          version <- v .: "version"+          t <- v .:? "type" :: Parser (Maybe Int)+          case t of+            (Just 2) -> return $ ApplicationCommandUser acid aid gid name defPerm version+            (Just 3) -> return $ ApplicationCommandMessage acid aid gid name defPerm version+            _ -> do+              desc <- v .: "description"+              options <- v .:? "options"+              return $ ApplicationCommandChatInput acid aid gid name desc options defPerm version+      )++-- | Either subcommands and groups, or values. data ApplicationCommandOptions   = ApplicationCommandOptionsSubcommands [ApplicationCommandOptionSubcommandOrGroup]   | ApplicationCommandOptionsValues [ApplicationCommandOptionValue]   deriving (Show, Eq, Read) +instance FromJSON ApplicationCommandOptions where+  parseJSON =+    withArray+      "ApplicationCommandOptions"+      ( \a -> do+          let a' = toList a+          case a' of+            [] -> return $ ApplicationCommandOptionsValues []+            (v' : _) ->+              withObject+                "ApplicationCommandOptions item"+                ( \v -> do+                    t <- v .: "type" :: Parser Int+                    if t == 1 || t == 2+                      then ApplicationCommandOptionsSubcommands <$> mapM parseJSON a'+                      else ApplicationCommandOptionsValues <$> mapM parseJSON a'+                )+                v'+      )++instance ToJSON ApplicationCommandOptions where+  toJSON (ApplicationCommandOptionsSubcommands o) = toJSON o+  toJSON (ApplicationCommandOptionsValues o) = toJSON o++-- | Either a subcommand group or a subcommand. data ApplicationCommandOptionSubcommandOrGroup   = ApplicationCommandOptionSubcommandGroup-      { applicationCommandOptionSubcommandGroupName :: T.Text,+      { -- | The name of the subcommand group+        applicationCommandOptionSubcommandGroupName :: T.Text,+        -- | The description of the subcommand group         applicationCommandOptionSubcommandGroupDescription :: T.Text,+        -- | The subcommands in this subcommand group         applicationCommandOptionSubcommandGroupOptions :: [ApplicationCommandOptionSubcommand]       }   | ApplicationCommandOptionSubcommandOrGroupSubcommand ApplicationCommandOptionSubcommand   deriving (Show, Eq, Read) +instance FromJSON ApplicationCommandOptionSubcommandOrGroup where+  parseJSON =+    withObject+      "ApplicationCommandOptionSubcommandOrGroup"+      ( \v -> do+          t <- v .: "type" :: Parser Int+          case t of+            2 ->+              ApplicationCommandOptionSubcommandGroup+                <$> v .: "name"+                <*> v .: "description"+                <*> v .: "options"+            1 -> ApplicationCommandOptionSubcommandOrGroupSubcommand <$> parseJSON (Object v)+            _ -> fail "unexpected subcommand group type"+      )++instance ToJSON ApplicationCommandOptionSubcommandOrGroup where+  toJSON ApplicationCommandOptionSubcommandGroup {..} =+    object+      [ ("type", Number 2),+        ("name", toJSON applicationCommandOptionSubcommandGroupName),+        ("description", toJSON applicationCommandOptionSubcommandGroupDescription),+        ("options", toJSON applicationCommandOptionSubcommandGroupOptions)+      ]+  toJSON (ApplicationCommandOptionSubcommandOrGroupSubcommand a) = toJSON a++-- | Data for a single subcommand. data ApplicationCommandOptionSubcommand = ApplicationCommandOptionSubcommand-  { applicationCommandOptionSubcommandName :: T.Text,+  { -- | The name of the subcommand+    applicationCommandOptionSubcommandName :: T.Text,+    -- | The description of the subcommand     applicationCommandOptionSubcommandDescription :: T.Text,+    -- | What options are there in this subcommand     applicationCommandOptionSubcommandOptions :: [ApplicationCommandOptionValue]   }   deriving (Show, Eq, Read) +instance FromJSON ApplicationCommandOptionSubcommand where+  parseJSON =+    withObject+      "ApplicationCommandOptionSubcommand"+      ( \v -> do+          t <- v .: "type" :: Parser Int+          case t of+            1 ->+              ApplicationCommandOptionSubcommand+                <$> v .: "name"+                <*> v .: "description"+                <*> v .:? "options" .!= []+            _ -> fail "unexpected subcommand type"+      )++instance ToJSON ApplicationCommandOptionSubcommand where+  toJSON ApplicationCommandOptionSubcommand {..} =+    object+      [ ("type", Number 1),+        ("name", toJSON applicationCommandOptionSubcommandName),+        ("description", toJSON applicationCommandOptionSubcommandDescription),+        ("options", toJSON applicationCommandOptionSubcommandOptions)+      ]++-- | Data for a single value. data ApplicationCommandOptionValue   = ApplicationCommandOptionValueString-      { applicationCommandOptionValueName :: T.Text,+      { -- | The name of the value+        applicationCommandOptionValueName :: T.Text,+        -- | The description of the value         applicationCommandOptionValueDescription :: T.Text,-        applicationCommandOptionValueRequired :: Maybe Bool,-        applicationCommandOptionValueStringChoices :: Maybe [Choice T.Text],-        applicationCommandOptionValueAutocomplete :: Maybe Bool+        -- | Whether this option is required+        applicationCommandOptionValueRequired :: Bool,+        -- | Whether to autocomplete or have a list of named choices. For neither option, use `Left False`+        applicationCommandOptionValueStringChoices :: AutocompleteOrChoice T.Text       }   | ApplicationCommandOptionValueInteger-      { applicationCommandOptionValueName :: T.Text,+      { -- | The name of the value+        applicationCommandOptionValueName :: T.Text,+        -- | The description of the value         applicationCommandOptionValueDescription :: T.Text,-        applicationCommandOptionValueRequired :: Maybe Bool,-        applicationCommandOptionValueIntegerChoices :: Maybe [Choice Integer],+        -- | Whether this option is required+        applicationCommandOptionValueRequired :: Bool,+        -- | Whether to autocomplete or have a list of named choices. For neither option, use `Left False`+        applicationCommandOptionValueIntegerChoices :: AutocompleteOrChoice Integer,+        -- | The lower bound of values permitted. If choices are provided or autocomplete is on, this can be ignored         applicationCommandOptionValueIntegerMinVal :: Maybe Integer,-        applicationCommandOptionValueIntegerMaxVal :: Maybe Integer,-        applicationCommandOptionValueAutocomplete :: Maybe Bool+        -- | The upper bound of values permitted. If choices are provided or autocomplete is on, this can be ignored+        applicationCommandOptionValueIntegerMaxVal :: Maybe Integer       }   | ApplicationCommandOptionValueBoolean-      { applicationCommandOptionValueName :: T.Text,+      { -- | The name of the value+        applicationCommandOptionValueName :: T.Text,+        -- | The description of the value         applicationCommandOptionValueDescription :: T.Text,-        applicationCommandOptionValueRequired :: Maybe Bool+        -- | Whether this option is required+        applicationCommandOptionValueRequired :: Bool       }   | ApplicationCommandOptionValueUser-      { applicationCommandOptionValueName :: T.Text,+      { -- | The name of the value+        applicationCommandOptionValueName :: T.Text,+        -- | The description of the value         applicationCommandOptionValueDescription :: T.Text,-        applicationCommandOptionValueRequired :: Maybe Bool+        -- | Whether this option is required+        applicationCommandOptionValueRequired :: Bool       }   | ApplicationCommandOptionValueChannel-      { applicationCommandOptionValueName :: T.Text,+      { -- | The name of the value+        applicationCommandOptionValueName :: T.Text,+        -- | The description of the value         applicationCommandOptionValueDescription :: T.Text,-        applicationCommandOptionValueRequired :: Maybe Bool,+        -- | Whether this option is required+        applicationCommandOptionValueRequired :: Bool,+        -- | What type of channel can be put in here         applicationCommandOptionValueChannelTypes :: Maybe [ApplicationCommandChannelType]       }   | ApplicationCommandOptionValueRole-      { applicationCommandOptionValueName :: T.Text,+      { -- | The name of the value+        applicationCommandOptionValueName :: T.Text,+        -- | The description of the value         applicationCommandOptionValueDescription :: T.Text,-        applicationCommandOptionValueRequired :: Maybe Bool+        -- | Whether this option is required+        applicationCommandOptionValueRequired :: Bool       }   | ApplicationCommandOptionValueMentionable-      { applicationCommandOptionValueName :: T.Text,+      { -- | The name of the value+        applicationCommandOptionValueName :: T.Text,+        -- | The description of the value         applicationCommandOptionValueDescription :: T.Text,-        applicationCommandOptionValueRequired :: Maybe Bool+        -- | Whether this option is required+        applicationCommandOptionValueRequired :: Bool       }   | ApplicationCommandOptionValueNumber-      { applicationCommandOptionValueName :: T.Text,+      { -- | The name of the value+        applicationCommandOptionValueName :: T.Text,+        -- | The description of the value         applicationCommandOptionValueDescription :: T.Text,-        applicationCommandOptionValueRequired :: Maybe Bool,-        applicationCommandOptionValueNumberChoices :: Maybe [Choice Scientific],+        -- | Whether this option is required+        applicationCommandOptionValueRequired :: Bool,+        -- | Whether to autocomplete or have a list of named choices. For neither option, use `Left False`+        applicationCommandOptionValueNumberChoices :: AutocompleteOrChoice Scientific,+        -- | The lower bound of values permitted. If choices are provided or autocomplete is on, this can be ignored         applicationCommandOptionValueNumberMinVal :: Maybe Scientific,-        applicationCommandOptionValueNumberMaxVal :: Maybe Scientific,-        applicationCommandOptionValueAutocomplete :: Maybe Bool+        -- | The upper bound of values permitted. If choices are provided or autocomplete is on, this can be ignored+        applicationCommandOptionValueNumberMaxVal :: Maybe Scientific       }   deriving (Show, Eq, Read) -instance Internals ApplicationCommandOptionValue InternalApplicationCommandOption where-  toInternal ApplicationCommandOptionValueNumber {..} = InternalApplicationCommandOption ApplicationCommandOptionTypeNumber applicationCommandOptionValueName applicationCommandOptionValueDescription applicationCommandOptionValueRequired (((StringNumberValueNumber <$>) <$>) <$> applicationCommandOptionValueNumberChoices) Nothing Nothing applicationCommandOptionValueNumberMinVal applicationCommandOptionValueNumberMaxVal applicationCommandOptionValueAutocomplete-  toInternal ApplicationCommandOptionValueInteger {..} = InternalApplicationCommandOption ApplicationCommandOptionTypeInteger applicationCommandOptionValueName applicationCommandOptionValueDescription applicationCommandOptionValueRequired (((StringNumberValueInteger <$>) <$>) <$> applicationCommandOptionValueIntegerChoices) Nothing Nothing (fromInteger <$> applicationCommandOptionValueIntegerMinVal) (fromInteger <$> applicationCommandOptionValueIntegerMaxVal) applicationCommandOptionValueAutocomplete-  toInternal ApplicationCommandOptionValueString {..} = InternalApplicationCommandOption ApplicationCommandOptionTypeInteger applicationCommandOptionValueName applicationCommandOptionValueDescription applicationCommandOptionValueRequired (((StringNumberValueString <$>) <$>) <$> applicationCommandOptionValueStringChoices) Nothing Nothing Nothing Nothing applicationCommandOptionValueAutocomplete-  toInternal ApplicationCommandOptionValueChannel {..} = InternalApplicationCommandOption ApplicationCommandOptionTypeChannel applicationCommandOptionValueName applicationCommandOptionValueDescription applicationCommandOptionValueRequired Nothing Nothing applicationCommandOptionValueChannelTypes Nothing Nothing Nothing-  toInternal ApplicationCommandOptionValueBoolean {..} = InternalApplicationCommandOption ApplicationCommandOptionTypeBoolean applicationCommandOptionValueName applicationCommandOptionValueDescription applicationCommandOptionValueRequired Nothing Nothing Nothing Nothing Nothing Nothing-  toInternal ApplicationCommandOptionValueUser {..} = InternalApplicationCommandOption ApplicationCommandOptionTypeUser applicationCommandOptionValueName applicationCommandOptionValueDescription applicationCommandOptionValueRequired Nothing Nothing Nothing Nothing Nothing Nothing-  toInternal ApplicationCommandOptionValueRole {..} = InternalApplicationCommandOption ApplicationCommandOptionTypeRole applicationCommandOptionValueName applicationCommandOptionValueDescription applicationCommandOptionValueRequired Nothing Nothing Nothing Nothing Nothing Nothing-  toInternal ApplicationCommandOptionValueMentionable {..} = InternalApplicationCommandOption ApplicationCommandOptionTypeMentionable applicationCommandOptionValueName applicationCommandOptionValueDescription applicationCommandOptionValueRequired Nothing Nothing Nothing Nothing Nothing Nothing--  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeNumber, ..} = do-    cs <- maybe (Just []) (mapM extractChoices) internalApplicationCommandOptionChoices-    return $ ApplicationCommandOptionValueNumber internalApplicationCommandOptionName internalApplicationCommandOptionDescription internalApplicationCommandOptionRequired (fromResult cs) internalApplicationCommandOptionMinVal internalApplicationCommandOptionMaxVal internalApplicationCommandOptionAutocomplete-    where-      extractChoices (Choice s (StringNumberValueNumber n)) = Just (Choice s n)-      extractChoices _ = Nothing-      fromResult [] = Nothing-      fromResult is = Just is-  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeInteger, ..} = do-    cs <- maybe (Just []) (mapM extractChoices) internalApplicationCommandOptionChoices-    return $ ApplicationCommandOptionValueInteger internalApplicationCommandOptionName internalApplicationCommandOptionDescription internalApplicationCommandOptionRequired (fromResult cs) (round <$> internalApplicationCommandOptionMinVal) (round <$> internalApplicationCommandOptionMaxVal) internalApplicationCommandOptionAutocomplete-    where-      extractChoices (Choice s (StringNumberValueInteger n)) = Just (Choice s n)-      extractChoices _ = Nothing-      fromResult [] = Nothing-      fromResult is = Just is-  -- note with the above: the bounds are rounded for simplicity but ideally they wouldn't be-  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeString, ..} = do-    cs <- maybe (Just []) (mapM extractChoices) internalApplicationCommandOptionChoices-    return $ ApplicationCommandOptionValueString internalApplicationCommandOptionName internalApplicationCommandOptionDescription internalApplicationCommandOptionRequired (fromResult cs) internalApplicationCommandOptionAutocomplete-    where-      extractChoices (Choice s (StringNumberValueString n)) = Just (Choice s n)-      extractChoices _ = Nothing-      fromResult [] = Nothing-      fromResult is = Just is-  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeBoolean, ..} = Just $ ApplicationCommandOptionValueBoolean internalApplicationCommandOptionName internalApplicationCommandOptionDescription internalApplicationCommandOptionRequired-  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeUser, ..} = Just $ ApplicationCommandOptionValueUser internalApplicationCommandOptionName internalApplicationCommandOptionDescription internalApplicationCommandOptionRequired-  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeRole, ..} = Just $ ApplicationCommandOptionValueRole internalApplicationCommandOptionName internalApplicationCommandOptionDescription internalApplicationCommandOptionRequired-  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeMentionable, ..} = Just $ ApplicationCommandOptionValueMentionable internalApplicationCommandOptionName internalApplicationCommandOptionDescription internalApplicationCommandOptionRequired-  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeChannel, ..} = Just $ ApplicationCommandOptionValueChannel internalApplicationCommandOptionName internalApplicationCommandOptionDescription internalApplicationCommandOptionRequired internalApplicationCommandOptionChannelTypes-  fromInternal _ = Nothing--instance Internals ApplicationCommandOptionSubcommand InternalApplicationCommandOption where-  toInternal ApplicationCommandOptionSubcommand {..} = InternalApplicationCommandOption ApplicationCommandOptionTypeSubcommand applicationCommandOptionSubcommandName applicationCommandOptionSubcommandDescription Nothing Nothing (Just $ toInternal <$> applicationCommandOptionSubcommandOptions) Nothing Nothing Nothing Nothing--  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeSubcommand, ..} = do-    os <- maybe (Just []) (mapM fromInternal) internalApplicationCommandOptionOptions-    return $ ApplicationCommandOptionSubcommand internalApplicationCommandOptionName internalApplicationCommandOptionDescription os-  fromInternal _ = Nothing--instance Internals ApplicationCommandOptionSubcommandOrGroup InternalApplicationCommandOption where-  toInternal (ApplicationCommandOptionSubcommandOrGroupSubcommand s) = toInternal s-  toInternal ApplicationCommandOptionSubcommandGroup {..} = InternalApplicationCommandOption ApplicationCommandOptionTypeSubcommandGroup applicationCommandOptionSubcommandGroupName applicationCommandOptionSubcommandGroupDescription Nothing Nothing (Just $ toInternal <$> applicationCommandOptionSubcommandGroupOptions) Nothing Nothing Nothing Nothing--  fromInternal io@InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeSubcommand, ..} = ApplicationCommandOptionSubcommandOrGroupSubcommand <$> fromInternal io-  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeSubcommandGroup, ..} = do-    os <- maybe (Just []) (mapM fromInternal) internalApplicationCommandOptionOptions-    return $ ApplicationCommandOptionSubcommandGroup internalApplicationCommandOptionName internalApplicationCommandOptionDescription os-  fromInternal _ = Nothing--instance Internals ApplicationCommandOptions [InternalApplicationCommandOption] where-  toInternal (ApplicationCommandOptionsSubcommands is) = toInternal <$> is-  toInternal (ApplicationCommandOptionsValues is) = toInternal <$> is--  fromInternal is = (ApplicationCommandOptionsSubcommands <$> mapM fromInternal is) <|> (ApplicationCommandOptionsValues <$> mapM fromInternal is)--instance Internals ApplicationCommand InternalApplicationCommand where-  toInternal ApplicationCommandUser {..} = InternalApplicationCommand applicationCommandId (Just ApplicationCommandTypeUser) applicationCommandApplicationId applicationCommandGuildId applicationCommandName "" Nothing applicationCommandDefaultPermission applicationCommandVersion-  toInternal ApplicationCommandMessage {..} = InternalApplicationCommand applicationCommandId (Just ApplicationCommandTypeMessage) applicationCommandApplicationId applicationCommandGuildId applicationCommandName "" Nothing applicationCommandDefaultPermission applicationCommandVersion-  toInternal ApplicationCommandChatInput {..} = InternalApplicationCommand applicationCommandId (Just ApplicationCommandTypeChatInput) applicationCommandApplicationId applicationCommandGuildId applicationCommandName applicationCommandDescription (toInternal <$> applicationCommandOptions) applicationCommandDefaultPermission applicationCommandVersion-  toInternal (ApplicationCommandUnknown ai) = ai--  fromInternal InternalApplicationCommand {internalApplicationCommandType = Just ApplicationCommandTypeUser, ..} = Just $ ApplicationCommandUser internalApplicationCommandId internalApplicationCommandApplicationId internalApplicationCommandGuildId internalApplicationCommandName internalApplicationCommandDefaultPermission internalApplicationCommandVersion-  fromInternal InternalApplicationCommand {internalApplicationCommandType = Just ApplicationCommandTypeMessage, ..} = Just $ ApplicationCommandMessage internalApplicationCommandId internalApplicationCommandApplicationId internalApplicationCommandGuildId internalApplicationCommandName internalApplicationCommandDefaultPermission internalApplicationCommandVersion-  fromInternal a@InternalApplicationCommand {internalApplicationCommandType = Just ApplicationCommandTypeChatInput, ..} = Just $ fromMaybe (ApplicationCommandUnknown a) $ ((internalApplicationCommandOptions <|> Just []) >>= fromInternal) >>= \iOptions -> Just $ ApplicationCommandChatInput internalApplicationCommandId internalApplicationCommandApplicationId internalApplicationCommandGuildId internalApplicationCommandName internalApplicationCommandDescription (Just iOptions) internalApplicationCommandDefaultPermission internalApplicationCommandVersion-  fromInternal a = fromInternal (a {internalApplicationCommandType = Just ApplicationCommandTypeChatInput})---- Just $ ApplicationCommandMessage internalApplicationCommandId internalApplicationCommandApplicationId internalApplicationCommandGuildId internalApplicationCommandName internalApplicationCommandDefaultPermission internalApplicationCommandVersion---- | What type of application command. Represents slash commands, right clicking--- a user, and right clicking a message respectively.-data ApplicationCommandType-  = -- | Slash commands-    ApplicationCommandTypeChatInput-  | -- | User commands-    ApplicationCommandTypeUser-  | -- | Message commands-    ApplicationCommandTypeMessage-  deriving (Show, Read, Data, Eq)+instance FromJSON ApplicationCommandOptionValue where+  parseJSON =+    withObject+      "ApplicationCommandOptionValue"+      ( \v -> do+          name <- v .: "name"+          desc <- v .: "description"+          required <- v .:? "required" .!= False+          t <- v .: "type" :: Parser Int+          case t of+            3 ->+              ApplicationCommandOptionValueString name desc required+                <$> parseJSON (Object v)+            4 ->+              ApplicationCommandOptionValueInteger name desc required+                <$> parseJSON (Object v)+                <*> v .:? "min_value"+                <*> v .:? "max_value"+            10 ->+              ApplicationCommandOptionValueNumber name desc required+                <$> parseJSON (Object v)+                <*> v .:? "min_value"+                <*> v .:? "max_value"+            7 ->+              ApplicationCommandOptionValueChannel name desc required+                <$> v .:? "channel_types"+            5 -> return $ ApplicationCommandOptionValueBoolean name desc required+            6 -> return $ ApplicationCommandOptionValueUser name desc required+            8 -> return $ ApplicationCommandOptionValueRole name desc required+            9 -> return $ ApplicationCommandOptionValueMentionable name desc required+            _ -> fail "unknown application command option value type"+      ) -instance Enum ApplicationCommandType where-  fromEnum ApplicationCommandTypeChatInput = 1-  fromEnum ApplicationCommandTypeUser = 2-  fromEnum ApplicationCommandTypeMessage = 3-  toEnum a = fromJust $ lookup a table+instance ToJSON ApplicationCommandOptionValue where+  toJSON ApplicationCommandOptionValueString {..} =+    object+      [ ("type", Number 3),+        ("name", toJSON applicationCommandOptionValueName),+        ("description", toJSON applicationCommandOptionValueDescription),+        ("required", toJSON applicationCommandOptionValueRequired),+        choiceOrAutocompleteToJSON applicationCommandOptionValueStringChoices+      ]+  toJSON ApplicationCommandOptionValueInteger {..} =+    object+      [ ("type", Number 4),+        ("name", toJSON applicationCommandOptionValueName),+        ("description", toJSON applicationCommandOptionValueDescription),+        ("required", toJSON applicationCommandOptionValueRequired),+        choiceOrAutocompleteToJSON applicationCommandOptionValueIntegerChoices+      ]+  toJSON ApplicationCommandOptionValueNumber {..} =+    object+      [ ("type", Number 10),+        ("name", toJSON applicationCommandOptionValueName),+        ("description", toJSON applicationCommandOptionValueDescription),+        ("required", toJSON applicationCommandOptionValueRequired),+        choiceOrAutocompleteToJSON applicationCommandOptionValueNumberChoices+      ]+  toJSON ApplicationCommandOptionValueChannel {..} =+    object+      [ ("type", Number 7),+        ("name", toJSON applicationCommandOptionValueName),+        ("description", toJSON applicationCommandOptionValueDescription),+        ("required", toJSON applicationCommandOptionValueRequired),+        ("channel_types", toJSON applicationCommandOptionValueChannelTypes)+      ]+  toJSON acov =+    object+      [ ("type", Number (t acov)),+        ("name", toJSON $ applicationCommandOptionValueName acov),+        ("description", toJSON $ applicationCommandOptionValueDescription acov),+        ("required", toJSON $ applicationCommandOptionValueRequired acov)+      ]     where-      table = makeTable ApplicationCommandTypeChatInput--instance ToJSON ApplicationCommandType where-  toJSON = toJSON . fromEnum--instance FromJSON ApplicationCommandType where-  parseJSON = withScientific "ApplicationCommandType" (return . toEnum . round)+      t ApplicationCommandOptionValueBoolean {} = 5+      t ApplicationCommandOptionValueUser {} = 6+      t ApplicationCommandOptionValueRole {} = 8+      t ApplicationCommandOptionValueMentionable {} = 9+      t _ = -1  -- | Data type to be used when creating application commands. The specification -- is below.@@ -267,84 +390,124 @@ -- of command nesting permitted. -- -- https://discord.com/developers/docs/interactions/application-commands#create-global-application-command-data CreateApplicationCommand = CreateApplicationCommand-  { -- | The application command name (1-32 chars).-    createApplicationCommandName :: T.Text,-    -- | The application command description (1-100 chars). Has to be empty for-    -- non-slash commands.-    createApplicationCommandDescription :: T.Text,-    -- | What options the application (max length 25). Has to be `Nothing` for-    -- non-slash commands.-    createApplicationCommandOptions :: Maybe [InternalApplicationCommandOption],-    -- | Whether the command is enabled by default when the application is added-    -- to a guild. Defaults to true if not present-    createApplicationCommandDefaultPermission :: Maybe Bool,-    -- | What the type of the command is. If `Nothing`, defaults to slash-    -- commands.-    createApplicationCommandType :: Maybe ApplicationCommandType-  }+data CreateApplicationCommand+  = CreateApplicationCommandChatInput+      { -- | The application command name (1-32 chars).+        createApplicationCommandName :: T.Text,+        -- | The application command description (1-100 chars). Has to be empty for+        -- non-slash commands.+        createApplicationCommandDescription :: T.Text,+        -- | What options the application (max length 25). Has to be `Nothing` for+        -- non-slash commands.+        createApplicationCommandOptions :: Maybe ApplicationCommandOptions,+        -- | Whether the command is enabled by default when the application is added+        -- to a guild.+        createApplicationCommandDefaultPermission :: Bool+      }+  | CreateApplicationCommandUser+      { -- | The application command name (1-32 chars).+        createApplicationCommandName :: T.Text,+        -- | Whether the command is enabled by default when the application is added+        -- to a guild.+        createApplicationCommandDefaultPermission :: Bool+      }+  | CreateApplicationCommandMessage+      { -- | The application command name (1-32 chars).+        createApplicationCommandName :: T.Text,+        -- | Whether the command is enabled by default when the application is added+        -- to a guild.+        createApplicationCommandDefaultPermission :: Bool+      }   deriving (Show, Eq, Read)  instance ToJSON CreateApplicationCommand where-  toJSON CreateApplicationCommand {..} =+  toJSON CreateApplicationCommandChatInput {..} =     object       [ (name, value)         | (name, Just value) <-             [ ("name", toMaybeJSON createApplicationCommandName),               ("description", toMaybeJSON createApplicationCommandDescription),               ("options", toJSON <$> createApplicationCommandOptions),-              ("default_permission", toJSON <$> createApplicationCommandDefaultPermission),-              ("type", toJSON <$> createApplicationCommandType)+              ("default_permission", toMaybeJSON createApplicationCommandDefaultPermission),+              ("type", Just $ Number 1)             ]       ]+  toJSON CreateApplicationCommandUser {..} =+    object+      [ (name, value)+        | (name, Just value) <-+            [ ("name", toMaybeJSON createApplicationCommandName),+              ("default_permission", toMaybeJSON createApplicationCommandDefaultPermission),+              ("type", Just $ Number 2)+            ]+      ]+  toJSON CreateApplicationCommandMessage {..} =+    object+      [ (name, value)+        | (name, Just value) <-+            [ ("name", toMaybeJSON createApplicationCommandName),+              ("default_permission", toMaybeJSON createApplicationCommandDefaultPermission),+              ("type", Just $ Number 3)+            ]+      ] +nameIsValid :: Bool -> T.Text -> Bool+nameIsValid isChatInput name = l >= 1 && l <= 32 && (isChatInput <= T.all (`elem` validChars) name)+  where+    l = T.length name+    validChars = '-' : ['a' .. 'z']+ -- | Create the basics for a chat input (slash command). Use record overwriting -- to enter the other values. The name needs to be all lower case letters, and -- between 1 and 32 characters. The description has to be non-empty and less -- than or equal to 100 characters. createApplicationCommandChatInput :: T.Text -> T.Text -> Maybe CreateApplicationCommand createApplicationCommandChatInput name desc-  | T.all isLower name && not (T.null desc) && l >= 1 && l <= 32 && T.length desc <= 100 = Just $ CreateApplicationCommand name desc Nothing Nothing (Just ApplicationCommandTypeChatInput)+  | nameIsValid True name && not (T.null desc) && T.length desc <= 100 = Just $ CreateApplicationCommandChatInput name desc Nothing True   | otherwise = Nothing-  where-    l = T.length name  -- | Create the basics for a user command. Use record overwriting to enter the -- other values. The name needs to be between 1 and 32 characters. createApplicationCommandUser :: T.Text -> Maybe CreateApplicationCommand createApplicationCommandUser name-  | l >= 1 && l <= 32 = Just $ CreateApplicationCommand name "" Nothing Nothing (Just ApplicationCommandTypeUser)+  | nameIsValid False name = Just $ CreateApplicationCommandUser name True   | otherwise = Nothing-  where-    l = T.length name  -- | Create the basics for a message command. Use record overwriting to enter -- the other values. The name needs to be between 1 and 32 characters. createApplicationCommandMessage :: T.Text -> Maybe CreateApplicationCommand createApplicationCommandMessage name-  | l >= 1 && l <= 32 = Just $ CreateApplicationCommand name "" Nothing Nothing (Just ApplicationCommandTypeMessage)+  | nameIsValid False name = Just $ CreateApplicationCommandMessage name True   | otherwise = Nothing-  where-    l = T.length name  -- | Data type to be used when editing application commands. The specification -- is below. See `CreateApplicationCommand` for an explanation for the -- parameters. -- -- https://discord.com/developers/docs/interactions/application-commands#edit-global-application-command-data EditApplicationCommand = EditApplicationCommand-  { editApplicationCommandName :: Maybe T.Text,-    editApplicationCommandDescription :: Maybe T.Text,-    editApplicationCommandOptions :: Maybe [InternalApplicationCommandOption],-    editApplicationCommandDefaultPermission :: Maybe Bool,-    editApplicationCommandType :: Maybe ApplicationCommandType-  }+data EditApplicationCommand+  = EditApplicationCommandChatInput+      { editApplicationCommandName :: Maybe T.Text,+        editApplicationCommandDescription :: Maybe T.Text,+        editApplicationCommandOptions :: Maybe ApplicationCommandOptions,+        editApplicationCommandDefaultPermission :: Maybe Bool+      }+  | EditApplicationCommandUser+      { editApplicationCommandName :: Maybe T.Text,+        editApplicationCommandDefaultPermission :: Maybe Bool+      }+  | EditApplicationCommandMessage+      { editApplicationCommandName :: Maybe T.Text,+        editApplicationCommandDefaultPermission :: Maybe Bool+      } -instance Default EditApplicationCommand where-  def = EditApplicationCommand Nothing Nothing Nothing Nothing Nothing+defaultEditApplicationCommand :: Int -> EditApplicationCommand+defaultEditApplicationCommand 2 = EditApplicationCommandUser Nothing Nothing+defaultEditApplicationCommand 3 = EditApplicationCommandMessage Nothing Nothing+defaultEditApplicationCommand _ = EditApplicationCommandChatInput Nothing Nothing Nothing Nothing  instance ToJSON EditApplicationCommand where-  toJSON EditApplicationCommand {..} =+  toJSON EditApplicationCommandChatInput {..} =     object       [ (name, value)         | (name, Just value) <-@@ -352,181 +515,27 @@               ("description", toJSON <$> editApplicationCommandDescription),               ("options", toJSON <$> editApplicationCommandOptions),               ("default_permission", toJSON <$> editApplicationCommandDefaultPermission),-              ("type", toJSON <$> editApplicationCommandType)+              ("type", Just $ Number 1)             ]       ]---- | The full information about an application command, obtainable with the--- various get requests. In theory, you never need to construct one of these ---- so if you are, reconsider what you're doing.------ https://discord.com/developers/docs/interactions/application-commands#application-command-object-application-command-structure-data InternalApplicationCommand = InternalApplicationCommand-  { -- | Unique id of the command.-    internalApplicationCommandId :: ApplicationCommandId,-    -- | The type of the command.-    internalApplicationCommandType :: Maybe ApplicationCommandType,-    -- | Unique id of the parent application (the bot).-    internalApplicationCommandApplicationId :: ApplicationId,-    -- | The guild id of the command if not global.-    internalApplicationCommandGuildId :: Maybe GuildId,-    -- | Must be 1-32 characters.-    internalApplicationCommandName :: T.Text,-    -- | Must be empty for USER and MESSAGE commands, otherwise 1-100 chars.-    internalApplicationCommandDescription :: T.Text,-    -- | CHAT_INPUT only, parameters to command-    internalApplicationCommandOptions :: Maybe [InternalApplicationCommandOption],-    -- | whether the command is enabled by default when the app is added to a-    -- guild. Defaults to true.-    internalApplicationCommandDefaultPermission :: Maybe Bool,-    internalApplicationCommandVersion :: Snowflake-  }-  deriving (Show, Eq, Read)--instance FromJSON InternalApplicationCommand where-  parseJSON =-    withObject-      "InternalApplicationCommand"-      ( \v ->-          InternalApplicationCommand-            <$> v .: "id"-            <*> v .:? "type"-            <*> v .: "application_id"-            <*> v .:? "guild_id"-            <*> v .: "name"-            <*> v .: "description"-            <*> v .:? "options"-            <*> v .:? "default_permission"-            <*> v .: "version"-      )---- | This is the structure that designates different options for slash commands.------ https://discord.com/developers/docs/interactions/application-commands#application-command-object-application-command-option-structure-data InternalApplicationCommandOption = InternalApplicationCommandOption-  { -- | What the type of this option is.-    internalApplicationCommandOptionType :: ApplicationCommandOptionType,-    -- | The name of the option . 1-32 characters-    internalApplicationCommandOptionName :: T.Text,-    -- | 1-100 characters-    internalApplicationCommandOptionDescription :: T.Text,-    -- | Is the parameter required? default false-    internalApplicationCommandOptionRequired :: Maybe Bool,-    -- | If specified, these are the only valid options to choose from. Type-    -- depends on optionType, and can only be specified for STRING, INTEGER or-    -- NUMBER types.-    internalApplicationCommandOptionChoices :: Maybe [InternalApplicationCommandOptionChoice],-    -- | If the option type is a subcommand or subcommand group type, these are-    -- the parameters to the subcommand.-    internalApplicationCommandOptionOptions :: Maybe [InternalApplicationCommandOption],-    -- | If option is channel type, these are the only channel types allowed.-    internalApplicationCommandOptionChannelTypes :: Maybe [ApplicationCommandChannelType],-    -- | If option is number type, minimum value for the number-    internalApplicationCommandOptionMinVal :: Maybe Scientific,-    -- | if option is number type, maximum value for the number-    internalApplicationCommandOptionMaxVal :: Maybe Scientific,-    -- | Enable auto complete interactions. may not be set to true if choices is present.-    internalApplicationCommandOptionAutocomplete :: Maybe Bool-  }-  deriving (Show, Eq, Read)--instance ToJSON InternalApplicationCommandOption where-  toJSON InternalApplicationCommandOption {..} =+  toJSON EditApplicationCommandUser {..} =     object       [ (name, value)         | (name, Just value) <--            [ ("type", toMaybeJSON internalApplicationCommandOptionType),-              ("name", toMaybeJSON internalApplicationCommandOptionName),-              ("description", toMaybeJSON internalApplicationCommandOptionDescription),-              ("required", toJSON <$> internalApplicationCommandOptionRequired),-              ("choices", toJSON <$> internalApplicationCommandOptionChoices),-              ("options", toJSON <$> internalApplicationCommandOptionOptions),-              ("channel_types", toJSON <$> internalApplicationCommandOptionChannelTypes),-              ("min_val", toJSON <$> internalApplicationCommandOptionMinVal),-              ("max_val", toJSON <$> internalApplicationCommandOptionMaxVal),-              ("autocomplete", toJSON <$> internalApplicationCommandOptionAutocomplete)+            [ ("name", toJSON <$> editApplicationCommandName),+              ("default_permission", toJSON <$> editApplicationCommandDefaultPermission),+              ("type", Just $ Number 2)             ]       ]--instance FromJSON InternalApplicationCommandOption where-  parseJSON =-    withObject-      "InternalApplicationCommandOption"-      ( \v ->-          InternalApplicationCommandOption-            <$> v .: "type"-            <*> v .: "name"-            <*> v .: "description"-            <*> v .:? "required"-            <*> v .:? "choices"-            <*> v .:? "options"-            <*> v .:? "channel_types"-            <*> v .:? "min_val"-            <*> v .:? "max_val"-            <*> v .:? "autocomplete"-      )---- | What type of command option. Can represent a wide variety of types, so--- please check out the documentation below.------ https://discord.com/developers/docs/interactions/application-commands#application-command-object-application-command-option-type-data ApplicationCommandOptionType-  = -- | A subcommand. It can take further options, excluding sub commands and-    -- sub command groups.-    ApplicationCommandOptionTypeSubcommand-  | -- | A subcommand group. It can take further options, excluding sub command-    -- groups.-    ApplicationCommandOptionTypeSubcommandGroup-  | -- | Can typically be provided with default values.-    ApplicationCommandOptionTypeString-  | -- | Can typically be provided with default values, and possibly with-    -- minimum and maximum values.-    ApplicationCommandOptionTypeInteger-  | ApplicationCommandOptionTypeBoolean-  | ApplicationCommandOptionTypeUser-  | -- | Can be limited in the types of the channel allowed.-    ApplicationCommandOptionTypeChannel-  | ApplicationCommandOptionTypeRole-  | -- | Users and roles.-    ApplicationCommandOptionTypeMentionable-  | -- | Can typically be provided with default values, and possibly with-    -- minimum and maximum values. Represents a double.-    ApplicationCommandOptionTypeNumber-  deriving (Show, Read, Data, Eq)--instance Enum ApplicationCommandOptionType where-  fromEnum ApplicationCommandOptionTypeSubcommand = 1-  fromEnum ApplicationCommandOptionTypeSubcommandGroup = 2-  fromEnum ApplicationCommandOptionTypeString = 3-  fromEnum ApplicationCommandOptionTypeInteger = 4-  fromEnum ApplicationCommandOptionTypeBoolean = 5-  fromEnum ApplicationCommandOptionTypeUser = 6-  fromEnum ApplicationCommandOptionTypeChannel = 7-  fromEnum ApplicationCommandOptionTypeRole = 8-  fromEnum ApplicationCommandOptionTypeMentionable = 9-  fromEnum ApplicationCommandOptionTypeNumber = 10-  toEnum a = fromJust $ lookup a table-    where-      table = makeTable ApplicationCommandOptionTypeSubcommand--instance ToJSON ApplicationCommandOptionType where-  toJSON = toJSON . fromEnum--instance FromJSON ApplicationCommandOptionType where-  parseJSON = withScientific "ApplicationCommandOptionType" (return . toEnum . round)---- | Utility data type to store strings or number types.-data StringNumberValue = StringNumberValueString T.Text | StringNumberValueNumber Scientific | StringNumberValueInteger Integer-  deriving (Show, Read, Eq)--instance ToJSON StringNumberValue where-  toJSON (StringNumberValueString s) = toJSON s-  toJSON (StringNumberValueNumber i) = toJSON i-  toJSON (StringNumberValueInteger i) = toJSON i--instance FromJSON StringNumberValue where-  parseJSON (String t) = return $ StringNumberValueString t-  parseJSON v = (StringNumberValueInteger <$> parseJSON v) <|> (StringNumberValueNumber <$> parseJSON v)+  toJSON EditApplicationCommandMessage {..} =+    object+      [ (name, value)+        | (name, Just value) <-+            [ ("name", toJSON <$> editApplicationCommandName),+              ("default_permission", toJSON <$> editApplicationCommandDefaultPermission),+              ("type", Just $ Number 3)+            ]+      ]  data Choice a = Choice {choiceName :: T.Text, choiceValue :: a}   deriving (Show, Read, Eq)@@ -534,14 +543,6 @@ instance Functor Choice where   fmap f (Choice s a) = Choice s (f a) -type InternalApplicationCommandOptionChoice = Choice StringNumberValue---- | The choices for a particular option.--- data InternalApplicationCommandOptionChoice = InternalApplicationCommandOptionChoice---   { internalApplicationCommandOptionChoiceName :: T.Text,---     internalApplicationCommandOptionChoiceValue :: StringNumberValue---   }---   deriving (Show, Read, Eq) instance (ToJSON a) => ToJSON (Choice a) where   toJSON Choice {..} = object [("name", toJSON choiceName), ("value", toJSON choiceValue)] @@ -555,6 +556,23 @@             <*> v .: "value"       ) +type AutocompleteOrChoice a = Either Bool [Choice a]++instance {-# OVERLAPPING #-} (FromJSON a) => FromJSON (AutocompleteOrChoice a) where+  parseJSON =+    withObject+      "AutocompleteOrChoice"+      ( \v -> do+          mcs <- v .:! "choices"+          case mcs of+            Nothing -> Left <$> v .:? "autocomplete" .!= False+            Just cs -> return $ Right cs+      )++choiceOrAutocompleteToJSON :: (ToJSON a) => AutocompleteOrChoice a -> Pair+choiceOrAutocompleteToJSON (Left b) = ("autocomplete", toJSON b)+choiceOrAutocompleteToJSON (Right cs) = ("choices", toJSON cs)+ -- | The different channel types. -- -- https://discord.com/developers/docs/resources/channel#channel-object-channel-types@@ -575,7 +593,7 @@     ApplicationCommandChannelTypeGuildStore   | -- | A temporary sub-channel within a guild_news channel.     ApplicationCommandChannelTypeGuildNewsThread-  | -- | A temporary sub-channel within a guild_text channel+  | -- | A temporary sub-channel within a guild_text channel.     ApplicationCommandChannelTypeGuildPublicThread   | -- | A temporary sub-channel within a GUILD_TEXT channel that is only     -- viewable by those invited and those with the MANAGE_THREADS permission@@ -584,36 +602,34 @@     ApplicationCommandChannelTypeGuildStageVoice   deriving (Show, Read, Data, Eq) -instance Enum ApplicationCommandChannelType where-  fromEnum ApplicationCommandChannelTypeGuildText = 0-  fromEnum ApplicationCommandChannelTypeDM = 1-  fromEnum ApplicationCommandChannelTypeGuildVoice = 2-  fromEnum ApplicationCommandChannelTypeGroupDM = 3-  fromEnum ApplicationCommandChannelTypeGuildCategory = 4-  fromEnum ApplicationCommandChannelTypeGuildNews = 5-  fromEnum ApplicationCommandChannelTypeGuildStore = 6-  fromEnum ApplicationCommandChannelTypeGuildNewsThread = 10-  fromEnum ApplicationCommandChannelTypeGuildPublicThread = 11-  fromEnum ApplicationCommandChannelTypeGuildPrivateThread = 12-  fromEnum ApplicationCommandChannelTypeGuildStageVoice = 13-  toEnum a = fromJust $ lookup a table-    where-      table = makeTable ApplicationCommandChannelTypeGuildText+instance InternalDiscordEnum ApplicationCommandChannelType where+  discordTypeStartValue = ApplicationCommandChannelTypeGuildText+  fromDiscordType ApplicationCommandChannelTypeGuildText = 0+  fromDiscordType ApplicationCommandChannelTypeDM = 1+  fromDiscordType ApplicationCommandChannelTypeGuildVoice = 2+  fromDiscordType ApplicationCommandChannelTypeGroupDM = 3+  fromDiscordType ApplicationCommandChannelTypeGuildCategory = 4+  fromDiscordType ApplicationCommandChannelTypeGuildNews = 5+  fromDiscordType ApplicationCommandChannelTypeGuildStore = 6+  fromDiscordType ApplicationCommandChannelTypeGuildNewsThread = 10+  fromDiscordType ApplicationCommandChannelTypeGuildPublicThread = 11+  fromDiscordType ApplicationCommandChannelTypeGuildPrivateThread = 12+  fromDiscordType ApplicationCommandChannelTypeGuildStageVoice = 13  instance ToJSON ApplicationCommandChannelType where-  toJSON = toJSON . fromEnum+  toJSON = toJSON . fromDiscordType  instance FromJSON ApplicationCommandChannelType where-  parseJSON = withScientific "ApplicationCommandChannelType" (return . toEnum . round)+  parseJSON = discordTypeParseJSON "ApplicationCommandChannelType"  data GuildApplicationCommandPermissions = GuildApplicationCommandPermissions-  { -- | The id of the command+  { -- | The id of the command.     guildApplicationCommandPermissionsId :: ApplicationCommandId,-    -- | The id of the application+    -- | The id of the application.     guildApplicationCommandPermissionsApplicationId :: ApplicationId,-    -- | The id of the guild+    -- | The id of the guild.     guildApplicationCommandPermissionsGuildId :: GuildId,-    -- | The permissions for the command in the guild+    -- | The permissions for the command in the guild.     guildApplicationCommandPermissionsPermissions :: [ApplicationCommandPermissions]   }   deriving (Show, Eq, Ord, Read)@@ -642,12 +658,14 @@             ]       ] +-- | Application command permissions allow you to enable or disable commands for+-- specific users or roles within a guild. data ApplicationCommandPermissions = ApplicationCommandPermissions-  { -- | The id of the role or user+  { -- | The id of the role or user.     applicationCommandPermissionsId :: Snowflake,-    -- | Choose either role or user-    applicationCommandPermissionsType :: ApplicationCommandPermissionType,-    -- | Whether to allow or not+    -- | Choose either role (1) or user (2).+    applicationCommandPermissionsType :: Integer,+    -- | Whether to allow or not.     applicationCommandPermissionsPermission :: Bool   }   deriving (Show, Eq, Ord, Read)@@ -673,21 +691,3 @@               ("permission", toMaybeJSON applicationCommandPermissionsPermission)             ]       ]--data ApplicationCommandPermissionType-  = ApplicationCommandPermissionTypeRole-  | ApplicationCommandPermissionTypeUser-  deriving (Show, Eq, Ord, Read, Data)--instance Enum ApplicationCommandPermissionType where-  fromEnum ApplicationCommandPermissionTypeRole = 1-  fromEnum ApplicationCommandPermissionTypeUser = 2-  toEnum a = fromJust $ lookup a table-    where-      table = makeTable ApplicationCommandPermissionTypeRole--instance ToJSON ApplicationCommandPermissionType where-  toJSON = toJSON . fromEnum--instance FromJSON ApplicationCommandPermissionType where-  parseJSON = withScientific "ApplicationCommandPermissionType" (return . toEnum . round)

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveDataTypeable #-} @@ -17,9 +18,8 @@ import Discord.Internal.Types.User (User(..), GuildMember) import Discord.Internal.Types.Embed import Data.Data (Data)-import Data.Maybe (fromJust) import Data.Bits-import Discord.Internal.Types.Components (Component, Emoji)+import Discord.Internal.Types.Components (ComponentActionRow, Emoji)  -- | Guild channels represent an isolated set of users and messages in a Guild (Server) data Channel@@ -292,16 +292,15 @@   , messageWebhookId          :: Maybe WebhookId          -- ^ The webhook id of the webhook that made the message   , messageType               :: MessageType              -- ^ What type of message is this.   , messageActivity           :: Maybe MessageActivity    -- ^ sent with Rich Presence-related chat embeds-  -- , messageApplication  :: Maybe ??? -- ^ a partial application object   , messageApplicationId      :: Maybe ApplicationId      -- ^ if the message is a response to an Interaction, this is the id of the interaction's application   , messageReference          :: Maybe MessageReference   -- ^ Reference IDs of the original message   , messageFlags              :: Maybe MessageFlags       -- ^ Various message flags   , messageReferencedMessage  :: Maybe Message            -- ^ The full original message   , messageInteraction        :: Maybe MessageInteraction -- ^ sent if message is an interaction response   , messageThread             :: Maybe Channel            -- ^ the thread that was started from this message, includes thread member object-  , messageComponents         :: Maybe [Component]        -- ^ sent if the message contains components like buttons, action rows, or other interactive components-  , messageStickerItems       :: Maybe [StickerItem]      -- ^ sent if the message contains stickers -  } deriving (Show, Read, Eq, Ord)+  , messageComponents         :: Maybe [ComponentActionRow]        -- ^ sent if the message contains components like buttons, action rows, or other interactive components+  , messageStickerItems       :: Maybe [StickerItem]      -- ^ sent if the message contains stickers+  } deriving (Show, Eq, Ord, Read)  instance FromJSON Message where   parseJSON = withObject "Message" $ \o ->@@ -449,19 +448,17 @@   | StickerFormatTypeLOTTIE   deriving (Show, Read, Eq, Ord, Data) -instance Enum StickerFormatType where-  fromEnum StickerFormatTypePNG = 1-  fromEnum StickerFormatTypeAPNG = 2-  fromEnum StickerFormatTypeLOTTIE = 3-  toEnum a = fromJust $ lookup a table-    where-      table = makeTable StickerFormatTypePNG+instance InternalDiscordEnum StickerFormatType where+  discordTypeStartValue = StickerFormatTypePNG+  fromDiscordType StickerFormatTypePNG = 1+  fromDiscordType StickerFormatTypeAPNG = 2+  fromDiscordType StickerFormatTypeLOTTIE = 3  instance ToJSON StickerFormatType where-  toJSON = toJSON . fromEnum+  toJSON = toJSON . fromDiscordType  instance FromJSON StickerFormatType where-  parseJSON = withScientific "StickerFormatType" (return . toEnum . round)+  parseJSON = discordTypeParseJSON "StickerFormatType"  -- | Represents an attached to a message file. data Attachment = Attachment@@ -539,9 +536,9 @@   data MessageType-  = MessageTypeDefault -  | MessageTypeRecipientAdd -  | MessageTypeRecipientRemove +  = MessageTypeDefault+  | MessageTypeRecipientAdd+  | MessageTypeRecipientRemove   | MessageTypeCall   | MessageTypeChannelNameChange   | MessageTypeChannelIconChange@@ -564,39 +561,37 @@   | MessageTypeContextMenuCommand   deriving (Show, Read, Data, Eq, Ord) -instance Enum MessageType where-  fromEnum MessageTypeDefault = 0-  fromEnum MessageTypeRecipientAdd = 1-  fromEnum MessageTypeRecipientRemove = 2-  fromEnum MessageTypeCall = 3-  fromEnum MessageTypeChannelNameChange = 4-  fromEnum MessageTypeChannelIconChange = 5-  fromEnum MessageTypeChannelPinnedMessage = 6-  fromEnum MessageTypeGuildMemberJoin = 7-  fromEnum MessageTypeUserPremiumGuildSubscription = 8-  fromEnum MessageTypeUserPremiumGuildSubscriptionTier1 = 9-  fromEnum MessageTypeUserPremiumGuildSubscriptionTier2 = 10-  fromEnum MessageTypeUserPremiumGuildSubscriptionTier3 = 11-  fromEnum MessageTypeChannelFollowAdd = 12-  fromEnum MessageTypeGuildDiscoveryDisqualified = 14-  fromEnum MessageTypeGuildDiscoveryRequalified = 15-  fromEnum MessageTypeGuildDiscoveryGracePeriodInitialWarning = 16-  fromEnum MessageTypeGuildDiscoveryGracePeriodFinalWarning = 17-  fromEnum MessageTypeThreadCreated = 18-  fromEnum MessageTypeReply = 19-  fromEnum MessageTypeChatInputCommand = 20-  fromEnum MessageTypeThreadStarterMessage = 21-  fromEnum MessageTypeGuildInviteReminder = 22-  fromEnum MessageTypeContextMenuCommand = 23-  toEnum a = fromJust $ lookup a table-    where-      table = makeTable MessageTypeDefault+instance InternalDiscordEnum MessageType where+  discordTypeStartValue = MessageTypeDefault+  fromDiscordType MessageTypeDefault = 0+  fromDiscordType MessageTypeRecipientAdd = 1+  fromDiscordType MessageTypeRecipientRemove = 2+  fromDiscordType MessageTypeCall = 3+  fromDiscordType MessageTypeChannelNameChange = 4+  fromDiscordType MessageTypeChannelIconChange = 5+  fromDiscordType MessageTypeChannelPinnedMessage = 6+  fromDiscordType MessageTypeGuildMemberJoin = 7+  fromDiscordType MessageTypeUserPremiumGuildSubscription = 8+  fromDiscordType MessageTypeUserPremiumGuildSubscriptionTier1 = 9+  fromDiscordType MessageTypeUserPremiumGuildSubscriptionTier2 = 10+  fromDiscordType MessageTypeUserPremiumGuildSubscriptionTier3 = 11+  fromDiscordType MessageTypeChannelFollowAdd = 12+  fromDiscordType MessageTypeGuildDiscoveryDisqualified = 14+  fromDiscordType MessageTypeGuildDiscoveryRequalified = 15+  fromDiscordType MessageTypeGuildDiscoveryGracePeriodInitialWarning = 16+  fromDiscordType MessageTypeGuildDiscoveryGracePeriodFinalWarning = 17+  fromDiscordType MessageTypeThreadCreated = 18+  fromDiscordType MessageTypeReply = 19+  fromDiscordType MessageTypeChatInputCommand = 20+  fromDiscordType MessageTypeThreadStarterMessage = 21+  fromDiscordType MessageTypeGuildInviteReminder = 22+  fromDiscordType MessageTypeContextMenuCommand = 23  instance ToJSON MessageType where-  toJSON = toJSON . fromEnum+  toJSON = toJSON . fromDiscordType  instance FromJSON MessageType where-  parseJSON = withScientific "MessageType" (return . toEnum . round)+  parseJSON = discordTypeParseJSON "MessageType"  data MessageActivity = MessageActivity   { messageActivityType :: MessageActivityType@@ -622,23 +617,21 @@   | MessageActivityTypeJoinRequest -- ^ Request to join a Rich Presence event   deriving (Show, Read, Data, Eq, Ord) -instance Enum MessageActivityType where-  fromEnum MessageActivityTypeJoin = 1-  fromEnum MessageActivityTypeSpectate = 2-  fromEnum MessageActivityTypeListen = 3-  fromEnum MessageActivityTypeJoinRequest = 4-  toEnum a = fromJust $ lookup a table-    where-      table = makeTable MessageActivityTypeJoin+instance InternalDiscordEnum MessageActivityType where+  discordTypeStartValue = MessageActivityTypeJoin+  fromDiscordType MessageActivityTypeJoin = 1+  fromDiscordType MessageActivityTypeSpectate = 2+  fromDiscordType MessageActivityTypeListen = 3+  fromDiscordType MessageActivityTypeJoinRequest = 4  instance ToJSON MessageActivityType where-  toJSON = toJSON . fromEnum+  toJSON = toJSON . fromDiscordType  instance FromJSON MessageActivityType where-  parseJSON = withScientific "MessageActivityType" (return . toEnum . round)+  parseJSON = discordTypeParseJSON "MessageActivityType"  -- | Types of flags to attach to the message.-data MessageFlag = +data MessageFlag =     MessageFlagCrossposted   | MessageFlagIsCrosspost   | MessageFlagSupressEmbeds@@ -652,35 +645,36 @@ newtype MessageFlags = MessageFlags [MessageFlag]   deriving (Show, Read, Eq, Ord) -instance Enum MessageFlag where-  fromEnum MessageFlagCrossposted = 1 `shift` 0-  fromEnum MessageFlagIsCrosspost = 1 `shift` 1-  fromEnum MessageFlagSupressEmbeds = 1 `shift` 2-  fromEnum MessageFlagSourceMessageDeleted = 1 `shift` 3-  fromEnum MessageFlagUrgent = 1 `shift` 4-  fromEnum MessageFlagHasThread = 1 `shift` 5-  fromEnum MessageFlagEphemeral = 1 `shift` 6-  fromEnum MessageFlagLoading = 1 `shift` 7-  toEnum a = fromJust $ lookup a table-    where-      table = makeTable MessageFlagCrossposted+instance InternalDiscordEnum MessageFlag where+  discordTypeStartValue = MessageFlagCrossposted+  fromDiscordType MessageFlagCrossposted = 1 `shift` 0+  fromDiscordType MessageFlagIsCrosspost = 1 `shift` 1+  fromDiscordType MessageFlagSupressEmbeds = 1 `shift` 2+  fromDiscordType MessageFlagSourceMessageDeleted = 1 `shift` 3+  fromDiscordType MessageFlagUrgent = 1 `shift` 4+  fromDiscordType MessageFlagHasThread = 1 `shift` 5+  fromDiscordType MessageFlagEphemeral = 1 `shift` 6+  fromDiscordType MessageFlagLoading = 1 `shift` 7  instance ToJSON MessageFlags where-  toJSON (MessageFlags fs) = Number $ fromInteger $ fromIntegral $ foldr (.|.) 0 (fromEnum <$> fs)+  toJSON (MessageFlags fs) = Number $ fromInteger $ fromIntegral $ foldr (.|.) 0 (fromDiscordType <$> fs)  -- TODO: maybe make this a type class or something - the ability to handle flags automatically would be Very Good.  instance FromJSON MessageFlags where-  parseJSON = withScientific "MessageFlags" (\s -> let i = round s in if i /= (i .&. range) then fail "could not get message flags" else return $ MessageFlags (snd <$> filter (\(i',_) -> i .&. i' == i') table))-    where -      table = makeTable MessageFlagCrossposted-      range = sum $ fst <$> table+  parseJSON = withScientific "MessageFlags" $ \s ->+      let i = round s+          range = sum $ fst <$> (discordTypeTable @MessageFlag)+      in if i /= (i .&. range)+         then fail "could not get message flags"+         else return $ MessageFlags (snd <$> filter (\(i',_) -> i .&. i' == i') discordTypeTable) +-- | This is sent on the message object when the message is a response to an Interaction without an existing message (i.e., any non-component interaction). data MessageInteraction = MessageInteraction-  { messageInteractionId :: InteractionId-  , messageInteractionType :: InteractionType-  , messageInteractionName :: T.Text-  , messageInteractionUser :: User+  { messageInteractionId :: InteractionId -- ^ Id of the interaction+  , messageInteractionType :: Integer -- ^ Type of the interaction (liekly always application command)+  , messageInteractionName :: T.Text -- ^ Name of the interaction+  , messageInteractionUser :: User -- ^ User who invoked the interaction   } deriving (Show, Eq, Ord, Read)  instance ToJSON MessageInteraction where@@ -698,4 +692,3 @@                        <*> o .: "type"                        <*> o .: "name"                        <*> o .: "user"-

@@ -0,0 +1,164 @@+{-# LANGUAGE DeriveDataTypeable #-}++-- | Data structures pertaining to Discord Colors+module Discord.Internal.Types.Color where+++import Text.Read (readMaybe)+import Data.Maybe (fromMaybe)+import Data.Char (toLower)+import Data.Aeson+import Data.Data+import Control.Applicative (Alternative((<|>)))+import Data.Bits (Bits((.&.)))+++import Discord.Internal.Types.Prelude (InternalDiscordEnum(..))++-- | Color names+-- Color is a bit of a mess on discord embeds.+-- I've here stolen the pallet list from https://gist.github.com/thomasbnt/b6f455e2c7d743b796917fa3c205f812+--+-- All discord embed color stuff is credited to+-- https://github.com/WarwickTabletop/tablebot/pull/34+data DiscordColor+  = DiscordColorRGB Integer Integer Integer+  | DiscordColorDefault+  | DiscordColorAqua+  | DiscordColorDarkAqua+  | DiscordColorGreen+  | DiscordColorDarkGreen+  | DiscordColorBlue+  | DiscordColorDarkBlue+  | DiscordColorPurple+  | DiscordColorDarkPurple+  | DiscordColorLuminousVividPink+  | DiscordColorDarkVividPink+  | DiscordColorGold+  | DiscordColorDarkGold+  | DiscordColorOrange+  | DiscordColorDarkOrange+  | DiscordColorRed+  | DiscordColorDarkRed+  | DiscordColorGray+  | DiscordColorDarkGray+  | DiscordColorDarkerGray+  | DiscordColorLightGray+  | DiscordColorNavy+  | DiscordColorDarkNavy+  | DiscordColorYellow+  | DiscordColorDiscordWhite+  | DiscordColorDiscordBlurple+  | DiscordColorDiscordGrayple+  | DiscordColorDiscordDarkButNotBlack+  | DiscordColorDiscordNotQuiteBlack+  | DiscordColorDiscordGreen+  | DiscordColorDiscordYellow+  | DiscordColorDiscordFuschia+  | DiscordColorDiscordRed+  | DiscordColorDiscordBlack+  deriving (Show, Read, Eq, Ord, Data)++-- | @hexToRGB@ attempts to convert a potential hex string into its decimal RGB+-- components.+hexToRGB :: String -> Maybe (Integer, Integer, Integer)+hexToRGB hex = do+  let h = map toLower hex+  r <- take2 h >>= toDec+  g <- drop2 h >>= take2 >>= toDec+  b <- drop2 h >>= drop2 >>= toDec+  return (r, g, b)+  where+    take2 (a:b:_) = Just [a, b]+    take2 _ = Nothing+    drop2 (_ : _ : as) = Just as+    drop2 _ = Nothing+    toDec :: String -> Maybe Integer+    toDec [s, u] = do+      a <- charToDec s+      b <- charToDec u+      return $ a * 16 + b+    toDec _ = Nothing+    charToDec :: Char -> Maybe Integer+    charToDec 'a' = Just 10+    charToDec 'b' = Just 11+    charToDec 'c' = Just 12+    charToDec 'd' = Just 13+    charToDec 'e' = Just 14+    charToDec 'f' = Just 15+    charToDec c = readMaybe [c]++-- | @hexToDiscordColor@ converts a potential hex string into a DiscordColor,+-- evaluating to Default if it fails.+hexToDiscordColor :: String -> DiscordColor+hexToDiscordColor hex =+  let (r, g, b) = fromMaybe (0, 0, 0) $ hexToRGB hex+   in DiscordColorRGB r g b++colorToInternal :: DiscordColor -> Integer+-- colorToInternal (DiscordColor i) = i+colorToInternal (DiscordColorRGB r g b) = (r * 256 + g) * 256 + b+colorToInternal DiscordColorDefault = 0+colorToInternal DiscordColorAqua = 1752220+colorToInternal DiscordColorDarkAqua = 1146986+colorToInternal DiscordColorGreen = 3066993+colorToInternal DiscordColorDarkGreen = 2067276+colorToInternal DiscordColorBlue = 3447003+colorToInternal DiscordColorDarkBlue = 2123412+colorToInternal DiscordColorPurple = 10181046+colorToInternal DiscordColorDarkPurple = 7419530+colorToInternal DiscordColorLuminousVividPink = 15277667+colorToInternal DiscordColorDarkVividPink = 11342935+colorToInternal DiscordColorGold = 15844367+colorToInternal DiscordColorDarkGold = 12745742+colorToInternal DiscordColorOrange = 15105570+colorToInternal DiscordColorDarkOrange = 11027200+colorToInternal DiscordColorRed = 15158332+colorToInternal DiscordColorDarkRed = 10038562+colorToInternal DiscordColorGray = 9807270+colorToInternal DiscordColorDarkGray = 9936031+colorToInternal DiscordColorDarkerGray = 8359053+colorToInternal DiscordColorLightGray = 12370112+colorToInternal DiscordColorNavy = 3426654+colorToInternal DiscordColorDarkNavy = 2899536+colorToInternal DiscordColorYellow = 16776960+colorToInternal DiscordColorDiscordWhite = 16777215+colorToInternal DiscordColorDiscordBlurple = 5793266+colorToInternal DiscordColorDiscordGrayple = 10070709+colorToInternal DiscordColorDiscordDarkButNotBlack = 2895667+colorToInternal DiscordColorDiscordNotQuiteBlack = 2303786+colorToInternal DiscordColorDiscordGreen = 5763719+colorToInternal DiscordColorDiscordYellow = 16705372+colorToInternal DiscordColorDiscordFuschia = 15418782+colorToInternal DiscordColorDiscordRed = 15548997+colorToInternal DiscordColorDiscordBlack = 16777215++convertToRGB :: Integer -> DiscordColor+convertToRGB i = DiscordColorRGB (div i (256 * 256) .&. 255) (div i 256 .&. 255) (i .&. 255)++instance InternalDiscordEnum DiscordColor where+  discordTypeStartValue = DiscordColorDefault+  fromDiscordType = fromIntegral . colorToInternal+  discordTypeTable = map (\d -> (fromDiscordType d, d)) (makeTable discordTypeStartValue)+    where+      makeTable :: Data b => b -> [b]+      makeTable t = map (fromConstrB (fromConstr (toConstr (0 :: Int)))) (dataTypeConstrs $ dataTypeOf t)++instance ToJSON DiscordColor where+  toJSON = toJSON . fromDiscordType++instance FromJSON DiscordColor where+  parseJSON =+    withScientific+      "DiscordColor"+      ( \v ->+          discordTypeParseJSON "DiscordColor" (Number v)+            <|> ( case maybeInt v >>= Just . convertToRGB of+                    Nothing -> fail $ "could not parse discord color: " ++ show v+                    Just d -> return d+                )+      )+    where+      maybeInt i+        | fromIntegral (round i) == i = Just $ round i+        | otherwise = Nothing

@@ -1,219 +1,278 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -module Discord.Internal.Types.Components where+module Discord.Internal.Types.Components+  ( ComponentActionRow (..),+    ComponentButton (..),+    ButtonStyle (..),+    mkButton,+    ComponentSelectMenu (..),+    mkSelectMenu,+    SelectOption (..),+    mkSelectOption,+    Emoji (..),+    mkEmoji,+  )+where  import Data.Aeson-import Data.Data (Data)-import Data.Maybe (fromJust, fromMaybe)+import Data.Aeson.Types (Parser)+import Data.Foldable (Foldable (toList))+import Data.Scientific (Scientific) import qualified Data.Text as T-import Data.Tuple (swap)-import Discord.Internal.Types.Prelude (EmojiId, Internals (..), RoleId, makeTable, toMaybeJSON)+import Discord.Internal.Types.Prelude (EmojiId, RoleId, toMaybeJSON) import Discord.Internal.Types.User (User)-import qualified Network.HTTP.Req as R +data ComponentActionRow = ComponentActionRowButton [ComponentButton] | ComponentActionRowSelectMenu ComponentSelectMenu+  deriving (Show, Eq, Ord, Read)++instance FromJSON ComponentActionRow where+  parseJSON =+    withObject+      "ComponentActionRow"+      ( \cs -> do+          a <- cs .: "components" :: Parser Array+          let a' = toList a+          case a' of+            [] -> return $ ComponentActionRowButton []+            (c : _) ->+              withObject+                "ComponentActionRow item"+                ( \v -> do+                    t <- v .: "type" :: Parser Int+                    case t of+                      2 -> ComponentActionRowButton <$> mapM parseJSON a'+                      3 -> ComponentActionRowSelectMenu <$> parseJSON c+                      _ -> fail $ "unknown component type: " ++ show t+                )+                c+      )++instance ToJSON ComponentActionRow where+  toJSON (ComponentActionRowButton bs) = object [("type", Number 1), ("components", toJSON bs)]+  toJSON (ComponentActionRowSelectMenu bs) = object [("type", Number 1), ("components", toJSON [bs])]+ -- | Component type for a button, split into URL button and not URL button. -- -- Don't directly send button components - they need to be within an action row. data ComponentButton   = ComponentButton-      { componentButtonCustomId :: T.Text,+      { -- | Dev indentifier+        componentButtonCustomId :: T.Text,+        -- | Whether the button is disabled         componentButtonDisabled :: Bool,+        -- | What is the style of the button         componentButtonStyle :: ButtonStyle,+        -- | What is the user-facing label of the button         componentButtonLabel :: T.Text,+        -- | What emoji is displayed on the button         componentButtonEmoji :: Maybe Emoji       }   | ComponentButtonUrl-      { componentButtonUrl :: R.Url 'R.Https,+      { -- | The url for the button. If this is not a valid url, everything will+        -- break+        componentButtonUrl :: T.Text,+        -- | Whether the button is disabled         componentButtonDisabled :: Bool,+        -- | What is the user-facing label of the button         componentButtonLabel :: T.Text,+        -- | What emoji is displayed on the button         componentButtonEmoji :: Maybe Emoji       }-  deriving (Show, Eq)+  deriving (Show, Eq, Ord, Read) -data ButtonStyle = ButtonStylePrimary | ButtonStyleSecondary | ButtonStyleSuccess | ButtonStyleDanger-  deriving (Show, Eq, Read)+-- | Takes the label and the custom id of the button that is to be generated.+mkButton :: T.Text -> T.Text -> ComponentButton+mkButton label customId = ComponentButton customId False ButtonStyleSecondary label Nothing -buttonStyles :: [(ButtonStyle, InternalButtonStyle)]-buttonStyles =-  [ (ButtonStylePrimary, InternalButtonStylePrimary),-    (ButtonStyleSecondary, InternalButtonStyleSecondary),-    (ButtonStyleSuccess, InternalButtonStyleSuccess),-    (ButtonStyleDanger, InternalButtonStyleDanger)-  ]+instance FromJSON ComponentButton where+  parseJSON =+    withObject+      "ComponentButton"+      ( \v -> do+          t <- v .: "type" :: Parser Int+          case t of+            2 -> do+              disabled <- v .:? "disabled" .!= False+              label <- v .: "label"+              partialEmoji <- v .:? "emoji"+              style <- v .: "style" :: Parser Scientific+              case style of+                5 ->+                  ComponentButtonUrl+                    <$> v .: "url"+                    <*> return disabled+                    <*> return label+                    <*> return partialEmoji+                _ ->+                  ComponentButton+                    <$> v .: "custom_id"+                    <*> return disabled+                    <*> parseJSON (Number style)+                    <*> return label+                    <*> return partialEmoji+            _ -> fail "expected button type, got a different component"+      ) -instance Internals ButtonStyle InternalButtonStyle where-  toInternal a = fromJust (lookup a buttonStyles)-  fromInternal b = lookup b (swap <$> buttonStyles)+instance ToJSON ComponentButton where+  toJSON ComponentButtonUrl {..} =+    object+      [ (name, value)+        | (name, Just value) <-+            [ ("type", Just $ Number 2),+              ("style", Just $ Number 5),+              ("label", toMaybeJSON componentButtonLabel),+              ("disabled", toMaybeJSON componentButtonDisabled),+              ("url", toMaybeJSON componentButtonUrl),+              ("emoji", toJSON <$> componentButtonEmoji)+            ]+      ]+  toJSON ComponentButton {..} =+    object+      [ (name, value)+        | (name, Just value) <-+            [ ("type", Just $ Number 2),+              ("style", Just $ toJSON componentButtonStyle),+              ("label", toMaybeJSON componentButtonLabel),+              ("disabled", toMaybeJSON componentButtonDisabled),+              ("custom_id", toMaybeJSON componentButtonCustomId),+              ("emoji", toJSON <$> componentButtonEmoji)+            ]+      ] +-- | Buttton colors.+data ButtonStyle+  = -- | Blurple button+    ButtonStylePrimary+  | -- | Grey button+    ButtonStyleSecondary+  | -- | Green button+    ButtonStyleSuccess+  | -- | Red button+    ButtonStyleDanger+  deriving (Show, Eq, Ord, Read)++instance FromJSON ButtonStyle where+  parseJSON =+    withScientific+      "ButtonStyle"+      ( \case+          1 -> return ButtonStylePrimary+          2 -> return ButtonStyleSecondary+          3 -> return ButtonStyleSuccess+          4 -> return ButtonStyleDanger+          _ -> fail "unrecognised non-url button style"+      )++instance ToJSON ButtonStyle where+  toJSON ButtonStylePrimary = Number 1+  toJSON ButtonStyleSecondary = Number 2+  toJSON ButtonStyleSuccess = Number 3+  toJSON ButtonStyleDanger = Number 4+ -- | Component type for a select menus. -- -- Don't directly send select menus - they need to be within an action row. data ComponentSelectMenu = ComponentSelectMenu-  { componentSelectMenuCustomId :: T.Text,+  { -- | Dev identifier+    componentSelectMenuCustomId :: T.Text,+    -- | Whether the select menu is disabled     componentSelectMenuDisabled :: Bool,+    -- | What options are in this select menu (up to 25)     componentSelectMenuOptions :: [SelectOption],+    -- | Placeholder text if nothing is selected     componentSelectMenuPlaceholder :: Maybe T.Text,+    -- | Minimum number of values to select (def 1, min 0, max 25)     componentSelectMenuMinValues :: Maybe Integer,+    -- | Maximum number of values to select (def 1, max 25)     componentSelectMenuMaxValues :: Maybe Integer   }-  deriving (Show, Eq, Read)--data ComponentActionRow = ComponentActionRowButton [ComponentButton] | ComponentActionRowSelectMenu ComponentSelectMenu-  deriving (Show, Eq)+  deriving (Show, Eq, Ord, Read) -validPartialEmoji :: Emoji -> Maybe Emoji-validPartialEmoji Emoji {..} = do-  eid <- emojiId-  ean <- emojiAnimated-  return $ Emoji (Just eid) emojiName Nothing Nothing Nothing (Just ean)+-- | Takes the custom id and the options of the select menu that is to be+-- generated.+mkSelectMenu :: T.Text -> [SelectOption] -> ComponentSelectMenu+mkSelectMenu customId sos = ComponentSelectMenu customId False sos Nothing Nothing Nothing -instance Internals ComponentActionRow Component where-  toInternal (ComponentActionRowButton as) = Component ComponentTypeActionRow Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing (Just (toInternal' <$> as))-    where-      toInternal' ComponentButtonUrl {..} = Component ComponentTypeButton Nothing (Just componentButtonDisabled) (Just InternalButtonStyleLink) (Just componentButtonLabel) componentButtonEmoji (Just (R.renderUrl componentButtonUrl)) Nothing Nothing Nothing Nothing Nothing-      toInternal' ComponentButton {..} = Component ComponentTypeButton (Just componentButtonCustomId) (Just componentButtonDisabled) (Just (toInternal componentButtonStyle)) (Just componentButtonLabel) componentButtonEmoji Nothing Nothing Nothing Nothing Nothing Nothing-  toInternal (ComponentActionRowSelectMenu ComponentSelectMenu {..}) = Component ComponentTypeActionRow Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing (Just [Component ComponentTypeSelectMenu (Just componentSelectMenuCustomId) (Just componentSelectMenuDisabled) Nothing Nothing Nothing Nothing (Just componentSelectMenuOptions) componentSelectMenuPlaceholder componentSelectMenuMinValues componentSelectMenuMaxValues Nothing])+instance FromJSON ComponentSelectMenu where+  parseJSON =+    withObject+      "ComponentSelectMenu"+      ( \v ->+          do+            t <- v .: "type" :: Parser Int+            case t of+              3 ->+                ComponentSelectMenu+                  <$> v .: "custom_id"+                  <*> v .:? "disabled" .!= False+                  <*> v .: "options"+                  <*> v .:? "placeholder"+                  <*> v .:? "min_values"+                  <*> v .:? "max_values"+              _ -> fail "expected select menu type, got different component"+      ) -  fromInternal Component {componentType = ComponentTypeActionRow, componentComponents = (Just (Component {componentType = ComponentTypeSelectMenu, ..} : _))} = do-    cid <- componentCustomId-    cd <- componentDisabled-    co <- componentOptions-    return $ ComponentActionRowSelectMenu $ ComponentSelectMenu cid cd co componentPlaceholder componentMinValues componentMaxValues-  fromInternal Component {componentType = ComponentTypeActionRow, componentComponents = compComps} = compComps >>= mapM fromInternal' >>= Just . ComponentActionRowButton-    where-      fromInternal' Component {componentType = ComponentTypeButton, componentStyle = Just InternalButtonStyleLink, ..} = do-        url <- R.https <$> componentUrl-        label <- componentLabel-        return $ ComponentButtonUrl url (fromMaybe False componentDisabled) label componentEmoji-      fromInternal' Component {componentType = ComponentTypeButton, ..} = do-        customId <- componentCustomId-        label <- componentLabel-        style <- componentStyle >>= fromInternal-        return $ ComponentButton customId (fromMaybe False componentDisabled) style label componentEmoji-      fromInternal' _ = Nothing-  fromInternal _ = Nothing+instance ToJSON ComponentSelectMenu where+  toJSON ComponentSelectMenu {..} =+    object+      [ (name, value)+        | (name, Just value) <-+            [ ("type", Just $ Number 3),+              ("custom_id", toMaybeJSON componentSelectMenuCustomId),+              ("disabled", toMaybeJSON componentSelectMenuDisabled),+              ("options", toMaybeJSON componentSelectMenuOptions),+              ("placeholder", toJSON <$> componentSelectMenuPlaceholder),+              ("min_values", toJSON <$> componentSelectMenuMinValues),+              ("max_values", toJSON <$> componentSelectMenuMaxValues)+            ]+      ] -data Component = Component-  { componentType :: ComponentType,-    -- | Buttons and Select Menus only-    componentCustomId :: Maybe T.Text,-    -- | Buttons and Select Menus only-    componentDisabled :: Maybe Bool,-    -- | Button only-    componentStyle :: Maybe InternalButtonStyle,-    -- | Button only-    componentLabel :: Maybe T.Text,-    -- | Button only-    componentEmoji :: Maybe Emoji,-    -- | Button only, link buttons only-    componentUrl :: Maybe T.Text,-    -- | Select Menus only, max 25-    componentOptions :: Maybe [SelectOption],-    -- | Select Menus only, max 100 chars-    componentPlaceholder :: Maybe T.Text,-    -- | Select Menus only, min values to choose, default 1-    componentMinValues :: Maybe Integer,-    -- | Select Menus only, max values to choose, default 1-    componentMaxValues :: Maybe Integer,-    -- | Action Rows only-    componentComponents :: Maybe [Component]+-- | A single option in a select menu.+data SelectOption = SelectOption+  { -- | User facing option name+    selectOptionLabel :: T.Text,+    -- | Dev facing option value+    selectOptionValue :: T.Text,+    -- | additional description+    selectOptionDescription :: Maybe T.Text,+    -- | A partial emoji to show with the object (id, name, animated)+    selectOptionEmoji :: Maybe Emoji,+    -- | Use this value by default+    selectOptionDefault :: Maybe Bool   }   deriving (Show, Eq, Ord, Read) -instance FromJSON Component where-  parseJSON = withObject "Component" $ \o ->-    Component <$> o .: "type"-      <*> o .:? "custom_id"-      <*> o .:? "disabled"-      <*> o .:? "style"-      <*> o .:? "label"+-- | Make a select option from the given label and value.+mkSelectOption :: T.Text -> T.Text -> SelectOption+mkSelectOption label value = SelectOption label value Nothing Nothing Nothing++instance FromJSON SelectOption where+  parseJSON = withObject "SelectOption" $ \o ->+    SelectOption <$> o .: "label"+      <*> o .: "value"+      <*> o .:? "description"       <*> o .:? "emoji"-      <*> o .:? "url"-      <*> o .:? "options"-      <*> o .:? "placeholder"-      <*> o .:? "min_values"-      <*> o .:? "max_values"-      <*> o .:? "components"+      <*> o .:? "default" -instance ToJSON Component where-  toJSON Component {..} =+instance ToJSON SelectOption where+  toJSON SelectOption {..} =     object       [ (name, value)         | (name, Just value) <--            [ ("type", toMaybeJSON componentType),-              ("custom_id", toJSON <$> componentCustomId),-              ("disabled", toJSON <$> componentDisabled),-              ("style", toJSON <$> componentStyle),-              ("label", toJSON <$> componentLabel),-              ("emoji", toJSON <$> componentEmoji),-              ("url", toJSON <$> componentUrl),-              ("options", toJSON <$> componentOptions),-              ("placeholder", toJSON <$> componentPlaceholder),-              ("min_values", toJSON <$> componentMinValues),-              ("max_values", toJSON <$> componentMaxValues),-              ("components", toJSON <$> componentComponents)+            [ ("label", toMaybeJSON selectOptionLabel),+              ("value", toMaybeJSON selectOptionValue),+              ("description", toJSON <$> selectOptionDescription),+              ("emoji", toJSON <$> selectOptionEmoji),+              ("default", toJSON <$> selectOptionDefault)             ]       ] --- | The different types of components-data ComponentType-  = -- | A container for other components-    ComponentTypeActionRow-  | -- | A button-    ComponentTypeButton-  | -- | A select menu for picking from choices-    ComponentTypeSelectMenu-  deriving (Show, Read, Eq, Ord, Data)--instance Enum ComponentType where-  fromEnum ComponentTypeActionRow = 1-  fromEnum ComponentTypeButton = 2-  fromEnum ComponentTypeSelectMenu = 3-  toEnum a = fromJust $ lookup a table-    where-      table = makeTable ComponentTypeActionRow--instance ToJSON ComponentType where-  toJSON = toJSON . fromEnum--instance FromJSON ComponentType where-  parseJSON = withScientific "StickerFormatType" (return . toEnum . round)--data InternalButtonStyle-  = -- | Blurple button-    InternalButtonStylePrimary-  | -- | Grey button-    InternalButtonStyleSecondary-  | -- | Green button-    InternalButtonStyleSuccess-  | -- | Red button-    InternalButtonStyleDanger-  | -- | Grey button, navigates to URL-    InternalButtonStyleLink-  deriving (Show, Read, Eq, Ord, Data)--instance Enum InternalButtonStyle where-  fromEnum InternalButtonStylePrimary = 1-  fromEnum InternalButtonStyleSecondary = 2-  fromEnum InternalButtonStyleSuccess = 3-  fromEnum InternalButtonStyleDanger = 4-  fromEnum InternalButtonStyleLink = 5-  toEnum a = fromJust $ lookup a table-    where-      table = makeTable InternalButtonStylePrimary--instance ToJSON InternalButtonStyle where-  toJSON = toJSON . fromEnum--instance FromJSON InternalButtonStyle where-  parseJSON = withScientific "InternalButtonStyle" (return . toEnum . round)- -- | Represents an emoticon (emoji) data Emoji = Emoji   { -- | The emoji id@@ -231,6 +290,10 @@   }   deriving (Show, Read, Eq, Ord) +-- | Make an emoji with only a name+mkEmoji :: T.Text -> Emoji+mkEmoji t = Emoji Nothing t Nothing Nothing Nothing Nothing+ instance FromJSON Emoji where   parseJSON = withObject "Emoji" $ \o ->     Emoji <$> o .:? "id"@@ -253,44 +316,3 @@               ("animated", toJSON <$> emojiAnimated)             ]       ]--data SelectOption = SelectOption-  { -- | User facing option name-    selectOptionLabel :: T.Text,-    -- | Dev facing option value-    selectOptionValue :: T.Text,-    -- | additional description-    selectOptionDescription :: Maybe T.Text,-    -- | A partial emoji to show with the object (id, name, animated)-    selectOptionEmoji :: Maybe Emoji,-    -- | Use this value by default-    selectOptionDefault :: Maybe Bool-  }-  deriving (Show, Eq, Ord, Read)--instance FromJSON SelectOption where-  parseJSON = withObject "SelectOption" $ \o ->-    SelectOption <$> o .: "label"-      <*> o .: "value"-      <*> o .:? "description"-      <*> o .:? "emoji"-      <*> o .:? "default"--instance ToJSON SelectOption where-  toJSON SelectOption {..} =-    object-      [ (name, value)-        | (name, Just value) <--            [ ("label", toMaybeJSON selectOptionLabel),-              ("value", toMaybeJSON selectOptionValue),-              ("description", toJSON <$> selectOptionDescription),-              ("emoji", toJSON <$> selectOptionEmoji),-              ("default", toJSON <$> selectOptionDefault)-            ]-      ]--filterOutIncorrectEmoji :: Component -> Component-filterOutIncorrectEmoji c@Component {componentType = ComponentTypeActionRow, componentComponents = (Just cs)} = c {componentComponents = Just (filterOutIncorrectEmoji <$> cs)}-filterOutIncorrectEmoji c@Component {componentType = ComponentTypeSelectMenu, componentOptions = (Just os)} = c {componentOptions = Just ((\so -> so {selectOptionEmoji = selectOptionEmoji so >>= validPartialEmoji}) <$> os)}-filterOutIncorrectEmoji c@Component {componentType = ComponentTypeButton, componentEmoji = (Just e)} = c {componentEmoji = validPartialEmoji e}-filterOutIncorrectEmoji c = c

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RecordWildCards #-}  -- | Data structures pertaining to Discord Embed@@ -9,9 +10,13 @@ import Data.Default (Default, def) import qualified Data.Text as T import qualified Data.ByteString as B+import Data.Functor ((<&>)) -import Discord.Internal.Types.Prelude+import Network.HTTP.Client.MultipartFormData (PartM, partFileRequestBody)+import Network.HTTP.Client (RequestBody(RequestBodyBS)) +import Discord.Internal.Types.Color (DiscordColor)+ createEmbed :: CreateEmbed -> Embed createEmbed CreateEmbed{..} =   let@@ -21,16 +26,16 @@     embedImageToUrl :: T.Text -> CreateEmbedImage -> T.Text     embedImageToUrl place cei = case cei of                             CreateEmbedImageUrl t -> t-                            CreateEmbedImageUpload _ -> "attachment://" <> place <> ".png"+                            CreateEmbedImageUpload _ -> T.filter (/=' ') $ "attachment://" <> createEmbedTitle <> place <> ".png" -    embedAuthor = EmbedAuthor (emptyMaybe createEmbedAuthorName)+    embedAuthor = EmbedAuthor createEmbedAuthorName                               (emptyMaybe createEmbedAuthorUrl)                               (embedImageToUrl "author" <$> createEmbedAuthorIcon)                               Nothing-    embedImage = EmbedImage   (embedImageToUrl "image" <$> createEmbedImage)-                              Nothing Nothing Nothing-    embedThumbnail = EmbedThumbnail (embedImageToUrl "thumbnail" <$> createEmbedThumbnail)-                              Nothing Nothing Nothing+    embedImage = (embedImageToUrl "image" <$> createEmbedImage) <&>+                  \image -> EmbedImage image Nothing Nothing Nothing+    embedThumbnail = (embedImageToUrl "thumbnail" <$> createEmbedThumbnail) <&>+                      \thumbnail -> EmbedThumbnail thumbnail Nothing Nothing Nothing     embedFooter = EmbedFooter createEmbedFooterText                               (embedImageToUrl "footer" <$> createEmbedFooterIcon)                               Nothing@@ -38,16 +43,15 @@   in Embed { embedAuthor      = Just embedAuthor            , embedTitle       = emptyMaybe createEmbedTitle            , embedUrl         = emptyMaybe createEmbedUrl-           , embedThumbnail   = Just embedThumbnail+           , embedThumbnail   = embedThumbnail            , embedDescription = emptyMaybe createEmbedDescription            , embedFields      = createEmbedFields-           , embedImage       = Just embedImage+           , embedImage       = embedImage            , embedFooter      = Just embedFooter            , embedColor       = createEmbedColor-           , embedTimestamp   = Nothing+           , embedTimestamp   = createEmbedTimestamp             -- can't set these-           , embedType        = Nothing            , embedVideo       = Nothing            , embedProvider    = Nothing            }@@ -64,8 +68,8 @@   , createEmbedImage       :: Maybe CreateEmbedImage   , createEmbedFooterText  :: T.Text   , createEmbedFooterIcon  :: Maybe CreateEmbedImage-  , createEmbedColor       :: Maybe ColorInteger---, createEmbedTimestamp   :: Maybe UTCTime+  , createEmbedColor       :: Maybe DiscordColor+  , createEmbedTimestamp   :: Maybe UTCTime   } deriving (Show, Read, Eq, Ord)  data CreateEmbedImage = CreateEmbedImageUrl T.Text@@ -73,7 +77,7 @@   deriving (Show, Read, Eq, Ord)  instance Default CreateEmbed where- def = CreateEmbed "" "" Nothing "" "" Nothing "" [] Nothing "" Nothing Nothing  -- Nothing+ def = CreateEmbed "" "" Nothing "" "" Nothing "" [] Nothing "" Nothing Nothing Nothing  -- | An embed attached to a message. data Embed = Embed@@ -85,9 +89,8 @@   , embedFields      :: [EmbedField]     -- ^ Fields of the embed   , embedImage       :: Maybe EmbedImage   , embedFooter      :: Maybe EmbedFooter-  , embedColor       :: Maybe ColorInteger    -- ^ The embed color+  , embedColor       :: Maybe DiscordColor    -- ^ The embed color   , embedTimestamp   :: Maybe UTCTime    -- ^ The time of the embed content-  , embedType        :: Maybe T.Text     -- ^ Type of embed (Always "rich" for users)   , embedVideo       :: Maybe EmbedVideo -- ^ Only present for "video" types   , embedProvider    :: Maybe EmbedProvider -- ^ Only present for "video" types   } deriving (Show, Read, Eq, Ord)@@ -105,7 +108,6 @@    , "footer"      .= embedFooter    , "color"       .= embedColor    , "timestamp"   .= embedTimestamp-   , "type"        .= embedType    , "video"       .= embedVideo    , "provider"    .= embedProvider     ]@@ -122,13 +124,12 @@           <*> o .:? "footer"           <*> o .:? "color"           <*> o .:? "timestamp"-          <*> o .:? "type"           <*> o .:? "video"           <*> o .:? "provider"   data EmbedThumbnail = EmbedThumbnail-  { embedThumbnailUrl :: Maybe T.Text+  { embedThumbnailUrl :: T.Text   , embedThumbnailProxyUrl :: Maybe T.Text   , embedThumbnailHeight :: Maybe Integer   , embedThumbnailWidth :: Maybe Integer@@ -144,32 +145,35 @@  instance FromJSON EmbedThumbnail where   parseJSON = withObject "thumbnail" $ \o ->-    EmbedThumbnail <$> o .:? "url"+    EmbedThumbnail <$> o .: "url"                    <*> o .:? "proxy_url"                    <*> o .:? "height"                    <*> o .:? "width"  data EmbedVideo = EmbedVideo   { embedVideoUrl :: Maybe T.Text+  , embedProxyUrl :: Maybe T.Text   , embedVideoHeight :: Maybe Integer   , embedVideoWidth :: Maybe Integer   } deriving (Show, Read, Eq, Ord)  instance ToJSON EmbedVideo where-  toJSON (EmbedVideo a b c) = object+  toJSON (EmbedVideo a a' b c) = object     [ "url" .= a     , "height" .= b     , "width" .= c+    , "proxy_url" .= a'     ]  instance FromJSON EmbedVideo where   parseJSON = withObject "video" $ \o ->     EmbedVideo <$> o .:? "url"+               <*> o .:? "proxy_url"                <*> o .:? "height"                <*> o .:? "width"  data EmbedImage = EmbedImage-  { embedImageUrl :: Maybe T.Text+  { embedImageUrl :: T.Text   , embedImageProxyUrl :: Maybe T.Text   , embedImageHeight :: Maybe Integer   , embedImageWidth :: Maybe Integer@@ -185,7 +189,7 @@  instance FromJSON EmbedImage where   parseJSON = withObject "image" $ \o ->-    EmbedImage <$> o .:? "url"+    EmbedImage <$> o .:  "url"                <*> o .:? "proxy_url"                <*> o .:? "height"                <*> o .:? "width"@@ -207,7 +211,7 @@                   <*> o .:? "url"  data EmbedAuthor = EmbedAuthor-  { embedAuthorName :: Maybe T.Text+  { embedAuthorName :: T.Text   , embedAuthorUrl :: Maybe T.Text   , embedAuthorIconUrl :: Maybe T.Text   , embedAuthorProxyIconUrl :: Maybe T.Text@@ -223,7 +227,7 @@  instance FromJSON EmbedAuthor where   parseJSON = withObject "author" $ \o ->-    EmbedAuthor <$> o .:? "name"+    EmbedAuthor <$> o .:  "name"                 <*> o .:? "url"                 <*> o .:? "icon_url"                 <*> o .:? "proxy_icon_url"@@ -265,3 +269,14 @@     EmbedField <$> o .:  "name"                <*> o .:  "value"                <*> o .:? "inline"+++maybeEmbed :: Maybe CreateEmbed -> [PartM IO]+maybeEmbed =+      let mkPart (name,content) = partFileRequestBody name (T.unpack name) (RequestBodyBS content)+          uploads CreateEmbed{..} = [(T.filter (/=' ') $ createEmbedTitle<>n,c) | (n, Just (CreateEmbedImageUpload c)) <-+                                          [ ("author.png", createEmbedAuthorIcon)+                                          , ("thumbnail.png", createEmbedThumbnail)+                                          , ("image.png", createEmbedImage)+                                          , ("footer.png", createEmbedFooterIcon) ]]+      in maybe [] (map mkPart . uploads)

@@ -15,9 +15,9 @@  import Discord.Internal.Types.Prelude import Discord.Internal.Types.Channel-import Discord.Internal.Types.Guild     ( Role, GuildInfo, GuildUnavailable, Guild )+import Discord.Internal.Types.Guild (Role, GuildInfo, GuildUnavailable, Guild) import Discord.Internal.Types.User (User, GuildMember)-import Discord.Internal.Types.Interactions (InternalInteraction, Interaction)+import Discord.Internal.Types.Interactions (Interaction) import Discord.Internal.Types.Components (Emoji)  @@ -58,7 +58,7 @@   -- | VoiceStateUpdate   -- | VoiceServerUpdate   | UnknownEvent     T.Text Object-  deriving (Show, Read, Eq)+  deriving (Show, Eq)  data EventInternalParse =     InternalReady                   Int User [Channel] [GuildUnavailable] T.Text (Maybe Shard) PartialApplication@@ -92,11 +92,11 @@   | InternalPresenceUpdate          PresenceInfo   | InternalTypingStart             TypingInfo   | InternalUserUpdate              User-  | InternalInteractionCreate       InternalInteraction-  -- | InternalVoiceStateUpdate-  -- | InternalVoiceServerUpdate+  | InternalInteractionCreate       Interaction+  -- -- | InternalVoiceStateUpdate+  -- -- | InternalVoiceServerUpdate   | InternalUnknownEvent     T.Text Object-  deriving (Show, Read, Eq)+  deriving (Show, Eq, Read)  data PartialApplication = PartialApplication   { partialApplicationID :: ApplicationId

@@ -30,7 +30,7 @@   | Hello Integer   | HeartbeatAck   | ParseError T.Text-  deriving (Show, Read, Eq)+  deriving (Show, Eq, Read)  -- | Sent to gateway by our library data GatewaySendableInternal@@ -80,7 +80,7 @@ compileGatewayIntent :: GatewayIntent -> Int compileGatewayIntent GatewayIntent{..} =  sum $ [ if on then flag else 0-       | (flag, on) <- [ (2 ^  0, gatewayIntentGuilds)+       | (flag, on) <- [ (     1, gatewayIntentGuilds)                        , (2 ^  1, gatewayIntentMembers)                        , (2 ^  2, gatewayIntentBans)                        , (2 ^  3, gatewayIntentEmojis)@@ -169,7 +169,7 @@                ejson <- o .: "d"                case ejson of                  Object hm -> Dispatch <$> eventParse etype hm <*> o .: "s"-                 _other -> Dispatch (InternalUnknownEvent ("Dispatch payload wasn't an object") o)+                 _other -> Dispatch (InternalUnknownEvent "Dispatch payload wasn't an object" o)                                   <$> o .: "s"       1  -> HeartbeatRequest . fromMaybe 0 . readMaybe <$> o .: "d"       7  -> pure Reconnect

@@ -10,6 +10,7 @@ import qualified Data.Text as T  import Discord.Internal.Types.Prelude+import Discord.Internal.Types.Color (DiscordColor) import Discord.Internal.Types.Channel (Channel) import Discord.Internal.Types.User (User, GuildMember) import Discord.Internal.Types.Components (Emoji)@@ -116,10 +117,10 @@     Role {         roleId      :: RoleId -- ^ The role id       , roleName    :: T.Text                    -- ^ The role name-      , roleColor   :: ColorInteger              -- ^ Integer representation of color code+      , roleColor   :: DiscordColor              -- ^ Integer representation of color code       , roleHoist   :: Bool                      -- ^ If the role is pinned in the user listing       , rolePos     :: Integer                   -- ^ Position of this role-      , rolePerms   :: T.Text                   -- ^ Permission bit set+      , rolePerms   :: T.Text                    -- ^ Permission bit set       , roleManaged :: Bool                      -- ^ Whether this role is managed by an integration       , roleMention :: Bool                      -- ^ Whether this role is mentionable     } deriving (Show, Read, Eq, Ord)

@@ -1,9 +1,10 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}  module Discord.Internal.Types.Interactions@@ -14,22 +15,16 @@     InteractionDataApplicationCommandOptionSubcommandOrGroup (..),     InteractionDataApplicationCommandOptionSubcommand (..),     InteractionDataApplicationCommandOptionValue (..),-    ApplicationCommandInteractionDataValue (..),-    InternalInteraction (..),     InteractionToken,-    InteractionType,-    InternalInteractionData (..),     ResolvedData (..),-    InternalInteractionDataApplicationCommandOption (..),+    MemberOrUser (..),     InteractionResponse (..),     interactionResponseBasic,-    InteractionCallbackType (..),-    InteractionCallbackData (..),-    InteractionCallbackAutocomplete,-    InteractionCallbackMessages (..),-    interactionCallbackMessagesBasic,-    InteractionCallbackDataFlags (..),-    InteractionCallbackDataFlag (..),+    InteractionResponseAutocomplete (..),+    InteractionResponseMessage (..),+    interactionResponseMessageBasic,+    InteractionResponseMessageFlags (..),+    InteractionResponseMessageFlag (..),   ) where @@ -37,344 +32,393 @@ import Data.Aeson import Data.Aeson.Types (Parser) import Data.Bits (Bits (shift, (.|.)))-import Data.Data (Data)-import Data.Maybe (fromJust, fromMaybe)+import Data.Foldable (Foldable (toList)) import Data.Scientific (Scientific) import qualified Data.Text as T-import Discord.Internal.Types.ApplicationCommands-  (-    InternalApplicationCommandOptionChoice,-    ApplicationCommandOptionType (..),-    ApplicationCommandType (..),-  )+import Discord.Internal.Types.ApplicationCommands (Choice) import Discord.Internal.Types.Channel (AllowedMentions, Attachment, Message)-import Discord.Internal.Types.Components (Component, ComponentType (..))-import Discord.Internal.Types.Embed (Embed)-import Discord.Internal.Types.Prelude (ApplicationId, ApplicationCommandId, ChannelId, GuildId, InteractionId, InteractionToken, InteractionType (..), Internals (..), MessageId, Snowflake, UserId, makeTable, toMaybeJSON)+import Discord.Internal.Types.Components (ComponentActionRow)+import Discord.Internal.Types.Embed (CreateEmbed, createEmbed)+import Discord.Internal.Types.Prelude (ApplicationCommandId, ApplicationId, ChannelId, GuildId, InteractionId, InteractionToken, MessageId, RoleId, Snowflake, UserId) import Discord.Internal.Types.User (GuildMember, User) -import Debug.Trace-+-- | An interaction received from discord. data Interaction   = InteractionComponent-      { interactionId :: InteractionId,+      { -- | The id of this interaction.+        interactionId :: InteractionId,+        -- | The id of the application that this interaction belongs to.         interactionApplicationId :: ApplicationId,-        interactionDataComponent :: Maybe InteractionDataComponent, -- referenced as Data in API+        -- | The data for this interaction.+        interactionDataComponent :: InteractionDataComponent,+        -- | What guild this interaction comes from.         interactionGuildId :: Maybe GuildId,+        -- | What channel this interaction comes from.         interactionChannelId :: Maybe ChannelId,-        interactionMember :: Maybe GuildMember,-        interactionUser :: Maybe User,+        -- | What user/member this interaction comes from.+        interactionUser :: MemberOrUser,+        -- | The unique token that represents this interaction.         interactionToken :: InteractionToken,+        -- | What version of interaction is this (always 1).         interactionVersion :: Int,-        interactionMessage :: Message+        -- | What message is associated with this interaction.+        interactionMessage :: Message,+        -- | The invoking user's preferred locale.+        interactionLocale :: T.Text,+        -- | The invoking guild's preferred locale.+        interactionGuildLocale :: Maybe T.Text       }   | InteractionPing-      { interactionId :: InteractionId,+      { -- | The id of this interaction.+        interactionId :: InteractionId,+        -- | The id of the application that this interaction belongs to.         interactionApplicationId :: ApplicationId,+        -- | The unique token that represents this interaction.         interactionToken :: InteractionToken,+        -- | What version of interaction is this (always 1).         interactionVersion :: Int       }   | InteractionApplicationCommand-      { interactionId :: InteractionId,+      { -- | The id of this interaction.+        interactionId :: InteractionId,+        -- | The id of the application that this interaction belongs to.         interactionApplicationId :: ApplicationId,-        interactionDataApplicationCommand :: Maybe InteractionDataApplicationCommand, -- referenced as Data in API+        -- | The data for this interaction.+        interactionDataApplicationCommand :: InteractionDataApplicationCommand,+        -- | What guild this interaction comes from.         interactionGuildId :: Maybe GuildId,+        -- | What channel this interaction comes from.         interactionChannelId :: Maybe ChannelId,-        interactionMember :: Maybe GuildMember,-        interactionUser :: Maybe User,+        -- | What user/member this interaction comes from.+        interactionUser :: MemberOrUser,+        -- | The unique token that represents this interaction.         interactionToken :: InteractionToken,-        interactionVersion :: Int+        -- | What version of interaction is this (always 1).+        interactionVersion :: Int,+        -- | The invoking user's preferred locale.+        interactionLocale :: T.Text,+        -- | The invoking guild's preferred locale.+        interactionGuildLocale :: Maybe T.Text       }   | InteractionApplicationCommandAutocomplete-      { interactionId :: InteractionId,+      { -- | The id of this interaction.+        interactionId :: InteractionId,+        -- | The id of the application that this interaction belongs to.         interactionApplicationId :: ApplicationId,-        interactionDataApplicationCommand :: Maybe InteractionDataApplicationCommand, -- referenced as Data in API+        -- | The data for this interaction.+        interactionDataApplicationCommand :: InteractionDataApplicationCommand,+        -- | What guild this interaction comes from.         interactionGuildId :: Maybe GuildId,+        -- | What channel this interaction comes from.         interactionChannelId :: Maybe ChannelId,-        interactionMember :: Maybe GuildMember,-        interactionUser :: Maybe User,+        -- | What user/member this interaction comes from.+        interactionUser :: MemberOrUser,+        -- | The unique token that represents this interaction.         interactionToken :: InteractionToken,-        interactionVersion :: Int+        -- | What version of interaction is this (always 1).+        interactionVersion :: Int,+        -- | The invoking user's preferred locale.+        interactionLocale :: T.Text,+        -- | The invoking guild's preferred locale.+        interactionGuildLocale :: Maybe T.Text       }-  | InteractionUnknown InternalInteraction-  deriving (Show, Read, Eq)+  deriving (Show, Eq, Read) +instance FromJSON Interaction where+  parseJSON =+    withObject+      "Interaction"+      ( \v -> do+          iid <- v .: "id"+          aid <- v .: "application_id"+          gid <- v .:? "guild_id"+          cid <- v .:? "channel_id"+          tok <- v .: "token"+          version <- v .: "version"+          glocale <- v .:? "guild_locale"+          t <- v .: "type" :: Parser Int+          case t of+            1 -> return $ InteractionPing iid aid tok version+            2 ->+              InteractionApplicationCommand iid aid+                <$> v .: "data"+                <*> return gid+                <*> return cid+                <*> parseJSON (Object v)+                <*> return tok+                <*> return version+                <*> v .: "locale"+                <*> return glocale+            3 ->+              InteractionComponent iid aid+                <$> v .: "data"+                <*> return gid+                <*> return cid+                <*> parseJSON (Object v)+                <*> return tok+                <*> return version+                <*> v .: "message"+                <*> v .: "locale"+                <*> return glocale+            4 ->+              InteractionApplicationCommandAutocomplete iid aid+                <$> v .: "data"+                <*> return gid+                <*> return cid+                <*> parseJSON (Object v)+                <*> return tok+                <*> return version+                <*> v .: "locale"+                <*> return glocale+            _ -> fail "unknown interaction type"+      )++newtype MemberOrUser = MemberOrUser (Either GuildMember User) deriving (Show, Eq, Read)++instance {-# OVERLAPPING #-} FromJSON MemberOrUser where+  parseJSON =+    withObject+      "MemberOrUser"+      ( \v -> MemberOrUser <$> ((Left <$> v .: "member") <|> (Right <$> v .: "user"))+      )+ data InteractionDataComponent   = InteractionDataComponentButton-      { -- | Component only, the unique id+      { -- | The unique id of the component (up to 100 characters).         interactionDataComponentCustomId :: T.Text       }   | InteractionDataComponentSelectMenu-      { interactionDataComponentCustomId :: T.Text,+      { -- | The unique id of the component (up to 100 characters).+        interactionDataComponentCustomId :: T.Text,+        -- | Values for the select menu.         interactionDataComponentValues :: [T.Text]       }   deriving (Show, Read, Eq) +instance FromJSON InteractionDataComponent where+  parseJSON =+    withObject+      "InteractionDataComponent"+      ( \v -> do+          cid <- v .: "custom_id"+          t <- v .: "component_type" :: Parser Int+          case t of+            2 -> return $ InteractionDataComponentButton cid+            3 ->+              InteractionDataComponentSelectMenu cid+                <$> v .: "values"+            _ -> fail "unknown interaction data component type"+      )+ data InteractionDataApplicationCommand   = InteractionDataApplicationCommandUser-      { -- | id of the invoked command+      { -- | Id of the invoked command.         interactionDataApplicationCommandId :: ApplicationCommandId,-        -- | name of the invoked command+        -- | Name of the invoked command.         interactionDataApplicationCommandName :: T.Text,-        -- | the resolved data in the command+        -- | The resolved data in the command.         interactionDataApplicationCommandResolvedData :: Maybe ResolvedData,-        -- | the target of the command+        -- | The id of the user that is the target.         interactionDataApplicationCommandTargetId :: UserId       }   | InteractionDataApplicationCommandMessage-      { -- | Application command only, id of the invoked command+      { -- | Id of the invoked command.         interactionDataApplicationCommandId :: ApplicationCommandId,-        -- | Application command only, name of the invoked command+        -- | Name of the invoked command.         interactionDataApplicationCommandName :: T.Text,+        -- | The resolved data in the command.         interactionDataApplicationCommandResolvedData :: Maybe ResolvedData,+        -- | The id of the message that is the target.         interactionDataApplicationCommandTargetId :: MessageId       }   | InteractionDataApplicationCommandChatInput-      { -- | Application command only, id of the invoked command+      { -- | Id of the invoked command.         interactionDataApplicationCommandId :: ApplicationCommandId,-        -- | Application command only, name of the invoked command+        -- | Name of the invoked command.         interactionDataApplicationCommandName :: T.Text,+        -- | The resolved data in the command.         interactionDataApplicationCommandResolvedData :: Maybe ResolvedData,+        -- | The options of the application command.         interactionDataApplicationCommandOptions :: Maybe InteractionDataApplicationCommandOptions       }   deriving (Show, Read, Eq) +instance FromJSON InteractionDataApplicationCommand where+  parseJSON =+    withObject+      "InteractionDataApplicationCommand"+      ( \v -> do+          aci <- v .: "id"+          name <- v .: "name"+          rd <- v .:? "resolved_data"+          t <- v .: "type" :: Parser Int+          case t of+            1 ->+              InteractionDataApplicationCommandChatInput aci name rd+                <$> v .:? "options"+            2 ->+              InteractionDataApplicationCommandUser aci name rd+                <$> v .: "target_id"+            3 ->+              InteractionDataApplicationCommandMessage aci name rd+                <$> v .: "target_id"+            _ -> fail "unknown interaction data component type"+      )++-- | Either subcommands and groups, or values. data InteractionDataApplicationCommandOptions   = InteractionDataApplicationCommandOptionsSubcommands [InteractionDataApplicationCommandOptionSubcommandOrGroup]   | InteractionDataApplicationCommandOptionsValues [InteractionDataApplicationCommandOptionValue]   deriving (Show, Read, Eq) +instance FromJSON InteractionDataApplicationCommandOptions where+  parseJSON =+    withArray+      "InteractionDataApplicationCommandOptions"+      ( \a -> do+          let a' = toList a+          case a' of+            [] -> return $ InteractionDataApplicationCommandOptionsValues []+            (v' : _) ->+              withObject+                "InteractionDataApplicationCommandOptions item"+                ( \v -> do+                    t <- v .: "type" :: Parser Int+                    if t == 1 || t == 2+                      then InteractionDataApplicationCommandOptionsSubcommands <$> mapM parseJSON a'+                      else InteractionDataApplicationCommandOptionsValues <$> mapM parseJSON a'+                )+                v'+      )++-- | Either a subcommand group or a subcommand. data InteractionDataApplicationCommandOptionSubcommandOrGroup   = InteractionDataApplicationCommandOptionSubcommandGroup       { interactionDataApplicationCommandOptionSubcommandGroupName :: T.Text,         interactionDataApplicationCommandOptionSubcommandGroupOptions :: [InteractionDataApplicationCommandOptionSubcommand],-        interactionDataApplicationCommandOptionSubcommandGroupFocused :: Maybe Bool+        interactionDataApplicationCommandOptionSubcommandGroupFocused :: Bool       }   | InteractionDataApplicationCommandOptionSubcommandOrGroupSubcommand InteractionDataApplicationCommandOptionSubcommand   deriving (Show, Read, Eq) +instance FromJSON InteractionDataApplicationCommandOptionSubcommandOrGroup where+  parseJSON =+    withObject+      "InteractionDataApplicationCommandOptionSubcommandOrGroup"+      ( \v -> do+          t <- v .: "type" :: Parser Int+          case t of+            2 ->+              InteractionDataApplicationCommandOptionSubcommandGroup+                <$> v .: "name"+                <*> v .: "options"+                <*> v .:? "focused" .!= False+            1 -> InteractionDataApplicationCommandOptionSubcommandOrGroupSubcommand <$> parseJSON (Object v)+            _ -> fail "unexpected subcommand group type"+      )++-- | Data for a single subcommand. data InteractionDataApplicationCommandOptionSubcommand = InteractionDataApplicationCommandOptionSubcommand   { interactionDataApplicationCommandOptionSubcommandName :: T.Text,     interactionDataApplicationCommandOptionSubcommandOptions :: [InteractionDataApplicationCommandOptionValue],-    interactionDataApplicationCommandOptionSubcommandFocused :: Maybe Bool-  }-  deriving (Show, Read, Eq)--data InteractionDataApplicationCommandOptionValue = InteractionDataApplicationCommandOptionValue-  { interactionDataApplicationCommandOptionValueName :: T.Text,-    interactionDataApplicationCommandOptionValueValue :: ApplicationCommandInteractionDataValue,-    interactionDataApplicationCommandOptionValueFocused :: Maybe Bool-  }-  deriving (Show, Read, Eq)--instance Internals InteractionDataApplicationCommandOptionValue InternalInteractionDataApplicationCommandOption where-  toInternal InteractionDataApplicationCommandOptionValue {..} = InternalInteractionDataApplicationCommandOption interactionDataApplicationCommandOptionValueName (getTypeFromACIDV interactionDataApplicationCommandOptionValueValue) (Just interactionDataApplicationCommandOptionValueValue) Nothing interactionDataApplicationCommandOptionValueFocused--  fromInternal InternalInteractionDataApplicationCommandOption {..}-    | internalInteractionDataApplicationCommandOptionType `elem` [ApplicationCommandOptionTypeSubcommand, ApplicationCommandOptionTypeSubcommandGroup] = Nothing-    | otherwise = do-      v <- trace ("this" ++ show internalInteractionDataApplicationCommandOptionValue) internalInteractionDataApplicationCommandOptionValue-      return $ InteractionDataApplicationCommandOptionValue internalInteractionDataApplicationCommandOptionName v internalInteractionDataApplicationCommandOptionFocused--instance Internals InteractionDataApplicationCommandOptionSubcommand InternalInteractionDataApplicationCommandOption where-  toInternal InteractionDataApplicationCommandOptionSubcommand {..} =-    InternalInteractionDataApplicationCommandOption interactionDataApplicationCommandOptionSubcommandName ApplicationCommandOptionTypeSubcommand Nothing (Just $ toInternal <$> interactionDataApplicationCommandOptionSubcommandOptions) interactionDataApplicationCommandOptionSubcommandFocused--  fromInternal InternalInteractionDataApplicationCommandOption {internalInteractionDataApplicationCommandOptionType = ApplicationCommandOptionTypeSubcommand, ..} = do-    o <- internalInteractionDataApplicationCommandOptionOptions-    o' <- mapM fromInternal o-    return $ InteractionDataApplicationCommandOptionSubcommand internalInteractionDataApplicationCommandOptionName o' internalInteractionDataApplicationCommandOptionFocused-  fromInternal _ = Nothing--instance Internals InteractionDataApplicationCommandOptionSubcommandOrGroup InternalInteractionDataApplicationCommandOption where-  toInternal InteractionDataApplicationCommandOptionSubcommandGroup {..} =-    InternalInteractionDataApplicationCommandOption interactionDataApplicationCommandOptionSubcommandGroupName ApplicationCommandOptionTypeSubcommand Nothing (Just $ toInternal <$> interactionDataApplicationCommandOptionSubcommandGroupOptions) interactionDataApplicationCommandOptionSubcommandGroupFocused-  toInternal (InteractionDataApplicationCommandOptionSubcommandOrGroupSubcommand s) = toInternal s--  fromInternal InternalInteractionDataApplicationCommandOption {internalInteractionDataApplicationCommandOptionType = ApplicationCommandOptionTypeSubcommandGroup, ..} = do-    o <- internalInteractionDataApplicationCommandOptionOptions-    o' <- mapM fromInternal o-    return $ InteractionDataApplicationCommandOptionSubcommandGroup internalInteractionDataApplicationCommandOptionName o' internalInteractionDataApplicationCommandOptionFocused-  fromInternal i@InternalInteractionDataApplicationCommandOption {internalInteractionDataApplicationCommandOptionType = ApplicationCommandOptionTypeSubcommand, ..} = InteractionDataApplicationCommandOptionSubcommandOrGroupSubcommand <$> fromInternal i-  fromInternal _ = Nothing--instance Internals InteractionDataApplicationCommandOptions [InternalInteractionDataApplicationCommandOption] where-  toInternal (InteractionDataApplicationCommandOptionsSubcommands lst) = toInternal <$> lst-  toInternal (InteractionDataApplicationCommandOptionsValues lst) = toInternal <$> lst--  fromInternal is = (InteractionDataApplicationCommandOptionsSubcommands <$> mapM fromInternal is) <|> (InteractionDataApplicationCommandOptionsValues <$> mapM fromInternal is)--instance Internals InteractionDataApplicationCommand InternalInteractionData where-  toInternal InteractionDataApplicationCommandUser {..} = InternalInteractionData (Just interactionDataApplicationCommandId) (Just interactionDataApplicationCommandName) (Just ApplicationCommandTypeUser) interactionDataApplicationCommandResolvedData Nothing Nothing Nothing Nothing Nothing-  toInternal InteractionDataApplicationCommandMessage {..} = InternalInteractionData (Just interactionDataApplicationCommandId) (Just interactionDataApplicationCommandName) (Just ApplicationCommandTypeMessage) interactionDataApplicationCommandResolvedData Nothing Nothing Nothing Nothing Nothing-  toInternal InteractionDataApplicationCommandChatInput {..} = InternalInteractionData (Just interactionDataApplicationCommandId) (Just interactionDataApplicationCommandName) (Just ApplicationCommandTypeMessage) interactionDataApplicationCommandResolvedData (toInternal <$> interactionDataApplicationCommandOptions) Nothing Nothing Nothing Nothing--  fromInternal InternalInteractionData {internalInteractionDataApplicationCommandType = Just ApplicationCommandTypeUser, ..} = do-    aid <- internalInteractionDataApplicationCommandId-    name <- internalInteractionDataApplicationCommandName-    tid <- internalInteractionDataTargetId-    return $ InteractionDataApplicationCommandUser aid name internalInteractionDataResolved tid-  fromInternal InternalInteractionData {internalInteractionDataApplicationCommandType = Just ApplicationCommandTypeMessage, ..} = do-    aid <- internalInteractionDataApplicationCommandId-    name <- internalInteractionDataApplicationCommandName-    tid <- internalInteractionDataTargetId-    return $ InteractionDataApplicationCommandMessage aid name internalInteractionDataResolved tid-  fromInternal InternalInteractionData {internalInteractionDataApplicationCommandType = Just ApplicationCommandTypeChatInput, ..} = do-    aid <- internalInteractionDataApplicationCommandId-    name <- internalInteractionDataApplicationCommandName-    return $ InteractionDataApplicationCommandChatInput aid name internalInteractionDataResolved (internalInteractionDataOptions >>= fromInternal)-  fromInternal _ = Nothing--instance Internals InteractionDataComponent InternalInteractionData where-  toInternal InteractionDataComponentButton {..} = InternalInteractionData Nothing Nothing Nothing Nothing Nothing (Just interactionDataComponentCustomId) (Just ComponentTypeButton) Nothing Nothing-  toInternal InteractionDataComponentSelectMenu {..} = InternalInteractionData Nothing Nothing Nothing Nothing Nothing (Just interactionDataComponentCustomId) (Just ComponentTypeSelectMenu) (Just interactionDataComponentValues) Nothing--  fromInternal InternalInteractionData {internalInteractionDataComponentType = Just ComponentTypeButton, ..} = InteractionDataComponentButton <$> internalInteractionDataCustomId-  fromInternal InternalInteractionData {internalInteractionDataComponentType = Just ComponentTypeSelectMenu, ..} = InteractionDataComponentSelectMenu <$> internalInteractionDataCustomId <*> internalInteractionDataValues-  fromInternal _ = Nothing--instance Internals Interaction InternalInteraction where-  toInternal InteractionPing {..} = InternalInteraction interactionId interactionApplicationId InteractionTypePing Nothing Nothing Nothing Nothing Nothing interactionToken interactionVersion Nothing-  toInternal InteractionComponent {..} = InternalInteraction interactionId interactionApplicationId InteractionTypeMessageComponent (toInternal <$> interactionDataComponent) interactionGuildId interactionChannelId interactionMember interactionUser interactionToken interactionVersion (Just interactionMessage)-  toInternal InteractionApplicationCommand {..} = InternalInteraction interactionId interactionApplicationId InteractionTypeApplicationCommand (toInternal <$> interactionDataApplicationCommand) interactionGuildId interactionChannelId interactionMember interactionUser interactionToken interactionVersion Nothing-  toInternal InteractionApplicationCommandAutocomplete {..} = InternalInteraction interactionId interactionApplicationId InteractionTypeApplicationCommandAutocomplete (toInternal <$> interactionDataApplicationCommand) interactionGuildId interactionChannelId interactionMember interactionUser interactionToken interactionVersion Nothing-  toInternal (InteractionUnknown i) = i--  fromInternal InternalInteraction {internalInteractionType = InteractionTypePing, ..} = Just $ InteractionPing internalInteractionId internalInteractionApplicationId internalInteractionToken internalInteractionVersion-  fromInternal i@InternalInteraction {internalInteractionType = InteractionTypeMessageComponent, ..} = Just $ fromMaybe (InteractionUnknown i) $ internalInteractionMessage >>= Just . InteractionComponent internalInteractionId internalInteractionApplicationId (internalInteractionData >>= fromInternal) internalInteractionGuildId internalInteractionChannelId internalInteractionMember internalInteractionUser internalInteractionToken internalInteractionVersion-  fromInternal i@InternalInteraction {internalInteractionType=InteractionTypeApplicationCommandAutocomplete,..} = Just $ fromMaybe (InteractionUnknown i) $ process internalInteractionData-    where process Nothing = Just $ InteractionApplicationCommandAutocomplete internalInteractionId internalInteractionApplicationId Nothing internalInteractionGuildId internalInteractionChannelId internalInteractionMember internalInteractionUser internalInteractionToken internalInteractionVersion-          process (Just d) = fromInternal d >>= \d' -> Just $ InteractionApplicationCommandAutocomplete internalInteractionId internalInteractionApplicationId (Just d') internalInteractionGuildId internalInteractionChannelId internalInteractionMember internalInteractionUser internalInteractionToken internalInteractionVersion-  fromInternal i@InternalInteraction {internalInteractionType=InteractionTypeApplicationCommand,..} = Just $ fromMaybe (InteractionUnknown i) $ process internalInteractionData-    where process Nothing = Just $ InteractionApplicationCommand internalInteractionId internalInteractionApplicationId Nothing internalInteractionGuildId internalInteractionChannelId internalInteractionMember internalInteractionUser internalInteractionToken internalInteractionVersion-          process (Just d) = fromInternal d >>= \d' -> Just $ InteractionApplicationCommand internalInteractionId internalInteractionApplicationId (Just d') internalInteractionGuildId internalInteractionChannelId internalInteractionMember internalInteractionUser internalInteractionToken internalInteractionVersion-    -- Just $ InteractionApplicationCommand internalInteractionId internalInteractionApplicationId (internalInteractionType == InteractionTypeApplicationCommandAutocomplete) (internalInteractionData >>= fromInternal) internalInteractionGuildId internalInteractionChannelId internalInteractionMember internalInteractionUser internalInteractionToken internalInteractionVersion---- instance Internals Interaction InternalInteraction where---- application command id--- application command name--- application command type -- this should be defined in the constructor!--- resolved data -- this should be formalised and integrated, instead of being---  left as values--- options -- only present if type is subcommand or subcommand group---- | This is the data that is recieved when an interaction occurs.------ https://discord.com/developers/docs/interactions/receiving-and-responding#interaction-object-interaction-structure-data InternalInteraction = InternalInteraction-  { internalInteractionId :: InteractionId,-    internalInteractionApplicationId :: ApplicationId,-    internalInteractionType :: InteractionType, -- referenced as Type in API-    internalInteractionData :: Maybe InternalInteractionData, -- referenced as Data in API-    internalInteractionGuildId :: Maybe GuildId,-    internalInteractionChannelId :: Maybe ChannelId,-    internalInteractionMember :: Maybe GuildMember,-    internalInteractionUser :: Maybe User,-    internalInteractionToken :: InteractionToken,-    internalInteractionVersion :: Int,-    internalInteractionMessage :: Maybe Message+    interactionDataApplicationCommandOptionSubcommandFocused :: Bool   }   deriving (Show, Read, Eq) -instance ToJSON InternalInteraction where-  toJSON InternalInteraction {..} =-    object-      [ (name, value)-        | (name, Just value) <--            [ ("id", toMaybeJSON internalInteractionId),-              ("application_id", toMaybeJSON internalInteractionApplicationId),-              ("type", toMaybeJSON internalInteractionType),-              ("data", toJSON <$> internalInteractionData),-              ("guild_id", toJSON <$> internalInteractionGuildId),-              ("channel_id", toJSON <$> internalInteractionChannelId),-              ("member", toJSON <$> internalInteractionMember),-              ("user", toJSON <$> internalInteractionUser),-              ("token", toMaybeJSON internalInteractionToken),-              ("version", toMaybeJSON internalInteractionVersion),-              ("message", toJSON <$> internalInteractionMessage)-            ]-      ]--instance FromJSON InternalInteraction where+instance FromJSON InteractionDataApplicationCommandOptionSubcommand where   parseJSON =     withObject-      "InternalInteraction"-      ( \v ->-          InternalInteraction-            <$> v .: "id"-            <*> v .: "application_id"-            <*> v .: "type"-            <*> v .:? "data"-            <*> v .:? "guild_id"-            <*> v .:? "channel_id"-            <*> v .:? "member"-            <*> v .:? "user"-            <*> v .: "token"-            <*> v .: "version"-            <*> v .:? "message"+      "InteractionDataApplicationCommandOptionSubcommand"+      ( \v -> do+          t <- v .: "type" :: Parser Int+          case t of+            1 ->+              InteractionDataApplicationCommandOptionSubcommand+                <$> v .: "name"+                <*> v .:? "options" .!= []+                <*> v .:? "focused" .!= False+            _ -> fail "unexpected subcommand type"       ) --- | This is received if the interaction was a component or application command.------ https://discord.com/developers/docs/interactions/receiving-and-responding#interaction-object-interaction-data-structure-data InternalInteractionData = InternalInteractionData-  { -- | Application command only, id of the invoked command-    internalInteractionDataApplicationCommandId :: Maybe ApplicationCommandId,-    -- | Application command only, name of the invoked command-    internalInteractionDataApplicationCommandName :: Maybe T.Text,-    -- | Application command only, the type of the invoked command-    internalInteractionDataApplicationCommandType :: Maybe ApplicationCommandType,-    -- | Application command only, converted users, roles, channels-    internalInteractionDataResolved :: Maybe ResolvedData,-    -- | Application command only, params and values-    internalInteractionDataOptions :: Maybe [InternalInteractionDataApplicationCommandOption],-    -- | Component only, the unique id-    internalInteractionDataCustomId :: Maybe T.Text,-    -- | Component only, the type of the component-    internalInteractionDataComponentType :: Maybe ComponentType,-    -- | Component only, the selected options if component is the select type-    internalInteractionDataValues :: Maybe [T.Text],-    -- | This is the id of the user or message being targetted by a user command-    -- or a message command-    internalInteractionDataTargetId :: Maybe Snowflake-  }+-- | Data for a single value.+data InteractionDataApplicationCommandOptionValue+  = InteractionDataApplicationCommandOptionValueString+      { interactionDataApplicationCommandOptionValueName :: T.Text,+        interactionDataApplicationCommandOptionValueStringValue :: Either T.Text T.Text+      }+  | InteractionDataApplicationCommandOptionValueInteger+      { interactionDataApplicationCommandOptionValueName :: T.Text,+        interactionDataApplicationCommandOptionValueIntegerValue :: Either T.Text Integer+      }+  | InteractionDataApplicationCommandOptionValueBoolean+      { interactionDataApplicationCommandOptionValueName :: T.Text,+        interactionDataApplicationCommandOptionValueBooleanValue :: Bool+      }+  | InteractionDataApplicationCommandOptionValueUser+      { interactionDataApplicationCommandOptionValueName :: T.Text,+        interactionDataApplicationCommandOptionValueUserValue :: UserId+      }+  | InteractionDataApplicationCommandOptionValueChannel+      { interactionDataApplicationCommandOptionValueName :: T.Text,+        interactionDataApplicationCommandOptionValueChannelValue :: ChannelId+      }+  | InteractionDataApplicationCommandOptionValueRole+      { interactionDataApplicationCommandOptionValueName :: T.Text,+        interactionDataApplicationCommandOptionValueRoleValue :: RoleId+      }+  | InteractionDataApplicationCommandOptionValueMentionable+      { interactionDataApplicationCommandOptionValueName :: T.Text,+        interactionDataApplicationCommandOptionValueMentionableValue :: Snowflake+      }+  | InteractionDataApplicationCommandOptionValueNumber+      { interactionDataApplicationCommandOptionValueName :: T.Text,+        interactionDataApplicationCommandOptionValueNumberValue :: Either T.Text Scientific+      }   deriving (Show, Read, Eq) -instance ToJSON InternalInteractionData where-  toJSON InternalInteractionData {..} =-    object-      [ (name, value)-        | (name, Just value) <--            [ ("id", toJSON <$> internalInteractionDataApplicationCommandId),-              ("name", toJSON <$> internalInteractionDataApplicationCommandName),-              ("type", toJSON <$> internalInteractionDataApplicationCommandType),-              ("resolved", toJSON <$> internalInteractionDataResolved),-              ("options", toJSON <$> internalInteractionDataOptions),-              ("custom_id", toJSON <$> internalInteractionDataCustomId),-              ("component_type", toJSON <$> internalInteractionDataComponentType),-              ("values", toJSON <$> internalInteractionDataValues),-              ("target_id", toJSON <$> internalInteractionDataTargetId)-            ]-      ]--instance FromJSON InternalInteractionData where+instance FromJSON InteractionDataApplicationCommandOptionValue where   parseJSON =     withObject-      "InternalInteractionData"-      ( \v ->-          InternalInteractionData-            <$> v .:? "id"-            <*> v .:? "name"-            <*> v .:? "type"-            <*> v .:? "resolved"-            <*> v .:? "options"-            <*> v .:? "custom_id"-            <*> v .:? "component_type"-            <*> v .:? "values"-            <*> v .:? "target_id"+      "InteractionDataApplicationCommandOptionValue"+      ( \v -> do+          name <- v .: "name"+          focused <- v .:? "focused" .!= False+          t <- v .: "type" :: Parser Int+          case t of+            3 ->+              InteractionDataApplicationCommandOptionValueString name+                <$> parseValue v focused+            4 ->+              InteractionDataApplicationCommandOptionValueInteger name+                <$> parseValue v focused+            10 ->+              InteractionDataApplicationCommandOptionValueNumber name+                <$> parseValue v focused+            5 ->+              InteractionDataApplicationCommandOptionValueBoolean name+                <$> v .: "value"+            6 ->+              InteractionDataApplicationCommandOptionValueUser name+                <$> v .: "value"+            7 ->+              InteractionDataApplicationCommandOptionValueChannel name+                <$> v .: "value"+            8 ->+              InteractionDataApplicationCommandOptionValueRole name+                <$> v .: "value"+            9 ->+              InteractionDataApplicationCommandOptionValueMentionable name+                <$> v .: "value"+            _ -> fail $ "unexpected interaction data application command option value type: " ++ show t       ) +parseValue :: (FromJSON a) => Object -> Bool -> Parser (Either T.Text a)+parseValue o True = Left <$> o .: "value"+parseValue o False = Right <$> o .: "value"++-- resolved data -- this should be formalised and integrated, instead of being+--  left as values+ -- | I'm not sure what this stuff is, so you're on your own. -- -- It's not worth the time working out how to create this stuff.@@ -413,141 +457,72 @@             <*> v .:? "channels"       ) --- | The application command payload for an interaction.-data InternalInteractionDataApplicationCommandOption = InternalInteractionDataApplicationCommandOption-  { internalInteractionDataApplicationCommandOptionName :: T.Text,-    internalInteractionDataApplicationCommandOptionType :: ApplicationCommandOptionType,-    -- | The value itself. Mutually exclusive with options. Docs are wrong that it's only numbers and strings.-    internalInteractionDataApplicationCommandOptionValue :: Maybe ApplicationCommandInteractionDataValue,-    -- | Only present in group subcommands and subcommands. Mutually exclusive with value.-    internalInteractionDataApplicationCommandOptionOptions :: Maybe [InternalInteractionDataApplicationCommandOption],-    -- | Whether this is the field that the user is currently typing in.-    internalInteractionDataApplicationCommandOptionFocused :: Maybe Bool-  }-  deriving (Show, Read, Eq)--instance ToJSON InternalInteractionDataApplicationCommandOption where-  toJSON InternalInteractionDataApplicationCommandOption {..} =-    object-      [ (name, value)-        | (name, Just value) <--            [ ("name", toMaybeJSON internalInteractionDataApplicationCommandOptionName),-              ("type", toMaybeJSON internalInteractionDataApplicationCommandOptionType),-              ("value", toJSON <$> internalInteractionDataApplicationCommandOptionValue),-              ("options", toJSON <$> internalInteractionDataApplicationCommandOptionOptions),-              ("focused", toJSON <$> internalInteractionDataApplicationCommandOptionFocused)-            ]-      ]--instance FromJSON InternalInteractionDataApplicationCommandOption where-  parseJSON =-    withObject-      "InternalInteractionDataApplicationCommandOption"-      ( \v ->-          InternalInteractionDataApplicationCommandOption-            <$> v .: "name"-            <*> typeParser v-            <*> (typeParser v >>= \t -> v .:? "value" >>= valueParser t)-            <*> v .:? "options"-            <*> v .:? "focused"-      )-    where-      typeParser v = v .: "type"-      valueParser t (Just v) = parseJSONACIDV t v-      valueParser _ Nothing = return Nothing- -- | The data to respond to an interaction with. Unless specified otherwise, you -- only have three seconds to reply to an interaction before a failure state is -- given.-data InteractionResponse = InteractionResponse-  { interactionResponseType :: InteractionCallbackType,-    interactionResponseData :: Maybe InteractionCallbackData-  }-  deriving (Show, Read, Eq)+data InteractionResponse+  = -- | ACK a Ping+    InteractionResponsePong+  | -- | Respond to an interaction with a message+    InteractionResponseChannelMessage InteractionResponseMessage+  | -- | ACK an interaction and edit a response later (use `CreateFollowupInteractionMessage` and `InteractionResponseMessage` to do so). User sees loading state.+    InteractionResponseDeferChannelMessage+  | -- | for components, ACK an interaction and edit the original message later; the user does not see a loading state.+    InteractionResponseDeferUpdateMessage+  | -- | for components, edit the message the component was attached to+    InteractionResponseUpdateMessage InteractionResponseMessage+  | -- | respond to an autocomplete interaction with suggested choices+    InteractionResponseAutocompleteResult InteractionResponseAutocomplete +-- | A basic interaction response, sending back the given text. interactionResponseBasic :: T.Text -> InteractionResponse-interactionResponseBasic t = InteractionResponse InteractionCallbackTypeChannelMessageWithSource (Just . InteractionCallbackDataMessages $ interactionCallbackMessagesBasic t)+interactionResponseBasic t = InteractionResponseChannelMessage (interactionResponseMessageBasic t)  instance ToJSON InteractionResponse where-  toJSON InteractionResponse {..} =-    object-      [ (name, value)-        | (name, Just value) <--            [ ("type", toMaybeJSON interactionResponseType),-              ("data", toJSON <$> interactionResponseData)-            ]-      ]---- | What's the type of the response?-data InteractionCallbackType-  = -- | Responds to a PING.-    InteractionCallbackTypePong-  | -- | Respond with a message to the interaction-    InteractionCallbackTypeChannelMessageWithSource-  | -- | Respond with a message to the interaction, after a delay. Sending this-    -- back means the interaction token lasts for 15 minutes.-    InteractionCallbackTypeDeferredChannelMessageWithSource-  | -- | For components, edit the original message later.-    InteractionCallbackTypeDeferredUpdateMessage-  | -- | For components, edit the original message.-    InteractionCallbackTypeUpdateMessage-  | -- | Respond to an autocomplete interaction with suggested choices.-    InteractionCallbackTypeApplicationCommandAutocompleteResult-  deriving (Show, Read, Eq, Data)--instance Enum InteractionCallbackType where-  fromEnum InteractionCallbackTypePong = 1-  fromEnum InteractionCallbackTypeChannelMessageWithSource = 4-  fromEnum InteractionCallbackTypeDeferredChannelMessageWithSource = 5-  fromEnum InteractionCallbackTypeDeferredUpdateMessage = 6-  fromEnum InteractionCallbackTypeUpdateMessage = 7-  fromEnum InteractionCallbackTypeApplicationCommandAutocompleteResult = 8-  toEnum a = fromJust $ lookup a table-    where-      table = makeTable InteractionCallbackTypePong--instance ToJSON InteractionCallbackType where-  toJSON = toJSON . fromEnum---- | Convenience wrapper for two separate types of callback.-data InteractionCallbackData-  = InteractionCallbackDataMessages InteractionCallbackMessages-  | InteractionCallbackDataAutocomplete InteractionCallbackAutocomplete-  deriving (Show, Read, Eq)+  toJSON InteractionResponsePong = object [("type", Number 1)]+  toJSON InteractionResponseDeferChannelMessage = object [("type", Number 5)]+  toJSON InteractionResponseDeferUpdateMessage = object [("type", Number 6)]+  toJSON (InteractionResponseChannelMessage ms) = object [("type", Number 4), ("data", toJSON ms)]+  toJSON (InteractionResponseUpdateMessage ms) = object [("type", Number 7), ("data", toJSON ms)]+  toJSON (InteractionResponseAutocompleteResult ms) = object [("type", Number 8), ("data", toJSON ms)] -instance ToJSON InteractionCallbackData where-  toJSON (InteractionCallbackDataMessages icdm) = toJSON icdm-  toJSON (InteractionCallbackDataAutocomplete icda) = toJSON icda+data InteractionResponseAutocomplete = InteractionResponseAutocompleteString [Choice T.Text] | InteractionResponseAutocompleteInteger [Choice Integer] | InteractionResponseAutocompleteNumber [Choice Scientific]+  deriving (Show, Eq) -type InteractionCallbackAutocomplete = [InternalApplicationCommandOptionChoice]+instance ToJSON InteractionResponseAutocomplete where+  toJSON (InteractionResponseAutocompleteString cs) = object [("choices", toJSON cs)]+  toJSON (InteractionResponseAutocompleteInteger cs) = object [("choices", toJSON cs)]+  toJSON (InteractionResponseAutocompleteNumber cs) = object [("choices", toJSON cs)]  -- | A cut down message structure.-data InteractionCallbackMessages = InteractionCallbackMessages-  { interactionCallbackMessagesTTS :: Maybe Bool,-    interactionCallbackMessagesContent :: Maybe T.Text,-    interactionCallbackMessagesEmbeds :: Maybe [Embed],-    interactionCallbackMessagesAllowedMentions :: Maybe AllowedMentions,-    interactionCallbackMessagesFlags :: Maybe InteractionCallbackDataFlags,-    interactionCallbackMessagesComponents :: Maybe [Component],-    interactionCallbackMessagesAttachments :: Maybe [Attachment]+data InteractionResponseMessage = InteractionResponseMessage+  { interactionResponseMessageTTS :: Maybe Bool,+    interactionResponseMessageContent :: Maybe T.Text,+    interactionResponseMessageEmbeds :: Maybe [CreateEmbed],+    interactionResponseMessageAllowedMentions :: Maybe AllowedMentions,+    interactionResponseMessageFlags :: Maybe InteractionResponseMessageFlags,+    interactionResponseMessageComponents :: Maybe [ComponentActionRow],+    interactionResponseMessageAttachments :: Maybe [Attachment]   }-  deriving (Show, Read, Eq)+  deriving (Show, Eq) -interactionCallbackMessagesBasic :: T.Text -> InteractionCallbackMessages-interactionCallbackMessagesBasic t = InteractionCallbackMessages Nothing (Just t) Nothing Nothing Nothing Nothing Nothing+-- | A basic interaction response, sending back the given text. This is+-- effectively a helper function.+interactionResponseMessageBasic :: T.Text -> InteractionResponseMessage+interactionResponseMessageBasic t = InteractionResponseMessage Nothing (Just t) Nothing Nothing Nothing Nothing Nothing -instance ToJSON InteractionCallbackMessages where-  toJSON InteractionCallbackMessages {..} =+instance ToJSON InteractionResponseMessage where+  toJSON InteractionResponseMessage {..} =     object       [ (name, value)         | (name, Just value) <--            [ ("tts", toJSON <$> interactionCallbackMessagesTTS),-              ("content", toJSON <$> interactionCallbackMessagesContent),-              ("embeds", toJSON <$> interactionCallbackMessagesEmbeds),-              ("allowed_mentions", toJSON <$> interactionCallbackMessagesAllowedMentions),-              ("flags", toJSON <$> interactionCallbackMessagesFlags),-              ("components", toJSON <$> interactionCallbackMessagesComponents),-              ("attachments", toJSON <$> interactionCallbackMessagesAttachments)+            [ ("tts", toJSON <$> interactionResponseMessageTTS),+              ("content", toJSON <$> interactionResponseMessageContent),+              ("embeds", toJSON . (createEmbed <$>) <$> interactionResponseMessageEmbeds),+              ("allowed_mentions", toJSON <$> interactionResponseMessageAllowedMentions),+              ("flags", toJSON <$> interactionResponseMessageFlags),+              ("components", toJSON <$> interactionResponseMessageComponents),+              ("attachments", toJSON <$> interactionResponseMessageAttachments)             ]       ] @@ -555,60 +530,17 @@ -- -- Currently the only flag is EPHERMERAL, which means only the user can see the -- message.-data InteractionCallbackDataFlag = InteractionCallbackDataFlagEphermeral+data InteractionResponseMessageFlag = InteractionResponseMessageFlagEphermeral   deriving (Show, Read, Eq) -newtype InteractionCallbackDataFlags = InteractionCallbackDataFlags [InteractionCallbackDataFlag]+newtype InteractionResponseMessageFlags = InteractionResponseMessageFlags [InteractionResponseMessageFlag]   deriving (Show, Read, Eq) -instance Enum InteractionCallbackDataFlag where-  fromEnum InteractionCallbackDataFlagEphermeral = 1 `shift` 6+instance Enum InteractionResponseMessageFlag where+  fromEnum InteractionResponseMessageFlagEphermeral = 1 `shift` 6   toEnum i-    | i == 1 `shift` 6 = InteractionCallbackDataFlagEphermeral+    | i == 1 `shift` 6 = InteractionResponseMessageFlagEphermeral     | otherwise = error $ "could not find InteractionCallbackDataFlag `" ++ show i ++ "`" -instance ToJSON InteractionCallbackDataFlags where-  toJSON (InteractionCallbackDataFlags fs) = Number $ fromInteger $ fromIntegral $ foldr (.|.) 0 (fromEnum <$> fs)--data ApplicationCommandInteractionDataValue-  = ApplicationCommandInteractionDataValueString T.Text-  | ApplicationCommandInteractionDataValueInteger Integer-  | ApplicationCommandInteractionDataValueBoolean Bool-  | ApplicationCommandInteractionDataValueUser Snowflake-  | ApplicationCommandInteractionDataValueChannel Snowflake-  | ApplicationCommandInteractionDataValueRole Snowflake-  | ApplicationCommandInteractionDataValueMentionable Snowflake-  | ApplicationCommandInteractionDataValueNumber Scientific-  deriving (Show, Eq, Ord, Read)--getTypeFromACIDV :: ApplicationCommandInteractionDataValue -> ApplicationCommandOptionType-getTypeFromACIDV acidv = case acidv of-  ApplicationCommandInteractionDataValueString _ -> ApplicationCommandOptionTypeString-  ApplicationCommandInteractionDataValueInteger _ -> ApplicationCommandOptionTypeInteger-  ApplicationCommandInteractionDataValueBoolean _ -> ApplicationCommandOptionTypeBoolean-  ApplicationCommandInteractionDataValueUser _ -> ApplicationCommandOptionTypeUser-  ApplicationCommandInteractionDataValueChannel _ -> ApplicationCommandOptionTypeChannel-  ApplicationCommandInteractionDataValueRole _ -> ApplicationCommandOptionTypeRole-  ApplicationCommandInteractionDataValueMentionable _ -> ApplicationCommandOptionTypeMentionable-  ApplicationCommandInteractionDataValueNumber _ -> ApplicationCommandOptionTypeNumber--instance ToJSON ApplicationCommandInteractionDataValue where-  toJSON (ApplicationCommandInteractionDataValueString t) = String t-  toJSON (ApplicationCommandInteractionDataValueNumber t) = Number t-  toJSON (ApplicationCommandInteractionDataValueInteger t) = Number $ fromInteger t-  toJSON (ApplicationCommandInteractionDataValueBoolean t) = Bool t-  toJSON (ApplicationCommandInteractionDataValueUser t) = toJSON t-  toJSON (ApplicationCommandInteractionDataValueChannel t) = toJSON t-  toJSON (ApplicationCommandInteractionDataValueRole t) = toJSON t-  toJSON (ApplicationCommandInteractionDataValueMentionable t) = toJSON t--parseJSONACIDV :: ApplicationCommandOptionType -> Value -> Parser (Maybe ApplicationCommandInteractionDataValue)-parseJSONACIDV ApplicationCommandOptionTypeString (String t) = return $ return (ApplicationCommandInteractionDataValueString t)-parseJSONACIDV ApplicationCommandOptionTypeInteger n = Just . ApplicationCommandInteractionDataValueInteger <$> parseJSON n-parseJSONACIDV ApplicationCommandOptionTypeNumber (Number t) = return $ return (ApplicationCommandInteractionDataValueNumber t)-parseJSONACIDV ApplicationCommandOptionTypeBoolean (Bool t) = return $ return (ApplicationCommandInteractionDataValueBoolean t)-parseJSONACIDV ApplicationCommandOptionTypeUser t = Just . ApplicationCommandInteractionDataValueUser <$> parseJSON t-parseJSONACIDV ApplicationCommandOptionTypeChannel t = Just . ApplicationCommandInteractionDataValueChannel <$> parseJSON t-parseJSONACIDV ApplicationCommandOptionTypeRole t = Just . ApplicationCommandInteractionDataValueRole <$> parseJSON t-parseJSONACIDV ApplicationCommandOptionTypeMentionable t = Just . ApplicationCommandInteractionDataValueMentionable <$> parseJSON t-parseJSONACIDV t v = fail $ "could not parse type " ++ show t ++ " from " ++ show v+instance ToJSON InteractionResponseMessageFlags where+  toJSON (InteractionResponseMessageFlags fs) = Number $ fromInteger $ fromIntegral $ foldr (.|.) 0 (fromEnum <$> fs)

@@ -1,8 +1,8 @@-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE MultiParamTypeClasses  #-} {-# LANGUAGE FlexibleInstances  #-}+{-# LANGUAGE RankNTypes  #-}  -- | Provides base types and utility functions needed for modules in Discord.Internal.Types module Discord.Internal.Types.Prelude where@@ -14,16 +14,14 @@ import Data.Time.Clock import qualified Data.Text as T import Data.Time.Clock.POSIX-import Control.Monad (mzero)  import Data.Functor.Compose (Compose(Compose, getCompose)) import Data.Bifunctor (first) import Text.Read (readMaybe) import Data.Data (Data (dataTypeOf), dataTypeConstrs, fromConstr)-import Data.Maybe (fromJust)  -- | Authorization token for the Discord API-data Auth = Auth T.Text+newtype Auth = Auth T.Text   deriving (Show, Read, Eq, Ord)  @@ -47,10 +45,14 @@   toJSON (Snowflake snowflake) = String . T.pack $ show snowflake  instance FromJSON Snowflake where-  parseJSON (String snowflake) = case readMaybe (T.unpack snowflake) of-    Nothing -> fail "null snowflake"-    (Just i) -> pure i-  parseJSON _ = mzero+  parseJSON =+    withText+      "Snowflake"+      ( \snowflake ->+          case readMaybe (T.unpack snowflake) of+            Nothing -> fail "null snowflake"+            (Just i) -> pure i+      )  type ChannelId = Snowflake type StageId = Snowflake@@ -65,7 +67,7 @@ type IntegrationId = Snowflake type WebhookId = Snowflake type ParentId = Snowflake-type ApplicationId = Snowflake +type ApplicationId = Snowflake type ApplicationCommandId = Snowflake type InteractionId = Snowflake type InteractionToken = T.Text@@ -80,42 +82,42 @@ epochTime :: UTCTime epochTime = posixSecondsToUTCTime 0 -type ColorInteger = Integer--makeTable :: (Data t, Enum t) => t -> [(Int, t)]-makeTable t = map (\cData -> let c = fromConstr cData in (fromEnum c, c)) (dataTypeConstrs $ dataTypeOf t)+{- -toMaybeJSON :: (ToJSON a) => a -> Maybe Value-toMaybeJSON = return . toJSON+InternalDiscordEnum is a hack-y typeclass, but it's the best solution overall.+The best we can do is prevent the end-user from seeing this. --- | What type of interaction has a user requested? Each requires its own type--- of response.-data InteractionType-  = InteractionTypePing-  | InteractionTypeApplicationCommand-  | InteractionTypeMessageComponent-  | InteractionTypeApplicationCommandAutocomplete-  deriving (Show, Read, Data, Eq, Ord)+typeclass Bounded (minBound + maxBound) could replace discordTypeStartValue, but+it can't derive instances for types like DiscordColor, which have simple sum types involved. -instance Enum InteractionType where-  fromEnum InteractionTypePing = 1-  fromEnum InteractionTypeApplicationCommand = 2-  fromEnum InteractionTypeMessageComponent = 3-  fromEnum InteractionTypeApplicationCommandAutocomplete = 4-  toEnum a = fromJust $ lookup a table-    where-      table = makeTable InteractionTypePing+typeclass Enum (toEnum + fromEnum) requires defining both A->Int and Int->A.+If we handle both at once (with an inline map), it's no longer typesafe. -instance ToJSON InteractionType where-  toJSON = toJSON . fromEnum+External packages exist, but bloat our dependencies -instance FromJSON InteractionType where-  parseJSON = withScientific "InteractionType" (return . toEnum . round)+-}+class Data a => InternalDiscordEnum a where+  discordTypeStartValue :: a+  fromDiscordType :: a -> Int+  discordTypeTable :: [(Int, a)]+  discordTypeTable =  map (\d -> (fromDiscordType d, d)) (makeTable discordTypeStartValue)+    where+      makeTable :: Data b => b -> [b]+      makeTable t = map fromConstr (dataTypeConstrs $ dataTypeOf t) -class Internals a b where-  toInternal :: a -> b-  fromInternal :: b -> Maybe a+  discordTypeParseJSON :: String -> Value -> Parser a+  discordTypeParseJSON name =+    withScientific+      name+      ( \i -> do+          case maybeInt i >>= (`lookup` discordTypeTable) of+            Nothing -> fail $ "could not parse type: " ++ show i+            Just d -> return d+      )+    where+      maybeInt i+        | fromIntegral (round i) == i = Just $ round i+        | otherwise = Nothing -instance Internals a a where-  toInternal = id-  fromInternal = Just+toMaybeJSON :: (ToJSON a) => a -> Maybe Value+toMaybeJSON = return . toJSON

@@ -1,3 +1,4 @@+-- | Re-export user-visible types module Discord.Types   ( module Discord.Internal.Types   ) where@@ -6,4 +7,9 @@     ( GatewaySendableInternal(..)     , GatewayReceivable(..)     , EventInternalParse(..)+    , InternalDiscordEnum(..)++    , colorToInternal+    , convertToRGB+    , hexToRGB     )