summaryrefslogtreecommitdiff
path: root/Hsbot/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/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 '')
-rw-r--r--Hsbot/Command.hs87
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]
-