diff options
Diffstat (limited to 'Hsbot')
| -rw-r--r-- | Hsbot/Command.hs | 7 | ||||
| -rw-r--r-- | Hsbot/Core.hs | 12 | ||||
| -rw-r--r-- | Hsbot/IRCPlugin.hs | 1 | ||||
| -rw-r--r-- | Hsbot/Main.hs | 4 | ||||
| -rw-r--r-- | Hsbot/Plugin.hs | 20 | ||||
| -rw-r--r-- | Hsbot/Utils.hs | 8 |
6 files changed, 32 insertions, 20 deletions
diff --git a/Hsbot/Command.hs b/Hsbot/Command.hs index 054653d..76f1d04 100644 --- a/Hsbot/Command.hs +++ b/Hsbot/Command.hs @@ -67,7 +67,9 @@ processInternalCommand (InternalCmd intCmd) = do plugins <- gets botPlugins if intCmdTo intCmd == "CORE" then processCoreCommand intCmd - else sendToPlugin (InternalCmd intCmd) $ fromMaybe [] (M.lookup plugins (intCmdTo intCmd)) + else case M.lookup (intCmdTo intCmd) plugins of + Just plugin -> sendToPlugin (InternalCmd intCmd) plugin + Nothing -> errorM $ "Invalid destination in message : " ++ (show intCmd) processInternalCommand _ = return () -- | Processes a core command @@ -76,8 +78,11 @@ processCoreCommand intCmd = do let command' = intCmdCmd intCmd case command' of "LOAD" -> loadPlugin $ intCmdMsg intCmd + "RELOAD" -> reloadPlugin $ intCmdMsg intCmd "UNLOAD" -> unloadPlugin $ intCmdMsg intCmd "REGISTER" -> registerCommand (intCmdMsg intCmd) (intCmdFrom intCmd) "UNREGISTER" -> unregisterCommand (intCmdMsg intCmd) (intCmdFrom intCmd) _ -> traceM $ inColor ("Invalid command : " ++ (show intCmd)) [31] + bot' <- get + traceM $ show bot' diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs index 2de1507..a8f29ec 100644 --- a/Hsbot/Core.hs +++ b/Hsbot/Core.hs @@ -13,6 +13,7 @@ import System.IO import System.Time (getClockTime) import Hsbot.IRCParser +import Hsbot.Plugin import Hsbot.Types import Hsbot.Utils @@ -32,11 +33,12 @@ connectServer server = do return $ Bot server starttime handle [] M.empty chan threadId M.empty -- | Disconnect from the server -disconnectServer :: Bot -> IO () -- IO Bot ? -disconnectServer bot = do - killThread $ readerThreadId bot - mapM_ (killThread . pluginThreadId . snd) (M.toList $ botPlugins bot) - hClose $ botHandle bot +disconnectServer :: IrcBot () +disconnectServer = do + bot <- get + liftIO $ killThread $ readerThreadId bot + mapM_ unloadPlugin (M.keys $ botPlugins bot) + liftIO $ hClose $ botHandle bot return () -- | Socket reading loop diff --git a/Hsbot/IRCPlugin.hs b/Hsbot/IRCPlugin.hs index 8c5eb86..d4dcb82 100644 --- a/Hsbot/IRCPlugin.hs +++ b/Hsbot/IRCPlugin.hs @@ -1,5 +1,6 @@ module Hsbot.IRCPlugin ( readMsg + , sendCommand , sendRegisterCommand , sendUnregisterCommand , writeMsg diff --git a/Hsbot/Main.hs b/Hsbot/Main.hs index c73a2e5..ea1bf16 100644 --- a/Hsbot/Main.hs +++ b/Hsbot/Main.hs @@ -15,8 +15,8 @@ import Hsbot.Types imain :: IO () imain = do bot <- connectServer $ ircServer config - (runStateT run bot) `catch` (const $ return ((), bot)) - disconnectServer bot + bot' <- (execStateT run bot) `catch` (const $ return bot) + evalStateT disconnectServer bot' -- | The Bot monad main function run :: IrcBot () diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs index e6f425a..d75fe8e 100644 --- a/Hsbot/Plugin.hs +++ b/Hsbot/Plugin.hs @@ -1,10 +1,13 @@ module Hsbot.Plugin ( loadPlugin , sendToPlugin + , reloadPlugin + , unloadPlugin ) where import Control.Concurrent import Control.Concurrent.Chan +import Control.Exception.Extensible import Control.Monad.State import qualified Data.Map as M import System.IO @@ -53,6 +56,12 @@ effectivelyLoadPlugin name serverChan = do return Nothing return plugin +-- | Reloads a plugin +reloadPlugin :: String -> IrcBot () +reloadPlugin name = do + unloadPlugin name + loadPlugin name + -- | Unloads a plugin unloadPlugin :: String -> IrcBot () unloadPlugin name = do @@ -61,17 +70,12 @@ unloadPlugin name = do case M.lookup name oldPlugins of Just plugin -> do let newPlugins = M.delete name oldPlugins - liftIO $ killPlugin plugin -- TODO : forkIO to get this asynchronous and non blocking - -- or let's see if closing one's chan kills him. - unloadAll $ pluginModule $ M.lookup name oldPlugins + liftIO $ throwTo (pluginThreadId plugin) UserInterrupt -- TODO : fix this! + --sendToPlugin (InternalCmd $ IntCmd "STOP" "CORE" name "") plugin + liftIO $ unloadAll $ pluginModule plugin put $ bot { botPlugins = newPlugins } Nothing -> return () --- | stop a plugin -killPlugin :: Plugin -> IO () -killPlugin plugin = do - -- TODO : send stop, sleep and kill thread (if necessary) and remove its commands - -- | Sends a msg to a plugin sendToPlugin :: BotMsg -> Plugin -> IrcBot () sendToPlugin msg plugin = do diff --git a/Hsbot/Utils.hs b/Hsbot/Utils.hs index b84b028..a58fd0c 100644 --- a/Hsbot/Utils.hs +++ b/Hsbot/Utils.hs @@ -34,9 +34,9 @@ traceM :: String -> IrcBot () traceM msg = liftIO $ trace msg -- | Logs an error message -error :: String -> IO () -error msg = trace $ inColor msg [31] +traceRed :: String -> IO () +traceRed msg = trace $ inColor msg [31] -errorM :: String -> a () -error msg = liftIO $ error msg +errorM :: String -> IrcBot () +errorM msg = liftIO $ traceRed msg |