diff --git a/backend/src/RoomDataHandler.hs b/backend/src/RoomDataHandler.hs index 23f0b2b..3f87ae1 100644 --- a/backend/src/RoomDataHandler.hs +++ b/backend/src/RoomDataHandler.hs @@ -50,12 +50,11 @@ roomDataHandler = do newRoomData <- parseBodyOrBadRequest liftIO $ putStrLn "Got triggered from prosody" whenM (roomStateDiffers newRoomData) $ do - (openedRooms, closedRooms) <- roomStateDiffInOpenRooms newRoomData + (openedRooms, closedRooms) <- setRoomDataState newRoomData mapM_ notifyRoomOpend openedRooms mapM_ notifyRoomClosed closedRooms - setRoomDataState newRoomData broadcastUserData success diff --git a/backend/src/State/GenericTVarState.hs b/backend/src/State/GenericTVarState.hs index 3e40c32..0793468 100644 --- a/backend/src/State/GenericTVarState.hs +++ b/backend/src/State/GenericTVarState.hs @@ -1,4 +1,4 @@ -module State.GenericTVarState (GenericTVarState, updateGenericTVarState, getGenericTVarState) where +module State.GenericTVarState (GenericTVarState, updateGenericTVarState, updateGenericTVarStateWithQuery, getGenericTVarState) where import ClassyPrelude @@ -7,5 +7,11 @@ type GenericTVarState a = TVar a updateGenericTVarState :: (MonadIO m) => GenericTVarState a -> a -> m () updateGenericTVarState tv a = atomically $ writeTVar tv a +updateGenericTVarStateWithQuery :: (MonadIO m) => GenericTVarState a -> (a -> a -> b) -> a -> m b +updateGenericTVarStateWithQuery tv f a = atomically $ do + b <- readTVar tv + writeTVar tv a + return $ f b a + getGenericTVarState :: (MonadIO m) => GenericTVarState a -> m a getGenericTVarState = readTVarIO diff --git a/backend/src/State/RoomDataState.hs b/backend/src/State/RoomDataState.hs index 35140df..9ef5a09 100644 --- a/backend/src/State/RoomDataState.hs +++ b/backend/src/State/RoomDataState.hs @@ -7,8 +7,8 @@ where import ClassyPrelude import Types.RoomData -class Monad m => MonadRoomDataStateModify m where - setRoomDataState :: RoomsData -> m () +class (Monad m) => MonadRoomDataStateModify m where + setRoomDataState :: RoomsData -> m RoomsStateDiff -class Monad m => MonadRoomDataStateRead m where +class (Monad m) => MonadRoomDataStateRead m where getRoomDataState :: m RoomsData diff --git a/backend/src/State/RoomsState.hs b/backend/src/State/RoomsState.hs index fab907b..01c9a2c 100644 --- a/backend/src/State/RoomsState.hs +++ b/backend/src/State/RoomsState.hs @@ -3,6 +3,7 @@ module State.RoomsState initRoomsState, HasRoomsState (..), roomStateDiffers, + RoomsStateDiff, roomStateDiffInOpenRooms, updateRoomState, getRoomState, @@ -12,7 +13,7 @@ where import ClassyPrelude import State.GenericTVarState import State.RoomDataState (MonadRoomDataStateRead (getRoomDataState)) -import Types.RoomData (RoomsData, roomNotEmpty, sameName) +import Types.RoomData (RoomsData, RoomsStateDiff, roomNotEmpty, sameName) type RoomsState = GenericTVarState RoomsData @@ -28,12 +29,13 @@ updateRoomState :: MonadReader env m ) => RoomsData -> - m () + m RoomsStateDiff updateRoomState newData = do state <- getRoomsState <$> ask liftIO $ putStrLn "Upating room state" - updateGenericTVarState state newData + diff <- updateGenericTVarStateWithQuery state roomStateDiff newData liftIO $ putStrLn "Done Upating room state" + return diff getRoomState :: ( HasRoomsState env, @@ -69,5 +71,11 @@ roomStateDiffInOpenRooms newData = do return (newRooms, oldRooms) +roomStateDiff :: RoomsData -> RoomsData -> RoomsStateDiff +roomStateDiff newData current = (newRooms, oldRooms) + where + newRooms = filter roomNotEmpty $ filter (\newRoom -> isNothing $ find (sameName newRoom) (filter roomNotEmpty current)) newData + oldRooms = filter (\oldRoom -> isNothing $ find (sameName oldRoom) newData) current + eqIgnoreOrdering :: (Eq a) => [a] -> [a] -> Bool eqIgnoreOrdering a b = length a == length b && all (`elem` b) a diff --git a/backend/src/Types/RoomData.hs b/backend/src/Types/RoomData.hs index 0f0cf49..2354257 100644 --- a/backend/src/Types/RoomData.hs +++ b/backend/src/Types/RoomData.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} -module Types.RoomData (RoomData, RoomsData, sameName, roomNotEmpty, prettyPrintOpenedRoom) where +module Types.RoomData (RoomData, RoomsStateDiff, RoomsData, sameName, roomNotEmpty, prettyPrintOpenedRoom) where import ClassyPrelude import Data.Aeson (FromJSON, ToJSON) @@ -26,6 +26,8 @@ type RoomName = Text type RoomsData = [RoomData] +type RoomsStateDiff = (RoomsData, RoomsData) + instance ToJSON RoomData instance FromJSON RoomData