summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--Hsbot/Command.hs14
-rw-r--r--Hsbot/IRCPlugin.hs13
-rw-r--r--Plugins/Core.hs6
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 ()