equal
deleted
inserted
replaced
31 |
31 |
32 clientLoop :: Handle -> TChan [String] -> IO () |
32 clientLoop :: Handle -> TChan [String] -> IO () |
33 clientLoop handle chan = |
33 clientLoop handle chan = |
34 listenLoop handle [] chan |
34 listenLoop handle [] chan |
35 `catch` (const $ clientOff >> return ()) |
35 `catch` (const $ clientOff >> return ()) |
36 where clientOff = atomically $ writeTChan chan ["QUIT"] |
36 where clientOff = atomically $ writeTChan chan ["QUIT"] -- если клиент отключается, то делаем вид, что от него пришла команда QUIT |
37 |
37 |
38 mainLoop :: Socket -> TChan ClientInfo -> [ClientInfo] -> [RoomInfo] -> IO () |
38 mainLoop :: Socket -> TChan ClientInfo -> [ClientInfo] -> [RoomInfo] -> IO () |
39 mainLoop servSock acceptChan clients rooms = do |
39 mainLoop servSock acceptChan clients rooms = do |
40 r <- atomically $ (Left `fmap` readTChan acceptChan) `orElse` (Right `fmap` tselect clients) |
40 r <- atomically $ (Left `fmap` readTChan acceptChan) `orElse` (Right `fmap` tselect clients) |
41 case r of |
41 case r of |
46 let (clientsFunc, roomsFunc, handlesFunc, answer) = handleCmd client clients rooms $ cmd |
46 let (clientsFunc, roomsFunc, handlesFunc, answer) = handleCmd client clients rooms $ cmd |
47 putStrLn ("< " ++ show answer) |
47 putStrLn ("< " ++ show answer) |
48 |
48 |
49 let mclients = clientsFunc clients |
49 let mclients = clientsFunc clients |
50 let mrooms = roomsFunc rooms |
50 let mrooms = roomsFunc rooms |
51 let recipients = handlesFunc client clients rooms |
51 let recipients = handlesFunc client mclients mrooms |
52 |
52 |
53 clHandles' <- forM recipients $ |
53 clHandles' <- forM recipients $ |
54 \ch -> do |
54 \ch -> do |
55 forM_ answer (\str -> hPutStrLn ch str) |
55 forM_ answer (\str -> hPutStrLn ch str) |
56 hPutStrLn ch "" |
56 hPutStrLn ch "" |