Archived
1
0
Fork 0

Fixed the clean killing of plugin's threads, fixed exception management and cleaned plugins' main functions.

This commit is contained in:
Julien Dessaux 2010-02-08 00:11:46 +01:00
parent 416460886d
commit bfc06f1ff1
7 changed files with 27 additions and 33 deletions

View file

@ -2,7 +2,9 @@ module Hsbot.Main
( imain
) where
import Control.Exception
import Control.Monad.State
import Prelude hiding (catch)
import System.IO
import Config
@ -15,8 +17,8 @@ import Hsbot.Types
imain :: IO ()
imain = do
bot <- connectServer $ ircServer config
bot' <- (execStateT run bot) `catch` (const $ return bot)
evalStateT disconnectServer bot'
(execStateT run bot) `catch` (\(ex :: IOException) -> return bot)
evalStateT disconnectServer bot
-- | The Bot monad main function
run :: IrcBot ()

View file

@ -7,9 +7,10 @@ module Hsbot.Plugin
import Control.Concurrent
import Control.Concurrent.Chan
import Control.Exception.Extensible
import Control.Exception
import Control.Monad.State
import qualified Data.Map as M
import Data.Maybe
import System.IO
import System.Plugins
@ -36,7 +37,7 @@ loadPlugin name = do
effectivelyLoadPlugin :: String -> Chan BotMsg -> IO (Maybe Plugin)
effectivelyLoadPlugin name serverChan = do
-- TODO : test if Plugins/ ++ name ++ .hs exists
m <- liftIO $ makeAll ("Plugins/" ++ name ++ ".hs") []
m <- liftIO $ makeAll ("Plugins/" ++ name ++ ".hs") ["-XScopedTypeVariables"]
plugin <- case m of
MakeSuccess _ _ -> do
ldstat <- load_ ("Plugins/" ++ name ++ ".o") [".","Hsbot","Hsbot/Plugins"] ("main" ++ name)
@ -57,6 +58,7 @@ effectivelyLoadPlugin name serverChan = do
return plugin
-- | Reloads a plugin
-- TODO : make it a safe reload (compile before unloading)
reloadPlugin :: String -> IrcBot ()
reloadPlugin name = do
unloadPlugin name
@ -70,8 +72,7 @@ unloadPlugin name = do
case M.lookup name oldPlugins of
Just plugin -> do
let newPlugins = M.delete name oldPlugins
liftIO $ throwTo (pluginThreadId plugin) UserInterrupt -- TODO : fix this!
--sendToPlugin (InternalCmd $ IntCmd "STOP" "CORE" name "") plugin
liftIO $ throwTo (pluginThreadId plugin) UserInterrupt
liftIO $ unloadAll $ pluginModule plugin
put $ bot { botPlugins = newPlugins }
Nothing -> return ()