Changed the way I handled the Bot monad for more concurrency.

1 files changed, 24 insertions, 21 deletions

diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs
index 3191a15..6f14413 100644
--- a/Hsbot/Plugin.hs
+++ b/Hsbot/Plugin.hs
@@ -10,29 +10,32 @@ import System.Log.Logger
 
 import Hsbot.Types
 
-loadPlugin :: PluginId -> Bot (Env IO) ()
+loadPlugin :: PluginId -> Env IO ()
 loadPlugin pId = do
-    bot <- get
-    chan <- liftIO (newChan :: IO (Chan Message))
-    master <- lift $ asks envChan
-    let name = pluginName pId
-        loop = pluginEp pId
-        oldPlugins = botPlugins bot
-        pState = PluginState { pluginId     = pId
-                             , pluginChan   = chan
-                             , pluginMaster = master }
-    -- We check for unicity
-    case M.lookup name oldPlugins of
-        Just _  -> liftIO . warningM "Hsbot.Core.LoadPlugin" $ "Not loading already loaded plugin : " ++ name
-        Nothing -> do
-            liftIO . infoM "Hsbot.Core.LoadPlugin" $ "Loading plugin : " ++ name
-            env <- lift ask
-            finalStateMVar <- liftIO newEmptyMVar
-            threadId <- liftIO . forkIO $ runReaderT (execStateT loop pState >>= storeFinalState finalStateMVar) env
-            let newPlugins = M.insert name (pState, finalStateMVar, threadId) oldPlugins
-            put $ bot { botPlugins = newPlugins
-                      , botHooks   = chan : botHooks bot }
+    botMVar <- asks envBotState
+    (liftIO $ takeMVar botMVar) >>= execStateT effectivelyLoadPlugin >>= liftIO . putMVar botMVar
   where
+    effectivelyLoadPlugin :: Bot (Env IO) ()
+    effectivelyLoadPlugin = do
+        bot <- get
+        chan <- liftIO (newChan :: IO (Chan Message))
+        master <- lift $ asks envChan
+        let name = pluginName pId
+            loop = pluginEp pId
+            oldPlugins = botPlugins bot
+            pState = PluginState { pluginId     = pId
+                                 , pluginChan   = chan
+                                 , pluginMaster = master }
+        case M.lookup name oldPlugins of
+            Just _  -> liftIO . warningM "Hsbot.Core.LoadPlugin" $ "Not loading already loaded plugin : " ++ name
+            Nothing -> do
+                liftIO . infoM "Hsbot.Core.LoadPlugin" $ "Loading plugin : " ++ name
+                env <- lift ask
+                finalStateMVar <- liftIO newEmptyMVar
+                threadId <- liftIO . forkIO $ runReaderT (execStateT loop pState >>= storeFinalState finalStateMVar) env
+                let newPlugins = M.insert name (pState, finalStateMVar, threadId) oldPlugins
+                put $ bot { botPlugins = newPlugins
+                          , botHooks   = chan : botHooks bot }
     storeFinalState :: MVar PluginState -> PluginState -> Env IO ()
     storeFinalState finalStateMVar finalState = liftIO $ putMVar finalStateMVar finalState