summaryrefslogtreecommitdiff
path: root/Hsbot
diff options
context:
space:
mode:
authorJulien Dessaux2010-04-21 21:01:07 +0200
committerJulien Dessaux2010-04-21 22:37:06 +0200
commit455b18bc1044d8f4cfb0d99c19f9f38955d00d00 (patch)
tree72e82c5c0088b9b408bf6401d13402a96daeac99 /Hsbot
parentFixed several stuff. (diff)
downloadhsbot-455b18bc1044d8f4cfb0d99c19f9f38955d00d00.tar.gz
hsbot-455b18bc1044d8f4cfb0d99c19f9f38955d00d00.tar.bz2
hsbot-455b18bc1044d8f4cfb0d99c19f9f38955d00d00.zip
Removed all the dynamic module loading stuff.
Diffstat (limited to 'Hsbot')
-rw-r--r--Hsbot/Command.hs5
-rw-r--r--Hsbot/Main.hs8
-rw-r--r--Hsbot/Plugin.hs62
-rw-r--r--Hsbot/Types.hs4
4 files changed, 23 insertions, 56 deletions
diff --git a/Hsbot/Command.hs b/Hsbot/Command.hs
index 3977a57..f42db98 100644
--- a/Hsbot/Command.hs
+++ b/Hsbot/Command.hs
@@ -77,12 +77,9 @@ processCoreCommand :: IntCmd -> IrcBot ()
processCoreCommand intCmd = do
let command' = intCmdCmd intCmd
case command' of
- "LOAD" -> loadPlugin $ intCmdMsg intCmd
- "RELOAD" -> reloadPlugin $ intCmdMsg intCmd
+ "LOAD" -> traceM $ inColor "hsbot has been compiled in static mode." [31]
"UNLOAD" -> unloadPlugin $ intCmdMsg intCmd
"REGISTER" -> registerCommand (intCmdMsg intCmd) (intCmdFrom intCmd)
"UNREGISTER" -> unregisterCommand (intCmdMsg intCmd) (intCmdFrom intCmd)
_ -> traceM $ inColor ("Invalid command : " ++ (show intCmd)) [31]
- bot' <- get
- traceM $ show bot'
diff --git a/Hsbot/Main.hs b/Hsbot/Main.hs
index 5bf03bf..82b643f 100644
--- a/Hsbot/Main.hs
+++ b/Hsbot/Main.hs
@@ -13,6 +13,10 @@ import Hsbot.IRC
import Hsbot.Plugin
import Hsbot.Types
+import Plugins.Core(mainCore)
+import Plugins.Ping(mainPing)
+import Plugins.Quote(mainQuote)
+
-- | Bot's main entry point
imain :: IO ()
imain = do
@@ -24,6 +28,8 @@ imain = do
run :: IrcBot ()
run = do
initServer
- mapM_ loadPlugin defaultPlugins
+ loadPlugin "Ping" mainPing
+ loadPlugin "Core" mainCore
+ loadPlugin "Quote" mainQuote
runServer
diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs
index 63d8256..34c6603 100644
--- a/Hsbot/Plugin.hs
+++ b/Hsbot/Plugin.hs
@@ -1,68 +1,35 @@
module Hsbot.Plugin
( loadPlugin
, sendToPlugin
- , reloadPlugin
, unloadPlugin
) where
import Control.Concurrent
-import Control.Concurrent.Chan
+import Control.Concurrent.Chan()
import Control.Exception
import Control.Monad.State
import qualified Data.Map as M
-import Data.Maybe
-import System.IO
-import System.Plugins
+import Data.Maybe()
+import System.IO()
import Hsbot.Types
import Hsbot.Utils
--- TODO : reload plugin, list plugins, etc
-
-- | Loads a plugin into an ircBot
-loadPlugin :: String -> IrcBot ()
-loadPlugin name = do
+loadPlugin :: String -> (Chan BotMsg -> Chan BotMsg -> IO ()) -> IrcBot ()
+loadPlugin name entryPoint = 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] -- or a wait, smthg like that?
- else do
- plugin <- liftIO $ effectivelyLoadPlugin name (botChannel bot)
- case plugin of
- Just plugin' -> do
- put $ bot { botPlugins = M.insert name plugin' oldPlugins}
- Nothing -> return ()
+ plugin <- liftIO $ effectivelyLoadPlugin name entryPoint (botChannel bot)
+ put $ bot { botPlugins = M.insert name plugin oldPlugins}
-- | Effectively try to load a plugin
-effectivelyLoadPlugin :: String -> Chan BotMsg -> IO (Maybe Plugin)
-effectivelyLoadPlugin name serverChan = do
- -- TODO : test if Plugins/ ++ name ++ .hs exists
- m <- liftIO $ makeAll ("Plugins/" ++ name ++ ".hs") ["-XScopedTypeVariables"]
- 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
-
--- | Reloads a plugin
--- TODO : make it a safe reload (compile before unloading)
-reloadPlugin :: String -> IrcBot ()
-reloadPlugin name = do
- unloadPlugin name
- loadPlugin name
+effectivelyLoadPlugin :: String -> (Chan BotMsg -> Chan BotMsg -> IO ()) -> Chan BotMsg -> IO (Plugin)
+effectivelyLoadPlugin name entryPoint serverChan = do
+ putStrLn $ inColor ("Loaded (static) plugin: " ++ name) [32]
+ chan <- newChan :: IO (Chan BotMsg)
+ threadId <- forkIO $ entryPoint serverChan chan
+ return $ Plugin name threadId chan
-- | Unloads a plugin
unloadPlugin :: String -> IrcBot ()
@@ -73,9 +40,8 @@ unloadPlugin name = do
Just plugin -> do
let newPlugins = M.delete name oldPlugins
liftIO $ throwTo (pluginThreadId plugin) UserInterrupt
- liftIO $ unloadAll $ pluginModule plugin
put $ bot { botPlugins = newPlugins }
- Nothing -> return ()
+ Nothing -> return ()
-- | Sends a msg to a plugin
sendToPlugin :: BotMsg -> Plugin -> IrcBot ()
diff --git a/Hsbot/Types.hs b/Hsbot/Types.hs
index acca137..6b85af5 100644
--- a/Hsbot/Types.hs
+++ b/Hsbot/Types.hs
@@ -18,7 +18,6 @@ import Control.Monad.State
import qualified Data.Map as M
import Network
import System.IO
-import System.Plugins
import System.Time (ClockTime)
-- | TODO : a monad for a channel, and a monad for a server, all together driven by a Bot?
@@ -102,13 +101,12 @@ data BotMsg = InputMsg IrcMsg | OutputMsg IrcMsg | InternalCmd IntCmd deriving (
-- | A plugin (core side)
data Plugin = Plugin
{ pluginName :: String -- The plugin's name
- , pluginModule :: Module -- The plugin himself
, pluginThreadId :: ThreadId -- The plugin thread
, pluginChannel :: Chan BotMsg -- The plugin channel
}
instance Show Plugin where
- show (Plugin name _ _ _) = show name
+ show (Plugin name _ _) = show name
-- | A IrcPlugin ("user" side)
data PluginInstance = PluginInstance