Switch to TVar
continuous-integration/drone/push Build is passing Details
continuous-integration/drone/tag Build is passing Details

This commit is contained in:
qvalentin 2023-06-19 17:53:40 +02:00
parent 03985cede2
commit 1e318817a4
7 changed files with 33 additions and 17 deletions

View File

@ -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

View File

@ -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

View File

@ -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 = []

View File

@ -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

View File

@ -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

View File

@ -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.

View File

@ -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