diff options
Diffstat (limited to '')
-rw-r--r-- | Hsbot/Plugin.hs | 45 |
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 |