netserver/hedgewars-server.hs
changeset 1381 e9754d1d61a9
parent 1370 ff8863ebde17
child 1382 b6ab9fea22fe
equal deleted inserted replaced
1380:f3bdfe2452f2 1381:e9754d1d61a9
     4 import IO
     4 import IO
     5 import System.IO
     5 import System.IO
     6 import Control.Concurrent
     6 import Control.Concurrent
     7 import Control.Concurrent.STM
     7 import Control.Concurrent.STM
     8 import Control.Exception (setUncaughtExceptionHandler, handle, finally)
     8 import Control.Exception (setUncaughtExceptionHandler, handle, finally)
     9 import Control.Monad (forM, forM_, filterM, liftM)
     9 import Control.Monad (forM, forM_, filterM, liftM, unless)
    10 import Maybe (fromMaybe)
    10 import Maybe (fromMaybe)
    11 import Data.List
    11 import Data.List
    12 import Miscutils
    12 import Miscutils
    13 import HWProto
    13 import HWProto
    14 import Opts
    14 import Opts
    42 
    42 
    43 
    43 
    44 sendAnswers [] _ clients _ = return clients
    44 sendAnswers [] _ clients _ = return clients
    45 sendAnswers ((handlesFunc, answer):answers) client clients rooms = do
    45 sendAnswers ((handlesFunc, answer):answers) client clients rooms = do
    46 	let recipients = handlesFunc client clients rooms
    46 	let recipients = handlesFunc client clients rooms
    47 	putStrLn ("< " ++ (show answer))
    47 	unless (null recipients) $ putStrLn ("< " ++ (show answer))
    48 
    48 
    49 	clHandles' <- forM recipients $
    49 	clHandles' <- forM recipients $
    50 		\ch -> Control.Exception.handle (\e -> putStrLn (show e) >> hClose ch >> return [ch]) $
    50 		\ch -> Control.Exception.handle (\e -> putStrLn (show e) >> hClose ch >> return [ch]) $
    51 			if (not $ null answer) && (head answer == "off") then hClose ch >> return [ch] else -- probably client with exception, don't send him anything
       
    52 			do
    51 			do
    53 			forM_ answer (\str -> hPutStrLn ch str)
    52 			forM_ answer (\str -> hPutStrLn ch str)
    54 			hPutStrLn ch ""
    53 			hPutStrLn ch ""
    55 			hFlush ch
    54 			hFlush ch
    56 			if (not $ null answer) && (head answer == "BYE") then hClose ch >> return [ch] else return []
    55 			if (not $ null answer) && (head answer == "BYE") then hClose ch >> return [ch] else return []