split report and state update in separate threads

Author: soulomoon

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

@@ -924,18 +924,17 @@ indexHieFile se mod_summary srcPath !hash hf = do
             -- If the hash in the pending list doesn't match the current hash, then skip
             Just pendingHash -> pendingHash /= hash
         unless newerScheduled $ do
-          -- Using `bracket`, so even if an exception happen during withHieDb call,
-          -- the the ending part of `reportProgress` (which clean the progress indicator) will still be called.
-          indexDoneB <- liftIO newBarrier
-          bracket_ (liftIO $ atomically $ writeTQueue indexProgressThread (reportProgress indexDoneB optProgressStyle)) (signalBarrier indexDoneB ()) $
+          -- Using bracket, so even if an exception happen during withHieDb call,
+          -- the `post` (which clean the progress indicator) will still be called.
+          bracket_ (pre optProgressStyle) post $
             withHieDb (\db -> HieDb.addRefsFromLoaded db targetPath (HieDb.RealFile $ fromNormalizedFilePath srcPath) hash hf')
     where
     mod_location    = ms_location mod_summary
     targetPath      = Compat.ml_hie_file mod_location
     HieDbWriter{..} = hiedbWriter se
 
     -- Get a progress token to report progress and update it for the current file
-    reportProgress indexDoneB style = do
+    pre style = atomically $ writeTQueue indexProgressThread $ do
       tok <- modifyVar indexProgressToken $ fmap dupe . \case
         x@(Just _) -> pure x
         -- Create a token if we don't already have one
@@ -990,9 +989,8 @@ indexHieFile se mod_summary srcPath !hash hf = do
                   , _message = Nothing
                   , _percentage = Nothing
                   }
-      -- Report the progress once we are done indexing this file
-      liftIO $ waitBarrier indexDoneB
-
+    -- Report the progress once we are done indexing this file
+    post = do
       mdone <- atomically $ do
         -- Remove current element from pending
         pending <- stateTVar indexPending $
@@ -1001,22 +999,25 @@ indexHieFile se mod_summary srcPath !hash hf = do
         -- If we are done, report and reset completed
         whenMaybe (HashMap.null pending) $
           swapTVar indexCompleted 0
-      whenJust (lspEnv se) $ \env -> LSP.runLspT env $
-        when (coerce $ ideTesting se) $
-          LSP.sendNotification (LSP.SMethod_CustomMethod (Proxy @"ghcide/reference/ready")) $
-            toJSON $ fromNormalizedFilePath srcPath
-      whenJust mdone $ \done ->
-        modifyVar_ indexProgressToken $ \tok -> do
-          whenJust (lspEnv se) $ \env -> LSP.runLspT env $
-            whenJust tok $ \token ->
-              LSP.sendNotification LSP.SMethod_Progress  $ LSP.ProgressParams token $
-                toJSON $
-                LSP.WorkDoneProgressEnd
-                  { _kind = LSP.AString @"end"
-                  , _message = Just $ "Finished indexing " <> T.pack (show done) <> " files"
-                  }
-          -- We are done with the current indexing cycle, so destroy the token
-          pure Nothing
+
+      atomically $ do
+        writeTQueue indexProgressThread $ do
+            whenJust (lspEnv se) $ \env -> LSP.runLspT env $
+                when (coerce $ ideTesting se) $
+                LSP.sendNotification (LSP.SMethod_CustomMethod (Proxy @"ghcide/reference/ready")) $
+                    toJSON $ fromNormalizedFilePath srcPath
+            whenJust mdone $ \done ->
+                modifyVar_ indexProgressToken $ \tok -> do
+                whenJust (lspEnv se) $ \env -> LSP.runLspT env $
+                    whenJust tok $ \token ->
+                    LSP.sendNotification LSP.SMethod_Progress  $ LSP.ProgressParams token $
+                        toJSON $
+                        LSP.WorkDoneProgressEnd
+                        { _kind = LSP.AString @"end"
+                        , _message = Just $ "Finished indexing " <> T.pack (show done) <> " files"
+                        }
+                -- We are done with the current indexing cycle, so destroy the token
+                pure Nothing
 
 writeAndIndexHieFile :: HscEnv -> ShakeExtras -> ModSummary -> NormalizedFilePath -> [GHC.AvailInfo] -> HieASTs Type -> BS.ByteString -> IO [FileDiagnostic]
 writeAndIndexHieFile hscEnv se mod_summary srcPath exports ast source =