adyxax/hsbot
Archived
1
0
Fork 0
Code Issues Activity

Rewrote command handling, added the Quote module and cleaned input handling.

Browse source
This commit is contained in:
Julien Dessaux 2010-02-04 20:55:54 +01:00
parent 46d9dd301d
commit 53870767c3
9 changed files with 116 additions and 57 deletions
Download patch file Download diff file Expand all files Collapse all files

81
Hsbot/Command.hs
View file

@ -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 ()