summaryrefslogtreecommitdiff
path: root/Hsbot/Irc/Command.hs
diff options
context:
space:
mode:
authorJulien Dessaux2010-05-16 00:01:00 +0200
committerJulien Dessaux2010-05-16 00:01:00 +0200
commitc1662ba7b982a8502dc9f32031b7cb518df7f60e (patch)
treef00dbd9cb39bf0fbc20949105ea2b93d9e868070 /Hsbot/Irc/Command.hs
parentAdded the quote module. (diff)
downloadhsbot-c1662ba7b982a8502dc9f32031b7cb518df7f60e.tar.gz
hsbot-c1662ba7b982a8502dc9f32031b7cb518df7f60e.tar.bz2
hsbot-c1662ba7b982a8502dc9f32031b7cb518df7f60e.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 'Hsbot/Irc/Command.hs')
-rw-r--r--Hsbot/Irc/Command.hs59
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 ()
+