blob: 3feffa86858a416ac0a1da4900327d8e8d44af0b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
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 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 chan = botChan bot
pchan <- liftIO (newChan :: IO (Chan BotMsg))
mvar <- liftIO newEmptyMVar
threadId <- liftIO . forkIO $ finally (startIrcbot ircConfig chan pchan) (putMVar mvar ())
let plugin = PluginState { pluginName = ircConfigName ircConfig
, pluginChan = pchan
, pluginHandles = M.empty }
plugins = botPlugins bot
put $ bot { botPlugins = M.insert (pluginName plugin) (plugin, mvar, threadId) plugins }
resumeData <- gets botResumeData
liftIO $ modifyMVar_ resumeData (\oldData -> return $ M.insert (ircConfigName ircConfig) M.empty oldData)
-- | 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 ()
|
