Fixed several stuff.

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

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 ()
 

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 ()

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]

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)
+    bot' <- (execStateT run bot) `catch` (\(_ :: IOException) -> return bot)
-    evalStateT disconnectServer bot
+    evalStateT disconnectServer bot'
 
 -- | The Bot monad main function
 run :: IrcBot ()

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

Makefile

@@ -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 \*.o -exec rm {} \;
-	- find ./ -name \*.hi -exec rm {} +
+	- find ./ -name \*.hi -exec rm {} \;
 

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)
+    plugin' <- (execStateT run plugin) `catch` (\(_ :: AsyncException) -> return plugin)
-    evalStateT (mapM_ sendUnregisterCommand ["list", "load", "reload", "unload"]) plugin
+    evalStateT (mapM_ sendUnregisterCommand ["list", "load", "reload", "unload"]) plugin'
 
 -- | The IrcPlugin monad main function
 run :: IrcPlugin ()

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

TODO

@@ -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