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:
parent
c20cfe88b3
commit
c1662ba7b9
33 changed files with 856 additions and 654 deletions
|
@ -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
|
||||
}
|
||||
|
||||
|
|
Reference in a new issue