diff options
Diffstat (limited to '')
-rw-r--r-- | Hsbot/Plugin.hs | 38 | ||||
-rw-r--r-- | Hsbot/Plugin/Ping.hs | 25 |
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 () |