Archived
1
0
Fork 0

Added an utility function to correctly answer a message we receive (aka /msg)

This commit is contained in:
Julien Dessaux 2010-04-22 19:42:53 +02:00
parent d922240e9a
commit 727adadc28
3 changed files with 21 additions and 12 deletions

View file

@ -38,16 +38,16 @@ unregisterCommand cmd pluginName' = do
-- | Dispatches an input message -- | Dispatches an input message
dispatchMessage :: BotMsg -> IrcBot () dispatchMessage :: BotMsg -> IrcBot ()
dispatchMessage (InputMsg inputMsg) = do dispatchMessage (InputMsg inputMsg)
| isPluginCommand = do
plugins <- gets botPlugins plugins <- gets botPlugins
cmds <- gets botCommands cmds <- gets botCommands
if isPluginCommand --TODO : how to get rid of this if?
then
let key = tail $ head $ words getMsgContent let key = tail $ head $ words getMsgContent
pluginNames = fromMaybe [] $ M.lookup key cmds pluginNames = fromMaybe [] $ M.lookup key cmds
plugins' = fromMaybe [] $ mapM (flip M.lookup plugins) pluginNames plugins' = fromMaybe [] $ mapM (flip M.lookup plugins) pluginNames
in mapM_ (sendRunCommand $ tail getMsgContent) plugins' mapM_ (sendRunCommand $ tail getMsgContent) plugins'
else | otherwise = do
plugins <- gets botPlugins
mapM_ (sendToPlugin (InputMsg inputMsg)) (M.elems plugins) mapM_ (sendToPlugin (InputMsg inputMsg)) (M.elems plugins)
where where
isPluginCommand :: Bool isPluginCommand :: Bool

View file

@ -1,5 +1,6 @@
module Hsbot.IRCPlugin module Hsbot.IRCPlugin
( readMsg ( answerMsg
, readMsg
, sendCommand , sendCommand
, sendCommandWithRequest , sendCommandWithRequest
, sendRegisterCommand , sendRegisterCommand
@ -9,6 +10,7 @@ module Hsbot.IRCPlugin
import Control.Concurrent.Chan import Control.Concurrent.Chan
import Control.Monad.State import Control.Monad.State
import Data.Maybe(fromMaybe)
import Hsbot.Types import Hsbot.Types
@ -24,6 +26,15 @@ writeMsg botMsg = do
serverChan <- gets instanceServerChan serverChan <- gets instanceServerChan
liftIO $ writeChan serverChan $ botMsg 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 -- | Commands management
sendCommand :: String -> String -> String -> IrcPlugin () sendCommand :: String -> String -> String -> IrcPlugin ()
sendCommand cmd to params = sendCommandWithRequest cmd to params Nothing sendCommand cmd to params = sendCommandWithRequest cmd to params Nothing

View file

@ -28,9 +28,9 @@ run = forever $ do
where where
eval :: BotMsg -> IrcPlugin () eval :: BotMsg -> IrcPlugin ()
eval (InternalCmd intCmd) = do eval (InternalCmd intCmd) = do
let request = intCmdBotMsg intCmd
case intCmdCmd intCmd of case intCmdCmd intCmd of
"RUN" -> let stuff = words $ intCmdMsg intCmd "RUN" -> let stuff = words $ intCmdMsg intCmd
request = intCmdBotMsg intCmd
in case head stuff of in case head stuff of
"list" -> listPlugins request "list" -> listPlugins request
"load" -> loadPlugin $ tail stuff "load" -> loadPlugin $ tail stuff
@ -38,9 +38,7 @@ run = forever $ do
"unload" -> unloadPlugin $ tail stuff "unload" -> unloadPlugin $ tail stuff
_ -> lift $ trace $ show intCmd -- TODO : help message _ -> lift $ trace $ show intCmd -- TODO : help message
"ANSWER" -> let stuff = intCmdMsg intCmd "ANSWER" -> let stuff = intCmdMsg intCmd
request = intCmdBotMsg intCmd in answerMsg request ("Loaded plugins : " ++ stuff)
chanOrigin = head $ parameters (fromMaybe (IrcMsg Nothing "ARGH" []) request)
in writeMsg $ OutputMsg $ IrcMsg Nothing "PRIVMSG" [chanOrigin, "Loaded plugins : " ++ stuff]
_ -> lift $ trace $ show intCmd _ -> lift $ trace $ show intCmd
eval (InputMsg _) = return () eval (InputMsg _) = return ()
eval _ = return () eval _ = return ()