summaryrefslogtreecommitdiff
path: root/Hsbot/Irc/Plugin.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Hsbot/Irc/Plugin.hs')
-rw-r--r--Hsbot/Irc/Plugin.hs80
1 files changed, 80 insertions, 0 deletions
diff --git a/Hsbot/Irc/Plugin.hs b/Hsbot/Irc/Plugin.hs
new file mode 100644
index 0000000..b12d922
--- /dev/null
+++ b/Hsbot/Irc/Plugin.hs
@@ -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 ()
+