@@ -51,7 +51,6 @@ noProgressReporting = return $ ProgressReporting
51
51
-- | State used in 'delayedProgressReporting'
52
52
data State
53
53
= NotStarted
54
- | Completed
55
54
| Stopped
56
55
| Running (Async () )
57
56
@@ -61,9 +60,8 @@ data Transition = Event ProgressEvent | StopProgress
61
60
updateState :: IO () -> Transition -> State -> IO State
62
61
updateState _ _ Stopped = pure Stopped
63
62
updateState start (Event KickStarted ) NotStarted = Running <$> async start
64
- updateState start (Event KickStarted ) Completed = Running <$> async start
65
63
updateState start (Event KickStarted ) (Running a) = cancel a >> Running <$> async start
66
- updateState _ (Event KickCompleted ) (Running a) = cancel a $> Completed
64
+ updateState _ (Event KickCompleted ) (Running a) = cancel a $> NotStarted
67
65
updateState _ (Event KickCompleted ) st = pure st
68
66
updateState _ StopProgress (Running a) = cancel a $> Stopped
69
67
updateState _ StopProgress st = pure st
@@ -96,8 +94,10 @@ delayedProgressReporting
96
94
delayedProgressReporting before after lspEnv optProgressStyle = do
97
95
inProgressVar <- newVar $ InProgress 0 0 mempty
98
96
progressState <- newVar NotStarted
99
- let progressUpdate event = modifyVar_ progressState $ updateState (mRunLspT lspEnv $ lspShakeProgress inProgressVar) (Event event)
100
- progressStop = modifyVar_ progressState $ updateState (mRunLspT lspEnv $ lspShakeProgress inProgressVar) StopProgress
97
+ let progressUpdate event = updateStateVar $ Event event
98
+ progressStop = updateStateVar StopProgress
99
+ updateStateVar = modifyVar_ progressState . updateState (mRunLspT lspEnv $ lspShakeProgress inProgressVar)
100
+
101
101
inProgress :: NormalizedFilePath -> Action a -> Action a
102
102
inProgress = withProgressVar inProgressVar
103
103
return ProgressReporting {.. }
@@ -132,12 +132,14 @@ delayedProgressReporting before after lspEnv optProgressStyle = do
132
132
{ _message = Nothing
133
133
}
134
134
}
135
+ loop _ _ | optProgressStyle == NoProgress =
136
+ forever $ liftIO $ threadDelay maxBound
135
137
loop id prev = do
136
138
InProgress {.. } <- liftIO $ readVar inProgress
139
+ liftIO $ sleep after
137
140
if todo == 0 then loop id 0 else do
138
141
let next = 100 * fromIntegral done / fromIntegral todo
139
- liftIO $ sleep after
140
- when (optProgressStyle /= NoProgress && next /= prev) $
142
+ when (next /= prev) $
141
143
LSP. sendNotification LSP. SProgress $
142
144
LSP. ProgressParams
143
145
{ _token = id
0 commit comments