netserver/newhwserv.hs
changeset 892 dfe97199f17e
parent 891 701f86df9b4c
child 893 149244d86bf1
equal deleted inserted replaced
891:701f86df9b4c 892:dfe97199f17e
    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 ci -> do
    39 		Left ci -> do
    40 			mainLoop servSock acceptChan (ci:clients) rooms
    40 			mainLoop servSock acceptChan (ci:clients) rooms
    41 		Right (line, client) -> do
    41 		Right (line, client) -> do
    42 			let (doQuit, recipients, strs) = handleCmd client sameRoom rooms $ words line
    42 			let (recipients, strs) = handleCmd client sameRoom rooms $ words line
    43 
    43 
    44 			clients' <- forM recipients $
    44 			clients' <- forM recipients $
    45 					\ci -> do
    45 					\ci -> do
    46 							forM_ strs (\str -> hPutStrLn (handle ci) str)
    46 							forM_ strs (\str -> hPutStrLn (handle ci) str)
    47 							hFlush (handle ci)
    47 							hFlush (handle ci)
    48 							return []
    48 							return []
    49 					`catch` const (hClose (handle ci) >> return [ci])
    49 					`catch` const (hClose (handle ci) >> return [ci])
    50 
    50 
    51 			client' <- if doQuit then hClose (handle client) >> return [client] else return []
    51 			client' <- if head strs == "QUIT" then hClose (handle client) >> return [client] else return []
    52 
    52 
    53 			mainLoop servSock acceptChan (remove (remove clients (concat clients')) client') rooms
    53 			mainLoop servSock acceptChan (remove (remove clients (concat clients')) client') rooms
    54 			where
    54 			where
    55 				sameRoom = filter (\cl -> room cl == room client) clients
    55 				sameRoom = filter (\cl -> room cl == room client) clients
    56 				remove list rmClients = deleteFirstsBy (\ a b -> handle a == handle b) list rmClients
    56 				remove list rmClients = deleteFirstsBy (\ a b -> handle a == handle b) list rmClients