equal
deleted
inserted
replaced
|
1 {-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving #-} |
|
2 |
1 module RoomsAndClients( |
3 module RoomsAndClients( |
2 RoomIndex(), |
4 RoomIndex(), |
3 ClientIndex(), |
5 ClientIndex(), |
4 MRoomsAndClients(), |
6 MRoomsAndClients(), |
5 IRoomsAndClients(), |
7 IRoomsAndClients(), |
32 ) where |
34 ) where |
33 |
35 |
34 |
36 |
35 import Store |
37 import Store |
36 import Control.Monad |
38 import Control.Monad |
|
39 import Control.DeepSeq |
37 |
40 |
38 |
41 |
39 data Room r = Room { |
42 data Room r = Room { |
40 roomClients' :: [ClientIndex], |
43 roomClients' :: ![ClientIndex], |
41 room' :: r |
44 room' :: !r |
42 } |
45 } |
43 |
46 |
44 |
47 |
45 data Client c = Client { |
48 data Client c = Client { |
46 clientRoom' :: RoomIndex, |
49 clientRoom' :: !RoomIndex, |
47 client' :: c |
50 client' :: !c |
48 } |
51 } |
49 |
52 |
50 |
53 |
51 newtype RoomIndex = RoomIndex ElemIndex |
54 newtype RoomIndex = RoomIndex ElemIndex |
52 deriving (Eq) |
55 deriving (Eq, NFData) |
53 newtype ClientIndex = ClientIndex ElemIndex |
56 newtype ClientIndex = ClientIndex ElemIndex |
54 deriving (Eq, Show, Read, Ord) |
57 deriving (Eq, Show, Read, Ord, NFData) |
55 |
58 |
56 instance Show RoomIndex where |
59 instance Show RoomIndex where |
57 show (RoomIndex i) = 'r' : show i |
60 show (RoomIndex i) = 'r' : show i |
58 |
61 |
59 unRoomIndex :: RoomIndex -> ElemIndex |
62 unRoomIndex :: RoomIndex -> ElemIndex |
80 when (ri /= lobbyId) $ error "Empty struct inserts not at firstIndex index" |
83 when (ri /= lobbyId) $ error "Empty struct inserts not at firstIndex index" |
81 return rnc |
84 return rnc |
82 |
85 |
83 |
86 |
84 roomAddClient :: ClientIndex -> Room r -> Room r |
87 roomAddClient :: ClientIndex -> Room r -> Room r |
85 roomAddClient cl rm = let cls = cl : roomClients' rm; nr = rm{roomClients' = cls} in cls `seq` nr |
88 roomAddClient cl rm = let cls = cl : roomClients' rm; nr = rm{roomClients' = cls} in cls `deepseq` nr |
86 |
89 |
87 roomRemoveClient :: ClientIndex -> Room r -> Room r |
90 roomRemoveClient :: ClientIndex -> Room r -> Room r |
88 roomRemoveClient cl rm = let cls = filter (/= cl) $ roomClients' rm; nr = rm{roomClients' = cls} in cls `seq` nr |
91 roomRemoveClient cl rm = let cls = filter (/= cl) $ roomClients' rm; nr = rm{roomClients' = cls} in cls `deepseq` nr |
89 |
92 |
90 |
93 |
91 addRoom :: MRoomsAndClients r c -> r -> IO RoomIndex |
94 addRoom :: MRoomsAndClients r c -> r -> IO RoomIndex |
92 addRoom (MRoomsAndClients (rooms, _)) rm = do |
95 addRoom (MRoomsAndClients (rooms, _)) rm = do |
93 i <- addElem rooms (Room [] rm) |
96 i <- addElem rooms (Room [] rm) |