Archived
1
0
Fork 0

Rewrote nearly everything!

* Rewrote the whole architecture to achieve extreme modularity
* Added the ability to build a multiprotocol bot
* Added cabal integration
* Added configuration handling the XMonad style
* Added configuration in ~/.hsbot
* Refactored many many named and functions
* Refactored data structures
* Cleaned a big bunch of stuff
This commit is contained in:
Julien Dessaux 2010-05-16 00:01:00 +02:00
parent c20cfe88b3
commit c1662ba7b9
33 changed files with 856 additions and 654 deletions

View file

@ -1,61 +1,24 @@
module Hsbot.Plugin
( listPlugins
, loadPlugin
, sendToPlugin
, unloadPlugin
( Plugin
, PluginState (..)
) where
import Control.Concurrent
import Control.Concurrent.Chan()
import Control.Exception
import Control.Concurrent.Chan ()
import Control.Monad.State
import qualified Data.Map as M
import Data.Maybe()
import System.IO()
import IO (Handle)
import Hsbot.Types
import Hsbot.Utils
import Hsbot.Message
-- | Loads a plugin into an ircBot
loadPlugin :: String -> (Chan BotMsg -> Chan BotMsg -> IO ()) -> IrcBot ()
loadPlugin name entryPoint = do
bot <- get
let oldPlugins = botPlugins bot
plugin <- liftIO $ effectivelyLoadPlugin name entryPoint (botChannel bot)
put $ bot { botPlugins = M.insert name plugin oldPlugins}
-- | The Plugin monad
type Plugin = StateT PluginState IO
-- | Effectively try to load a plugin
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
-- | Sends a list of loaded plugins
listPlugins :: IrcMsg -> String -> IrcBot ()
listPlugins originalRequest dest = do
plugins <- gets botPlugins
let listing = unwords $ M.keys plugins
case M.lookup dest plugins of
Just plugin -> sendToPlugin (InternalCmd $ IntCmd "ANSWER" "CORE" dest listing originalRequest) plugin
Nothing -> return ()
-- | Unloads a plugin
unloadPlugin :: String -> IrcBot ()
unloadPlugin name = do
bot <- get
let oldPlugins = botPlugins bot
case M.lookup name oldPlugins of
Just plugin -> do
let newPlugins = M.delete name oldPlugins
liftIO $ throwTo (pluginThreadId plugin) UserInterrupt
put $ bot { botPlugins = newPlugins }
Nothing -> return ()
-- | Sends a msg to a plugin
sendToPlugin :: BotMsg -> Plugin -> IrcBot ()
sendToPlugin msg plugin = do
let chan = pluginChannel plugin
liftIO $ writeChan chan msg
-- | 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
}