Hsbot/Plugin.hs


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

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 -> Env IO ()
loadPlugin pId = do
    botMVar <- asks envBotState
    liftIO (takeMVar botMVar) >>= execStateT effectivelyLoadPlugin >>= liftIO . putMVar botMVar
  where
    effectivelyLoadPlugin :: Bot (Env IO) ()
    effectivelyLoadPlugin = 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 }
        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 }
    storeFinalState :: MVar PluginState -> PluginState -> Env IO ()
    storeFinalState finalStateMVar finalState = liftIO $ putMVar finalStateMVar finalState