diff options
author | Julien Dessaux | 2011-05-01 03:11:32 +0200 |
---|---|---|
committer | Julien Dessaux | 2011-05-01 03:28:28 +0200 |
commit | c497b24700eeea4269e4d76559e8023284a0a213 (patch) | |
tree | 9d09a769232cb93e3987f999f12a3203b81443b1 /Hsbot/Plugin.hs | |
parent | Improved message utilities. (diff) | |
download | hsbot-c497b24700eeea4269e4d76559e8023284a0a213.tar.gz hsbot-c497b24700eeea4269e4d76559e8023284a0a213.tar.bz2 hsbot-c497b24700eeea4269e4d76559e8023284a0a213.zip |
Added plugin loading, and the most basic hook capability.
Diffstat (limited to 'Hsbot/Plugin.hs')
-rw-r--r-- | Hsbot/Plugin.hs | 38 |
1 files changed, 38 insertions, 0 deletions
diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs new file mode 100644 index 0000000..3191a15 --- /dev/null +++ b/Hsbot/Plugin.hs @@ -0,0 +1,38 @@ +module Hsbot.Plugin + ( loadPlugin + ) where + +import Control.Concurrent +import qualified Data.Map as M +import Control.Monad.Reader +import Control.Monad.State +import System.Log.Logger + +import Hsbot.Types + +loadPlugin :: PluginId -> Bot (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 } + where + storeFinalState :: MVar PluginState -> PluginState -> Env IO () + storeFinalState finalStateMVar finalState = liftIO $ putMVar finalStateMVar finalState + |