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, MonadIO m ) => m ConnectedClients getConnctedClientsGeneric = do ask >>= readMVar . getConnectedClientState