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