--- a/gameServer/ClientIO.hs Thu Feb 25 15:58:44 2010 +0000
+++ b/gameServer/ClientIO.hs Thu Feb 25 18:28:33 2010 +0000
@@ -3,6 +3,7 @@
import qualified Control.Exception as Exception
import Control.Concurrent.Chan
+import Control.Concurrent
import Control.Monad
import System.IO
----------------
@@ -10,38 +11,39 @@
listenLoop :: Handle -> Int -> [String] -> Chan CoreMessage -> Int -> IO ()
listenLoop handle linesNumber buf chan clientID = do
- str <- hGetLine handle
- if (linesNumber > 50) || (length str > 450) then
- writeChan chan $ ClientMessage (clientID, ["QUIT", "Protocol violation"])
- else
- if str == "" then do
- writeChan chan $ ClientMessage (clientID, buf)
- listenLoop handle 0 [] chan clientID
- else
- listenLoop handle (linesNumber + 1) (buf ++ [str]) chan clientID
+ str <- hGetLine handle
+ if (linesNumber > 50) || (length str > 450) then
+ writeChan chan $ ClientMessage (clientID, ["QUIT", "Protocol violation"])
+ else
+ if str == "" then do
+ writeChan chan $ ClientMessage (clientID, buf)
+ yield
+ listenLoop handle 0 [] chan clientID
+ else
+ listenLoop handle (linesNumber + 1) (buf ++ [str]) chan clientID
clientRecvLoop :: Handle -> Chan CoreMessage -> Int -> IO ()
clientRecvLoop handle chan clientID =
- listenLoop handle 0 [] chan clientID
- `catch` (\e -> clientOff (show e) >> return ())
- where clientOff msg = writeChan chan $ ClientMessage (clientID, ["QUIT", msg]) -- if the client disconnects, we perform as if it sent QUIT message
+ listenLoop handle 0 [] chan clientID
+ `catch` (\e -> clientOff (show e) >> return ())
+ where clientOff msg = writeChan chan $ ClientMessage (clientID, ["QUIT", msg]) -- if the client disconnects, we perform as if it sent QUIT message
clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> Int -> IO()
clientSendLoop handle coreChan chan clientID = do
- answer <- readChan chan
- doClose <- Exception.handle
- (\(e :: Exception.IOException) -> if isQuit answer then return True else sendQuit e >> return False) $ do
- forM_ answer (hPutStrLn handle)
- hPutStrLn handle ""
- hFlush handle
- return $ isQuit answer
+ answer <- readChan chan
+ doClose <- Exception.handle
+ (\(e :: Exception.IOException) -> if isQuit answer then return True else sendQuit e >> return False) $ do
+ forM_ answer (hPutStrLn handle)
+ hPutStrLn handle ""
+ hFlush handle
+ return $ isQuit answer
- if doClose then
- Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on hClose") $ hClose handle
- else
- clientSendLoop handle coreChan chan clientID
+ if doClose then
+ Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on hClose") $ hClose handle
+ else
+ clientSendLoop handle coreChan chan clientID
- where
- sendQuit e = writeChan coreChan $ ClientMessage (clientID, ["QUIT", show e])
- isQuit ("BYE":xs) = True
- isQuit _ = False
+ where
+ sendQuit e = writeChan coreChan $ ClientMessage (clientID, ["QUIT", show e])
+ isQuit ("BYE":xs) = True
+ isQuit _ = False