gameServer/ClientIO.hs
changeset 2296 19f2f76dc346
parent 2126 cb249fa8e3da
child 2348 b39d826e1ccd
equal deleted inserted replaced
2295:2fff3e4ce52f 2296:19f2f76dc346
     1 {-# LANGUAGE PatternSignatures #-}
     1 {-# LANGUAGE CPP, PatternSignatures #-}
     2 module ClientIO where
     2 module ClientIO where
     3 
     3 
     4 import qualified Control.Exception
     4 #if defined(NEW_EXCEPTIONS)
       
     5 import qualified Control.OldException as Exception
       
     6 #else
       
     7 import qualified Control.Exception as Exception
       
     8 #endif
     5 import Control.Concurrent.Chan
     9 import Control.Concurrent.Chan
     6 import Control.Monad
    10 import Control.Monad
     7 import System.IO
    11 import System.IO
     8 ----------------
    12 ----------------
     9 import CoreTypes
    13 import CoreTypes
    27 	where clientOff msg = writeChan chan $ ClientMessage (clientID, ["QUIT", msg]) -- if the client disconnects, we perform as if it sent QUIT message
    31 	where clientOff msg = writeChan chan $ ClientMessage (clientID, ["QUIT", msg]) -- if the client disconnects, we perform as if it sent QUIT message
    28 
    32 
    29 clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> Int -> IO()
    33 clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> Int -> IO()
    30 clientSendLoop handle coreChan chan clientID = do
    34 clientSendLoop handle coreChan chan clientID = do
    31 	answer <- readChan chan
    35 	answer <- readChan chan
    32 	doClose <- Control.Exception.handle
    36 	doClose <- Exception.handle
    33 		(\(e :: Control.Exception.Exception) -> if isQuit answer then return True else sendQuit e >> return False) $ do
    37 		(\(e :: Exception.Exception) -> if isQuit answer then return True else sendQuit e >> return False) $ do
    34 		forM_ answer (\str -> hPutStrLn handle str)
    38 		forM_ answer (\str -> hPutStrLn handle str)
    35 		hPutStrLn handle ""
    39 		hPutStrLn handle ""
    36 		hFlush handle
    40 		hFlush handle
    37 		return $ isQuit answer
    41 		return $ isQuit answer
    38 
    42 
    39 	if doClose then
    43 	if doClose then
    40 		Control.Exception.handle (\(_ :: Control.Exception.Exception) -> putStrLn "error on hClose") $ hClose handle
    44 		Exception.handle (\(_ :: Exception.Exception) -> putStrLn "error on hClose") $ hClose handle
    41 		else
    45 		else
    42 		clientSendLoop handle coreChan chan clientID
    46 		clientSendLoop handle coreChan chan clientID
    43 
    47 
    44 	where
    48 	where
    45 		sendQuit e = writeChan coreChan $ ClientMessage (clientID, ["QUIT", show e])
    49 		sendQuit e = writeChan coreChan $ ClientMessage (clientID, ["QUIT", show e])