From fd8d5faf5f4ab085b01316e15403779ca30cf3f9 Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Thu, 4 Feb 2010 21:05:37 +0100
Subject: Began a complete rewrite of command and plugin management.

Wrote a command routing statement, added an IrcPlugin monad.
---
 Plugins/Core.hs | 49 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 49 insertions(+)
 create mode 100644 Plugins/Core.hs

(limited to 'Plugins/Core.hs')

diff --git a/Plugins/Core.hs b/Plugins/Core.hs
new file mode 100644
index 0000000..a15cc62
--- /dev/null
+++ b/Plugins/Core.hs
@@ -0,0 +1,49 @@
+module Plugins.Core
+    ( mainCore
+    ) where
+
+import Control.Concurrent.Chan
+
+import Hsbot.IRCPlugin
+import Hsbot.Types
+import Hsbot.Utils
+
+-- | The plugin's main entry point
+mainCore :: Chan BotMsg -> Chan BotMsg -> IO ()
+mainCore serverChan chan = do
+    let plugin = PluginInstance "Core" serverChan chan
+    (runStateT run plugin) `catch` (const $ return ((), plugin))
+    return ()
+
+-- | The IrcPlugin monad main function
+run :: IrcPlugin ()
+run = do
+    mapM_ sendRegisterCommand ["load", "unload"]
+    runPlugin
+    mapM_ sendUnregisterCommand ["load", "unload"]
+
+runPlugin :: IrcPlugin ()
+runPlugin = forever $ do
+    msg <- readMsg
+    eval msg
+  where
+    eval :: BotMsg -> IrcPlugin ()
+    eval (InternalCmd intCmd) = do
+        case intCmdCmd intCmd of
+            "RUN" -> let stuff = words $ intCmdMsg intCmd
+                     in case head stuff of
+                            "load"   -> loadPlugin $ tail stuff
+                            "unload" -> unloadPlugin $ tail stuff
+                            _      -> lift $ trace $ show intCmd -- TODO : help message
+            _     -> lift $ trace $ show intCmd
+    eval (InputMsg msg) = return ()
+    eval _ = return ()
+
+-- | The load command
+loadPlugin :: [String] -> IrcPlugin ()
+loadPlugin pluginNames = mapM_ (sendCommand "LOAD" "CORE") pluginNames
+
+-- | The unload command
+unloadPlugin :: [String] -> IrcPlugin ()
+unloadPlugin pluginNames = mapM_ (sendCommand "UNLOAD" "CORE") pluginNames
+
-- 
cgit v1.2.3