netserver/hedgewars-server.hs
changeset 1473 60e1fad78d58
parent 1469 5218aa76939e
child 1474 8817adb86da6
--- a/netserver/hedgewars-server.hs	Tue Nov 04 17:04:54 2008 +0000
+++ b/netserver/hedgewars-server.hs	Tue Nov 04 21:53:30 2008 +0000
@@ -57,7 +57,7 @@
 sendAnswers [] _ clients _ = return clients
 sendAnswers ((handlesFunc, answer):answers) client clients rooms = do
 	let recipients = handlesFunc client clients rooms
-	unless (null recipients) $ putStrLn ("< " ++ (show answer))
+	--unless (null recipients) $ putStrLn ("< " ++ (show answer))
 
 	clHandles' <- forM recipients $
 		\ch -> Control.Exception.handle
@@ -82,7 +82,7 @@
 
 reactCmd :: [String] -> ClientInfo -> [ClientInfo] -> [RoomInfo] -> IO ([ClientInfo], [RoomInfo])
 reactCmd cmd client clients rooms = do
-	putStrLn ("> " ++ show cmd)
+	--putStrLn ("> " ++ show cmd)
 
 	let (clientsFunc, roomsFunc, answers) = handleCmd client clients rooms $ cmd
 	let mrooms = roomsFunc rooms
@@ -91,12 +91,18 @@
 
 	clientsIn <- sendAnswers answers mclient mclients mrooms
 	let quitClient = find forceQuit $ clientsIn
-	if isJust quitClient then reactCmd ["QUIT"] (fromJust quitClient) clientsIn mrooms else return (clientsIn, mrooms)
+	if isJust quitClient then
+		reactCmd ["QUIT"] (fromJust quitClient) clientsIn mrooms
+	else
+		return (clientsIn, mrooms)
 
 
 mainLoop :: Socket -> TChan ClientInfo -> TChan [String] -> [ClientInfo] -> [RoomInfo] -> IO ()
 mainLoop servSock acceptChan messagesChan clients rooms = do
-	r <- atomically $ (Accept `fmap` readTChan acceptChan) `orElse` (ClientMessage `fmap` tselect clients) `orElse` (CoreMessage `fmap` readTChan messagesChan)
+	r <- atomically $
+		(Accept `fmap` readTChan acceptChan) `orElse`
+		(ClientMessage `fmap` tselect clients) `orElse`
+		(CoreMessage `fmap` readTChan messagesChan)
 	case r of
 		Accept ci ->
 			mainLoop servSock acceptChan messagesChan (clients ++ [ci]) rooms
@@ -106,8 +112,9 @@
 			let hadRooms = (not $ null rooms) && (null mrooms)
 				in unless ((not $ isDedicated globalOptions) && ((null clientsIn) || hadRooms)) $
 					mainLoop servSock acceptChan messagesChan clientsIn mrooms
-		CoreMessage msg -> if not $ null $ clients then
-			do
+		CoreMessage msg ->
+			if not $ null $ clients then
+				do
 				let client = head clients -- don't care
 				(clientsIn, mrooms) <- reactCmd msg client clients rooms
 				mainLoop servSock acceptChan messagesChan clientsIn mrooms