From 727adadc28a40fe8843a0727168684d3c2b3e114 Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Thu, 22 Apr 2010 19:42:53 +0200
Subject: Added an utility function to correctly answer a message we receive
 (aka /msg)

---
 Hsbot/Command.hs   | 14 +++++++-------
 Hsbot/IRCPlugin.hs | 13 ++++++++++++-
 Plugins/Core.hs    |  6 ++----
 3 files changed, 21 insertions(+), 12 deletions(-)

diff --git a/Hsbot/Command.hs b/Hsbot/Command.hs
index ea372e4..711aa32 100644
--- a/Hsbot/Command.hs
+++ b/Hsbot/Command.hs
@@ -38,16 +38,16 @@ unregisterCommand cmd pluginName' = do
 
 -- | Dispatches an input message
 dispatchMessage :: BotMsg -> IrcBot ()
-dispatchMessage (InputMsg inputMsg) = do
-    plugins <- gets botPlugins
-    cmds    <- gets botCommands
-    if isPluginCommand  --TODO : how to get rid of this if?
-      then
+dispatchMessage (InputMsg inputMsg)
+    | isPluginCommand = do
+        plugins <- gets botPlugins
+        cmds    <- gets botCommands
         let key         = tail $ head $ words getMsgContent
             pluginNames = fromMaybe [] $ M.lookup key cmds
             plugins'    = fromMaybe [] $ mapM (flip M.lookup plugins) pluginNames
-        in mapM_ (sendRunCommand $ tail getMsgContent) plugins'
-      else
+        mapM_ (sendRunCommand $ tail getMsgContent) plugins'
+    | otherwise       = do
+        plugins <- gets botPlugins
         mapM_ (sendToPlugin (InputMsg inputMsg)) (M.elems plugins)
   where
     isPluginCommand :: Bool
diff --git a/Hsbot/IRCPlugin.hs b/Hsbot/IRCPlugin.hs
index c32d24c..4707ce1 100644
--- a/Hsbot/IRCPlugin.hs
+++ b/Hsbot/IRCPlugin.hs
@@ -1,5 +1,6 @@
 module Hsbot.IRCPlugin
-    ( readMsg
+    ( answerMsg
+    , readMsg
     , sendCommand
     , sendCommandWithRequest
     , sendRegisterCommand
@@ -9,6 +10,7 @@ module Hsbot.IRCPlugin
 
 import Control.Concurrent.Chan
 import Control.Monad.State
+import Data.Maybe(fromMaybe)
 
 import Hsbot.Types
 
@@ -24,6 +26,15 @@ writeMsg botMsg = do
     serverChan <- gets instanceServerChan
     liftIO $ writeChan serverChan $ botMsg
 
+answerMsg :: Maybe IrcMsg -> String -> IrcPlugin ()
+answerMsg request msg = do
+    let incoming   = fromMaybe (IrcMsg Nothing "ARGH" []) request
+        chanOrigin = head $ parameters (incoming)
+        sender     = takeWhile (/= '!') $ fromMaybe "ARGH" (prefix incoming)
+    case head chanOrigin of
+        '#' -> writeMsg $ OutputMsg $ IrcMsg Nothing "PRIVMSG" [chanOrigin, msg]
+        _   -> writeMsg $ OutputMsg $ IrcMsg Nothing "PRIVMSG" [sender, msg]
+
 -- | Commands management
 sendCommand :: String -> String -> String -> IrcPlugin ()
 sendCommand cmd to params = sendCommandWithRequest cmd to params Nothing
diff --git a/Plugins/Core.hs b/Plugins/Core.hs
index 64e0bf7..f6bd4ef 100644
--- a/Plugins/Core.hs
+++ b/Plugins/Core.hs
@@ -28,9 +28,9 @@ run = forever $ do
   where
     eval :: BotMsg -> IrcPlugin ()
     eval (InternalCmd intCmd) = do
+        let request = intCmdBotMsg intCmd
         case intCmdCmd intCmd of
             "RUN"    -> let stuff = words $ intCmdMsg intCmd
-                            request = intCmdBotMsg intCmd
                         in case head stuff of
                             "list"   -> listPlugins request
                             "load"   -> loadPlugin $ tail stuff
@@ -38,9 +38,7 @@ run = forever $ do
                             "unload" -> unloadPlugin $ tail stuff
                             _      -> lift $ trace $ show intCmd -- TODO : help message
             "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]
+                        in answerMsg request ("Loaded plugins : " ++ stuff)
             _        -> lift $ trace $ show intCmd
     eval (InputMsg _) = return ()
     eval _ = return ()
-- 
cgit v1.2.3