Start with keeping roomsstate
This commit is contained in:
parent
839f6df5f8
commit
f0e0d93b05
8 changed files with 161 additions and 81 deletions
|
@ -1,14 +1,19 @@
|
|||
{-# LANGUAGE DerivingVia #-}
|
||||
|
||||
module Types.AppTypes (Env (..), App (..), getConnectedClientState, HasConnectedClientState, App, AppProfile (Prod, Dev)) where
|
||||
module Types.AppTypes (Env (..), App (..), getConnectedClientState, HasConnectedClientState, AppProfile (Prod, Dev)) where
|
||||
|
||||
import ClassyPrelude
|
||||
import Types.ConnectionState (ConnectedClientsState)
|
||||
import Types.RoomsState
|
||||
( HasRoomsState (getRoomsState),
|
||||
RoomsState,
|
||||
)
|
||||
|
||||
data AppProfile = Prod | Dev
|
||||
|
||||
data Env = Env
|
||||
{ connectedClientsState :: ConnectedClientsState,
|
||||
roomsState :: RoomsState,
|
||||
profile :: AppProfile
|
||||
}
|
||||
|
||||
|
@ -18,6 +23,9 @@ class HasConnectedClientState a where
|
|||
instance HasConnectedClientState Env where
|
||||
getConnectedClientState = connectedClientsState
|
||||
|
||||
instance HasRoomsState Env where
|
||||
getRoomsState = roomsState
|
||||
|
||||
newtype App env a = App {unApp :: env -> IO a}
|
||||
deriving
|
||||
( Functor,
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
module Types.ConnectionState
|
||||
( Client (..),
|
||||
Client,
|
||||
ConnectedClientsState,
|
||||
ConnectedClients,
|
||||
initConnectionsState,
|
||||
)
|
||||
where
|
||||
|
||||
|
@ -13,9 +13,16 @@ import Network.WebSockets qualified as WS
|
|||
data Client = Client
|
||||
{ uuid :: UUID,
|
||||
name :: Text,
|
||||
conn :: WS.Connection
|
||||
conn :: WS.Connection,
|
||||
joinedRoom :: Bool
|
||||
}
|
||||
|
||||
type ConnectedClientsState = MVar ConnectedClients
|
||||
|
||||
type ConnectedClients = [Client]
|
||||
|
||||
initConnectionsState :: IO ConnectedClientsState
|
||||
initConnectionsState = newMVar newConnectedClients
|
||||
|
||||
newConnectedClients :: ConnectedClients
|
||||
newConnectedClients = []
|
||||
|
|
|
@ -11,7 +11,7 @@ data Participant = Participant
|
|||
displayName :: Text,
|
||||
avatarURL :: Text
|
||||
}
|
||||
deriving (Generic, Show)
|
||||
deriving (Generic, Show, Eq)
|
||||
|
||||
instance ToJSON Participant
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module Types.RoomData (RoomData) where
|
||||
module Types.RoomData (RoomData, RoomsData) where
|
||||
|
||||
import ClassyPrelude
|
||||
import Data.Aeson (FromJSON, ToJSON)
|
||||
|
@ -10,10 +10,12 @@ data RoomData = RoomData
|
|||
{ roomName :: RoomName,
|
||||
participants :: [Participant]
|
||||
}
|
||||
deriving (Generic, Show)
|
||||
deriving (Generic, Show, Eq)
|
||||
|
||||
type RoomName = Text
|
||||
|
||||
type RoomsData = [RoomData]
|
||||
|
||||
instance ToJSON RoomData
|
||||
|
||||
instance FromJSON RoomData
|
||||
|
|
45
backend/src/Types/RoomsState.hs
Normal file
45
backend/src/Types/RoomsState.hs
Normal file
|
@ -0,0 +1,45 @@
|
|||
module Types.RoomsState
|
||||
( RoomsState,
|
||||
initRoomsState,
|
||||
HasRoomsState (..),
|
||||
roomStateDiffers,
|
||||
updateRoomState,
|
||||
)
|
||||
where
|
||||
|
||||
import ClassyPrelude
|
||||
import Types.RoomData (RoomsData)
|
||||
|
||||
type RoomsState = MVar RoomsData
|
||||
|
||||
initRoomsState :: IO RoomsState
|
||||
initRoomsState = newMVar []
|
||||
|
||||
class HasRoomsState a where
|
||||
getRoomsState :: a -> RoomsState
|
||||
|
||||
updateRoomState ::
|
||||
( HasRoomsState env,
|
||||
MonadIO m,
|
||||
MonadReader env m
|
||||
) =>
|
||||
RoomsData ->
|
||||
m ()
|
||||
updateRoomState newData = do
|
||||
state <- getRoomsState <$> ask
|
||||
putMVar state newData
|
||||
|
||||
roomStateDiffers ::
|
||||
( HasRoomsState env,
|
||||
MonadIO m,
|
||||
MonadReader env m
|
||||
) =>
|
||||
RoomsData ->
|
||||
m Bool
|
||||
roomStateDiffers newData = do
|
||||
state <- getRoomsState <$> ask
|
||||
current <- readMVar state
|
||||
return $ eqIgnoreOrdering newData current
|
||||
|
||||
eqIgnoreOrdering :: (Eq a) => [a] -> [a] -> Bool
|
||||
eqIgnoreOrdering a b = length a == length b && all (`elem` b) a
|
Loading…
Add table
Add a link
Reference in a new issue