summaryrefslogtreecommitdiff
path: root/Hsbot/Command.hs
diff options
context:
space:
mode:
authorJulien Dessaux2010-02-04 20:55:54 +0100
committerJulien Dessaux2010-02-04 20:55:54 +0100
commit53870767c32f61f756861d7bf18b5a55cd45a2e2 (patch)
tree2cb6b79ecaa039f472a220b26ce2af44d52b488c /Hsbot/Command.hs
parentImplemented unregisterCommand. (diff)
downloadhsbot-53870767c32f61f756861d7bf18b5a55cd45a2e2.tar.gz
hsbot-53870767c32f61f756861d7bf18b5a55cd45a2e2.tar.bz2
hsbot-53870767c32f61f756861d7bf18b5a55cd45a2e2.zip
Rewrote command handling, added the Quote module and cleaned input handling.
Diffstat (limited to '')
-rw-r--r--Hsbot/Command.hs81
1 files changed, 45 insertions, 36 deletions
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 ()
+