From 11c2c16835b3e8368be77ccc5b7ddf949021eccd Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Sat, 3 Jul 2010 21:26:00 +0200
Subject: Moved files around as a preliminary for architectural changes.

---
 HsbotMaster/Hsbot/Plugin.hs | 67 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 67 insertions(+)
 create mode 100644 HsbotMaster/Hsbot/Plugin.hs

(limited to 'HsbotMaster/Hsbot/Plugin.hs')

diff --git a/HsbotMaster/Hsbot/Plugin.hs b/HsbotMaster/Hsbot/Plugin.hs
new file mode 100644
index 0000000..1493c73
--- /dev/null
+++ b/HsbotMaster/Hsbot/Plugin.hs
@@ -0,0 +1,67 @@
+module Hsbot.Plugin
+    ( killPlugin
+    , spawnPlugins
+    , spawnPlugin
+    , unloadPlugin
+    ) where
+
+import Control.Concurrent (forkIO)
+import Control.Concurrent.Chan
+import Control.Concurrent.MVar
+import Control.Exception
+import Control.Monad.State
+import qualified Data.Map as M
+import Data.Maybe (fromMaybe)
+import Prelude hiding (catch)
+
+import Hsbot.Config
+import Hsbot.Irc.Config
+import Hsbot.Irc.Core
+import Hsbot.Types
+
+-- | spawns plugins
+spawnPlugins :: Bot ()
+spawnPlugins = do
+    config <- gets botConfig
+    mapM_ (spawnPlugin) config
+
+-- | spawns a single plugin
+spawnPlugin :: BotConfig -> Bot ()
+spawnPlugin (IrcBotConfig ircConfig) = do
+    bot <- get
+    let mvar = botResumeData bot
+        name = ircConfigName ircConfig
+    resumeData <- liftIO $ takeMVar mvar
+    let pluginResumeData = fromMaybe M.empty $ M.lookup name resumeData
+        chan = botChan bot
+    pchan <- liftIO (newChan :: IO (Chan BotMsg))
+    pluginMVar <- liftIO newEmptyMVar
+    threadId <- liftIO . forkIO $ finally (startIrcbot ircConfig chan pchan (Just $ show pluginResumeData)) (putMVar pluginMVar ())
+    let plugin  = PluginState { pluginName    = name
+                              , pluginChan    = pchan
+                              , pluginHandles = M.empty }
+        plugins = botPlugins bot
+    put $ bot { botPlugins = M.insert (pluginName plugin) (plugin, pluginMVar, threadId) plugins }
+    liftIO . putMVar mvar $ M.insert name pluginResumeData resumeData
+
+-- | Unloads a plugin
+unloadPlugin :: String -> Bot ()
+unloadPlugin name = do
+    killPlugin name
+    resumeData <- gets botResumeData
+    liftIO $ modifyMVar_ resumeData (\oldData -> return $ M.delete name oldData)
+
+-- | kills a plugin
+killPlugin :: String -> Bot ()
+killPlugin name = do
+    bot <- get
+    let oldPlugins = botPlugins bot
+    -- We check if the plugin exists
+    case M.lookup name oldPlugins of
+        Just (_, mvar, threadId) -> do
+            let newPlugins = M.delete name oldPlugins
+            liftIO $ throwTo threadId UserInterrupt
+            put $ bot { botPlugins = newPlugins }
+            liftIO $ takeMVar mvar
+        Nothing            -> return ()
+
-- 
cgit v1.2.3