102 lines
2.5 KiB
Haskell
102 lines
2.5 KiB
Haskell
module State.ConnectedClientsState
|
|
( MonadConnectedClientsModify (..),
|
|
MonadConnectedClientsRead (..),
|
|
ConnectedClients,
|
|
ConnectedClientsState,
|
|
HasConnectedClientState (..),
|
|
initConnectionsState,
|
|
addWSClientGeneric,
|
|
updateWSClientGeneric,
|
|
removeWSClientGeneric,
|
|
getConnctedClientsGeneric,
|
|
)
|
|
where
|
|
|
|
import ClassyPrelude
|
|
import Data.UUID
|
|
import Types.ConnectionState
|
|
|
|
type ConnectedClientsState = TVar ConnectedClients
|
|
|
|
initConnectionsState :: IO ConnectedClientsState
|
|
initConnectionsState = newTVarIO newConnectedClients
|
|
|
|
newConnectedClients :: ConnectedClients
|
|
newConnectedClients = []
|
|
|
|
class Monad m => MonadConnectedClientsModify m where
|
|
addWSClient :: Client -> m ()
|
|
removeWSClient :: UUID -> m ()
|
|
updateWSClient :: UUID -> (Client -> Client) -> m ()
|
|
|
|
class HasConnectedClientState a where
|
|
getConnectedClientState :: a -> ConnectedClientsState
|
|
|
|
addWSClientGeneric ::
|
|
( HasConnectedClientState env,
|
|
MonadReader env m,
|
|
MonadUnliftIO m
|
|
) =>
|
|
Client ->
|
|
m ()
|
|
addWSClientGeneric client = do
|
|
modifyState $ addClient client
|
|
|
|
addClient :: Client -> ConnectedClients -> ConnectedClients
|
|
addClient client clients = client : clients
|
|
|
|
updateWSClientGeneric ::
|
|
( HasConnectedClientState env,
|
|
MonadReader env m,
|
|
MonadUnliftIO m
|
|
) =>
|
|
UUID ->
|
|
(Client -> Client) ->
|
|
m
|
|
()
|
|
updateWSClientGeneric clientId patchFunction = do
|
|
modifyState $ updateClient clientId patchFunction
|
|
|
|
updateClient :: UUID -> (Client -> Client) -> ConnectedClients -> ConnectedClients
|
|
updateClient toUpdate f allClients = do
|
|
client <- allClients
|
|
if toUpdate == uuid client
|
|
then return $ f client
|
|
else return client
|
|
|
|
removeWSClientGeneric ::
|
|
( HasConnectedClientState env,
|
|
MonadReader env m,
|
|
MonadUnliftIO m
|
|
) =>
|
|
UUID ->
|
|
m ()
|
|
removeWSClientGeneric clientId = do
|
|
modifyState $ removeClient clientId
|
|
|
|
removeClient :: UUID -> ConnectedClients -> ConnectedClients
|
|
removeClient toRemove = filter ((/= toRemove) . uuid)
|
|
|
|
modifyState ::
|
|
( HasConnectedClientState env,
|
|
MonadReader env m,
|
|
MonadUnliftIO m
|
|
) =>
|
|
(ConnectedClients -> ConnectedClients) ->
|
|
m ()
|
|
modifyState modifyFunc = do
|
|
state <- getConnectedClientState <$> ask
|
|
atomically $ modifyTVar state modifyFunc
|
|
|
|
class Monad m => MonadConnectedClientsRead m where
|
|
getConnctedClients :: m ConnectedClients
|
|
|
|
getConnctedClientsGeneric ::
|
|
( HasConnectedClientState env,
|
|
MonadReader env m,
|
|
MonadIO m
|
|
) =>
|
|
m ConnectedClients
|
|
getConnctedClientsGeneric = do
|
|
ask >>= readTVarIO . getConnectedClientState
|