diff -r 95efe37482e3 -r 4e78ad846fb6 gameServer/ClientIO.hs --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/gameServer/ClientIO.hs Wed Feb 18 15:04:40 2009 +0000 @@ -0,0 +1,43 @@ +{-# LANGUAGE PatternSignatures #-} +module ClientIO where + +import qualified Control.Exception +import Control.Concurrent.Chan +import Control.Monad +import System.IO +---------------- +import CoreTypes + +listenLoop :: Handle -> [String] -> Chan CoreMessage -> Int -> IO () +listenLoop handle buf chan clientID = do + str <- hGetLine handle + if str == "" then do + writeChan chan $ ClientMessage (clientID, buf) + listenLoop handle [] chan clientID + else + listenLoop handle (buf ++ [str]) chan clientID + +clientRecvLoop :: Handle -> Chan CoreMessage -> Int -> IO () +clientRecvLoop handle chan clientID = + listenLoop handle [] 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 <- Control.Exception.handle + (\(e :: Control.Exception.Exception) -> if isQuit answer then return True else sendQuit e >> return False) $ do + forM_ answer (\str -> hPutStrLn handle str) + hPutStrLn handle "" + hFlush handle + return $ isQuit answer + + if doClose then + Control.Exception.handle (\(_ :: Control.Exception.Exception) -> putStrLn "error on hClose") $ hClose handle + else + clientSendLoop handle coreChan chan clientID + + where + sendQuit e = writeChan coreChan $ ClientMessage (clientID, ["QUIT", show e]) + isQuit answer = head answer == "BYE"