A recent change in Discord added some pretty neat ways of interacting. Unfortunately, it requires a fair amount of fiddling, so let's go through how to use this!
Below is an example of what we'll be able to produce at the end of this tutorial.
We'll start where the Plugins tutorial left off, with the below file. I've removed myping', and commented out most of the file, so we can start from basics and build back up again, as well as added a line to pingPlugin' which will help us later.
module Tablebot.Plugins.MyPing (pingPlugin') where
import Data.Text
import Tablebot.Utility
import Tablebot.Utility.Discord
import Tablebot.Utility.SmartParser
import Database.Persist.TH
import Discord.Types
import Database.Esqueleto
import GHC.Word
import Data.Maybe (catMaybes)
import Discord.Interactions
import Data.Default
-- share
-- [mkPersist sqlSettings, mkMigrate "pingMigration"]
-- [persistLowerCase|
-- PingCount
-- Primary uid
-- uid Word64
-- counter Int
-- deriving Show
-- |]
myPing :: Command
myPing = Command "myping" (noArguments $ \m -> do
sendMessage m "pong") []
-- myEcho :: Command
-- myEcho = Command "myecho" (parseComm echoHelp) []
-- where echoHelp :: RestOfInput Text -> Message -> DatabaseDiscord ()
-- echoHelp (ROI t) m = sendMessage m t
-- myPing'' :: Command
-- myPing'' = Command "cmyping" (parseComm pingDB) []
-- where pingDB :: Message -> DatabaseDiscord ()
-- pingDB m = do
-- let uid = extractFromSnowflake $ userId $ messageAuthor m
-- user <- liftSql $ select $ from $ \p -> do
-- where_ (p ^. PingCountUid ==. val uid)
-- return p
-- c <- case user of
-- [] -> do
-- _ <- liftSql $ insert (PingCount uid 1)
-- return 1
-- (x : _) -> do
-- let (PingCount uid' count) = entityVal x
-- record' = PingCount uid' (count+1)
-- liftSql $ repsert (entityKey x) record'
-- return (count+1)
-- sendMessage m (pack $ show c)
pingPlugin' :: Plugin
pingPlugin' = (plug "myping") {commands = [
myPing
-- , myPing''
-- , myEcho
]
-- , migrations = [pingMigration]
, onComponentRecvs = []
, applicationCommands = catMaybes []
}Additionally, we'll need to choose how our application commands are registered. The quickest and easiest way to do this is to add SERVER_ID=<your_test_server_id> to your .env file.
As before, let's start with the simplest type of command - replying to a given command.
We're going to change up how myPing is formed, so we can see how to make both a slash command and a text command.
First, we separate out the function that responds with pong, and make it so that instead of instantly sending the message, it generates a MessageDetails data structure that represents such a message.
myPing :: Command
myPing = Command "myping" (parseComm myPingAction) []
myPingAction :: DatabaseDiscord MessageDetails
myPingAction = return $ messageDetailsBasic "pong"Due to some of the setup that's been done separately, this will work as before, replying with "pong" when we call "myping".
We can now create our first application command!
To do this, we have to tell Discord what application command to create, and then we have to come up with a way to answer that. Luckily, we've made some magic to make some of this somewhat easier, and package it all up for us.
myPingInteraction :: Maybe ApplicationCommandRecv
myPingInteraction = makeApplicationCommandPair "myping" "my unique ping" myPingActionHere we've (possibly) created an application command called "myping", with a description of "my unique ping" that is created from myPingAction.
If we add myPingInteraction to the applicationCommands list in pingPlugin', and run our bot, we can see that we can now (after a short delay) type /myping into discord, press enter, and get a special response in return.
Well, that's pretty exciting. But we could do that before. What do we need to do to get the rest of our ping functions up to scratch?
Turns out there's a fair amount of information that we took for granted before that we're now going to have to work through, but don't worry, we're gonna get through it step by step.
Slash commands unfortunately need to have each of their parameters named and described, which means that anything we give to our function has to be named. This can be seen below.
Let's uncomment myEcho and roll up our sleeves to see what we want to do here.
First we pull out echoHelp into its own top level function, modify the return and arguments so it returns a message that is just the text we pass in - and we run into an issue. Having a RestOfInput doesn't make any sense in a slash command, so we can't use echoHelp as is. We're going to have to construct two subtly different functions that we can process differently to get what we want.
-- current `echoHelp`
echoHelp :: RestOfInput Text -> DatabaseDiscord MessageDetails
echoHelp (ROI t) = return $ messageDetailsBasic tWe take away the restriction of RestOfInput for now, breaking myecho, but we'll fix it shortly.
We then change myEcho so that instead of having (parseComm echoHelp), we instead have (parseComm (echoHelp . unROI)). This function is now the same as it originally was, and we can reuse our new echoHelp for our interactions. unROI lets us get the value within a RestOfInput value; its usage here effectively tells parseComm "Hey, get a RestOfInput, unwrap it, and feed it to echoHelp".
myEcho :: Command
myEcho = Command "myecho" (parseComm (echoHelp . unROI)) []
echoHelp :: Text -> DatabaseDiscord MessageDetails
echoHelp t = return $ messageDetailsBasic tOk, great, we're back to where we started. Now we have to make this labelled interactiony thingummy.
Let's see if we can just do the same thing we just did, using the tools we had before.
myEchoInteraction :: Maybe ApplicationCommandRecv
myEchoInteraction = makeApplicationCommandPair "myecho" "echo your input" (echoHelp . unLabel)Alright, and compi-
No instance for (GHC.TypeLits.KnownSymbol name0)
arising from a use of ‘makeApplicationCommandPair’
• In the expression:
makeApplicationCommandPair
"myecho" "echo your input" (echoHelp . unLabel)
In an equation for ‘myEchoInteraction’:
myEchoInteraction
= makeApplicationCommandPair
"myecho" "echo your input" (echoHelp . unLabel)
Oh dear that's hideous. Oh yeah, we forget to actually label anything! Labelling means we name and describe each argument we're giving to this function.
We can achieve this in one of two ways. Firstly, we could create a function which has the labels we want and then make the slash command like that; secondly, we could use type applications to add the labels we want here. I'm going to go with the latter in this case, but I'll show both here. Labelled is provided by Tablebot to do some clever things in the command parsing - it groups a value with a label and a description.
myEchoInteraction1 :: Maybe ApplicationCommandRecv
myEchoInteraction1 = makeApplicationCommandPair "myecho" "echo your input" echoHelp'
where
echoHelp' :: Labelled "message" "the message to echo back" Text -> DatabaseDiscord MessageDetails
echoHelp' (Labelled t) = echoHelp t
myEchoInteraction2 :: Maybe ApplicationCommandRecv
myEchoInteraction2 = makeApplicationCommandPair "myecho" "echo your input" (echoHelp . unLabel @"message" @"the message to echo back")Adding this new construction to our applicationCommands list and running the bot results in a new application command, one which can a single text input which the bot then throws right back at us.
One of the most useful bits of information that we would want to get is the user id of the user that called a command. Removing the reliance on Message means that we, unfortunately, don't have that information any more. We have a solution to this though! And we'll work through using that solution with myping'', which was the ping example that counted the number of times it had been pinged by the user before.
As before, we'll start by moving the helper function (pingDB) to its own top level function, changing any message sending to returning a MessageDetails, and then removing Message from the signature.
Doing this though, we immediately come up on the snag. Even if we aren't sending a message using m any more, we are still getting the user id of the user that sent the message. To solve this, we have to perform a special kind of parsing, using the context we have. This changes the first couple lines of pingDB to the following.
pingDB :: SenderUserId -> DatabaseDiscord MessageDetails
pingDB (SenderUserId u) = do
let uid = extractFromSnowflake $ unId uWe then construct the interaction as we have done before, add it to the interactions, and boom, we have another slash command to work with!
There are some more complex constructions with slash commands (such as subcommands), but as they are currently a bit fiddly we won't cover them in this tutorial.
Discord also offers user and message application commands, which we haven't created nice interfaces for just yet, but are usable if you do create them.
Another cool thing added was a variety of widgets and gizmos that bots can add to messages called "components". These also use the interaction system to process, but we've abstracted that again.
First, let's decide what we want to do with this. How about we add to the basic myping, and make it so that there's a button that says "Ping!", which people can click and it'll reply "pong"?
Yes it's contrived, I'm sorry.
Like before, this is a two stage process. In one place, we have to create the component itself, and in another we have to handle the interaction the component generates.
Let's create the component itself. We need to add it to the button to be pressed. This isn't too streamlined, but it makes some level of sense.
A button needs the text it will display, and a unique identifier that we'll use to differentiate and process a button. In this case, those are "Ping!" and "myping pingbutton" (why that exactly I'll explain later).
myPingAction :: DatabaseDiscord MessageDetails
myPingAction = return $ (messageDetailsBasic "pong") { messageDetailsComponents = Just [cps] }
where cps = ActionRowButtons [mkButton "Ping!" "myping pingbutton"]Running the bot, we see that we get the button now! But it just loads for a couple seconds then errors. We need our bot to actually handle this button press.
We can construct and add this component handler by using processComponentInteraction and ComponentRecv. The first creates a parser like parseComm did in the Plugins tutorial and the latter creates the data structure this interaction processor works in.
The action we use in response to the button will be myPingAction as it was before, so we feed that and False to processComponentInteraction. The False means that we send a message, instead of updating a message (see More complex components).
The reason I chose "myping pingbutton" as the identifier before is because of how we process and distribute components. The first word of the unique identifier has to be the plugin name, and the second has to be identifier of the particular component being processed.
myPingButton :: ComponentRecv
myPingButton = ComponentRecv "pingbutton" (processComponentInteraction myPingAction False)Now we just load myPingButton into onComponentRecvs in our plugin creation (similar to what we do with other commands), run the bot again, run the command, and press our sparkly button, and we get a message from the bot saying "pong"!
pingPlugin' = (plug "myping") {commands = [
...
]
...
, onComponentRecvs = [myPingButton] -- This right here, add this
...
}But can we do better?
In the Plugins tutorial we created a ping command that stored the ping count of a user in the database. Wouldn't it be useful if we could do the same, but in a button? Well even if it isn't useful, we can!
For this we're going to have to make a more complex button action, but it should be fine, right?
First we make it so that the button identifier includes a number at the end, like "myping pingbutton 0". Now we have to update the action on receiving a button press.
We create a function myPingButtonAction that takes a number and the interaction, and with those updates the original message component with that number, and sends a message that says "pong" and the number it is up to.
myPingButtonAction :: Integer -> Interaction -> DatabaseDiscord MessageDetails
myPingButtonAction i inter = do
sendReplyMessage (interactionMessage inter) ("pong " <> pack (show i)) -- respond to the message with a pong
return $ def { messageDetailsComponents = Just [cps] } -- the message to update the original with
where cps = ActionRowButtons [mkButton "Ping!" ("myping pingbutton " <> pack (show (i + 1)))]And then we edit myPingButton so that it uses the above function and also uses the output from it to update the original message: ComponentRecv "pingbutton" (processComponentInteraction myPingButtonAction True).
Now when we press the button, we get a pong with a number after it for each time the button has been pressed! Pretty neat, huh?
A lot was missed out of this tutorial, and there's a lot more that we haven't (yet!) made easier to do within tablebot, but we hope that this lets you get started on your bot development in Haskell!
In case you just want the complete working code from this tutorial, here it is.
module Tablebot.Plugins.MyPing (pingPlugin') where
import Data.Text
import Tablebot.Utility
import Tablebot.Utility.Discord
import Tablebot.Utility.SmartParser
import Database.Persist.TH
import Discord.Types
import Database.Esqueleto
import GHC.Word
import Data.Maybe (catMaybes)
import Discord.Interactions
import Data.Default
share
[mkPersist sqlSettings, mkMigrate "pingMigration"]
[persistLowerCase|
PingCount
Primary uid
uid Word64
counter Int
deriving Show
|]
myPing :: Command
myPing = Command "myping" (parseComm myPingAction) []
myPingAction :: DatabaseDiscord MessageDetails
myPingAction = return $ (messageDetailsBasic "pong") { messageDetailsComponents = Just [cps] }
where cps = ActionRowButtons [mkButton "Ping!" "myping pingbutton 0"]
myPingInteraction :: Maybe ApplicationCommandRecv
myPingInteraction = makeApplicationCommandPair "myping" "my unique ping" myPingAction
myPingButton :: ComponentRecv
myPingButton = ComponentRecv "pingbutton" (processComponentInteraction myPingButtonAction True)
myPingButtonAction :: Integer -> Interaction -> DatabaseDiscord MessageDetails
myPingButtonAction i inter = do
sendReplyMessage (interactionMessage inter) ("pong " <> pack (show i))
return $ def { messageDetailsComponents = Just [cps] }
where cps = ActionRowButtons [mkButton "Ping!" ("myping pingbutton " <> pack (show (i + 1)))]
myEcho :: Command
myEcho = Command "myecho" (parseComm (echoHelp . unROI)) []
echoHelp :: Text -> DatabaseDiscord MessageDetails
echoHelp t = return $ messageDetailsBasic t
myEchoInteraction :: Maybe ApplicationCommandRecv
myEchoInteraction = makeApplicationCommandPair "myecho" "echo your input" (echoHelp . unLabel @"message" @"the message to echo back")
myPing'' :: Command
myPing'' = Command "cmyping" (parseComm pingDB) []
pingDB :: SenderUserId -> DatabaseDiscord MessageDetails
pingDB (SenderUserId u) = do
let uid = extractFromSnowflake $ unId u
user <- liftSql $ select $ from $ \p -> do
where_ (p ^. PingCountUid ==. val uid)
return p
c <- case user of
[] -> do
_ <- liftSql $ insert (PingCount uid 1)
return 1
(x : _) -> do
let (PingCount uid' count) = entityVal x
record' = PingCount uid' (count+1)
liftSql $ repsert (entityKey x) record'
return (count+1)
return $ messageDetailsBasic (pack $ show c)
myPingInteraction'' :: Maybe ApplicationCommandRecv
myPingInteraction'' = makeApplicationCommandPair "cmyping" "counting pings" pingDB
pingPlugin' :: Plugin
pingPlugin' = (plug "myping") {commands = [
myPing
, myPing''
, myEcho
]
, migrations = [pingMigration]
, onComponentRecvs = [myPingButton]
, applicationCommands = catMaybes [ myPingInteraction, myEchoInteraction, myPingInteraction'' ]
}