diff options
author | Julien Dessaux | 2010-04-21 21:01:07 +0200 |
---|---|---|
committer | Julien Dessaux | 2010-04-21 22:37:06 +0200 |
commit | 455b18bc1044d8f4cfb0d99c19f9f38955d00d00 (patch) | |
tree | 72e82c5c0088b9b408bf6401d13402a96daeac99 | |
parent | Fixed several stuff. (diff) | |
download | hsbot-455b18bc1044d8f4cfb0d99c19f9f38955d00d00.tar.gz hsbot-455b18bc1044d8f4cfb0d99c19f9f38955d00d00.tar.bz2 hsbot-455b18bc1044d8f4cfb0d99c19f9f38955d00d00.zip |
Removed all the dynamic module loading stuff.
-rw-r--r-- | Config.hs | 2 | ||||
-rw-r--r-- | Hsbot.hs | 6 | ||||
-rw-r--r-- | Hsbot/Command.hs | 5 | ||||
-rw-r--r-- | Hsbot/Main.hs | 8 | ||||
-rw-r--r-- | Hsbot/Plugin.hs | 62 | ||||
-rw-r--r-- | Hsbot/Types.hs | 4 | ||||
-rw-r--r-- | TODO | 2 |
7 files changed, 31 insertions, 58 deletions
@@ -9,7 +9,7 @@ import Hsbot.Types -- | Imported plugins goes there defaultPlugins :: [String] -defaultPlugins = [ "Ping", "Core" ] +defaultPlugins = [] -- | User server localhost :: IrcServer @@ -9,6 +9,9 @@ module Hsbot , module Hsbot.Plugin , module Hsbot.Types , module Hsbot.Utils + , module Plugins.Core + , module Plugins.Ping + , module Plugins.Quote ) where import Config @@ -21,4 +24,7 @@ import Hsbot.Main import Hsbot.Plugin import Hsbot.Types import Hsbot.Utils +import Plugins.Core +import Plugins.Ping +import Plugins.Quote 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 @@ -1,8 +1,8 @@ :julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif +* Add the IrcMsg as an optional parameter for an internal command * Solve the catching that never happen in main * throwto exception to main thread -* list plugins * write a safe reload : try reload before unloading * discard all trace with a color param and replace those with functions info/warn/error/debug |