equal
deleted
inserted
replaced
14 acceptLoop :: Socket -> TChan ClientInfo -> IO () |
14 acceptLoop :: Socket -> TChan ClientInfo -> IO () |
15 acceptLoop servSock acceptChan = do |
15 acceptLoop servSock acceptChan = do |
16 (cHandle, host, port) <- accept servSock |
16 (cHandle, host, port) <- accept servSock |
17 cChan <- atomically newTChan |
17 cChan <- atomically newTChan |
18 forkIO $ clientLoop cHandle cChan |
18 forkIO $ clientLoop cHandle cChan |
19 atomically $ writeTChan acceptChan (ClientInfo cChan cHandle "" "" False) |
19 atomically $ writeTChan acceptChan (ClientInfo cChan cHandle "" 0 "" False) |
20 acceptLoop servSock acceptChan |
20 acceptLoop servSock acceptChan |
21 |
21 |
22 listenLoop :: Handle -> TChan String -> IO () |
22 listenLoop :: Handle -> TChan String -> IO () |
23 listenLoop handle chan = do |
23 listenLoop handle chan = do |
24 str <- hGetLine handle |
24 str <- hGetLine handle |
27 |
27 |
28 clientLoop :: Handle -> TChan String -> IO () |
28 clientLoop :: Handle -> TChan String -> IO () |
29 clientLoop handle chan = |
29 clientLoop handle chan = |
30 listenLoop handle chan |
30 listenLoop handle chan |
31 `catch` (const $ clientOff >> return ()) |
31 `catch` (const $ clientOff >> return ()) |
32 `finally` hClose handle |
|
33 where clientOff = atomically $ writeTChan chan "QUIT" |
32 where clientOff = atomically $ writeTChan chan "QUIT" |
34 |
33 |
35 mainLoop :: Socket -> TChan ClientInfo -> [ClientInfo] -> [RoomInfo] -> IO () |
34 mainLoop :: Socket -> TChan ClientInfo -> [ClientInfo] -> [RoomInfo] -> IO () |
36 mainLoop servSock acceptChan clients rooms = do |
35 mainLoop servSock acceptChan clients rooms = do |
37 r <- atomically $ (Left `fmap` readTChan acceptChan) `orElse` (Right `fmap` tselect clients) |
36 r <- atomically $ (Left `fmap` readTChan acceptChan) `orElse` (Right `fmap` tselect clients) |
46 forM_ strs (\str -> hPutStrLn (handle ci) str) |
45 forM_ strs (\str -> hPutStrLn (handle ci) str) |
47 hFlush (handle ci) |
46 hFlush (handle ci) |
48 return [] |
47 return [] |
49 `catch` const (hClose (handle ci) >> return [ci]) |
48 `catch` const (hClose (handle ci) >> return [ci]) |
50 |
49 |
51 client' <- if head strs == "QUIT" then hClose (handle client) >> return [client] else return [] |
50 client' <- if (not $ null strs) && (head strs == "QUIT") then hClose (handle client) >> return [client] else return [] |
52 |
51 |
53 mainLoop servSock acceptChan (remove (remove (mclient : filter (\cl -> handle cl /= handle client) clients) (concat clients')) client') mrooms |
52 mainLoop servSock acceptChan (remove (remove (mclient : filter (\cl -> handle cl /= handle client) clients) (concat clients')) client') mrooms |
54 where |
53 where |
55 remove list rmClients = deleteFirstsBy (\ a b -> handle a == handle b) list rmClients |
54 remove list rmClients = deleteFirstsBy (\ a b -> handle a == handle b) list rmClients |
56 |
55 |