summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--Hsbot/Main.hs6
-rw-r--r--Hsbot/Plugin.hs9
-rw-r--r--Makefile2
-rw-r--r--Plugins/Core.hs15
-rw-r--r--Plugins/Ping.hs4
-rw-r--r--Plugins/Quote.hs21
-rw-r--r--TODO3
7 files changed, 27 insertions, 33 deletions
diff --git a/Hsbot/Main.hs b/Hsbot/Main.hs
index ea1bf16..592fefa 100644
--- a/Hsbot/Main.hs
+++ b/Hsbot/Main.hs
@@ -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 ()
diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs
index d75fe8e..63d8256 100644
--- a/Hsbot/Plugin.hs
+++ b/Hsbot/Plugin.hs
@@ -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 ()
diff --git a/Makefile b/Makefile
index d778930..bc49b08 100644
--- a/Makefile
+++ b/Makefile
@@ -1,5 +1,5 @@
all:
- ghc --make -Wall -O2 Main.hs -o hsbot
+ ghc --make -Wall -O2 Main.hs -o hsbot -XScopedTypeVariables
clean:
- rm hsbot
diff --git a/Plugins/Core.hs b/Plugins/Core.hs
index 99abfc0..b05e9aa 100644
--- a/Plugins/Core.hs
+++ b/Plugins/Core.hs
@@ -3,7 +3,9 @@ module Plugins.Core
) where
import Control.Concurrent.Chan
+import Control.Exception
import Control.Monad.State
+import Prelude hiding (catch)
import Hsbot.IRCPlugin
import Hsbot.Types
@@ -13,18 +15,13 @@ import Hsbot.Utils
mainCore :: Chan BotMsg -> Chan BotMsg -> IO ()
mainCore serverChan chan = do
let plugin = PluginInstance "Core" serverChan chan
- (runStateT run plugin) `catch` (const $ return ((), plugin))
- return ()
+ evalStateT (mapM_ sendRegisterCommand ["list", "load", "reload", "unload"]) plugin
+ (execStateT run plugin) `catch` (\(ex :: AsyncException) -> return plugin)
+ evalStateT (mapM_ sendUnregisterCommand ["list", "load", "reload", "unload"]) plugin
-- | The IrcPlugin monad main function
run :: IrcPlugin ()
-run = do
- mapM_ sendRegisterCommand ["load", "reload", "unload"]
- runPlugin
- mapM_ sendUnregisterCommand ["load", "reload", "unload"]
-
-runPlugin :: IrcPlugin ()
-runPlugin = forever $ do
+run = forever $ do
msg <- readMsg
eval msg
where
diff --git a/Plugins/Ping.hs b/Plugins/Ping.hs
index 6102fe4..8258bcf 100644
--- a/Plugins/Ping.hs
+++ b/Plugins/Ping.hs
@@ -3,7 +3,9 @@ module Plugins.Ping
) where
import Control.Concurrent.Chan
+import Control.Exception
import Control.Monad.State
+import Prelude hiding (catch)
import Hsbot.IRCPlugin
import Hsbot.Types
@@ -12,7 +14,7 @@ import Hsbot.Types
mainPing :: Chan BotMsg -> Chan BotMsg -> IO ()
mainPing serverChan chan = do
let plugin = PluginInstance "Ping" serverChan chan
- (runStateT run plugin) `catch` (const $ return ((), plugin))
+ (execStateT run plugin) `catch` (\(ex :: AsyncException) -> return plugin)
return ()
-- | The IrcPlugin monad main function
diff --git a/Plugins/Quote.hs b/Plugins/Quote.hs
index fd36e11..df16006 100644
--- a/Plugins/Quote.hs
+++ b/Plugins/Quote.hs
@@ -3,7 +3,9 @@ module Plugins.Quote
) where
import Control.Concurrent.Chan
+import Control.Exception
import Control.Monad.State
+import Prelude hiding (catch)
import System.Time (ClockTime)
import Hsbot.IRCPlugin
@@ -28,24 +30,13 @@ type QuoteBot a = StateT QuoteDB IO a
mainQuote :: Chan BotMsg -> Chan BotMsg -> IO ()
mainQuote serverChan chan = do
let plugin = PluginInstance "Quote" serverChan chan
- plugin' <- (execStateT run plugin) `catch` (const $ return plugin)
- putStrLn "graou"
- evalStateT stop plugin'
+ evalStateT (mapM_ sendRegisterCommand ["quote"]) plugin
+ (execStateT run plugin) `catch` (\(ex :: AsyncException) -> return plugin)
+ evalStateT (mapM_ sendUnregisterCommand ["quote"]) plugin
-- | The IrcPlugin monad main function
run :: IrcPlugin ()
-run = do
- -- TODO : init quote handling (sqlite + structure to handle temporary stuff)
- sendRegisterCommand "quote"
- runPlugin
-
-stop :: IrcPlugin ()
-stop = do
- sendUnregisterCommand "quote"
- -- TODO : send cancel messages for all temporary stuff
-
-runPlugin :: IrcPlugin ()
-runPlugin = forever $ do
+run = forever $ do
msg <- readMsg
eval msg
where
diff --git a/TODO b/TODO
index c866e91..3a6c619 100644
--- a/TODO
+++ b/TODO
@@ -1,7 +1,8 @@
:julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif
-* fix unload plugins
+* throwto exception to main thread
* list plugins
+* write a safe reload : try reload before unloading
* discard all trace with a color param and replace those with functions info/warn/error/debug
* clean the plugin module