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/Irc/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/Irc/Command.hs | 59 |
1 files changed, 59 insertions, 0 deletions
diff --git a/Hsbot/Irc/Command.hs b/Hsbot/Irc/Command.hs new file mode 100644 index 0000000..3f5c8c1 --- /dev/null +++ b/Hsbot/Irc/Command.hs @@ -0,0 +1,59 @@ +module Hsbot.Irc.Command + ( processInternalCommand + , registerCommand + , unregisterCommand + ) where + +import Control.Monad.State +import qualified Data.List as L +import qualified Data.Map as M +import Data.Maybe + +import Hsbot.Irc.Message +import Hsbot.Irc.Plugin +import Hsbot.Irc.Types + +-- | Registers a plugin's command +registerCommand :: String -> String -> IrcBot () +registerCommand cmd pluginName' = do + ircBot <- get + let cmds = ircBotCommands ircBot + plugins = ircBotPlugins ircBot + 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 $ ircBot { ircBotCommands = newCmds } + Nothing -> return () + +-- | Unregisters a plugin's command +unregisterCommand :: String -> String -> IrcBot () +unregisterCommand cmd pluginName' = do + ircBot <- get + let cmds = ircBotCommands ircBot + newCmds = M.adjust (L.delete pluginName') cmd cmds + put $ ircBot { ircBotCommands = newCmds } + +-- | Processes an internal command +processInternalCommand :: IrcBotMsg -> IrcBot () +processInternalCommand (IntIrcCmd ircCmd) + | ircCmdTo ircCmd == "CORE" = processCoreCommand ircCmd + | otherwise = do + plugins <- gets ircBotPlugins + case M.lookup (ircCmdTo ircCmd) plugins of + Just plugin -> sendToPlugin (IntIrcCmd ircCmd) plugin + Nothing -> return () +processInternalCommand _ = return () + +-- | Processes a core command +processCoreCommand :: IrcCmd -> IrcBot () +processCoreCommand ircCmd = do + let command' = ircCmdCmd ircCmd + originalRequest = ircCmdBotMsg ircCmd + case command' of + "LIST" -> listPlugins originalRequest (ircCmdFrom ircCmd) + "LOAD" -> loadIrcPlugin $ ircCmdMsg ircCmd + "UNLOAD" -> unloadPlugin $ ircCmdMsg ircCmd + "REGISTER" -> registerCommand (ircCmdMsg ircCmd) (ircCmdFrom ircCmd) + "UNREGISTER" -> unregisterCommand (ircCmdMsg ircCmd) (ircCmdFrom ircCmd) + _ -> return () + |