Start with keeping roomsstate

This commit is contained in:
qvalentin 2023-01-27 19:53:34 +01:00
parent 839f6df5f8
commit f0e0d93b05
8 changed files with 161 additions and 81 deletions

View file

@ -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,

View file

@ -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 = []

View file

@ -11,7 +11,7 @@ data Participant = Participant
displayName :: Text,
avatarURL :: Text
}
deriving (Generic, Show)
deriving (Generic, Show, Eq)
instance ToJSON Participant

View file

@ -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

View 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