diff options
author | Julien Dessaux | 2010-04-22 00:05:35 +0200 |
---|---|---|
committer | Julien Dessaux | 2010-04-22 00:10:13 +0200 |
commit | d922240e9a28680d48014604576620d7fc5aa605 (patch) | |
tree | 60185f299eebb04d8da9b79e9afd011d6147e411 /Hsbot | |
parent | Make the main thread exit cleanly in case of connection loss. (diff) | |
download | hsbot-d922240e9a28680d48014604576620d7fc5aa605.tar.gz hsbot-d922240e9a28680d48014604576620d7fc5aa605.tar.bz2 hsbot-d922240e9a28680d48014604576620d7fc5aa605.zip |
Wrote the list plugin command.
Diffstat (limited to 'Hsbot')
-rw-r--r-- | Hsbot/Command.hs | 2 | ||||
-rw-r--r-- | Hsbot/IRCParser.hs | 4 | ||||
-rw-r--r-- | Hsbot/IRCPlugin.hs | 8 | ||||
-rw-r--r-- | Hsbot/Plugin.hs | 12 |
4 files changed, 21 insertions, 5 deletions
diff --git a/Hsbot/Command.hs b/Hsbot/Command.hs index 1eaee82..ea372e4 100644 --- a/Hsbot/Command.hs +++ b/Hsbot/Command.hs @@ -76,7 +76,9 @@ processInternalCommand _ = return () processCoreCommand :: IntCmd -> IrcBot () processCoreCommand intCmd = do let command' = intCmdCmd intCmd + originalRequest = intCmdBotMsg intCmd case command' of + "LIST" -> listPlugins originalRequest (intCmdFrom intCmd) "LOAD" -> traceM $ inColor "hsbot has been compiled in static mode." [31] "UNLOAD" -> unloadPlugin $ intCmdMsg intCmd "REGISTER" -> registerCommand (intCmdMsg intCmd) (intCmdFrom intCmd) diff --git a/Hsbot/IRCParser.hs b/Hsbot/IRCParser.hs index a5f2e41..263ac1f 100644 --- a/Hsbot/IRCParser.hs +++ b/Hsbot/IRCParser.hs @@ -18,8 +18,8 @@ pMsg = do pfx <- optionMaybe pPrefix cmd <- pCommand params <- many (char ' ' >> (pLongParam <|> pShortParam)) - --char '\r' - eof + char '\r' + --eof return $ IrcMsg pfx cmd params pPrefix :: ParsecT String u Identity [Char] diff --git a/Hsbot/IRCPlugin.hs b/Hsbot/IRCPlugin.hs index 568eb1d..c32d24c 100644 --- a/Hsbot/IRCPlugin.hs +++ b/Hsbot/IRCPlugin.hs @@ -1,6 +1,7 @@ module Hsbot.IRCPlugin ( readMsg , sendCommand + , sendCommandWithRequest , sendRegisterCommand , sendUnregisterCommand , writeMsg @@ -25,10 +26,13 @@ writeMsg botMsg = do -- | Commands management sendCommand :: String -> String -> String -> IrcPlugin () -sendCommand cmd to params = do +sendCommand cmd to params = sendCommandWithRequest cmd to params Nothing + +sendCommandWithRequest :: String -> String -> String -> Maybe IrcMsg -> IrcPlugin () +sendCommandWithRequest cmd to params originalRequest = do serverChan <- gets instanceServerChan from <- gets instanceName - liftIO $ writeChan serverChan $ InternalCmd $ IntCmd cmd from to params Nothing + liftIO $ writeChan serverChan $ InternalCmd $ IntCmd cmd from to params originalRequest sendRegisterCommand :: String -> IrcPlugin () sendRegisterCommand cmd = sendCommand "REGISTER" "CORE" cmd diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs index 34c6603..43ce0fb 100644 --- a/Hsbot/Plugin.hs +++ b/Hsbot/Plugin.hs @@ -1,5 +1,6 @@ module Hsbot.Plugin - ( loadPlugin + ( listPlugins + , loadPlugin , sendToPlugin , unloadPlugin ) where @@ -31,6 +32,15 @@ effectivelyLoadPlugin name entryPoint serverChan = do threadId <- forkIO $ entryPoint serverChan chan return $ Plugin name threadId chan +-- | Sends a list of loaded plugins +listPlugins :: Maybe IrcMsg -> String -> IrcBot () +listPlugins originalRequest dest = do + plugins <- gets botPlugins + let listing = unwords $ M.keys plugins + case M.lookup dest plugins of + Just plugin -> sendToPlugin (InternalCmd $ IntCmd "ANSWER" "CORE" dest listing originalRequest) plugin + Nothing -> return () + -- | Unloads a plugin unloadPlugin :: String -> IrcBot () unloadPlugin name = do |