Did some work and moved to stack

.gitignore

@@ -1,4 +1,6 @@
 dist-newstyle
+.stack-work
+*.lock
 *.secret
 *#
 .#*

app/Commands.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Commands where
+
+import           Discord
+import           Discord.Types
+import           Discord.Interactions
+import qualified Discord.Requests     as R
+
+import qualified Data.Text            as T
+
+pingCommand :: CreateApplicationCommand
+pingCommand =
+  CreateApplicationCommand
+    "ping"
+    "pong"
+    (Just [])
+    Nothing
+    Nothing
+
+pingResponse :: InteractionResponse
+pingResponse = interactionResponseBasic "Pong"
+
+edtCommand :: CreateApplicationCommand
+edtCommand = CreateApplicationCommand
+  "edt"
+  "Gets the planning for a group"
+  (Just $ toInternal <$>
+    [ ApplicationCommandOptionValueString
+        "group"
+        "Group to get the planning for"
+        (Just True)
+        Nothing
+        Nothing
+    , ApplicationCommandOptionValueString
+        "day"
+        "The day you want the planning for as DD/MM(/YYYY)"
+        Nothing Nothing Nothing
+    ])
+  Nothing
+  Nothing

app/Main.hs

@@ -1,20 +1,22 @@
 {-# 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 Discord.Internal.Rest (Activity(Activity))
+import Discord.Internal.Rest.Guild (ModifyGuildOpts(modifyGuildOptsIcon))
+import UnliftIO.Directory (renameDirectory)
+
+testServer :: Snowflake
+testServer = 740862954454646814
 
 main :: IO ()
 main = do
@@ -30,11 +32,44 @@ main = do
 
 onDiscordStart :: DiscordHandler ()
 onDiscordStart = do
-  let activity =
-    Activity
-      {
-      }
+  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 :: Event -> DiscordHandler ()
+onDiscordEvent (Ready _ _ _ _ _ _ (PartialApplication i _)) =
+  mapM_ (maybe ( return () )
+               ( void
+               . restCall
+               . R.CreateGuildApplicationCommand i testServer
+               )
+        )
+        [ Just pingCommand
+        , Just edtCommand
+        ]
+onDiscordEvent ( InteractionCreate InteractionApplicationCommand
+                   { interactionDataApplicationCommand =
+                       Just InteractionDataApplicationCommandChatInput
+                         { interactionDataApplicationCommandName = name
+                         , interactionDataApplicationCommandOptions = opts
+                         , ..
+                         }
+                   , ..
+                   }
+               ) = do
+    void $ restCall
+      (R.CreateInteractionResponse interactionId interactionToken response)
+    where
+      response = case name of
+        "ping" -> pingResponse
+        _ -> interactionResponseBasic $ "Unhandled Command: " `T.append` name
 onDiscordEvent _ = return ()
 

botiut.cabal

@@ -24,12 +24,13 @@ executable botiut
     main-is:          Main.hs
 
     -- Modules included in this executable, other than Main.
-    -- other-modules:
+    other-modules:
+            Commands
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:
     build-depends:
-            base ^>=4.15.0.0
+            base ^>=4.14.0.0
           , discord-haskell
           , control-event
           , text

stack.yaml

@@ -0,0 +1,14 @@
+resolver: lts-18.24
+packages:
+  - .
+allow-newer: true
+extra-deps:
+  # Stuff not in stackage
+  - emoji-0.1.0.2
+  - control-event-1.3
+  - iCalendar-0.4.0.5
+  - mime-0.4.0.2
+  # My fork of discord-haskell to fix a bug
+  - github: Annwan/discord-haskell
+    commit: 830e3a0bcc2586e40e167a1ec14e357e6396a7d2
+