Added an utility function to correctly answer a message we receive (aka /msg)
This commit is contained in:
parent
d922240e9a
commit
727adadc28
3 changed files with 21 additions and 12 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ()
|
||||
|
|
Reference in a new issue