gameServer/RoomsAndClients.hs
author nemo
Sun, 23 Nov 2014 18:10:15 -0500
changeset 10544 37b0e1f92e3c
parent 10460 8dcea9087d75
child 11046 47a8c19ecb60
permissions -rw-r--r--
prevent seduction of frozen hogs
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
10460
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10216
diff changeset
     1
{-
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10216
diff changeset
     2
 * Hedgewars, a free turn based strategy game
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10216
diff changeset
     3
 * Copyright (c) 2004-2014 Andrey Korotaev <unC0Rr@gmail.com>
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10216
diff changeset
     4
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10216
diff changeset
     5
 * This program is free software; you can redistribute it and/or modify
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10216
diff changeset
     6
 * it under the terms of the GNU General Public License as published by
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10216
diff changeset
     7
 * the Free Software Foundation; version 2 of the License
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10216
diff changeset
     8
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10216
diff changeset
     9
 * This program is distributed in the hope that it will be useful,
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10216
diff changeset
    10
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10216
diff changeset
    11
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10216
diff changeset
    12
 * GNU General Public License for more details.
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10216
diff changeset
    13
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10216
diff changeset
    14
 * You should have received a copy of the GNU General Public License
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10216
diff changeset
    15
 * along with this program; if not, write to the Free Software
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10216
diff changeset
    16
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10216
diff changeset
    17
 \-}
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10216
diff changeset
    18
6805
097289be7200 Add more strictness in hope it will help with space leak
unc0rr
parents: 4932
diff changeset
    19
{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving #-}
097289be7200 Add more strictness in hope it will help with space leak
unc0rr
parents: 4932
diff changeset
    20
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    21
module RoomsAndClients(
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    22
    RoomIndex(),
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    23
    ClientIndex(),
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    24
    MRoomsAndClients(),
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    25
    IRoomsAndClients(),
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    26
    newRoomsAndClients,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    27
    addRoom,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    28
    addClient,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    29
    removeRoom,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    30
    removeClient,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    31
    modifyRoom,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    32
    modifyClient,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    33
    lobbyId,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    34
    moveClientToLobby,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    35
    moveClientToRoom,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    36
    clientRoomM,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    37
    clientExists,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    38
    client,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    39
    room,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    40
    client'sM,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    41
    room'sM,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    42
    allClientsM,
10216
6928a323097f Fix build
unc0rr
parents: 10215
diff changeset
    43
    allRoomsM,
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    44
    clientsM,
8452
170afc3ac39f Also rooms per version stats
unc0rr
parents: 6805
diff changeset
    45
    roomsM,
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    46
    roomClientsM,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    47
    roomClientsIndicesM,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    48
    withRoomsAndClients,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    49
    allRooms,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    50
    allClients,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    51
    clientRoom,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    52
    showRooms,
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    53
    roomClients
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    54
    ) where
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    55
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    56
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    57
import Store
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    58
import Control.Monad
6805
097289be7200 Add more strictness in hope it will help with space leak
unc0rr
parents: 4932
diff changeset
    59
import Control.DeepSeq
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    60
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    61
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    62
data Room r = Room {
6805
097289be7200 Add more strictness in hope it will help with space leak
unc0rr
parents: 4932
diff changeset
    63
    roomClients' :: ![ClientIndex],
097289be7200 Add more strictness in hope it will help with space leak
unc0rr
parents: 4932
diff changeset
    64
    room' :: !r
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    65
    }
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    66
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    67
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    68
data Client c = Client {
6805
097289be7200 Add more strictness in hope it will help with space leak
unc0rr
parents: 4932
diff changeset
    69
    clientRoom' :: !RoomIndex,
097289be7200 Add more strictness in hope it will help with space leak
unc0rr
parents: 4932
diff changeset
    70
    client' :: !c
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    71
    }
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    72
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    73
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    74
newtype RoomIndex = RoomIndex ElemIndex
6805
097289be7200 Add more strictness in hope it will help with space leak
unc0rr
parents: 4932
diff changeset
    75
    deriving (Eq, NFData)
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    76
newtype ClientIndex = ClientIndex ElemIndex
6805
097289be7200 Add more strictness in hope it will help with space leak
unc0rr
parents: 4932
diff changeset
    77
    deriving (Eq, Show, Read, Ord, NFData)
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    78
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    79
instance Show RoomIndex where
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    80
    show (RoomIndex i) = 'r' : show i
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    81
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    82
unRoomIndex :: RoomIndex -> ElemIndex
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    83
unRoomIndex (RoomIndex r) = r
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    84
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    85
unClientIndex :: ClientIndex -> ElemIndex
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    86
unClientIndex (ClientIndex c) = c
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    87
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    88
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    89
newtype MRoomsAndClients r c = MRoomsAndClients (MStore (Room r), MStore (Client c))
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    90
newtype IRoomsAndClients r c = IRoomsAndClients (IStore (Room r), IStore (Client c))
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    91
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    92
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    93
lobbyId :: RoomIndex
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    94
lobbyId = RoomIndex firstIndex
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    95
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    96
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    97
newRoomsAndClients :: r -> IO (MRoomsAndClients r c)
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    98
newRoomsAndClients r = do
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
    99
    rooms <- newStore
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   100
    clients <- newStore
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   101
    let rnc = MRoomsAndClients (rooms, clients)
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   102
    ri <- addRoom rnc r
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   103
    when (ri /= lobbyId) $ error "Empty struct inserts not at firstIndex index"
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   104
    return rnc
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   105
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   106
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   107
roomAddClient :: ClientIndex -> Room r -> Room r
6805
097289be7200 Add more strictness in hope it will help with space leak
unc0rr
parents: 4932
diff changeset
   108
roomAddClient cl rm = let cls = cl : roomClients' rm; nr = rm{roomClients' = cls} in cls `deepseq` nr
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   109
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   110
roomRemoveClient :: ClientIndex -> Room r -> Room r
6805
097289be7200 Add more strictness in hope it will help with space leak
unc0rr
parents: 4932
diff changeset
   111
roomRemoveClient cl rm = let cls = filter (/= cl) $ roomClients' rm; nr = rm{roomClients' = cls} in cls `deepseq` nr
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   112
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   113
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   114
addRoom :: MRoomsAndClients r c -> r -> IO RoomIndex
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4905
diff changeset
   115
addRoom (MRoomsAndClients (rooms, _)) rm = do
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4905
diff changeset
   116
    i <- addElem rooms (Room  [] rm)
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   117
    return $ RoomIndex i
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   118
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   119
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   120
addClient :: MRoomsAndClients r c -> c -> IO ClientIndex
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4905
diff changeset
   121
addClient (MRoomsAndClients (rooms, clients)) cl = do
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4905
diff changeset
   122
    i <- addElem clients (Client lobbyId cl)
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   123
    modifyElem rooms (roomAddClient (ClientIndex i)) (unRoomIndex lobbyId)
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   124
    return $ ClientIndex i
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   125
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   126
removeRoom :: MRoomsAndClients r c -> RoomIndex -> IO ()
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4905
diff changeset
   127
removeRoom rnc@(MRoomsAndClients (rooms, _)) rm@(RoomIndex ri)
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4905
diff changeset
   128
    | rm == lobbyId = error "Cannot delete lobby"
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   129
    | otherwise = do
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   130
        clIds <- liftM roomClients' $ readElem rooms ri
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   131
        forM_ clIds (moveClientToLobby rnc)
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   132
        removeElem rooms ri
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   133
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   134
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   135
removeClient :: MRoomsAndClients r c -> ClientIndex -> IO ()
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   136
removeClient (MRoomsAndClients (rooms, clients)) cl@(ClientIndex ci) = do
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   137
    RoomIndex ri <- liftM clientRoom' $ readElem clients ci
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   138
    modifyElem rooms (roomRemoveClient cl) ri
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   139
    removeElem clients ci
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   140
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   141
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   142
modifyRoom :: MRoomsAndClients r c -> (r -> r) -> RoomIndex -> IO ()
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   143
modifyRoom (MRoomsAndClients (rooms, _)) f (RoomIndex ri) = modifyElem rooms (\r -> r{room' = f $ room' r}) ri
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   144
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   145
modifyClient :: MRoomsAndClients r c -> (c -> c) -> ClientIndex -> IO ()
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   146
modifyClient (MRoomsAndClients (_, clients)) f (ClientIndex ci) = modifyElem clients (\c -> c{client' = f $ client' c}) ci
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   147
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   148
moveClientInRooms :: MRoomsAndClients r c -> RoomIndex -> RoomIndex -> ClientIndex -> IO ()
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   149
moveClientInRooms (MRoomsAndClients (rooms, clients)) (RoomIndex riFrom) rt@(RoomIndex riTo) cl@(ClientIndex ci) = do
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   150
    modifyElem rooms (roomRemoveClient cl) riFrom
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   151
    modifyElem rooms (roomAddClient cl) riTo
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   152
    modifyElem clients (\c -> c{clientRoom' = rt}) ci
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   153
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   154
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   155
moveClientToLobby :: MRoomsAndClients r c -> ClientIndex -> IO ()
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   156
moveClientToLobby rnc ci = do
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4905
diff changeset
   157
    rm <- clientRoomM rnc ci
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4905
diff changeset
   158
    moveClientInRooms rnc rm lobbyId ci
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   159
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   160
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   161
moveClientToRoom :: MRoomsAndClients r c -> RoomIndex -> ClientIndex -> IO ()
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4905
diff changeset
   162
moveClientToRoom rnc = moveClientInRooms rnc lobbyId
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   163
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   164
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   165
clientExists :: MRoomsAndClients r c -> ClientIndex -> IO Bool
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   166
clientExists (MRoomsAndClients (_, clients)) (ClientIndex ci) = elemExists clients ci
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   167
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   168
clientRoomM :: MRoomsAndClients r c -> ClientIndex -> IO RoomIndex
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   169
clientRoomM (MRoomsAndClients (_, clients)) (ClientIndex ci) = liftM clientRoom' (clients `readElem` ci)
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   170
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   171
client'sM :: MRoomsAndClients r c -> (c -> a) -> ClientIndex -> IO a
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   172
client'sM (MRoomsAndClients (_, clients)) f (ClientIndex ci) = liftM (f . client') (clients `readElem` ci)
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   173
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   174
room'sM :: MRoomsAndClients r c -> (r -> a) -> RoomIndex -> IO a
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   175
room'sM (MRoomsAndClients (rooms, _)) f (RoomIndex ri) = liftM (f . room') (rooms `readElem` ri)
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   176
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   177
allClientsM :: MRoomsAndClients r c -> IO [ClientIndex]
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   178
allClientsM (MRoomsAndClients (_, clients)) = liftM (map ClientIndex) $ indicesM clients
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   179
10215
26fc5502ba22 - Fix applying vote result
unc0rr
parents: 8452
diff changeset
   180
allRoomsM :: MRoomsAndClients r c -> IO [RoomIndex]
26fc5502ba22 - Fix applying vote result
unc0rr
parents: 8452
diff changeset
   181
allRoomsM (MRoomsAndClients (rooms, _)) = liftM (map RoomIndex) $ indicesM rooms
26fc5502ba22 - Fix applying vote result
unc0rr
parents: 8452
diff changeset
   182
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   183
clientsM :: MRoomsAndClients r c -> IO [c]
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4905
diff changeset
   184
clientsM (MRoomsAndClients (_, clients)) = indicesM clients >>= mapM (liftM client' . readElem clients)
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   185
8452
170afc3ac39f Also rooms per version stats
unc0rr
parents: 6805
diff changeset
   186
roomsM :: MRoomsAndClients r c -> IO [r]
170afc3ac39f Also rooms per version stats
unc0rr
parents: 6805
diff changeset
   187
roomsM (MRoomsAndClients (rooms, _)) = indicesM rooms >>= mapM (liftM room' . readElem rooms)
170afc3ac39f Also rooms per version stats
unc0rr
parents: 6805
diff changeset
   188
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   189
roomClientsIndicesM :: MRoomsAndClients r c -> RoomIndex -> IO [ClientIndex]
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4905
diff changeset
   190
roomClientsIndicesM (MRoomsAndClients (rooms, _)) (RoomIndex ri) = liftM roomClients' (rooms `readElem` ri)
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   191
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   192
roomClientsM :: MRoomsAndClients r c -> RoomIndex -> IO [c]
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   193
roomClientsM (MRoomsAndClients (rooms, clients)) (RoomIndex ri) = liftM roomClients' (rooms `readElem` ri) >>= mapM (\(ClientIndex ci) -> liftM client' $ readElem clients ci)
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   194
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   195
withRoomsAndClients :: MRoomsAndClients r c -> (IRoomsAndClients r c -> a) -> IO a
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   196
withRoomsAndClients (MRoomsAndClients (rooms, clients)) f =
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   197
    withIStore2 rooms clients (\r c -> f $ IRoomsAndClients (r, c))
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   198
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   199
----------------------------------------
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   200
----------- IRoomsAndClients -----------
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   201
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   202
showRooms :: (Show r, Show c) => IRoomsAndClients r c -> String
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   203
showRooms rnc@(IRoomsAndClients (rooms, clients)) = concatMap showRoom (allRooms rnc)
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   204
    where
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4905
diff changeset
   205
    showRoom r = unlines $ (show r ++ ": " ++ (show . room' $ rooms ! unRoomIndex r)) : map showClient (roomClients' $ rooms ! unRoomIndex r)
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4905
diff changeset
   206
    showClient c = "    " ++ show c ++ ": " ++ (show . client' $ clients ! unClientIndex c)
4905
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   207
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   208
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   209
allRooms :: IRoomsAndClients r c -> [RoomIndex]
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   210
allRooms (IRoomsAndClients (rooms, _)) = map RoomIndex $ indices rooms
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   211
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   212
allClients :: IRoomsAndClients r c -> [ClientIndex]
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   213
allClients (IRoomsAndClients (_, clients)) = map ClientIndex $ indices clients
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   214
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   215
clientRoom :: IRoomsAndClients r c -> ClientIndex -> RoomIndex
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   216
clientRoom (IRoomsAndClients (_, clients)) (ClientIndex ci) = clientRoom' (clients ! ci)
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   217
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   218
client :: IRoomsAndClients r c -> ClientIndex -> c
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   219
client (IRoomsAndClients (_, clients)) (ClientIndex ci) = client' (clients ! ci)
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   220
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   221
room :: IRoomsAndClients r c -> RoomIndex -> r
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   222
room (IRoomsAndClients (rooms, _)) (RoomIndex ri) = room' (rooms ! ri)
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   223
7842d085acf4 Fix merge :D
unc0rr
parents:
diff changeset
   224
roomClients :: IRoomsAndClients r c -> RoomIndex -> [ClientIndex]
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4905
diff changeset
   225
roomClients (IRoomsAndClients (rooms, _)) (RoomIndex ri) = roomClients' (rooms ! ri)