spawn a progress thread for indexHieFile

Author: soulomoon

ghcide/session-loader/Development/IDE/Session.hs

@@ -403,6 +403,9 @@ runWithDb recorder fp k = do
     withAsync (writerThread withWriteDbRetryable chan) $ \_ -> do
       withHieDb fp (\readDb -> k (makeWithHieDbRetryable recorder rng readDb) chan)
   where
+    progressThread :: TQueue (IO ()) -> IO ()
+    progressThread chan = forever $ join $ atomically $ readTQueue chan
+
     writerThread :: WithHieDb -> IndexQueue -> IO ()
     writerThread withHieDbRetryable chan = do
       -- Clear the index of any files that might have been deleted since the last run

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

@@ -927,7 +927,7 @@ indexHieFile se mod_summary srcPath !hash hf = 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 $ async (reportProgress indexDoneB optProgressStyle)) (signalBarrier indexDoneB ()) $
+          bracket_ (liftIO $ atomically $ writeTQueue indexProgressThread (reportProgress indexDoneB optProgressStyle)) (signalBarrier indexDoneB ()) $
             withHieDb (\db -> HieDb.addRefsFromLoaded db targetPath (HieDb.RealFile $ fromNormalizedFilePath srcPath) hash hf')
     where
     mod_location    = ms_location mod_summary

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

@@ -245,10 +245,11 @@ instance Pretty Log where
 -- a worker thread.
 data HieDbWriter
   = HieDbWriter
-  { indexQueue         :: IndexQueue
-  , indexPending       :: TVar (HMap.HashMap NormalizedFilePath Fingerprint) -- ^ Avoid unnecessary/out of date indexing
-  , indexCompleted     :: TVar Int -- ^ to report progress
-  , indexProgressToken :: Var (Maybe LSP.ProgressToken)
+  { indexQueue          :: IndexQueue
+  , indexPending        :: TVar (HMap.HashMap NormalizedFilePath Fingerprint) -- ^ Avoid unnecessary/out of date indexing
+  , indexCompleted      :: TVar Int -- ^ to report progress
+  , indexProgressToken  :: Var (Maybe LSP.ProgressToken)
+  , indexProgressThread :: TQueue (IO ())
   -- ^ This is a Var instead of a TVar since we need to do IO to initialise/update, so we need a lock
   }
 
@@ -653,6 +654,7 @@ shakeOpen recorder lspEnv defaultConfig idePlugins debouncer
         indexCompleted <- newTVarIO 0
         semanticTokensId <- newTVarIO 0
         indexProgressToken <- newVar Nothing
+        indexProgressThread <- newTQueueIO
         let hiedbWriter = HieDbWriter{..}
         exportsMap <- newTVarIO mempty
         -- lazily initialize the exports map with the contents of the hiedb