diff options
| -rw-r--r-- | Hsbot/Command.hs | 2 | ||||
| -rw-r--r-- | Hsbot/Core.hs | 6 | ||||
| -rw-r--r-- | Hsbot/IRC.hs | 3 | ||||
| -rw-r--r-- | Hsbot/IRCParser.hs | 4 | ||||
| -rw-r--r-- | Hsbot/Main.hs | 6 | ||||
| -rw-r--r-- | Hsbot/Types.hs | 4 | ||||
| -rw-r--r-- | Makefile | 10 | ||||
| -rw-r--r-- | Plugins/Core.hs | 6 | ||||
| -rw-r--r-- | Plugins/Ping.hs | 2 | ||||
| -rw-r--r-- | TODO | 3 |
10 files changed, 25 insertions, 21 deletions
diff --git a/Hsbot/Command.hs b/Hsbot/Command.hs index 76f1d04..3977a57 100644 --- a/Hsbot/Command.hs +++ b/Hsbot/Command.hs @@ -58,7 +58,7 @@ dispatchMessage (InputMsg inputMsg) = do sendRunCommand cmd plugin = do sendToPlugin (InternalCmd $ IntCmd "RUN" "CORE" (pluginName plugin) cmd) plugin getMsgContent :: String - getMsgContent = (parameters inputMsg) !! 1 + getMsgContent = unwords . tail $ parameters inputMsg dispatchMessage _ = return () -- | Processes an internal command diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs index a8f29ec..e3ce3eb 100644 --- a/Hsbot/Core.hs +++ b/Hsbot/Core.hs @@ -4,9 +4,9 @@ module Hsbot.Core ) where import Control.Concurrent -import Control.Concurrent.Chan +import Control.Concurrent.Chan() import Control.Monad.State -import Data.List +import Data.List() import qualified Data.Map as M import Network import System.IO @@ -36,8 +36,8 @@ connectServer server = do disconnectServer :: IrcBot () disconnectServer = do bot <- get - liftIO $ killThread $ readerThreadId bot mapM_ unloadPlugin (M.keys $ botPlugins bot) + liftIO $ killThread $ readerThreadId bot liftIO $ hClose $ botHandle bot return () diff --git a/Hsbot/IRC.hs b/Hsbot/IRC.hs index c837a4f..1eac2d8 100644 --- a/Hsbot/IRC.hs +++ b/Hsbot/IRC.hs @@ -23,7 +23,7 @@ initServer = do -- | Run a server runServer :: IrcBot () -runServer = do +runServer = forever $ do chan <- gets botChannel let input = readChan chan msg <- liftIO input @@ -31,7 +31,6 @@ runServer = do InputMsg inputMsg -> dispatchMessage $ InputMsg inputMsg OutputMsg outputMsg -> sendstr (serializeIrcMsg outputMsg) InternalCmd internalCmd -> processInternalCommand $ InternalCmd internalCmd - runServer -- | Joins a chan joinChan :: String -> IrcBot () diff --git a/Hsbot/IRCParser.hs b/Hsbot/IRCParser.hs index ebf8f71..a5f2e41 100644 --- a/Hsbot/IRCParser.hs +++ b/Hsbot/IRCParser.hs @@ -24,9 +24,9 @@ pMsg = do pPrefix :: ParsecT String u Identity [Char] pPrefix = do - char ':' + _ <- char ':' pfx <- many1 (noneOf " ") - space + _ <- space return pfx pCommand :: ParsecT String u Identity [Char] diff --git a/Hsbot/Main.hs b/Hsbot/Main.hs index 592fefa..5bf03bf 100644 --- a/Hsbot/Main.hs +++ b/Hsbot/Main.hs @@ -5,7 +5,7 @@ module Hsbot.Main import Control.Exception import Control.Monad.State import Prelude hiding (catch) -import System.IO +import System.IO() import Config import Hsbot.Core @@ -17,8 +17,8 @@ import Hsbot.Types imain :: IO () imain = do bot <- connectServer $ ircServer config - (execStateT run bot) `catch` (\(ex :: IOException) -> return bot) - evalStateT disconnectServer bot + bot' <- (execStateT run bot) `catch` (\(_ :: IOException) -> return bot) + evalStateT disconnectServer bot' -- | The Bot monad main function run :: IrcBot () diff --git a/Hsbot/Types.hs b/Hsbot/Types.hs index 99619ee..acca137 100644 --- a/Hsbot/Types.hs +++ b/Hsbot/Types.hs @@ -13,7 +13,7 @@ module Hsbot.Types ) where import Control.Concurrent -import Control.Concurrent.Chan +import Control.Concurrent.Chan() import Control.Monad.State import qualified Data.Map as M import Network @@ -97,7 +97,7 @@ data IntCmd = IntCmd , intCmdMsg :: String -- the IrcMsg associated with the command } deriving (Show) -data BotMsg = InputMsg IrcMsg | OutputMsg IrcMsg | InternalCmd IntCmd +data BotMsg = InputMsg IrcMsg | OutputMsg IrcMsg | InternalCmd IntCmd deriving (Show) -- | A plugin (core side) data Plugin = Plugin @@ -1,8 +1,14 @@ all: ghc --make -Wall -O2 Main.hs -o hsbot -XScopedTypeVariables +listen: + nc -l 127.0.0.1 6667 + +run: + runghc -XScopedTypeVariables Main + clean: - rm hsbot - - find ./ -name \*.o -exec rm {} + - - find ./ -name \*.hi -exec rm {} + + - find ./ -name \*.o -exec rm {} \; + - find ./ -name \*.hi -exec rm {} \; diff --git a/Plugins/Core.hs b/Plugins/Core.hs index b05e9aa..123d2e6 100644 --- a/Plugins/Core.hs +++ b/Plugins/Core.hs @@ -2,7 +2,7 @@ module Plugins.Core ( mainCore ) where -import Control.Concurrent.Chan +import Control.Concurrent.Chan(Chan) import Control.Exception import Control.Monad.State import Prelude hiding (catch) @@ -16,8 +16,8 @@ mainCore :: Chan BotMsg -> Chan BotMsg -> IO () mainCore serverChan chan = do let plugin = PluginInstance "Core" serverChan chan evalStateT (mapM_ sendRegisterCommand ["list", "load", "reload", "unload"]) plugin - (execStateT run plugin) `catch` (\(ex :: AsyncException) -> return plugin) - evalStateT (mapM_ sendUnregisterCommand ["list", "load", "reload", "unload"]) plugin + plugin' <- (execStateT run plugin) `catch` (\(_ :: AsyncException) -> return plugin) + evalStateT (mapM_ sendUnregisterCommand ["list", "load", "reload", "unload"]) plugin' -- | The IrcPlugin monad main function run :: IrcPlugin () diff --git a/Plugins/Ping.hs b/Plugins/Ping.hs index 8258bcf..f478582 100644 --- a/Plugins/Ping.hs +++ b/Plugins/Ping.hs @@ -14,7 +14,7 @@ import Hsbot.Types mainPing :: Chan BotMsg -> Chan BotMsg -> IO () mainPing serverChan chan = do let plugin = PluginInstance "Ping" serverChan chan - (execStateT run plugin) `catch` (\(ex :: AsyncException) -> return plugin) + _ <- (execStateT run plugin) `catch` (\(_ :: AsyncException) -> return plugin) return () -- | The IrcPlugin monad main function @@ -1,13 +1,12 @@ :julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif +* Solve the catching that never happen in main * throwto exception to main thread * list plugins * write a safe reload : try reload before unloading * discard all trace with a color param and replace those with functions info/warn/error/debug * clean the plugin module -* kill threads -* plugin reload * list modules command * part chan |