Did more work

.gitignore

@@ -4,3 +4,4 @@ dist-newstyle
 *.secret
 *#
 .#*
+conf.yaml

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

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"

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

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 ()
 

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