adyxax/hsbot
Archived
1
0
Fork 0
Code Issues Activity

Removed thread ids from plugins data structure.

Browse source
This commit is contained in:
Julien Dessaux 2010-05-16 17:58:38 +02:00
parent c1662ba7b9
commit 738ad9e9bb
11 changed files with 37 additions and 46 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
Hsbot/Core.hs
View file

@ -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 }

4
Hsbot/Irc/Command.hs
View file

@ -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

13
Hsbot/Irc/Core.hs
View file

@ -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 =

15
Hsbot/Irc/Plugin.hs
View file

@ -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 ()

4
Hsbot/Irc/Plugin/Core.hs
View file

@ -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

3
Hsbot/Irc/Plugin/Dummy.hs
View file

@ -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)

3
Hsbot/Irc/Plugin/Ping.hs
View file

@ -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)

3
Hsbot/Irc/Plugin/Quote.hs
View file

@ -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

1
Hsbot/Irc/PluginCommons.hs
View file

@ -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
}

18
Hsbot/Irc/Types.hs
View file

@ -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
}

1
Hsbot/Plugin.hs
View file

@ -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
}