Skip to content

Commit 3bb1e1b

Browse files
soulomoonsoulomoon
committed
thread shake restart to a worker thread
1 parent 240254e commit 3bb1e1b

File tree

4 files changed

+50
-17
lines changed

4 files changed

+50
-17
lines changed

‎ghcide/src/Development/IDE/Core/Service.hs

Lines changed: 21 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,8 @@
99
module Development.IDE.Core.Service(
1010
getIdeOptions, getIdeOptionsIO,
1111
IdeState, initialise, shutdown,
12+
runWithShake,
13+
ShakeOpQueue,
1214
runAction,
1315
getDiagnostics,
1416
ideLogger,
@@ -31,6 +33,10 @@ import Ide.Plugin.Config
3133
import qualified Language.LSP.Protocol.Types as LSP
3234
import qualified Language.LSP.Server as LSP
3335

36+
import Control.Concurrent.Async (async, withAsync)
37+
import Control.Concurrent.STM (TQueue, atomically,
38+
newTQueueIO, readTQueue,
39+
writeTBQueue, writeTQueue)
3440
import Control.Monad
3541
import qualified Development.IDE.Core.FileExists as FileExists
3642
import qualified Development.IDE.Core.OfInterest as OfInterest
@@ -66,9 +72,10 @@ initialise :: Recorder (WithPriority Log)
6672
-> IdeOptions
6773
-> WithHieDb
6874
-> IndexQueue
75+
-> ShakeOpQueue
6976
-> Monitoring
7077
-> IO IdeState
71-
initialise recorder defaultConfig plugins mainRule lspEnv debouncer options withHieDb hiedbChan metrics = do
78+
initialise recorder defaultConfig plugins mainRule lspEnv debouncer options withHieDb hiedbChan sq metrics = do
7279
shakeProfiling <- do
7380
let fromConf = optShakeProfiling options
7481
fromEnv <- lookupEnv "GHCIDE_BUILD_PROFILING"
@@ -84,6 +91,7 @@ initialise recorder defaultConfig plugins mainRule lspEnv debouncer options with
8491
(optTesting options)
8592
withHieDb
8693
hiedbChan
94+
sq
8795
(optShakeOptions options)
8896
metrics
8997
$ do
@@ -94,11 +102,22 @@ initialise recorder defaultConfig plugins mainRule lspEnv debouncer options with
94102

95103
-- | Shutdown the Compiler Service.
96104
shutdown :: IdeState -> IO ()
97-
shutdown = shakeShut
105+
shutdown st = atomically $ writeTQueue (shakeOpQueue $ shakeExtras st) $ shakeShut st
98106

99107
-- This will return as soon as the result of the action is
100108
-- available. There might still be other rules running at this point,
101109
-- e.g., the ofInterestRule.
102110
runAction :: String -> IdeState -> Action a -> IO a
103111
runAction herald ide act =
104112
join $ shakeEnqueue (shakeExtras ide) (mkDelayedAction herald Logger.Debug act)
113+
114+
115+
runWithShake :: (ShakeOpQueue-> IO ()) -> IO ()
116+
runWithShake f = do
117+
q <- newTQueueIO
118+
withAsync (runShakeOp q) $ const $ f q
119+
where
120+
runShakeOp :: ShakeOpQueue -> IO ()
121+
runShakeOp q = do
122+
join $ atomically $ readTQueue q
123+
runShakeOp q

‎ghcide/src/Development/IDE/Core/Shake.hs

Lines changed: 10 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@ module Development.IDE.Core.Shake(
2929
GetModificationTime(GetModificationTime, GetModificationTime_, missingFileDiagnostics),
3030
shakeOpen, shakeShut,
3131
shakeEnqueue,
32+
ShakeOpQueue,
3233
newSession,
3334
use, useNoFile, uses, useWithStaleFast, useWithStaleFast', delayedAction,
3435
FastResult(..),
@@ -77,6 +78,7 @@ module Development.IDE.Core.Shake(
7778

7879
import Control.Concurrent.Async
7980
import Control.Concurrent.STM
81+
import Control.Concurrent.STM (writeTQueue)
8082
import Control.Concurrent.STM.Stats (atomicallyNamed)
8183
import Control.Concurrent.Strict
8284
import Control.DeepSeq
@@ -257,6 +259,10 @@ data HieDbWriter
257259
-- with (currently) retry functionality
258260
type IndexQueue = TQueue (((HieDb -> IO ()) -> IO ()) -> IO ())
259261

262+
-- ShakeOpQueue is used to enqueue Shake operations.
263+
-- shutdown, restart
264+
type ShakeOpQueue = TQueue (IO ())
265+
260266
-- Note [Semantic Tokens Cache Location]
261267
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
262268
-- storing semantic tokens cache for each file in shakeExtras might
@@ -329,6 +335,7 @@ data ShakeExtras = ShakeExtras
329335
-- ^ Default HLS config, only relevant if the client does not provide any Config
330336
, dirtyKeys :: TVar KeySet
331337
-- ^ Set of dirty rule keys since the last Shake run
338+
, shakeOpQueue :: ShakeOpQueue
332339
}
333340

334341
type WithProgressFunc = forall a.
@@ -614,14 +621,15 @@ shakeOpen :: Recorder (WithPriority Log)
614621
-> IdeTesting
615622
-> WithHieDb
616623
-> IndexQueue
624+
-> ShakeOpQueue
617625
-> ShakeOptions
618626
-> Monitoring
619627
-> Rules ()
620628
-> IO IdeState
621629
shakeOpen recorder lspEnv defaultConfig idePlugins debouncer
622630
shakeProfileDir (IdeReportProgress reportProgress)
623631
ideTesting@(IdeTesting testing)
624-
withHieDb indexQueue opts monitoring rules = mdo
632+
withHieDb indexQueue shakeOpQueue opts monitoring rules = mdo
625633

626634
#if MIN_VERSION_ghc(9,3,0)
627635
ideNc <- initNameCache 'r' knownKeyNames
@@ -752,6 +760,7 @@ delayedAction a = do
752760
-- but actions added via 'shakeEnqueue' will be requeued.
753761
shakeRestart :: Recorder (WithPriority Log) -> IdeState -> VFSModified -> String -> [DelayedAction ()] -> IO [Key] -> IO ()
754762
shakeRestart recorder IdeState{..} vfs reason acts ioActionBetweenShakeSession =
763+
atomically $ writeTQueue (shakeOpQueue $ shakeExtras) $
755764
withMVar'
756765
shakeSession
757766
(\runner -> do

‎ghcide/src/Development/IDE/LSP/LanguageServer.hs

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,8 @@ import UnliftIO.Exception
3434
import qualified Colog.Core as Colog
3535
import Control.Monad.IO.Unlift (MonadUnliftIO)
3636
import Development.IDE.Core.IdeConfiguration
37+
import Development.IDE.Core.Service (ShakeOpQueue,
38+
runWithShake)
3739
import Development.IDE.Core.Shake hiding (Log, Priority)
3840
import Development.IDE.Core.Tracing
3941
import qualified Development.IDE.Session as Session
@@ -128,7 +130,7 @@ setupLSP ::
128130
Recorder (WithPriority Log)
129131
-> (FilePath -> IO FilePath) -- ^ Map root paths to the location of the hiedb for the project
130132
-> LSP.Handlers (ServerM config)
131-
-> (LSP.LanguageContextEnv config -> Maybe FilePath -> WithHieDb -> IndexQueue -> IO IdeState)
133+
-> (LSP.LanguageContextEnv config -> Maybe FilePath -> WithHieDb -> IndexQueue -> ShakeOpQueue -> IO IdeState)
132134
-> MVar ()
133135
-> IO (LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState)),
134136
LSP.Handlers (ServerM config),
@@ -186,7 +188,7 @@ setupLSP recorder getHieDbLoc userHandlers getIdeState clientMsgVar = do
186188
handleInit
187189
:: Recorder (WithPriority Log)
188190
-> (FilePath -> IO FilePath)
189-
-> (LSP.LanguageContextEnv config -> Maybe FilePath -> WithHieDb -> IndexQueue -> IO IdeState)
191+
-> (LSP.LanguageContextEnv config -> Maybe FilePath -> WithHieDb -> IndexQueue -> ShakeOpQueue -> IO IdeState)
190192
-> MVar ()
191193
-> IO ()
192194
-> (SomeLspId -> IO ())
@@ -228,8 +230,8 @@ handleInit recorder getHieDbLoc getIdeState lifetime exitClientMsg clearReqId wa
228230
exceptionInHandler e
229231
k $ ResponseError (InR ErrorCodes_InternalError) (T.pack $ show e) Nothing
230232
_ <- flip forkFinally handleServerException $ do
231-
untilMVar lifetime $ runWithDb (cmapWithPrio LogSession recorder) dbLoc $ \withHieDb' hieChan' -> do
232-
putMVar dbMVar (WithHieDbShield withHieDb',hieChan')
233+
untilMVar lifetime $ runWithShake $ \sq -> runWithDb (cmapWithPrio LogSession recorder) dbLoc $ \withHieDb' hieChan' -> do
234+
putMVar dbMVar (WithHieDbShield withHieDb',hieChan',sq)
233235
forever $ do
234236
msg <- readChan clientMsgChan
235237
-- We dispatch notifications synchronously and requests asynchronously
@@ -239,8 +241,8 @@ handleInit recorder getHieDbLoc getIdeState lifetime exitClientMsg clearReqId wa
239241
ReactorRequest _id act k -> void $ async $ checkCancelled _id act k
240242
logWith recorder Info LogReactorThreadStopped
241243

242-
(WithHieDbShield withHieDb,hieChan) <- takeMVar dbMVar
243-
ide <- getIdeState env root withHieDb hieChan
244+
(WithHieDbShield withHieDb,hieChan,sq) <- takeMVar dbMVar
245+
ide <- getIdeState env root withHieDb hieChan sq
244246
registerIdeConfiguration (shakeExtras ide) initConfig
245247
pure $ Right (env,ide)
246248

‎ghcide/src/Development/IDE/Main.hs

Lines changed: 11 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -51,8 +51,10 @@ import qualified Development.IDE.Core.Rules as Rules
5151
import Development.IDE.Core.RuleTypes (GenerateCore (GenerateCore),
5252
GetHieAst (GetHieAst),
5353
TypeCheck (TypeCheck))
54-
import Development.IDE.Core.Service (initialise,
55-
runAction)
54+
import Development.IDE.Core.Service (ShakeOpQueue,
55+
initialise,
56+
runAction,
57+
runWithShake)
5658
import qualified Development.IDE.Core.Service as Service
5759
import Development.IDE.Core.Shake (IdeState (shakeExtras),
5860
IndexQueue,
@@ -309,8 +311,8 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
309311
logWith recorder Info $ LogLspStart (pluginId <$> ipMap argsHlsPlugins)
310312

311313
ideStateVar <- newEmptyMVar
312-
let getIdeState :: LSP.LanguageContextEnv Config -> Maybe FilePath -> WithHieDb -> IndexQueue -> IO IdeState
313-
getIdeState env rootPath withHieDb hieChan = do
314+
let getIdeState :: LSP.LanguageContextEnv Config -> Maybe FilePath -> WithHieDb -> IndexQueue -> ShakeOpQueue -> IO IdeState
315+
getIdeState env rootPath withHieDb hieChan sq = do
314316
traverse_ IO.setCurrentDirectory rootPath
315317
t <- ioT
316318
logWith recorder Info $ LogLspStartDuration t
@@ -349,6 +351,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
349351
ideOptions
350352
withHieDb
351353
hieChan
354+
sq
352355
monitoring
353356
putMVar ideStateVar ide
354357
pure ide
@@ -373,7 +376,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
373376
Check argFiles -> do
374377
dir <- maybe IO.getCurrentDirectory return argsProjectRoot
375378
dbLoc <- getHieDbLoc dir
376-
runWithDb (cmapWithPrio LogSession recorder) dbLoc $ \hiedb hieChan -> do
379+
runWithShake $ \sq -> runWithDb (cmapWithPrio LogSession recorder) dbLoc $ \hiedb hieChan -> do
377380
-- GHC produces messages with UTF8 in them, so make sure the terminal doesn't error
378381
hSetEncoding stdout utf8
379382
hSetEncoding stderr utf8
@@ -401,7 +404,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
401404
, optCheckProject = pure False
402405
, optModifyDynFlags = optModifyDynFlags def_options <> pluginModifyDynflags plugins
403406
}
404-
ide <- initialise (cmapWithPrio LogService recorder) argsDefaultHlsConfig argsHlsPlugins rules Nothing debouncer ideOptions hiedb hieChan mempty
407+
ide <- initialise (cmapWithPrio LogService recorder) argsDefaultHlsConfig argsHlsPlugins rules Nothing debouncer ideOptions hiedb hieChan sq mempty
405408
shakeSessionInit (cmapWithPrio LogShake recorder) ide
406409
registerIdeConfiguration (shakeExtras ide) $ IdeConfiguration mempty (hashed Nothing)
407410

@@ -431,15 +434,15 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
431434
Custom (IdeCommand c) -> do
432435
root <- maybe IO.getCurrentDirectory return argsProjectRoot
433436
dbLoc <- getHieDbLoc root
434-
runWithDb (cmapWithPrio LogSession recorder) dbLoc $ \hiedb hieChan -> do
437+
runWithShake $ \sq -> runWithDb (cmapWithPrio LogSession recorder) dbLoc $ \hiedb hieChan -> do
435438
sessionLoader <- loadSessionWithOptions (cmapWithPrio LogSession recorder) argsSessionLoadingOptions "."
436439
let def_options = argsIdeOptions argsDefaultHlsConfig sessionLoader
437440
ideOptions = def_options
438441
{ optCheckParents = pure NeverCheck
439442
, optCheckProject = pure False
440443
, optModifyDynFlags = optModifyDynFlags def_options <> pluginModifyDynflags plugins
441444
}
442-
ide <- initialise (cmapWithPrio LogService recorder) argsDefaultHlsConfig argsHlsPlugins rules Nothing debouncer ideOptions hiedb hieChan mempty
445+
ide <- initialise (cmapWithPrio LogService recorder) argsDefaultHlsConfig argsHlsPlugins rules Nothing debouncer ideOptions hiedb hieChan sq mempty
443446
shakeSessionInit (cmapWithPrio LogShake recorder) ide
444447
registerIdeConfiguration (shakeExtras ide) $ IdeConfiguration mempty (hashed Nothing)
445448
c ide

0 commit comments

Comments
 (0)