From c1662ba7b982a8502dc9f32031b7cb518df7f60e Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Sun, 16 May 2010 00:01:00 +0200
Subject: 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
---
 Hsbot/Irc/Plugin.hs | 80 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 80 insertions(+)
 create mode 100644 Hsbot/Irc/Plugin.hs

(limited to 'Hsbot/Irc/Plugin.hs')

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 ()
+
-- 
cgit v1.2.3