Switch to TVar

backend/src/BroadcastUserData.hs

@@ -41,8 +41,8 @@ broadCastToClientsGeneric ::
   Text ->
   m ()
 broadCastToClientsGeneric message = do
-  state <- getConnctedClients
-  liftIO $ broadcast message state
+  connectedClients <- getConnctedClients
+  liftIO (broadcast message connectedClients)
 
 broadcast :: Text -> ConnectedClients -> IO ()
 broadcast message clients = do

backend/src/State/ConnectedClientsState.hs

@@ -72,9 +72,7 @@ modifyState ::
   m ()
 modifyState modifyFunc = do
   state <- getConnectedClientState <$> ask
-  modifyMVar_ state $ \s ->
-    let s' = modifyFunc s
-     in return s'
+  atomically $ modifyTVar state modifyFunc
 
 class Monad m => MonadConnectedClientsRead m where
   getConnctedClients :: m ConnectedClients
@@ -86,4 +84,4 @@ getConnctedClientsGeneric ::
   ) =>
   m ConnectedClients
 getConnctedClientsGeneric = do
-  ask >>= readMVar . getConnectedClientState
+  ask >>= readTVarIO . getConnectedClientState

backend/src/Types/ConnectionState.hs

@@ -17,12 +17,12 @@ data Client = Client
     joinedRoom :: Bool
   }
 
-type ConnectedClientsState = MVar ConnectedClients
+type ConnectedClientsState = TVar ConnectedClients
 
 type ConnectedClients = [Client]
 
 initConnectionsState :: IO ConnectedClientsState
-initConnectionsState = newMVar newConnectedClients
+initConnectionsState = newTVarIO newConnectedClients
 
 newConnectedClients :: ConnectedClients
 newConnectedClients = []

backend/src/Types/RoomsState.hs

@@ -12,10 +12,10 @@ import ClassyPrelude
 import State.RoomDataState (MonadRoomDataStateRead (getRoomDataState))
 import Types.RoomData (RoomsData)
 
-type RoomsState = MVar RoomsData
+type RoomsState = TVar RoomsData
 
 initRoomsState :: IO RoomsState
-initRoomsState = newMVar []
+initRoomsState = newTVarIO []
 
 class HasRoomsState a where
   getRoomsState :: a -> RoomsState
@@ -29,7 +29,7 @@ updateRoomState ::
   m ()
 updateRoomState newData = do
   state <- getRoomsState <$> ask
-  _ <- swapMVar state newData
+  _ <- atomically $ swapTVar state newData
   return ()
 
 getRoomState ::
@@ -40,7 +40,7 @@ getRoomState ::
   m RoomsData
 getRoomState = do
   state <- getRoomsState <$> ask
-  readMVar state
+  readTVarIO state
 
 roomStateDiffers ::
   ( MonadRoomDataStateRead m

backend/src/WebServer.hs

@@ -121,6 +121,24 @@ notFound = do
           "404 - Not Found"
   throwError response
 
+-- notFound ::
+--   ( MonadIO m,
+--     HasWebEnv env,
+--     MonadReader env m,
+--     MonadError ResponseReceived m
+--   ) =>
+--   m ResponseReceived
+-- notFound = do
+--   respond' <- getRespond <$> ask
+--   response <-
+--     liftIO $
+--       respond' $
+--         responseLBS
+--           status200
+--           [("Content-Type", "text/plain")]
+--           "200 - Success"
+--   response
+
 runWebApp ::
   ( MonadIO m,
     MonadReader Env m

backend/stack.yaml

@@ -16,7 +16,7 @@
 # this way we can use prebuild binaries for hls
 #resolver: nightly-2022-11-12
 #resolver: ghc-9.2.4
-resolver: lts-20.16
+resolver: lts-20.26
 #
 # The location of a snapshot can be provided as a file or url. Stack assumes
 # a snapshot provided as a file might change, whereas a url resource does not.

backend/stack.yaml.lock

@@ -6,7 +6,7 @@
 packages: []
 snapshots:
 - completed:
-    sha256: dad15e2ec0c09280a5c2e07190fb18710fc54472f029f34f861f686540824d81
-    size: 649592
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/16.yaml
-  original: lts-20.16
+    sha256: 5a59b2a405b3aba3c00188453be172b85893cab8ebc352b1ef58b0eae5d248a2
+    size: 650475
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/26.yaml
+  original: lts-20.26