You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 

80 lines
2.9 KiB

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Main where
import Control.Monad (when, void)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import UnliftIO (liftIO)
import Discord
import Discord.Types
import Discord.Interactions
import qualified Discord.Requests as R
import Commands
import qualified Data.ByteString as BS
import qualified Data.Yaml as YAML
import qualified Data.HashMap.Strict as Map
testServer :: Snowflake
testServer = 740862954454646814
main :: IO ()
main = do
tok <- TIO.readFile "./auth.secret"
conf <- YAML.decodeFileThrow "./conf.yaml" :: IO YAML.Value
putStrLn $ show conf
err <- runDiscord $ def { discordToken = tok
, discordOnStart = onDiscordStart conf
, discordOnEnd = liftIO $ putStrLn "Ended"
, discordOnEvent = onDiscordEvent conf
, discordOnLog =
\s -> TIO.putStrLn s >> TIO.putStrLn ""
}
TIO.putStrLn err
onDiscordStart :: YAML.Value -> DiscordHandler ()
onDiscordStart conf = do
let activity = Activity { activityName = "Doing stuff"
, activityType = ActivityTypeGame
, activityUrl = Nothing
}
let opts = UpdateStatusOpts { updateStatusOptsSince = Nothing
, updateStatusOptsGame = Just activity
, updateStatusOptsNewStatus = UpdateStatusOnline
, updateStatusOptsAFK = False
}
sendCommand (UpdateStatus opts)
onDiscordEvent :: YAML.Value -> Event -> DiscordHandler ()
onDiscordEvent conf (Ready _ _ _ _ _ _ (PartialApplication i _)) =
mapM_ (maybe ( return () )
( void
. restCall
. R.CreateGuildApplicationCommand i testServer
)
)
[ Just pingCommand
, Just edtCommand
]
onDiscordEvent conf
( InteractionCreate InteractionApplicationCommand
{ interactionDataApplicationCommand =
Just InteractionDataApplicationCommandChatInput
{ interactionDataApplicationCommandName = name
, interactionDataApplicationCommandOptions = opts
, ..
}
, ..
}
) = do
void $ restCall
(R.CreateInteractionResponse interactionId interactionToken response)
where
response = case name of
"ping" -> pingResponse
"edt" -> edtResponse opts
_ -> interactionResponseBasic $ "Unhandled Command: " `T.append` name
onDiscordEvent _ _ = return ()