diff options
| -rw-r--r-- | server/lib/Cafp/Main/Server.hs | 16 |
1 files changed, 12 insertions, 4 deletions
diff --git a/server/lib/Cafp/Main/Server.hs b/server/lib/Cafp/Main/Server.hs index 9ded571..799f26e 100644 --- a/server/lib/Cafp/Main/Server.hs +++ b/server/lib/Cafp/Main/Server.hs @@ -97,19 +97,27 @@ getOrCreateRoom server roomId = MVar.modifyMVar (serverRooms server) $ \rooms -> Just room -> pure (rooms, room) Nothing -> do gen <- newStdGen + warning $ "[" <> T.unpack roomId <> "] Created room" room <- atomically $ newRoom server gen pure (HMS.insert roomId room rooms, room) +deleteRoom :: Server -> RoomId -> IO () +deleteRoom server roomId = do + warning $ "[" <> T.unpack roomId <> "] Deleting room" + MVar.modifyMVar_ (serverRooms server) $ pure . HMS.delete roomId + joinRoom :: Room -> Sink -> STM PlayerId joinRoom room sink = do pid <- STM.stateTVar (roomGame room) joinGame STM.modifyTVar' (roomSinks room) $ HMS.insert pid sink pure pid -leaveRoom :: Room -> PlayerId -> STM () +leaveRoom :: Room -> PlayerId -> STM Bool leaveRoom room pid = do STM.modifyTVar' (roomGame room) $ leaveGame pid - STM.modifyTVar' (roomSinks room) $ HMS.delete pid + STM.stateTVar (roomSinks room) $ \sinks -> + let sinks' = HMS.delete pid sinks in + (HMS.null sinks', sinks') syncRoom :: Room -> IO () syncRoom room = do @@ -131,8 +139,8 @@ wsApp server pc = case routePendingConnection pc of WS.withPingThread conn 30 (pure ()) $ bracket (atomically $ joinRoom room sink) (\playerId -> do - atomically $ leaveRoom room playerId - syncRoom room) + roomEmpty <- atomically $ leaveRoom room playerId + if roomEmpty then deleteRoom server roomId else syncRoom room) (\playerId -> do syncRoom room cards <- fmap (^. gameCards) . atomically . STM.readTVar $ |