@@ -14,7 +14,7 @@ module Development.IDE.Core.ProgressReporting
14
14
where
15
15
16
16
import Control.Concurrent.Async
17
- import Control.Concurrent.STM.Stats (STM , TVar , atomicallyNamed ,
17
+ import Control.Concurrent.STM.Stats (TVar , atomicallyNamed ,
18
18
newTVarIO , readTVar ,
19
19
readTVarIO , writeTVar )
20
20
import Control.Concurrent.Strict
@@ -82,21 +82,19 @@ data InProgressState = InProgressState
82
82
newInProgress :: IO InProgressState
83
83
newInProgress = InProgressState <$> newTVarIO 0 <*> newTVarIO 0 <*> STM. newIO
84
84
85
- recordProgress :: InProgressState -> NormalizedFilePath -> (Int -> Int ) -> STM ()
85
+ recordProgress :: InProgressState -> NormalizedFilePath -> (Int -> Int ) -> IO ()
86
86
recordProgress InProgressState {.. } file shift = do
87
- done <- readTVar doneVar
88
- todo <- readTVar todoVar
89
- (prev, new) <- STM. focus alterPrevAndNew file currentVar
90
- let (done',todo') =
91
- case (prev,new) of
92
- (Nothing ,0 ) -> (done+ 1 , todo+ 1 )
93
- (Nothing ,_) -> (done, todo+ 1 )
94
- (Just 0 , 0 ) -> (done , todo)
95
- (Just 0 , _) -> (done- 1 , todo)
96
- (Just _, 0 ) -> (done+ 1 , todo)
97
- (Just _, _) -> (done , todo)
98
- writeTVar todoVar todo'
99
- writeTVar doneVar done'
87
+ (prev, new) <- atomicallyNamed " recordProgress" $ STM. focus alterPrevAndNew file currentVar
88
+ atomicallyNamed " recordProgress2" $ do
89
+ done <- readTVar doneVar
90
+ todo <- readTVar todoVar
91
+ case (prev,new) of
92
+ (Nothing ,0 ) -> writeTVar doneVar (done+ 1 ) >> writeTVar todoVar (todo+ 1 )
93
+ (Nothing ,_) -> writeTVar todoVar (todo+ 1 )
94
+ (Just 0 , 0 ) -> pure ()
95
+ (Just 0 , _) -> writeTVar doneVar (done- 1 )
96
+ (Just _, 0 ) -> writeTVar doneVar (done+ 1 )
97
+ (Just _, _) -> pure ()
100
98
where
101
99
alterPrevAndNew = do
102
100
prev <- Focus. lookup
@@ -186,7 +184,7 @@ delayedProgressReporting before after lspEnv optProgressStyle = do
186
184
-- Do not remove the eta-expansion without profiling a session with at
187
185
-- least 1000 modifications.
188
186
where
189
- f shift = atomicallyNamed " recordProgress " $ recordProgress inProgress file shift
187
+ f shift = recordProgress inProgress file shift
190
188
191
189
mRunLspT :: Applicative m => Maybe (LSP. LanguageContextEnv c ) -> LSP. LspT c m () -> m ()
192
190
mRunLspT (Just lspEnv) f = LSP. runLspT lspEnv f
0 commit comments