80 when (ri /= lobbyId) $ error "Empty struct inserts not at firstIndex index" |
80 when (ri /= lobbyId) $ error "Empty struct inserts not at firstIndex index" |
81 return rnc |
81 return rnc |
82 |
82 |
83 |
83 |
84 roomAddClient :: ClientIndex -> Room r -> Room r |
84 roomAddClient :: ClientIndex -> Room r -> Room r |
85 roomAddClient cl room = let cls = cl : roomClients' room; nr = room{roomClients' = cls} in cls `seq` nr `seq` nr |
85 roomAddClient cl rm = let cls = cl : roomClients' rm; nr = rm{roomClients' = cls} in cls `seq` nr |
86 |
86 |
87 roomRemoveClient :: ClientIndex -> Room r -> Room r |
87 roomRemoveClient :: ClientIndex -> Room r -> Room r |
88 roomRemoveClient cl room = let cls = filter (/= cl) $ roomClients' room; nr = room{roomClients' = cls} in cls `seq` nr `seq` nr |
88 roomRemoveClient cl rm = let cls = filter (/= cl) $ roomClients' rm; nr = rm{roomClients' = cls} in cls `seq` nr |
89 |
89 |
90 |
90 |
91 addRoom :: MRoomsAndClients r c -> r -> IO RoomIndex |
91 addRoom :: MRoomsAndClients r c -> r -> IO RoomIndex |
92 addRoom (MRoomsAndClients (rooms, _)) room = do |
92 addRoom (MRoomsAndClients (rooms, _)) rm = do |
93 i <- addElem rooms (Room [] room) |
93 i <- addElem rooms (Room [] rm) |
94 return $ RoomIndex i |
94 return $ RoomIndex i |
95 |
95 |
96 |
96 |
97 addClient :: MRoomsAndClients r c -> c -> IO ClientIndex |
97 addClient :: MRoomsAndClients r c -> c -> IO ClientIndex |
98 addClient (MRoomsAndClients (rooms, clients)) client = do |
98 addClient (MRoomsAndClients (rooms, clients)) cl = do |
99 i <- addElem clients (Client lobbyId client) |
99 i <- addElem clients (Client lobbyId cl) |
100 modifyElem rooms (roomAddClient (ClientIndex i)) (unRoomIndex lobbyId) |
100 modifyElem rooms (roomAddClient (ClientIndex i)) (unRoomIndex lobbyId) |
101 return $ ClientIndex i |
101 return $ ClientIndex i |
102 |
102 |
103 removeRoom :: MRoomsAndClients r c -> RoomIndex -> IO () |
103 removeRoom :: MRoomsAndClients r c -> RoomIndex -> IO () |
104 removeRoom rnc@(MRoomsAndClients (rooms, _)) room@(RoomIndex ri) |
104 removeRoom rnc@(MRoomsAndClients (rooms, _)) rm@(RoomIndex ri) |
105 | room == lobbyId = error "Cannot delete lobby" |
105 | rm == lobbyId = error "Cannot delete lobby" |
106 | otherwise = do |
106 | otherwise = do |
107 clIds <- liftM roomClients' $ readElem rooms ri |
107 clIds <- liftM roomClients' $ readElem rooms ri |
108 forM_ clIds (moveClientToLobby rnc) |
108 forM_ clIds (moveClientToLobby rnc) |
109 removeElem rooms ri |
109 removeElem rooms ri |
110 |
110 |
129 modifyElem clients (\c -> c{clientRoom' = rt}) ci |
129 modifyElem clients (\c -> c{clientRoom' = rt}) ci |
130 |
130 |
131 |
131 |
132 moveClientToLobby :: MRoomsAndClients r c -> ClientIndex -> IO () |
132 moveClientToLobby :: MRoomsAndClients r c -> ClientIndex -> IO () |
133 moveClientToLobby rnc ci = do |
133 moveClientToLobby rnc ci = do |
134 room <- clientRoomM rnc ci |
134 rm <- clientRoomM rnc ci |
135 moveClientInRooms rnc room lobbyId ci |
135 moveClientInRooms rnc rm lobbyId ci |
136 |
136 |
137 |
137 |
138 moveClientToRoom :: MRoomsAndClients r c -> RoomIndex -> ClientIndex -> IO () |
138 moveClientToRoom :: MRoomsAndClients r c -> RoomIndex -> ClientIndex -> IO () |
139 moveClientToRoom rnc ri ci = moveClientInRooms rnc lobbyId ri ci |
139 moveClientToRoom rnc = moveClientInRooms rnc lobbyId |
140 |
140 |
141 |
141 |
142 clientExists :: MRoomsAndClients r c -> ClientIndex -> IO Bool |
142 clientExists :: MRoomsAndClients r c -> ClientIndex -> IO Bool |
143 clientExists (MRoomsAndClients (_, clients)) (ClientIndex ci) = elemExists clients ci |
143 clientExists (MRoomsAndClients (_, clients)) (ClientIndex ci) = elemExists clients ci |
144 |
144 |
153 |
153 |
154 allClientsM :: MRoomsAndClients r c -> IO [ClientIndex] |
154 allClientsM :: MRoomsAndClients r c -> IO [ClientIndex] |
155 allClientsM (MRoomsAndClients (_, clients)) = liftM (map ClientIndex) $ indicesM clients |
155 allClientsM (MRoomsAndClients (_, clients)) = liftM (map ClientIndex) $ indicesM clients |
156 |
156 |
157 clientsM :: MRoomsAndClients r c -> IO [c] |
157 clientsM :: MRoomsAndClients r c -> IO [c] |
158 clientsM (MRoomsAndClients (_, clients)) = indicesM clients >>= mapM (\ci -> liftM client' $ readElem clients ci) |
158 clientsM (MRoomsAndClients (_, clients)) = indicesM clients >>= mapM (liftM client' . readElem clients) |
159 |
159 |
160 roomClientsIndicesM :: MRoomsAndClients r c -> RoomIndex -> IO [ClientIndex] |
160 roomClientsIndicesM :: MRoomsAndClients r c -> RoomIndex -> IO [ClientIndex] |
161 roomClientsIndicesM (MRoomsAndClients (rooms, clients)) (RoomIndex ri) = liftM roomClients' (rooms `readElem` ri) |
161 roomClientsIndicesM (MRoomsAndClients (rooms, _)) (RoomIndex ri) = liftM roomClients' (rooms `readElem` ri) |
162 |
162 |
163 roomClientsM :: MRoomsAndClients r c -> RoomIndex -> IO [c] |
163 roomClientsM :: MRoomsAndClients r c -> RoomIndex -> IO [c] |
164 roomClientsM (MRoomsAndClients (rooms, clients)) (RoomIndex ri) = liftM roomClients' (rooms `readElem` ri) >>= mapM (\(ClientIndex ci) -> liftM client' $ readElem clients ci) |
164 roomClientsM (MRoomsAndClients (rooms, clients)) (RoomIndex ri) = liftM roomClients' (rooms `readElem` ri) >>= mapM (\(ClientIndex ci) -> liftM client' $ readElem clients ci) |
165 |
165 |
166 withRoomsAndClients :: MRoomsAndClients r c -> (IRoomsAndClients r c -> a) -> IO a |
166 withRoomsAndClients :: MRoomsAndClients r c -> (IRoomsAndClients r c -> a) -> IO a |
171 ----------- IRoomsAndClients ----------- |
171 ----------- IRoomsAndClients ----------- |
172 |
172 |
173 showRooms :: (Show r, Show c) => IRoomsAndClients r c -> String |
173 showRooms :: (Show r, Show c) => IRoomsAndClients r c -> String |
174 showRooms rnc@(IRoomsAndClients (rooms, clients)) = concatMap showRoom (allRooms rnc) |
174 showRooms rnc@(IRoomsAndClients (rooms, clients)) = concatMap showRoom (allRooms rnc) |
175 where |
175 where |
176 showRoom r = unlines $ ((show r) ++ ": " ++ (show $ room' $ rooms ! (unRoomIndex r))) : (map showClient (roomClients' $ rooms ! (unRoomIndex r))) |
176 showRoom r = unlines $ (show r ++ ": " ++ (show . room' $ rooms ! unRoomIndex r)) : map showClient (roomClients' $ rooms ! unRoomIndex r) |
177 showClient c = " " ++ (show c) ++ ": " ++ (show $ client' $ clients ! (unClientIndex c)) |
177 showClient c = " " ++ show c ++ ": " ++ (show . client' $ clients ! unClientIndex c) |
178 |
178 |
179 |
179 |
180 allRooms :: IRoomsAndClients r c -> [RoomIndex] |
180 allRooms :: IRoomsAndClients r c -> [RoomIndex] |
181 allRooms (IRoomsAndClients (rooms, _)) = map RoomIndex $ indices rooms |
181 allRooms (IRoomsAndClients (rooms, _)) = map RoomIndex $ indices rooms |
182 |
182 |
191 |
191 |
192 room :: IRoomsAndClients r c -> RoomIndex -> r |
192 room :: IRoomsAndClients r c -> RoomIndex -> r |
193 room (IRoomsAndClients (rooms, _)) (RoomIndex ri) = room' (rooms ! ri) |
193 room (IRoomsAndClients (rooms, _)) (RoomIndex ri) = room' (rooms ! ri) |
194 |
194 |
195 roomClients :: IRoomsAndClients r c -> RoomIndex -> [ClientIndex] |
195 roomClients :: IRoomsAndClients r c -> RoomIndex -> [ClientIndex] |
196 roomClients (IRoomsAndClients (rooms, _)) (RoomIndex ri) = roomClients' $ (rooms ! ri) |
196 roomClients (IRoomsAndClients (rooms, _)) (RoomIndex ri) = roomClients' (rooms ! ri) |