diff options
author | Julien Dessaux | 2010-05-16 00:01:00 +0200 |
---|---|---|
committer | Julien Dessaux | 2010-05-16 00:01:00 +0200 |
commit | c1662ba7b982a8502dc9f32031b7cb518df7f60e (patch) | |
tree | f00dbd9cb39bf0fbc20949105ea2b93d9e868070 /Hsbot/Command.hs | |
parent | Added the quote module. (diff) | |
download | hsbot-0.2.0.tar.gz hsbot-0.2.0.tar.bz2 hsbot-0.2.0.zip |
Rewrote nearly everything!v0.2.0
* Rewrote the whole architecture to achieve extreme modularity
* Added the ability to build a multiprotocol bot
* Added cabal integration
* Added configuration handling the XMonad style
* Added configuration in ~/.hsbot
* Refactored many many named and functions
* Refactored data structures
* Cleaned a big bunch of stuff
Diffstat (limited to '')
-rw-r--r-- | Hsbot/Command.hs | 87 |
1 files changed, 0 insertions, 87 deletions
diff --git a/Hsbot/Command.hs b/Hsbot/Command.hs deleted file mode 100644 index 4653618..0000000 --- a/Hsbot/Command.hs +++ /dev/null @@ -1,87 +0,0 @@ -module Hsbot.Command - ( dispatchMessage - , processInternalCommand - , registerCommand - , unregisterCommand - ) where - -import Control.Monad.State -import qualified Data.List as L -import qualified Data.Map as M -import Data.Maybe - -import Config -import Hsbot.Plugin -import Hsbot.Types -import Hsbot.Utils - --- | Registers a plugin's command -registerCommand :: String -> String -> IrcBot () -registerCommand cmd pluginName' = do - bot <- get - cmds <- gets botCommands - 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 - cmds <- gets botCommands - let newCmds = M.adjust (L.delete pluginName') cmd cmds - put $ bot { botCommands = newCmds } - --- | Dispatches an input message -dispatchMessage :: BotMsg -> IrcBot () -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 - mapM_ (sendRunCommand $ tail getMsgContent) plugins' - | otherwise = do - plugins <- gets botPlugins - 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 inputMsg) plugin - getMsgContent :: String - getMsgContent = unwords . tail $ parameters inputMsg -dispatchMessage _ = return () - --- | Processes an internal command -processInternalCommand :: BotMsg -> IrcBot () -processInternalCommand (InternalCmd intCmd) = do - plugins <- gets botPlugins - if intCmdTo intCmd == "CORE" - then processCoreCommand intCmd - else case M.lookup (intCmdTo intCmd) plugins of - Just plugin -> sendToPlugin (InternalCmd intCmd) plugin - Nothing -> errorM $ "Invalid destination in message : " ++ (show intCmd) -processInternalCommand _ = return () - --- | Processes a core command -processCoreCommand :: IntCmd -> IrcBot () -processCoreCommand intCmd = do - let command' = intCmdCmd intCmd - originalRequest = intCmdBotMsg intCmd - case command' of - "LIST" -> listPlugins originalRequest (intCmdFrom intCmd) - "LOAD" -> traceM $ inColor "hsbot has been compiled in static mode." [31] - "UNLOAD" -> unloadPlugin $ intCmdMsg intCmd - "REGISTER" -> registerCommand (intCmdMsg intCmd) (intCmdFrom intCmd) - "UNREGISTER" -> unregisterCommand (intCmdMsg intCmd) (intCmdFrom intCmd) - _ -> traceM $ inColor ("Invalid command : " ++ (show intCmd)) [31] - |