module BroadcastUserData ( broadcastUserData, broadCastToClientsGeneric, MonadBroadcast (..), ) where import ClassyPrelude import Data.Aeson (encode) import Network.WebSockets qualified as WS import State.ConnectedClientsState (ConnectedClients, MonadConnectedClientsRead (getConnctedClients)) import State.RoomDataState (MonadRoomDataStateRead (getRoomDataState)) import Types.ConnectionState (Client (..)) import Types.User (User, clientToUser) import Types.UsersData (UsersData (..)) class (Monad m, MonadConnectedClientsRead m) => MonadBroadcast m where broadCastToClients :: Text -> m () broadcastUserData :: ( MonadRoomDataStateRead m, MonadBroadcast m ) => m () broadcastUserData = do userWithOutRoom <- getUsersWithoutRoom roomsData <- getRoomDataState let usersData = UsersData {usersWithOutRoom = userWithOutRoom, roomsData = roomsData} broadCastToClients $ (decodeUtf8 . toStrict . encode) usersData getUsersWithoutRoom :: ( MonadConnectedClientsRead m ) => m [User] getUsersWithoutRoom = map clientToUser . filter (not . joinedRoom) <$> getConnctedClients broadCastToClientsGeneric :: ( MonadIO m, MonadConnectedClientsRead m ) => Text -> m () broadCastToClientsGeneric message = do connectedClients <- getConnctedClients liftIO (broadcast message connectedClients) broadcast :: Text -> ConnectedClients -> IO () broadcast message clients = do putStrLn $ "Broadcasting: " ++ message forM_ clients $ \client -> WS.sendTextData (conn client) message