From 53870767c32f61f756861d7bf18b5a55cd45a2e2 Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Thu, 4 Feb 2010 20:55:54 +0100
Subject: Rewrote command handling, added the Quote module and cleaned input
 handling.

---
 Hsbot/Command.hs | 81 +++++++++++++++++++++++++++++++-------------------------
 1 file changed, 45 insertions(+), 36 deletions(-)

(limited to 'Hsbot/Command.hs')

diff --git a/Hsbot/Command.hs b/Hsbot/Command.hs
index 92f304c..bab592e 100644
--- a/Hsbot/Command.hs
+++ b/Hsbot/Command.hs
@@ -1,5 +1,6 @@
 module Hsbot.Command
-    ( dispatchCommand
+    ( dispatchMessage
+    , processInternalCommand
     , registerCommand
     , unregisterCommand
     ) where
@@ -14,46 +15,20 @@ import Hsbot.Plugin
 import Hsbot.Types
 import Hsbot.Utils
 
--- TODO :  unregister command
-
-dispatchCommand :: BotMsg -> IrcBot ()
-dispatchCommand (InputMsg inputMsg) = do
-    plugins <- gets botPlugins
-    cmds    <- gets botCommands
-    if command inputMsg == "PRIVMSG"
-      then  -- The first word matters as the command
-        let msg = (parameters inputMsg) !! 1
-            pfx = commandPrefix config
-        in if (head msg) == pfx
-             then
-               let key         = tail msg -- all but the cmd prefix
-                   pluginNames = fromMaybe [] $ M.lookup key cmds
-                   plugins'    = fromMaybe [] $ mapM (flip M.lookup plugins) pluginNames
-               in mapM_ (sendToPlugin (InputMsg inputMsg)) plugins'
-             else
-               mapM_ (sendToPlugin (InputMsg inputMsg)) (M.elems plugins)
-      else
-        return ()
-dispatchCommand _ = return ()
-
+-- | Registers a plugin's command
 registerCommand :: String -> String -> IrcBot ()
 registerCommand cmd pluginName' = do
     bot     <- get
     cmds    <- gets botCommands
-    exists <- pluginExists pluginName'
-    -- TODO : improve this crap and remove at least one if!
-    if exists
-      then
-        let cmds' = if cmd `M.member` cmds
-                      then cmds
-                      else M.singleton cmd []
-            -- TODO : remove duplicates ?
-            newCmds = M.adjust (++ [pluginName']) cmd cmds'
-        in put $ bot { botCommands = newCmds }
-      else
-        traceM $ inColor ("Couldn't register command \"" ++ cmd ++ "\" for plugin \""
-                          ++ pluginName' ++ "\" : plugin does not exists") [31]
+    plugins <- gets botPlugins
+    case M.lookup pluginName' plugins of
+        Just _  -> let pluginNames = pluginName' : fromMaybe [] (M.lookup cmd cmds) -- TODO : remove/check for duplicates ?
+                       newCmds     = M.insert cmd pluginNames cmds
+                   in  put $ bot { botCommands = newCmds }
+        Nothing -> traceM $ inColor ("Couldn't register command \"" ++ cmd ++ "\" for plugin \""
+                                     ++ pluginName' ++ "\" : plugin does not exists") [31]
 
+-- | Unregisters a plugin's command
 unregisterCommand :: String -> String -> IrcBot ()
 unregisterCommand cmd pluginName' = do
     bot    <- get
@@ -61,3 +36,37 @@ unregisterCommand cmd pluginName' = do
     let newCmds = M.adjust (L.delete pluginName') cmd cmds
     put $ bot { botCommands = newCmds }
 
+--
+-- TODO Clean this crap
+--
+dispatchMessage :: BotMsg -> IrcBot ()
+dispatchMessage (InputMsg inputMsg) = do
+    plugins <- gets botPlugins
+    cmds    <- gets botCommands
+    case command inputMsg of
+        "PRIVMSG" ->  -- The first word matters as the command
+                     let msg = (parameters inputMsg) !! 1
+                         pfx = commandPrefix config
+                     in if (head msg) == pfx
+                          then
+                            let msg'        = tail msg -- all but the cmd prefix
+                                key         = head $ words msg'
+                                pluginNames = fromMaybe [] $ M.lookup key cmds
+                                plugins'    = fromMaybe [] $ mapM (flip M.lookup plugins) pluginNames
+                            in  mapM_ (sendToPlugin $ InternalCmd $ IntCmd ("runCommand " ++ key) inputMsg) plugins'
+                          else
+                            mapM_ (sendToPlugin (InputMsg inputMsg)) (M.elems plugins)
+        _        -> return ()
+dispatchMessage _ = return ()
+
+-- | Processes an internal command
+processInternalCommand :: BotMsg -> IrcBot ()
+processInternalCommand (InternalCmd intCmd) = do
+    let command' = words $ internalCommand intCmd
+    case command' !! 0 of
+        "REGISTER" -> case command' !! 1 of
+                        "COMMAND" -> registerCommand (command' !! 2) (command' !! 3)
+                        _         -> traceM $ inColor ("Invalid argument for the REGISTER command : " ++ (command' !! 2)) [31]
+        _          -> traceM $ inColor ("Invalid command : " ++ (command' !! 1)) [31]
+processInternalCommand _ = return ()
+
-- 
cgit v1.2.3