gameServer/ClientIO.hs
changeset 1804 4e78ad846fb6
child 2001 d909152bdc21
--- /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"