blob: 3191a15b5bae1c12f2eaea64daeb3ef1c4360e32 (
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
|
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
|