summaryrefslogtreecommitdiff
path: root/Hsbot/Plugin
diff options
context:
space:
mode:
authorJulien Dessaux2011-05-01 03:11:32 +0200
committerJulien Dessaux2011-05-01 03:28:28 +0200
commitc497b24700eeea4269e4d76559e8023284a0a213 (patch)
tree9d09a769232cb93e3987f999f12a3203b81443b1 /Hsbot/Plugin
parentImproved message utilities. (diff)
downloadhsbot-c497b24700eeea4269e4d76559e8023284a0a213.tar.gz
hsbot-c497b24700eeea4269e4d76559e8023284a0a213.tar.bz2
hsbot-c497b24700eeea4269e4d76559e8023284a0a213.zip
Added plugin loading, and the most basic hook capability.
Diffstat (limited to '')
-rw-r--r--Hsbot/Plugin.hs38
-rw-r--r--Hsbot/Plugin/Ping.hs25
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 ()