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
|
-- | Dispatches an input message
|
||||||
dispatchMessage :: BotMsg -> IrcBot ()
|
dispatchMessage :: BotMsg -> IrcBot ()
|
||||||
dispatchMessage (InputMsg inputMsg) = do
|
dispatchMessage (InputMsg inputMsg)
|
||||||
plugins <- gets botPlugins
|
| isPluginCommand = do
|
||||||
cmds <- gets botCommands
|
plugins <- gets botPlugins
|
||||||
if isPluginCommand --TODO : how to get rid of this if?
|
cmds <- gets botCommands
|
||||||
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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ()
|
||||||
|
|
Reference in a new issue