From daea135424857594622573fa1a900b436d7ee0ae Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Sat, 29 May 2010 00:55:14 +0200
Subject: Implemented the clean killing of plugins' threads.

---
 Hsbot/Irc/Core.hs   | 17 +++++++++++------
 Hsbot/Irc/Plugin.hs | 22 +++++++++++++++-------
 Hsbot/Irc/Types.hs  |  3 ---
 3 files changed, 26 insertions(+), 16 deletions(-)

(limited to 'Hsbot/Irc')

diff --git a/Hsbot/Irc/Core.hs b/Hsbot/Irc/Core.hs
index 2fb8386..229fef8 100644
--- a/Hsbot/Irc/Core.hs
+++ b/Hsbot/Irc/Core.hs
@@ -3,7 +3,7 @@ module Hsbot.Irc.Core
     ) where
 
 import Control.Concurrent
-import Control.Exception (IOException, catch)
+import Control.Exception (AsyncException, Handler (..), IOException, catch, catches)
 import Control.Monad.State
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
@@ -34,7 +34,7 @@ startIrcbot config masterChan myChan = do
     putStrLn "[IrcBot] Spawning reader threads..."
     myOwnThreadId  <- myThreadId
     readerThreadId <- forkIO $ ircBotReader handle chan myOwnThreadId
-    masterReaderThreadId <- forkIO $ ircBotMasterReader masterChan chan
+    masterReaderThreadId <- forkIO $ ircBotMasterReader myChan chan
     putStrLn "[IrcBot] Initializing server connection..."
     let ircServerState = IrcServerState { ircServerId            = ircConfigAddress config
                                         , ircServerChannels      = []
@@ -46,18 +46,23 @@ startIrcbot config masterChan myChan = do
                                   , ircBotCommands             = M.empty
                                   , ircBotChan                 = chan
                                   , ircBotMasterChan           = masterChan
-                                  , ircBotMyChan               = myChan
                                   , ircBotServerState          = ircServerState
                                   , ircBotHandle               = handle
                                   , ircBotConfig               = config
-                                  , ircBotReaderThreadId       = readerThreadId
-                                  , ircBotMasterReaderThreadId = masterReaderThreadId
                                   , ircBotResumeData           = M.singleton "HANDLE" (show fd) }
     ircBotState' <- execStateT (initBotServerConnection config) ircBotState
     putStrLn "[IrcBot] Spawning plugins..."
     ircBotState'' <- execStateT spawnIrcPlugins ircBotState'
     putStrLn "[IrcBot] Entering Core loop... "
-    (evalStateT ircBotLoop ircBotState'') `catch` (\(_ :: IOException) -> return ())
+    ircBotState''' <- (execStateT ircBotLoop ircBotState'') `catches` [ Handler (\ (_ :: IOException) -> return (ircBotState''))
+                                                                      , Handler (\ (_ :: AsyncException) -> return (ircBotState'')) ]
+    putStrLn "[IrcBot] Killing reader threads..."
+    killThread readerThreadId
+    killThread masterReaderThreadId
+    putStrLn "[IrcBot] Killing active plugins... "
+    let resumeData = ircBotResumeData ircBotState'''
+        ircPlugins = read (fromMaybe [] (M.lookup "PLUGINS" resumeData)) :: [String]
+    evalStateT (mapM_ killIrcPlugin ircPlugins) ircBotState'''
     return ()
 
 --resumeIrcBot
diff --git a/Hsbot/Irc/Plugin.hs b/Hsbot/Irc/Plugin.hs
index d972db2..28026aa 100644
--- a/Hsbot/Irc/Plugin.hs
+++ b/Hsbot/Irc/Plugin.hs
@@ -1,6 +1,7 @@
 module Hsbot.Irc.Plugin
     ( IrcPlugin
     , IrcPluginState (..)
+    , killIrcPlugin
     , listPlugins
     , loadIrcPlugin
     , sendToPlugin
@@ -72,16 +73,23 @@ listPlugins originalRequest dest = do
 -- | Unloads a plugin
 unloadIrcPlugin :: String -> IrcBot ()
 unloadIrcPlugin name = do
+    killIrcPlugin name
     ircbot <- get
-    let oldPlugins    = ircBotPlugins ircbot
-        oldResumeData = ircBotResumeData ircbot
+    let oldResumeData = ircBotResumeData ircbot
+        newPlugins    = M.keys $ ircBotPlugins ircbot
+        newResumeData = M.insert "PLUGINS" (show newPlugins) oldResumeData
+    put $ ircbot { ircBotResumeData = newResumeData }
+
+-- | kills a plugin
+killIrcPlugin :: String -> IrcBot ()
+killIrcPlugin name = do
+    ircbot <- get
+    let oldPlugins = ircBotPlugins ircbot
     -- We check if the plugin exists
     case M.lookup name oldPlugins of
         Just (_, threadId) -> do
-            let newPlugins    = M.delete name oldPlugins
-                newResumeData = M.insert "PLUGINS" (show $ M.keys newPlugins) oldResumeData
+            let newPlugins = M.delete name oldPlugins
             liftIO $ throwTo threadId UserInterrupt
-            put $ ircbot { ircBotPlugins = newPlugins
-                         , ircBotResumeData = newResumeData }
-        Nothing     -> return ()
+            put $ ircbot { ircBotPlugins = newPlugins }
+        Nothing            -> return ()
 
diff --git a/Hsbot/Irc/Types.hs b/Hsbot/Irc/Types.hs
index c9be251..fe70ea4 100644
--- a/Hsbot/Irc/Types.hs
+++ b/Hsbot/Irc/Types.hs
@@ -26,12 +26,9 @@ data IrcBotState = IrcBotState
     , ircBotCommands             :: M.Map String [String]   -- Loaded plugins
     , ircBotChan                 :: Chan IrcBotMsg          -- The IrcBot's communication channel
     , ircBotMasterChan           :: Chan BotMsg             -- The Hsbot communication channel
-    , ircBotMyChan               :: Chan BotMsg             -- The Hsbot communication channel
     , ircBotServerState          :: IrcServerState          -- The state of the IrcServer
     , ircBotHandle               :: Handle                  -- The server's socket/handle
     , ircBotConfig               :: IrcConfig               -- The starting configuration
-    , ircBotReaderThreadId       :: ThreadId                -- the thread that process inputs from the socket
-    , ircBotMasterReaderThreadId :: ThreadId                -- the thread that process inputs from the master bot
     , ircBotResumeData           :: ResumeData              -- the necessary data to resume the bot's operations on reboot
     }
 
-- 
cgit v1.2.3