From 5631730e8677a6e14f4369909611df280f26d54c Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@fb.com>
Date: Wed, 17 Aug 2022 17:40:26 +0200
Subject: [PATCH] Send begin progress message synchronously

Currently the Begin progress message is sent asynchronously, so it can
happen that it's never sent if the async is cancelled immediately
because a new kick has started. This causes trouble in tests and
benchmarks which make assumptions about progress updates.

To address this, we send the Begin progress message synchronously,
and only then do the rest of the progress reporting stuff
(including waiting for the response) asynchronously
---
 .../Development/IDE/Core/ProgressReporting.hs | 19 ++++++++++---------
 1 file changed, 10 insertions(+), 9 deletions(-)

diff --git a/ghcide/src/Development/IDE/Core/ProgressReporting.hs b/ghcide/src/Development/IDE/Core/ProgressReporting.hs
index 7bb6e11944..7436ca56ff 100644
--- a/ghcide/src/Development/IDE/Core/ProgressReporting.hs
+++ b/ghcide/src/Development/IDE/Core/ProgressReporting.hs
@@ -63,10 +63,10 @@ data State
 -- | State transitions used in 'delayedProgressReporting'
 data Transition = Event ProgressEvent | StopProgress
 
-updateState :: IO () -> Transition -> State -> IO State
+updateState :: IO (Async ()) -> Transition -> State -> IO State
 updateState _      _                    Stopped     = pure Stopped
-updateState start (Event KickStarted)   NotStarted  = Running <$> async start
-updateState start (Event KickStarted)   (Running a) = cancel a >> Running <$> async start
+updateState start (Event KickStarted)   NotStarted  = Running <$> start
+updateState start (Event KickStarted)   (Running a) = cancel a >> Running <$> start
 updateState _     (Event KickCompleted) (Running a) = cancel a $> NotStarted
 updateState _     (Event KickCompleted) st          = pure st
 updateState _     StopProgress          (Running a) = cancel a $> Stopped
@@ -110,12 +110,13 @@ delayedProgressReporting
   -> Maybe (LSP.LanguageContextEnv c)
   -> ProgressReportingStyle
   -> IO ProgressReporting
-delayedProgressReporting before after lspEnv optProgressStyle = do
+delayedProgressReporting before after Nothing optProgressStyle = noProgressReporting
+delayedProgressReporting before after (Just lspEnv) optProgressStyle = do
     inProgressState <- newInProgress
     progressState <- newVar NotStarted
     let progressUpdate event = updateStateVar $ Event event
         progressStop   =  updateStateVar StopProgress
-        updateStateVar = modifyVar_ progressState . updateState (mRunLspT lspEnv $ lspShakeProgress inProgressState)
+        updateStateVar = modifyVar_ progressState . updateState (lspShakeProgress inProgressState)
 
         inProgress = updateStateForFile inProgressState
     return ProgressReporting{..}
@@ -127,11 +128,11 @@ delayedProgressReporting before after lspEnv optProgressStyle = do
             u <- ProgressTextToken . T.pack . show . hashUnique <$> liftIO newUnique
 
             b <- liftIO newBarrier
-            void $ LSP.sendRequest LSP.SWindowWorkDoneProgressCreate
+            void $ LSP.runLspT lspEnv $ LSP.sendRequest LSP.SWindowWorkDoneProgressCreate
                 LSP.WorkDoneProgressCreateParams { _token = u } $ liftIO . signalBarrier b
-            ready <- liftIO $ waitBarrier b
-
-            for_ ready $ const $ bracket_ (start u) (stop u) (loop u 0)
+            liftIO $ async $ do
+                ready <- waitBarrier b
+                LSP.runLspT lspEnv $ for_ ready $ const $ bracket_ (start u) (stop u) (loop u 0)
             where
                 start id = LSP.sendNotification LSP.SProgress $
                     LSP.ProgressParams