netserver/newhwserv.hs
changeset 878 45bff6dadfce
parent 877 ebb801acd8b9
child 889 3bf9dc791f45
equal deleted inserted replaced
877:ebb801acd8b9 878:45bff6dadfce
    37 	r <- atomically $ (Left `fmap` readTChan acceptChan) `orElse` (Right `fmap` tselect clients)
    37 	r <- atomically $ (Left `fmap` readTChan acceptChan) `orElse` (Right `fmap` tselect clients)
    38 	case r of
    38 	case r of
    39 		Left (ch, h) -> do
    39 		Left (ch, h) -> do
    40 			mainLoop servSock acceptChan $ (ch, h):clients
    40 			mainLoop servSock acceptChan $ (ch, h):clients
    41 		Right (line, handle) -> do
    41 		Right (line, handle) -> do
    42 			clients' <- forM clients $ 
    42 			clients' <- forM clients $
    43 					\(ch, h) -> do
    43 					\(ch, h) -> do
    44 						hPutStrLn h line
    44 						hPutStrLn h line
    45 						hFlush h
    45 						hFlush h
    46 						return [(ch,h)]
    46 						return [(ch,h)]
    47 					`catch` const (hClose h >> return [])
    47 					`catch` const (hClose h >> return [])
    53 startServer serverSocket = do
    53 startServer serverSocket = do
    54 	acceptChan <- atomically newTChan
    54 	acceptChan <- atomically newTChan
    55 	forkIO $ acceptLoop serverSocket acceptChan
    55 	forkIO $ acceptLoop serverSocket acceptChan
    56 	mainLoop serverSocket acceptChan []
    56 	mainLoop serverSocket acceptChan []
    57 
    57 
    58 main = withSocketsDo $ do 
    58 main = withSocketsDo $ do
    59 	serverSocket <- listenOn $ Service "hedgewars"
    59 	serverSocket <- listenOn $ Service "hedgewars"
    60 	startServer serverSocket `finally` sClose serverSocket
    60 	startServer serverSocket `finally` sClose serverSocket