Skip to content

Commit

Permalink
Send begin progress message synchronously
Browse files Browse the repository at this point in the history
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
  • Loading branch information
pepeiborra authored and wz1000 committed Aug 18, 2022
1 parent c9ed045 commit f4ce73f
Showing 1 changed file with 10 additions and 9 deletions.
19 changes: 10 additions & 9 deletions ghcide/src/Development/IDE/Core/ProgressReporting.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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{..}
Expand All @@ -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
Expand Down

0 comments on commit f4ce73f

Please sign in to comment.