Archived
1
0
Fork 0

Began a complete rewrite of command and plugin management.

Wrote a command routing statement, added an IrcPlugin monad.
This commit is contained in:
Julien Dessaux 2010-02-04 21:05:37 +01:00
parent 047a10bc9b
commit fd8d5faf5f
12 changed files with 244 additions and 87 deletions

View file

@ -36,37 +36,48 @@ unregisterCommand cmd pluginName' = do
let newCmds = M.adjust (L.delete pluginName') cmd cmds
put $ bot { botCommands = newCmds }
--
-- TODO Clean this crap
--
-- | Dispatches an input message
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 ()
if isPluginCommand --TODO : how to get rid of this if?
then
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_ (sendToPlugin (InputMsg inputMsg)) (M.elems plugins)
where
isPluginCommand :: Bool
isPluginCommand =
and [ command inputMsg == "PRIVMSG"
, (head getMsgContent) == (commandPrefix config) ]
sendRunCommand :: String -> Plugin -> IrcBot ()
sendRunCommand cmd plugin = do
sendToPlugin (InternalCmd $ IntCmd "RUN" "CORE" (pluginName plugin) cmd) plugin
getMsgContent :: String
getMsgContent = (parameters inputMsg) !! 1
dispatchMessage _ = return ()
-- | Processes an internal command
-- | 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]
plugins <- gets botPlugins
if intCmdTo intCmd == "CORE"
then processCoreCommand intCmd
else sendToPlugin (InternalCmd intCmd) $ fromMaybe [] (M.lookup plugins (intCmdTo intCmd))
processInternalCommand _ = return ()
-- | Processes a core command
processCoreCommand :: IntCmd -> IrcBot ()
processCoreCommand intCmd = do
let command' = intCmdCmd intCmd
case command' of
"LOAD" -> loadPlugin $ intCmdMsg intCmd
"UNLOAD" -> unloadPlugin $ intCmdMsg intCmd
"REGISTER" -> registerCommand (intCmdMsg intCmd) (intCmdFrom intCmd)
"UNREGISTER" -> unregisterCommand (intCmdMsg intCmd) (intCmdFrom intCmd)
_ -> traceM $ inColor ("Invalid command : " ++ (show intCmd)) [31]