diff options
| -rw-r--r-- | Hsbot/Command.hs | 14 | ||||
| -rw-r--r-- | Hsbot/IRCPlugin.hs | 13 | ||||
| -rw-r--r-- | Plugins/Core.hs | 6 |
3 files changed, 21 insertions, 12 deletions
diff --git a/Hsbot/Command.hs b/Hsbot/Command.hs index ea372e4..711aa32 100644 --- a/Hsbot/Command.hs +++ b/Hsbot/Command.hs @@ -38,16 +38,16 @@ unregisterCommand cmd pluginName' = do -- | Dispatches an input message dispatchMessage :: BotMsg -> IrcBot () -dispatchMessage (InputMsg inputMsg) = do - plugins <- gets botPlugins - cmds <- gets botCommands - if isPluginCommand --TODO : how to get rid of this if? - then +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 - in mapM_ (sendRunCommand $ tail getMsgContent) plugins' - else + mapM_ (sendRunCommand $ tail getMsgContent) plugins' + | otherwise = do + plugins <- gets botPlugins mapM_ (sendToPlugin (InputMsg inputMsg)) (M.elems plugins) where isPluginCommand :: Bool diff --git a/Hsbot/IRCPlugin.hs b/Hsbot/IRCPlugin.hs index c32d24c..4707ce1 100644 --- a/Hsbot/IRCPlugin.hs +++ b/Hsbot/IRCPlugin.hs @@ -1,5 +1,6 @@ module Hsbot.IRCPlugin - ( readMsg + ( answerMsg + , readMsg , sendCommand , sendCommandWithRequest , sendRegisterCommand @@ -9,6 +10,7 @@ module Hsbot.IRCPlugin import Control.Concurrent.Chan import Control.Monad.State +import Data.Maybe(fromMaybe) import Hsbot.Types @@ -24,6 +26,15 @@ writeMsg botMsg = do serverChan <- gets instanceServerChan liftIO $ writeChan serverChan $ botMsg +answerMsg :: Maybe IrcMsg -> String -> IrcPlugin () +answerMsg request msg = do + let incoming = fromMaybe (IrcMsg Nothing "ARGH" []) request + chanOrigin = head $ parameters (incoming) + sender = takeWhile (/= '!') $ fromMaybe "ARGH" (prefix incoming) + case head chanOrigin of + '#' -> writeMsg $ OutputMsg $ IrcMsg Nothing "PRIVMSG" [chanOrigin, msg] + _ -> writeMsg $ OutputMsg $ IrcMsg Nothing "PRIVMSG" [sender, msg] + -- | Commands management sendCommand :: String -> String -> String -> IrcPlugin () sendCommand cmd to params = sendCommandWithRequest cmd to params Nothing diff --git a/Plugins/Core.hs b/Plugins/Core.hs index 64e0bf7..f6bd4ef 100644 --- a/Plugins/Core.hs +++ b/Plugins/Core.hs @@ -28,9 +28,9 @@ run = forever $ do where eval :: BotMsg -> IrcPlugin () eval (InternalCmd intCmd) = do + let request = intCmdBotMsg intCmd case intCmdCmd intCmd of "RUN" -> let stuff = words $ intCmdMsg intCmd - request = intCmdBotMsg intCmd in case head stuff of "list" -> listPlugins request "load" -> loadPlugin $ tail stuff @@ -38,9 +38,7 @@ run = forever $ do "unload" -> unloadPlugin $ tail stuff _ -> lift $ trace $ show intCmd -- TODO : help message "ANSWER" -> let stuff = intCmdMsg intCmd - request = intCmdBotMsg intCmd - chanOrigin = head $ parameters (fromMaybe (IrcMsg Nothing "ARGH" []) request) - in writeMsg $ OutputMsg $ IrcMsg Nothing "PRIVMSG" [chanOrigin, "Loaded plugins : " ++ stuff] + in answerMsg request ("Loaded plugins : " ++ stuff) _ -> lift $ trace $ show intCmd eval (InputMsg _) = return () eval _ = return () |