diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2026-08-02 15:42:34 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2026-08-05 21:55:55 +0200 |
| commit | cb3e2abade4a0aa1ad13f4aa1632b1e05af4d29a (patch) | |
| tree | 5ee32f2e21b5fa504bdb1d30a717dffa4f17ac34 /src/Erebos/Chatroom.hs | |
| parent | 0efd90e5f01996ceb01f5a2889f9e2986322c371 (diff) | |
Use cached values for shared state lookups
Diffstat (limited to 'src/Erebos/Chatroom.hs')
| -rw-r--r-- | src/Erebos/Chatroom.hs | 9 |
1 files changed, 4 insertions, 5 deletions
diff --git a/src/Erebos/Chatroom.hs b/src/Erebos/Chatroom.hs index c535845..c050381 100644 --- a/src/Erebos/Chatroom.hs +++ b/src/Erebos/Chatroom.hs @@ -371,12 +371,11 @@ updateChatroomByStateData lookupData newName newDesc = findAndUpdateChatroomStat listChatrooms :: MonadHead LocalState m => m [ChatroomState] listChatrooms = filter (not . roomStateDeleted) . - fromSetBy (comparing $ roomName <=< roomStateRoom) . - lookupSharedValue . lsShared . fromStored <$> getLocalHead + fromSetBy (comparing $ roomName <=< roomStateRoom) <$> lookupSharedValueM findChatroom :: MonadHead LocalState m => (ChatroomState -> Bool) -> m (Maybe ChatroomState) findChatroom p = do - list <- map snd . chatroomSetToList . lookupSharedValue . lsShared . fromStored <$> getLocalHead + list <- map snd . chatroomSetToList <$> lookupSharedValueM return $ find p list findChatroomByRoomData :: MonadHead LocalState m => Stored (Signed ChatroomData) -> m (Maybe ChatroomState) @@ -453,7 +452,7 @@ data ChatroomSetChange = AddedChatroom ChatroomState watchChatrooms :: MonadIO m => Head LocalState -> (Set ChatroomState -> Maybe [ChatroomSetChange] -> IO ()) -> m WatchedHead watchChatrooms h f = liftIO $ do lastVar <- newIORef Nothing - watchHeadWith h (lookupSharedValue . lsShared . headObject) $ \cur -> do + watchHeadWith h lookupSharedValueH $ \cur -> do let curList = chatroomSetToList cur mbLast <- readIORef lastVar writeIORef lastVar $ Just curList @@ -537,7 +536,7 @@ instance Service ChatroomService where svcModify $ \s -> s { psSendRoomUpdates = True } when (not previouslyUpdated) $ do - syncChatroomsToPeer . lookupSharedValue . lsShared . fromStored =<< getLocalHead + syncChatroomsToPeer =<< lookupSharedValueM when chatRoomQuery $ do rooms <- listChatrooms |