90 lines
2.1 KiB
Haskell
90 lines
2.1 KiB
Haskell
|
module State.ConnectedClientsState
|
||
|
|
( MonadConnectedClientsModify (..),
|
||
|
|
MonadConnectedClientsRead (..),
|
||
|
|
addWSClientGeneric,
|
||
|
|
updateWSClientGeneric,
|
||
|
|
removeWSClientGeneric,
|
||
|
|
getConnctedClientsGeneric,
|
||
|
|
)
|
||
|
|
where
|
||
|
|
|
||
|
|
import ClassyPrelude
|
||
|
|
import Data.UUID
|
||
|
|
import Types.AppTypes
|
||
|
|
import Types.ConnectionState
|
||
|
|
|
||
|
|
class Monad m => MonadConnectedClientsModify m where
|
||
|
|
addWSClient :: Client -> m ()
|
||
|
|
removeWSClient :: UUID -> m ()
|
||
|
|
updateWSClient :: UUID -> (Client -> Client) -> m ()
|
||
|
|
|
||
|
|
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
|
||
|
|
modifyMVar_ state $ \s ->
|
||
|
|
let s' = modifyFunc s
|
||
|
|
in return s'
|
||
|
|
|
||
|
|
class Monad m => MonadConnectedClientsRead m where
|
||
|
|
getConnctedClients :: m ConnectedClients
|
||
|
|
|
||
|
|
getConnctedClientsGeneric ::
|
||
|
|
( HasConnectedClientState env,
|
||
|
|
MonadReader env m,
|
||
|
|
MonadUnliftIO m
|
||
|
|
) =>
|
||
|
|
m ConnectedClients
|
||
|
|
getConnctedClientsGeneric = do
|
||
|
|
ask >>= readMVar . getConnectedClientState
|