report indexing in another thread

Author: soulomoon

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

@@ -139,6 +139,7 @@ import           GHC.Core.Lint.Interactive
 #if MIN_VERSION_ghc(9,7,0)
 import           Data.Foldable                     (toList)
 import           GHC.Unit.Module.Warnings
+import Control.Concurrent.Async (async, withAsync)
 #else
 import           Development.IDE.Core.FileStore    (shareFilePath)
 #endif
@@ -923,17 +924,19 @@ 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 `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
+          -- Using `finally`, 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
+          withAsync (reportProgress indexDoneB optProgressStyle) $ \preAsync ->
+            flip finally (signalBarrier indexDoneB ()) $
+                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
-    pre style = do
+    reportProgress indexDoneB style = do
       tok <- modifyVar indexProgressToken $ fmap dupe . \case
         x@(Just _) -> pure x
         -- Create a token if we don't already have one
@@ -944,15 +947,16 @@ indexHieFile se mod_summary srcPath !hash hf = do
               u <- LSP.ProgressToken . LSP.InR . T.pack . show . hashUnique <$> liftIO Unique.newUnique
               b <- liftIO newBarrier
               void $ LSP.sendRequest LSP.SMethod_WindowWorkDoneProgressCreate (LSP.WorkDoneProgressCreateParams u) $ liftIO . signalBarrier b
-              ready <- liftIO $ waitBarrier b
-              LSP.sendNotification LSP.SMethod_Progress $ LSP.ProgressParams u $
-                toJSON $ LSP.WorkDoneProgressBegin
-                  { _kind = LSP.AString @"begin"
-                  ,  _title = "Indexing"
-                  , _cancellable = Nothing
-                  , _message = Nothing
-                  , _percentage = Nothing
-                  }
+              liftIO $ async $ do
+                _ready <- waitBarrier b
+                LSP.runLspT env $ LSP.sendNotification LSP.SMethod_Progress $ LSP.ProgressParams u $
+                        toJSON $ LSP.WorkDoneProgressBegin
+                        { _kind = LSP.AString @"begin"
+                        ,  _title = "Indexing"
+                        , _cancellable = Nothing
+                        , _message = Nothing
+                        , _percentage = Nothing
+                        }
               pure (Just u)
 
       (!done, !remaining) <- atomically $ do
@@ -964,7 +968,6 @@ indexHieFile se mod_summary srcPath !hash hf = do
         progressFrac = fromIntegral done / fromIntegral (done + remaining)
         progressPct :: LSP.UInt
         progressPct = floor $ 100 * progressFrac
-
       whenJust (lspEnv se) $ \env -> whenJust tok $ \token -> LSP.runLspT env $
         LSP.sendNotification LSP.SMethod_Progress $ LSP.ProgressParams token $
           toJSON $
@@ -988,9 +991,9 @@ 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 $