summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--Hsbot/Message.hs6
-rw-r--r--Hsbot/Plugin.hs13
-rw-r--r--Hsbot/Plugin/Duck.hs2
-rw-r--r--Hsbot/Plugin/Ping.hs2
-rw-r--r--Hsbot/Types.hs8
-rw-r--r--Hsbot/Utils.hs4
-rw-r--r--hsbot.cabal2
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: