Fixed the clean killing of plugin's threads, fixed exception management and cleaned plugins' main functions.
This commit is contained in:
parent
416460886d
commit
bfc06f1ff1
7 changed files with 27 additions and 33 deletions
|
@ -3,7 +3,9 @@ module Plugins.Core
|
|||
) where
|
||||
|
||||
import Control.Concurrent.Chan
|
||||
import Control.Exception
|
||||
import Control.Monad.State
|
||||
import Prelude hiding (catch)
|
||||
|
||||
import Hsbot.IRCPlugin
|
||||
import Hsbot.Types
|
||||
|
@ -13,18 +15,13 @@ import Hsbot.Utils
|
|||
mainCore :: Chan BotMsg -> Chan BotMsg -> IO ()
|
||||
mainCore serverChan chan = do
|
||||
let plugin = PluginInstance "Core" serverChan chan
|
||||
(runStateT run plugin) `catch` (const $ return ((), plugin))
|
||||
return ()
|
||||
evalStateT (mapM_ sendRegisterCommand ["list", "load", "reload", "unload"]) plugin
|
||||
(execStateT run plugin) `catch` (\(ex :: AsyncException) -> return plugin)
|
||||
evalStateT (mapM_ sendUnregisterCommand ["list", "load", "reload", "unload"]) plugin
|
||||
|
||||
-- | The IrcPlugin monad main function
|
||||
run :: IrcPlugin ()
|
||||
run = do
|
||||
mapM_ sendRegisterCommand ["load", "reload", "unload"]
|
||||
runPlugin
|
||||
mapM_ sendUnregisterCommand ["load", "reload", "unload"]
|
||||
|
||||
runPlugin :: IrcPlugin ()
|
||||
runPlugin = forever $ do
|
||||
run = forever $ do
|
||||
msg <- readMsg
|
||||
eval msg
|
||||
where
|
||||
|
|
|
@ -3,7 +3,9 @@ module Plugins.Ping
|
|||
) where
|
||||
|
||||
import Control.Concurrent.Chan
|
||||
import Control.Exception
|
||||
import Control.Monad.State
|
||||
import Prelude hiding (catch)
|
||||
|
||||
import Hsbot.IRCPlugin
|
||||
import Hsbot.Types
|
||||
|
@ -12,7 +14,7 @@ import Hsbot.Types
|
|||
mainPing :: Chan BotMsg -> Chan BotMsg -> IO ()
|
||||
mainPing serverChan chan = do
|
||||
let plugin = PluginInstance "Ping" serverChan chan
|
||||
(runStateT run plugin) `catch` (const $ return ((), plugin))
|
||||
(execStateT run plugin) `catch` (\(ex :: AsyncException) -> return plugin)
|
||||
return ()
|
||||
|
||||
-- | The IrcPlugin monad main function
|
||||
|
|
|
@ -3,7 +3,9 @@ module Plugins.Quote
|
|||
) where
|
||||
|
||||
import Control.Concurrent.Chan
|
||||
import Control.Exception
|
||||
import Control.Monad.State
|
||||
import Prelude hiding (catch)
|
||||
import System.Time (ClockTime)
|
||||
|
||||
import Hsbot.IRCPlugin
|
||||
|
@ -28,24 +30,13 @@ type QuoteBot a = StateT QuoteDB IO a
|
|||
mainQuote :: Chan BotMsg -> Chan BotMsg -> IO ()
|
||||
mainQuote serverChan chan = do
|
||||
let plugin = PluginInstance "Quote" serverChan chan
|
||||
plugin' <- (execStateT run plugin) `catch` (const $ return plugin)
|
||||
putStrLn "graou"
|
||||
evalStateT stop plugin'
|
||||
evalStateT (mapM_ sendRegisterCommand ["quote"]) plugin
|
||||
(execStateT run plugin) `catch` (\(ex :: AsyncException) -> return plugin)
|
||||
evalStateT (mapM_ sendUnregisterCommand ["quote"]) plugin
|
||||
|
||||
-- | The IrcPlugin monad main function
|
||||
run :: IrcPlugin ()
|
||||
run = do
|
||||
-- TODO : init quote handling (sqlite + structure to handle temporary stuff)
|
||||
sendRegisterCommand "quote"
|
||||
runPlugin
|
||||
|
||||
stop :: IrcPlugin ()
|
||||
stop = do
|
||||
sendUnregisterCommand "quote"
|
||||
-- TODO : send cancel messages for all temporary stuff
|
||||
|
||||
runPlugin :: IrcPlugin ()
|
||||
runPlugin = forever $ do
|
||||
run = forever $ do
|
||||
msg <- readMsg
|
||||
eval msg
|
||||
where
|
||||
|
|
Reference in a new issue