diff options
| -rw-r--r-- | Hsbot/Message.hs | 6 | ||||
| -rw-r--r-- | Hsbot/Plugin.hs | 13 | ||||
| -rw-r--r-- | Hsbot/Plugin/Duck.hs | 2 | ||||
| -rw-r--r-- | Hsbot/Plugin/Ping.hs | 2 | ||||
| -rw-r--r-- | Hsbot/Types.hs | 8 | ||||
| -rw-r--r-- | Hsbot/Utils.hs | 4 | ||||
| -rw-r--r-- | hsbot.cabal | 2 |
7 files changed, 15 insertions, 22 deletions
diff --git a/Hsbot/Message.hs b/Hsbot/Message.hs index 1382098..d6697cd 100644 --- a/Hsbot/Message.hs +++ b/Hsbot/Message.hs @@ -5,17 +5,17 @@ module Hsbot.Message ) where import Control.Concurrent -import Control.Monad.State +import Control.Monad.Reader import qualified Network.IRC as IRC import Hsbot.Types -- Plugin Utils readMsg :: Plugin (Env IO) Message -readMsg = gets pluginChan >>= liftIO . readChan +readMsg = asks pluginChan >>= liftIO . readChan writeMsg :: Message -> Plugin (Env IO) () -writeMsg msg = gets pluginMaster >>= liftIO . flip writeChan msg +writeMsg msg = asks pluginMaster >>= liftIO . flip writeChan msg answerMsg :: IRC.Message -> String -> Plugin (Env IO) () answerMsg request msg = diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs index ebcff8d..6d1eacf 100644 --- a/Hsbot/Plugin.hs +++ b/Hsbot/Plugin.hs @@ -23,19 +23,16 @@ loadPlugin pId = do let name = pluginName pId loop = pluginEp pId oldPlugins = botPlugins bot - pState = PluginState { pluginId = pId - , pluginChan = chan - , pluginMaster = master } + pEnv = PluginEnv { pluginId = pId + , pluginChan = chan + , pluginMaster = master } 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 + threadId <- liftIO . forkIO $ runReaderT (runReaderT loop pEnv) env + let newPlugins = M.insert name (pEnv, threadId) oldPlugins put $ bot { botPlugins = newPlugins , botHooks = chan : botHooks bot } - storeFinalState :: MVar PluginState -> PluginState -> Env IO () - storeFinalState finalStateMVar finalState = liftIO $ putMVar finalStateMVar finalState diff --git a/Hsbot/Plugin/Duck.hs b/Hsbot/Plugin/Duck.hs index 11f7637..7e8c521 100644 --- a/Hsbot/Plugin/Duck.hs +++ b/Hsbot/Plugin/Duck.hs @@ -6,7 +6,7 @@ module Hsbot.Plugin.Duck import Control.Concurrent.Chan () import qualified Data.List as L -import Control.Monad.State +import Control.Monad.Reader import qualified Network.IRC as IRC import Prelude hiding (catch) diff --git a/Hsbot/Plugin/Ping.hs b/Hsbot/Plugin/Ping.hs index 179bcb3..54ba396 100644 --- a/Hsbot/Plugin/Ping.hs +++ b/Hsbot/Plugin/Ping.hs @@ -4,7 +4,7 @@ module Hsbot.Plugin.Ping ) where import Control.Concurrent.Chan () -import Control.Monad.State +import Control.Monad.Reader import qualified Network.IRC as IRC import Prelude hiding (catch) diff --git a/Hsbot/Types.hs b/Hsbot/Types.hs index 14e89a1..c7331d3 100644 --- a/Hsbot/Types.hs +++ b/Hsbot/Types.hs @@ -7,8 +7,8 @@ module Hsbot.Types , Env , Message (..) , Plugin + , PluginEnv (..) , PluginId (..) - , PluginState (..) , TLSConfig (..) ) where @@ -39,16 +39,16 @@ data BotEnv = BotEnv type Bot = StateT BotState data BotState = BotState - { botPlugins :: M.Map String (PluginState, MVar PluginState, ThreadId) + { botPlugins :: M.Map String (PluginEnv, ThreadId) , botHooks :: [Chan Message] , botChannels :: [String] , botNickname :: String } -- The Plugin monad -type Plugin = StateT PluginState +type Plugin = ReaderT PluginEnv -data PluginState = PluginState +data PluginEnv = PluginEnv { pluginId :: PluginId , pluginChan :: Chan Message , pluginMaster :: Chan Message diff --git a/Hsbot/Utils.hs b/Hsbot/Utils.hs index b41fa52..6eec5c4 100644 --- a/Hsbot/Utils.hs +++ b/Hsbot/Utils.hs @@ -1,7 +1,6 @@ module Hsbot.Utils ( addThreadIdToQuitMVar , delThreadIdFromQuitMVar - , first , initTLSEnv , readCertificate , readPrivateKey @@ -41,9 +40,6 @@ setGlobalQuitMVar status = do quitMv <- asks envQuitMv liftIO $ putMVar quitMv status -first :: (a, b, c) -> a -first (a, _, _) = a - -- Helpers sendStr :: Handle -> Maybe TLSCtx -> String -> IO () sendStr _ (Just ctx) msg = sendData ctx $ L.fromChunks [C.pack msg] diff --git a/hsbot.cabal b/hsbot.cabal index d0a2665..e60d115 100644 --- a/hsbot.cabal +++ b/hsbot.cabal @@ -1,5 +1,5 @@ Name: hsbot -Version: 0.4.8 +Version: 0.4.9 Cabal-version: >=1.2 Synopsis: A multipurposes IRC bot Description: |