75 lines
1.7 KiB
Haskell
75 lines
1.7 KiB
Haskell
|
{-# LANGUAGE DerivingVia #-}
|
||
|
|
{-# LANGUAGE FlexibleContexts #-}
|
||
|
|
{-# LANGUAGE FlexibleInstances #-}
|
||
|
|
|
||
|
|
module WebSocket.WSReaderTApp
|
||
|
|
( WSApp (..),
|
||
|
|
WSEnv (..),
|
||
|
|
HasWSEnv (..),
|
||
|
|
)
|
||
|
|
where
|
||
|
|
|
||
|
|
import BroadcastUserData
|
||
|
|
( MonadBroadcast (..),
|
||
|
|
broadCastToClientsGeneric,
|
||
|
|
)
|
||
|
|
import ClassyPrelude
|
||
|
|
import Data.UUID
|
||
|
|
import Network.WebSockets qualified as WS
|
||
|
|
import State.ConnectedClientsState
|
||
|
|
( MonadConnectedClientsModify (..),
|
||
|
|
MonadConnectedClientsRead (..),
|
||
|
|
addWSClientGeneric,
|
||
|
|
getConnctedClientsGeneric,
|
||
|
|
removeWSClientGeneric,
|
||
|
|
updateWSClientGeneric,
|
||
|
|
)
|
||
|
|
import State.RoomDataState
|
||
|
|
import Types.AppTypes
|
||
|
|
import Types.RoomsState (HasRoomsState (..), getRoomState)
|
||
|
|
|
||
|
|
data WSEnv = WSEnv
|
||
|
|
{ appEnv :: Env,
|
||
|
|
connection :: WS.Connection,
|
||
|
|
clientId :: UUID
|
||
|
|
}
|
||
|
|
|
||
|
|
class HasWSEnv a where
|
||
|
|
getConn :: a -> WS.Connection
|
||
|
|
getClientId :: a -> UUID
|
||
|
|
|
||
|
|
instance HasWSEnv WSEnv where
|
||
|
|
getConn = connection
|
||
|
|
getClientId = clientId
|
||
|
|
|
||
|
|
newtype WSApp env a = WSApp {unWSApp :: env -> IO a}
|
||
|
|
deriving
|
||
|
|
( Functor,
|
||
|
|
Applicative,
|
||
|
|
Monad,
|
||
|
|
MonadReader env,
|
||
|
|
MonadIO,
|
||
|
|
MonadUnliftIO
|
||
|
|
)
|
||
|
|
via ReaderT env IO
|
||
|
|
|
||
|
|
instance HasConnectedClientState WSEnv where
|
||
|
|
getConnectedClientState = connectedClientsState . appEnv
|
||
|
|
|
||
|
|
instance HasRoomsState WSEnv where
|
||
|
|
getRoomsState = roomsState . appEnv
|
||
|
|
|
||
|
|
instance MonadConnectedClientsModify (WSApp WSEnv) where
|
||
|
|
addWSClient = addWSClientGeneric
|
||
|
|
updateWSClient = updateWSClientGeneric
|
||
|
|
removeWSClient = removeWSClientGeneric
|
||
|
|
|
||
|
|
instance MonadConnectedClientsRead (WSApp WSEnv) where
|
||
|
|
getConnctedClients = getConnctedClientsGeneric
|
||
|
|
|
||
|
|
instance MonadRoomDataStateRead (WSApp WSEnv) where
|
||
|
|
getRoomDataState = getRoomState
|
||
|
|
|
||
|
|
instance MonadBroadcast (WSApp WSEnv) where
|
||
|
|
broadCastToClients = broadCastToClientsGeneric
|