blob: 7d4f0ca647b19de5514a54cc3e8e5fcefb603463 (
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
|
module Hsbot.Plugin
( loadPlugin
, sendToPlugin
) where
import Control.Concurrent
import Control.Concurrent.Chan
import Control.Monad.State
import qualified Data.Map as M
import System.IO
import System.Plugins
import Hsbot.Types
import Hsbot.Utils
-- TODO : unload plugin, reload plugin, list plugins, etc
-- | Loads a plugin into an ircBot
loadPlugin :: String -> IrcBot ()
loadPlugin name = do
bot <- get
let oldPlugins = botPlugins bot
if name `M.member` oldPlugins
then traceM $ inColor ("Can't load plugin \"" ++ name ++ "\", this identifier has already been registered.") [31]
else do
plugin <- liftIO $ effectivelyLoadPlugin name (botChannel bot)
case plugin of
Just plugin' -> do
put $ bot { botPlugins = M.insert name plugin' oldPlugins}
Nothing -> return ()
-- | Effectively try to load a plugin
effectivelyLoadPlugin :: String -> Chan BotMsg -> IO (Maybe Plugin)
effectivelyLoadPlugin name serverChan = do
-- TODO : test if Plugins/ ++ name ++ .hs exists
-- Just load, do not compile if .o already present
m <- liftIO $ makeAll ("Plugins/" ++ name ++ ".hs") []
plugin <- case m of
MakeSuccess _ _ -> do
ldstat <- load_ ("Plugins/" ++ name ++ ".o") [".","Hsbot","Hsbot/Plugins"] ("main" ++ name)
case ldstat of
LoadSuccess v entryPoint -> do
putStrLn $ inColor ("Loaded plugin: " ++ name) [32]
chan <- newChan :: IO (Chan BotMsg)
threadId <- forkIO $ entryPoint serverChan chan
return $ Just (Plugin name v threadId chan)
LoadFailure e -> do
putStrLn $ inColor ("Couldn't load plugin: " ++ name) [31]
mapM_ putStrLn e
return Nothing
MakeFailure e -> do
putStrLn $ inColor ("FATAL: Couldn't compile plugin: " ++ name) [31]
mapM_ putStrLn e
return Nothing
return plugin
-- | Sends a msg to a plugin
sendToPlugin :: BotMsg -> Plugin -> IrcBot ()
sendToPlugin msg plugin = do
let chan = pluginChannel plugin
liftIO $ writeChan chan msg
|
