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
80
Hsbot/Irc/Plugin.hs
Normal file
80
Hsbot/Irc/Plugin.hs
Normal file
|
@ -0,0 +1,80 @@
|
|||
module Hsbot.Irc.Plugin
|
||||
( IrcPlugin
|
||||
, IrcPluginState (..)
|
||||
, listPlugins
|
||||
, loadIrcPlugin
|
||||
, sendToPlugin
|
||||
, spawnIrcPlugins
|
||||
, unloadPlugin
|
||||
) where
|
||||
|
||||
import Control.Concurrent
|
||||
import Control.Concurrent.Chan ()
|
||||
import Control.Exception
|
||||
import Control.Monad.State
|
||||
import qualified Data.Map as M
|
||||
|
||||
import Hsbot.Irc.Config
|
||||
import Hsbot.Irc.Message
|
||||
import Hsbot.Irc.PluginCommons
|
||||
import Hsbot.Irc.Plugin.Core
|
||||
import Hsbot.Irc.Plugin.Dummy
|
||||
import Hsbot.Irc.Plugin.Ping
|
||||
import Hsbot.Irc.Plugin.Quote
|
||||
import Hsbot.Irc.Types
|
||||
|
||||
-- | Sends a msg to a plugin
|
||||
sendToPlugin :: IrcBotMsg -> IrcPluginState -> IrcBot ()
|
||||
sendToPlugin ircBotMsg plugin = do
|
||||
liftIO $ writeChan (ircPluginChan plugin) ircBotMsg
|
||||
|
||||
-- | spawns IrcPlugins
|
||||
spawnIrcPlugins :: IrcBot ()
|
||||
spawnIrcPlugins = do
|
||||
config <- gets ircBotConfig
|
||||
mapM_ (loadIrcPlugin) (ircConfigPlugins config)
|
||||
|
||||
-- | loads an ircbot plugin
|
||||
loadIrcPlugin :: String -> IrcBot ()
|
||||
loadIrcPlugin pluginName = do
|
||||
ircbot <- get
|
||||
let masterChan = ircBotChan ircbot
|
||||
pluginChan <- liftIO (newChan :: IO (Chan IrcBotMsg))
|
||||
let entryPoint = case pluginName of
|
||||
"Core" -> ircBotPluginCore
|
||||
"Ping" -> ircBotPluginPing
|
||||
"Quote" -> ircBotPluginQuote
|
||||
_ -> ircBotPluginDummy
|
||||
let oldPlugins = ircBotPlugins ircbot
|
||||
-- We check for unicity
|
||||
case M.lookup pluginName oldPlugins of
|
||||
Just plugin -> 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 }
|
||||
|
||||
-- | Sends a list of loaded plugins
|
||||
listPlugins :: IrcMsg -> String -> IrcBot ()
|
||||
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 ()
|
||||
|
||||
-- | Unloads a plugin
|
||||
unloadPlugin :: String -> IrcBot ()
|
||||
unloadPlugin name = do
|
||||
bot <- get
|
||||
let oldPlugins = ircBotPlugins bot
|
||||
case M.lookup name oldPlugins of
|
||||
Just plugin -> do
|
||||
let newPlugins = M.delete name oldPlugins
|
||||
liftIO $ throwTo (ircPluginThreadId plugin) UserInterrupt
|
||||
put $ bot { ircBotPlugins = newPlugins }
|
||||
Nothing -> return ()
|
||||
|
Reference in a new issue