From 455b18bc1044d8f4cfb0d99c19f9f38955d00d00 Mon Sep 17 00:00:00 2001 From: Julien Dessaux Date: Wed, 21 Apr 2010 21:01:07 +0200 Subject: Removed all the dynamic module loading stuff. --- Hsbot/Command.hs | 5 +---- Hsbot/Main.hs | 8 +++++++- Hsbot/Plugin.hs | 62 +++++++++++++------------------------------------------- Hsbot/Types.hs | 4 +--- 4 files changed, 23 insertions(+), 56 deletions(-) (limited to 'Hsbot') 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 -- cgit v1.2.3