Finished changing plugin data structure to Maps.
This commit is contained in:
parent
884c6c9f2e
commit
d2f40f6481
3 changed files with 24 additions and 9 deletions
|
@ -7,6 +7,7 @@ import Control.Concurrent
|
||||||
import Control.Concurrent.Chan
|
import Control.Concurrent.Chan
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import Data.List
|
import Data.List
|
||||||
|
import qualified Data.Map as M
|
||||||
import Network
|
import Network
|
||||||
import System.IO
|
import System.IO
|
||||||
import System.Time (getClockTime)
|
import System.Time (getClockTime)
|
||||||
|
@ -28,13 +29,13 @@ connectServer server = do
|
||||||
chan <- newChan :: IO (Chan BotMsg)
|
chan <- newChan :: IO (Chan BotMsg)
|
||||||
threadId <- forkIO $ botReader handle chan
|
threadId <- forkIO $ botReader handle chan
|
||||||
putStrLn "done."
|
putStrLn "done."
|
||||||
return (Bot server starttime handle [] [] chan threadId)
|
return (Bot server starttime handle [] M.empty chan threadId M.empty)
|
||||||
|
|
||||||
-- | Disconnect from the server
|
-- | Disconnect from the server
|
||||||
disconnectServer :: Bot -> IO () -- IO Bot ?
|
disconnectServer :: Bot -> IO () -- IO Bot ?
|
||||||
disconnectServer bot = do
|
disconnectServer bot = do
|
||||||
killThread $ readerThreadId bot
|
killThread $ readerThreadId bot
|
||||||
mapM_ (killThread . pluginThreadId) (botPlugins bot)
|
mapM_ (killThread . pluginThreadId . snd) (M.toList $ botPlugins bot)
|
||||||
hClose $ botHandle bot
|
hClose $ botHandle bot
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
|
|
@ -5,6 +5,7 @@ module Hsbot.IRC
|
||||||
|
|
||||||
import Control.Concurrent.Chan
|
import Control.Concurrent.Chan
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
|
import qualified Data.Map as M
|
||||||
|
|
||||||
import Hsbot.IRCParser
|
import Hsbot.IRCParser
|
||||||
import Hsbot.Plugin
|
import Hsbot.Plugin
|
||||||
|
@ -30,7 +31,7 @@ runServer = do
|
||||||
msg <- liftIO input
|
msg <- liftIO input
|
||||||
case msg of
|
case msg of
|
||||||
InputMsg inputMsg ->
|
InputMsg inputMsg ->
|
||||||
mapM_ (sendToPlugin $ InputMsg inputMsg) plugins
|
mapM_ (sendToPlugin (InputMsg inputMsg) . snd) (M.toList plugins)
|
||||||
OutputMsg outputMsg ->
|
OutputMsg outputMsg ->
|
||||||
sendstr (serializeIrcMsg outputMsg)
|
sendstr (serializeIrcMsg outputMsg)
|
||||||
InternalCmd internalCmd ->
|
InternalCmd internalCmd ->
|
||||||
|
|
|
@ -1,26 +1,33 @@
|
||||||
module Hsbot.Plugin
|
module Hsbot.Plugin
|
||||||
( loadPlugin
|
( loadPlugin
|
||||||
|
, pluginExists
|
||||||
, sendToPlugin
|
, sendToPlugin
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Concurrent.Chan
|
import Control.Concurrent.Chan
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
|
import qualified Data.Map as M
|
||||||
import System.IO
|
import System.IO
|
||||||
import System.Plugins
|
import System.Plugins
|
||||||
|
|
||||||
import Hsbot.Types
|
import Hsbot.Types
|
||||||
import Hsbot.Utils
|
import Hsbot.Utils
|
||||||
|
|
||||||
|
-- TODO : unload plugin, reload plugin, list plugins, etc
|
||||||
|
|
||||||
-- | Loads a plugin into an ircBot
|
-- | Loads a plugin into an ircBot
|
||||||
loadPlugin :: String -> IrcBot ()
|
loadPlugin :: String -> IrcBot ()
|
||||||
loadPlugin name = do
|
loadPlugin name = do
|
||||||
bot <- get
|
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]
|
||||||
|
else do
|
||||||
plugin <- liftIO $ effectivelyLoadPlugin name (botChannel bot)
|
plugin <- liftIO $ effectivelyLoadPlugin name (botChannel bot)
|
||||||
case plugin of
|
case plugin of
|
||||||
Just plugin' -> do
|
Just plugin' -> do
|
||||||
let oldPlugins = botPlugins bot
|
put $ bot { botPlugins = M.insert name plugin' oldPlugins}
|
||||||
put $ bot { botPlugins = plugin' : oldPlugins } -- TODO : clean with a correct append
|
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
|
|
||||||
-- | Effectively try to load a plugin
|
-- | Effectively try to load a plugin
|
||||||
|
@ -54,3 +61,9 @@ sendToPlugin msg plugin = do
|
||||||
let chan = pluginChannel plugin
|
let chan = pluginChannel plugin
|
||||||
liftIO $ writeChan chan msg
|
liftIO $ writeChan chan msg
|
||||||
|
|
||||||
|
-- | Tells if a plugin is loaded or not
|
||||||
|
pluginExists :: String -> IrcBot Bool
|
||||||
|
pluginExists name = do
|
||||||
|
plugins <- gets botPlugins
|
||||||
|
return $ name `M.member` plugins
|
||||||
|
|
||||||
|
|
Reference in a new issue