summaryrefslogtreecommitdiff
path: root/HsbotMaster/Hsbot/Plugin.hs
blob: 1493c7314acafac4608f3e7c1a6547d8e2417a53 (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
64
65
66
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 ()