From d922240e9a28680d48014604576620d7fc5aa605 Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Thu, 22 Apr 2010 00:05:35 +0200
Subject: Wrote the list plugin command.

---
 Hsbot/Command.hs   |  2 ++
 Hsbot/IRCParser.hs |  4 ++--
 Hsbot/IRCPlugin.hs |  8 ++++++--
 Hsbot/Plugin.hs    | 12 +++++++++++-
 Plugins/Core.hs    | 20 ++++++++++++++++----
 TODO               |  9 +++------
 6 files changed, 40 insertions(+), 15 deletions(-)

diff --git a/Hsbot/Command.hs b/Hsbot/Command.hs
index 1eaee82..ea372e4 100644
--- a/Hsbot/Command.hs
+++ b/Hsbot/Command.hs
@@ -76,7 +76,9 @@ processInternalCommand _ = return ()
 processCoreCommand :: IntCmd -> IrcBot ()
 processCoreCommand intCmd = do
     let command' = intCmdCmd intCmd
+        originalRequest = intCmdBotMsg intCmd
     case command' of
+        "LIST"       -> listPlugins originalRequest (intCmdFrom intCmd)
         "LOAD"       -> traceM $ inColor "hsbot has been compiled in static mode." [31]
         "UNLOAD"     -> unloadPlugin $ intCmdMsg intCmd
         "REGISTER"   -> registerCommand (intCmdMsg intCmd) (intCmdFrom intCmd)
diff --git a/Hsbot/IRCParser.hs b/Hsbot/IRCParser.hs
index a5f2e41..263ac1f 100644
--- a/Hsbot/IRCParser.hs
+++ b/Hsbot/IRCParser.hs
@@ -18,8 +18,8 @@ pMsg = do
     pfx <- optionMaybe pPrefix
     cmd <- pCommand
     params <- many (char ' ' >> (pLongParam <|> pShortParam))
-    --char '\r'
-    eof
+    char '\r'
+    --eof
     return $ IrcMsg pfx cmd params
 
 pPrefix :: ParsecT String u Identity [Char]
diff --git a/Hsbot/IRCPlugin.hs b/Hsbot/IRCPlugin.hs
index 568eb1d..c32d24c 100644
--- a/Hsbot/IRCPlugin.hs
+++ b/Hsbot/IRCPlugin.hs
@@ -1,6 +1,7 @@
 module Hsbot.IRCPlugin
     ( readMsg
     , sendCommand
+    , sendCommandWithRequest
     , sendRegisterCommand
     , sendUnregisterCommand
     , writeMsg
@@ -25,10 +26,13 @@ writeMsg botMsg = do
 
 -- | Commands management
 sendCommand :: String -> String -> String -> IrcPlugin ()
-sendCommand cmd to params = do
+sendCommand cmd to params = sendCommandWithRequest cmd to params Nothing
+
+sendCommandWithRequest :: String -> String -> String -> Maybe IrcMsg -> IrcPlugin ()
+sendCommandWithRequest cmd to params originalRequest = do
     serverChan <- gets instanceServerChan
     from       <- gets instanceName
-    liftIO $ writeChan serverChan $ InternalCmd $ IntCmd cmd from to params Nothing
+    liftIO $ writeChan serverChan $ InternalCmd $ IntCmd cmd from to params originalRequest
 
 sendRegisterCommand :: String -> IrcPlugin ()
 sendRegisterCommand cmd = sendCommand "REGISTER" "CORE" cmd
diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs
index 34c6603..43ce0fb 100644
--- a/Hsbot/Plugin.hs
+++ b/Hsbot/Plugin.hs
@@ -1,5 +1,6 @@
 module Hsbot.Plugin
-    ( loadPlugin
+    ( listPlugins
+    , loadPlugin
     , sendToPlugin
     , unloadPlugin
     ) where
@@ -31,6 +32,15 @@ effectivelyLoadPlugin name entryPoint serverChan = do
     threadId <- forkIO $ entryPoint serverChan chan
     return $ Plugin name threadId chan
 
+-- | Sends a list of loaded plugins
+listPlugins :: Maybe IrcMsg -> String -> IrcBot ()
+listPlugins originalRequest dest = do
+    plugins <- gets botPlugins
+    let listing = unwords $ M.keys plugins
+    case M.lookup dest plugins of
+        Just plugin -> sendToPlugin (InternalCmd $ IntCmd "ANSWER" "CORE" dest listing originalRequest) plugin
+        Nothing     -> return ()
+
 -- | Unloads a plugin
 unloadPlugin :: String -> IrcBot ()
 unloadPlugin name = do
diff --git a/Plugins/Core.hs b/Plugins/Core.hs
index 123d2e6..64e0bf7 100644
--- a/Plugins/Core.hs
+++ b/Plugins/Core.hs
@@ -5,6 +5,7 @@ module Plugins.Core
 import Control.Concurrent.Chan(Chan)
 import Control.Exception
 import Control.Monad.State
+import Data.Maybe(fromMaybe)
 import Prelude hiding (catch)
 
 import Hsbot.IRCPlugin
@@ -28,16 +29,27 @@ run = forever $ do
     eval :: BotMsg -> IrcPlugin ()
     eval (InternalCmd intCmd) = do
         case intCmdCmd intCmd of
-            "RUN" -> let stuff = words $ intCmdMsg intCmd
-                     in case head stuff of
+            "RUN"    -> let stuff = words $ intCmdMsg intCmd
+                            request = intCmdBotMsg intCmd
+                        in case head stuff of
+                            "list"   -> listPlugins request
                             "load"   -> loadPlugin $ tail stuff
                             "reload" -> reloadPlugin $ tail stuff
                             "unload" -> unloadPlugin $ tail stuff
                             _      -> lift $ trace $ show intCmd -- TODO : help message
-            _     -> lift $ trace $ show intCmd
-    eval (InputMsg msg) = return ()
+            "ANSWER" -> let stuff = intCmdMsg intCmd
+                            request = intCmdBotMsg intCmd
+                            chanOrigin = head $ parameters (fromMaybe (IrcMsg Nothing "ARGH" []) request)
+                        in writeMsg $ OutputMsg $ IrcMsg Nothing "PRIVMSG" [chanOrigin, "Loaded plugins : " ++ stuff]
+            _        -> lift $ trace $ show intCmd
+    eval (InputMsg _) = return ()
     eval _ = return ()
 
+-- | The list command
+listPlugins :: Maybe IrcMsg -> IrcPlugin ()
+listPlugins request = do
+    sendCommandWithRequest "LIST" "CORE" (unwords []) request
+
 -- | The load command
 loadPlugin :: [String] -> IrcPlugin ()
 loadPlugin pluginNames = mapM_ (sendCommand "LOAD" "CORE") pluginNames
diff --git a/TODO b/TODO
index 7e8afd1..9ec408e 100644
--- a/TODO
+++ b/TODO
@@ -1,10 +1,7 @@
 :julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif
 
-* write a safe reload : try reload before unloading
-* discard all trace with a color param and replace those with functions info/warn/error/debug
-
+* Write the quote module
 * clean the plugin module
-* list modules command
 * part chan
 
 * add admin checks for cmds
@@ -13,6 +10,6 @@
 
 * Handle unix signals properly
 * Make the bot auto-reconnect (/!\ admin plugin!)
-
-* restore \r in IRCParser
+* discard all trace with a color param and replace those with functions info/warn/error/debug
+* write a safe reload : try reload before unloading
 
-- 
cgit v1.2.3