Added plugin loading, and the most basic hook capability.

Hsbot/Core.hs

@@ -19,6 +19,7 @@ import Prelude hiding (catch)
 import System.IO
 import System.Log.Logger
 
+import Hsbot.Plugin
 import Hsbot.Types
 import Hsbot.Utils
 
@@ -77,7 +78,7 @@ runHsbot = do
         chan <- lift $ asks envChan
         (liftIO . forkIO $ botReader connhdl tlsCtx chan myOwnThreadId) >>= lift . addThreadIdToQuitMVar
         -- Then we spawn all plugins
-        -- asks envSocket  >>= mapM_ ( ----- what's next? the core server handling! ----- )
+        (lift $ asks envConfig) >>= mapM_ loadPlugin . configPlugins
         -- Finally we spawn the main bot loop
         bot <- get
         finalStateMVar <- liftIO newEmptyMVar
@@ -86,6 +87,7 @@ runHsbot = do
         code <- asks envQuitMv >>= liftIO . takeMVar
         -- and we clean things up
         asks envThreadIdsMv >>= liftIO . readMVar >>= liftIO . mapM_ killThread
+        -- TODO : kill plugin threads
         return code
     storeFinalState :: MVar BotState -> BotState -> Env IO ()
     storeFinalState finalStateMVar finalState = liftIO $ putMVar finalStateMVar finalState
@@ -103,8 +105,16 @@ botReader handle Nothing chan fatherThreadId = forever $
         killThread myId
         return ""
 
+handleIncomingStr :: Chan Message -> String -> IO ()
+handleIncomingStr chan str = do
+    case IRC.decode str of
+        Just msg -> do
+            debugM "Ircd.Reader" $ "<-- " ++ (show msg)
+            writeChan chan $ IncomingMsg msg
+        Nothing -> debugM "Ircd.Reader" $ "Error: couldn't decode : " ++ str     -- TODO: spam control
+
 botLoop :: Bot (Env IO) ()
-botLoop = do
+botLoop = forever $ do
     chan <- lift $ asks envChan
     hooks <- gets botHooks
     msg  <- liftIO $ readChan chan
@@ -115,16 +125,9 @@ botLoop = do
             env <- lift ask
             let connhdl  = envHandle env
                 tlsCtx   = envTLSCtx env
+            liftIO $ debugM "Ircd.Reader" $ "--> " ++ (show outMsg)
             liftIO . sendStr connhdl tlsCtx $ IRC.encode outMsg
 
-handleIncomingStr :: Chan Message -> String -> IO ()
-handleIncomingStr chan str = do
-    case IRC.decode str of
-        Just msg -> do
-            debugM "Ircd.Reader" $ "<-- " ++ (show msg)
-            writeChan chan $ IncomingMsg msg
-        Nothing -> debugM "Ircd.Reader" $ "Error: couldn't decode : " ++ str     -- TODO: spam control
-
 terminateHsbot :: Env IO ()
 terminateHsbot = do
     liftIO $ infoM "Hsbot.Core" "Closing connection"

Hsbot/Message.hs

@@ -11,13 +11,13 @@ import qualified Network.IRC as IRC
 import Hsbot.Types
 
 -- Plugin Utils
-readMsg :: Plugin IO (Message)
+readMsg :: Plugin (Env IO) (Message)
 readMsg = gets pluginChan >>= liftIO . readChan >>= return
 
-writeMsg :: Message -> Plugin IO ()
+writeMsg :: Message -> Plugin (Env IO) ()
 writeMsg msg = gets pluginMaster >>= liftIO . flip writeChan msg
 
-answerMsg :: IRC.Message -> String -> Plugin IO ()
+answerMsg :: IRC.Message -> String -> Plugin (Env IO) ()
 answerMsg request msg =
     case IRC.msg_params request of
         sender:_ -> writeMsg . OutgoingMsg $ IRC.Message Nothing "PRIVMSG" [sender, msg]

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
+

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 ()

Hsbot/Types.hs

@@ -38,7 +38,7 @@ data BotEnv = BotEnv
 type Bot = StateT BotState
 
 data BotState = BotState
-    { botPlugins  :: M.Map String (PluginState, MVar (), ThreadId)
+    { botPlugins  :: M.Map String (PluginState, MVar PluginState, ThreadId)
     , botHooks    :: [Chan Message]
     , botChannels :: [String]
     , botNickname :: String
@@ -55,7 +55,7 @@ data PluginState = PluginState
 
 data PluginId = PluginId
     { pluginName :: String
-    , pluginEp   :: PluginState -> IO ()
+    , pluginEp   :: Plugin (Env IO) ()
     }
 
 -- Messaging
@@ -73,7 +73,7 @@ data Config = Config
     , configChannels  :: [String]
     , configNicknames :: [String]
     , configRealname  :: String
-    , configPlugins   :: [(String, Chan Message -> Chan Message -> IO ())]
+    , configPlugins   :: [PluginId]
     }
 
 data TLSConfig = TLSConfig

hsbot.cabal

@@ -1,5 +1,5 @@
 Name:               hsbot
-Version:            0.4.1
+Version:            0.4.4
 Cabal-version:      >=1.2
 Synopsis:           A multipurposes IRC bot
 Description:
@@ -19,11 +19,10 @@ Build-type:         Simple
 Library
   ghc-options: -Wall
   exposed-modules:  Hsbot
-                    --Hsbot.Command
                     Hsbot.Config
                     Hsbot.Core
                     Hsbot.Message
-                    --Hsbot.Plugin
+                    Hsbot.Plugin
                     Hsbot.Plugin.Ping
                     Hsbot.Types
                     Hsbot.Utils