diff options
author | Julien Dessaux | 2010-07-03 21:26:00 +0200 |
---|---|---|
committer | Julien Dessaux | 2010-07-03 22:40:17 +0200 |
commit | 11c2c16835b3e8368be77ccc5b7ddf949021eccd (patch) | |
tree | 7733132ee370335156219ff6eb4f0ef2dbd1c8ff /HsbotMaster/Hsbot/Plugin.hs | |
parent | Wrote most of the resume code for the core and the irc plugin. (diff) | |
download | hsbot-11c2c16835b3e8368be77ccc5b7ddf949021eccd.tar.gz hsbot-11c2c16835b3e8368be77ccc5b7ddf949021eccd.tar.bz2 hsbot-11c2c16835b3e8368be77ccc5b7ddf949021eccd.zip |
Moved files around as a preliminary for architectural changes.
Diffstat (limited to 'HsbotMaster/Hsbot/Plugin.hs')
-rw-r--r-- | HsbotMaster/Hsbot/Plugin.hs | 67 |
1 files changed, 67 insertions, 0 deletions
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 () + |