summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJulien Dessaux2010-04-21 20:57:22 +0200
committerJulien Dessaux2010-04-21 20:57:22 +0200
commit4c76d3d40bbfea365283c13256b3e7cf2d2deb5e (patch)
treeb5f4e70d225ba0247ad0691e37b45b8cb4142f6c
parentFixed the clean killing of plugin's threads, fixed exception management and c... (diff)
downloadhsbot-4c76d3d40bbfea365283c13256b3e7cf2d2deb5e.tar.gz
hsbot-4c76d3d40bbfea365283c13256b3e7cf2d2deb5e.tar.bz2
hsbot-4c76d3d40bbfea365283c13256b3e7cf2d2deb5e.zip
Fixed several stuff.
-rw-r--r--Hsbot/Command.hs2
-rw-r--r--Hsbot/Core.hs6
-rw-r--r--Hsbot/IRC.hs3
-rw-r--r--Hsbot/IRCParser.hs4
-rw-r--r--Hsbot/Main.hs6
-rw-r--r--Hsbot/Types.hs4
-rw-r--r--Makefile10
-rw-r--r--Plugins/Core.hs6
-rw-r--r--Plugins/Ping.hs2
-rw-r--r--TODO3
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
diff --git a/Makefile b/Makefile
index bc49b08..abd30ba 100644
--- a/Makefile
+++ b/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 \*.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
diff --git a/TODO b/TODO
index 3a6c619..9575ac1 100644
--- a/TODO
+++ b/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