From bfc06f1ff188c9d7faa817034363a27e34eae15a Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Mon, 8 Feb 2010 00:11:46 +0100
Subject: Fixed the clean killing of plugin's threads, fixed exception
 management and cleaned plugins' main functions.

---
 Plugins/Core.hs  | 15 ++++++---------
 Plugins/Ping.hs  |  4 +++-
 Plugins/Quote.hs | 21 ++++++---------------
 3 files changed, 15 insertions(+), 25 deletions(-)

(limited to 'Plugins')

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
-- 
cgit v1.2.3