author | unc0rr |
Thu, 01 May 2008 14:30:12 +0000 | |
changeset 894 | 2ca76a7f3121 |
parent 890 | 1d8c4a5ec622 |
child 895 | 6aee2f335726 |
permissions | -rw-r--r-- |
849 | 1 |
module Miscutils where |
2 |
||
3 |
import IO |
|
4 |
import System.IO |
|
5 |
import Control.Concurrent |
|
6 |
import Control.Concurrent.STM |
|
7 |
import Control.Exception (finally) |
|
894 | 8 |
import Data.Word |
9 |
import Data.Char |
|
849 | 10 |
|
851 | 11 |
data ClientInfo = |
12 |
ClientInfo |
|
13 |
{ |
|
889 | 14 |
chan :: TChan String, |
851 | 15 |
handle :: Handle, |
16 |
nick :: String, |
|
894 | 17 |
protocol :: Word16, |
851 | 18 |
room :: String, |
19 |
isMaster :: Bool |
|
20 |
} |
|
21 |
||
22 |
data RoomInfo = |
|
23 |
RoomInfo |
|
24 |
{ |
|
25 |
name :: String, |
|
26 |
password :: String |
|
27 |
} |
|
28 |
||
29 |
||
849 | 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 |
||
852
f756a1d3324c
Handle the case when the room is already created by someone else
unc0rr
parents:
851
diff
changeset
|
49 |
manipState2 :: TVar[ClientInfo] -> TVar[RoomInfo] -> ([ClientInfo] -> [RoomInfo] -> ([ClientInfo], [RoomInfo], Bool)) -> IO Bool |
851 | 50 |
manipState2 state1 state2 op = |
51 |
atomically $ do |
|
52 |
ls1 <- readTVar state1 |
|
53 |
ls2 <- readTVar state2 |
|
852
f756a1d3324c
Handle the case when the room is already created by someone else
unc0rr
parents:
851
diff
changeset
|
54 |
let (ol1, ol2, res) = op ls1 ls2 |
851 | 55 |
writeTVar state1 ol1 |
56 |
writeTVar state2 ol2 |
|
852
f756a1d3324c
Handle the case when the room is already created by someone else
unc0rr
parents:
851
diff
changeset
|
57 |
return res |
889 | 58 |
|
890 | 59 |
tselect :: [ClientInfo] -> STM (String, ClientInfo) |
60 |
tselect = foldl orElse retry . map (\ci -> (flip (,) ci) `fmap` readTChan (chan ci)) |
|
889 | 61 |
|
894 | 62 |
maybeRead :: Read a => String -> Maybe a |
63 |
maybeRead s = case reads s of |
|
64 |
[(x, rest)] | all isSpace rest -> Just x |
|
65 |
_ -> Nothing |
|
66 |