on master help sign in
Don't repeatedly update the progress (#230)
9d1f2baNeil Mitchell
src/Development/IDE/Core/Shake.hs+14−11
@@ -311,7 +311,7 @@ lspShakeProgress getLspId sendMsg prog = do
311 sendMsg $ LSP.ReqWorkDoneProgressCreate $ LSP.fmServerWorkDoneProgressCreateRequest
311 sendMsg $ LSP.ReqWorkDoneProgressCreate $ LSP.fmServerWorkDoneProgressCreateRequest
312 lspId $ LSP.WorkDoneProgressCreateParams
312 lspId $ LSP.WorkDoneProgressCreateParams
313 { _token = u }
313 { _token = u }
314− bracket_ (start u) (stop u) (loop u)
314+ bracket_ (start u) (stop u) (loop u Nothing)
315 where
315 where
316 start id = sendMsg $ LSP.NotWorkDoneProgressBegin $ LSP.fmServerWorkDoneProgressBeginNotification
316 start id = sendMsg $ LSP.NotWorkDoneProgressBegin $ LSP.fmServerWorkDoneProgressBeginNotification
317 LSP.ProgressParams
317 LSP.ProgressParams
@@ -331,20 +331,23 @@ lspShakeProgress getLspId sendMsg prog = do
331 }
331 }
332 }
332 }
333 sample = 0.1
333 sample = 0.1
334− loop id = forever $ do
334+ loop id prev = do
335 sleep sample
335 sleep sample
336 p <- prog
336 p <- prog
337 let done = countSkipped p + countBuilt p
337 let done = countSkipped p + countBuilt p
338 let todo = done + countUnknown p + countTodo p
338 let todo = done + countUnknown p + countTodo p
339+ let next = Just $ T.pack $ show done <> "/" <> show todo
340+ when (next /= prev) $
339− sendMsg $ LSP.NotWorkDoneProgressReport $ LSP.fmServerWorkDoneProgressReportNotification
341+ sendMsg $ LSP.NotWorkDoneProgressReport $ LSP.fmServerWorkDoneProgressReportNotification
340− LSP.ProgressParams
342+ LSP.ProgressParams
341− { _token = id
343+ { _token = id
342− , _value = LSP.WorkDoneProgressReportParams
344+ , _value = LSP.WorkDoneProgressReportParams
343− { _cancellable = Nothing
345+ { _cancellable = Nothing
344− , _message = Just $ T.pack $ show done <> "/" <> show todo
346+ , _message = next
345− , _percentage = Nothing
347+ , _percentage = Nothing
346− }
348+ }
347− }
349+ }
350+ loop id next
348
351
349shakeProfile :: IdeState -> FilePath -> IO ()
352shakeProfile :: IdeState -> FilePath -> IO ()
350shakeProfile IdeState{..} = shakeProfileDatabase shakeDb
353shakeProfile IdeState{..} = shakeProfileDatabase shakeDb