7 import Data.List |
7 import Data.List |
8 import Maybe (fromJust) |
8 import Maybe (fromJust) |
9 |
9 |
10 |
10 |
11 data ClientInfo = |
11 data ClientInfo = |
12 ClientInfo |
12 ClientInfo |
13 { |
13 { |
14 chan :: TChan String, |
14 chan :: TChan [String], |
15 handle :: Handle, |
15 handle :: Handle, |
16 nick :: String, |
16 nick :: String, |
17 protocol :: Word16, |
17 protocol :: Word16, |
18 room :: String, |
18 room :: String, |
19 isMaster :: Bool |
19 isMaster :: Bool |
20 } |
20 } |
|
21 |
|
22 instance Eq ClientInfo where |
|
23 a1 == a2 = handle a1 == handle a2 |
21 |
24 |
22 data RoomInfo = |
25 data RoomInfo = |
23 RoomInfo |
26 RoomInfo |
24 { |
27 { |
25 name :: String, |
28 name :: String, |
26 password :: String |
29 password :: String |
27 } |
30 } |
28 |
31 |
29 clientByHandle :: Handle -> [ClientInfo] -> ClientInfo |
32 type ClientsTransform = [ClientInfo] -> [ClientInfo] |
30 clientByHandle clhandle clients = fromJust $ find (\ci -> handle ci == clhandle) clients |
33 type RoomsTransform = [RoomInfo] -> [RoomInfo] |
|
34 type HandlesSelector = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [Handle] |
|
35 type CmdHandler = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> (ClientsTransform, RoomsTransform, HandlesSelector, [String]) |
|
36 |
31 |
37 |
32 roomByName :: String -> [RoomInfo] -> RoomInfo |
38 roomByName :: String -> [RoomInfo] -> RoomInfo |
33 roomByName roomName rooms = fromJust $ find (\room -> roomName == name room) rooms |
39 roomByName roomName rooms = fromJust $ find (\room -> roomName == name room) rooms |
34 |
40 |
35 fromRoomHandles :: String -> [ClientInfo] -> [Handle] |
41 tselect :: [ClientInfo] -> STM ([String], ClientInfo) |
36 fromRoomHandles roomName clients = map (\ci -> handle ci) $ filter (\ci -> room ci == roomName) clients |
42 tselect = foldl orElse retry . map (\ci -> (flip (,) ci) `fmap` readTChan (chan ci)) |
37 |
|
38 modifyClient :: Handle -> [ClientInfo] -> (ClientInfo -> ClientInfo) -> [ClientInfo] |
|
39 modifyClient clhandle (cl:cls) func = |
|
40 if handle cl == clhandle then |
|
41 (func cl) : cls |
|
42 else |
|
43 cl : (modifyClient clhandle cls func) |
|
44 |
|
45 tselect :: [ClientInfo] -> STM (String, Handle) |
|
46 tselect = foldl orElse retry . map (\ci -> (flip (,) $ handle ci) `fmap` readTChan (chan ci)) |
|
47 |
43 |
48 maybeRead :: Read a => String -> Maybe a |
44 maybeRead :: Read a => String -> Maybe a |
49 maybeRead s = case reads s of |
45 maybeRead s = case reads s of |
50 [(x, rest)] | all isSpace rest -> Just x |
46 [(x, rest)] | all isSpace rest -> Just x |
51 _ -> Nothing |
47 _ -> Nothing |
54 deleteBy2t _ _ [] = [] |
50 deleteBy2t _ _ [] = [] |
55 deleteBy2t eq x (y:ys) = if y `eq` x then ys else y : deleteBy2t eq x ys |
51 deleteBy2t eq x (y:ys) = if y `eq` x then ys else y : deleteBy2t eq x ys |
56 |
52 |
57 deleteFirstsBy2t :: (a -> b -> Bool) -> [a] -> [b] -> [a] |
53 deleteFirstsBy2t :: (a -> b -> Bool) -> [a] -> [b] -> [a] |
58 deleteFirstsBy2t eq = foldl (flip (deleteBy2t eq)) |
54 deleteFirstsBy2t eq = foldl (flip (deleteBy2t eq)) |
|
55 |
|
56 sameRoom :: HandlesSelector |
|
57 sameRoom client clients rooms = map handle $ filter (\ci -> room ci == room client) clients |
|
58 |
|
59 othersInRoom :: HandlesSelector |
|
60 othersInRoom client clients rooms = map handle $ filter (client /=) $ filter (\ci -> room ci == room client) clients |
|
61 |
|
62 fromRoom :: String -> HandlesSelector |
|
63 fromRoom roomName _ clients _ = map handle $ filter (\ci -> room ci == roomName) clients |
|
64 |
|
65 clientOnly :: HandlesSelector |
|
66 clientOnly client _ _ = [handle client] |
|
67 |
|
68 noChangeClients :: ClientsTransform |
|
69 noChangeClients a = a |
|
70 |
|
71 modifyClient :: ClientInfo -> ClientsTransform |
|
72 modifyClient client (cl:cls) = |
|
73 if cl == client then |
|
74 client : cls |
|
75 else |
|
76 cl : (modifyClient client cls) |
|
77 |
|
78 noChangeRooms :: RoomsTransform |
|
79 noChangeRooms a = a |
|
80 |
|
81 addRoom :: RoomInfo -> RoomsTransform |
|
82 addRoom room rooms = room:rooms |
|
83 |
|
84 removeRoom :: String -> RoomsTransform |
|
85 removeRoom roomname rooms = filter (\rm -> roomname /= name rm) rooms |
|
86 |
|
87 badCmd :: [String] |
|
88 badCmd = ["ERROR", "Bad command, state or incorrect parameter"] |