fix: mulithreading

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
 

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

backend/src/State/RoomDataState.hs

@@ -7,8 +7,8 @@ where
 import ClassyPrelude
 import Types.RoomData
 
-class Monad m => MonadRoomDataStateModify m where
+class (Monad m) => MonadRoomDataStateModify m where
-  setRoomDataState :: RoomsData -> m ()
+  setRoomDataState :: RoomsData -> m RoomsStateDiff
 
-class Monad m => MonadRoomDataStateRead m where
+class (Monad m) => MonadRoomDataStateRead m where
   getRoomDataState :: m RoomsData

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

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