tighten up the update diagnostics loop to avoid contention

Author: pepeiborra

ghcide/src/Development/IDE/Core/Debouncer.hs

@@ -44,13 +44,14 @@ asyncRegisterEvent d 0 k fire = do
         whenJust (Map.lookup k m) cancel
         pure $ Map.delete k m
     fire
-asyncRegisterEvent d delay k fire = modifyVar_ d $ \m -> mask_ $ do
-    whenJust (Map.lookup k m) cancel
+asyncRegisterEvent d delay k fire = do
     a <- asyncWithUnmask $ \unmask -> unmask $ do
         sleep delay
         fire
         modifyVar_ d (pure . Map.delete k)
-    pure $ Map.insert k a m
+    modifyVar_ d $ \m -> mask_ $ do
+        whenJust (Map.lookup k m) cancel
+        pure $ Map.insert k a m
 
 -- | Debouncer used in the DAML CLI compiler that emits events immediately.
 noopDebouncer :: Debouncer k

ghcide/src/Development/IDE/Core/Shake.hs

@@ -1100,15 +1100,16 @@ updateFileDiagnostics fp k ShakeExtras{logger, diagnostics, hiddenDiagnostics, p
         let uri = filePathToUri' fp
         let delay = if null newDiags then 0.1 else 0
         registerEvent debouncer delay uri $ do
-             mask_ $ modifyVar_ publishedDiagnostics $ \published -> do
+             join $ mask_ $ modifyVar publishedDiagnostics $ \published -> do
                  let lastPublish = HMap.lookupDefault [] uri published
-                 when (lastPublish /= newDiags) $ case lspEnv of
-                   Nothing -> -- Print an LSP event.
-                     logInfo logger $ showDiagnosticsColored $ map (fp,ShowDiag,) newDiags
-                   Just env -> LSP.runLspT env $
-                     LSP.sendNotification LSP.STextDocumentPublishDiagnostics $
-                       LSP.PublishDiagnosticsParams (fromNormalizedUri uri) ver (List newDiags)
-                 pure $! HMap.insert uri newDiags published
+                     !published' = HMap.insert uri newDiags published
+                     action = when (lastPublish /= newDiags) $ case lspEnv of
+                        Nothing -> -- Print an LSP event.
+                            logInfo logger $ showDiagnosticsColored $ map (fp,ShowDiag,) newDiags
+                        Just env -> LSP.runLspT env $
+                            LSP.sendNotification LSP.STextDocumentPublishDiagnostics $
+                            LSP.PublishDiagnosticsParams (fromNormalizedUri uri) ver (List newDiags)
+                 return (published', action)
 
 newtype Priority = Priority Double