Added plugin loading, and the most basic hook capability.

2 files changed, 47 insertions, 16 deletions

diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs
new file mode 100644
index 0000000..3191a15
--- /dev/null
+++ b/Hsbot/Plugin.hs
@@ -0,0 +1,38 @@
+module Hsbot.Plugin
+    ( loadPlugin
+    ) where
+
+import Control.Concurrent
+import qualified Data.Map as M
+import Control.Monad.Reader
+import Control.Monad.State
+import System.Log.Logger
+
+import Hsbot.Types
+
+loadPlugin :: PluginId -> Bot (Env IO) ()
+loadPlugin pId = do
+    bot <- get
+    chan <- liftIO (newChan :: IO (Chan Message))
+    master <- lift $ asks envChan
+    let name = pluginName pId
+        loop = pluginEp pId
+        oldPlugins = botPlugins bot
+        pState = PluginState { pluginId     = pId
+                             , pluginChan   = chan
+                             , pluginMaster = master }
+    -- We check for unicity
+    case M.lookup name oldPlugins of
+        Just _  -> liftIO . warningM "Hsbot.Core.LoadPlugin" $ "Not loading already loaded plugin : " ++ name
+        Nothing -> do
+            liftIO . infoM "Hsbot.Core.LoadPlugin" $ "Loading plugin : " ++ name
+            env <- lift ask
+            finalStateMVar <- liftIO newEmptyMVar
+            threadId <- liftIO . forkIO $ runReaderT (execStateT loop pState >>= storeFinalState finalStateMVar) env
+            let newPlugins = M.insert name (pState, finalStateMVar, threadId) oldPlugins
+            put $ bot { botPlugins = newPlugins
+                      , botHooks   = chan : botHooks bot }
+  where
+    storeFinalState :: MVar PluginState -> PluginState -> Env IO ()
+    storeFinalState finalStateMVar finalState = liftIO $ putMVar finalStateMVar finalState
+
diff --git a/Hsbot/Plugin/Ping.hs b/Hsbot/Plugin/Ping.hs
index 192bab4..d399ab8 100644
--- a/Hsbot/Plugin/Ping.hs
+++ b/Hsbot/Plugin/Ping.hs
@@ -1,35 +1,28 @@
 module Hsbot.Plugin.Ping
-    ( pingId
-    , ping
+    ( ping
+    , thePing
     ) where
 
 import Control.Concurrent.Chan ()
-import Control.Exception
-import Control.Monad.State (execStateT, forever)
+import Control.Monad.State
 import qualified Network.IRC as IRC
 import Prelude hiding (catch)
 
 import Hsbot.Message
 import Hsbot.Types
 
-pingId :: PluginId
-pingId = PluginId
+ping :: PluginId
+ping = PluginId
     { pluginName = "ping"
-    , pluginEp   = ping }
-
--- | The plugin's main entry point
-ping :: PluginState -> IO ()
-ping state = do
-    _ <- (execStateT run state) `catch` (\(_ :: AsyncException) -> return state)
-    return ()
+    , pluginEp   = thePing }
 
 -- | The IrcPlugin monad main function
-run :: Plugin IO ()
-run = forever $ do
+thePing :: Plugin (Env IO) ()
+thePing = forever $ do
     msg <- readMsg
     eval msg
   where
-    eval :: Message -> Plugin IO ()
+    eval :: Message -> Plugin (Env IO) ()
     eval (IncomingMsg msg)
         | (IRC.msg_command msg) == "PING" = writeMsg . OutgoingMsg . IRC.Message Nothing "PONG" $ IRC.msg_params msg
         | otherwise = return ()