24 { |
24 { |
25 name :: String, |
25 name :: String, |
26 password :: String |
26 password :: String |
27 } |
27 } |
28 |
28 |
29 |
|
30 sendMsg :: Handle -> String -> IO() |
|
31 sendMsg clientHandle str = finally (return ()) (hPutStrLn clientHandle str >> hFlush clientHandle) -- catch exception when client tries to send to other |
|
32 |
|
33 sendAll :: [Handle] -> String -> IO[()] |
|
34 sendAll clientsList str = mapM (\x -> sendMsg x str) clientsList |
|
35 |
|
36 sendOthers :: [Handle] -> Handle -> String -> IO[()] |
|
37 sendOthers clientsList clientHandle str = sendAll (filter (/= clientHandle) clientsList) str |
|
38 |
|
39 extractCmd :: String -> (String, [String]) |
|
40 extractCmd str = if ws == [] then ("", []) else (head ws, tail ws) |
|
41 where ws = words str |
|
42 |
|
43 manipState :: TVar[a] -> ([a] -> [a]) -> IO() |
|
44 manipState state op = |
|
45 atomically $ do |
|
46 ls <- readTVar state |
|
47 writeTVar state $ op ls |
|
48 |
|
49 manipState2 :: TVar[ClientInfo] -> TVar[RoomInfo] -> ([ClientInfo] -> [RoomInfo] -> ([ClientInfo], [RoomInfo], Bool)) -> IO Bool |
|
50 manipState2 state1 state2 op = |
|
51 atomically $ do |
|
52 ls1 <- readTVar state1 |
|
53 ls2 <- readTVar state2 |
|
54 let (ol1, ol2, res) = op ls1 ls2 |
|
55 writeTVar state1 ol1 |
|
56 writeTVar state2 ol2 |
|
57 return res |
|
58 |
|
59 tselect :: [ClientInfo] -> STM (String, ClientInfo) |
29 tselect :: [ClientInfo] -> STM (String, ClientInfo) |
60 tselect = foldl orElse retry . map (\ci -> (flip (,) ci) `fmap` readTChan (chan ci)) |
30 tselect = foldl orElse retry . map (\ci -> (flip (,) ci) `fmap` readTChan (chan ci)) |
61 |
31 |
62 maybeRead :: Read a => String -> Maybe a |
32 maybeRead :: Read a => String -> Maybe a |
63 maybeRead s = case reads s of |
33 maybeRead s = case reads s of |
64 [(x, rest)] | all isSpace rest -> Just x |
34 [(x, rest)] | all isSpace rest -> Just x |
65 _ -> Nothing |
35 _ -> Nothing |
66 |
|