From e024c8cdba60d8716ef5fc69cade67c567340b6b Mon Sep 17 00:00:00 2001
From: Antoine COMBET <antoine.combet@etu.univ-lyon1.fr>
Date: Sun, 6 Feb 2022 20:16:48 +0100
Subject: [PATCH] Did some work and moved to stack

---
 .gitignore      |  2 ++
 app/Commands.hs | 40 +++++++++++++++++++++++++++++++++++
 app/Main.hs     | 55 ++++++++++++++++++++++++++++++++++++++++---------
 botiut.cabal    |  5 +++--
 stack.yaml      | 14 +++++++++++++
 5 files changed, 104 insertions(+), 12 deletions(-)
 create mode 100644 stack.yaml

diff --git a/.gitignore b/.gitignore
index a80a946..4415e84 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,4 +1,6 @@
 dist-newstyle
+.stack-work
+*.lock
 *.secret
 *#
 .#*
\ No newline at end of file
diff --git a/app/Commands.hs b/app/Commands.hs
index e69de29..6738d43 100644
--- a/app/Commands.hs
+++ b/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
diff --git a/app/Main.hs b/app/Main.hs
index fd9bc91..3f68e6f 100644
--- a/app/Main.hs
+++ b/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 ()
 
diff --git a/botiut.cabal b/botiut.cabal
index 22b6938..7dc4f84 100644
--- a/botiut.cabal
+++ b/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
diff --git a/stack.yaml b/stack.yaml
new file mode 100644
index 0000000..ee98e75
--- /dev/null
+++ b/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
+