From 738ad9e9bbbefb43a7889a458ff1c326a324eb9a Mon Sep 17 00:00:00 2001 From: Julien Dessaux Date: Sun, 16 May 2010 17:58:38 +0200 Subject: Removed thread ids from plugins data structure. --- Hsbot/Core.hs | 18 ++++++++++-------- Hsbot/Irc/Command.hs | 4 ++-- Hsbot/Irc/Core.hs | 13 ++++++++----- Hsbot/Irc/Plugin.hs | 15 +++++++-------- Hsbot/Irc/Plugin/Core.hs | 4 +--- Hsbot/Irc/Plugin/Dummy.hs | 3 --- Hsbot/Irc/Plugin/Ping.hs | 3 --- Hsbot/Irc/Plugin/Quote.hs | 3 --- Hsbot/Irc/PluginCommons.hs | 1 - Hsbot/Irc/Types.hs | 18 +++++++++--------- Hsbot/Plugin.hs | 1 - 11 files changed, 37 insertions(+), 46 deletions(-) (limited to 'Hsbot') diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs index cae873b..772a31a 100644 --- a/Hsbot/Core.hs +++ b/Hsbot/Core.hs @@ -13,7 +13,7 @@ import System.IO() import Hsbot.Config import Hsbot.Irc.Config -import Hsbot.Irc.Core (ircbot) +import Hsbot.Irc.Core import Hsbot.Message import Hsbot.Plugin @@ -22,10 +22,10 @@ type Bot = StateT BotState IO -- | An Hsbot state data BotState = BotState - { botStartTime :: UTCTime -- the bot's uptime - , botPlugins :: M.Map String PluginState -- Loaded plugins - , botChan :: Chan BotMsg -- The bot's communication channel - , botConfig :: Config -- the bot's starting config + { botStartTime :: UTCTime -- the bot's uptime + , botPlugins :: M.Map String (PluginState, ThreadId) -- Loaded plugins + , botChan :: Chan BotMsg -- The bot's communication channel + , botConfig :: Config -- the bot's starting config } -- | Bot's main entry point @@ -62,8 +62,10 @@ spawnIrcPlugins = do bot <- get let chan = botChan bot pchan <- liftIO (newChan :: IO (Chan BotMsg)) - threadId <- liftIO $ forkIO (ircbot config chan pchan) - let plugin = PluginState (ircConfigName config) threadId pchan M.empty + threadId <- liftIO $ forkIO (startIrcbot config chan pchan) + let plugin = PluginState { pluginName = ircConfigName config + , pluginChan = pchan + , pluginHandles = M.empty } plugins = botPlugins bot - put $ bot { botPlugins = M.insert (pluginName plugin) plugin plugins } + put $ bot { botPlugins = M.insert (pluginName plugin) (plugin, threadId) plugins } diff --git a/Hsbot/Irc/Command.hs b/Hsbot/Irc/Command.hs index 3f5c8c1..e5c033e 100644 --- a/Hsbot/Irc/Command.hs +++ b/Hsbot/Irc/Command.hs @@ -40,8 +40,8 @@ processInternalCommand (IntIrcCmd ircCmd) | otherwise = do plugins <- gets ircBotPlugins case M.lookup (ircCmdTo ircCmd) plugins of - Just plugin -> sendToPlugin (IntIrcCmd ircCmd) plugin - Nothing -> return () + Just (plugin, _) -> sendToPlugin (IntIrcCmd ircCmd) plugin + Nothing -> return () processInternalCommand _ = return () -- | Processes a core command diff --git a/Hsbot/Irc/Core.hs b/Hsbot/Irc/Core.hs index ac51419..2c455ce 100644 --- a/Hsbot/Irc/Core.hs +++ b/Hsbot/Irc/Core.hs @@ -1,5 +1,5 @@ module Hsbot.Irc.Core - ( ircbot + ( startIrcbot ) where import Control.Concurrent @@ -21,8 +21,8 @@ import Hsbot.Irc.Types import Hsbot.Message (BotMsg) -- | IrcBot's main entry point -ircbot :: IrcConfig -> Chan BotMsg -> Chan BotMsg -> IO () -ircbot config masterChan myChan = do +startIrcbot :: IrcConfig -> Chan BotMsg -> Chan BotMsg -> IO () +startIrcbot config masterChan myChan = do startTime <- getCurrentTime putStrLn "[IrcBot] Opening communication channel... " chan <- newChan :: IO (Chan IrcBotMsg) @@ -55,6 +55,9 @@ ircbot config masterChan myChan = do _ <- ircBotLoop ircBotState' `catch` (\(_ :: IOException) -> return ()) return () +--resumeIrcBot +--resumeIrcBot + -- | Runs the IrcBot's reader loop ircBotReader :: Handle -> Chan IrcBotMsg -> ThreadId -> IO () ircBotReader handle chan fatherThreadId = forever $ do @@ -126,9 +129,9 @@ dispatchMessage (InIrcMsg inIrcMsg) = do let key = tail . head $ words getMsgContent pluginNames = fromMaybe [] $ M.lookup key cmds plugins' = fromMaybe [] $ mapM (flip M.lookup plugins) pluginNames - in mapM_ (sendRunCommand $ tail getMsgContent) plugins' + in mapM_ (sendRunCommand (tail getMsgContent) . fst) plugins' else - mapM_ (sendToPlugin $ InIrcMsg inIrcMsg) (M.elems plugins) + mapM_ (sendToPlugin (InIrcMsg inIrcMsg) . fst) (M.elems plugins) where isPluginCommand :: IrcConfig -> Bool isPluginCommand config = diff --git a/Hsbot/Irc/Plugin.hs b/Hsbot/Irc/Plugin.hs index b12d922..525ab8f 100644 --- a/Hsbot/Irc/Plugin.hs +++ b/Hsbot/Irc/Plugin.hs @@ -48,14 +48,13 @@ loadIrcPlugin pluginName = do let oldPlugins = ircBotPlugins ircbot -- We check for unicity case M.lookup pluginName oldPlugins of - Just plugin -> return () - Nothing -> do + Just _ -> return () + Nothing -> do threadId <- liftIO $ forkIO (entryPoint pluginChan masterChan) let plugin = IrcPluginState { ircPluginName = pluginName - , ircPluginThreadId = threadId , ircPluginChan = pluginChan , ircPluginMasterChan = masterChan } - put $ ircbot { ircBotPlugins = M.insert pluginName plugin oldPlugins } + put $ ircbot { ircBotPlugins = M.insert pluginName (plugin, threadId) oldPlugins } -- | Sends a list of loaded plugins listPlugins :: IrcMsg -> String -> IrcBot () @@ -63,8 +62,8 @@ listPlugins originalRequest dest = do plugins <- gets ircBotPlugins let listing = unwords $ M.keys plugins case M.lookup dest plugins of - Just plugin -> sendToPlugin (IntIrcCmd $ IrcCmd "ANSWER" "CORE" dest listing originalRequest) plugin - Nothing -> return () + Just (plugin, _) -> sendToPlugin (IntIrcCmd $ IrcCmd "ANSWER" "CORE" dest listing originalRequest) plugin + Nothing -> return () -- | Unloads a plugin unloadPlugin :: String -> IrcBot () @@ -72,9 +71,9 @@ unloadPlugin name = do bot <- get let oldPlugins = ircBotPlugins bot case M.lookup name oldPlugins of - Just plugin -> do + Just (_, threadId) -> do let newPlugins = M.delete name oldPlugins - liftIO $ throwTo (ircPluginThreadId plugin) UserInterrupt + liftIO $ throwTo threadId UserInterrupt put $ bot { ircBotPlugins = newPlugins } Nothing -> return () diff --git a/Hsbot/Irc/Plugin/Core.hs b/Hsbot/Irc/Plugin/Core.hs index 5d69ca3..9987a89 100644 --- a/Hsbot/Irc/Plugin/Core.hs +++ b/Hsbot/Irc/Plugin/Core.hs @@ -2,7 +2,7 @@ module Hsbot.Irc.Plugin.Core ( ircBotPluginCore ) where -import Control.Concurrent (Chan, myThreadId) +import Control.Concurrent (Chan) import Control.Exception import Control.Monad.State import Prelude hiding (catch) @@ -13,9 +13,7 @@ import Hsbot.Irc.PluginCommons -- | The plugin's main entry point ircBotPluginCore :: Chan IrcBotMsg -> Chan IrcBotMsg -> IO () ircBotPluginCore myChan masterChan = do - threadId <- myThreadId let plugin = IrcPluginState { ircPluginName = "Core" - , ircPluginThreadId = threadId , ircPluginChan = myChan , ircPluginMasterChan = masterChan } evalStateT (mapM_ sendRegisterCommand ["list", "load", "reload", "unload"]) plugin diff --git a/Hsbot/Irc/Plugin/Dummy.hs b/Hsbot/Irc/Plugin/Dummy.hs index 48515ce..c543b90 100644 --- a/Hsbot/Irc/Plugin/Dummy.hs +++ b/Hsbot/Irc/Plugin/Dummy.hs @@ -2,7 +2,6 @@ module Hsbot.Irc.Plugin.Dummy ( ircBotPluginDummy ) where -import Control.Concurrent (myThreadId) import Control.Concurrent.Chan import Control.Exception import Control.Monad.State @@ -14,9 +13,7 @@ import Hsbot.Irc.PluginCommons -- | The plugin's main entry point ircBotPluginDummy :: Chan IrcBotMsg -> Chan IrcBotMsg -> IO () ircBotPluginDummy myChan masterChan = do - threadId <- myThreadId let plugin = IrcPluginState { ircPluginName = "Dummy" - , ircPluginThreadId = threadId , ircPluginChan = myChan , ircPluginMasterChan = masterChan } _ <- (execStateT run plugin) `catch` (\(_ :: AsyncException) -> return plugin) diff --git a/Hsbot/Irc/Plugin/Ping.hs b/Hsbot/Irc/Plugin/Ping.hs index 6a38f0d..90579c4 100644 --- a/Hsbot/Irc/Plugin/Ping.hs +++ b/Hsbot/Irc/Plugin/Ping.hs @@ -2,7 +2,6 @@ module Hsbot.Irc.Plugin.Ping ( ircBotPluginPing ) where -import Control.Concurrent (myThreadId) import Control.Concurrent.Chan import Control.Exception import Control.Monad.State @@ -14,9 +13,7 @@ import Hsbot.Irc.PluginCommons -- | The plugin's main entry point ircBotPluginPing :: Chan IrcBotMsg -> Chan IrcBotMsg -> IO () ircBotPluginPing myChan masterChan = do - threadId <- myThreadId let plugin = IrcPluginState { ircPluginName = "Ping" - , ircPluginThreadId = threadId , ircPluginChan = myChan , ircPluginMasterChan = masterChan } _ <- (execStateT run plugin) `catch` (\(_ :: AsyncException) -> return plugin) diff --git a/Hsbot/Irc/Plugin/Quote.hs b/Hsbot/Irc/Plugin/Quote.hs index ff037c7..31eaeaf 100644 --- a/Hsbot/Irc/Plugin/Quote.hs +++ b/Hsbot/Irc/Plugin/Quote.hs @@ -2,7 +2,6 @@ module Hsbot.Irc.Plugin.Quote ( ircBotPluginQuote ) where -import Control.Concurrent (myThreadId) import Control.Concurrent.Chan import Control.Exception import Control.Monad.State @@ -61,9 +60,7 @@ ircBotPluginQuote myChan masterChan = do txtQuoteBot <- TIO.readFile $ dbfile let quoteBot = read (T.unpack txtQuoteBot) :: QuoteBotState -- The plugin main loop - threadId <- myThreadId let plugin = IrcPluginState { ircPluginName = "Quote" - , ircPluginThreadId = threadId , ircPluginChan = myChan , ircPluginMasterChan = masterChan } evalStateT (mapM_ sendRegisterCommand ["quote"]) plugin diff --git a/Hsbot/Irc/PluginCommons.hs b/Hsbot/Irc/PluginCommons.hs index 71f00a4..51f9473 100644 --- a/Hsbot/Irc/PluginCommons.hs +++ b/Hsbot/Irc/PluginCommons.hs @@ -23,7 +23,6 @@ type IrcPlugin = StateT IrcPluginState IO -- | A plugin state data IrcPluginState = IrcPluginState { ircPluginName :: String -- The plugin's name - , ircPluginThreadId :: ThreadId -- The plugin thread , ircPluginChan :: Chan IrcBotMsg -- The plugin chan , ircPluginMasterChan :: Chan IrcBotMsg -- The master's chan } diff --git a/Hsbot/Irc/Types.hs b/Hsbot/Irc/Types.hs index eac58d7..7ee716f 100644 --- a/Hsbot/Irc/Types.hs +++ b/Hsbot/Irc/Types.hs @@ -21,15 +21,15 @@ type IrcBot = StateT IrcBotState IO -- | An Ircbot state data IrcBotState = IrcBotState - { ircBotStartTime :: UTCTime -- the bot's uptime - , ircBotPlugins :: M.Map String IrcPluginState -- Loaded plugins - , ircBotCommands :: M.Map String [String] -- Loaded plugins - , ircBotChan :: Chan IrcBotMsg -- The IrcBot's communication channel - , ircBotMasterChan :: Chan BotMsg -- The Hsbot communication channel - , ircBotMyChan :: Chan BotMsg -- The Hsbot communication channel - , ircBotServerState :: IrcServerState -- The state of the IrcServer - , ircBotHandle :: Handle -- The server's socket/handle - , ircBotConfig :: IrcConfig -- The starting configuration + { ircBotStartTime :: UTCTime -- the bot's uptime + , ircBotPlugins :: M.Map String (IrcPluginState, ThreadId) -- Loaded plugins + , ircBotCommands :: M.Map String [String] -- Loaded plugins + , ircBotChan :: Chan IrcBotMsg -- The IrcBot's communication channel + , ircBotMasterChan :: Chan BotMsg -- The Hsbot communication channel + , ircBotMyChan :: Chan BotMsg -- The Hsbot communication channel + , ircBotServerState :: IrcServerState -- The state of the IrcServer + , ircBotHandle :: Handle -- The server's socket/handle + , ircBotConfig :: IrcConfig -- The starting configuration , ircBotReaderThreadId :: ThreadId , ircBotMasterReaderThreadId :: ThreadId } diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs index 9e34d92..47dd0f5 100644 --- a/Hsbot/Plugin.hs +++ b/Hsbot/Plugin.hs @@ -17,7 +17,6 @@ type Plugin = StateT PluginState IO -- | A plugin state data PluginState = PluginState { pluginName :: String -- The plugin's name - , pluginThreadId :: ThreadId -- The plugin thread , pluginChan :: Chan BotMsg -- The plugin chan , pluginHandles :: M.Map String Handle -- the plugins's handles } -- cgit v1.2.3