Removed thread ids from plugins data structure.

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
 
@@ -23,7 +23,7 @@ type Bot = StateT BotState IO
 -- | An Hsbot state
 data BotState = BotState
     { botStartTime :: UTCTime                              -- the bot's uptime
-    , botPlugins   :: M.Map String PluginState -- Loaded plugins
+    , botPlugins   :: M.Map String (PluginState, ThreadId) -- Loaded plugins
     , botChan      :: Chan BotMsg                          -- The bot's communication channel
     , botConfig    :: Config                               -- the bot's starting config
     }
@@ -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)
+        threadId <- liftIO $ forkIO (startIrcbot config chan pchan)
-        let plugin  = PluginState (ircConfigName config) threadId pchan M.empty
+        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 }
 

Hsbot/Irc/Command.hs

@@ -40,7 +40,7 @@ processInternalCommand (IntIrcCmd ircCmd)
   | otherwise = do
       plugins <- gets ircBotPlugins
       case M.lookup (ircCmdTo ircCmd) plugins of
-          Just plugin -> sendToPlugin (IntIrcCmd ircCmd) plugin
+          Just (plugin, _) -> sendToPlugin (IntIrcCmd ircCmd) plugin
           Nothing          -> return ()
 processInternalCommand _ = return ()
 

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 ()
+startIrcbot :: IrcConfig -> Chan BotMsg -> Chan BotMsg -> IO ()
-ircbot config masterChan myChan = do
+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 =

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 ()
+        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,7 +62,7 @@ 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
+        Just (plugin, _) -> sendToPlugin (IntIrcCmd $ IrcCmd "ANSWER" "CORE" dest listing originalRequest) plugin
         Nothing          -> return ()
 
 -- | Unloads a plugin
@@ -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 ()
 

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

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)

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)

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

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
     }

Hsbot/Irc/Types.hs

@@ -22,7 +22,7 @@ type IrcBot = StateT IrcBotState IO
 -- | An Ircbot state
 data IrcBotState = IrcBotState
     { ircBotStartTime            :: UTCTime                                 -- the bot's uptime
-    , ircBotPlugins              :: M.Map String IrcPluginState -- Loaded plugins
+    , 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

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
     }