From b7565417cf39e38d38eccc7a4c56f6030c73c1a2 Mon Sep 17 00:00:00 2001 From: Antoine COMBET Date: Sun, 6 Feb 2022 21:48:13 +0100 Subject: [PATCH] Did more work --- .gitignore | 3 ++- README.org | 4 ++-- app/Commands.hs | 25 ++++++++++++++++++++++++- app/Commands.hsCommands.hs | 0 app/Commands/EDT.hs | 5 +++++ app/Main.hs | 25 +++++++++++++++---------- botiut.cabal | 7 ++++++- 7 files changed, 54 insertions(+), 15 deletions(-) create mode 100644 app/Commands.hsCommands.hs create mode 100644 app/Commands/EDT.hs diff --git a/.gitignore b/.gitignore index 4415e84..1ed6ea1 100644 --- a/.gitignore +++ b/.gitignore @@ -3,4 +3,5 @@ dist-newstyle *.lock *.secret *# -.#* \ No newline at end of file +.#* +conf.yaml \ No newline at end of file diff --git a/README.org b/README.org index f33c8a4..7484f47 100644 --- a/README.org +++ b/README.org @@ -1,8 +1,8 @@ #+title: botiut #+author: Annwan -** TODO List [0/3] -- [ ] Framework +** TODO List [1/3] +- [X] Framework - [ ] Time table [0/2] - [ ] =edt= command - [ ] Messages in channel diff --git a/app/Commands.hs b/app/Commands.hs index 6738d43..bd31f81 100644 --- a/app/Commands.hs +++ b/app/Commands.hs @@ -1,12 +1,16 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + module Commands where import Discord import Discord.Types import Discord.Interactions import qualified Discord.Requests as R - import qualified Data.Text as T +import qualified Data.Map.Strict as Map + +import Commands.EDT pingCommand :: CreateApplicationCommand pingCommand = @@ -38,3 +42,22 @@ edtCommand = CreateApplicationCommand ]) Nothing Nothing + +edtResponse :: Maybe InteractionDataApplicationCommandOptions -> InteractionResponse +edtResponse (Just (InteractionDataApplicationCommandOptionsValues opts)) = + interactionResponseBasic $ + "You gave:\n```hs\n" `T.append` T.pack (show parsedOpts) `T.append` "\n```" + where + parsedOpts :: Map.Map T.Text T.Text + parsedOpts = Map.fromList $ map parseOpt opts + parseOpt :: InteractionDataApplicationCommandOptionValue -> (T.Text, T.Text) + parseOpt (InteractionDataApplicationCommandOptionValue + { interactionDataApplicationCommandOptionValueName = name + , interactionDataApplicationCommandOptionValueValue = + ApplicationCommandInteractionDataValueString val + , ..} + ) = (name, val) + parseOpt _ = ("INVALID FORMAT", "INVALID FORMAT") + +edtResponse _ = interactionResponseBasic + "The edt command should have params yet you managed not to give any: wow" diff --git a/app/Commands.hsCommands.hs b/app/Commands.hsCommands.hs new file mode 100644 index 0000000..e69de29 diff --git a/app/Commands/EDT.hs b/app/Commands/EDT.hs new file mode 100644 index 0000000..074ab2e --- /dev/null +++ b/app/Commands/EDT.hs @@ -0,0 +1,5 @@ +module Commands.EDT where + +import qualified Data.Map.Strict as Map +import qualified Text.ICalendar.Parser as IP +import qualified Text.ICalendar.Types as IT diff --git a/app/Main.hs b/app/Main.hs index 3f68e6f..969f98b 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -12,8 +12,9 @@ import Discord.Types import Discord.Interactions import qualified Discord.Requests as R import Commands -import Discord.Internal.Rest.Guild (ModifyGuildOpts(modifyGuildOptsIcon)) -import UnliftIO.Directory (renameDirectory) +import qualified Data.ByteString as BS +import qualified Data.Yaml as YAML +import qualified Data.HashMap.Strict as Map testServer :: Snowflake testServer = 740862954454646814 @@ -21,17 +22,19 @@ 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 + , discordOnStart = onDiscordStart conf , discordOnEnd = liftIO $ putStrLn "Ended" - , discordOnEvent = onDiscordEvent + , discordOnEvent = onDiscordEvent conf , discordOnLog = \s -> TIO.putStrLn s >> TIO.putStrLn "" } TIO.putStrLn err -onDiscordStart :: DiscordHandler () -onDiscordStart = do +onDiscordStart :: YAML.Value -> DiscordHandler () +onDiscordStart conf = do let activity = Activity { activityName = "Doing stuff" , activityType = ActivityTypeGame , activityUrl = Nothing @@ -44,8 +47,8 @@ onDiscordStart = do sendCommand (UpdateStatus opts) -onDiscordEvent :: Event -> DiscordHandler () -onDiscordEvent (Ready _ _ _ _ _ _ (PartialApplication i _)) = +onDiscordEvent :: YAML.Value -> Event -> DiscordHandler () +onDiscordEvent conf (Ready _ _ _ _ _ _ (PartialApplication i _)) = mapM_ (maybe ( return () ) ( void . restCall @@ -55,7 +58,8 @@ onDiscordEvent (Ready _ _ _ _ _ _ (PartialApplication i _)) = [ Just pingCommand , Just edtCommand ] -onDiscordEvent ( InteractionCreate InteractionApplicationCommand +onDiscordEvent conf + ( InteractionCreate InteractionApplicationCommand { interactionDataApplicationCommand = Just InteractionDataApplicationCommandChatInput { interactionDataApplicationCommandName = name @@ -70,6 +74,7 @@ onDiscordEvent ( InteractionCreate InteractionApplicationCommand where response = case name of "ping" -> pingResponse + "edt" -> edtResponse opts _ -> interactionResponseBasic $ "Unhandled Command: " `T.append` name -onDiscordEvent _ = return () +onDiscordEvent _ _ = return () diff --git a/botiut.cabal b/botiut.cabal index 7dc4f84..2655480 100644 --- a/botiut.cabal +++ b/botiut.cabal @@ -25,7 +25,8 @@ executable botiut -- Modules included in this executable, other than Main. other-modules: - Commands + Commands + , Commands.EDT -- LANGUAGE extensions used by modules in this package. -- other-extensions: @@ -35,6 +36,10 @@ executable botiut , control-event , text , unliftio + , containers + , unordered-containers , iCalendar + , bytestring + , yaml hs-source-dirs: app default-language: Haskell2010