Made the Plugin monad a Reader instead of a State since it can't change.
This commit is contained in:
parent
4ec66d2ad7
commit
a8c0c85787
7 changed files with 15 additions and 22 deletions
|
@ -5,17 +5,17 @@ module Hsbot.Message
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Monad.State
|
import Control.Monad.Reader
|
||||||
import qualified Network.IRC as IRC
|
import qualified Network.IRC as IRC
|
||||||
|
|
||||||
import Hsbot.Types
|
import Hsbot.Types
|
||||||
|
|
||||||
-- Plugin Utils
|
-- Plugin Utils
|
||||||
readMsg :: Plugin (Env IO) Message
|
readMsg :: Plugin (Env IO) Message
|
||||||
readMsg = gets pluginChan >>= liftIO . readChan
|
readMsg = asks pluginChan >>= liftIO . readChan
|
||||||
|
|
||||||
writeMsg :: Message -> Plugin (Env IO) ()
|
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 :: IRC.Message -> String -> Plugin (Env IO) ()
|
||||||
answerMsg request msg =
|
answerMsg request msg =
|
||||||
|
|
|
@ -23,7 +23,7 @@ loadPlugin pId = do
|
||||||
let name = pluginName pId
|
let name = pluginName pId
|
||||||
loop = pluginEp pId
|
loop = pluginEp pId
|
||||||
oldPlugins = botPlugins bot
|
oldPlugins = botPlugins bot
|
||||||
pState = PluginState { pluginId = pId
|
pEnv = PluginEnv { pluginId = pId
|
||||||
, pluginChan = chan
|
, pluginChan = chan
|
||||||
, pluginMaster = master }
|
, pluginMaster = master }
|
||||||
case M.lookup name oldPlugins of
|
case M.lookup name oldPlugins of
|
||||||
|
@ -31,11 +31,8 @@ loadPlugin pId = do
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
liftIO . infoM "Hsbot.Core.LoadPlugin" $ "Loading plugin : " ++ name
|
liftIO . infoM "Hsbot.Core.LoadPlugin" $ "Loading plugin : " ++ name
|
||||||
env <- lift ask
|
env <- lift ask
|
||||||
finalStateMVar <- liftIO newEmptyMVar
|
threadId <- liftIO . forkIO $ runReaderT (runReaderT loop pEnv) env
|
||||||
threadId <- liftIO . forkIO $ runReaderT (execStateT loop pState >>= storeFinalState finalStateMVar) env
|
let newPlugins = M.insert name (pEnv, threadId) oldPlugins
|
||||||
let newPlugins = M.insert name (pState, finalStateMVar, threadId) oldPlugins
|
|
||||||
put $ bot { botPlugins = newPlugins
|
put $ bot { botPlugins = newPlugins
|
||||||
, botHooks = chan : botHooks bot }
|
, botHooks = chan : botHooks bot }
|
||||||
storeFinalState :: MVar PluginState -> PluginState -> Env IO ()
|
|
||||||
storeFinalState finalStateMVar finalState = liftIO $ putMVar finalStateMVar finalState
|
|
||||||
|
|
||||||
|
|
|
@ -6,7 +6,7 @@ module Hsbot.Plugin.Duck
|
||||||
|
|
||||||
import Control.Concurrent.Chan ()
|
import Control.Concurrent.Chan ()
|
||||||
import qualified Data.List as L
|
import qualified Data.List as L
|
||||||
import Control.Monad.State
|
import Control.Monad.Reader
|
||||||
import qualified Network.IRC as IRC
|
import qualified Network.IRC as IRC
|
||||||
import Prelude hiding (catch)
|
import Prelude hiding (catch)
|
||||||
|
|
||||||
|
|
|
@ -4,7 +4,7 @@ module Hsbot.Plugin.Ping
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Concurrent.Chan ()
|
import Control.Concurrent.Chan ()
|
||||||
import Control.Monad.State
|
import Control.Monad.Reader
|
||||||
import qualified Network.IRC as IRC
|
import qualified Network.IRC as IRC
|
||||||
import Prelude hiding (catch)
|
import Prelude hiding (catch)
|
||||||
|
|
||||||
|
|
|
@ -7,8 +7,8 @@ module Hsbot.Types
|
||||||
, Env
|
, Env
|
||||||
, Message (..)
|
, Message (..)
|
||||||
, Plugin
|
, Plugin
|
||||||
|
, PluginEnv (..)
|
||||||
, PluginId (..)
|
, PluginId (..)
|
||||||
, PluginState (..)
|
|
||||||
, TLSConfig (..)
|
, TLSConfig (..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
@ -39,16 +39,16 @@ data BotEnv = BotEnv
|
||||||
type Bot = StateT BotState
|
type Bot = StateT BotState
|
||||||
|
|
||||||
data BotState = BotState
|
data BotState = BotState
|
||||||
{ botPlugins :: M.Map String (PluginState, MVar PluginState, ThreadId)
|
{ botPlugins :: M.Map String (PluginEnv, ThreadId)
|
||||||
, botHooks :: [Chan Message]
|
, botHooks :: [Chan Message]
|
||||||
, botChannels :: [String]
|
, botChannels :: [String]
|
||||||
, botNickname :: String
|
, botNickname :: String
|
||||||
}
|
}
|
||||||
|
|
||||||
-- The Plugin monad
|
-- The Plugin monad
|
||||||
type Plugin = StateT PluginState
|
type Plugin = ReaderT PluginEnv
|
||||||
|
|
||||||
data PluginState = PluginState
|
data PluginEnv = PluginEnv
|
||||||
{ pluginId :: PluginId
|
{ pluginId :: PluginId
|
||||||
, pluginChan :: Chan Message
|
, pluginChan :: Chan Message
|
||||||
, pluginMaster :: Chan Message
|
, pluginMaster :: Chan Message
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
module Hsbot.Utils
|
module Hsbot.Utils
|
||||||
( addThreadIdToQuitMVar
|
( addThreadIdToQuitMVar
|
||||||
, delThreadIdFromQuitMVar
|
, delThreadIdFromQuitMVar
|
||||||
, first
|
|
||||||
, initTLSEnv
|
, initTLSEnv
|
||||||
, readCertificate
|
, readCertificate
|
||||||
, readPrivateKey
|
, readPrivateKey
|
||||||
|
@ -41,9 +40,6 @@ setGlobalQuitMVar status = do
|
||||||
quitMv <- asks envQuitMv
|
quitMv <- asks envQuitMv
|
||||||
liftIO $ putMVar quitMv status
|
liftIO $ putMVar quitMv status
|
||||||
|
|
||||||
first :: (a, b, c) -> a
|
|
||||||
first (a, _, _) = a
|
|
||||||
|
|
||||||
-- Helpers
|
-- Helpers
|
||||||
sendStr :: Handle -> Maybe TLSCtx -> String -> IO ()
|
sendStr :: Handle -> Maybe TLSCtx -> String -> IO ()
|
||||||
sendStr _ (Just ctx) msg = sendData ctx $ L.fromChunks [C.pack msg]
|
sendStr _ (Just ctx) msg = sendData ctx $ L.fromChunks [C.pack msg]
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
Name: hsbot
|
Name: hsbot
|
||||||
Version: 0.4.8
|
Version: 0.4.9
|
||||||
Cabal-version: >=1.2
|
Cabal-version: >=1.2
|
||||||
Synopsis: A multipurposes IRC bot
|
Synopsis: A multipurposes IRC bot
|
||||||
Description:
|
Description:
|
||||||
|
|
Reference in a new issue