summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Config.hs2
-rw-r--r--Hsbot.hs6
-rw-r--r--Hsbot/Command.hs5
-rw-r--r--Hsbot/Main.hs8
-rw-r--r--Hsbot/Plugin.hs62
-rw-r--r--Hsbot/Types.hs4
-rw-r--r--TODO2
7 files changed, 31 insertions, 58 deletions
diff --git a/Config.hs b/Config.hs
index fd5619e..a483232 100644
--- a/Config.hs
+++ b/Config.hs
@@ -9,7 +9,7 @@ import Hsbot.Types
-- | Imported plugins goes there
defaultPlugins :: [String]
-defaultPlugins = [ "Ping", "Core" ]
+defaultPlugins = []
-- | User server
localhost :: IrcServer
diff --git a/Hsbot.hs b/Hsbot.hs
index 48b3224..a504784 100644
--- a/Hsbot.hs
+++ b/Hsbot.hs
@@ -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
diff --git a/TODO b/TODO
index 9575ac1..3aedb52 100644
--- a/TODO
+++ b/TODO
@@ -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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-14 17:13:01 +0000