41 lines
1.1 KiB
Haskell
41 lines
1.1 KiB
Haskell
|
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||
|
|
|
||
|
|
{-# HLINT ignore "Redundant <$>" #-}
|
||
|
|
{-# HLINT ignore "Redundant $" #-}
|
||
|
|
{-# HLINT ignore "Redundant bracket" #-}
|
||
|
|
module BroadcastUserData
|
||
|
|
( broadcastUserData,
|
||
|
|
)
|
||
|
|
where
|
||
|
|
|
||
|
|
import ClassyPrelude
|
||
|
|
import Data.Aeson (encode)
|
||
|
|
import Types.AppTypes (HasConnectedClientState (..))
|
||
|
|
import Types.ConnectionState (Client (..))
|
||
|
|
import Types.RoomsState (HasRoomsState (..))
|
||
|
|
import Types.UsersData (UsersData (..))
|
||
|
|
import WebSocket (broadCastToClients)
|
||
|
|
|
||
|
|
broadcastUserData ::
|
||
|
|
( MonadIO m,
|
||
|
|
HasConnectedClientState env,
|
||
|
|
HasRoomsState env,
|
||
|
|
MonadReader env m
|
||
|
|
) =>
|
||
|
|
m ()
|
||
|
|
broadcastUserData = do
|
||
|
|
userWithOutRoom <- getUsersWithoutRoom
|
||
|
|
roomsData <- (getRoomsState <$> ask) >>= readMVar
|
||
|
|
let usersData = UsersData {userWithOutRoom = userWithOutRoom, roomsData = roomsData}
|
||
|
|
broadCastToClients $ (decodeUtf8 . toStrict . encode) usersData
|
||
|
|
|
||
|
|
getUsersWithoutRoom ::
|
||
|
|
( MonadIO m,
|
||
|
|
HasConnectedClientState env,
|
||
|
|
MonadReader env m
|
||
|
|
) =>
|
||
|
|
m [Text]
|
||
|
|
getUsersWithoutRoom = do
|
||
|
|
state <- (getConnectedClientState <$> ask) >>= readMVar
|
||
|
|
return $ map name $ filter (not . joinedRoom) state
|