summaryrefslogtreecommitdiff
path: root/Plugins
diff options
context:
space:
mode:
authorJulien Dessaux2010-02-08 00:11:46 +0100
committerJulien Dessaux2010-02-08 00:16:02 +0100
commitbfc06f1ff188c9d7faa817034363a27e34eae15a (patch)
treeb775c8401982544b273da8a22e1c28854eac58d5 /Plugins
parentContinue rewriting, found a problem in the way I kill plugins. (diff)
downloadhsbot-bfc06f1ff188c9d7faa817034363a27e34eae15a.tar.gz
hsbot-bfc06f1ff188c9d7faa817034363a27e34eae15a.tar.bz2
hsbot-bfc06f1ff188c9d7faa817034363a27e34eae15a.zip
Fixed the clean killing of plugin's threads, fixed exception management and cleaned plugins' main functions.
Diffstat (limited to 'Plugins')
-rw-r--r--Plugins/Core.hs15
-rw-r--r--Plugins/Ping.hs4
-rw-r--r--Plugins/Quote.hs21
3 files changed, 15 insertions, 25 deletions
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