summaryrefslogtreecommitdiff
path: root/Hsbot/Plugin.hs
diff options
context:
space:
mode:
authorJulien Dessaux2011-05-01 03:11:32 +0200
committerJulien Dessaux2011-05-01 03:28:28 +0200
commitc497b24700eeea4269e4d76559e8023284a0a213 (patch)
tree9d09a769232cb93e3987f999f12a3203b81443b1 /Hsbot/Plugin.hs
parentImproved message utilities. (diff)
downloadhsbot-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.hs38
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
+