From ae3a5f1628eaa9606a83d86138ecbe83066baf4e Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 22 Aug 2025 06:35:36 +0800
Subject: [PATCH 01/61] Fix broken pip during test

gracefully exit the server
---
 cabal.project                                 | 21 ++++
 ghcide/src/Development/IDE/Core/FileStore.hs  |  4 +-
 ghcide/src/Development/IDE/Core/Rules.hs      |  4 +-
 ghcide/src/Development/IDE/Core/Shake.hs      |  7 +-
 .../src/Development/IDE/LSP/LanguageServer.hs | 30 +++---
 .../IDE/Plugin/Completions/Logic.hs           |  2 +-
 hls-test-utils/src/Test/Hls.hs                | 18 +++-
 .../test/SemanticTokensTest.hs                |  2 +-
 scripts/open-close-loop.sh                    | 99 +++++++++++++++++++
 9 files changed, 164 insertions(+), 23 deletions(-)
 create mode 100755 scripts/open-close-loop.sh

diff --git a/cabal.project b/cabal.project
index 8d8bd080af..4abfc93bc9 100644
--- a/cabal.project
+++ b/cabal.project
@@ -5,6 +5,9 @@ packages:
          ./ghcide
          ./hls-plugin-api
          ./hls-test-utils
+--         /Volumes/src/lsp/lsp
+--         /Volumes/src/lsp/lsp-types
+--         /Volumes/src/lsp/lsp-test
 
 
 index-state: 2025-08-08T12:31:54Z
@@ -56,3 +59,21 @@ if impl(ghc >= 9.11)
   allow-newer:
     cabal-install-parsers:base,
     cabal-install-parsers:time,
+
+source-repository-package
+  type: git
+  location: https://github.com/soulomoon/lsp.git
+  commit: 6f217e8a1afcb77a926023d0ac9cbc0da7ef4d3c
+  subdir: lsp
+
+source-repository-package
+  type: git
+  location: https://github.com/soulomoon/lsp.git
+  commit: 6f217e8a1afcb77a926023d0ac9cbc0da7ef4d3c
+  subdir: lsp-types
+
+source-repository-package
+  type: git
+  location: https://github.com/soulomoon/lsp.git
+  commit: 6f217e8a1afcb77a926023d0ac9cbc0da7ef4d3c
+  subdir: lsp-test
diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs
index e545ec7b14..714d991201 100644
--- a/ghcide/src/Development/IDE/Core/FileStore.hs
+++ b/ghcide/src/Development/IDE/Core/FileStore.hs
@@ -252,8 +252,8 @@ getVersionedTextDoc doc = do
     maybe (pure Nothing) getVirtualFile $
         uriToNormalizedFilePath $ toNormalizedUri uri
   let ver = case mvf of
-        Just (VirtualFile lspver _ _) -> lspver
-        Nothing                       -> 0
+        Just (VirtualFile lspver _ _ _) -> lspver
+        Nothing                         -> 0
   return (VersionedTextDocumentIdentifier uri ver)
 
 fileStoreRules :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules ()
diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs
index c123c9d4a8..6c2b658208 100644
--- a/ghcide/src/Development/IDE/Core/Rules.hs
+++ b/ghcide/src/Development/IDE/Core/Rules.hs
@@ -516,8 +516,8 @@ persistentHieFileRule recorder = addPersistentRule GetHieAst $ \file -> runMaybe
   vfsRef <- asks vfsVar
   vfsData <- liftIO $ _vfsMap <$> readTVarIO vfsRef
   (currentSource, ver) <- liftIO $ case M.lookup (filePathToUri' file) vfsData of
-    Nothing -> (,Nothing) . T.decodeUtf8 <$> BS.readFile (fromNormalizedFilePath file)
-    Just vf -> pure (virtualFileText vf, Just $ virtualFileVersion vf)
+    Just (Open vf) -> pure (virtualFileText vf, Just $ virtualFileVersion vf)
+    _ -> (,Nothing) . T.decodeUtf8 <$> BS.readFile (fromNormalizedFilePath file)
   let refmap = generateReferencesMap . getAsts . Compat.hie_asts $ res
       del = deltaFromDiff (T.decodeUtf8 $ Compat.hie_hs_src res) currentSource
   pure (HAR (Compat.hie_module res) (Compat.hie_asts res) refmap mempty (HieFromDisk res),del,ver)
diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs
index 6fc9a4d00e..70688ae47b 100644
--- a/ghcide/src/Development/IDE/Core/Shake.hs
+++ b/ghcide/src/Development/IDE/Core/Shake.hs
@@ -390,11 +390,16 @@ addPersistentRule k getVal = do
 
 class Typeable a => IsIdeGlobal a where
 
+-- data VirtualFileEntry = Open VirtualFile | Closed ClosedVirtualFile
+getOpenFile :: VirtualFileEntry -> Maybe VirtualFile
+getOpenFile (Open vf) = Just vf
+getOpenFile _         = Nothing
 -- | Read a virtual file from the current snapshot
 getVirtualFile :: NormalizedFilePath -> Action (Maybe VirtualFile)
 getVirtualFile nf = do
   vfs <- fmap _vfsMap . liftIO . readTVarIO . vfsVar =<< getShakeExtras
-  pure $! Map.lookup (filePathToUri' nf) vfs -- Don't leak a reference to the entire map
+  let file = getOpenFile =<< Map.lookup (filePathToUri' nf) vfs
+  pure $! file -- Don't leak a reference to the entire map
 
 -- Take a snapshot of the current LSP VFS
 vfsSnapshot :: Maybe (LSP.LanguageContextEnv a) -> IO VFS
diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
index 918e024a4f..d08f32e53a 100644
--- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs
+++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
@@ -35,6 +35,9 @@ import           UnliftIO.Directory
 import           UnliftIO.Exception
 
 import qualified Colog.Core                            as Colog
+import           Control.Concurrent.Extra              (newBarrier,
+                                                        signalBarrier,
+                                                        waitBarrier)
 import           Control.Monad.IO.Unlift               (MonadUnliftIO)
 import           Control.Monad.Trans.Cont              (evalContT)
 import           Development.IDE.Core.IdeConfiguration
@@ -136,8 +139,7 @@ runLanguageServer recorder options inH outH defaultConfig parseConfig onConfigCh
             outH
             serverDefinition
 
-    untilMVar clientMsgVar $
-        runServer `finally` sequence_ onExit
+    void $ runServer `finally` sequence_ onExit
 
 setupLSP ::
      forall config.
@@ -156,7 +158,10 @@ setupLSP recorder defaultRoot getHieDbLoc userHandlers getIdeState clientMsgVar
   -- An MVar to control the lifetime of the reactor loop.
   -- The loop will be stopped and resources freed when it's full
   reactorLifetime <- newEmptyMVar
+  reactorLifetimeConfirmBarrier <- newBarrier
   let stopReactorLoop = void $ tryPutMVar reactorLifetime ()
+  let stopReactorLoopConfirm = signalBarrier reactorLifetimeConfirmBarrier ()
+  let untilReactorLifetimeConfirm = waitBarrier reactorLifetimeConfirmBarrier
 
   -- Forcefully exit
   let exit = void $ tryPutMVar clientMsgVar ()
@@ -185,17 +190,16 @@ setupLSP recorder defaultRoot getHieDbLoc userHandlers getIdeState clientMsgVar
   let staticHandlers = mconcat
         [ userHandlers
         , cancelHandler cancelRequest
-        , exitHandler exit
-        , shutdownHandler recorder stopReactorLoop
+        , shutdownHandler recorder (stopReactorLoop, untilReactorLifetimeConfirm)
         ]
         -- Cancel requests are special since they need to be handled
         -- out of order to be useful. Existing handlers are run afterwards.
 
-  let doInitialize = handleInit recorder defaultRoot getHieDbLoc getIdeState reactorLifetime exit clearReqId waitForCancel clientMsgChan
+  let doInitialize = handleInit recorder defaultRoot getHieDbLoc getIdeState (reactorLifetime, stopReactorLoopConfirm) exit clearReqId waitForCancel clientMsgChan
 
   let interpretHandler (env,  st) = LSP.Iso (LSP.runLspT env . flip (runReaderT . unServerM) (clientMsgChan,st)) liftIO
 
-  let onExit = [stopReactorLoop, exit]
+  let onExit = [stopReactorLoop, untilReactorLifetimeConfirm, exit]
 
   pure MkSetup {doInitialize, staticHandlers, interpretHandler, onExit}
 
@@ -205,13 +209,13 @@ handleInit
     -> FilePath -- ^ root directory, see Note [Root Directory]
     -> (FilePath -> IO FilePath)
     -> (LSP.LanguageContextEnv config -> FilePath -> WithHieDb -> ThreadQueue -> IO IdeState)
-    -> MVar ()
+    -> (MVar (), IO ())
     -> IO ()
     -> (SomeLspId -> IO ())
     -> (SomeLspId -> IO ())
     -> Chan ReactorMessage
     -> LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState))
-handleInit recorder defaultRoot getHieDbLoc getIdeState lifetime exitClientMsg clearReqId waitForCancel clientMsgChan env (TRequestMessage _ _ m params) = otTracedHandler "Initialize" (show m) $ \sp -> do
+handleInit recorder defaultRoot getHieDbLoc getIdeState (lifetime, lifetimeConfirm) exitClientMsg clearReqId waitForCancel clientMsgChan env (TRequestMessage _ _ m params) = otTracedHandler "Initialize" (show m) $ \sp -> do
     traceWithSpan sp params
     -- only shift if lsp root is different from the rootDir
     -- see Note [Root Directory]
@@ -227,7 +231,7 @@ handleInit recorder defaultRoot getHieDbLoc getIdeState lifetime exitClientMsg c
     let handleServerException (Left e) = do
             logWith recorder Error $ LogReactorThreadException e
             exitClientMsg
-        handleServerException (Right _) = pure ()
+        handleServerException (Right _) = lifetimeConfirm
 
         exceptionInHandler e = do
             logWith recorder Error $ LogReactorMessageActionException e
@@ -293,19 +297,17 @@ cancelHandler cancelRequest = LSP.notificationHandler SMethod_CancelRequest $ \T
         toLspId (InL x) = IdInt x
         toLspId (InR y) = IdString y
 
-shutdownHandler :: Recorder (WithPriority Log) -> IO () -> LSP.Handlers (ServerM c)
-shutdownHandler recorder stopReactor = LSP.requestHandler SMethod_Shutdown $ \_ resp -> do
+shutdownHandler :: Recorder (WithPriority Log) -> (IO (), IO ()) -> LSP.Handlers (ServerM c)
+shutdownHandler recorder (stopReactor, confirmVar) = LSP.requestHandler SMethod_Shutdown $ \_ resp -> do
     (_, ide) <- ask
     liftIO $ logWith recorder Debug LogServerShutdownMessage
     -- stop the reactor to free up the hiedb connection
     liftIO stopReactor
     -- flush out the Shake session to record a Shake profile if applicable
     liftIO $ shakeShut ide
+    liftIO confirmVar
     resp $ Right Null
 
-exitHandler :: IO () -> LSP.Handlers (ServerM c)
-exitHandler exit = LSP.notificationHandler SMethod_Exit $ const $ liftIO exit
-
 modifyOptions :: LSP.Options -> LSP.Options
 modifyOptions x = x{ LSP.optTextDocumentSync   = Just $ tweakTDS origTDS
                    }
diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs
index 0a5cecaca8..6c59a5ffe5 100644
--- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs
+++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs
@@ -857,7 +857,7 @@ mergeListsBy cmp all_lists = merge_lists all_lists
 
 -- |From the given cursor position, gets the prefix module or record for autocompletion
 getCompletionPrefix :: Position -> VFS.VirtualFile -> PosPrefixInfo
-getCompletionPrefix pos (VFS.VirtualFile _ _ ropetext) = getCompletionPrefixFromRope pos ropetext
+getCompletionPrefix pos (VFS.VirtualFile _ _ ropetext _) = getCompletionPrefixFromRope pos ropetext
 
 getCompletionPrefixFromRope :: Position -> Rope.Rope -> PosPrefixInfo
 getCompletionPrefixFromRope pos@(Position l c) ropetext =
diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs
index 1193b2dd19..dd76ed06b0 100644
--- a/hls-test-utils/src/Test/Hls.hs
+++ b/hls-test-utils/src/Test/Hls.hs
@@ -153,6 +153,17 @@ data Log
   = LogIDEMain IDEMain.Log
   | LogTestHarness LogTestHarness
 
+data TestRunLog
+  = TestRunFinished
+  | TestServerExitTimeoutSeconds Int
+  | TestServerCancelFinished String
+
+instance Pretty TestRunLog where
+    pretty :: TestRunLog -> Logger.Doc ann
+    pretty TestRunFinished = "Test run finished"
+    pretty (TestServerExitTimeoutSeconds secs) = "Server does not exit in " <> pretty secs <> "s, canceling the async task..."
+    pretty (TestServerCancelFinished took) = "Finishing canceling (took " <> pretty took <> "s)"
+
 instance Pretty Log where
   pretty = \case
     LogIDEMain log     -> pretty log
@@ -746,6 +757,7 @@ wrapClientLogger logger = do
     let lspLogRecorder = cmapWithPrio (renderStrict . layoutPretty defaultLayoutOptions. pretty) lspLogRecorder'
     return (lspLogRecorder <> logger, cb1)
 
+
 -- | Host a server, and run a test session on it.
 -- For setting custom timeout, set the environment variable 'LSP_TIMEOUT'
 -- * LSP_TIMEOUT=10 cabal test
@@ -760,6 +772,7 @@ runSessionWithTestConfig TestConfig{..} session =
 
     (recorder, cb1) <- wrapClientLogger =<< hlsPluginTestRecorder
     (recorderIde, cb2) <- wrapClientLogger =<< hlsHelperTestRecorder
+    testRecorder <- hlsHelperTestRecorder
     -- This plugin just installs a handler for the `initialized` notification, which then
     -- picks up the LSP environment and feeds it to our recorders
     let lspRecorderPlugin = pluginDescToIdePlugins [(defaultPluginDescriptor "LSPRecorderCallback" "Internal plugin")
@@ -780,9 +793,10 @@ runSessionWithTestConfig TestConfig{..} session =
     timeout 3 (wait server) >>= \case
         Just () -> pure ()
         Nothing -> do
-            putStrLn "Server does not exit in 3s, canceling the async task..."
+            logWith testRecorder Info (TestServerExitTimeoutSeconds 3)
             (t, _) <- duration $ cancel server
-            putStrLn $ "Finishing canceling (took " <> showDuration t <> "s)"
+            logWith testRecorder Info (TestServerCancelFinished (showDuration t))
+    logWith testRecorder Info TestRunFinished
     pure result
 
     where
diff --git a/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs b/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs
index a0d1648fb3..7daae0df51 100644
--- a/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs
+++ b/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs
@@ -90,7 +90,7 @@ docLspSemanticTokensString :: (HasCallStack) => TextDocumentIdentifier -> Sessio
 docLspSemanticTokensString doc = do
   res <- Test.getSemanticTokens doc
   textContent <- documentContents doc
-  let vfs = VirtualFile 0 0 (Rope.fromText textContent)
+  let vfs = VirtualFile 0 0 (Rope.fromText textContent) (Just LanguageKind_Haskell)
   case res ^? Language.LSP.Protocol.Types._L of
     Just tokens -> do
       either (error . show) pure $ recoverLspSemanticTokens vfs tokens
diff --git a/scripts/open-close-loop.sh b/scripts/open-close-loop.sh
new file mode 100755
index 0000000000..faf80e7d81
--- /dev/null
+++ b/scripts/open-close-loop.sh
@@ -0,0 +1,99 @@
+#!/usr/bin/env bash
+# Loop running the "open close" test until a Broken pipe is observed.
+# Writes each iteration's full output to test-logs/open-close-loop-<n>.log
+# Environment you can tweak:
+#   MAX_ITER   : maximum iterations before giving up (default: unlimited)
+#   SLEEP_SECS : seconds to sleep between iterations (default: 0)
+#   TRACE_FD   : set to 1 to enable HLS_TEST_TRACE_FD (default: 1)
+#   LOG_STDERR : set to 1 to enable verbose stderr logging (HLS_TEST_LOG_STDERR & HLS_TEST_HARNESS_STDERR) (default: 1)
+#
+# Exit codes:
+#   0 on success (broken pipe reproduced)
+#   1 on reaching MAX_ITER without reproduction
+#   2 on other setup error
+
+set -euo pipefail
+
+MAX_ITER="${MAX_ITER:-}"
+SLEEP_SECS="${SLEEP_SECS:-0}"
+TRACE_FD="${TRACE_FD:-1}"
+LOG_STDERR="${LOG_STDERR:-1}"
+
+# Allow providing a positional max iteration: ./open-close-loop.sh 50
+if [[ $# -ge 1 && -z "${MAX_ITER}" ]]; then
+  MAX_ITER="$1"
+fi
+
+mkdir -p test-logs
+
+iter=0
+start_ts=$(date -Iseconds)
+echo "[loop] Starting at ${start_ts}" >&2
+
+# Pattern string to detect (keep simple & literal for robustness)
+BROKEN_PIPE_RE='Broken pipe'
+DEBUG_DETECT="${DEBUG_DETECT:-0}"
+
+if [[ -z "${NO_BUILD_ONCE:-}" ]]; then
+  echo "[loop] Building test target ghcide-tests once upfront" >&2
+  cabal build ghcide-tests >&2
+fi
+
+# Locate the built test binary (simple heuristic similar to run_progress_test.sh)
+if [[ -z "${TEST_BIN:-}" ]]; then
+  TEST_BIN=$(find dist-newstyle -type f -name ghcide-tests -perm -111 2>/dev/null | head -n1 || true)
+fi
+
+if [[ -z "${TEST_BIN}" || ! -x "${TEST_BIN}" ]]; then
+  echo "[loop][error] Could not locate executable test binary 'ghcide-tests'. Set TEST_BIN explicitly or ensure build succeeded." >&2
+  exit 2
+fi
+echo "[loop] Using test binary: ${TEST_BIN}" >&2
+
+REBUILD_EACH="${REBUILD_EACH:-0}" # set to 1 to rebuild before every iteration
+
+while true; do
+  iter=$((iter+1))
+  ts=$(date -Iseconds)
+  log="test-logs/open-close-loop-${iter}.log"
+  echo "[loop] Iteration ${iter} starting at ${ts}, logging to ${log}" | tee -a "${log}" >&2
+  # Run the single test pattern. We don't fail the loop on non-zero exit (capture output then decide).
+  set +e
+  if [[ ${REBUILD_EACH} -eq 1 ]]; then
+    echo "[loop] Rebuilding before iteration ${iter}" | tee -a "${log}" >&2
+    cabal build ghcide-tests >>"${log}" 2>&1
+    # refresh TEST_BIN if path changed
+    TEST_BIN_NEW=$(find dist-newstyle -type f -name ghcide-tests -perm -111 2>/dev/null | head -n1 || true)
+    if [[ -n "${TEST_BIN_NEW}" ]]; then TEST_BIN="${TEST_BIN_NEW}"; fi
+  fi
+  HLS_TEST_TRACE_FD="${TRACE_FD}" \
+  HLS_TEST_LOG_STDERR="${LOG_STDERR}" \
+  HLS_TEST_HARNESS_STDERR="${LOG_STDERR}" \
+  TASTY_NUM_THREADS=1 \
+  TASTY_PATTERN="open close" \
+  "${TEST_BIN}" >"${log}" 2>&1
+  ec=$?
+  set -e
+
+  if grep -aFq -- "${BROKEN_PIPE_RE}" "${log}"; then
+    echo "[loop] Broken pipe reproduced in iteration ${iter}. Stopping." | tee -a "${log}" >&2
+    echo "[loop] --- Tail (last 60 lines) ---" >&2
+    tail -n 60 "${log}" >&2
+    exit 0
+  else
+    if [[ ${DEBUG_DETECT} -eq 1 ]]; then
+      echo "[loop][debug] No match for '${BROKEN_PIPE_RE}' in iteration ${iter}." | tee -a "${log}" >&2
+    fi
+  fi
+
+  if [[ -n "${MAX_ITER}" && ${iter} -ge ${MAX_ITER} ]]; then
+    echo "[loop] Reached MAX_ITER=${MAX_ITER} without reproducing Broken pipe." >&2
+    exit 1
+  fi
+
+  echo "[loop] Iteration ${iter} complete (exit code ${ec}). No Broken pipe yet." | tee -a "${log}" >&2
+  if [[ ${SLEEP_SECS} -gt 0 ]]; then
+    echo "[loop] Sleeping ${SLEEP_SECS}s" | tee -a "${log}" >&2
+    sleep "${SLEEP_SECS}"
+  fi
+done

From cd83664059eb1c2c3744c9faf97c2835a414a4aa Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 22 Aug 2025 06:57:23 +0800
Subject: [PATCH 02/61] Consolidate source-repository-package entries in
 cabal.project

---
 cabal.project | 16 ++--------------
 1 file changed, 2 insertions(+), 14 deletions(-)

diff --git a/cabal.project b/cabal.project
index 4abfc93bc9..c01e9d3e11 100644
--- a/cabal.project
+++ b/cabal.project
@@ -63,17 +63,5 @@ if impl(ghc >= 9.11)
 source-repository-package
   type: git
   location: https://github.com/soulomoon/lsp.git
-  commit: 6f217e8a1afcb77a926023d0ac9cbc0da7ef4d3c
-  subdir: lsp
-
-source-repository-package
-  type: git
-  location: https://github.com/soulomoon/lsp.git
-  commit: 6f217e8a1afcb77a926023d0ac9cbc0da7ef4d3c
-  subdir: lsp-types
-
-source-repository-package
-  type: git
-  location: https://github.com/soulomoon/lsp.git
-  commit: 6f217e8a1afcb77a926023d0ac9cbc0da7ef4d3c
-  subdir: lsp-test
+  tag: 6f217e8a1afcb77a926023d0ac9cbc0da7ef4d3c
+  subdir: lsp lsp-types lsp-test

From c7ad3a2f6945be2134a0dc5a2be876d6093f2c30 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 22 Aug 2025 07:24:16 +0800
Subject: [PATCH 03/61] Add flakiness testing workflow

---
 .github/workflows/flakiness.yml | 93 +++++++++++++++++++++++++++++++++
 1 file changed, 93 insertions(+)
 create mode 100644 .github/workflows/flakiness.yml

diff --git a/.github/workflows/flakiness.yml b/.github/workflows/flakiness.yml
new file mode 100644
index 0000000000..5058fba456
--- /dev/null
+++ b/.github/workflows/flakiness.yml
@@ -0,0 +1,93 @@
+name: flakiness
+
+defaults:
+  run:
+    shell: bash
+
+concurrency:
+  group: ${{ github.head_ref }}-${{ github.workflow }}
+  cancel-in-progress: true
+
+on:
+  # Run on PRs that touch relevant areas and on manual dispatch
+  pull_request:
+    branches:
+      - '**'
+    paths:
+      - 'scripts/open-close-loop.sh'
+      - 'ghcide/**'
+      - 'hls-test-utils/**'
+      - 'src/**'
+      - 'exe/**'
+      - 'plugins/**'
+      - 'cabal.project'
+  workflow_dispatch:
+    inputs:
+      max_iter:
+        description: 'Maximum iterations to attempt'
+        required: false
+        default: '100'
+      sleep_secs:
+        description: 'Seconds to sleep between iterations'
+        required: false
+        default: '0'
+
+jobs:
+  loop:
+    name: open-close loop (${{ matrix.os }})
+    runs-on: ${{ matrix.os }}
+    strategy:
+      fail-fast: false
+      matrix:
+        os:
+          - ubuntu-latest
+          - macOS-latest
+          - windows-latest
+
+    steps:
+      - uses: actions/checkout@v4
+
+      - name: Setup GHC and caching
+        uses: ./.github/actions/setup-build
+        with:
+          ghc: '9.12'
+          os: ${{ runner.os }}
+
+      - name: Show cabal and GHC versions
+        run: |
+          cabal --version
+          ghc --version
+
+      - name: Run open-close loop
+        id: run-loop
+        # Let this run for a while; build is done once inside the script
+        timeout-minutes: 45
+        env:
+          # Use workflow_dispatch inputs when present, else defaults
+          SLEEP_SECS: ${{ inputs.sleep_secs || '0' }}
+          TRACE_FD: '1'
+          LOG_STDERR: '1'
+        run: |
+          # Run with a sensible default of 100 iterations on PRs; allow override on manual runs
+          max_iter="${{ inputs.max_iter || '100' }}"
+          bash scripts/open-close-loop.sh "${max_iter}"
+          ec=$?
+          # Interpret: 0 = flake reproduced (fail the job), 1 = not reproduced within budget (pass), others = infra error
+          if [[ $ec -eq 0 ]]; then
+            echo "Broken pipe reproduced: marking job as failed"
+            exit 1
+          elif [[ $ec -eq 1 ]]; then
+            echo "No flake reproduced within MAX_ITER=${max_iter}: passing"
+            exit 0
+          else
+            echo "Loop script error (exit $ec): failing"
+            exit $ec
+          fi
+
+      # - name: Upload loop logs
+      #   if: always()
+      #   uses: actions/upload-artifact@v4
+      #   with:
+      #     name: open-close-loop-logs-${{ matrix.os }}
+      #     path: test-logs/
+      #     if-no-files-found: ignore

From 4d56b39430c2d45c9edbd80305886147edc0aac9 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 22 Aug 2025 07:53:57 +0800
Subject: [PATCH 04/61] Update flakiness workflow and fix exit codes in
 open-close loop script

---
 .github/workflows/flakiness.yml | 2 +-
 cabal.project                   | 8 ++++----
 scripts/open-close-loop.sh      | 4 ++--
 3 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/.github/workflows/flakiness.yml b/.github/workflows/flakiness.yml
index 5058fba456..ad3f053d24 100644
--- a/.github/workflows/flakiness.yml
+++ b/.github/workflows/flakiness.yml
@@ -42,7 +42,7 @@ jobs:
         os:
           - ubuntu-latest
           - macOS-latest
-          - windows-latest
+          # - windows-latest
 
     steps:
       - uses: actions/checkout@v4
diff --git a/cabal.project b/cabal.project
index c01e9d3e11..dc51fa5271 100644
--- a/cabal.project
+++ b/cabal.project
@@ -5,9 +5,9 @@ packages:
          ./ghcide
          ./hls-plugin-api
          ./hls-test-utils
---         /Volumes/src/lsp/lsp
---         /Volumes/src/lsp/lsp-types
---         /Volumes/src/lsp/lsp-test
+        -- /Volumes/src/lsp/lsp
+        -- /Volumes/src/lsp/lsp-types
+        -- /Volumes/src/lsp/lsp-test
 
 
 index-state: 2025-08-08T12:31:54Z
@@ -63,5 +63,5 @@ if impl(ghc >= 9.11)
 source-repository-package
   type: git
   location: https://github.com/soulomoon/lsp.git
-  tag: 6f217e8a1afcb77a926023d0ac9cbc0da7ef4d3c
+  tag: 839c458771455f5792f0fa4ead706f3eaf785d13
   subdir: lsp lsp-types lsp-test
diff --git a/scripts/open-close-loop.sh b/scripts/open-close-loop.sh
index faf80e7d81..b84fbd890c 100755
--- a/scripts/open-close-loop.sh
+++ b/scripts/open-close-loop.sh
@@ -79,7 +79,7 @@ while true; do
     echo "[loop] Broken pipe reproduced in iteration ${iter}. Stopping." | tee -a "${log}" >&2
     echo "[loop] --- Tail (last 60 lines) ---" >&2
     tail -n 60 "${log}" >&2
-    exit 0
+    exit 1
   else
     if [[ ${DEBUG_DETECT} -eq 1 ]]; then
       echo "[loop][debug] No match for '${BROKEN_PIPE_RE}' in iteration ${iter}." | tee -a "${log}" >&2
@@ -88,7 +88,7 @@ while true; do
 
   if [[ -n "${MAX_ITER}" && ${iter} -ge ${MAX_ITER} ]]; then
     echo "[loop] Reached MAX_ITER=${MAX_ITER} without reproducing Broken pipe." >&2
-    exit 1
+    exit 0
   fi
 
   echo "[loop] Iteration ${iter} complete (exit code ${ec}). No Broken pipe yet." | tee -a "${log}" >&2

From 9272de3794daa4821cfd135dad4ca235a38977b1 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 22 Aug 2025 08:01:31 +0800
Subject: [PATCH 05/61] Update lsp repository tag in cabal.project

---
 cabal.project | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/cabal.project b/cabal.project
index dc51fa5271..d155b30ed6 100644
--- a/cabal.project
+++ b/cabal.project
@@ -63,5 +63,5 @@ if impl(ghc >= 9.11)
 source-repository-package
   type: git
   location: https://github.com/soulomoon/lsp.git
-  tag: 839c458771455f5792f0fa4ead706f3eaf785d13
+  tag: 4b57c8af1b5544c88bb040cf07132e611c5a0014
   subdir: lsp lsp-types lsp-test

From e1a794709b780f500c1ebbd74d7cc49587a42931 Mon Sep 17 00:00:00 2001
From: patrick <patrickwalesss@gmail.com>
Date: Fri, 22 Aug 2025 08:35:22 +0800
Subject: [PATCH 06/61] Update flakiness.yml

---
 .github/workflows/flakiness.yml | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/.github/workflows/flakiness.yml b/.github/workflows/flakiness.yml
index ad3f053d24..929824ee7b 100644
--- a/.github/workflows/flakiness.yml
+++ b/.github/workflows/flakiness.yml
@@ -72,11 +72,11 @@ jobs:
           max_iter="${{ inputs.max_iter || '100' }}"
           bash scripts/open-close-loop.sh "${max_iter}"
           ec=$?
-          # Interpret: 0 = flake reproduced (fail the job), 1 = not reproduced within budget (pass), others = infra error
-          if [[ $ec -eq 0 ]]; then
+          # Interpret: 1 = flake reproduced (fail the job), 1 = not reproduced within budget (pass), others = infra error
+          if [[ $ec -eq 1 ]]; then
             echo "Broken pipe reproduced: marking job as failed"
             exit 1
-          elif [[ $ec -eq 1 ]]; then
+          elif [[ $ec -eq 0 ]]; then
             echo "No flake reproduced within MAX_ITER=${max_iter}: passing"
             exit 0
           else

From ed85d9be94b84b00d1424e75a268aa89c681d11a Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 22 Aug 2025 17:56:39 +0800
Subject: [PATCH 07/61] Add InitParameters data type and enhance shutdown
 handling in LanguageServer

---
 .../src/Development/IDE/LSP/LanguageServer.hs | 122 ++++++++++++------
 1 file changed, 84 insertions(+), 38 deletions(-)

diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
index d08f32e53a..88b948eab3 100644
--- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs
+++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
@@ -12,6 +12,7 @@ module Development.IDE.LSP.LanguageServer
     , ThreadQueue
     , runWithWorkerThreads
     , Setup (..)
+    , InitParameters (..)
     ) where
 
 import           Control.Concurrent.STM
@@ -41,6 +42,7 @@ import           Control.Concurrent.Extra              (newBarrier,
 import           Control.Monad.IO.Unlift               (MonadUnliftIO)
 import           Control.Monad.Trans.Cont              (evalContT)
 import           Development.IDE.Core.IdeConfiguration
+import           Development.IDE.Core.Service          (shutdown)
 import           Development.IDE.Core.Shake            hiding (Log)
 import           Development.IDE.Core.Tracing
 import           Development.IDE.Core.WorkerThread     (withWorkerQueue)
@@ -51,6 +53,7 @@ import           Ide.Logger
 import           Language.LSP.Server                   (LanguageContextEnv,
                                                         LspServerLog,
                                                         type (<~>))
+import           System.Timeout                        (timeout)
 data Log
   = LogRegisteringIdeConfig !IdeConfiguration
   | LogReactorThreadException !SomeException
@@ -60,10 +63,13 @@ data Log
   | LogSession Session.Log
   | LogLspServer LspServerLog
   | LogServerShutdownMessage
+  | LogShutDownTimeout Int
   deriving Show
 
 instance Pretty Log where
   pretty = \case
+    LogShutDownTimeout seconds ->
+        "Shutdown timeout, the server will exit now after waiting for" <+> pretty seconds <+> "milliseconds"
     LogRegisteringIdeConfig ideConfig ->
       -- This log is also used to identify if HLS starts successfully in vscode-haskell,
       -- don't forget to update the corresponding test in vscode-haskell if the text in
@@ -85,6 +91,30 @@ instance Pretty Log where
     LogLspServer msg -> pretty msg
     LogServerShutdownMessage -> "Received shutdown message"
 
+-- | Parameters for initializing the LSP language server.
+-- This record encapsulates all the configuration and callback functions
+-- needed to set up and run the language server initialization process.
+data InitParameters config = InitParameters
+  { initRecorder :: Recorder (WithPriority Log)
+    -- ^ Logger for recording server events and diagnostics
+  , initDefaultRoot :: FilePath
+    -- ^ Default root directory for the workspace, see Note [Root Directory]
+  , initGetHieDbLoc :: FilePath -> IO FilePath
+    -- ^ Function to determine the HIE database location for a given root path
+  , initGetIdeState :: LSP.LanguageContextEnv config -> FilePath -> WithHieDb -> ThreadQueue -> IO IdeState
+    -- ^ Function to create and initialize the IDE state with the given environment
+  , initLifetime :: (MVar (), IO ())
+    -- ^ Lifetime control: MVar to signal shutdown and confirmation action
+  , initForceShutdown :: IO ()
+    -- ^ Action to forcefully exit the server when exception occurs
+  , initClearReqId :: SomeLspId -> IO ()
+    -- ^ Function to clear/cancel a request by its ID
+  , initWaitForCancel :: SomeLspId -> IO ()
+    -- ^ Function to wait for a request cancellation by its ID
+  , initClientMsgChan :: Chan ReactorMessage
+    -- ^ Channel for communicating with the reactor message loop
+  }
+
 data Setup config m a
   = MkSetup
   { doInitialize :: LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either (TResponseError Method_Initialize) (LSP.LanguageContextEnv config, a))
@@ -159,9 +189,16 @@ setupLSP recorder defaultRoot getHieDbLoc userHandlers getIdeState clientMsgVar
   -- The loop will be stopped and resources freed when it's full
   reactorLifetime <- newEmptyMVar
   reactorLifetimeConfirmBarrier <- newBarrier
-  let stopReactorLoop = void $ tryPutMVar reactorLifetime ()
-  let stopReactorLoopConfirm = signalBarrier reactorLifetimeConfirmBarrier ()
-  let untilReactorLifetimeConfirm = waitBarrier reactorLifetimeConfirmBarrier
+  let stopReactorLoopConfirm =
+        signalBarrier reactorLifetimeConfirmBarrier ()
+  let stopReactorLoop = do
+        _ <- tryPutMVar reactorLifetime ()
+        let timeOutSeconds = 3 * 1_000_000
+        timeout timeOutSeconds (waitBarrier reactorLifetimeConfirmBarrier) >>= \case
+            Just () -> pure ()
+            -- If we don't get confirmation within 3 seconds, we log a warning and shutdown anyway.
+            -- This is to avoid deadlocks in case the client does not respond to shutdown requests.
+            Nothing -> logWith recorder Warning $ LogShutDownTimeout timeOutSeconds
 
   -- Forcefully exit
   let exit = void $ tryPutMVar clientMsgVar ()
@@ -190,48 +227,61 @@ setupLSP recorder defaultRoot getHieDbLoc userHandlers getIdeState clientMsgVar
   let staticHandlers = mconcat
         [ userHandlers
         , cancelHandler cancelRequest
-        , shutdownHandler recorder (stopReactorLoop, untilReactorLifetimeConfirm)
+        , shutdownHandler recorder stopReactorLoop
         ]
         -- Cancel requests are special since they need to be handled
         -- out of order to be useful. Existing handlers are run afterwards.
 
-  let doInitialize = handleInit recorder defaultRoot getHieDbLoc getIdeState (reactorLifetime, stopReactorLoopConfirm) exit clearReqId waitForCancel clientMsgChan
+  let initParams = InitParameters
+        { initRecorder = recorder
+        , initDefaultRoot = defaultRoot
+        , initGetHieDbLoc = getHieDbLoc
+        , initGetIdeState = getIdeState
+        , initLifetime = (reactorLifetime, stopReactorLoopConfirm)
+        , initForceShutdown = exit
+        , initClearReqId = clearReqId
+        , initWaitForCancel = waitForCancel
+        , initClientMsgChan = clientMsgChan
+        }
+
+  let doInitialize = handleInit initParams
 
   let interpretHandler (env,  st) = LSP.Iso (LSP.runLspT env . flip (runReaderT . unServerM) (clientMsgChan,st)) liftIO
 
-  let onExit = [stopReactorLoop, untilReactorLifetimeConfirm, exit]
+  let onExit = [stopReactorLoop, exit]
 
   pure MkSetup {doInitialize, staticHandlers, interpretHandler, onExit}
 
 
 handleInit
-    :: Recorder (WithPriority Log)
-    -> FilePath -- ^ root directory, see Note [Root Directory]
-    -> (FilePath -> IO FilePath)
-    -> (LSP.LanguageContextEnv config -> FilePath -> WithHieDb -> ThreadQueue -> IO IdeState)
-    -> (MVar (), IO ())
-    -> IO ()
-    -> (SomeLspId -> IO ())
-    -> (SomeLspId -> IO ())
-    -> Chan ReactorMessage
+    :: InitParameters config
     -> LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState))
-handleInit recorder defaultRoot getHieDbLoc getIdeState (lifetime, lifetimeConfirm) exitClientMsg clearReqId waitForCancel clientMsgChan env (TRequestMessage _ _ m params) = otTracedHandler "Initialize" (show m) $ \sp -> do
+handleInit initParams env (TRequestMessage _ _ m params) = otTracedHandler "Initialize" (show m) $ \sp -> do
     traceWithSpan sp params
     -- only shift if lsp root is different from the rootDir
     -- see Note [Root Directory]
+    let recorder = initRecorder initParams
+        defaultRoot = initDefaultRoot initParams
+        (lifetime, lifetimeConfirm) = initLifetime initParams
     root <- case LSP.resRootPath env of
         Just lspRoot | lspRoot /= defaultRoot -> setCurrentDirectory lspRoot >> return lspRoot
         _ -> pure defaultRoot
-    dbLoc <- getHieDbLoc root
+    dbLoc <- initGetHieDbLoc initParams root
     let initConfig = parseConfiguration params
     logWith recorder Info $ LogRegisteringIdeConfig initConfig
-    dbMVar <- newEmptyMVar
-
-
-    let handleServerException (Left e) = do
-            logWith recorder Error $ LogReactorThreadException e
-            exitClientMsg
-        handleServerException (Right _) = lifetimeConfirm
+    ideMVar <- newEmptyMVar
+
+    let handleServerExceptionOrShutDown me = do
+            -- try to shutdown shake
+            tryReadMVar ideMVar >>= \case
+                Nothing -> return ()
+                Just ide -> shutdown ide
+            lifetimeConfirm
+            case me of
+                Left e -> do
+                    logWith recorder Error $ LogReactorThreadException e
+                    initForceShutdown initParams
+                _ -> return ()
 
         exceptionInHandler e = do
             logWith recorder Error $ LogReactorMessageActionException e
@@ -239,13 +289,13 @@ handleInit recorder defaultRoot getHieDbLoc getIdeState (lifetime, lifetimeConfi
         checkCancelled :: forall m . LspId m -> IO () -> (TResponseError m -> IO ()) -> IO ()
         checkCancelled _id act k =
             let sid = SomeLspId _id
-            in flip finally (clearReqId sid) $
+            in flip finally (initClearReqId initParams sid) $
                 catch (do
                     -- We could optimize this by first checking if the id
                     -- is in the cancelled set. However, this is unlikely to be a
                     -- bottleneck and the additional check might hide
                     -- issues with async exceptions that need to be fixed.
-                    cancelOrRes <- race (waitForCancel sid) act
+                    cancelOrRes <- race (initWaitForCancel initParams sid) act
                     case cancelOrRes of
                         Left () -> do
                             logWith recorder Debug $ LogCancelledRequest sid
@@ -254,11 +304,12 @@ handleInit recorder defaultRoot getHieDbLoc getIdeState (lifetime, lifetimeConfi
                 ) $ \(e :: SomeException) -> do
                     exceptionInHandler e
                     k $ TResponseError (InR ErrorCodes_InternalError) (T.pack $ show e) Nothing
-    _ <- flip forkFinally handleServerException $ do
+    _ <- flip forkFinally handleServerExceptionOrShutDown $ do
         untilMVar lifetime $ runWithWorkerThreads (cmapWithPrio LogSession recorder) dbLoc $ \withHieDb' threadQueue' -> do
-            putMVar dbMVar (WithHieDbShield withHieDb',threadQueue')
+            ide <- initGetIdeState initParams env root withHieDb' threadQueue'
+            putMVar ideMVar ide
             forever $ do
-                msg <- readChan clientMsgChan
+                msg <- readChan $ initClientMsgChan initParams
                 -- We dispatch notifications synchronously and requests asynchronously
                 -- This is to ensure that all file edits and config changes are applied before a request is handled
                 case msg of
@@ -266,8 +317,7 @@ handleInit recorder defaultRoot getHieDbLoc getIdeState (lifetime, lifetimeConfi
                     ReactorRequest _id act k -> void $ async $ checkCancelled _id act k
         logWith recorder Info LogReactorThreadStopped
 
-    (WithHieDbShield withHieDb, threadQueue) <- takeMVar dbMVar
-    ide <- getIdeState env root withHieDb threadQueue
+    ide <- readMVar ideMVar
     registerIdeConfiguration (shakeExtras ide) initConfig
     pure $ Right (env,ide)
 
@@ -297,15 +347,11 @@ cancelHandler cancelRequest = LSP.notificationHandler SMethod_CancelRequest $ \T
         toLspId (InL x) = IdInt x
         toLspId (InR y) = IdString y
 
-shutdownHandler :: Recorder (WithPriority Log) -> (IO (), IO ()) -> LSP.Handlers (ServerM c)
-shutdownHandler recorder (stopReactor, confirmVar) = LSP.requestHandler SMethod_Shutdown $ \_ resp -> do
-    (_, ide) <- ask
+shutdownHandler :: Recorder (WithPriority Log) -> IO () -> LSP.Handlers (ServerM c)
+shutdownHandler recorder stopReactor = LSP.requestHandler SMethod_Shutdown $ \_ resp -> do
     liftIO $ logWith recorder Debug LogServerShutdownMessage
-    -- stop the reactor to free up the hiedb connection
+    -- stop the reactor to free up the hiedb connection and shut down shake
     liftIO stopReactor
-    -- flush out the Shake session to record a Shake profile if applicable
-    liftIO $ shakeShut ide
-    liftIO confirmVar
     resp $ Right Null
 
 modifyOptions :: LSP.Options -> LSP.Options

From 100b39e10048bf01dc10b1246741e9f7287cd519 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 22 Aug 2025 18:53:42 +0800
Subject: [PATCH 08/61] Rename InitParameters to InitializationContext and
 update related fields for clarity

---
 .../src/Development/IDE/LSP/LanguageServer.hs | 66 +++++++++----------
 1 file changed, 33 insertions(+), 33 deletions(-)

diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
index 88b948eab3..4b4bae36f6 100644
--- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs
+++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
@@ -12,7 +12,7 @@ module Development.IDE.LSP.LanguageServer
     , ThreadQueue
     , runWithWorkerThreads
     , Setup (..)
-    , InitParameters (..)
+    , InitializationContext (..)
     ) where
 
 import           Control.Concurrent.STM
@@ -91,27 +91,27 @@ instance Pretty Log where
     LogLspServer msg -> pretty msg
     LogServerShutdownMessage -> "Received shutdown message"
 
--- | Parameters for initializing the LSP language server.
+-- | Context for initializing the LSP language server.
 -- This record encapsulates all the configuration and callback functions
 -- needed to set up and run the language server initialization process.
-data InitParameters config = InitParameters
-  { initRecorder :: Recorder (WithPriority Log)
+data InitializationContext config = InitializationContext
+  { ctxRecorder :: Recorder (WithPriority Log)
     -- ^ Logger for recording server events and diagnostics
-  , initDefaultRoot :: FilePath
+  , ctxDefaultRoot :: FilePath
     -- ^ Default root directory for the workspace, see Note [Root Directory]
-  , initGetHieDbLoc :: FilePath -> IO FilePath
+  , ctxGetHieDbLoc :: FilePath -> IO FilePath
     -- ^ Function to determine the HIE database location for a given root path
-  , initGetIdeState :: LSP.LanguageContextEnv config -> FilePath -> WithHieDb -> ThreadQueue -> IO IdeState
+  , ctxGetIdeState :: LSP.LanguageContextEnv config -> FilePath -> WithHieDb -> ThreadQueue -> IO IdeState
     -- ^ Function to create and initialize the IDE state with the given environment
-  , initLifetime :: (MVar (), IO ())
+  , ctxLifetime :: (MVar (), IO ())
     -- ^ Lifetime control: MVar to signal shutdown and confirmation action
-  , initForceShutdown :: IO ()
+  , ctxForceShutdown :: IO ()
     -- ^ Action to forcefully exit the server when exception occurs
-  , initClearReqId :: SomeLspId -> IO ()
+  , ctxClearReqId :: SomeLspId -> IO ()
     -- ^ Function to clear/cancel a request by its ID
-  , initWaitForCancel :: SomeLspId -> IO ()
+  , ctxWaitForCancel :: SomeLspId -> IO ()
     -- ^ Function to wait for a request cancellation by its ID
-  , initClientMsgChan :: Chan ReactorMessage
+  , ctxClientMsgChan :: Chan ReactorMessage
     -- ^ Channel for communicating with the reactor message loop
   }
 
@@ -169,7 +169,7 @@ runLanguageServer recorder options inH outH defaultConfig parseConfig onConfigCh
             outH
             serverDefinition
 
-    void $ runServer `finally` sequence_ onExit
+    untilMVar clientMsgVar $ runServer `finally` sequence_ onExit
 
 setupLSP ::
      forall config.
@@ -232,16 +232,16 @@ setupLSP recorder defaultRoot getHieDbLoc userHandlers getIdeState clientMsgVar
         -- Cancel requests are special since they need to be handled
         -- out of order to be useful. Existing handlers are run afterwards.
 
-  let initParams = InitParameters
-        { initRecorder = recorder
-        , initDefaultRoot = defaultRoot
-        , initGetHieDbLoc = getHieDbLoc
-        , initGetIdeState = getIdeState
-        , initLifetime = (reactorLifetime, stopReactorLoopConfirm)
-        , initForceShutdown = exit
-        , initClearReqId = clearReqId
-        , initWaitForCancel = waitForCancel
-        , initClientMsgChan = clientMsgChan
+  let initParams = InitializationContext
+        { ctxRecorder = recorder
+        , ctxDefaultRoot = defaultRoot
+        , ctxGetHieDbLoc = getHieDbLoc
+        , ctxGetIdeState = getIdeState
+        , ctxLifetime = (reactorLifetime, stopReactorLoopConfirm)
+        , ctxForceShutdown = exit
+        , ctxClearReqId = clearReqId
+        , ctxWaitForCancel = waitForCancel
+        , ctxClientMsgChan = clientMsgChan
         }
 
   let doInitialize = handleInit initParams
@@ -254,19 +254,19 @@ setupLSP recorder defaultRoot getHieDbLoc userHandlers getIdeState clientMsgVar
 
 
 handleInit
-    :: InitParameters config
+    :: InitializationContext config
     -> LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState))
 handleInit initParams env (TRequestMessage _ _ m params) = otTracedHandler "Initialize" (show m) $ \sp -> do
     traceWithSpan sp params
     -- only shift if lsp root is different from the rootDir
     -- see Note [Root Directory]
-    let recorder = initRecorder initParams
-        defaultRoot = initDefaultRoot initParams
-        (lifetime, lifetimeConfirm) = initLifetime initParams
+    let recorder = ctxRecorder initParams
+        defaultRoot = ctxDefaultRoot initParams
+        (lifetime, lifetimeConfirm) = ctxLifetime initParams
     root <- case LSP.resRootPath env of
         Just lspRoot | lspRoot /= defaultRoot -> setCurrentDirectory lspRoot >> return lspRoot
         _ -> pure defaultRoot
-    dbLoc <- initGetHieDbLoc initParams root
+    dbLoc <- ctxGetHieDbLoc initParams root
     let initConfig = parseConfiguration params
     logWith recorder Info $ LogRegisteringIdeConfig initConfig
     ideMVar <- newEmptyMVar
@@ -280,7 +280,7 @@ handleInit initParams env (TRequestMessage _ _ m params) = otTracedHandler "Init
             case me of
                 Left e -> do
                     logWith recorder Error $ LogReactorThreadException e
-                    initForceShutdown initParams
+                    ctxForceShutdown initParams
                 _ -> return ()
 
         exceptionInHandler e = do
@@ -289,13 +289,13 @@ handleInit initParams env (TRequestMessage _ _ m params) = otTracedHandler "Init
         checkCancelled :: forall m . LspId m -> IO () -> (TResponseError m -> IO ()) -> IO ()
         checkCancelled _id act k =
             let sid = SomeLspId _id
-            in flip finally (initClearReqId initParams sid) $
+            in flip finally (ctxClearReqId initParams sid) $
                 catch (do
                     -- We could optimize this by first checking if the id
                     -- is in the cancelled set. However, this is unlikely to be a
                     -- bottleneck and the additional check might hide
                     -- issues with async exceptions that need to be fixed.
-                    cancelOrRes <- race (initWaitForCancel initParams sid) act
+                    cancelOrRes <- race (ctxWaitForCancel initParams sid) act
                     case cancelOrRes of
                         Left () -> do
                             logWith recorder Debug $ LogCancelledRequest sid
@@ -306,10 +306,10 @@ handleInit initParams env (TRequestMessage _ _ m params) = otTracedHandler "Init
                     k $ TResponseError (InR ErrorCodes_InternalError) (T.pack $ show e) Nothing
     _ <- flip forkFinally handleServerExceptionOrShutDown $ do
         untilMVar lifetime $ runWithWorkerThreads (cmapWithPrio LogSession recorder) dbLoc $ \withHieDb' threadQueue' -> do
-            ide <- initGetIdeState initParams env root withHieDb' threadQueue'
+            ide <- ctxGetIdeState initParams env root withHieDb' threadQueue'
             putMVar ideMVar ide
             forever $ do
-                msg <- readChan $ initClientMsgChan initParams
+                msg <- readChan $ ctxClientMsgChan initParams
                 -- We dispatch notifications synchronously and requests asynchronously
                 -- This is to ensure that all file edits and config changes are applied before a request is handled
                 case msg of

From 5835ad75813b3a987e7fed318655786129b8820c Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 22 Aug 2025 18:55:58 +0800
Subject: [PATCH 09/61] Increase default maximum iterations to 1000 in
 flakiness workflow

---
 .github/workflows/flakiness.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/flakiness.yml b/.github/workflows/flakiness.yml
index 929824ee7b..6e944b5bf5 100644
--- a/.github/workflows/flakiness.yml
+++ b/.github/workflows/flakiness.yml
@@ -26,7 +26,7 @@ on:
       max_iter:
         description: 'Maximum iterations to attempt'
         required: false
-        default: '100'
+        default: '1000'
       sleep_secs:
         description: 'Seconds to sleep between iterations'
         required: false

From d26ed7fe3fa143adf5e3aefb34358a353d565de1 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 22 Aug 2025 22:50:28 +0800
Subject: [PATCH 10/61] Update cabal.project and LanguageServer for improved
 logging and update to use new lsp revision

---
 .github/workflows/flakiness.yml               | 12 +++++-----
 cabal.project                                 |  5 +----
 .../src/Development/IDE/LSP/LanguageServer.hs | 12 +++++++++-
 scripts/open-close-loop.sh                    | 22 ++++++++++++-------
 4 files changed, 32 insertions(+), 19 deletions(-)

diff --git a/.github/workflows/flakiness.yml b/.github/workflows/flakiness.yml
index 6e944b5bf5..5b8ab32c1f 100644
--- a/.github/workflows/flakiness.yml
+++ b/.github/workflows/flakiness.yml
@@ -34,7 +34,7 @@ on:
 
 jobs:
   loop:
-    name: open-close loop (${{ matrix.os }})
+    name: Flakiness Test (broken pipe and test failures)
     runs-on: ${{ matrix.os }}
     strategy:
       fail-fast: false
@@ -72,12 +72,12 @@ jobs:
           max_iter="${{ inputs.max_iter || '100' }}"
           bash scripts/open-close-loop.sh "${max_iter}"
           ec=$?
-          # Interpret: 1 = flake reproduced (fail the job), 1 = not reproduced within budget (pass), others = infra error
-          if [[ $ec -eq 1 ]]; then
-            echo "Broken pipe reproduced: marking job as failed"
+          # Interpret: 0 = issue reproduced (fail the job), 1 = not reproduced within budget (pass), others = infra error
+          if [[ $ec -eq 0 ]]; then
+            echo "Issue reproduced (broken pipe or test failure): marking job as failed"
             exit 1
-          elif [[ $ec -eq 0 ]]; then
-            echo "No flake reproduced within MAX_ITER=${max_iter}: passing"
+          elif [[ $ec -eq 1 ]]; then
+            echo "No issues reproduced within MAX_ITER=${max_iter}: passing"
             exit 0
           else
             echo "Loop script error (exit $ec): failing"
diff --git a/cabal.project b/cabal.project
index d155b30ed6..0d033f7ff4 100644
--- a/cabal.project
+++ b/cabal.project
@@ -5,9 +5,6 @@ packages:
          ./ghcide
          ./hls-plugin-api
          ./hls-test-utils
-        -- /Volumes/src/lsp/lsp
-        -- /Volumes/src/lsp/lsp-types
-        -- /Volumes/src/lsp/lsp-test
 
 
 index-state: 2025-08-08T12:31:54Z
@@ -63,5 +60,5 @@ if impl(ghc >= 9.11)
 source-repository-package
   type: git
   location: https://github.com/soulomoon/lsp.git
-  tag: 4b57c8af1b5544c88bb040cf07132e611c5a0014
+  tag: 47b70011cae725233f0c5ebdf7141d5de0b3066e
   subdir: lsp lsp-types lsp-test
diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
index 4b4bae36f6..cd9db5b03f 100644
--- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs
+++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
@@ -13,6 +13,7 @@ module Development.IDE.LSP.LanguageServer
     , runWithWorkerThreads
     , Setup (..)
     , InitializationContext (..)
+    , untilMVar'
     ) where
 
 import           Control.Concurrent.STM
@@ -64,10 +65,15 @@ data Log
   | LogLspServer LspServerLog
   | LogServerShutdownMessage
   | LogShutDownTimeout Int
+  | LogServerExitWith (Either () Int)
   deriving Show
 
 instance Pretty Log where
   pretty = \case
+    LogServerExitWith (Right code) ->
+      "Server exited with code" <+> pretty code
+    LogServerExitWith (Left _) ->
+      "Server forcefully exited due to exception in reactor thread"
     LogShutDownTimeout seconds ->
         "Shutdown timeout, the server will exit now after waiting for" <+> pretty seconds <+> "milliseconds"
     LogRegisteringIdeConfig ideConfig ->
@@ -169,7 +175,8 @@ runLanguageServer recorder options inH outH defaultConfig parseConfig onConfigCh
             outH
             serverDefinition
 
-    untilMVar clientMsgVar $ runServer `finally` sequence_ onExit
+    untilMVar' clientMsgVar runServer `finally` sequence_ onExit
+        >>= logWith recorder Info . LogServerExitWith
 
 setupLSP ::
      forall config.
@@ -340,6 +347,9 @@ runWithWorkerThreads recorder dbLoc f = evalContT $ do
 untilMVar :: MonadUnliftIO m => MVar () -> m a -> m ()
 untilMVar mvar io = race_ (readMVar mvar) io
 
+untilMVar' :: MonadUnliftIO m => MVar a -> m b -> m (Either a b)
+untilMVar' mvar io = race (readMVar mvar) io
+
 cancelHandler :: (SomeLspId -> IO ()) -> LSP.Handlers (ServerM c)
 cancelHandler cancelRequest = LSP.notificationHandler SMethod_CancelRequest $ \TNotificationMessage{_params=CancelParams{_id}} ->
   liftIO $ cancelRequest (SomeLspId (toLspId _id))
diff --git a/scripts/open-close-loop.sh b/scripts/open-close-loop.sh
index b84fbd890c..b305f6922c 100755
--- a/scripts/open-close-loop.sh
+++ b/scripts/open-close-loop.sh
@@ -1,5 +1,5 @@
 #!/usr/bin/env bash
-# Loop running the "open close" test until a Broken pipe is observed.
+# Loop running the "open close" test until a Broken pipe or test failure is observed.
 # Writes each iteration's full output to test-logs/open-close-loop-<n>.log
 # Environment you can tweak:
 #   MAX_ITER   : maximum iterations before giving up (default: unlimited)
@@ -8,7 +8,7 @@
 #   LOG_STDERR : set to 1 to enable verbose stderr logging (HLS_TEST_LOG_STDERR & HLS_TEST_HARNESS_STDERR) (default: 1)
 #
 # Exit codes:
-#   0 on success (broken pipe reproduced)
+#   0 on success (broken pipe or test failure reproduced)
 #   1 on reaching MAX_ITER without reproduction
 #   2 on other setup error
 
@@ -30,8 +30,9 @@ iter=0
 start_ts=$(date -Iseconds)
 echo "[loop] Starting at ${start_ts}" >&2
 
-# Pattern string to detect (keep simple & literal for robustness)
+# Pattern strings to detect issues (keep simple & literal for robustness)
 BROKEN_PIPE_RE='Broken pipe'
+TEST_FAILED_RE='tests failed'
 DEBUG_DETECT="${DEBUG_DETECT:-0}"
 
 if [[ -z "${NO_BUILD_ONCE:-}" ]]; then
@@ -79,19 +80,24 @@ while true; do
     echo "[loop] Broken pipe reproduced in iteration ${iter}. Stopping." | tee -a "${log}" >&2
     echo "[loop] --- Tail (last 60 lines) ---" >&2
     tail -n 60 "${log}" >&2
-    exit 1
+    exit 0
+  elif grep -aFq -- "${TEST_FAILED_RE}" "${log}"; then
+    echo "[loop] Test failure detected in iteration ${iter}. Stopping." | tee -a "${log}" >&2
+    echo "[loop] --- Tail (last 60 lines) ---" >&2
+    tail -n 60 "${log}" >&2
+    exit 0
   else
     if [[ ${DEBUG_DETECT} -eq 1 ]]; then
-      echo "[loop][debug] No match for '${BROKEN_PIPE_RE}' in iteration ${iter}." | tee -a "${log}" >&2
+      echo "[loop][debug] No match for '${BROKEN_PIPE_RE}' or '${TEST_FAILED_RE}' in iteration ${iter}." | tee -a "${log}" >&2
     fi
   fi
 
   if [[ -n "${MAX_ITER}" && ${iter} -ge ${MAX_ITER} ]]; then
-    echo "[loop] Reached MAX_ITER=${MAX_ITER} without reproducing Broken pipe." >&2
-    exit 0
+    echo "[loop] Reached MAX_ITER=${MAX_ITER} without reproducing issues." >&2
+    exit 1
   fi
 
-  echo "[loop] Iteration ${iter} complete (exit code ${ec}). No Broken pipe yet." | tee -a "${log}" >&2
+  echo "[loop] Iteration ${iter} complete (exit code ${ec}). No issues detected yet." | tee -a "${log}" >&2
   if [[ ${SLEEP_SECS} -gt 0 ]]; then
     echo "[loop] Sleeping ${SLEEP_SECS}s" | tee -a "${log}" >&2
     sleep "${SLEEP_SECS}"

From 1f9cb0265492a8547b4239ea9575c70c2752b70e Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 22 Aug 2025 22:57:13 +0800
Subject: [PATCH 11/61] Update lsp repository tag to latest commit

---
 cabal.project | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/cabal.project b/cabal.project
index 0d033f7ff4..dc124e29bb 100644
--- a/cabal.project
+++ b/cabal.project
@@ -60,5 +60,5 @@ if impl(ghc >= 9.11)
 source-repository-package
   type: git
   location: https://github.com/soulomoon/lsp.git
-  tag: 47b70011cae725233f0c5ebdf7141d5de0b3066e
+  tag: f015902f9900065ad4960bae72e446983d5ff03d
   subdir: lsp lsp-types lsp-test

From c72d2e74534a74c4c28cae5d9947f31e39bb2b78 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 22 Aug 2025 23:02:27 +0800
Subject: [PATCH 12/61] Improve log message for server exit and simplify test
 failure detection pattern

---
 ghcide/src/Development/IDE/LSP/LanguageServer.hs | 4 +++-
 scripts/open-close-loop.sh                       | 2 +-
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
index cd9db5b03f..cd4ea346b2 100644
--- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs
+++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
@@ -70,8 +70,10 @@ data Log
 
 instance Pretty Log where
   pretty = \case
+    LogServerExitWith (Right 0) ->
+      "Server exited with succefully"
     LogServerExitWith (Right code) ->
-      "Server exited with code" <+> pretty code
+      "Server exited with failure code" <+> pretty code
     LogServerExitWith (Left _) ->
       "Server forcefully exited due to exception in reactor thread"
     LogShutDownTimeout seconds ->
diff --git a/scripts/open-close-loop.sh b/scripts/open-close-loop.sh
index b305f6922c..36b4bfca48 100755
--- a/scripts/open-close-loop.sh
+++ b/scripts/open-close-loop.sh
@@ -32,7 +32,7 @@ echo "[loop] Starting at ${start_ts}" >&2
 
 # Pattern strings to detect issues (keep simple & literal for robustness)
 BROKEN_PIPE_RE='Broken pipe'
-TEST_FAILED_RE='tests failed'
+TEST_FAILED_RE='fail'
 DEBUG_DETECT="${DEBUG_DETECT:-0}"
 
 if [[ -z "${NO_BUILD_ONCE:-}" ]]; then

From 569d7666d020c446fb614bdee500b8fa5664b76c Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 22 Aug 2025 23:27:21 +0800
Subject: [PATCH 13/61] Fix flakiness test

---
 .github/workflows/flakiness.yml | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/.github/workflows/flakiness.yml b/.github/workflows/flakiness.yml
index 5b8ab32c1f..26ce963bc4 100644
--- a/.github/workflows/flakiness.yml
+++ b/.github/workflows/flakiness.yml
@@ -68,17 +68,17 @@ jobs:
           TRACE_FD: '1'
           LOG_STDERR: '1'
         run: |
-          # Run with a sensible default of 100 iterations on PRs; allow override on manual runs
-          max_iter="${{ inputs.max_iter || '100' }}"
+          # Run with a sensible default of 1000 iterations on PRs;
+          max_iter="${{ inputs.max_iter }}"
           bash scripts/open-close-loop.sh "${max_iter}"
           ec=$?
-          # Interpret: 0 = issue reproduced (fail the job), 1 = not reproduced within budget (pass), others = infra error
+          # Interpret: 1 = issue reproduced (fail the job), 1 = not reproduced within budget (pass), others = infra error
           if [[ $ec -eq 0 ]]; then
             echo "Issue reproduced (broken pipe or test failure): marking job as failed"
-            exit 1
+            exit 0
           elif [[ $ec -eq 1 ]]; then
             echo "No issues reproduced within MAX_ITER=${max_iter}: passing"
-            exit 0
+            exit 1
           else
             echo "Loop script error (exit $ec): failing"
             exit $ec

From cb67ec584e724beadcad12a4e042ab3c1f58db0e Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Sat, 23 Aug 2025 00:05:39 +0800
Subject: [PATCH 14/61] Set default max_iter value to 1000 in flakiness test
 workflow

---
 .github/workflows/flakiness.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/flakiness.yml b/.github/workflows/flakiness.yml
index 26ce963bc4..2492974971 100644
--- a/.github/workflows/flakiness.yml
+++ b/.github/workflows/flakiness.yml
@@ -69,7 +69,7 @@ jobs:
           LOG_STDERR: '1'
         run: |
           # Run with a sensible default of 1000 iterations on PRs;
-          max_iter="${{ inputs.max_iter }}"
+          max_iter="${{ inputs.max_iter || 1000 }}"
           bash scripts/open-close-loop.sh "${max_iter}"
           ec=$?
           # Interpret: 1 = issue reproduced (fail the job), 1 = not reproduced within budget (pass), others = infra error

From 56bc03b1c934bef410ed0591b324fde7c0d3bd9b Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Sat, 23 Aug 2025 00:16:10 +0800
Subject: [PATCH 15/61] Refactor logging in open-close loop script to improve
 iteration output and progress reporting

---
 scripts/open-close-loop.sh | 22 ++++++++++++++++++----
 1 file changed, 18 insertions(+), 4 deletions(-)

diff --git a/scripts/open-close-loop.sh b/scripts/open-close-loop.sh
index 36b4bfca48..aedca3f6c9 100755
--- a/scripts/open-close-loop.sh
+++ b/scripts/open-close-loop.sh
@@ -24,6 +24,11 @@ if [[ $# -ge 1 && -z "${MAX_ITER}" ]]; then
   MAX_ITER="$1"
 fi
 
+# fallback to default if not set
+if [[ -z "${MAX_ITER}" ]]; then
+  MAX_ITER=1000
+fi
+
 mkdir -p test-logs
 
 iter=0
@@ -56,8 +61,13 @@ REBUILD_EACH="${REBUILD_EACH:-0}" # set to 1 to rebuild before every iteration
 while true; do
   iter=$((iter+1))
   ts=$(date -Iseconds)
-  log="test-logs/open-close-loop-${iter}.log"
-  echo "[loop] Iteration ${iter} starting at ${ts}, logging to ${log}" | tee -a "${log}" >&2
+  file_num=$((iter % 100))
+  if [[ ${file_num} -eq 0 ]]; then file_num=100; fi
+  log="test-logs/open-close-loop-${file_num}.log"
+  # Only show iteration start for first iteration or every 100th iteration
+  if [[ ${iter} -eq 1 || $((iter % 100)) -eq 0 ]]; then
+    echo "[loop] Iteration ${iter} starting at ${ts}, logging to ${log}" | tee -a "${log}" >&2
+  fi
   # Run the single test pattern. We don't fail the loop on non-zero exit (capture output then decide).
   set +e
   if [[ ${REBUILD_EACH} -eq 1 ]]; then
@@ -67,7 +77,7 @@ while true; do
     TEST_BIN_NEW=$(find dist-newstyle -type f -name ghcide-tests -perm -111 2>/dev/null | head -n1 || true)
     if [[ -n "${TEST_BIN_NEW}" ]]; then TEST_BIN="${TEST_BIN_NEW}"; fi
   fi
-  HLS_TEST_TRACE_FD="${TRACE_FD}" \
+  # LSP_TEST_LOG_MESSAGES=1 LSP_TEST_LOG_STDERR=1\
   HLS_TEST_LOG_STDERR="${LOG_STDERR}" \
   HLS_TEST_HARNESS_STDERR="${LOG_STDERR}" \
   TASTY_NUM_THREADS=1 \
@@ -97,7 +107,11 @@ while true; do
     exit 1
   fi
 
-  echo "[loop] Iteration ${iter} complete (exit code ${ec}). No issues detected yet." | tee -a "${log}" >&2
+  # Show progress every 100 iterations instead of every iteration
+  if [[ $((iter % 100)) -eq 0 ]]; then
+    echo "[loop] Progress: Completed ${iter} iterations without detecting issues." >&2
+  fi
+
   if [[ ${SLEEP_SECS} -gt 0 ]]; then
     echo "[loop] Sleeping ${SLEEP_SECS}s" | tee -a "${log}" >&2
     sleep "${SLEEP_SECS}"

From 9f24f2e4c20e065471a756fd9c1e6a0e5aed5db0 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Sat, 23 Aug 2025 03:30:39 +0800
Subject: [PATCH 16/61] Fix exit codes for broken pipe and test failure
 detection in open-close loop script

---
 scripts/open-close-loop.sh | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/scripts/open-close-loop.sh b/scripts/open-close-loop.sh
index aedca3f6c9..c35c0827d8 100755
--- a/scripts/open-close-loop.sh
+++ b/scripts/open-close-loop.sh
@@ -90,12 +90,12 @@ while true; do
     echo "[loop] Broken pipe reproduced in iteration ${iter}. Stopping." | tee -a "${log}" >&2
     echo "[loop] --- Tail (last 60 lines) ---" >&2
     tail -n 60 "${log}" >&2
-    exit 0
+    exit 1
   elif grep -aFq -- "${TEST_FAILED_RE}" "${log}"; then
     echo "[loop] Test failure detected in iteration ${iter}. Stopping." | tee -a "${log}" >&2
     echo "[loop] --- Tail (last 60 lines) ---" >&2
     tail -n 60 "${log}" >&2
-    exit 0
+    exit 1
   else
     if [[ ${DEBUG_DETECT} -eq 1 ]]; then
       echo "[loop][debug] No match for '${BROKEN_PIPE_RE}' or '${TEST_FAILED_RE}' in iteration ${iter}." | tee -a "${log}" >&2
@@ -104,7 +104,7 @@ while true; do
 
   if [[ -n "${MAX_ITER}" && ${iter} -ge ${MAX_ITER} ]]; then
     echo "[loop] Reached MAX_ITER=${MAX_ITER} without reproducing issues." >&2
-    exit 1
+    exit 0
   fi
 
   # Show progress every 100 iterations instead of every iteration

From 8eb7bb5ce498e59d41738c3c4e3b914b18e10398 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Sun, 24 Aug 2025 04:31:44 +0800
Subject: [PATCH 17/61] Refactor flakiness testing workflow: replace open-close
 loop script with a more flexible flaky-test-loop script, update test patterns
 handling, and improve logging and exit code interpretation.

---
 .github/workflows/flakiness.yml |  51 ++++++----
 cabal.project                   |   2 +-
 scripts/flaky-test-loop.sh      | 175 ++++++++++++++++++++++++++++++++
 scripts/flaky-test-patterns.txt |   9 ++
 scripts/open-close-loop.sh      | 119 ----------------------
 5 files changed, 216 insertions(+), 140 deletions(-)
 create mode 100755 scripts/flaky-test-loop.sh
 create mode 100644 scripts/flaky-test-patterns.txt
 delete mode 100755 scripts/open-close-loop.sh

diff --git a/.github/workflows/flakiness.yml b/.github/workflows/flakiness.yml
index 2492974971..0937d53a02 100644
--- a/.github/workflows/flakiness.yml
+++ b/.github/workflows/flakiness.yml
@@ -14,13 +14,18 @@ on:
     branches:
       - '**'
     paths:
-      - 'scripts/open-close-loop.sh'
+      - 'scripts/flaky-test-loop.sh'
+      - 'scripts/flaky-test-patterns.txt'
       - 'ghcide/**'
+      - 'ghcide-test/**'
       - 'hls-test-utils/**'
       - 'src/**'
       - 'exe/**'
       - 'plugins/**'
       - 'cabal.project'
+      - 'stack.yaml'
+      - 'haskell-language-server.cabal'
+      - '.github/workflows/flakiness.yml'
   workflow_dispatch:
     inputs:
       max_iter:
@@ -31,6 +36,14 @@ on:
         description: 'Seconds to sleep between iterations'
         required: false
         default: '0'
+      test_patterns:
+        description: 'Comma-separated Tasty patterns to run each iteration (overrides default)'
+        required: false
+        default: ''
+      pattern_file:
+        description: 'Path to a file with one Tasty pattern per line (overrides test_patterns)'
+        required: false
+        default: 'flaky-test-patterns.txt'
 
 jobs:
   loop:
@@ -41,7 +54,7 @@ jobs:
       matrix:
         os:
           - ubuntu-latest
-          - macOS-latest
+          - macos-latest
           # - windows-latest
 
     steps:
@@ -58,36 +71,34 @@ jobs:
           cabal --version
           ghc --version
 
-      - name: Run open-close loop
+      - name: Run flakiness loop
         id: run-loop
         # Let this run for a while; build is done once inside the script
         timeout-minutes: 45
         env:
           # Use workflow_dispatch inputs when present, else defaults
-          SLEEP_SECS: ${{ inputs.sleep_secs || '0' }}
-          TRACE_FD: '1'
+          SLEEP_SECS: ${{ github.event.inputs.sleep_secs || '0' }}
           LOG_STDERR: '1'
+          TEST_PATTERNS: ${{ github.event.inputs.test_patterns }}
+          PATTERN_FILE: ${{ github.event.inputs.pattern_file }}
         run: |
           # Run with a sensible default of 1000 iterations on PRs;
-          max_iter="${{ inputs.max_iter || 1000 }}"
-          bash scripts/open-close-loop.sh "${max_iter}"
+          max_iter="${{ github.event.inputs.max_iter }}"
+          max_iter="${max_iter:-1000}"
+          bash scripts/flaky-test-loop.sh "${max_iter}"
           ec=$?
-          # Interpret: 1 = issue reproduced (fail the job), 1 = not reproduced within budget (pass), others = infra error
-          if [[ $ec -eq 0 ]]; then
-            echo "Issue reproduced (broken pipe or test failure): marking job as failed"
-            exit 0
-          elif [[ $ec -eq 1 ]]; then
-            echo "No issues reproduced within MAX_ITER=${max_iter}: passing"
+          # Interpret exit codes from flaky-test-loop.sh
+          #   1 => issue reproduced (broken pipe or test failure) -> fail job
+          #   0 => no issues reproduced within MAX_ITER          -> pass job
+          #   2+ => setup/infra error                            -> fail job
+          if [[ $ec -eq 1 ]]; then
+            echo "Issue reproduced (broken pipe or test failure): failing job"
             exit 1
+          elif [[ $ec -eq 0 ]]; then
+            echo "No issues reproduced within MAX_ITER=${max_iter}: passing"
+            exit 0
           else
             echo "Loop script error (exit $ec): failing"
             exit $ec
           fi
 
-      # - name: Upload loop logs
-      #   if: always()
-      #   uses: actions/upload-artifact@v4
-      #   with:
-      #     name: open-close-loop-logs-${{ matrix.os }}
-      #     path: test-logs/
-      #     if-no-files-found: ignore
diff --git a/cabal.project b/cabal.project
index dc124e29bb..e17a1cf4ad 100644
--- a/cabal.project
+++ b/cabal.project
@@ -60,5 +60,5 @@ if impl(ghc >= 9.11)
 source-repository-package
   type: git
   location: https://github.com/soulomoon/lsp.git
-  tag: f015902f9900065ad4960bae72e446983d5ff03d
+  tag: 067cc174f325c57329fc0830f58e4d9f6f827049
   subdir: lsp lsp-types lsp-test
diff --git a/scripts/flaky-test-loop.sh b/scripts/flaky-test-loop.sh
new file mode 100755
index 0000000000..edd61a57dd
--- /dev/null
+++ b/scripts/flaky-test-loop.sh
@@ -0,0 +1,175 @@
+#!/usr/bin/env bash
+# Loop running HLS tasty tests until a Broken pipe or test failure is observed.
+# Originally ran only the "open close" test; now supports multiple patterns.
+# Logs each run to test-logs/<pattern-slug>-loop-<n>.log, rotating every 100 files per pattern.
+#
+# Environment you can tweak:
+#   MAX_ITER      : maximum iterations before giving up (default: 1000)
+#   SLEEP_SECS    : seconds to sleep between iterations (default: 0)
+#   SHOW_EVERY    : print progress/iteration header every N iterations (default: 100, 1 = every run, <=0 = disabled)
+#   LOG_STDERR    : set to 1 to enable verbose stderr logging (HLS_TEST_LOG_STDERR & HLS_TEST_HARNESS_STDERR) (default: 1)
+#   REBUILD_EACH  : set to 1 to cabal build ghcide-tests before every iteration (default: 0)
+#   TEST_BIN      : path to the built test binary (auto-discovered if not set)
+#   NO_BUILD_ONCE : set to non-empty to skip the initial cabal build step
+#
+# Test selection:
+#   TEST_PATTERNS : comma-separated list of tasty patterns to run each iteration.
+#                   Example: TEST_PATTERNS='open close,bidirectional module dependency with hs-boot'
+#                   If set and non-empty, this takes precedence over PATTERN_FILE.
+#                   If unset, defaults to 'open close' to match prior behavior.
+#   PATTERN_FILE  : path to a file with one pattern per line (lines starting with # or blank are ignored).
+#                   Used only if TEST_PATTERNS is empty/unset; otherwise ignored.
+#
+# Exit codes:
+#   1 on success (broken pipe or test failure reproduced)
+#   0 on reaching MAX_ITER without reproduction
+#   2 on other setup error
+
+set -euo pipefail
+
+MAX_ITER="${MAX_ITER:-}"
+SLEEP_SECS="${SLEEP_SECS:-0}"
+SHOW_EVERY="${SHOW_EVERY:-1}"
+LOG_STDERR="${LOG_STDERR:-1}"
+
+# Allow providing a positional max iteration: ./open-close-loop.sh 50
+if [[ $# -ge 1 && -z "${MAX_ITER}" ]]; then
+  MAX_ITER="$1"
+fi
+
+# fallback to default if not set
+if [[ -z "${MAX_ITER}" ]]; then
+  MAX_ITER=1000
+fi
+
+mkdir -p test-logs
+
+iter=0
+start_ts=$(date -Iseconds)
+echo "[loop] Starting at ${start_ts}" >&2
+
+# Pattern strings to detect issues (keep simple & literal for robustness)
+BROKEN_PIPE_RE='Broken pipe'
+TEST_FAILED_RE='fail'
+DEBUG_DETECT="${DEBUG_DETECT:-0}"
+
+# Resolve which tasty patterns to run each iteration
+patterns=()
+if [[ -n "${TEST_PATTERNS:-}" ]]; then
+  IFS=',' read -r -a patterns <<< "${TEST_PATTERNS}"
+  # trim whitespace and drop empty entries
+  tmp_patterns=()
+  for p in "${patterns[@]}"; do
+    # trim leading
+    p="${p#${p%%[![:space:]]*}}"
+    # trim trailing
+    p="${p%${p##*[![:space:]]}}"
+    [[ -z "$p" ]] && continue
+    tmp_patterns+=("$p")
+  done
+  patterns=("${tmp_patterns[@]}")
+elif [[ -n "${PATTERN_FILE:-}" && -r "${PATTERN_FILE}" ]]; then
+  while IFS= read -r line; do
+    # trim whitespace, skip comments and blank lines
+    trimmed="${line#${line%%[![:space:]]*}}"
+    trimmed="${trimmed%${trimmed##*[![:space:]]}}"
+    [[ -z "${trimmed}" || "${trimmed}" =~ ^[[:space:]]*# ]] && continue
+    patterns+=("${trimmed}")
+  done < "${PATTERN_FILE}"
+else
+  # default to the original single test
+  patterns+=("open close")
+fi
+
+if [[ ${#patterns[@]} -eq 0 ]]; then
+  echo "[loop][error] No test patterns provided (via PATTERN_FILE or TEST_PATTERNS)." >&2
+  exit 2
+fi
+
+if [[ -z "${NO_BUILD_ONCE:-}" ]]; then
+  echo "[loop] Building test target ghcide-tests once upfront" >&2
+  cabal build ghcide-tests >&2
+fi
+
+# Locate the built test binary (simple heuristic similar to run_progress_test.sh)
+if [[ -z "${TEST_BIN:-}" ]]; then
+  TEST_BIN=$(find dist-newstyle -type f -name ghcide-tests -perm -111 2>/dev/null | head -n1 || true)
+fi
+
+if [[ -z "${TEST_BIN}" || ! -x "${TEST_BIN}" ]]; then
+  echo "[loop][error] Could not locate executable test binary 'ghcide-tests'. Set TEST_BIN explicitly or ensure build succeeded." >&2
+  exit 2
+fi
+echo "[loop] Using test binary: ${TEST_BIN}" >&2
+
+REBUILD_EACH="${REBUILD_EACH:-0}" # set to 1 to rebuild before every iteration
+
+while true; do
+  iter=$((iter+1))
+  ts=$(date -Iseconds)
+  file_num=$((iter % 100))
+  if [[ ${file_num} -eq 0 ]]; then file_num=100; fi
+
+  # Run each selected pattern in this iteration
+  for pattern in "${patterns[@]}"; do
+    # sanitize pattern for a log slug
+    slug=$(printf '%s' "${pattern}" | tr -cs 'A-Za-z0-9._-' '-' | sed -E 's/^-+|-+$//g')
+    [[ -z "${slug}" ]] && slug="pattern"
+    log="test-logs/${slug}-loop-${file_num}.log"
+
+  # Show iteration start at first run and then every SHOW_EVERY runs (if > 0)
+  if [[ ${iter} -eq 1 || ( ${SHOW_EVERY} -gt 0 && $((iter % SHOW_EVERY)) -eq 0 ) ]]; then
+      echo "[loop] Iteration ${iter} (${ts}) pattern='${pattern}' -> ${log}" | tee -a "${log}" >&2
+    fi
+
+    # We don't fail the loop on non-zero exit (capture output then decide).
+    set +e
+    if [[ ${REBUILD_EACH} -eq 1 ]]; then
+      echo "[loop] Rebuilding before iteration ${iter} (pattern='${pattern}')" | tee -a "${log}" >&2
+      cabal build ghcide-tests >>"${log}" 2>&1
+      # refresh TEST_BIN if path changed
+      TEST_BIN_NEW=$(find dist-newstyle -type f -name ghcide-tests -perm -111 2>/dev/null | head -n1 || true)
+      if [[ -n "${TEST_BIN_NEW}" ]]; then TEST_BIN="${TEST_BIN_NEW}"; fi
+    fi
+    # HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP=1 \
+    HLS_TEST_LOG_STDERR="${LOG_STDERR}" \
+    HLS_TEST_HARNESS_STDERR="${LOG_STDERR}" \
+    TASTY_NUM_THREADS=1 \
+    TASTY_PATTERN="${pattern}" \
+    "${TEST_BIN}" >"${log}" 2>&1
+    set -e
+
+    if grep -aFq -- "${BROKEN_PIPE_RE}" "${log}"; then
+      echo "[loop] Broken pipe reproduced in iteration ${iter} for pattern '${pattern}'. Stopping." | tee -a "${log}" >&2
+      echo "[loop] Log file: ${log} (abs: $(pwd)/${log})" | tee -a "${log}" >&2
+      echo "[loop] --- Tail (last 60 lines) ---" >&2
+      tail -n 60 "${log}" >&2
+      exit 1
+    elif grep -aFq -- "${TEST_FAILED_RE}" "${log}"; then
+      echo "[loop] Test failure detected in iteration ${iter} for pattern '${pattern}'. Stopping." | tee -a "${log}" >&2
+      echo "[loop] Log file: ${log} (abs: $(pwd)/${log})" | tee -a "${log}" >&2
+      echo "[loop] --- Tail (last 60 lines) ---" >&2
+      tail -n 60 "${log}" >&2
+      exit 1
+    else
+      if [[ ${DEBUG_DETECT} -eq 1 ]]; then
+        echo "[loop][debug] No match for '${BROKEN_PIPE_RE}' or '${TEST_FAILED_RE}' in iteration ${iter} (pattern='${pattern}')." | tee -a "${log}" >&2
+      fi
+    fi
+  done
+
+  if [[ -n "${MAX_ITER}" && ${iter} -ge ${MAX_ITER} ]]; then
+    echo "[loop] Reached MAX_ITER=${MAX_ITER} without reproducing issues." >&2
+    exit 0
+  fi
+
+  # Show progress at the configured cadence
+  if [[ ${SHOW_EVERY} -gt 0 && $((iter % SHOW_EVERY)) -eq 0 ]]; then
+    echo "[loop] Progress: Completed ${iter} iterations without detecting issues." >&2
+  fi
+
+  if [[ ${SLEEP_SECS} -gt 0 ]]; then
+  echo "[loop] Sleeping ${SLEEP_SECS}s" >&2
+    sleep "${SLEEP_SECS}"
+  fi
+done
diff --git a/scripts/flaky-test-patterns.txt b/scripts/flaky-test-patterns.txt
new file mode 100644
index 0000000000..33d644a567
--- /dev/null
+++ b/scripts/flaky-test-patterns.txt
@@ -0,0 +1,9 @@
+# One tasty pattern per line. Lines starting with # are comments.
+# Blank lines are ignored.
+open close
+# bidirectional module dependency with hs-boot
+# InternalError over InvalidParams
+# ghcide restarts shake session on config changes:
+# addDependentFile
+# Another interesting one you can try:
+# sends indefinite progress notifications
diff --git a/scripts/open-close-loop.sh b/scripts/open-close-loop.sh
deleted file mode 100755
index c35c0827d8..0000000000
--- a/scripts/open-close-loop.sh
+++ /dev/null
@@ -1,119 +0,0 @@
-#!/usr/bin/env bash
-# Loop running the "open close" test until a Broken pipe or test failure is observed.
-# Writes each iteration's full output to test-logs/open-close-loop-<n>.log
-# Environment you can tweak:
-#   MAX_ITER   : maximum iterations before giving up (default: unlimited)
-#   SLEEP_SECS : seconds to sleep between iterations (default: 0)
-#   TRACE_FD   : set to 1 to enable HLS_TEST_TRACE_FD (default: 1)
-#   LOG_STDERR : set to 1 to enable verbose stderr logging (HLS_TEST_LOG_STDERR & HLS_TEST_HARNESS_STDERR) (default: 1)
-#
-# Exit codes:
-#   0 on success (broken pipe or test failure reproduced)
-#   1 on reaching MAX_ITER without reproduction
-#   2 on other setup error
-
-set -euo pipefail
-
-MAX_ITER="${MAX_ITER:-}"
-SLEEP_SECS="${SLEEP_SECS:-0}"
-TRACE_FD="${TRACE_FD:-1}"
-LOG_STDERR="${LOG_STDERR:-1}"
-
-# Allow providing a positional max iteration: ./open-close-loop.sh 50
-if [[ $# -ge 1 && -z "${MAX_ITER}" ]]; then
-  MAX_ITER="$1"
-fi
-
-# fallback to default if not set
-if [[ -z "${MAX_ITER}" ]]; then
-  MAX_ITER=1000
-fi
-
-mkdir -p test-logs
-
-iter=0
-start_ts=$(date -Iseconds)
-echo "[loop] Starting at ${start_ts}" >&2
-
-# Pattern strings to detect issues (keep simple & literal for robustness)
-BROKEN_PIPE_RE='Broken pipe'
-TEST_FAILED_RE='fail'
-DEBUG_DETECT="${DEBUG_DETECT:-0}"
-
-if [[ -z "${NO_BUILD_ONCE:-}" ]]; then
-  echo "[loop] Building test target ghcide-tests once upfront" >&2
-  cabal build ghcide-tests >&2
-fi
-
-# Locate the built test binary (simple heuristic similar to run_progress_test.sh)
-if [[ -z "${TEST_BIN:-}" ]]; then
-  TEST_BIN=$(find dist-newstyle -type f -name ghcide-tests -perm -111 2>/dev/null | head -n1 || true)
-fi
-
-if [[ -z "${TEST_BIN}" || ! -x "${TEST_BIN}" ]]; then
-  echo "[loop][error] Could not locate executable test binary 'ghcide-tests'. Set TEST_BIN explicitly or ensure build succeeded." >&2
-  exit 2
-fi
-echo "[loop] Using test binary: ${TEST_BIN}" >&2
-
-REBUILD_EACH="${REBUILD_EACH:-0}" # set to 1 to rebuild before every iteration
-
-while true; do
-  iter=$((iter+1))
-  ts=$(date -Iseconds)
-  file_num=$((iter % 100))
-  if [[ ${file_num} -eq 0 ]]; then file_num=100; fi
-  log="test-logs/open-close-loop-${file_num}.log"
-  # Only show iteration start for first iteration or every 100th iteration
-  if [[ ${iter} -eq 1 || $((iter % 100)) -eq 0 ]]; then
-    echo "[loop] Iteration ${iter} starting at ${ts}, logging to ${log}" | tee -a "${log}" >&2
-  fi
-  # Run the single test pattern. We don't fail the loop on non-zero exit (capture output then decide).
-  set +e
-  if [[ ${REBUILD_EACH} -eq 1 ]]; then
-    echo "[loop] Rebuilding before iteration ${iter}" | tee -a "${log}" >&2
-    cabal build ghcide-tests >>"${log}" 2>&1
-    # refresh TEST_BIN if path changed
-    TEST_BIN_NEW=$(find dist-newstyle -type f -name ghcide-tests -perm -111 2>/dev/null | head -n1 || true)
-    if [[ -n "${TEST_BIN_NEW}" ]]; then TEST_BIN="${TEST_BIN_NEW}"; fi
-  fi
-  # LSP_TEST_LOG_MESSAGES=1 LSP_TEST_LOG_STDERR=1\
-  HLS_TEST_LOG_STDERR="${LOG_STDERR}" \
-  HLS_TEST_HARNESS_STDERR="${LOG_STDERR}" \
-  TASTY_NUM_THREADS=1 \
-  TASTY_PATTERN="open close" \
-  "${TEST_BIN}" >"${log}" 2>&1
-  ec=$?
-  set -e
-
-  if grep -aFq -- "${BROKEN_PIPE_RE}" "${log}"; then
-    echo "[loop] Broken pipe reproduced in iteration ${iter}. Stopping." | tee -a "${log}" >&2
-    echo "[loop] --- Tail (last 60 lines) ---" >&2
-    tail -n 60 "${log}" >&2
-    exit 1
-  elif grep -aFq -- "${TEST_FAILED_RE}" "${log}"; then
-    echo "[loop] Test failure detected in iteration ${iter}. Stopping." | tee -a "${log}" >&2
-    echo "[loop] --- Tail (last 60 lines) ---" >&2
-    tail -n 60 "${log}" >&2
-    exit 1
-  else
-    if [[ ${DEBUG_DETECT} -eq 1 ]]; then
-      echo "[loop][debug] No match for '${BROKEN_PIPE_RE}' or '${TEST_FAILED_RE}' in iteration ${iter}." | tee -a "${log}" >&2
-    fi
-  fi
-
-  if [[ -n "${MAX_ITER}" && ${iter} -ge ${MAX_ITER} ]]; then
-    echo "[loop] Reached MAX_ITER=${MAX_ITER} without reproducing issues." >&2
-    exit 0
-  fi
-
-  # Show progress every 100 iterations instead of every iteration
-  if [[ $((iter % 100)) -eq 0 ]]; then
-    echo "[loop] Progress: Completed ${iter} iterations without detecting issues." >&2
-  fi
-
-  if [[ ${SLEEP_SECS} -gt 0 ]]; then
-    echo "[loop] Sleeping ${SLEEP_SECS}s" | tee -a "${log}" >&2
-    sleep "${SLEEP_SECS}"
-  fi
-done

From d233023f9e3108acdc4275f413b20cc08ea210e1 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Sun, 24 Aug 2025 17:02:51 +0800
Subject: [PATCH 18/61] Update lsp repository tag to a447a4f

---
 cabal.project | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/cabal.project b/cabal.project
index e17a1cf4ad..607bab33cd 100644
--- a/cabal.project
+++ b/cabal.project
@@ -60,5 +60,5 @@ if impl(ghc >= 9.11)
 source-repository-package
   type: git
   location: https://github.com/soulomoon/lsp.git
-  tag: 067cc174f325c57329fc0830f58e4d9f6f827049
+  tag: a447a4f483fbf135e031a7829ad0ec86a9a20ac3
   subdir: lsp lsp-types lsp-test

From fe7421e087852a08776b53cd8cc1271f417190ab Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Sun, 24 Aug 2025 17:17:39 +0800
Subject: [PATCH 19/61] Update cabal.project

---
 cabal.project | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/cabal.project b/cabal.project
index 607bab33cd..6269d4ca6f 100644
--- a/cabal.project
+++ b/cabal.project
@@ -60,5 +60,5 @@ if impl(ghc >= 9.11)
 source-repository-package
   type: git
   location: https://github.com/soulomoon/lsp.git
-  tag: a447a4f483fbf135e031a7829ad0ec86a9a20ac3
+  tag: a747f731214ac269806df2ecad13044e094c96bf
   subdir: lsp lsp-types lsp-test

From 7bf694ab21bb5efd391975ea921ef84c610c9cf7 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Sun, 24 Aug 2025 17:38:02 +0800
Subject: [PATCH 20/61] update CI

---
 .github/workflows/flakiness.yml |  3 +++
 scripts/flaky-test-loop.sh      | 12 +-----------
 2 files changed, 4 insertions(+), 11 deletions(-)

diff --git a/.github/workflows/flakiness.yml b/.github/workflows/flakiness.yml
index 0937d53a02..7332b532f0 100644
--- a/.github/workflows/flakiness.yml
+++ b/.github/workflows/flakiness.yml
@@ -70,6 +70,8 @@ jobs:
         run: |
           cabal --version
           ghc --version
+      - name: Build ghcide-tests
+        run: cabal build ghcide-tests
 
       - name: Run flakiness loop
         id: run-loop
@@ -81,6 +83,7 @@ jobs:
           LOG_STDERR: '1'
           TEST_PATTERNS: ${{ github.event.inputs.test_patterns }}
           PATTERN_FILE: ${{ github.event.inputs.pattern_file }}
+          NO_BUILD_ONCE: '1'
         run: |
           # Run with a sensible default of 1000 iterations on PRs;
           max_iter="${{ github.event.inputs.max_iter }}"
diff --git a/scripts/flaky-test-loop.sh b/scripts/flaky-test-loop.sh
index edd61a57dd..b917d494a8 100755
--- a/scripts/flaky-test-loop.sh
+++ b/scripts/flaky-test-loop.sh
@@ -8,7 +8,6 @@
 #   SLEEP_SECS    : seconds to sleep between iterations (default: 0)
 #   SHOW_EVERY    : print progress/iteration header every N iterations (default: 100, 1 = every run, <=0 = disabled)
 #   LOG_STDERR    : set to 1 to enable verbose stderr logging (HLS_TEST_LOG_STDERR & HLS_TEST_HARNESS_STDERR) (default: 1)
-#   REBUILD_EACH  : set to 1 to cabal build ghcide-tests before every iteration (default: 0)
 #   TEST_BIN      : path to the built test binary (auto-discovered if not set)
 #   NO_BUILD_ONCE : set to non-empty to skip the initial cabal build step
 #
@@ -102,8 +101,6 @@ if [[ -z "${TEST_BIN}" || ! -x "${TEST_BIN}" ]]; then
 fi
 echo "[loop] Using test binary: ${TEST_BIN}" >&2
 
-REBUILD_EACH="${REBUILD_EACH:-0}" # set to 1 to rebuild before every iteration
-
 while true; do
   iter=$((iter+1))
   ts=$(date -Iseconds)
@@ -123,14 +120,7 @@ while true; do
     fi
 
     # We don't fail the loop on non-zero exit (capture output then decide).
-    set +e
-    if [[ ${REBUILD_EACH} -eq 1 ]]; then
-      echo "[loop] Rebuilding before iteration ${iter} (pattern='${pattern}')" | tee -a "${log}" >&2
-      cabal build ghcide-tests >>"${log}" 2>&1
-      # refresh TEST_BIN if path changed
-      TEST_BIN_NEW=$(find dist-newstyle -type f -name ghcide-tests -perm -111 2>/dev/null | head -n1 || true)
-      if [[ -n "${TEST_BIN_NEW}" ]]; then TEST_BIN="${TEST_BIN_NEW}"; fi
-    fi
+  set +e
     # HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP=1 \
     HLS_TEST_LOG_STDERR="${LOG_STDERR}" \
     HLS_TEST_HARNESS_STDERR="${LOG_STDERR}" \

From 8c17daa854688e7c687f11d5c62c9b2955fc6759 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Sun, 24 Aug 2025 21:43:15 +0800
Subject: [PATCH 21/61] Update reactor shutdown logging, and improve shutdown
 handling

---
 .github/workflows/flakiness.yml               |   3 -
 cabal.project                                 |   2 +-
 .../src/Development/IDE/LSP/LanguageServer.hs | 119 ++++++++++--------
 3 files changed, 68 insertions(+), 56 deletions(-)

diff --git a/.github/workflows/flakiness.yml b/.github/workflows/flakiness.yml
index 7332b532f0..0937d53a02 100644
--- a/.github/workflows/flakiness.yml
+++ b/.github/workflows/flakiness.yml
@@ -70,8 +70,6 @@ jobs:
         run: |
           cabal --version
           ghc --version
-      - name: Build ghcide-tests
-        run: cabal build ghcide-tests
 
       - name: Run flakiness loop
         id: run-loop
@@ -83,7 +81,6 @@ jobs:
           LOG_STDERR: '1'
           TEST_PATTERNS: ${{ github.event.inputs.test_patterns }}
           PATTERN_FILE: ${{ github.event.inputs.pattern_file }}
-          NO_BUILD_ONCE: '1'
         run: |
           # Run with a sensible default of 1000 iterations on PRs;
           max_iter="${{ github.event.inputs.max_iter }}"
diff --git a/cabal.project b/cabal.project
index 6269d4ca6f..269265a1ab 100644
--- a/cabal.project
+++ b/cabal.project
@@ -60,5 +60,5 @@ if impl(ghc >= 9.11)
 source-repository-package
   type: git
   location: https://github.com/soulomoon/lsp.git
-  tag: a747f731214ac269806df2ecad13044e094c96bf
+  tag: df83bb0fe7ea3f09339dae4593efe6b4a5284413
   subdir: lsp lsp-types lsp-test
diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
index cd4ea346b2..4d6741c84f 100644
--- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs
+++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
@@ -59,25 +59,30 @@ data Log
   = LogRegisteringIdeConfig !IdeConfiguration
   | LogReactorThreadException !SomeException
   | LogReactorMessageActionException !SomeException
-  | LogReactorThreadStopped
+  | LogReactorThreadStopped Int
   | LogCancelledRequest !SomeLspId
   | LogSession Session.Log
   | LogLspServer LspServerLog
-  | LogServerShutdownMessage
+  | LogReactorShutdownRequested Bool
   | LogShutDownTimeout Int
   | LogServerExitWith (Either () Int)
+  | LogReactorShutdownConfirmed !T.Text
   deriving Show
 
 instance Pretty Log where
   pretty = \case
+    LogReactorShutdownRequested b ->
+      "Requested reactor shutdown; stop signal posted: " <+> pretty b
+    LogReactorShutdownConfirmed msg ->
+        "Reactor shutdown confirmed: " <+> pretty msg
     LogServerExitWith (Right 0) ->
-      "Server exited with succefully"
+      "Server exited successfully"
     LogServerExitWith (Right code) ->
       "Server exited with failure code" <+> pretty code
     LogServerExitWith (Left _) ->
       "Server forcefully exited due to exception in reactor thread"
     LogShutDownTimeout seconds ->
-        "Shutdown timeout, the server will exit now after waiting for" <+> pretty seconds <+> "milliseconds"
+        "Shutdown timeout, the server will exit now after waiting for" <+> pretty seconds  <+> "seconds"
     LogRegisteringIdeConfig ideConfig ->
       -- This log is also used to identify if HLS starts successfully in vscode-haskell,
       -- don't forget to update the corresponding test in vscode-haskell if the text in
@@ -91,13 +96,12 @@ instance Pretty Log where
       vcat
         [ "ReactorMessageActionException"
         , pretty $ displayException e ]
-    LogReactorThreadStopped ->
-      "Reactor thread stopped"
+    LogReactorThreadStopped i ->
+      "Reactor thread stopped" <+> pretty i
     LogCancelledRequest requestId ->
       "Cancelled request" <+> viaShow requestId
     LogSession msg -> pretty msg
     LogLspServer msg -> pretty msg
-    LogServerShutdownMessage -> "Received shutdown message"
 
 -- | Context for initializing the LSP language server.
 -- This record encapsulates all the configuration and callback functions
@@ -111,8 +115,10 @@ data InitializationContext config = InitializationContext
     -- ^ Function to determine the HIE database location for a given root path
   , ctxGetIdeState :: LSP.LanguageContextEnv config -> FilePath -> WithHieDb -> ThreadQueue -> IO IdeState
     -- ^ Function to create and initialize the IDE state with the given environment
-  , ctxLifetime :: (MVar (), IO ())
-    -- ^ Lifetime control: MVar to signal shutdown and confirmation action
+  , ctxUntilReactorStopSignal :: IO () -> IO ()
+    -- ^ Lifetime control: MVar to signal reactor shutdown
+  , ctxconfirmReactorShutdown :: T.Text -> IO ()
+    -- ^ Callback to log/confirm reactor shutdown with a reason
   , ctxForceShutdown :: IO ()
     -- ^ Action to forcefully exit the server when exception occurs
   , ctxClearReqId :: SomeLspId -> IO ()
@@ -196,18 +202,21 @@ setupLSP recorder defaultRoot getHieDbLoc userHandlers getIdeState clientMsgVar
 
   -- An MVar to control the lifetime of the reactor loop.
   -- The loop will be stopped and resources freed when it's full
-  reactorLifetime <- newEmptyMVar
-  reactorLifetimeConfirmBarrier <- newBarrier
-  let stopReactorLoopConfirm =
-        signalBarrier reactorLifetimeConfirmBarrier ()
-  let stopReactorLoop = do
-        _ <- tryPutMVar reactorLifetime ()
-        let timeOutSeconds = 3 * 1_000_000
-        timeout timeOutSeconds (waitBarrier reactorLifetimeConfirmBarrier) >>= \case
-            Just () -> pure ()
-            -- If we don't get confirmation within 3 seconds, we log a warning and shutdown anyway.
-            -- This is to avoid deadlocks in case the client does not respond to shutdown requests.
-            Nothing -> logWith recorder Warning $ LogShutDownTimeout timeOutSeconds
+  reactorStopSignal <- newEmptyMVar
+  reactorConfirmBarrier <- newBarrier
+  let
+    untilReactorStopSignal = untilMVar reactorStopSignal
+    confirmReactorShutdown reason = do
+      logWith recorder Debug $ LogReactorShutdownConfirmed reason
+      signalBarrier reactorConfirmBarrier ()
+    requestReactorShutdown = do
+      k <- tryPutMVar reactorStopSignal ()
+      logWith recorder Info $ LogReactorShutdownRequested k
+      let timeOutSeconds = 2
+      timeout (timeOutSeconds * 1_000_000) (waitBarrier reactorConfirmBarrier) >>= \case
+        Just () -> pure ()
+        -- If we don't get confirmation within 2 seconds, we log a warning and shutdown anyway.
+        Nothing -> logWith recorder Warning $ LogShutDownTimeout timeOutSeconds
 
   -- Forcefully exit
   let exit = void $ tryPutMVar clientMsgVar ()
@@ -236,7 +245,7 @@ setupLSP recorder defaultRoot getHieDbLoc userHandlers getIdeState clientMsgVar
   let staticHandlers = mconcat
         [ userHandlers
         , cancelHandler cancelRequest
-        , shutdownHandler recorder stopReactorLoop
+        , shutdownHandler recorder requestReactorShutdown
         ]
         -- Cancel requests are special since they need to be handled
         -- out of order to be useful. Existing handlers are run afterwards.
@@ -246,7 +255,8 @@ setupLSP recorder defaultRoot getHieDbLoc userHandlers getIdeState clientMsgVar
         , ctxDefaultRoot = defaultRoot
         , ctxGetHieDbLoc = getHieDbLoc
         , ctxGetIdeState = getIdeState
-        , ctxLifetime = (reactorLifetime, stopReactorLoopConfirm)
+        , ctxUntilReactorStopSignal = untilReactorStopSignal
+        , ctxconfirmReactorShutdown = confirmReactorShutdown
         , ctxForceShutdown = exit
         , ctxClearReqId = clearReqId
         , ctxWaitForCancel = waitForCancel
@@ -256,8 +266,7 @@ setupLSP recorder defaultRoot getHieDbLoc userHandlers getIdeState clientMsgVar
   let doInitialize = handleInit initParams
 
   let interpretHandler (env,  st) = LSP.Iso (LSP.runLspT env . flip (runReaderT . unServerM) (clientMsgChan,st)) liftIO
-
-  let onExit = [stopReactorLoop, exit]
+  let onExit = [void $ tryPutMVar reactorStopSignal ()]
 
   pure MkSetup {doInitialize, staticHandlers, interpretHandler, onExit}
 
@@ -267,30 +276,33 @@ handleInit
     -> LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState))
 handleInit initParams env (TRequestMessage _ _ m params) = otTracedHandler "Initialize" (show m) $ \sp -> do
     traceWithSpan sp params
-    -- only shift if lsp root is different from the rootDir
-    -- see Note [Root Directory]
-    let recorder = ctxRecorder initParams
-        defaultRoot = ctxDefaultRoot initParams
-        (lifetime, lifetimeConfirm) = ctxLifetime initParams
+  -- only shift if lsp root is different from the rootDir
+  -- see Note [Root Directory]
+    let
+      recorder = ctxRecorder initParams
+      defaultRoot = ctxDefaultRoot initParams
+      untilReactorStopSignal = ctxUntilReactorStopSignal initParams
+      lifetimeConfirm = ctxconfirmReactorShutdown initParams
     root <- case LSP.resRootPath env of
-        Just lspRoot | lspRoot /= defaultRoot -> setCurrentDirectory lspRoot >> return lspRoot
-        _ -> pure defaultRoot
+      Just lspRoot | lspRoot /= defaultRoot -> setCurrentDirectory lspRoot >> return lspRoot
+      _ -> pure defaultRoot
     dbLoc <- ctxGetHieDbLoc initParams root
     let initConfig = parseConfiguration params
     logWith recorder Info $ LogRegisteringIdeConfig initConfig
     ideMVar <- newEmptyMVar
 
     let handleServerExceptionOrShutDown me = do
-            -- try to shutdown shake
-            tryReadMVar ideMVar >>= \case
-                Nothing -> return ()
-                Just ide -> shutdown ide
-            lifetimeConfirm
+            -- shutdown shake
+            readMVar ideMVar >>= \case
+                ide -> shutdown ide
             case me of
                 Left e -> do
+                    lifetimeConfirm "due to exception in reactor thread or shutdown message"
                     logWith recorder Error $ LogReactorThreadException e
                     ctxForceShutdown initParams
-                _ -> return ()
+                _ -> do
+                    lifetimeConfirm "due to shutdown message"
+                    return ()
 
         exceptionInHandler e = do
             logWith recorder Error $ LogReactorMessageActionException e
@@ -314,17 +326,21 @@ handleInit initParams env (TRequestMessage _ _ m params) = otTracedHandler "Init
                     exceptionInHandler e
                     k $ TResponseError (InR ErrorCodes_InternalError) (T.pack $ show e) Nothing
     _ <- flip forkFinally handleServerExceptionOrShutDown $ do
-        untilMVar lifetime $ runWithWorkerThreads (cmapWithPrio LogSession recorder) dbLoc $ \withHieDb' threadQueue' -> do
-            ide <- ctxGetIdeState initParams env root withHieDb' threadQueue'
-            putMVar ideMVar ide
-            forever $ do
-                msg <- readChan $ ctxClientMsgChan initParams
-                -- We dispatch notifications synchronously and requests asynchronously
-                -- This is to ensure that all file edits and config changes are applied before a request is handled
-                case msg of
-                    ReactorNotification act -> handle exceptionInHandler act
-                    ReactorRequest _id act k -> void $ async $ checkCancelled _id act k
-        logWith recorder Info LogReactorThreadStopped
+            runWithWorkerThreads (cmapWithPrio LogSession recorder) dbLoc $ \withHieDb' threadQueue' ->
+                do
+                ide <- ctxGetIdeState initParams env root withHieDb' threadQueue'
+                putMVar ideMVar ide
+                -- We might be blocked indefinitly at initialization if reactorStop is signaled
+                -- before we putMVar.
+                untilReactorStopSignal $ forever $ do
+                    msg <- readChan $ ctxClientMsgChan initParams
+                    -- We dispatch notifications synchronously and requests asynchronously
+                    -- This is to ensure that all file edits and config changes are applied before a request is handled
+                    case msg of
+                        ReactorNotification act -> handle exceptionInHandler act
+                        ReactorRequest _id act k -> void $ async $ checkCancelled _id act k
+                logWith recorder Info $ LogReactorThreadStopped 1
+            logWith recorder Info $ LogReactorThreadStopped 2
 
     ide <- readMVar ideMVar
     registerIdeConfiguration (shakeExtras ide) initConfig
@@ -360,10 +376,9 @@ cancelHandler cancelRequest = LSP.notificationHandler SMethod_CancelRequest $ \T
         toLspId (InR y) = IdString y
 
 shutdownHandler :: Recorder (WithPriority Log) -> IO () -> LSP.Handlers (ServerM c)
-shutdownHandler recorder stopReactor = LSP.requestHandler SMethod_Shutdown $ \_ resp -> do
-    liftIO $ logWith recorder Debug LogServerShutdownMessage
+shutdownHandler _recorder requestReactorShutdown = LSP.requestHandler SMethod_Shutdown $ \_ resp -> do
     -- stop the reactor to free up the hiedb connection and shut down shake
-    liftIO stopReactor
+    liftIO requestReactorShutdown
     resp $ Right Null
 
 modifyOptions :: LSP.Options -> LSP.Options

From 6907be0ead88148db589c47f4d651b06489f639e Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Tue, 26 Aug 2025 21:40:48 +0800
Subject: [PATCH 22/61] update flaky-test-loop script

---
 scripts/flaky-test-loop.sh      | 10 ++++++----
 scripts/flaky-test-patterns.txt |  4 ++++
 2 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/scripts/flaky-test-loop.sh b/scripts/flaky-test-loop.sh
index b917d494a8..17457654bc 100755
--- a/scripts/flaky-test-loop.sh
+++ b/scripts/flaky-test-loop.sh
@@ -47,9 +47,11 @@ iter=0
 start_ts=$(date -Iseconds)
 echo "[loop] Starting at ${start_ts}" >&2
 
-# Pattern strings to detect issues (keep simple & literal for robustness)
+# Patterns to detect issues
+# - Use case-insensitive extended regex for failures/timeouts in logs
+# - Broken pipe: case-insensitive fixed-string search
 BROKEN_PIPE_RE='Broken pipe'
-TEST_FAILED_RE='fail'
+TEST_FAILED_RE='fail|timeout'
 DEBUG_DETECT="${DEBUG_DETECT:-0}"
 
 # Resolve which tasty patterns to run each iteration
@@ -129,13 +131,13 @@ while true; do
     "${TEST_BIN}" >"${log}" 2>&1
     set -e
 
-    if grep -aFq -- "${BROKEN_PIPE_RE}" "${log}"; then
+  if grep -aFiq -- "${BROKEN_PIPE_RE}" "${log}"; then
       echo "[loop] Broken pipe reproduced in iteration ${iter} for pattern '${pattern}'. Stopping." | tee -a "${log}" >&2
       echo "[loop] Log file: ${log} (abs: $(pwd)/${log})" | tee -a "${log}" >&2
       echo "[loop] --- Tail (last 60 lines) ---" >&2
       tail -n 60 "${log}" >&2
       exit 1
-    elif grep -aFq -- "${TEST_FAILED_RE}" "${log}"; then
+  elif grep -aEqi -- "${TEST_FAILED_RE}" "${log}"; then
       echo "[loop] Test failure detected in iteration ${iter} for pattern '${pattern}'. Stopping." | tee -a "${log}" >&2
       echo "[loop] Log file: ${log} (abs: $(pwd)/${log})" | tee -a "${log}" >&2
       echo "[loop] --- Tail (last 60 lines) ---" >&2
diff --git a/scripts/flaky-test-patterns.txt b/scripts/flaky-test-patterns.txt
index 33d644a567..3e53620a6b 100644
--- a/scripts/flaky-test-patterns.txt
+++ b/scripts/flaky-test-patterns.txt
@@ -1,7 +1,11 @@
 # One tasty pattern per line. Lines starting with # are comments.
 # Blank lines are ignored.
+
 open close
+# non local variable
+Notification Handlers
 # bidirectional module dependency with hs-boot
+
 # InternalError over InvalidParams
 # ghcide restarts shake session on config changes:
 # addDependentFile

From 0851914e3a466064fe3302e72fe357ac03060f06 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Tue, 26 Aug 2025 21:41:53 +0800
Subject: [PATCH 23/61] update lsp rev

---
 cabal.project | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/cabal.project b/cabal.project
index 269265a1ab..c27665b169 100644
--- a/cabal.project
+++ b/cabal.project
@@ -60,5 +60,5 @@ if impl(ghc >= 9.11)
 source-repository-package
   type: git
   location: https://github.com/soulomoon/lsp.git
-  tag: df83bb0fe7ea3f09339dae4593efe6b4a5284413
+  tag: b23e47622b85f2577d7cfa5c2d89eaa8965d1961
   subdir: lsp lsp-types lsp-test

From 7900d7148d27ee0c8540194e7c1302e9ee4f05a4 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Tue, 26 Aug 2025 21:51:24 +0800
Subject: [PATCH 24/61] Use a TMVar as a stop flag to coordinate graceful
 shutdown. The worker thread checks this flag before dequeuing each job; if
 set, it exits immediately, ensuring that no new work is started after
 shutdown is requested. This mechanism is necessary because some downstream
 code may swallow async exceptions, making 'cancel' unreliable for stopping
 the thread in all cases. If 'cancel' does interrupt the thread (e.g., while
 blocked in STM or in a cooperative job), the thread exits immediately and
 never checks the TMVar; in such cases, the stop flag is redundant.

---
 ghcide-test/exe/ExceptionTests.hs             |  19 ++-
 .../session-loader/Development/IDE/Session.hs |  18 +--
 ghcide/src/Development/IDE/Core/Compile.hs    |   3 +-
 ghcide/src/Development/IDE/Core/FileStore.hs  |   3 +-
 ghcide/src/Development/IDE/Core/Shake.hs      |  15 ++-
 .../src/Development/IDE/Core/WorkerThread.hs  | 113 ++++++++++++++----
 ghcide/src/Development/IDE/GHC/Util.hs        |   2 +
 .../src/Development/IDE/LSP/LanguageServer.hs |  13 +-
 hls-test-utils/src/Test/Hls.hs                |   1 +
 9 files changed, 134 insertions(+), 53 deletions(-)

diff --git a/ghcide-test/exe/ExceptionTests.hs b/ghcide-test/exe/ExceptionTests.hs
index a95f91e97c..ed7c1f909d 100644
--- a/ghcide-test/exe/ExceptionTests.hs
+++ b/ghcide-test/exe/ExceptionTests.hs
@@ -13,8 +13,9 @@ import           Development.IDE.Core.Shake        (IdeState (..))
 import qualified Development.IDE.LSP.Notifications as Notifications
 import           Development.IDE.Plugin.HLS        (toResponseError)
 import           GHC.Base                          (coerce)
-import           Ide.Logger                        (Recorder, WithPriority,
-                                                    cmapWithPrio)
+import           Ide.Logger                        (Priority (Debug), Recorder,
+                                                    WithPriority, cmapWithPrio,
+                                                    logWith)
 import           Ide.Plugin.Error
 import           Ide.Plugin.HandleRequestTypes     (RejectionReason (DisabledGlobally))
 import           Ide.PluginUtils                   (pluginDescToIdePlugins)
@@ -28,7 +29,9 @@ import           Language.LSP.Protocol.Types       hiding
                                                     mkRange)
 import           Language.LSP.Test
 import           LogType                           (Log (..))
+import           System.Time.Extra                 (sleep)
 import           Test.Hls                          (TestConfig (testDisableDefaultPlugin, testPluginDescriptor),
+                                                    hlsHelperTestRecorder,
                                                     runSessionWithTestConfig,
                                                     testCheckProject,
                                                     waitForProgressDone)
@@ -99,13 +102,21 @@ tests = do
                           ]
                         }] ++ [Notifications.descriptor (cmapWithPrio LogNotifications r) "ghcide-core"]
           runSessionWithTestConfig def {testPluginDescriptor = plugins, testDisableDefaultPlugin=True, testCheckProject=False} $ const $ do
+              testRecorder :: Recorder (WithPriority [Char]) <- liftIO hlsHelperTestRecorder
               doc <- createDoc "A.hs" "haskell" "module A where"
-              waitForProgressDone
+              logWith testRecorder Debug "notification-exception 0"
+            --   waitForProgressDone
+              liftIO $ sleep 0.14
+              logWith testRecorder Debug "notification-exception 1"
+            --   liftIO $
+            --   liftIO $ threadDelay 100
               (view L.result -> lens) <- request SMethod_TextDocumentCodeLens (CodeLensParams Nothing Nothing doc)
+              logWith testRecorder Debug "notification-exception 2"
               case lens of
-                Right (InL []) ->
+                Right (InL []) -> do
                   -- We don't get error responses from notification handlers, so
                   -- we can only make sure that the server is still responding
+                  logWith testRecorder Debug "notification-exception success"
                   pure ()
                 _ -> liftIO $ assertFailure $ "We should have had an empty list" <> show lens]
 
diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs
index dde1cfdea5..4be4fd78e2 100644
--- a/ghcide/session-loader/Development/IDE/Session.hs
+++ b/ghcide/session-loader/Development/IDE/Session.hs
@@ -1,5 +1,6 @@
-{-# LANGUAGE CPP          #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE CPP                #-}
+{-# LANGUAGE ImpredicativeTypes #-}
+{-# LANGUAGE TypeFamilies       #-}
 
 {-|
 The logic for setting up a ghcide session by tapping into hie-bios.
@@ -104,8 +105,7 @@ import qualified Data.HashSet                        as Set
 import qualified Data.Set                            as OS
 import           Database.SQLite.Simple
 import           Development.IDE.Core.Tracing        (withTrace)
-import           Development.IDE.Core.WorkerThread   (awaitRunInThread,
-                                                      withWorkerQueue)
+import           Development.IDE.Core.WorkerThread
 import qualified Development.IDE.GHC.Compat.Util     as Compat
 import           Development.IDE.Session.Diagnostics (renderCradleError)
 import           Development.IDE.Types.Shake         (WithHieDb,
@@ -119,6 +119,7 @@ import qualified System.Random                       as Random
 import           System.Random                       (RandomGen)
 import           Text.ParserCombinators.ReadP        (readP_to_S)
 
+import qualified Control.Monad.Catch                 as MC
 import           GHC.Driver.Env                      (hsc_all_home_unit_ids)
 import           GHC.Driver.Errors.Types
 import           GHC.Types.Error                     (errMsgDiagnostic,
@@ -149,10 +150,12 @@ data Log
   | LogNewComponentCache !(([FileDiagnostic], Maybe HscEnvEq), DependencyInfo)
   | LogHieBios HieBios.Log
   | LogSessionLoadingChanged
+  | LogSessionWorkerThread LogWorkerThread
 deriving instance Show Log
 
 instance Pretty Log where
   pretty = \case
+    LogSessionWorkerThread msg -> pretty msg
     LogNoneCradleFound path ->
       "None cradle found for" <+> pretty path <+> ", ignoring the file"
     LogSettingInitialDynFlags ->
@@ -381,8 +384,8 @@ runWithDb recorder fp = ContT $ \k -> do
     _ <- withWriteDbRetryable deleteMissingRealFiles
     _ <- withWriteDbRetryable garbageCollectTypeNames
 
-    runContT (withWorkerQueue (writer withWriteDbRetryable)) $ \chan ->
-        withHieDb fp (\readDb -> k (WithHieDbShield $ makeWithHieDbRetryable recorder rng readDb, chan))
+    runContT (withWorkerQueue (cmapWithPrio LogSessionWorkerThread recorder) "hiedb thread" (writer withWriteDbRetryable))
+        $ \chan -> withHieDb fp (\readDb -> k (WithHieDbShield $ makeWithHieDbRetryable recorder rng readDb, chan))
   where
     writer withHieDbRetryable l = do
         -- TODO: probably should let exceptions be caught/logged/handled by top level handler
@@ -415,7 +418,7 @@ getHieDbLoc dir = do
 -- components mapping to the same hie.yaml file are mapped to the same
 -- HscEnv which is updated as new components are discovered.
 
-loadSessionWithOptions :: Recorder (WithPriority Log) -> SessionLoadingOptions -> FilePath -> TQueue (IO ()) -> IO (Action IdeGhcSession)
+loadSessionWithOptions :: Recorder (WithPriority Log) -> SessionLoadingOptions -> FilePath -> TaskQueue (IO ()) -> IO (Action IdeGhcSession)
 loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
   let toAbsolutePath = toAbsolute rootDir -- see Note [Root Directory]
   cradle_files <- newIORef []
@@ -753,6 +756,7 @@ emptyHscEnv :: NameCache -> FilePath -> IO HscEnv
 emptyHscEnv nc libDir = do
     -- We call setSessionDynFlags so that the loader is initialised
     -- We need to do this before we call initUnits.
+    -- we mask_ here because asynchronous exceptions might be swallowed
     env <- runGhc (Just libDir) $
       getSessionDynFlags >>= setSessionDynFlags >> getSession
     pure $ setNameCache nc (hscSetFlags ((hsc_dflags env){useUnicode = True }) env)
diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs
index 48439e2ff3..5a3039c5fe 100644
--- a/ghcide/src/Development/IDE/Core/Compile.hs
+++ b/ghcide/src/Development/IDE/Core/Compile.hs
@@ -75,6 +75,7 @@ import           Development.IDE.Core.Preprocessor
 import           Development.IDE.Core.ProgressReporting       (progressUpdate)
 import           Development.IDE.Core.RuleTypes
 import           Development.IDE.Core.Shake
+import           Development.IDE.Core.WorkerThread            (writeTaskQueue)
 import           Development.IDE.Core.Tracing                 (withTrace)
 import qualified Development.IDE.GHC.Compat                   as Compat
 import qualified Development.IDE.GHC.Compat                   as GHC
@@ -882,7 +883,7 @@ indexHieFile se mod_summary srcPath !hash hf = do
       -- hiedb doesn't use the Haskell src, so we clear it to avoid unnecessarily keeping it around
       let !hf' = hf{hie_hs_src = mempty}
       modifyTVar' indexPending $ HashMap.insert srcPath hash
-      writeTQueue indexQueue $ \withHieDb -> do
+      writeTaskQueue indexQueue $ \withHieDb -> do
         -- We are now in the worker thread
         -- Check if a newer index of this file has been scheduled, and if so skip this one
         newerScheduled <- atomically $ do
diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs
index 714d991201..37177a22d1 100644
--- a/ghcide/src/Development/IDE/Core/FileStore.hs
+++ b/ghcide/src/Development/IDE/Core/FileStore.hs
@@ -45,6 +45,7 @@ import           Development.IDE.Core.IdeConfiguration        (isWorkspaceFile)
 import           Development.IDE.Core.RuleTypes
 import           Development.IDE.Core.Shake                   hiding (Log)
 import qualified Development.IDE.Core.Shake                   as Shake
+import           Development.IDE.Core.WorkerThread
 import           Development.IDE.GHC.Orphans                  ()
 import           Development.IDE.Graph
 import           Development.IDE.Import.DependencyInformation
@@ -304,7 +305,7 @@ typecheckParentsAction recorder nfp = do
 setSomethingModified :: VFSModified -> IdeState -> String -> IO [Key] -> IO ()
 setSomethingModified vfs state reason actionBetweenSession = do
     -- Update database to remove any files that might have been renamed/deleted
-    atomically $ writeTQueue (indexQueue $ hiedbWriter $ shakeExtras state) (\withHieDb -> withHieDb deleteMissingRealFiles)
+    atomically $ writeTaskQueue (indexQueue $ hiedbWriter $ shakeExtras state) (\withHieDb -> withHieDb deleteMissingRealFiles)
     void $ restartShakeSession (shakeExtras state) vfs reason [] actionBetweenSession
 
 registerFileWatches :: [String] -> LSP.LspT Config IO Bool
diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs
index 70688ae47b..7356d673d7 100644
--- a/ghcide/src/Development/IDE/Core/Shake.hs
+++ b/ghcide/src/Development/IDE/Core/Shake.hs
@@ -25,7 +25,7 @@ module Development.IDE.Core.Shake(
     IdeState, shakeSessionInit, shakeExtras, shakeDb, rootDir,
     ShakeExtras(..), getShakeExtras, getShakeExtrasRules,
     KnownTargets(..), Target(..), toKnownFiles, unionKnownTargets, mkKnownTargets,
-    IdeRule, IdeResult,
+    IdeRule, IdeResult, RestartQueue,
     GetModificationTime(GetModificationTime, GetModificationTime_, missingFileDiagnostics),
     shakeOpen, shakeShut,
     shakeEnqueue,
@@ -254,12 +254,15 @@ data HieDbWriter
 -- | Actions to queue up on the index worker thread
 -- The inner `(HieDb -> IO ()) -> IO ()` wraps `HieDb -> IO ()`
 -- with (currently) retry functionality
-type IndexQueue = TQueue (((HieDb -> IO ()) -> IO ()) -> IO ())
+type IndexQueue = TaskQueue (((HieDb -> IO ()) -> IO ()) -> IO ())
+type RestartQueue = TaskQueue (IO ())
+type LoaderQueue = TaskQueue (IO ())
+
 
 data ThreadQueue = ThreadQueue {
     tIndexQueue     :: IndexQueue
-    , tRestartQueue :: TQueue (IO ())
-    , tLoaderQueue  :: TQueue (IO ())
+    , tRestartQueue :: RestartQueue
+    , tLoaderQueue  :: LoaderQueue
 }
 
 -- Note [Semantic Tokens Cache Location]
@@ -330,9 +333,9 @@ data ShakeExtras = ShakeExtras
       -- ^ Default HLS config, only relevant if the client does not provide any Config
     , dirtyKeys :: TVar KeySet
       -- ^ Set of dirty rule keys since the last Shake run
-    , restartQueue :: TQueue (IO ())
+    , restartQueue :: RestartQueue
       -- ^ Queue of restart actions to be run.
-    , loaderQueue :: TQueue (IO ())
+    , loaderQueue :: LoaderQueue
       -- ^ Queue of loader actions to be run.
     }
 
diff --git a/ghcide/src/Development/IDE/Core/WorkerThread.hs b/ghcide/src/Development/IDE/Core/WorkerThread.hs
index 6d141c7ef3..1c55d21c99 100644
--- a/ghcide/src/Development/IDE/Core/WorkerThread.hs
+++ b/ghcide/src/Development/IDE/Core/WorkerThread.hs
@@ -7,18 +7,38 @@ Description : This module provides an API for managing worker threads in the IDE
 see Note [Serializing runs in separate thread]
 -}
 module Development.IDE.Core.WorkerThread
-    (withWorkerQueue, awaitRunInThread)
- where
+  ( LogWorkerThread (..),
+    withWorkerQueue,
+    awaitRunInThread,
+    TaskQueue,
+    writeTaskQueue,
+    withWorkerQueueSimple
+  )
+where
 
-import           Control.Concurrent.Async  (AsyncCancelled (AsyncCancelled),
-                                            withAsync)
+import           Control.Concurrent.Async  (withAsync)
 import           Control.Concurrent.STM
 import           Control.Concurrent.Strict (newBarrier, signalBarrier,
                                             waitBarrier)
-import           Control.Exception.Safe    (Exception (fromException),
-                                            SomeException, throwIO, try)
-import           Control.Monad             (forever)
+import           Control.Exception.Safe    (SomeException, finally, throwIO,
+                                            try)
 import           Control.Monad.Cont        (ContT (ContT))
+import qualified Data.Text                 as T
+import           Ide.Logger
+
+data LogWorkerThread
+  = LogThreadEnding !T.Text
+  | LogThreadEnded !T.Text
+  | LogSingleWorkStarting !T.Text
+  | LogSingleWorkEnded !T.Text
+  deriving (Show)
+
+instance Pretty LogWorkerThread where
+  pretty = \case
+    LogThreadEnding t -> "Worker thread ending:" <+> pretty t
+    LogThreadEnded t -> "Worker thread ended:" <+> pretty t
+    LogSingleWorkStarting t -> "Worker starting a unit of work: " <+> pretty t
+    LogSingleWorkEnded t -> "Worker ended a unit of work: " <+> pretty t
 
 {-
 Note [Serializing runs in separate thread]
@@ -30,30 +50,71 @@ Like the db writes, session loading in session loader, shake session restarts.
 Originally we used various ways to implement this, but it was hard to maintain and error prone.
 Moreover, we can not stop these threads uniformly when we are shutting down the server.
 -}
+data TaskQueue a = TaskQueue (TQueue a)
+newTaskQueueIO :: IO (TaskQueue a)
+newTaskQueueIO = TaskQueue <$> newTQueueIO
+data ExitOrTask t = Exit | Task t
 
 -- | 'withWorkerQueue' creates a new 'TQueue', and launches a worker
 -- thread which polls the queue for requests and runs the given worker
 -- function on them.
-withWorkerQueue :: (t -> IO a) -> ContT () IO (TQueue t)
-withWorkerQueue workerAction = ContT $ \mainAction -> do
-    q <- newTQueueIO
-    withAsync (writerThread q) $ \_ -> mainAction q
-    where
-        writerThread q =
-            forever $ do
-                l <- atomically $ readTQueue q
-                workerAction l
+withWorkerQueueSimple :: Recorder (WithPriority LogWorkerThread) -> T.Text -> ContT () IO (TaskQueue (IO ()))
+withWorkerQueueSimple log title = withWorkerQueue log title id
+withWorkerQueue :: Recorder (WithPriority LogWorkerThread) -> T.Text -> (t -> IO ()) -> ContT () IO (TaskQueue t)
+withWorkerQueue log title workerAction = ContT $ \mainAction -> do
+  q <- newTaskQueueIO
+  -- Use a TMVar as a stop flag to coordinate graceful shutdown.
+  -- The worker thread checks this flag before dequeuing each job; if set, it exits immediately,
+  -- ensuring that no new work is started after shutdown is requested.
+  -- This mechanism is necessary because some downstream code may swallow async exceptions,
+  -- making 'cancel' unreliable for stopping the thread in all cases.
+  -- If 'cancel' does interrupt the thread (e.g., while blocked in STM or in a cooperative job),
+  -- the thread exits immediately and never checks the TMVar; in such cases, the stop flag is redundant.
+  b <- newEmptyTMVarIO
+  withAsync (writerThread q b) $ \_ -> do
+    mainAction q
+    -- if we want to debug the exact location the worker swallows an async exception, we can
+    -- temporarily comment out the `finally` clause.
+        `finally` atomically (putTMVar b ())
+    logWith log Debug (LogThreadEnding title)
+  logWith log Debug (LogThreadEnded title)
+  where
+    -- writerThread :: TaskQueue t -> TMVar () -> (forall a. IO a -> IO a) -> IO ()
+    writerThread q b =
+      -- See above: check stop flag before dequeuing, exit if set, otherwise run next job.
+      do
+        task <- atomically $ do
+          task <- tryReadTaskQueue q
+          isEm <- isEmptyTMVar b
+          case (isEm, task) of
+            (False, _)   -> return Exit -- stop flag set, exit
+            (_, Just t)  -> return $ Task t -- got a task, run it
+            (_, Nothing) -> retry -- no task, wait
+        case task of
+          Exit -> return ()
+          Task t -> do
+                logWith log Debug $ LogSingleWorkStarting title
+                workerAction t
+                logWith log Debug $ LogSingleWorkEnded title
+                writerThread q b
+
 
 -- | 'awaitRunInThread' queues up an 'IO' action to be run by a worker thread,
 -- and then blocks until the result is computed. If the action throws an
 -- non-async exception, it is rethrown in the calling thread.
-awaitRunInThread :: TQueue (IO ()) -> IO result -> IO result
-awaitRunInThread q act = do
-    -- Take an action from TQueue, run it and
-    -- use barrier to wait for the result
-    barrier <- newBarrier
-    atomically $ writeTQueue q $ try act >>= signalBarrier barrier
-    resultOrException <- waitBarrier barrier
-    case resultOrException of
-        Left e  -> throwIO (e :: SomeException)
-        Right r -> return r
+awaitRunInThread :: TaskQueue (IO ()) -> IO result -> IO result
+awaitRunInThread (TaskQueue q) act = do
+  -- Take an action from TQueue, run it and
+  -- use barrier to wait for the result
+  barrier <- newBarrier
+  atomically $ writeTQueue q (try act >>= signalBarrier barrier)
+  resultOrException <- waitBarrier barrier
+  case resultOrException of
+    Left e  -> throwIO (e :: SomeException)
+    Right r -> return r
+
+writeTaskQueue :: TaskQueue a -> a -> STM ()
+writeTaskQueue (TaskQueue q) = writeTQueue q
+
+tryReadTaskQueue :: TaskQueue a -> STM (Maybe a)
+tryReadTaskQueue (TaskQueue q) = tryReadTQueue q
diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs
index fb051bda5a..b76c8447f4 100644
--- a/ghcide/src/Development/IDE/GHC/Util.hs
+++ b/ghcide/src/Development/IDE/GHC/Util.hs
@@ -63,6 +63,7 @@ import           GHC.IO.Handle.Types
 import           Ide.PluginUtils                   (unescape)
 import           System.FilePath
 
+import qualified Control.Monad.Catch               as MC
 import           Data.Monoid                       (First (..))
 import           GHC.Data.EnumSet
 import           GHC.Data.FastString
@@ -130,6 +131,7 @@ runGhcEnv :: HscEnv -> Ghc a -> IO (HscEnv, a)
 runGhcEnv env act = do
     hsc_env <- initTempFs env
     ref <- newIORef hsc_env
+    -- we mask_ here because asynchronous exceptions might be swallowed
     res <- unGhc (withCleanupSession act) (Session ref)
     (,res) <$> readIORef ref
 
diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
index 4d6741c84f..d5d28ffaca 100644
--- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs
+++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
@@ -46,7 +46,7 @@ import           Development.IDE.Core.IdeConfiguration
 import           Development.IDE.Core.Service          (shutdown)
 import           Development.IDE.Core.Shake            hiding (Log)
 import           Development.IDE.Core.Tracing
-import           Development.IDE.Core.WorkerThread     (withWorkerQueue)
+import           Development.IDE.Core.WorkerThread
 import qualified Development.IDE.Session               as Session
 import           Development.IDE.Types.Shake           (WithHieDb,
                                                         WithHieDbShield (..))
@@ -293,11 +293,10 @@ handleInit initParams env (TRequestMessage _ _ m params) = otTracedHandler "Init
 
     let handleServerExceptionOrShutDown me = do
             -- shutdown shake
-            readMVar ideMVar >>= \case
-                ide -> shutdown ide
+            tryReadMVar ideMVar >>= mapM_ shutdown
             case me of
                 Left e -> do
-                    lifetimeConfirm "due to exception in reactor thread or shutdown message"
+                    lifetimeConfirm "due to exception in reactor thread"
                     logWith recorder Error $ LogReactorThreadException e
                     ctxForceShutdown initParams
                 _ -> do
@@ -339,8 +338,6 @@ handleInit initParams env (TRequestMessage _ _ m params) = otTracedHandler "Init
                     case msg of
                         ReactorNotification act -> handle exceptionInHandler act
                         ReactorRequest _id act k -> void $ async $ checkCancelled _id act k
-                logWith recorder Info $ LogReactorThreadStopped 1
-            logWith recorder Info $ LogReactorThreadStopped 2
 
     ide <- readMVar ideMVar
     registerIdeConfiguration (shakeExtras ide) initConfig
@@ -352,9 +349,9 @@ handleInit initParams env (TRequestMessage _ _ m params) = otTracedHandler "Init
 -- see Note [Serializing runs in separate thread]
 runWithWorkerThreads :: Recorder (WithPriority Session.Log) -> FilePath -> (WithHieDb -> ThreadQueue -> IO ()) -> IO ()
 runWithWorkerThreads recorder dbLoc f = evalContT $ do
-            sessionRestartTQueue <- withWorkerQueue id
-            sessionLoaderTQueue <- withWorkerQueue id
             (WithHieDbShield hiedb, threadQueue) <- runWithDb recorder dbLoc
+            sessionRestartTQueue <- withWorkerQueueSimple (cmapWithPrio Session.LogSessionWorkerThread recorder) "RestartTQueue"
+            sessionLoaderTQueue <- withWorkerQueueSimple (cmapWithPrio Session.LogSessionWorkerThread recorder) "SessionLoaderTQueue"
             liftIO $ f hiedb (ThreadQueue threadQueue sessionRestartTQueue sessionLoaderTQueue)
 
 -- | Runs the action until it ends or until the given MVar is put.
diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs
index dd76ed06b0..36a10ea711 100644
--- a/hls-test-utils/src/Test/Hls.hs
+++ b/hls-test-utils/src/Test/Hls.hs
@@ -29,6 +29,7 @@ module Test.Hls
     goldenWithCabalDocFormatter,
     goldenWithCabalDocFormatterInTmpDir,
     goldenWithTestConfig,
+    hlsHelperTestRecorder,
     def,
     -- * Running HLS for integration tests
     runSessionWithServer,

From 8c50e74bc9725a819605da6c2566dc90c5081e76 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Tue, 26 Aug 2025 21:59:40 +0800
Subject: [PATCH 25/61] restore

---
 ghcide-test/exe/ExceptionTests.hs | 19 ++++---------------
 1 file changed, 4 insertions(+), 15 deletions(-)

diff --git a/ghcide-test/exe/ExceptionTests.hs b/ghcide-test/exe/ExceptionTests.hs
index ed7c1f909d..a95f91e97c 100644
--- a/ghcide-test/exe/ExceptionTests.hs
+++ b/ghcide-test/exe/ExceptionTests.hs
@@ -13,9 +13,8 @@ import           Development.IDE.Core.Shake        (IdeState (..))
 import qualified Development.IDE.LSP.Notifications as Notifications
 import           Development.IDE.Plugin.HLS        (toResponseError)
 import           GHC.Base                          (coerce)
-import           Ide.Logger                        (Priority (Debug), Recorder,
-                                                    WithPriority, cmapWithPrio,
-                                                    logWith)
+import           Ide.Logger                        (Recorder, WithPriority,
+                                                    cmapWithPrio)
 import           Ide.Plugin.Error
 import           Ide.Plugin.HandleRequestTypes     (RejectionReason (DisabledGlobally))
 import           Ide.PluginUtils                   (pluginDescToIdePlugins)
@@ -29,9 +28,7 @@ import           Language.LSP.Protocol.Types       hiding
                                                     mkRange)
 import           Language.LSP.Test
 import           LogType                           (Log (..))
-import           System.Time.Extra                 (sleep)
 import           Test.Hls                          (TestConfig (testDisableDefaultPlugin, testPluginDescriptor),
-                                                    hlsHelperTestRecorder,
                                                     runSessionWithTestConfig,
                                                     testCheckProject,
                                                     waitForProgressDone)
@@ -102,21 +99,13 @@ tests = do
                           ]
                         }] ++ [Notifications.descriptor (cmapWithPrio LogNotifications r) "ghcide-core"]
           runSessionWithTestConfig def {testPluginDescriptor = plugins, testDisableDefaultPlugin=True, testCheckProject=False} $ const $ do
-              testRecorder :: Recorder (WithPriority [Char]) <- liftIO hlsHelperTestRecorder
               doc <- createDoc "A.hs" "haskell" "module A where"
-              logWith testRecorder Debug "notification-exception 0"
-            --   waitForProgressDone
-              liftIO $ sleep 0.14
-              logWith testRecorder Debug "notification-exception 1"
-            --   liftIO $
-            --   liftIO $ threadDelay 100
+              waitForProgressDone
               (view L.result -> lens) <- request SMethod_TextDocumentCodeLens (CodeLensParams Nothing Nothing doc)
-              logWith testRecorder Debug "notification-exception 2"
               case lens of
-                Right (InL []) -> do
+                Right (InL []) ->
                   -- We don't get error responses from notification handlers, so
                   -- we can only make sure that the server is still responding
-                  logWith testRecorder Debug "notification-exception success"
                   pure ()
                 _ -> liftIO $ assertFailure $ "We should have had an empty list" <> show lens]
 

From 54e334b9eba999808faa2c6cbd38662ff6dfc355 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Tue, 26 Aug 2025 22:04:52 +0800
Subject: [PATCH 26/61] restore

---
 ghcide/src/Development/IDE/GHC/Util.hs | 2 --
 1 file changed, 2 deletions(-)

diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs
index b76c8447f4..fb051bda5a 100644
--- a/ghcide/src/Development/IDE/GHC/Util.hs
+++ b/ghcide/src/Development/IDE/GHC/Util.hs
@@ -63,7 +63,6 @@ import           GHC.IO.Handle.Types
 import           Ide.PluginUtils                   (unescape)
 import           System.FilePath
 
-import qualified Control.Monad.Catch               as MC
 import           Data.Monoid                       (First (..))
 import           GHC.Data.EnumSet
 import           GHC.Data.FastString
@@ -131,7 +130,6 @@ runGhcEnv :: HscEnv -> Ghc a -> IO (HscEnv, a)
 runGhcEnv env act = do
     hsc_env <- initTempFs env
     ref <- newIORef hsc_env
-    -- we mask_ here because asynchronous exceptions might be swallowed
     res <- unGhc (withCleanupSession act) (Session ref)
     (,res) <$> readIORef ref
 

From d1b6d55bf983cbe024aa7b009b190763a2a8c80a Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Tue, 26 Aug 2025 22:34:53 +0800
Subject: [PATCH 27/61] update CI

---
 .github/workflows/flakiness.yml | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/.github/workflows/flakiness.yml b/.github/workflows/flakiness.yml
index 0937d53a02..dd0d1c196b 100644
--- a/.github/workflows/flakiness.yml
+++ b/.github/workflows/flakiness.yml
@@ -43,7 +43,7 @@ on:
       pattern_file:
         description: 'Path to a file with one Tasty pattern per line (overrides test_patterns)'
         required: false
-        default: 'flaky-test-patterns.txt'
+        default: 'scripts/flaky-test-patterns.txt'
 
 jobs:
   loop:
@@ -70,6 +70,9 @@ jobs:
         run: |
           cabal --version
           ghc --version
+      - name: build ghcide-tests
+        run: |
+          cabal build ghcide-tests
 
       - name: Run flakiness loop
         id: run-loop
@@ -81,6 +84,7 @@ jobs:
           LOG_STDERR: '1'
           TEST_PATTERNS: ${{ github.event.inputs.test_patterns }}
           PATTERN_FILE: ${{ github.event.inputs.pattern_file }}
+          NO_BUILD_ONCE: '1'
         run: |
           # Run with a sensible default of 1000 iterations on PRs;
           max_iter="${{ github.event.inputs.max_iter }}"
@@ -88,8 +92,8 @@ jobs:
           bash scripts/flaky-test-loop.sh "${max_iter}"
           ec=$?
           # Interpret exit codes from flaky-test-loop.sh
-          #   1 => issue reproduced (broken pipe or test failure) -> fail job
           #   0 => no issues reproduced within MAX_ITER          -> pass job
+          #   1 => issue reproduced (broken pipe or test failure) -> fail job
           #   2+ => setup/infra error                            -> fail job
           if [[ $ec -eq 1 ]]; then
             echo "Issue reproduced (broken pipe or test failure): failing job"

From 53a616224a70bd70dbd676e590ffbb7c09eee08a Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Wed, 27 Aug 2025 00:12:45 +0800
Subject: [PATCH 28/61] update test

---
 scripts/flaky-test-loop.sh      | 115 ++++++++++++++++++++------------
 scripts/flaky-test-patterns.txt |   6 +-
 2 files changed, 77 insertions(+), 44 deletions(-)

diff --git a/scripts/flaky-test-loop.sh b/scripts/flaky-test-loop.sh
index 17457654bc..f5b6e0f8fd 100755
--- a/scripts/flaky-test-loop.sh
+++ b/scripts/flaky-test-loop.sh
@@ -12,11 +12,18 @@
 #   NO_BUILD_ONCE : set to non-empty to skip the initial cabal build step
 #
 # Test selection:
-#   TEST_PATTERNS : comma-separated list of tasty patterns to run each iteration.
-#                   Example: TEST_PATTERNS='open close,bidirectional module dependency with hs-boot'
+#   TEST_PATTERNS : comma-separated list of entries to run each iteration.
+#                   Each entry can be either a plain tasty pattern, or 'BIN::PATTERN' to select a test binary.
+#                   Examples:
+#                     TEST_PATTERNS='open close'
+#                     TEST_PATTERNS='ghcide-tests::open close,func-test::sends indefinite progress notifications'
 #                   If set and non-empty, this takes precedence over PATTERN_FILE.
-#                   If unset, defaults to 'open close' to match prior behavior.
-#   PATTERN_FILE  : path to a file with one pattern per line (lines starting with # or blank are ignored).
+#                   If unset, defaults to 'ghcide-tests::open close' to match prior behavior.
+#   PATTERN_FILE  : path to a file with one entry per line.
+#                   Lines start with optional 'BIN::', then the tasty pattern. '#' comments and blank lines ignored.
+#                   Examples:
+#                     ghcide-tests::open close
+#                     func-test::sends indefinite progress notifications
 #                   Used only if TEST_PATTERNS is empty/unset; otherwise ignored.
 #
 # Exit codes:
@@ -54,54 +61,78 @@ BROKEN_PIPE_RE='Broken pipe'
 TEST_FAILED_RE='fail|timeout'
 DEBUG_DETECT="${DEBUG_DETECT:-0}"
 
-# Resolve which tasty patterns to run each iteration
-patterns=()
+# Resolve what to run each iteration as pairs of BIN and PATTERN
+items=() # each item is 'BIN::PATTERN'
 if [[ -n "${TEST_PATTERNS:-}" ]]; then
-  IFS=',' read -r -a patterns <<< "${TEST_PATTERNS}"
-  # trim whitespace and drop empty entries
-  tmp_patterns=()
-  for p in "${patterns[@]}"; do
-    # trim leading
-    p="${p#${p%%[![:space:]]*}}"
-    # trim trailing
-    p="${p%${p##*[![:space:]]}}"
-    [[ -z "$p" ]] && continue
-    tmp_patterns+=("$p")
+  IFS=',' read -r -a raw_items <<< "${TEST_PATTERNS}"
+  for it in "${raw_items[@]}"; do
+    # trim
+    it="${it#${it%%[![:space:]]*}}"; it="${it%${it##*[![:space:]]}}"
+    [[ -z "$it" ]] && continue
+    if [[ "$it" == *"::"* ]]; then
+      items+=("$it")
+    else
+      items+=("ghcide-tests::${it}")
+    fi
   done
-  patterns=("${tmp_patterns[@]}")
 elif [[ -n "${PATTERN_FILE:-}" && -r "${PATTERN_FILE}" ]]; then
   while IFS= read -r line; do
     # trim whitespace, skip comments and blank lines
-    trimmed="${line#${line%%[![:space:]]*}}"
-    trimmed="${trimmed%${trimmed##*[![:space:]]}}"
+    trimmed="${line#${line%%[![:space:]]*}}"; trimmed="${trimmed%${trimmed##*[![:space:]]}}"
     [[ -z "${trimmed}" || "${trimmed}" =~ ^[[:space:]]*# ]] && continue
-    patterns+=("${trimmed}")
+    if [[ "${trimmed}" == *"::"* ]]; then
+      items+=("${trimmed}")
+    else
+      items+=("ghcide-tests::${trimmed}")
+    fi
   done < "${PATTERN_FILE}"
 else
   # default to the original single test
-  patterns+=("open close")
+  items+=("ghcide-tests::open close")
 fi
 
-if [[ ${#patterns[@]} -eq 0 ]]; then
-  echo "[loop][error] No test patterns provided (via PATTERN_FILE or TEST_PATTERNS)." >&2
+if [[ ${#items[@]} -eq 0 ]]; then
+  echo "[loop][error] No test entries provided (via PATTERN_FILE or TEST_PATTERNS)." >&2
   exit 2
 fi
 
-if [[ -z "${NO_BUILD_ONCE:-}" ]]; then
-  echo "[loop] Building test target ghcide-tests once upfront" >&2
-  cabal build ghcide-tests >&2
-fi
-
-# Locate the built test binary (simple heuristic similar to run_progress_test.sh)
-if [[ -z "${TEST_BIN:-}" ]]; then
-  TEST_BIN=$(find dist-newstyle -type f -name ghcide-tests -perm -111 2>/dev/null | head -n1 || true)
+# Build required test binaries once upfront (unless NO_BUILD_ONCE is set or TEST_BIN overrides)
+if [[ -z "${NO_BUILD_ONCE:-}" && -z "${TEST_BIN:-}" ]]; then
+  # collect unique BIN names
+  declare -a bins_to_build=()
+  for it in "${items[@]}"; do
+    bin="${it%%::*}"; seen=0
+    if (( ${#bins_to_build[@]} > 0 )); then
+      for b in "${bins_to_build[@]}"; do [[ "$b" == "$bin" ]] && seen=1 && break; done
+    fi
+    [[ $seen -eq 0 ]] && bins_to_build+=("$bin")
+  done
+  if (( ${#bins_to_build[@]} > 0 )); then
+    echo "[loop] Building test targets once upfront: ${bins_to_build[*]}" >&2
+    cabal build "${bins_to_build[@]}" >&2 || true
+  fi
 fi
 
-if [[ -z "${TEST_BIN}" || ! -x "${TEST_BIN}" ]]; then
-  echo "[loop][error] Could not locate executable test binary 'ghcide-tests'. Set TEST_BIN explicitly or ensure build succeeded." >&2
-  exit 2
-fi
-echo "[loop] Using test binary: ${TEST_BIN}" >&2
+# Resolve binary path by name (cache results)
+BIN_NAMES=()
+BIN_PATHS=()
+get_bin_path() {
+  local name="$1"
+  local i
+  for ((i=0; i<${#BIN_NAMES[@]}; i++)); do
+    if [[ "${BIN_NAMES[i]}" == "$name" ]]; then
+      echo "${BIN_PATHS[i]}"; return
+    fi
+  done
+  local path=""
+  if [[ -n "${TEST_BIN:-}" ]]; then
+    path="${TEST_BIN}"
+  else
+    path=$(find dist-newstyle -type f -name "$name" -perm -111 2>/dev/null | head -n1 || true)
+  fi
+  BIN_NAMES+=("$name"); BIN_PATHS+=("$path")
+  echo "$path"
+}
 
 while true; do
   iter=$((iter+1))
@@ -109,10 +140,12 @@ while true; do
   file_num=$((iter % 100))
   if [[ ${file_num} -eq 0 ]]; then file_num=100; fi
 
-  # Run each selected pattern in this iteration
-  for pattern in "${patterns[@]}"; do
+  # Run each selected item (BIN::PATTERN) in this iteration
+  for item in "${items[@]}"; do
+    bin_name="${item%%::*}"
+    pattern="${item#*::}"
     # sanitize pattern for a log slug
-    slug=$(printf '%s' "${pattern}" | tr -cs 'A-Za-z0-9._-' '-' | sed -E 's/^-+|-+$//g')
+    slug=$(printf '%s' "${bin_name}-${pattern}" | tr -cs 'A-Za-z0-9._-' '-' | sed -E 's/^-+|-+$//g')
     [[ -z "${slug}" ]] && slug="pattern"
     log="test-logs/${slug}-loop-${file_num}.log"
 
@@ -127,8 +160,8 @@ while true; do
     HLS_TEST_LOG_STDERR="${LOG_STDERR}" \
     HLS_TEST_HARNESS_STDERR="${LOG_STDERR}" \
     TASTY_NUM_THREADS=1 \
-    TASTY_PATTERN="${pattern}" \
-    "${TEST_BIN}" >"${log}" 2>&1
+  TASTY_PATTERN="${pattern}" \
+  "$(get_bin_path "${bin_name}")" >"${log}" 2>&1
     set -e
 
   if grep -aFiq -- "${BROKEN_PIPE_RE}" "${log}"; then
diff --git a/scripts/flaky-test-patterns.txt b/scripts/flaky-test-patterns.txt
index 3e53620a6b..837bdbe8bd 100644
--- a/scripts/flaky-test-patterns.txt
+++ b/scripts/flaky-test-patterns.txt
@@ -1,13 +1,13 @@
 # One tasty pattern per line. Lines starting with # are comments.
 # Blank lines are ignored.
 
-open close
+# open close
 # non local variable
-Notification Handlers
+# Notification Handlers
 # bidirectional module dependency with hs-boot
 
 # InternalError over InvalidParams
 # ghcide restarts shake session on config changes:
 # addDependentFile
 # Another interesting one you can try:
-# sends indefinite progress notifications
+func-test::sends indefinite progress notifications

From a26922c5a74aba7b66fe68f86596cb10008d92a9 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Wed, 27 Aug 2025 00:13:04 +0800
Subject: [PATCH 29/61] Remove comment markers from flaky test patterns for
 clarity

---
 scripts/flaky-test-patterns.txt | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/scripts/flaky-test-patterns.txt b/scripts/flaky-test-patterns.txt
index 837bdbe8bd..4651c1ad1f 100644
--- a/scripts/flaky-test-patterns.txt
+++ b/scripts/flaky-test-patterns.txt
@@ -1,13 +1,13 @@
 # One tasty pattern per line. Lines starting with # are comments.
 # Blank lines are ignored.
 
-# open close
+open close
 # non local variable
-# Notification Handlers
+Notification Handlers
 # bidirectional module dependency with hs-boot
 
 # InternalError over InvalidParams
 # ghcide restarts shake session on config changes:
-# addDependentFile
+addDependentFile
 # Another interesting one you can try:
-func-test::sends indefinite progress notifications
+# func-test::sends indefinite progress notifications

From d10cf477c5560ab5da2fac67db683b948cc852de Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Wed, 27 Aug 2025 02:13:51 +0800
Subject: [PATCH 30/61] Remove pattern_file input and use default pattern file
 for flakiness test

---
 .github/workflows/flakiness.yml | 6 +-----
 1 file changed, 1 insertion(+), 5 deletions(-)

diff --git a/.github/workflows/flakiness.yml b/.github/workflows/flakiness.yml
index dd0d1c196b..6f9d9f432d 100644
--- a/.github/workflows/flakiness.yml
+++ b/.github/workflows/flakiness.yml
@@ -40,10 +40,6 @@ on:
         description: 'Comma-separated Tasty patterns to run each iteration (overrides default)'
         required: false
         default: ''
-      pattern_file:
-        description: 'Path to a file with one Tasty pattern per line (overrides test_patterns)'
-        required: false
-        default: 'scripts/flaky-test-patterns.txt'
 
 jobs:
   loop:
@@ -83,7 +79,7 @@ jobs:
           SLEEP_SECS: ${{ github.event.inputs.sleep_secs || '0' }}
           LOG_STDERR: '1'
           TEST_PATTERNS: ${{ github.event.inputs.test_patterns }}
-          PATTERN_FILE: ${{ github.event.inputs.pattern_file }}
+          PATTERN_FILE: 'scripts/flaky-test-patterns.txt'
           NO_BUILD_ONCE: '1'
         run: |
           # Run with a sensible default of 1000 iterations on PRs;

From b36f8a68317e77a63fc5faa83bcad12a47fd9061 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Wed, 27 Aug 2025 04:21:15 +0800
Subject: [PATCH 31/61] Replace writeFile and writeFileUTF8 with
 atomicFileWriteString and atomicFileWriteStringUTF8 for safer file operations

---
 ghcide-test/exe/CradleTests.hs            | 11 +++++----
 ghcide-test/exe/DependentFileTest.hs      |  5 ++--
 ghcide-test/exe/DiagnosticTests.hs        |  4 ++--
 ghcide-test/exe/GarbageCollectionTests.hs | 11 +++++----
 ghcide-test/exe/IfaceTests.hs             |  3 ++-
 ghcide-test/exe/PluginSimpleTests.hs      |  3 ++-
 ghcide-test/exe/UnitTests.hs              |  5 ++--
 ghcide-test/exe/WatchedFileTests.hs       | 12 +++++-----
 hls-test-utils/src/Test/Hls/FileSystem.hs | 28 +++++++++++++++++++++++
 9 files changed, 58 insertions(+), 24 deletions(-)

diff --git a/ghcide-test/exe/CradleTests.hs b/ghcide-test/exe/CradleTests.hs
index d79b90c835..8edb258257 100644
--- a/ghcide-test/exe/CradleTests.hs
+++ b/ghcide-test/exe/CradleTests.hs
@@ -29,6 +29,7 @@ import           Language.LSP.Protocol.Types     hiding
 import           Language.LSP.Test
 import           System.FilePath
 import           System.IO.Extra                 hiding (withTempDir)
+import           Test.Hls.FileSystem
 import           Test.Hls.Util                   (EnvSpec (..), OS (..),
                                                   ignoreInEnv)
 import           Test.Tasty
@@ -53,7 +54,7 @@ loadCradleOnlyonce = testGroup "load cradle only once"
     ]
     where
         direct dir = do
-            liftIO $ writeFileUTF8 (dir </> "hie.yaml")
+            liftIO $ atomicFileWriteStringUTF8 (dir </> "hie.yaml")
                 "cradle: {direct: {arguments: []}}"
             test dir
         implicit dir = test dir
@@ -73,7 +74,7 @@ retryFailedCradle = testWithDummyPluginEmpty' "retry failed" $ \dir -> do
   -- The false cradle always fails
   let hieContents = "cradle: {bios: {shell: \"false\"}}"
       hiePath = dir </> "hie.yaml"
-  liftIO $ writeFile hiePath hieContents
+  liftIO $ atomicFileWriteString hiePath hieContents
   let aPath = dir </> "A.hs"
   doc <- createDoc aPath "haskell" "main = return ()"
   WaitForIdeRuleResult {..} <- waitForAction "TypeCheck" doc
@@ -81,7 +82,7 @@ retryFailedCradle = testWithDummyPluginEmpty' "retry failed" $ \dir -> do
 
   -- Fix the cradle and typecheck again
   let validCradle = "cradle: {bios: {shell: \"echo A.hs\"}}"
-  liftIO $ writeFileUTF8 hiePath $ T.unpack validCradle
+  liftIO $ atomicFileWriteStringUTF8 hiePath $ T.unpack validCradle
   sendNotification SMethod_WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams
          [FileEvent (filePathToUri $ dir </> "hie.yaml") FileChangeType_Changed ]
 
@@ -214,7 +215,7 @@ sessionDepsArePickedUp = testWithDummyPluginEmpty'
   "session-deps-are-picked-up"
   $ \dir -> do
     liftIO $
-      writeFileUTF8
+      atomicFileWriteStringUTF8
         (dir </> "hie.yaml")
         "cradle: {direct: {arguments: []}}"
     -- Open without OverloadedStrings and expect an error.
@@ -223,7 +224,7 @@ sessionDepsArePickedUp = testWithDummyPluginEmpty'
 
     -- Update hie.yaml to enable OverloadedStrings.
     liftIO $
-      writeFileUTF8
+      atomicFileWriteStringUTF8
         (dir </> "hie.yaml")
         "cradle: {direct: {arguments: [-XOverloadedStrings]}}"
     sendNotification SMethod_WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams
diff --git a/ghcide-test/exe/DependentFileTest.hs b/ghcide-test/exe/DependentFileTest.hs
index 1f243819e3..dd2cb2a046 100644
--- a/ghcide-test/exe/DependentFileTest.hs
+++ b/ghcide-test/exe/DependentFileTest.hs
@@ -15,6 +15,7 @@ import           Language.LSP.Protocol.Types    hiding
                                                  mkRange)
 import           Language.LSP.Test
 import           Test.Hls
+import           Test.Hls.FileSystem
 
 
 tests :: TestTree
@@ -31,7 +32,7 @@ tests = testGroup "addDependentFile"
         -- If the file contains B then no type error
         -- otherwise type error
         let depFilePath = "dep-file.txt"
-        liftIO $ writeFile depFilePath "A"
+        liftIO $ atomicFileWriteString depFilePath "A"
         let fooContent = T.unlines
               [ "{-# LANGUAGE TemplateHaskell #-}"
               , "module Foo where"
@@ -48,7 +49,7 @@ tests = testGroup "addDependentFile"
         expectDiagnostics
             [("Foo.hs", [(DiagnosticSeverity_Error, (4,11), "Couldn't match type", Just "GHC-83865")])]
         -- Now modify the dependent file
-        liftIO $ writeFile depFilePath "B"
+        liftIO $ atomicFileWriteString depFilePath "B"
         sendNotification SMethod_WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams
             [FileEvent (filePathToUri depFilePath) FileChangeType_Changed ]
 
diff --git a/ghcide-test/exe/DiagnosticTests.hs b/ghcide-test/exe/DiagnosticTests.hs
index 52aba0b9b7..861b6723c7 100644
--- a/ghcide-test/exe/DiagnosticTests.hs
+++ b/ghcide-test/exe/DiagnosticTests.hs
@@ -39,7 +39,7 @@ import           System.Time.Extra
 import           Test.Hls                        (TestConfig (testConfigCaps, testDirLocation, testDisableKick, testPluginDescriptor),
                                                   runSessionWithTestConfig,
                                                   waitForProgressBegin)
-import           Test.Hls.FileSystem             (directCradle, file, text)
+import           Test.Hls.FileSystem
 import           Test.Tasty
 import           Test.Tasty.HUnit
 
@@ -383,7 +383,7 @@ tests = testGroup "diagnostics"
               let (drive, suffix) = splitDrive pathB
               in filePathToUri (joinDrive (lower drive) suffix)
           liftIO $ createDirectoryIfMissing True (takeDirectory pathB)
-          liftIO $ writeFileUTF8 pathB $ T.unpack bContent
+          liftIO $ atomicFileWriteStringUTF8 pathB $ T.unpack bContent
           uriA <- getDocUri "A/A.hs"
           Just pathA <- pure $ uriToFilePath uriA
           uriA <- pure $
diff --git a/ghcide-test/exe/GarbageCollectionTests.hs b/ghcide-test/exe/GarbageCollectionTests.hs
index 5cc9935352..1a867ad747 100644
--- a/ghcide-test/exe/GarbageCollectionTests.hs
+++ b/ghcide-test/exe/GarbageCollectionTests.hs
@@ -12,6 +12,7 @@ import           Language.LSP.Protocol.Types hiding (SemanticTokenAbsolute (..),
                                               SemanticTokensEdit (..), mkRange)
 import           Language.LSP.Test
 import           System.FilePath
+import           Test.Hls.FileSystem
 import           Test.Tasty
 import           Test.Tasty.HUnit
 import           Text.Printf                 (printf)
@@ -20,14 +21,14 @@ tests :: TestTree
 tests = testGroup "garbage collection"
   [ testGroup "dirty keys"
         [ testWithDummyPluginEmpty' "are collected" $ \dir -> do
-            liftIO $ writeFile (dir </> "hie.yaml") "cradle: {direct: {arguments: [A]}}"
+            liftIO $ atomicFileWriteString (dir </> "hie.yaml") "cradle: {direct: {arguments: [A]}}"
             doc <- generateGarbage "A" dir
             closeDoc doc
             garbage <- waitForGC
             liftIO $ assertBool "no garbage was found" $ not $ null garbage
 
         , testWithDummyPluginEmpty' "are deleted from the state" $ \dir -> do
-            liftIO $ writeFile (dir </> "hie.yaml") "cradle: {direct: {arguments: [A]}}"
+            liftIO $ atomicFileWriteString (dir </> "hie.yaml") "cradle: {direct: {arguments: [A]}}"
             docA <- generateGarbage "A" dir
             keys0 <- getStoredKeys
             closeDoc docA
@@ -37,7 +38,7 @@ tests = testGroup "garbage collection"
             liftIO $ assertBool "keys were not deleted from the state" (length keys1 < length keys0)
 
         , testWithDummyPluginEmpty' "are not regenerated unless needed" $ \dir -> do
-            liftIO $ writeFile (dir </> "hie.yaml") "cradle: {direct: {arguments: [A.hs, B.hs]}}"
+            liftIO $ atomicFileWriteString (dir </> "hie.yaml") "cradle: {direct: {arguments: [A.hs, B.hs]}}"
             docA <- generateGarbage "A" dir
             _docB <- generateGarbage "B" dir
 
@@ -58,7 +59,7 @@ tests = testGroup "garbage collection"
             liftIO $ regeneratedKeys @?= mempty
 
         , testWithDummyPluginEmpty' "regenerate successfully" $ \dir -> do
-            liftIO $ writeFile (dir </> "hie.yaml") "cradle: {direct: {arguments: [A]}}"
+            liftIO $ atomicFileWriteString (dir </> "hie.yaml") "cradle: {direct: {arguments: [A]}}"
             docA <- generateGarbage "A" dir
             closeDoc docA
             garbage <- waitForGC
@@ -83,7 +84,7 @@ tests = testGroup "garbage collection"
         let fp = modName <> ".hs"
             body = printf "module %s where" modName
         doc <- createDoc fp "haskell" (T.pack body)
-        liftIO $ writeFile (dir </> fp) body
+        liftIO $ atomicFileWriteString (dir </> fp) body
         builds <- waitForTypecheck doc
         liftIO $ assertBool "something is wrong with this test" builds
         return doc
diff --git a/ghcide-test/exe/IfaceTests.hs b/ghcide-test/exe/IfaceTests.hs
index d7dc533550..e1e94c926d 100644
--- a/ghcide-test/exe/IfaceTests.hs
+++ b/ghcide-test/exe/IfaceTests.hs
@@ -18,6 +18,7 @@ import           Language.LSP.Test
 import           System.Directory
 import           System.FilePath
 import           System.IO.Extra               hiding (withTempDir)
+import           Test.Hls.FileSystem
 import           Test.Tasty
 import           Test.Tasty.HUnit
 
@@ -45,7 +46,7 @@ ifaceTHTest = testWithExtraFiles "iface-th-test" "TH" $ \dir -> do
     cdoc <- createDoc cPath "haskell" cSource
 
     -- Change [TH]a from () to Bool
-    liftIO $ writeFileUTF8 aPath (unlines $ init (lines $ T.unpack aSource) ++ ["th_a = [d| a = False|]"])
+    liftIO $ atomicFileWriteStringUTF8 aPath (unlines $ init (lines $ T.unpack aSource) ++ ["th_a = [d| a = False|]"])
 
     -- Check that the change propagates to C
     changeDoc cdoc [TextDocumentContentChangeEvent . InR $ TextDocumentContentChangeWholeDocument cSource]
diff --git a/ghcide-test/exe/PluginSimpleTests.hs b/ghcide-test/exe/PluginSimpleTests.hs
index c160d2461c..b15e9af749 100644
--- a/ghcide-test/exe/PluginSimpleTests.hs
+++ b/ghcide-test/exe/PluginSimpleTests.hs
@@ -9,6 +9,7 @@ import           Language.LSP.Protocol.Types hiding (SemanticTokenAbsolute (..),
                                               SemanticTokensEdit (..), mkRange)
 import           Language.LSP.Test
 import           System.FilePath
+import           Test.Hls.FileSystem
 import           Test.Tasty
 
 tests :: TestTree
@@ -36,7 +37,7 @@ tests =
   -- required by plugin-1.0.0). See the build log above for details.
   testWithExtraFiles "simple plugin"  "plugin-knownnat" $ \dir -> do
     _ <- openDoc (dir </> "KnownNat.hs") "haskell"
-    liftIO $ writeFile (dir</>"hie.yaml")
+    liftIO $ atomicFileWriteString (dir</>"hie.yaml")
       "cradle: {cabal: [{path: '.', component: 'lib:plugin'}]}"
 
     expectDiagnostics
diff --git a/ghcide-test/exe/UnitTests.hs b/ghcide-test/exe/UnitTests.hs
index b2940ab27f..dcd5c170f4 100644
--- a/ghcide-test/exe/UnitTests.hs
+++ b/ghcide-test/exe/UnitTests.hs
@@ -31,6 +31,7 @@ import           System.Mem                        (performGC)
 import           Test.Hls                          (IdeState, def,
                                                     runSessionWithServerInTmpDir,
                                                     waitForProgressDone)
+import           Test.Hls.FileSystem
 import           Test.Tasty
 import           Test.Tasty.ExpectedFailure
 import           Test.Tasty.HUnit
@@ -104,9 +105,9 @@ findResolution_us :: Int -> IO Int
 findResolution_us delay_us | delay_us >= 1000000 = error "Unable to compute timestamp resolution"
 findResolution_us delay_us = withTempFile $ \f -> withTempFile $ \f' -> do
     performGC
-    writeFile f ""
+    atomicFileWriteString f ""
     threadDelay delay_us
-    writeFile f' ""
+    atomicFileWriteString f' ""
     t <- getModTime f
     t' <- getModTime f'
     if t /= t' then return delay_us else findResolution_us (delay_us * 10)
diff --git a/ghcide-test/exe/WatchedFileTests.hs b/ghcide-test/exe/WatchedFileTests.hs
index 1c2ded9109..f00e4bfffe 100644
--- a/ghcide-test/exe/WatchedFileTests.hs
+++ b/ghcide-test/exe/WatchedFileTests.hs
@@ -29,7 +29,7 @@ tests :: TestTree
 tests = testGroup "watched files"
   [ testGroup "Subscriptions"
     [ testWithDummyPluginEmpty' "workspace files" $ \sessionDir -> do
-        liftIO $ writeFile (sessionDir </> "hie.yaml") "cradle: {direct: {arguments: [\"-isrc\", \"A\", \"WatchedFilesMissingModule\"]}}"
+        liftIO $ atomicFileWriteString (sessionDir </> "hie.yaml") "cradle: {direct: {arguments: [\"-isrc\", \"A\", \"WatchedFilesMissingModule\"]}}"
         _doc <- createDoc "A.hs" "haskell" "{-#LANGUAGE NoImplicitPrelude #-}\nmodule A where\nimport WatchedFilesMissingModule"
         setIgnoringRegistrationRequests False
         watchedFileRegs <- getWatchedFilesSubscriptionsUntil SMethod_TextDocumentPublishDiagnostics
@@ -40,7 +40,7 @@ tests = testGroup "watched files"
     , testWithDummyPluginEmpty' "non workspace file" $ \sessionDir -> do
         tmpDir <- liftIO getTemporaryDirectory
         let yaml = "cradle: {direct: {arguments: [\"-i" <> tail(init(show tmpDir)) <> "\", \"A\", \"WatchedFilesMissingModule\"]}}"
-        liftIO $ writeFile (sessionDir </> "hie.yaml") yaml
+        liftIO $ atomicFileWriteString (sessionDir </> "hie.yaml") yaml
         _doc <- createDoc "A.hs" "haskell" "{-# LANGUAGE NoImplicitPrelude#-}\nmodule A where\nimport WatchedFilesMissingModule"
         setIgnoringRegistrationRequests False
         watchedFileRegs <- getWatchedFilesSubscriptionsUntil SMethod_TextDocumentPublishDiagnostics
@@ -53,8 +53,8 @@ tests = testGroup "watched files"
   , testGroup "Changes"
     [
       testWithDummyPluginEmpty' "workspace files" $ \sessionDir -> do
-        liftIO $ writeFile (sessionDir </> "hie.yaml") "cradle: {direct: {arguments: [\"-isrc\", \"A\", \"B\"]}}"
-        liftIO $ writeFile (sessionDir </> "B.hs") $ unlines
+        liftIO $ atomicFileWriteString (sessionDir </> "hie.yaml") "cradle: {direct: {arguments: [\"-isrc\", \"A\", \"B\"]}}"
+        liftIO $ atomicFileWriteString (sessionDir </> "B.hs") $ unlines
           ["module B where"
           ,"b :: Bool"
           ,"b = False"]
@@ -66,7 +66,7 @@ tests = testGroup "watched files"
           ]
         expectDiagnostics [("A.hs", [(DiagnosticSeverity_Error, (3, 4), "Couldn't match expected type '()' with actual type 'Bool'", Just "GHC-83865")])]
         -- modify B off editor
-        liftIO $ writeFile (sessionDir </> "B.hs") $ unlines
+        liftIO $ atomicFileWriteString (sessionDir </> "B.hs") $ unlines
           ["module B where"
           ,"b :: Int"
           ,"b = 0"]
@@ -80,7 +80,7 @@ tests = testGroup "watched files"
           let cabalFile = "reload.cabal"
           cabalContent <- liftIO $ T.readFile cabalFile
           let fix = T.replace "build-depends:    base" "build-depends:    base, split"
-          liftIO $ T.writeFile cabalFile (fix cabalContent)
+          liftIO $ atomicFileWriteText cabalFile (fix cabalContent)
           sendNotification SMethod_WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams
             [ FileEvent (filePathToUri $ sessionDir </> cabalFile) FileChangeType_Changed ]
           expectDiagnostics [(hsFile, [])]
diff --git a/hls-test-utils/src/Test/Hls/FileSystem.hs b/hls-test-utils/src/Test/Hls/FileSystem.hs
index c93643badd..8a6193904f 100644
--- a/hls-test-utils/src/Test/Hls/FileSystem.hs
+++ b/hls-test-utils/src/Test/Hls/FileSystem.hs
@@ -29,8 +29,12 @@ module Test.Hls.FileSystem
   , directProjectMulti
   , simpleCabalProject
   , simpleCabalProject'
+  , atomicFileWriteString
+  , atomicFileWriteStringUTF8
+  , atomicFileWriteText
   ) where
 
+import           Control.Exception           (onException)
 import           Data.Foldable               (traverse_)
 import qualified Data.Text                   as T
 import qualified Data.Text.IO                as T
@@ -38,6 +42,7 @@ import           Development.IDE             (NormalizedFilePath)
 import           Language.LSP.Protocol.Types (toNormalizedFilePath)
 import           System.Directory
 import           System.FilePath             as FP
+import           System.IO.Extra             (newTempFileWithin, writeFileUTF8)
 import           System.Process.Extra        (readProcess)
 
 -- ----------------------------------------------------------------------------
@@ -244,3 +249,26 @@ simpleCabalProject' :: [FileTree] -> [FileTree]
 simpleCabalProject' fps =
   [ simpleCabalCradle
   ] <> fps
+
+
+-- | Also resets the interface store
+atomicFileWrite :: FilePath -> (FilePath -> IO a) -> IO a
+atomicFileWrite targetPath write = do
+  let dir = takeDirectory targetPath
+  createDirectoryIfMissing True dir
+  (tempFilePath, cleanUp) <- newTempFileWithin dir
+  (write tempFilePath >>= \x -> renameFile tempFilePath targetPath >> pure x)
+    `onException` cleanUp
+
+
+atomicFileWriteString :: FilePath -> String -> IO ()
+atomicFileWriteString targetPath content =
+  atomicFileWrite targetPath (flip writeFile content)
+
+atomicFileWriteStringUTF8 :: FilePath -> String -> IO ()
+atomicFileWriteStringUTF8 targetPath content =
+  atomicFileWrite targetPath (flip writeFileUTF8 content)
+
+atomicFileWriteText :: FilePath -> T.Text -> IO ()
+atomicFileWriteText targetPath content =
+    atomicFileWrite targetPath (flip T.writeFile content)

From 15cd44a23326ea548b3bf89e1a80eb1aa46147cb Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 29 Aug 2025 01:47:11 +0800
Subject: [PATCH 32/61] Refactor flaky test loop script for improved build
 handling and error reporting

---
 scripts/flaky-test-loop.sh | 20 ++++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)

diff --git a/scripts/flaky-test-loop.sh b/scripts/flaky-test-loop.sh
index f5b6e0f8fd..f916649ec7 100755
--- a/scripts/flaky-test-loop.sh
+++ b/scripts/flaky-test-loop.sh
@@ -1,6 +1,7 @@
 #!/usr/bin/env bash
 # Loop running HLS tasty tests until a Broken pipe or test failure is observed.
 # Originally ran only the "open close" test; now supports multiple patterns.
+# Ensures successful build before running any tests.
 # Logs each run to test-logs/<pattern-slug>-loop-<n>.log, rotating every 100 files per pattern.
 #
 # Environment you can tweak:
@@ -8,7 +9,6 @@
 #   SLEEP_SECS    : seconds to sleep between iterations (default: 0)
 #   SHOW_EVERY    : print progress/iteration header every N iterations (default: 100, 1 = every run, <=0 = disabled)
 #   LOG_STDERR    : set to 1 to enable verbose stderr logging (HLS_TEST_LOG_STDERR & HLS_TEST_HARNESS_STDERR) (default: 1)
-#   TEST_BIN      : path to the built test binary (auto-discovered if not set)
 #   NO_BUILD_ONCE : set to non-empty to skip the initial cabal build step
 #
 # Test selection:
@@ -58,7 +58,7 @@ echo "[loop] Starting at ${start_ts}" >&2
 # - Use case-insensitive extended regex for failures/timeouts in logs
 # - Broken pipe: case-insensitive fixed-string search
 BROKEN_PIPE_RE='Broken pipe'
-TEST_FAILED_RE='fail|timeout'
+TEST_FAILED_RE='failed|timeout'
 DEBUG_DETECT="${DEBUG_DETECT:-0}"
 
 # Resolve what to run each iteration as pairs of BIN and PATTERN
@@ -96,8 +96,8 @@ if [[ ${#items[@]} -eq 0 ]]; then
   exit 2
 fi
 
-# Build required test binaries once upfront (unless NO_BUILD_ONCE is set or TEST_BIN overrides)
-if [[ -z "${NO_BUILD_ONCE:-}" && -z "${TEST_BIN:-}" ]]; then
+# Build required test binaries once upfront (unless NO_BUILD_ONCE is set)
+if [[ -z "${NO_BUILD_ONCE:-}" ]]; then
   # collect unique BIN names
   declare -a bins_to_build=()
   for it in "${items[@]}"; do
@@ -109,7 +109,11 @@ if [[ -z "${NO_BUILD_ONCE:-}" && -z "${TEST_BIN:-}" ]]; then
   done
   if (( ${#bins_to_build[@]} > 0 )); then
     echo "[loop] Building test targets once upfront: ${bins_to_build[*]}" >&2
-    cabal build "${bins_to_build[@]}" >&2 || true
+    if ! cabal build "${bins_to_build[@]}" >&2; then
+      echo "[loop][error] Build failed. Cannot proceed with tests." >&2
+      exit 2
+    fi
+    echo "[loop] Build succeeded. Proceeding with tests." >&2
   fi
 fi
 
@@ -125,11 +129,7 @@ get_bin_path() {
     fi
   done
   local path=""
-  if [[ -n "${TEST_BIN:-}" ]]; then
-    path="${TEST_BIN}"
-  else
-    path=$(find dist-newstyle -type f -name "$name" -perm -111 2>/dev/null | head -n1 || true)
-  fi
+  path=$(find dist-newstyle -type f -name "$name" -perm -111 2>/dev/null | head -n1 || true)
   BIN_NAMES+=("$name"); BIN_PATHS+=("$path")
   echo "$path"
 }

From ed1c20ced349e6a08effd1dc28aa20a25086724e Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 29 Aug 2025 01:47:29 +0800
Subject: [PATCH 33/61] Update lsp

---
 cabal.project | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/cabal.project b/cabal.project
index c27665b169..412eb35676 100644
--- a/cabal.project
+++ b/cabal.project
@@ -60,5 +60,5 @@ if impl(ghc >= 9.11)
 source-repository-package
   type: git
   location: https://github.com/soulomoon/lsp.git
-  tag: b23e47622b85f2577d7cfa5c2d89eaa8965d1961
+  tag: 3cf7cebcb4d6a80c03854c5ee75d4e66b7f06bfa
   subdir: lsp lsp-types lsp-test

From 53c4536972e652dbb44b51e94454478e5d430a68 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 29 Aug 2025 01:58:15 +0800
Subject: [PATCH 34/61] format

---
 hls-test-utils/src/Test/Hls/FileSystem.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/hls-test-utils/src/Test/Hls/FileSystem.hs b/hls-test-utils/src/Test/Hls/FileSystem.hs
index 8a6193904f..e349dbad3b 100644
--- a/hls-test-utils/src/Test/Hls/FileSystem.hs
+++ b/hls-test-utils/src/Test/Hls/FileSystem.hs
@@ -251,7 +251,6 @@ simpleCabalProject' fps =
   ] <> fps
 
 
--- | Also resets the interface store
 atomicFileWrite :: FilePath -> (FilePath -> IO a) -> IO a
 atomicFileWrite targetPath write = do
   let dir = takeDirectory targetPath

From a9fa00dfa99ef9b3cd77e42c0944684fcc109e33 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 29 Aug 2025 05:32:38 +0800
Subject: [PATCH 35/61] Enhance testing workflow and progress reporting

- Update flakiness workflow to build additional test suite.
- Refactor test workflow to simplify test commands.
- Introduce TestReporting style for progress reporting in IDE options.
---
 .github/workflows/flakiness.yml               |  3 +-
 .github/workflows/test.yml                    | 64 +++++++++----------
 cabal.project                                 |  2 +-
 .../Development/IDE/Core/ProgressReporting.hs | 40 ++++++++++--
 ghcide/src/Development/IDE/Main.hs            |  8 ++-
 ghcide/src/Development/IDE/Types/Options.hs   |  1 +
 scripts/flaky-test-patterns.txt               |  2 +-
 7 files changed, 78 insertions(+), 42 deletions(-)

diff --git a/.github/workflows/flakiness.yml b/.github/workflows/flakiness.yml
index 6f9d9f432d..7d8b938133 100644
--- a/.github/workflows/flakiness.yml
+++ b/.github/workflows/flakiness.yml
@@ -66,9 +66,10 @@ jobs:
         run: |
           cabal --version
           ghc --version
-      - name: build ghcide-tests
+      - name: build tests
         run: |
           cabal build ghcide-tests
+          cabal build func-test
 
       - name: Run flakiness loop
         id: run-loop
diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml
index 984758a310..2096f84d41 100644
--- a/.github/workflows/test.yml
+++ b/.github/workflows/test.yml
@@ -114,18 +114,18 @@ jobs:
       - if: needs.pre_job.outputs.should_skip_ghcide != 'true' && matrix.test
         name: Test ghcide
         # run the tests without parallelism to avoid running out of memory
-        run: cabal test ghcide-tests || cabal test ghcide-tests
+        run: cabal test ghcide-tests
 
       - if: matrix.test
         name: Test hls-plugin-api
-        run: cabal test hls-plugin-api || cabal test hls-plugin-api
+        run: cabal test hls-plugin-api
 
       - if: matrix.test
         name: Test func-test suite
         env:
           HLS_TEST_EXE: hls
           HLS_WRAPPER_TEST_EXE: hls-wrapper
-        run: cabal test func-test || cabal test func-test
+        run: cabal test func-test
 
       - if: matrix.test
         name: Test wrapper-test suite
@@ -136,124 +136,124 @@ jobs:
 
       - if: matrix.test
         name: Test hls-refactor-plugin
-        run: cabal test hls-refactor-plugin-tests || cabal test hls-refactor-plugin-tests
+        run: cabal test hls-refactor-plugin-tests
 
       # TODO enable when it supports 9.10
       - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12'
         name: Test hls-floskell-plugin
-        run: cabal test hls-floskell-plugin-tests || cabal test hls-floskell-plugin-tests
+        run: cabal test hls-floskell-plugin-tests
 
       - if: matrix.test
         name: Test hls-class-plugin
-        run: cabal test hls-class-plugin-tests || cabal test hls-class-plugin-tests
+        run: cabal test hls-class-plugin-tests
 
       - if: matrix.test
         name: Test hls-pragmas-plugin
-        run: cabal test hls-pragmas-plugin-tests || cabal test hls-pragmas-plugin-tests
+        run: cabal test hls-pragmas-plugin-tests
 
       - if: matrix.test
         name: Test hls-eval-plugin
-        run: cabal test hls-eval-plugin-tests || cabal test hls-eval-plugin-tests
+        run: cabal test hls-eval-plugin-tests
 
       # TODO enable when it supports 9.10
       - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12'
         name: Test hls-splice-plugin
-        run: cabal test hls-splice-plugin-tests || cabal test hls-splice-plugin-tests
+        run: cabal test hls-splice-plugin-tests
 
       - if: matrix.test && matrix.ghc != '9.12'
         name: Test hls-stan-plugin
-        run: cabal test hls-stan-plugin-tests || cabal test hls-stan-plugin-tests
+        run: cabal test hls-stan-plugin-tests
 
       - if: matrix.test
         name: Test hls-stylish-haskell-plugin
-        run: cabal test hls-stylish-haskell-plugin-tests || cabal test hls-stylish-haskell-plugin-tests
+        run: cabal test hls-stylish-haskell-plugin-tests
 
       - if: matrix.test
         name: Test hls-ormolu-plugin
-        run: cabal test hls-ormolu-plugin-tests || cabal test hls-ormolu-plugin-tests
+        run: cabal test hls-ormolu-plugin-tests
 
       - if: matrix.test
         name: Test hls-fourmolu-plugin
-        run: cabal test hls-fourmolu-plugin-tests || cabal test hls-fourmolu-plugin-tests
+        run: cabal test hls-fourmolu-plugin-tests
 
       - if: matrix.test
         name: Test hls-explicit-imports-plugin test suite
-        run: cabal test hls-explicit-imports-plugin-tests || cabal test hls-explicit-imports-plugin-tests
+        run: cabal test hls-explicit-imports-plugin-tests
 
       - if: matrix.test
         name: Test hls-call-hierarchy-plugin test suite
-        run: cabal test hls-call-hierarchy-plugin-tests || cabal test hls-call-hierarchy-plugin-tests
+        run: cabal test hls-call-hierarchy-plugin-tests
 
       - if: matrix.test && matrix.os != 'windows-latest'
         name: Test hls-rename-plugin test suite
-        run: cabal test hls-rename-plugin-tests || cabal test hls-rename-plugin-tests
+        run: cabal test hls-rename-plugin-tests
 
       # TODO enable when it supports 9.10
       - if: matrix.test && matrix.ghc != '9.10'
         name: Test hls-hlint-plugin test suite
-        run: cabal test hls-hlint-plugin-tests || cabal test hls-hlint-plugin-tests
+        run: cabal test hls-hlint-plugin-tests
 
       - if: matrix.test
         name: Test hls-module-name-plugin test suite
-        run: cabal test hls-module-name-plugin-tests || cabal test hls-module-name-plugin-tests
+        run: cabal test hls-module-name-plugin-tests
 
       - if: matrix.test
         name: Test hls-alternate-number-format-plugin test suite
-        run: cabal test hls-alternate-number-format-plugin-tests || cabal test hls-alternate-number-format-plugin-tests
+        run: cabal test hls-alternate-number-format-plugin-tests
 
       - if: matrix.test
         name: Test hls-qualify-imported-names-plugin test suite
-        run: cabal test hls-qualify-imported-names-plugin-tests || cabal test hls-qualify-imported-names-plugin-tests
+        run: cabal test hls-qualify-imported-names-plugin-tests
 
       - if: matrix.test
         name: Test hls-code-range-plugin test suite
-        run: cabal test hls-code-range-plugin-tests || cabal test hls-code-range-plugin-tests
+        run: cabal test hls-code-range-plugin-tests
 
       - if: matrix.test
         name: Test hls-change-type-signature test suite
-        run: cabal test hls-change-type-signature-plugin-tests || cabal test hls-change-type-signature-plugin-tests
+        run: cabal test hls-change-type-signature-plugin-tests
 
       - if: matrix.test
         name: Test hls-gadt-plugin test suit
-        run: cabal test hls-gadt-plugin-tests || cabal test hls-gadt-plugin-tests
+        run: cabal test hls-gadt-plugin-tests
 
       - if: matrix.test
         name: Test hls-explicit-fixity-plugin test suite
-        run: cabal test hls-explicit-fixity-plugin-tests || cabal test hls-explicit-fixity-plugin-tests
+        run: cabal test hls-explicit-fixity-plugin-tests
 
       - if: matrix.test
         name: Test hls-explicit-record-fields-plugin test suite
-        run: cabal test hls-explicit-record-fields-plugin-tests || cabal test hls-explicit-record-fields-plugin-tests
+        run: cabal test hls-explicit-record-fields-plugin-tests
 
       # versions need to be limited since the tests depend on cabal-fmt which only builds with ghc <9.10
       - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12'
         name: Test hls-cabal-fmt-plugin test suite
-        run: cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests || cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests
+        run: cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests
 
       - if: matrix.test && matrix.ghc != '9.12'
         name: Test hls-cabal-gild-plugin test suite
-        run: cabal test hls-cabal-gild-plugin-tests --flag=isolateCabalGildTests || cabal test hls-cabal-gild-plugin-tests --flag=isolateCabalGildTests
+        run: cabal test hls-cabal-gild-plugin-tests --flag=isolateCabalGildTests
 
       - if: matrix.test
         name: Test hls-cabal-plugin test suite
-        run: cabal test hls-cabal-plugin-tests || cabal test hls-cabal-plugin-tests
+        run: cabal test hls-cabal-plugin-tests
 
       # TODO enable when it supports 9.10
       - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12'
         name: Test hls-retrie-plugin test suite
-        run: cabal test hls-retrie-plugin-tests || cabal test hls-retrie-plugin-tests
+        run: cabal test hls-retrie-plugin-tests
 
       - if: matrix.test
         name: Test hls-overloaded-record-dot-plugin test suite
-        run: cabal test hls-overloaded-record-dot-plugin-tests || cabal test hls-overloaded-record-dot-plugin-tests
+        run: cabal test hls-overloaded-record-dot-plugin-tests
 
       - if: matrix.test
         name: Test hls-semantic-tokens-plugin test suite
-        run: cabal test hls-semantic-tokens-plugin-tests || cabal test hls-semantic-tokens-plugin-tests
+        run: cabal test hls-semantic-tokens-plugin-tests
 
       - if: matrix.test
         name: Test hls-notes-plugin test suite
-        run: cabal test hls-notes-plugin-tests || cabal test hls-notes-plugin-tests
+        run: cabal test hls-notes-plugin-tests
 
       # The plugin tutorial is only compatible with 9.6 and 9.8.
       # No particular reason, just to avoid excessive CPP.
diff --git a/cabal.project b/cabal.project
index 412eb35676..20ea0e956f 100644
--- a/cabal.project
+++ b/cabal.project
@@ -60,5 +60,5 @@ if impl(ghc >= 9.11)
 source-repository-package
   type: git
   location: https://github.com/soulomoon/lsp.git
-  tag: 3cf7cebcb4d6a80c03854c5ee75d4e66b7f06bfa
+  tag: 52e9b0ef0c34443c84a8e79c9b3fceb6acb3e00f
   subdir: lsp lsp-types lsp-test
diff --git a/ghcide/src/Development/IDE/Core/ProgressReporting.hs b/ghcide/src/Development/IDE/Core/ProgressReporting.hs
index 3d8a2bf989..4bf4b10ab5 100644
--- a/ghcide/src/Development/IDE/Core/ProgressReporting.hs
+++ b/ghcide/src/Development/IDE/Core/ProgressReporting.hs
@@ -23,24 +23,31 @@ import           Control.Concurrent.STM         (STM)
 import           Control.Concurrent.STM.Stats   (TVar, atomically,
                                                  atomicallyNamed, modifyTVar',
                                                  newTVarIO, readTVar, retry)
-import           Control.Concurrent.Strict      (modifyVar_, newVar,
-                                                 threadDelay)
+import           Control.Concurrent.Strict      (modifyVar_, newBarrier, newVar,
+                                                 signalBarrier, threadDelay,
+                                                 waitBarrier)
 import           Control.Monad.Extra            hiding (loop)
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Class      (lift)
+import qualified Data.Aeson                     as J
 import           Data.Functor                   (($>))
 import qualified Data.Text                      as T
+import           Data.Unique                    (hashUnique, newUnique)
 import           Development.IDE.GHC.Orphans    ()
 import           Development.IDE.Types.Location
 import           Development.IDE.Types.Options
 import qualified Focus
+import           Language.LSP.Protocol.Message
 import           Language.LSP.Protocol.Types
-import           Language.LSP.Server            (ProgressAmount (..),
+import qualified Language.LSP.Protocol.Types    as L
+import           Language.LSP.Server            (MonadLsp, ProgressAmount (..),
                                                  ProgressCancellable (..),
+                                                 sendNotification, sendRequest,
                                                  withProgress)
 import qualified Language.LSP.Server            as LSP
 import qualified StmContainers.Map              as STM
 import           UnliftIO                       (Async, async, bracket, cancel)
+import qualified UnliftIO.Exception             as UE
 
 data ProgressEvent
   = ProgressNewStarted
@@ -168,7 +175,7 @@ progressReportingNoTrace todo done (Just lspEnv) title optProgressStyle = do
   let _progressUpdate event = liftIO $ updateStateVar $ Event event
       _progressStop = updateStateVar StopProgress
       updateStateVar = modifyVar_ progressState . updateState (progressCounter lspEnv title optProgressStyle todo done)
-  return ProgressReporting {..}
+  return ProgressReporting {_progressUpdate, _progressStop}
 
 -- | `progressReporting` initiates a new progress reporting session.
 -- It necessitates the active tracking of progress using the `inProgress` function.
@@ -196,6 +203,25 @@ progressReporting (Just lspEnv) title optProgressStyle = do
 
         f = recordProgress inProgress file
 
+withProgressDummy ::
+  forall c m a.
+  MonadLsp c m =>
+  T.Text ->
+  Maybe ProgressToken ->
+  ProgressCancellable ->
+  ((ProgressAmount -> m ()) -> m a) ->
+  m a
+withProgressDummy title _ _ f = do
+    t <- L.ProgressToken . L.InR . T.pack . show . hashUnique <$> liftIO newUnique
+    r <- liftIO newBarrier
+    _ <- sendRequest SMethod_WindowWorkDoneProgressCreate (WorkDoneProgressCreateParams t) $
+        \_ -> liftIO $ signalBarrier r ()
+    -- liftIO $ waitBarrier r
+    sendProgressReport t $ WorkDoneProgressBegin L.AString title Nothing Nothing Nothing
+    f (const $ return ()) `UE.finally` sendProgressReport t (WorkDoneProgressEnd L.AString Nothing)
+  where
+    sendProgressReport token report = sendNotification SMethod_Progress $ ProgressParams token $ J.toJSON report
+
 -- Kill this to complete the progress session
 progressCounter ::
   LSP.LanguageContextEnv c ->
@@ -205,8 +231,12 @@ progressCounter ::
   STM Int ->
   IO ()
 progressCounter lspEnv title optProgressStyle getTodo getDone =
-  LSP.runLspT lspEnv $ withProgress title Nothing NotCancellable $ \update -> loop update 0
+  LSP.runLspT lspEnv $ withProgressChoice title Nothing NotCancellable $ \update -> loop update 0
   where
+    withProgressChoice = case optProgressStyle of
+        TestReporting -> withProgressDummy
+        _             -> withProgress
+
     loop _ _ | optProgressStyle == NoProgress = forever $ liftIO $ threadDelay maxBound
     loop update prevPct = do
       (todo, done, nextPct) <- liftIO $ atomically $ do
diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs
index ad4a36327a..fec6aaf725 100644
--- a/ghcide/src/Development/IDE/Main.hs
+++ b/ghcide/src/Development/IDE/Main.hs
@@ -77,8 +77,9 @@ import           Development.IDE.Types.Location           (NormalizedUri,
                                                            toNormalizedFilePath')
 import           Development.IDE.Types.Monitoring         (Monitoring)
 import           Development.IDE.Types.Options            (IdeGhcSession,
-                                                           IdeOptions (optCheckParents, optCheckProject, optReportProgress, optRunSubset),
+                                                           IdeOptions (..),
                                                            IdeTesting (IdeTesting),
+                                                           ProgressReportingStyle (TestReporting),
                                                            clientSupportsProgress,
                                                            defaultIdeOptions,
                                                            optModifyDynFlags,
@@ -276,7 +277,10 @@ testing recorder projectRoot plugins =
       let
         defOptions = argsIdeOptions config sessionLoader
       in
-        defOptions{ optTesting = IdeTesting True }
+        defOptions{
+            optTesting = IdeTesting True
+            , optProgressStyle = TestReporting
+            }
     lspOptions = argsLspOptions { LSP.optProgressStartDelay = 0, LSP.optProgressUpdateDelay = 0 }
   in
     arguments
diff --git a/ghcide/src/Development/IDE/Types/Options.hs b/ghcide/src/Development/IDE/Types/Options.hs
index 8d4d91e166..124e7a9469 100644
--- a/ghcide/src/Development/IDE/Types/Options.hs
+++ b/ghcide/src/Development/IDE/Types/Options.hs
@@ -107,6 +107,7 @@ newtype IdeOTMemoryProfiling = IdeOTMemoryProfiling    Bool
 data ProgressReportingStyle
     = Percentage -- ^ Report using the LSP @_percentage@ field
     | Explicit   -- ^ Report using explicit 123/456 text
+    | TestReporting -- ^ Special mode for testing, reports only start/stop
     | NoProgress -- ^ Do not report any percentage
     deriving Eq
 
diff --git a/scripts/flaky-test-patterns.txt b/scripts/flaky-test-patterns.txt
index 4651c1ad1f..04a2260826 100644
--- a/scripts/flaky-test-patterns.txt
+++ b/scripts/flaky-test-patterns.txt
@@ -10,4 +10,4 @@ Notification Handlers
 # ghcide restarts shake session on config changes:
 addDependentFile
 # Another interesting one you can try:
-# func-test::sends indefinite progress notifications
+func-test::sends indefinite progress notifications

From 6e504149e123f752211ec02d985b7960a1234f90 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 29 Aug 2025 05:56:35 +0800
Subject: [PATCH 36/61] Simplify build step in flakiness workflow to compile
 all tests

---
 .github/workflows/flakiness.yml | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/.github/workflows/flakiness.yml b/.github/workflows/flakiness.yml
index 7d8b938133..08aee8e6ce 100644
--- a/.github/workflows/flakiness.yml
+++ b/.github/workflows/flakiness.yml
@@ -66,10 +66,9 @@ jobs:
         run: |
           cabal --version
           ghc --version
-      - name: build tests
+      - name: build
         run: |
-          cabal build ghcide-tests
-          cabal build func-test
+          cabal build all
 
       - name: Run flakiness loop
         id: run-loop

From 1097ce632c6e13c86f5a1635321f3ba6ae994162 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 29 Aug 2025 06:14:01 +0800
Subject: [PATCH 37/61] Add HLS test executables to flakiness workflow
 environment

---
 .github/workflows/flakiness.yml | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/.github/workflows/flakiness.yml b/.github/workflows/flakiness.yml
index 08aee8e6ce..2546f35394 100644
--- a/.github/workflows/flakiness.yml
+++ b/.github/workflows/flakiness.yml
@@ -81,6 +81,8 @@ jobs:
           TEST_PATTERNS: ${{ github.event.inputs.test_patterns }}
           PATTERN_FILE: 'scripts/flaky-test-patterns.txt'
           NO_BUILD_ONCE: '1'
+          HLS_TEST_EXE: 'hls'
+          HLS_WRAPPER_TEST_EXE: 'hls-wrapper'
         run: |
           # Run with a sensible default of 1000 iterations on PRs;
           max_iter="${{ github.event.inputs.max_iter }}"

From afb4328b1bc4b1d6c471ec60d48f2ab06f473233 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 29 Aug 2025 06:46:17 +0800
Subject: [PATCH 38/61] Update flakiness workflow to dynamically locate HLS
 executable

---
 .github/workflows/flakiness.yml | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/.github/workflows/flakiness.yml b/.github/workflows/flakiness.yml
index 2546f35394..7601e6666e 100644
--- a/.github/workflows/flakiness.yml
+++ b/.github/workflows/flakiness.yml
@@ -81,12 +81,14 @@ jobs:
           TEST_PATTERNS: ${{ github.event.inputs.test_patterns }}
           PATTERN_FILE: 'scripts/flaky-test-patterns.txt'
           NO_BUILD_ONCE: '1'
-          HLS_TEST_EXE: 'hls'
-          HLS_WRAPPER_TEST_EXE: 'hls-wrapper'
+          # HLS_TEST_EXE: 'hls'
+          # HLS_WRAPPER_TEST_EXE: 'hls-wrapper'
         run: |
           # Run with a sensible default of 1000 iterations on PRs;
           max_iter="${{ github.event.inputs.max_iter }}"
           max_iter="${max_iter:-1000}"
+          # copy hls to current dir so the script can find it
+          HLS_TEST_EXE="$(cabal exec which hls)"
           bash scripts/flaky-test-loop.sh "${max_iter}"
           ec=$?
           # Interpret exit codes from flaky-test-loop.sh

From 5384ea7673cfe00c70034a6c9b50a93120b5177b Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 29 Aug 2025 06:46:52 +0800
Subject: [PATCH 39/61] Refactor flakiness workflow to streamline HLS test
 execution command

---
 .github/workflows/flakiness.yml | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/.github/workflows/flakiness.yml b/.github/workflows/flakiness.yml
index 7601e6666e..9806b5880b 100644
--- a/.github/workflows/flakiness.yml
+++ b/.github/workflows/flakiness.yml
@@ -81,15 +81,13 @@ jobs:
           TEST_PATTERNS: ${{ github.event.inputs.test_patterns }}
           PATTERN_FILE: 'scripts/flaky-test-patterns.txt'
           NO_BUILD_ONCE: '1'
-          # HLS_TEST_EXE: 'hls'
-          # HLS_WRAPPER_TEST_EXE: 'hls-wrapper'
+          # HLS_TEST_EXE: 'hls' # HLS_WRAPPER_TEST_EXE: 'hls-wrapper'
         run: |
           # Run with a sensible default of 1000 iterations on PRs;
           max_iter="${{ github.event.inputs.max_iter }}"
           max_iter="${max_iter:-1000}"
           # copy hls to current dir so the script can find it
-          HLS_TEST_EXE="$(cabal exec which hls)"
-          bash scripts/flaky-test-loop.sh "${max_iter}"
+          HLS_TEST_EXE="$(cabal exec which hls)" bash scripts/flaky-test-loop.sh "${max_iter}"
           ec=$?
           # Interpret exit codes from flaky-test-loop.sh
           #   0 => no issues reproduced within MAX_ITER          -> pass job

From bffdb6a3479b06ad2e8dcde72f3e364280fc7ba9 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 29 Aug 2025 07:58:54 +0800
Subject: [PATCH 40/61] Replace waitForAllProgressDone with waitForKickDone in
 resolveRequests for improved test synchronization

---
 ghcide-test/exe/ResolveTests.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/ghcide-test/exe/ResolveTests.hs b/ghcide-test/exe/ResolveTests.hs
index 4fc917c56b..0886fd62ce 100644
--- a/ghcide-test/exe/ResolveTests.hs
+++ b/ghcide-test/exe/ResolveTests.hs
@@ -24,7 +24,7 @@ import           Language.LSP.Test             hiding (resolveCompletion)
 import           Test.Hls                      (IdeState, SMethod (..), liftIO,
                                                 mkPluginTestDescriptor,
                                                 someMethodToMethodString,
-                                                waitForAllProgressDone)
+                                                waitForKickDone)
 import qualified Test.Hls.FileSystem           as FS
 import           Test.Tasty
 import           Test.Tasty.HUnit
@@ -100,7 +100,7 @@ resolveRequests =
         , "data Foo = Foo { foo :: Int }"
         , "bar = Foo 4"
         ]
-      waitForAllProgressDone
+      waitForKickDone
       items <- getCompletions doc (Position 2 7)
       let resolveCompItems = filter (\i -> "test item" `T.isPrefixOf` (i ^. J.label)) items
       liftIO $ assertEqual "There must be exactly two results" 2 (length resolveCompItems)
@@ -113,7 +113,7 @@ resolveRequests =
         , "data Foo = Foo { foo :: Int }"
         , "bar = Foo 4"
         ]
-      waitForAllProgressDone
+      waitForKickDone
       -- Cant use 'getAllCodeActions', as this lsp-test function queries the diagnostic
       -- locations and we don't have diagnostics in these tests.
       cas <- Maybe.mapMaybe (preview _R) <$> getCodeActions doc (Range (Position 0 0) (Position 1 0))
@@ -128,7 +128,7 @@ resolveRequests =
         , "data Foo = Foo { foo :: Int }"
         , "bar = Foo 4"
         ]
-      waitForAllProgressDone
+      waitForKickDone
       cd <- getCodeLenses doc
       let resolveCodeLenses = filter (\i -> case i ^. J.command of
             Just cmd -> "test item" `T.isPrefixOf` (cmd ^. J.title)

From d07c06fca344c5134573330e001005a8526536dc Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 29 Aug 2025 08:05:05 +0800
Subject: [PATCH 41/61] always send progress

---
 .../Development/IDE/Core/ProgressReporting.hs | 22 ++++++++++---------
 1 file changed, 12 insertions(+), 10 deletions(-)

diff --git a/ghcide/src/Development/IDE/Core/ProgressReporting.hs b/ghcide/src/Development/IDE/Core/ProgressReporting.hs
index 4bf4b10ab5..868674f99d 100644
--- a/ghcide/src/Development/IDE/Core/ProgressReporting.hs
+++ b/ghcide/src/Development/IDE/Core/ProgressReporting.hs
@@ -24,8 +24,7 @@ import           Control.Concurrent.STM.Stats   (TVar, atomically,
                                                  atomicallyNamed, modifyTVar',
                                                  newTVarIO, readTVar, retry)
 import           Control.Concurrent.Strict      (modifyVar_, newBarrier, newVar,
-                                                 signalBarrier, threadDelay,
-                                                 waitBarrier)
+                                                 signalBarrier, threadDelay)
 import           Control.Monad.Extra            hiding (loop)
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Class      (lift)
@@ -212,15 +211,18 @@ withProgressDummy ::
   ((ProgressAmount -> m ()) -> m a) ->
   m a
 withProgressDummy title _ _ f = do
-    t <- L.ProgressToken . L.InR . T.pack . show . hashUnique <$> liftIO newUnique
-    r <- liftIO newBarrier
-    _ <- sendRequest SMethod_WindowWorkDoneProgressCreate (WorkDoneProgressCreateParams t) $
-        \_ -> liftIO $ signalBarrier r ()
-    -- liftIO $ waitBarrier r
-    sendProgressReport t $ WorkDoneProgressBegin L.AString title Nothing Nothing Nothing
-    f (const $ return ()) `UE.finally` sendProgressReport t (WorkDoneProgressEnd L.AString Nothing)
+        UE.bracket start end $ \_ ->
+            f (const $ return ())
   where
     sendProgressReport token report = sendNotification SMethod_Progress $ ProgressParams token $ J.toJSON report
+    start = UE.uninterruptibleMask_ $ do
+        t <- L.ProgressToken . L.InR . T.pack . show . hashUnique <$> liftIO newUnique
+        r <- liftIO newBarrier
+        _ <- sendRequest SMethod_WindowWorkDoneProgressCreate (WorkDoneProgressCreateParams t) $ \_ -> liftIO $ signalBarrier r ()
+        sendProgressReport t $ WorkDoneProgressBegin L.AString title Nothing Nothing Nothing
+        return t
+    end t = do
+        sendProgressReport t (WorkDoneProgressEnd L.AString Nothing)
 
 -- Kill this to complete the progress session
 progressCounter ::
@@ -231,7 +233,7 @@ progressCounter ::
   STM Int ->
   IO ()
 progressCounter lspEnv title optProgressStyle getTodo getDone =
-  LSP.runLspT lspEnv $ withProgressChoice title Nothing NotCancellable $ \update -> loop update 0
+    LSP.runLspT lspEnv $ withProgressChoice title Nothing NotCancellable $ \update -> loop update 0
   where
     withProgressChoice = case optProgressStyle of
         TestReporting -> withProgressDummy

From 7ad628efa7daeeac9afa73b67cf8d1b994d09109 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 29 Aug 2025 18:48:38 +0800
Subject: [PATCH 42/61] update lsp

---
 cabal.project | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/cabal.project b/cabal.project
index 20ea0e956f..d83e432492 100644
--- a/cabal.project
+++ b/cabal.project
@@ -60,5 +60,5 @@ if impl(ghc >= 9.11)
 source-repository-package
   type: git
   location: https://github.com/soulomoon/lsp.git
-  tag: 52e9b0ef0c34443c84a8e79c9b3fceb6acb3e00f
+  tag: 640c7c755bf16128e3cb19c257688aa3305ff9f5
   subdir: lsp lsp-types lsp-test

From b962e1f6c2c7aa15e5bf0cf267f97b464e0fb9bf Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 29 Aug 2025 18:58:05 +0800
Subject: [PATCH 43/61] increase timeout for flakiness

---
 .github/workflows/flakiness.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/flakiness.yml b/.github/workflows/flakiness.yml
index 9806b5880b..d01aef57d4 100644
--- a/.github/workflows/flakiness.yml
+++ b/.github/workflows/flakiness.yml
@@ -73,7 +73,7 @@ jobs:
       - name: Run flakiness loop
         id: run-loop
         # Let this run for a while; build is done once inside the script
-        timeout-minutes: 45
+        timeout-minutes: 60
         env:
           # Use workflow_dispatch inputs when present, else defaults
           SLEEP_SECS: ${{ github.event.inputs.sleep_secs || '0' }}

From c3758fa0aae347ab4684a9013f277b112a3aa1c6 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 29 Aug 2025 18:58:51 +0800
Subject: [PATCH 44/61] update number of runs to 500 for flakiness

---
 .github/workflows/flakiness.yml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/.github/workflows/flakiness.yml b/.github/workflows/flakiness.yml
index d01aef57d4..ae8824699a 100644
--- a/.github/workflows/flakiness.yml
+++ b/.github/workflows/flakiness.yml
@@ -83,9 +83,9 @@ jobs:
           NO_BUILD_ONCE: '1'
           # HLS_TEST_EXE: 'hls' # HLS_WRAPPER_TEST_EXE: 'hls-wrapper'
         run: |
-          # Run with a sensible default of 1000 iterations on PRs;
+          # Run with a sensible default of 500 iterations on PRs;
           max_iter="${{ github.event.inputs.max_iter }}"
-          max_iter="${max_iter:-1000}"
+          max_iter="${max_iter:-500}"
           # copy hls to current dir so the script can find it
           HLS_TEST_EXE="$(cabal exec which hls)" bash scripts/flaky-test-loop.sh "${max_iter}"
           ec=$?

From b313fd0621fb21fb89c632c9d3b6a6c36d610a23 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Sun, 31 Aug 2025 01:08:47 +0800
Subject: [PATCH 45/61] update CI

---
 scripts/flaky-test-loop.sh      |  4 ++--
 scripts/flaky-test-patterns.txt | 10 +++++++---
 2 files changed, 9 insertions(+), 5 deletions(-)

diff --git a/scripts/flaky-test-loop.sh b/scripts/flaky-test-loop.sh
index f916649ec7..f95c4feab0 100755
--- a/scripts/flaky-test-loop.sh
+++ b/scripts/flaky-test-loop.sh
@@ -137,8 +137,8 @@ get_bin_path() {
 while true; do
   iter=$((iter+1))
   ts=$(date -Iseconds)
-  file_num=$((iter % 100))
-  if [[ ${file_num} -eq 0 ]]; then file_num=100; fi
+  file_num=$((iter % 2))
+  # if [[ ${file_num} -eq 0 ]]; then file_num=100; fi
 
   # Run each selected item (BIN::PATTERN) in this iteration
   for item in "${items[@]}"; do
diff --git a/scripts/flaky-test-patterns.txt b/scripts/flaky-test-patterns.txt
index 04a2260826..debba3c54f 100644
--- a/scripts/flaky-test-patterns.txt
+++ b/scripts/flaky-test-patterns.txt
@@ -3,11 +3,15 @@
 
 open close
 # non local variable
-Notification Handlers
+# Notification Handlers
 # bidirectional module dependency with hs-boot
 
 # InternalError over InvalidParams
 # ghcide restarts shake session on config changes:
-addDependentFile
+# addDependentFile
 # Another interesting one you can try:
-func-test::sends indefinite progress notifications
+# func-test::sends indefinite progress notifications
+# hls-pragmas-plugin-tests::/inline: RULES/
+
+# hls-graph cancel leaks asynchronous exception to the next session
+hls-hlint-plugin-tests::adding hlint flags to plugin configuration removes hlint diagnostics

From 84f7d35ddd2819643b2b773ddb93dbb9997b49b3 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Sun, 31 Aug 2025 01:27:34 +0800
Subject: [PATCH 46/61] Add AsyncParentKill exception handling and improve
 database step retrieval

---
 .../Development/IDE/Graph/Internal/Action.hs  |   2 +
 .../IDE/Graph/Internal/Database.hs            | 232 ++++++++----------
 .../Development/IDE/Graph/Internal/Types.hs   |  38 +--
 3 files changed, 125 insertions(+), 147 deletions(-)

diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Action.hs b/hls-graph/src/Development/IDE/Graph/Internal/Action.hs
index 6d47d9b511..30ef078ffe 100644
--- a/hls-graph/src/Development/IDE/Graph/Internal/Action.hs
+++ b/hls-graph/src/Development/IDE/Graph/Internal/Action.hs
@@ -81,8 +81,10 @@ actionFork act k = do
 
 isAsyncException :: SomeException -> Bool
 isAsyncException e
+    | Just (_ :: SomeAsyncException) <- fromException e = True
     | Just (_ :: AsyncCancelled) <- fromException e = True
     | Just (_ :: AsyncException) <- fromException e = True
+    | Just (_ :: AsyncParentKill) <- fromException e = True
     | Just (_ :: ExitCode) <- fromException e = True
     | otherwise = False
 
diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs b/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
index 359e5ceb6a..18b00bf3bc 100644
--- a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
+++ b/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
@@ -8,16 +8,17 @@
 {-# LANGUAGE RecordWildCards    #-}
 {-# LANGUAGE TypeFamilies       #-}
 
-module Development.IDE.Graph.Internal.Database (compute, newDatabase, incDatabase, build, getDirtySet, getKeysAndVisitAge) where
+module Development.IDE.Graph.Internal.Database (compute, newDatabase, incDatabase, build, getDirtySet, getKeysAndVisitAge, AsyncParentKill(..)) where
 
 import           Prelude                              hiding (unzip)
 
 import           Control.Concurrent.Async
 import           Control.Concurrent.Extra
-import           Control.Concurrent.STM.Stats         (STM, atomically,
+import           Control.Concurrent.STM.Stats         (STM, TVar, atomically,
                                                        atomicallyNamed,
                                                        modifyTVar', newTVarIO,
-                                                       readTVarIO)
+                                                       readTVar, readTVarIO,
+                                                       retry)
 import           Control.Exception
 import           Control.Monad
 import           Control.Monad.IO.Class               (MonadIO (liftIO))
@@ -25,7 +26,6 @@ import           Control.Monad.Trans.Class            (lift)
 import           Control.Monad.Trans.Reader
 import qualified Control.Monad.Trans.State.Strict     as State
 import           Data.Dynamic
-import           Data.Either
 import           Data.Foldable                        (for_, traverse_)
 import           Data.IORef.Extra
 import           Data.Maybe
@@ -39,11 +39,12 @@ import           Development.IDE.Graph.Internal.Types
 import qualified Focus
 import qualified ListT
 import qualified StmContainers.Map                    as SMap
-import           System.IO.Unsafe
 import           System.Time.Extra                    (duration, sleep)
 
 #if MIN_VERSION_base(4,19,0)
 import           Data.Functor                         (unzip)
+import           UnliftIO                             (MonadUnliftIO (withRunInIO))
+import qualified UnliftIO.Exception                   as UE
 #else
 import           Data.List.NonEmpty                   (unzip)
 #endif
@@ -67,18 +68,22 @@ incDatabase db (Just kk) = do
         -- since we assume that no build is mutating the db.
         -- Therefore run one transaction per key to minimise contention.
         atomicallyNamed "incDatabase" $ SMap.focus updateDirty k (databaseValues db)
+    -- let list = SMap.listT (databaseValues db)
+    -- atomicallyNamed "incDatabase - all " $ flip ListT.traverse_ list $ \(k,_) ->
+    --     SMap.focus dirtyRunningKey k (databaseValues db)
 
 -- all keys are dirty
 incDatabase db Nothing = do
     atomically $ modifyTVar'  (databaseStep db) $ \(Step i) -> Step $ i + 1
     let list = SMap.listT (databaseValues db)
+    -- all running keys are also dirty
     atomicallyNamed "incDatabase - all " $ flip ListT.traverse_ list $ \(k,_) ->
         SMap.focus updateDirty k (databaseValues db)
 
 updateDirty :: Monad m => Focus.Focus KeyDetails m ()
 updateDirty = Focus.adjust $ \(KeyDetails status rdeps) ->
             let status'
-                  | Running _ _ _ x <- status = Dirty x
+                  | Running _ x <- status = Dirty x
                   | Clean x <- status = Dirty (Just x)
                   | otherwise = status
             in KeyDetails status' rdeps
@@ -88,58 +93,57 @@ build
     => Database -> Stack -> f key -> IO (f Key, f value)
 -- build _ st k | traceShow ("build", st, k) False = undefined
 build db stack keys = do
-    built <- runAIO $ do
-        built <- builder db stack (fmap newKey keys)
-        case built of
-          Left clean  -> return clean
-          Right dirty -> liftIO dirty
-    let (ids, vs) = unzip built
-    pure (ids, fmap (asV . resultValue) vs)
+    step <- readTVarIO $ databaseStep db
+    go `catch` \e@(AsyncParentKill i s) -> do
+        if s == step
+            then throw e
+            else throw $ AsyncParentKill i $ Step (-1)
     where
-        asV :: Value -> value
-        asV (Value x) = unwrapDynamic x
+    go = do
+        step <- readTVarIO $ databaseStep db
+        !built <- runAIO step $ builder db stack (fmap newKey keys)
+        let (ids, vs) = unzip built
+        pure (ids, fmap (asV . resultValue) vs)
+        where
+            asV :: Value -> value
+            asV (Value x) = unwrapDynamic x
+
 
 -- | Build a list of keys and return their results.
 --  If none of the keys are dirty, we can return the results immediately.
 --  Otherwise, a blocking computation is returned *which must be evaluated asynchronously* to avoid deadlock.
-builder
-    :: Traversable f => Database -> Stack -> f Key -> AIO (Either (f (Key, Result)) (IO (f (Key, Result))))
+builder :: (Traversable f) => Database -> Stack -> f Key -> AIO (f (Key, Result))
 -- builder _ st kk | traceShow ("builder", st,kk) False = undefined
-builder db@Database{..} stack keys = withRunInIO $ \(RunInIO run) -> do
-    -- Things that I need to force before my results are ready
-    toForce <- liftIO $ newTVarIO []
-    current <- liftIO $ readTVarIO databaseStep
-    results <- liftIO $ for keys $ \id ->
-        -- Updating the status of all the dependencies atomically is not necessary.
-        -- Therefore, run one transaction per dep. to avoid contention
-        atomicallyNamed "builder" $ do
-            -- Spawn the id if needed
-            status <- SMap.lookup id databaseValues
-            val <- case viewDirty current $ maybe (Dirty Nothing) keyStatus status of
-                Clean r -> pure r
-                Running _ force val _
-                  | memberStack id stack -> throw $ StackException stack
-                  | otherwise -> do
-                    modifyTVar' toForce (Wait force :)
-                    pure val
-                Dirty s -> do
-                    let act = run (refresh db stack id s)
-                        (force, val) = splitIO (join act)
-                    SMap.focus (updateStatus $ Running current force val s) id databaseValues
-                    modifyTVar' toForce (Spawn force:)
-                    pure val
-
-            pure (id, val)
-
-    toForceList <- liftIO $ readTVarIO toForce
-    let waitAll = run $ waitConcurrently_ toForceList
-    case toForceList of
-        [] -> return $ Left results
-        _ -> return $ Right $ do
-                waitAll
-                pure results
-
-
+builder db stack keys = do
+    keyWaits <- for keys $ \k -> builderOne db stack k
+    !res <- for keyWaits $ \(k, waitR) -> do
+        !v<- liftIO waitR
+        return (k, v)
+    return res
+
+builderOne :: Database -> Stack -> Key -> AIO (Key, IO Result)
+builderOne db@Database {..} stack id = UE.mask_ $ do
+  current <- liftIO $ readTVarIO databaseStep
+  (k, registerWaitResult) <- liftIO $ atomicallyNamed "builder" $ do
+    -- Spawn the id if needed
+    status <- SMap.lookup id databaseValues
+    val <- case viewDirty current $ maybe (Dirty Nothing) keyStatus status of
+      Dirty s -> do
+        let act =
+              asyncWithCleanUp
+                ( refresh db stack id s
+                    `UE.onException` liftIO (atomicallyNamed "builder - onException" (SMap.focus updateDirty id databaseValues))
+                )
+        SMap.focus (updateStatus $ Running current s) id databaseValues
+        return act
+      Clean r -> pure . pure . pure $ r
+      -- force here might contains async exceptions from previous runs
+      Running _step _s
+        | memberStack id stack -> throw $ StackException stack
+        | otherwise -> retry
+    pure (id, val)
+  waitR <- registerWaitResult
+  return (k, waitR)
 -- | isDirty
 -- only dirty when it's build time is older than the changed time of one of its dependencies
 isDirty :: Foldable t => Result -> t (a, Result) -> Bool
@@ -155,41 +159,35 @@ isDirty me = any (\(_,dep) -> resultBuilt me < resultChanged dep)
 refreshDeps :: KeySet -> Database -> Stack -> Key -> Result -> [KeySet] -> AIO Result
 refreshDeps visited db stack key result = \case
     -- no more deps to refresh
-    [] -> liftIO $ compute db stack key RunDependenciesSame (Just result)
+    [] -> compute db stack key RunDependenciesSame (Just result)
     (dep:deps) -> do
         let newVisited = dep <> visited
         res <- builder db stack (toListKeySet (dep `differenceKeySet` visited))
-        case res of
-            Left res ->  if isDirty result res
+        if isDirty result res
                 -- restart the computation if any of the deps are dirty
-                then liftIO $ compute db stack key RunDependenciesChanged (Just result)
+                then compute db stack key RunDependenciesChanged (Just result)
                 -- else kick the rest of the deps
                 else refreshDeps newVisited db stack key result deps
-            Right iores -> do
-                res <- liftIO iores
-                if isDirty result res
-                    then liftIO $ compute db stack key RunDependenciesChanged (Just result)
-                    else refreshDeps newVisited db stack key result deps
-
--- | Refresh a key:
-refresh :: Database -> Stack -> Key -> Maybe Result -> AIO (IO Result)
+
+
+-- refresh :: Database -> Stack -> Key -> Maybe Result -> IO Result
 -- refresh _ st k _ | traceShow ("refresh", st, k) False = undefined
+refresh :: Database -> Stack -> Key -> Maybe Result -> AIO Result
 refresh db stack key result = case (addStack key stack, result) of
     (Left e, _) -> throw e
-    (Right stack, Just me@Result{resultDeps = ResultDeps deps}) -> asyncWithCleanUp $ refreshDeps mempty db stack key me (reverse deps)
-    (Right stack, _) ->
-        asyncWithCleanUp $ liftIO $ compute db stack key RunDependenciesChanged result
+    (Right stack, Just me@Result{resultDeps = ResultDeps deps}) -> refreshDeps mempty db stack key me (reverse deps)
+    (Right stack, _) -> compute db stack key RunDependenciesChanged result
 
 -- | Compute a key.
-compute :: Database -> Stack -> Key -> RunMode -> Maybe Result -> IO Result
+compute :: Database -> Stack -> Key -> RunMode -> Maybe Result -> AIO Result
 -- compute _ st k _ _ | traceShow ("compute", st, k) False = undefined
 compute db@Database{..} stack key mode result = do
     let act = runRule databaseRules key (fmap resultData result) mode
-    deps <- newIORef UnknownDeps
+    deps <- liftIO $ newIORef UnknownDeps
     (execution, RunResult{..}) <-
-        duration $ runReaderT (fromAction act) $ SAction db deps stack
-    curStep <- readTVarIO databaseStep
-    deps <- readIORef deps
+        liftIO $ duration $ runReaderT (fromAction act) $ SAction db deps stack
+    curStep <- liftIO $ readTVarIO databaseStep
+    deps <- liftIO $ readIORef deps
     let lastChanged = maybe curStep resultChanged result
     let lastBuild = maybe curStep resultBuilt result
     -- changed time is always older than or equal to build time
@@ -212,12 +210,12 @@ compute db@Database{..} stack key mode result = do
             -- If an async exception strikes before the deps have been recorded,
             -- we won't be able to accurately propagate dirtiness for this key
             -- on the next build.
-            void $
+            liftIO $ void $
                 updateReverseDeps key db
                     (getResultDepsDefault mempty previousDeps)
                     deps
         _ -> pure ()
-    atomicallyNamed "compute and run hook" $ do
+    liftIO $ atomicallyNamed "compute and run hook" $ do
         runHook
         SMap.focus (updateStatus $ Clean res) key databaseValues
     pure res
@@ -247,18 +245,6 @@ getKeysAndVisitAge db = do
         getAge Result{resultVisited = Step s} = curr - s
     return keysWithVisitAge
 --------------------------------------------------------------------------------
--- Lazy IO trick
-
-data Box a = Box {fromBox :: a}
-
--- | Split an IO computation into an unsafe lazy value and a forcing computation
-splitIO :: IO a -> (IO (), a)
-splitIO act = do
-    let act2 = Box <$> act
-    let res = unsafePerformIO act2
-    (void $ evaluate res, fromBox res)
-
---------------------------------------------------------------------------------
 -- Reverse dependencies
 
 -- | Update the reverse dependencies of an Id
@@ -301,14 +287,29 @@ transitiveDirtySet database = flip State.execStateT mempty . traverse_ loop
 
 -- | A simple monad to implement cancellation on top of 'Async',
 --   generalizing 'withAsync' to monadic scopes.
-newtype AIO a = AIO { unAIO :: ReaderT (IORef [Async ()]) IO a }
+newtype AIO a = AIO { unAIO :: ReaderT (TVar [Async ()]) IO a }
   deriving newtype (Applicative, Functor, Monad, MonadIO)
 
+data AsyncParentKill = AsyncParentKill ThreadId Step
+    deriving (Show, Eq)
+
+instance Exception AsyncParentKill where
+  toException = asyncExceptionToException
+  fromException = asyncExceptionFromException
+
 -- | Run the monadic computation, cancelling all the spawned asyncs if an exception arises
-runAIO :: AIO a -> IO a
-runAIO (AIO act) = do
-    asyncs <- newIORef []
-    runReaderT act asyncs `onException` cleanupAsync asyncs
+runAIO :: Step -> AIO a -> IO a
+runAIO s (AIO act) = do
+    asyncsRef <- newTVarIO []
+    -- Log the exact exception (including async exceptions) before cleanup,
+    -- then rethrow to preserve previous semantics.
+    runReaderT act asyncsRef `onException` do
+        asyncs <- atomically $ do
+            r <- readTVar asyncsRef
+            modifyTVar' asyncsRef $ const []
+            return r
+        tid <- myThreadId
+        cleanupAsync asyncs tid s
 
 -- | Like 'async' but with built-in cancellation.
 --   Returns an IO action to wait on the result.
@@ -319,7 +320,7 @@ asyncWithCleanUp act = do
     -- mask to make sure we keep track of the spawned async
     liftIO $ uninterruptibleMask $ \restore -> do
         a <- async $ restore io
-        atomicModifyIORef'_ st (void a :)
+        atomically $ modifyTVar' st (void a :)
         return $ wait a
 
 unliftAIO :: AIO a -> AIO (IO a)
@@ -327,19 +328,17 @@ unliftAIO act = do
     st <- AIO ask
     return $ runReaderT (unAIO act) st
 
-newtype RunInIO = RunInIO (forall a. AIO a -> IO a)
+instance MonadUnliftIO AIO where
+    withRunInIO k = do
+        st <- AIO ask
+        liftIO $ k (\aio -> runReaderT (unAIO aio) st)
 
-withRunInIO :: (RunInIO -> AIO b) -> AIO b
-withRunInIO k = do
-    st <- AIO ask
-    k $ RunInIO (\aio -> runReaderT (unAIO aio) st)
-
-cleanupAsync :: IORef [Async a] -> IO ()
+cleanupAsync :: [Async a] -> ThreadId -> Step -> IO ()
 -- mask to make sure we interrupt all the asyncs
-cleanupAsync ref = uninterruptibleMask $ \unmask -> do
-    asyncs <- atomicModifyIORef' ref ([],)
+cleanupAsync asyncs tid step  = uninterruptibleMask $ \unmask -> do
     -- interrupt all the asyncs without waiting
-    mapM_ (\a -> throwTo (asyncThreadId a) AsyncCancelled) asyncs
+    -- mapM_ (\a -> throwTo (asyncThreadId a) AsyncCancelled) asyncs
+    mapM_ (\a -> throwTo (asyncThreadId a) $ AsyncParentKill tid step) asyncs
     -- Wait until all the asyncs are done
     -- But if it takes more than 10 seconds, log to stderr
     unless (null asyncs) $ do
@@ -348,32 +347,3 @@ cleanupAsync ref = uninterruptibleMask $ \unmask -> do
                 traceM "cleanupAsync: waiting for asyncs to finish"
         withAsync warnIfTakingTooLong $ \_ ->
             mapM_ waitCatch asyncs
-
-data Wait
-    = Wait {justWait :: !(IO ())}
-    | Spawn {justWait :: !(IO ())}
-
-fmapWait :: (IO () -> IO ()) -> Wait -> Wait
-fmapWait f (Wait io)  = Wait (f io)
-fmapWait f (Spawn io) = Spawn (f io)
-
-waitOrSpawn :: Wait -> IO (Either (IO ()) (Async ()))
-waitOrSpawn (Wait io)  = pure $ Left io
-waitOrSpawn (Spawn io) = Right <$> async io
-
-waitConcurrently_ :: [Wait] -> AIO ()
-waitConcurrently_ [] = pure ()
-waitConcurrently_ [one] = liftIO $ justWait one
-waitConcurrently_ many = do
-    ref <- AIO ask
-    -- spawn the async computations.
-    -- mask to make sure we keep track of all the asyncs.
-    (asyncs, syncs) <- liftIO $ uninterruptibleMask $ \unmask -> do
-        waits <- liftIO $ traverse (waitOrSpawn . fmapWait unmask) many
-        let (syncs, asyncs) = partitionEithers waits
-        liftIO $ atomicModifyIORef'_ ref (asyncs ++)
-        return (asyncs, syncs)
-    -- work on the sync computations
-    liftIO $ sequence_ syncs
-    -- wait for the async computations before returning
-    liftIO $ traverse_ wait asyncs
diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs
index 34bed42391..5231879122 100644
--- a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs
+++ b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs
@@ -28,7 +28,7 @@ import qualified ListT
 import qualified StmContainers.Map                  as SMap
 import           StmContainers.Map                  (Map)
 import           System.Time.Extra                  (Seconds)
-import           UnliftIO                           (MonadUnliftIO)
+import           UnliftIO                           (MonadUnliftIO, readTVarIO)
 
 #if !MIN_VERSION_base(4,18,0)
 import           Control.Applicative                (liftA2)
@@ -80,8 +80,8 @@ getDatabase :: Action Database
 getDatabase = Action $ asks actionDatabase
 
 -- | waitForDatabaseRunningKeysAction waits for all keys in the database to finish running.
-waitForDatabaseRunningKeysAction :: Action ()
-waitForDatabaseRunningKeysAction = getDatabase >>= liftIO . waitForDatabaseRunningKeys
+-- waitForDatabaseRunningKeysAction :: Action ()
+-- waitForDatabaseRunningKeysAction = getDatabase >>= liftIO . waitForDatabaseRunningKeys
 
 ---------------------------------------------------------------------
 -- DATABASE
@@ -91,6 +91,12 @@ data ShakeDatabase = ShakeDatabase !Int [Action ()] Database
 newtype Step = Step Int
     deriving newtype (Eq,Ord,Hashable,Show)
 
+
+getShakeStep :: MonadIO m => ShakeDatabase -> m Step
+getShakeStep (ShakeDatabase _ _ db) = do
+    s <- readTVarIO $ databaseStep db
+    return s
+
 ---------------------------------------------------------------------
 -- Keys
 
@@ -115,8 +121,8 @@ data Database = Database {
     databaseValues :: !(Map Key KeyDetails)
     }
 
-waitForDatabaseRunningKeys :: Database -> IO ()
-waitForDatabaseRunningKeys = getDatabaseValues >=> mapM_ (waitRunning . snd)
+-- waitForDatabaseRunningKeys :: Database -> IO ()
+-- waitForDatabaseRunningKeys = getDatabaseValues >=> mapM_ (waitRunning . snd)
 
 getDatabaseValues :: Database -> IO [(Key, Status)]
 getDatabaseValues = atomically
@@ -129,24 +135,24 @@ data Status
     = Clean !Result
     | Dirty (Maybe Result)
     | Running {
-        runningStep   :: !Step,
-        runningWait   :: !(IO ()),
-        runningResult :: Result,     -- LAZY
-        runningPrev   :: !(Maybe Result)
+        runningStep :: !Step,
+        -- runningWait   :: !(IO ()),
+        -- runningResult :: Result,     -- LAZY
+        runningPrev :: !(Maybe Result)
         }
 
 viewDirty :: Step -> Status -> Status
-viewDirty currentStep (Running s _ _ re) | currentStep /= s = Dirty re
+viewDirty currentStep (Running s re) | currentStep /= s = Dirty re
 viewDirty _ other = other
 
 getResult :: Status -> Maybe Result
-getResult (Clean re)           = Just re
-getResult (Dirty m_re)         = m_re
-getResult (Running _ _ _ m_re) = m_re -- watch out: this returns the previous result
+getResult (Clean re)       = Just re
+getResult (Dirty m_re)     = m_re
+getResult (Running _ m_re) = m_re -- watch out: this returns the previous result
 
-waitRunning :: Status -> IO ()
-waitRunning Running{..} = runningWait
-waitRunning _           = return ()
+-- waitRunning :: Status -> IO ()
+-- waitRunning Running{..} = runningWait
+-- waitRunning _           = return ()
 
 data Result = Result {
     resultValue     :: !Value,

From 9788101344efbc2acb7da7b762b103478f9f5def Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Sun, 31 Aug 2025 01:44:36 +0800
Subject: [PATCH 47/61] fix bench

---
 .../src/Development/IDE/Graph/Internal/Database.hs     | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs b/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
index 18b00bf3bc..68bd9edef9 100644
--- a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
+++ b/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
@@ -159,13 +159,13 @@ isDirty me = any (\(_,dep) -> resultBuilt me < resultChanged dep)
 refreshDeps :: KeySet -> Database -> Stack -> Key -> Result -> [KeySet] -> AIO Result
 refreshDeps visited db stack key result = \case
     -- no more deps to refresh
-    [] -> compute db stack key RunDependenciesSame (Just result)
+    [] -> compute' db stack key RunDependenciesSame (Just result)
     (dep:deps) -> do
         let newVisited = dep <> visited
         res <- builder db stack (toListKeySet (dep `differenceKeySet` visited))
         if isDirty result res
                 -- restart the computation if any of the deps are dirty
-                then compute db stack key RunDependenciesChanged (Just result)
+                then compute' db stack key RunDependenciesChanged (Just result)
                 -- else kick the rest of the deps
                 else refreshDeps newVisited db stack key result deps
 
@@ -176,10 +176,12 @@ refresh :: Database -> Stack -> Key -> Maybe Result -> AIO Result
 refresh db stack key result = case (addStack key stack, result) of
     (Left e, _) -> throw e
     (Right stack, Just me@Result{resultDeps = ResultDeps deps}) -> refreshDeps mempty db stack key me (reverse deps)
-    (Right stack, _) -> compute db stack key RunDependenciesChanged result
+    (Right stack, _) -> compute' db stack key RunDependenciesChanged result
 
+compute' :: Database -> Stack -> Key -> RunMode -> Maybe Result -> AIO Result
+compute' db stack key mode result = liftIO $ compute db stack key mode result
 -- | Compute a key.
-compute :: Database -> Stack -> Key -> RunMode -> Maybe Result -> AIO Result
+compute :: Database -> Stack -> Key -> RunMode -> Maybe Result -> IO Result
 -- compute _ st k _ _ | traceShow ("compute", st, k) False = undefined
 compute db@Database{..} stack key mode result = do
     let act = runRule databaseRules key (fmap resultData result) mode

From a87d1c241ed06ebd1cef5a2023e7210b98549f85 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Sun, 31 Aug 2025 02:04:59 +0800
Subject: [PATCH 48/61] fix import

---
 hls-graph/src/Development/IDE/Graph/Internal/Database.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs b/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
index 68bd9edef9..026548203d 100644
--- a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
+++ b/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
@@ -40,11 +40,11 @@ import qualified Focus
 import qualified ListT
 import qualified StmContainers.Map                    as SMap
 import           System.Time.Extra                    (duration, sleep)
+import           UnliftIO                             (MonadUnliftIO (withRunInIO))
+import qualified UnliftIO.Exception                   as UE
 
 #if MIN_VERSION_base(4,19,0)
 import           Data.Functor                         (unzip)
-import           UnliftIO                             (MonadUnliftIO (withRunInIO))
-import qualified UnliftIO.Exception                   as UE
 #else
 import           Data.List.NonEmpty                   (unzip)
 #endif

From 66dc235d5cdfef9ce0a68d44fff1ff059866088c Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Sun, 31 Aug 2025 03:55:51 +0800
Subject: [PATCH 49/61] fix compilation

---
 hls-graph/src/Development/IDE/Graph/Internal/Types.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs
index 5231879122..dc8fa33eb6 100644
--- a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs
+++ b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs
@@ -6,7 +6,6 @@
 module Development.IDE.Graph.Internal.Types where
 
 import           Control.Concurrent.STM             (STM)
-import           Control.Monad                      ((>=>))
 import           Control.Monad.Catch
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Reader

From 8483c7bc19222740cf4c1d8840d7158e45e08460 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Mon, 1 Sep 2025 02:33:58 +0800
Subject: [PATCH 50/61] add event log

---
 scripts/eventlog-dump.fish      | 122 ++++++++++++++++++++++++++++++++
 scripts/flaky-test-loop.sh      |   4 +-
 scripts/flaky-test-patterns.txt |   7 +-
 3 files changed, 129 insertions(+), 4 deletions(-)
 create mode 100755 scripts/eventlog-dump.fish

diff --git a/scripts/eventlog-dump.fish b/scripts/eventlog-dump.fish
new file mode 100755
index 0000000000..5122b48590
--- /dev/null
+++ b/scripts/eventlog-dump.fish
@@ -0,0 +1,122 @@
+#!/usr/bin/env fish
+
+# Dump a GHC RTS .eventlog to a plain-text file using the ghc-events CLI.
+# Usage:
+#   scripts/eventlog-dump.fish <file.eventlog> [output.txt] [starts_with_prefix] [contains_substring]
+#
+# Notes:
+# - Attempts to find ghc-events in PATH, ~/.cabal/bin, or ~/.local/bin.
+# - If not found, will try: cabal install ghc-events
+# - Output defaults to <basename>.events.txt in the current directory.
+
+function usage
+  echo "Usage: (basename (status filename)) <file.eventlog> [output.txt] [starts_with_prefix] [contains_substring]"
+  exit 2
+end
+
+if test (count $argv) -lt 1
+  usage
+end
+
+set evlog $argv[1]
+if not test -f $evlog
+  echo "error: file not found: $evlog" >&2
+  exit 1
+end
+
+if test (count $argv) -ge 2
+  set out $argv[2]
+else
+  set base (basename $evlog)
+  if string match -q '*\.eventlog' $base
+    set out (string replace -r '\\.eventlog$' '.events.txt' -- $base)
+  else
+    set out "$base.events.txt"
+  end
+end
+
+# Optional prefix filter: only keep lines that start with this string
+set filter_prefix ""
+if test (count $argv) -ge 3
+  set filter_prefix $argv[3]
+end
+
+# Optional contains filter: only keep lines that contain this substring (applied after prefix filter if both provided)
+set filter_contains ""
+if test (count $argv) -ge 4
+  set filter_contains $argv[4]
+end
+
+function find_ghc_events --description "echo absolute path to ghc-events or empty"
+  if command -sq ghc-events
+    command -s ghc-events
+    return 0
+  end
+  if test -x ~/.cabal/bin/ghc-events
+    echo ~/.cabal/bin/ghc-events
+    return 0
+  end
+  if test -x ~/.local/bin/ghc-events
+    echo ~/.local/bin/ghc-events
+    return 0
+  end
+  return 1
+end
+
+set ghc_events_bin (find_ghc_events)
+
+if test -z "$ghc_events_bin"
+  echo "ghc-events not found; attempting to install via 'cabal install ghc-events'..." >&2
+  if not command -sq cabal
+    echo "error: cabal not found; please install ghc-events manually (e.g., via cabal)." >&2
+    exit 1
+  end
+  cabal install ghc-events
+  set ghc_events_bin (find_ghc_events)
+  if test -z "$ghc_events_bin"
+    echo "error: ghc-events still not found after installation." >&2
+    exit 1
+  end
+end
+
+echo "Dumping events from $evlog to $out..."
+set -l stream_cmd "$ghc_events_bin show $evlog"
+
+if test -n "$filter_prefix" -o -n "$filter_contains"
+  # Stream through filters
+  eval $stream_cmd | while read -l line
+    set -l keep 1
+    if test -n "$filter_prefix"
+      if not string match -q -- "$filter_prefix*" -- $line
+        set keep 0
+      end
+    end
+    if test $keep -eq 1 -a -n "$filter_contains"
+      if not string match -q -- "*$filter_contains*" -- $line
+        set keep 0
+      end
+    end
+    if test $keep -eq 1
+      echo $line
+    end
+  end > $out
+else
+  eval $stream_cmd > $out
+end
+set exit_code $status
+
+if test $exit_code -ne 0
+  echo "error: dump failed with exit code $exit_code" >&2
+  exit $exit_code
+end
+
+set -l size ""
+if command -sq stat
+  # macOS stat prints size with -f%z; suppress errors if not supported
+  set size (stat -f%z $out 2>/dev/null)
+end
+if test -z "$size"
+  set size (wc -c < $out)
+end
+
+echo "Wrote $out ($size bytes)."
diff --git a/scripts/flaky-test-loop.sh b/scripts/flaky-test-loop.sh
index f95c4feab0..d4c03d1e91 100755
--- a/scripts/flaky-test-loop.sh
+++ b/scripts/flaky-test-loop.sh
@@ -161,7 +161,7 @@ while true; do
     HLS_TEST_HARNESS_STDERR="${LOG_STDERR}" \
     TASTY_NUM_THREADS=1 \
   TASTY_PATTERN="${pattern}" \
-  "$(get_bin_path "${bin_name}")" >"${log}" 2>&1
+  "$(get_bin_path "${bin_name}")" +RTS -l -olhlint.eventlog -RTS >"${log}" 2>&1
     set -e
 
   if grep -aFiq -- "${BROKEN_PIPE_RE}" "${log}"; then
@@ -170,7 +170,7 @@ while true; do
       echo "[loop] --- Tail (last 60 lines) ---" >&2
       tail -n 60 "${log}" >&2
       exit 1
-  elif grep -aEqi -- "${TEST_FAILED_RE}" "${log}"; then
+  elif grep -aEq -- "${TEST_FAILED_RE}" "${log}"; then
       echo "[loop] Test failure detected in iteration ${iter} for pattern '${pattern}'. Stopping." | tee -a "${log}" >&2
       echo "[loop] Log file: ${log} (abs: $(pwd)/${log})" | tee -a "${log}" >&2
       echo "[loop] --- Tail (last 60 lines) ---" >&2
diff --git a/scripts/flaky-test-patterns.txt b/scripts/flaky-test-patterns.txt
index debba3c54f..63f7a9df14 100644
--- a/scripts/flaky-test-patterns.txt
+++ b/scripts/flaky-test-patterns.txt
@@ -1,7 +1,7 @@
 # One tasty pattern per line. Lines starting with # are comments.
 # Blank lines are ignored.
 
-open close
+# open close
 # non local variable
 # Notification Handlers
 # bidirectional module dependency with hs-boot
@@ -14,4 +14,7 @@ open close
 # hls-pragmas-plugin-tests::/inline: RULES/
 
 # hls-graph cancel leaks asynchronous exception to the next session
-hls-hlint-plugin-tests::adding hlint flags to plugin configuration removes hlint diagnostics
+# hls-hlint-plugin-tests::adding hlint flags to plugin configuration removes hlint diagnostics
+# hls-explicit-imports-plugin-tests::ExplicitUsualCase inlay hints with client caps
+# hls-class-plugin-tests::Creates a placeholder for fmap
+hls-rename-plugin-tests::Rename

From 969bce9f5dc2717df96d56768a093dfb2da2a9b1 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 5 Sep 2025 19:18:53 +0800
Subject: [PATCH 51/61] workaround hlint bug

---
 plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
index 210e9f3910..1585965132 100644
--- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
+++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
@@ -66,7 +66,8 @@ import           System.Environment                                 (setEnv,
 import           Development.IDE.GHC.Compat                         (DynFlags,
                                                                      extensionFlags,
                                                                      ms_hspp_opts,
-                                                                     topDir)
+                                                                     topDir,
+                                                                     uninterruptibleMaskM_)
 import qualified Development.IDE.GHC.Compat.Util                    as EnumSet
 
 #if MIN_GHC_API_VERSION(9,4,0)
@@ -205,7 +206,7 @@ rules recorder plugin = do
 
   defineNoFile (cmapWithPrio LogShake recorder) $ \GetHlintSettings -> do
     (Config flags) <- getHlintConfig plugin
-    liftIO $ argsSettings flags
+    liftIO $ uninterruptibleMask_ $ argsSettings flags
 
   action $ do
     files <- Map.keys <$> getFilesOfInterestUntracked

From 8f37e25fcc1d0b662c736ffb3fb3bed2cdf3907c Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Fri, 5 Sep 2025 21:35:20 +0800
Subject: [PATCH 52/61] enforce build state changes

---
 hls-graph/src/Development/IDE/Graph/Internal/Database.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs b/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
index 026548203d..deee9b79a2 100644
--- a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
+++ b/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
@@ -122,17 +122,17 @@ builder db stack keys = do
     return res
 
 builderOne :: Database -> Stack -> Key -> AIO (Key, IO Result)
-builderOne db@Database {..} stack id = UE.mask_ $ do
+builderOne db@Database {..} stack id = UE.uninterruptibleMask $ \restore -> do
   current <- liftIO $ readTVarIO databaseStep
-  (k, registerWaitResult) <- liftIO $ atomicallyNamed "builder" $ do
+  (k, registerWaitResult) <- restore $ liftIO $ atomicallyNamed "builder" $ do
     -- Spawn the id if needed
     status <- SMap.lookup id databaseValues
     val <- case viewDirty current $ maybe (Dirty Nothing) keyStatus status of
       Dirty s -> do
         let act =
               asyncWithCleanUp
-                ( refresh db stack id s
-                    `UE.onException` liftIO (atomicallyNamed "builder - onException" (SMap.focus updateDirty id databaseValues))
+                ((restore $ refresh db stack id s)
+                    `UE.onException` UE.uninterruptibleMask_ (liftIO (atomicallyNamed "builder - onException" (SMap.focus updateDirty id databaseValues)))
                 )
         SMap.focus (updateStatus $ Running current s) id databaseValues
         return act

From 773bfee9967c38a1ec2d1a2c497b06dbea59d51d Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Sat, 6 Sep 2025 01:39:41 +0800
Subject: [PATCH 53/61] new hls-graph runtime

---
 ghcide/ghcide.cabal                           |   1 -
 .../session-loader/Development/IDE/Session.hs |  12 +-
 ghcide/src/Development/IDE/Core/Compile.hs    |   2 +-
 ghcide/src/Development/IDE/Core/FileStore.hs  |   2 +-
 ghcide/src/Development/IDE/Core/Shake.hs      | 208 ++++++++++--------
 .../src/Development/IDE/LSP/LanguageServer.hs |  10 +-
 hls-graph/hls-graph.cabal                     |   5 +
 hls-graph/src/Development/IDE/Graph.hs        |   1 +
 .../src/Development/IDE/Graph/Database.hs     |  13 +-
 .../IDE/Graph/Internal/Database.hs            | 141 ++++--------
 .../Development/IDE/Graph/Internal/Types.hs   |  62 +++++-
 .../src/Development/IDE}/WorkerThread.hs      |  91 +++++---
 hls-graph/test/ActionSpec.hs                  |  42 ++--
 hls-graph/test/DatabaseSpec.hs                |  17 +-
 .../src/Ide/Plugin/Cabal/OfInterest.hs        |   6 +-
 .../src/Ide/Plugin/Cabal/Rules.hs             |   2 +-
 .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs  |   2 +-
 scripts/eventlog-dump.fish                    |  25 ++-
 scripts/flaky-test-patterns.txt               |   6 +-
 19 files changed, 367 insertions(+), 281 deletions(-)
 rename {ghcide/src/Development/IDE/Core => hls-graph/src/Development/IDE}/WorkerThread.hs (56%)

diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal
index 7dd12f9fef..b9dd211fa5 100644
--- a/ghcide/ghcide.cabal
+++ b/ghcide/ghcide.cabal
@@ -142,7 +142,6 @@ library
     Development.IDE.Core.Shake
     Development.IDE.Core.Tracing
     Development.IDE.Core.UseStale
-    Development.IDE.Core.WorkerThread
     Development.IDE.GHC.Compat
     Development.IDE.GHC.Compat.Core
     Development.IDE.GHC.Compat.CmdLine
diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs
index 4be4fd78e2..4a0c34aad7 100644
--- a/ghcide/session-loader/Development/IDE/Session.hs
+++ b/ghcide/session-loader/Development/IDE/Session.hs
@@ -105,12 +105,12 @@ import qualified Data.HashSet                        as Set
 import qualified Data.Set                            as OS
 import           Database.SQLite.Simple
 import           Development.IDE.Core.Tracing        (withTrace)
-import           Development.IDE.Core.WorkerThread
 import qualified Development.IDE.GHC.Compat.Util     as Compat
 import           Development.IDE.Session.Diagnostics (renderCradleError)
 import           Development.IDE.Types.Shake         (WithHieDb,
                                                       WithHieDbShield (..),
                                                       toNoFileKey)
+import           Development.IDE.WorkerThread
 import           GHC.Data.Graph.Directed
 import           HieDb.Create
 import           HieDb.Types
@@ -153,6 +153,14 @@ data Log
   | LogSessionWorkerThread LogWorkerThread
 deriving instance Show Log
 
+instance Pretty LogWorkerThread where
+  pretty = \case
+    LogThreadEnding t -> "Worker thread ending:" <+> pretty t
+    LogThreadEnded t -> "Worker thread ended:" <+> pretty t
+    LogSingleWorkStarting t -> "Worker starting a unit of work: " <+> pretty t
+    LogSingleWorkEnded t -> "Worker ended a unit of work: " <+> pretty t
+    LogMainThreadId t tid -> "Main thread for" <+> pretty t <+> "is" <+> pretty (show tid)
+
 instance Pretty Log where
   pretty = \case
     LogSessionWorkerThread msg -> pretty msg
@@ -384,7 +392,7 @@ runWithDb recorder fp = ContT $ \k -> do
     _ <- withWriteDbRetryable deleteMissingRealFiles
     _ <- withWriteDbRetryable garbageCollectTypeNames
 
-    runContT (withWorkerQueue (cmapWithPrio LogSessionWorkerThread recorder) "hiedb thread" (writer withWriteDbRetryable))
+    runContT (withWorkerQueue (logWith (cmapWithPrio LogSessionWorkerThread recorder) Debug) "hiedb thread" (writer withWriteDbRetryable))
         $ \chan -> withHieDb fp (\readDb -> k (WithHieDbShield $ makeWithHieDbRetryable recorder rng readDb, chan))
   where
     writer withHieDbRetryable l = do
diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs
index 5a3039c5fe..d30eee8594 100644
--- a/ghcide/src/Development/IDE/Core/Compile.hs
+++ b/ghcide/src/Development/IDE/Core/Compile.hs
@@ -75,7 +75,7 @@ import           Development.IDE.Core.Preprocessor
 import           Development.IDE.Core.ProgressReporting       (progressUpdate)
 import           Development.IDE.Core.RuleTypes
 import           Development.IDE.Core.Shake
-import           Development.IDE.Core.WorkerThread            (writeTaskQueue)
+import           Development.IDE.WorkerThread            (writeTaskQueue)
 import           Development.IDE.Core.Tracing                 (withTrace)
 import qualified Development.IDE.GHC.Compat                   as Compat
 import qualified Development.IDE.GHC.Compat                   as GHC
diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs
index 37177a22d1..6b5650f90b 100644
--- a/ghcide/src/Development/IDE/Core/FileStore.hs
+++ b/ghcide/src/Development/IDE/Core/FileStore.hs
@@ -45,7 +45,6 @@ import           Development.IDE.Core.IdeConfiguration        (isWorkspaceFile)
 import           Development.IDE.Core.RuleTypes
 import           Development.IDE.Core.Shake                   hiding (Log)
 import qualified Development.IDE.Core.Shake                   as Shake
-import           Development.IDE.Core.WorkerThread
 import           Development.IDE.GHC.Orphans                  ()
 import           Development.IDE.Graph
 import           Development.IDE.Import.DependencyInformation
@@ -53,6 +52,7 @@ import           Development.IDE.Types.Diagnostics
 import           Development.IDE.Types.Location
 import           Development.IDE.Types.Options
 import           Development.IDE.Types.Shake                  (toKey)
+import           Development.IDE.WorkerThread
 import           HieDb.Create                                 (deleteMissingRealFiles)
 import           Ide.Logger                                   (Pretty (pretty),
                                                                Priority (Info),
diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs
index 7356d673d7..0c3e5e63d2 100644
--- a/ghcide/src/Development/IDE/Core/Shake.hs
+++ b/ghcide/src/Development/IDE/Core/Shake.hs
@@ -81,103 +81,108 @@ module Development.IDE.Core.Shake(
 
 import           Control.Concurrent.Async
 import           Control.Concurrent.STM
-import           Control.Concurrent.STM.Stats           (atomicallyNamed)
+import           Control.Concurrent.STM.Stats            (atomicallyNamed)
 import           Control.Concurrent.Strict
 import           Control.DeepSeq
-import           Control.Exception.Extra                hiding (bracket_)
-import           Control.Lens                           ((%~), (&), (?~))
+import           Control.Exception.Extra                 hiding (bracket_)
+import           Control.Lens                            ((%~), (&), (?~))
 import           Control.Monad.Extra
 import           Control.Monad.IO.Class
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Maybe
-import           Data.Aeson                             (Result (Success),
-                                                         toJSON)
-import qualified Data.Aeson.Types                       as A
-import qualified Data.ByteString.Char8                  as BS
-import qualified Data.ByteString.Char8                  as BS8
-import           Data.Coerce                            (coerce)
+import           Data.Aeson                              (Result (Success),
+                                                          toJSON)
+import qualified Data.Aeson.Types                        as A
+import qualified Data.ByteString.Char8                   as BS
+import qualified Data.ByteString.Char8                   as BS8
+import           Data.Coerce                             (coerce)
 import           Data.Default
 import           Data.Dynamic
-import           Data.EnumMap.Strict                    (EnumMap)
-import qualified Data.EnumMap.Strict                    as EM
-import           Data.Foldable                          (find, for_)
-import           Data.Functor                           ((<&>))
+import           Data.EnumMap.Strict                     (EnumMap)
+import qualified Data.EnumMap.Strict                     as EM
+import           Data.Foldable                           (find, for_)
+import           Data.Functor                            ((<&>))
 import           Data.Functor.Identity
 import           Data.Hashable
-import qualified Data.HashMap.Strict                    as HMap
-import           Data.HashSet                           (HashSet)
-import qualified Data.HashSet                           as HSet
-import           Data.List.Extra                        (foldl', partition,
-                                                         takeEnd)
-import qualified Data.Map.Strict                        as Map
+import qualified Data.HashMap.Strict                     as HMap
+import           Data.HashSet                            (HashSet)
+import qualified Data.HashSet                            as HSet
+import           Data.List.Extra                         (partition, takeEnd)
+import qualified Data.Map.Strict                         as Map
 import           Data.Maybe
-import qualified Data.SortedList                        as SL
-import           Data.String                            (fromString)
-import qualified Data.Text                              as T
+import qualified Data.SortedList                         as SL
+import           Data.String                             (fromString)
+import qualified Data.Text                               as T
 import           Data.Time
 import           Data.Traversable
 import           Data.Tuple.Extra
 import           Data.Typeable
 import           Data.Unique
-import           Data.Vector                            (Vector)
-import qualified Data.Vector                            as Vector
+import           Data.Vector                             (Vector)
+import qualified Data.Vector                             as Vector
 import           Development.IDE.Core.Debouncer
-import           Development.IDE.Core.FileUtils         (getModTime)
+import           Development.IDE.Core.FileUtils          (getModTime)
 import           Development.IDE.Core.PositionMapping
 import           Development.IDE.Core.ProgressReporting
 import           Development.IDE.Core.RuleTypes
-import           Development.IDE.Types.Options          as Options
-import qualified Language.LSP.Protocol.Message          as LSP
-import qualified Language.LSP.Server                    as LSP
+import           Development.IDE.Types.Options           as Options
+import qualified Language.LSP.Protocol.Message           as LSP
+import qualified Language.LSP.Server                     as LSP
 
 import           Development.IDE.Core.Tracing
-import           Development.IDE.Core.WorkerThread
-import           Development.IDE.GHC.Compat             (NameCache,
-                                                         NameCacheUpdater,
-                                                         initNameCache,
-                                                         knownKeyNames)
-import           Development.IDE.GHC.Orphans            ()
-import           Development.IDE.Graph                  hiding (ShakeValue,
-                                                         action)
-import qualified Development.IDE.Graph                  as Shake
-import           Development.IDE.Graph.Database         (ShakeDatabase,
-                                                         shakeGetBuildStep,
-                                                         shakeGetDatabaseKeys,
-                                                         shakeNewDatabase,
-                                                         shakeProfileDatabase,
-                                                         shakeRunDatabaseForKeys)
+import           Development.IDE.GHC.Compat              (NameCache,
+                                                          NameCacheUpdater,
+                                                          initNameCache,
+                                                          knownKeyNames)
+import           Development.IDE.GHC.Orphans             ()
+import           Development.IDE.Graph                   hiding (ShakeValue,
+                                                          action)
+import qualified Development.IDE.Graph                   as Shake
+import           Development.IDE.Graph.Database          (ShakeDatabase,
+                                                          shakeGetBuildStep,
+                                                          shakeGetDatabaseKeys,
+                                                          shakeNewDatabase,
+                                                          shakeProfileDatabase,
+                                                          shakeRunDatabaseForKeys,
+                                                          shakeShutDatabase)
+import           Development.IDE.Graph.Internal.Database (AsyncParentKill (AsyncParentKill))
+import           Development.IDE.Graph.Internal.Types    (Step (..),
+                                                          getShakeStep)
 import           Development.IDE.Graph.Rule
 import           Development.IDE.Types.Action
 import           Development.IDE.Types.Diagnostics
-import           Development.IDE.Types.Exports          hiding (exportsMapSize)
-import qualified Development.IDE.Types.Exports          as ExportsMap
+import           Development.IDE.Types.Exports           hiding (exportsMapSize)
+import qualified Development.IDE.Types.Exports           as ExportsMap
 import           Development.IDE.Types.KnownTargets
 import           Development.IDE.Types.Location
-import           Development.IDE.Types.Monitoring       (Monitoring (..))
+import           Development.IDE.Types.Monitoring        (Monitoring (..))
 import           Development.IDE.Types.Shake
+import           Development.IDE.WorkerThread
 import qualified Focus
 import           GHC.Fingerprint
-import           GHC.Stack                              (HasCallStack)
-import           GHC.TypeLits                           (KnownSymbol)
+import           GHC.Stack                               (HasCallStack)
+import           GHC.TypeLits                            (KnownSymbol)
 import           HieDb.Types
-import           Ide.Logger                             hiding (Priority)
-import qualified Ide.Logger                             as Logger
+import           Ide.Logger                              hiding (Priority)
+import qualified Ide.Logger                              as Logger
 import           Ide.Plugin.Config
-import qualified Ide.PluginUtils                        as HLS
+import qualified Ide.PluginUtils                         as HLS
 import           Ide.Types
-import qualified Language.LSP.Protocol.Lens             as L
+import qualified Language.LSP.Protocol.Lens              as L
 import           Language.LSP.Protocol.Message
 import           Language.LSP.Protocol.Types
-import qualified Language.LSP.Protocol.Types            as LSP
-import           Language.LSP.VFS                       hiding (start)
+import qualified Language.LSP.Protocol.Types             as LSP
+import           Language.LSP.VFS                        hiding (start)
 import qualified "list-t" ListT
-import           OpenTelemetry.Eventlog                 hiding (addEvent)
-import qualified Prettyprinter                          as Pretty
-import qualified StmContainers.Map                      as STM
-import           System.FilePath                        hiding (makeRelative)
-import           System.IO.Unsafe                       (unsafePerformIO)
+import           OpenTelemetry.Eventlog                  hiding (addEvent)
+import qualified Prettyprinter                           as Pretty
+import qualified StmContainers.Map                       as STM
+import           System.FilePath                         hiding (makeRelative)
+import           System.IO.Unsafe                        (unsafePerformIO)
 import           System.Time.Extra
-import           UnliftIO                               (MonadUnliftIO (withRunInIO))
+import           UnliftIO                                (MonadUnliftIO (withRunInIO))
+import qualified UnliftIO.Exception                      as UE
+
 
 
 data Log
@@ -186,7 +191,7 @@ data Log
   | LogBuildSessionRestart !String ![DelayedActionInternal] !KeySet !Seconds !(Maybe FilePath)
   | LogBuildSessionRestartTakingTooLong !Seconds
   | LogDelayedAction !(DelayedAction ()) !Seconds
-  | LogBuildSessionFinish !(Maybe SomeException)
+  | LogBuildSessionFinish !Step !(Maybe SomeException)
   | LogDiagsDiffButNoLspEnv ![FileDiagnostic]
   | LogDefineEarlyCutoffRuleNoDiagHasDiag !FileDiagnostic
   | LogDefineEarlyCutoffRuleCustomNewnessHasDiag !FileDiagnostic
@@ -196,10 +201,12 @@ data Log
   | LogShakeGarbageCollection !T.Text !Int !Seconds
   -- * OfInterest Log messages
   | LogSetFilesOfInterest ![(NormalizedFilePath, FileOfInterestStatus)]
+  | LogShakeText !T.Text
   deriving Show
 
 instance Pretty Log where
   pretty = \case
+    LogShakeText msg -> pretty msg
     LogCreateHieDbExportsMapStart ->
       "Initializing exports map from hiedb"
     LogCreateHieDbExportsMapFinish exportsMapSize ->
@@ -216,9 +223,10 @@ instance Pretty Log where
       hsep
         [ "Finished:" <+> pretty (actionName delayedAct)
         , "Took:" <+> pretty (showDuration seconds) ]
-    LogBuildSessionFinish e ->
+    LogBuildSessionFinish step e ->
       vcat
         [ "Finished build session"
+        , "Step:" <+> pretty (show step)
         , pretty (fmap displayException e) ]
     LogDiagsDiffButNoLspEnv fileDiagnostics ->
       "updateFileDiagnostics published different from new diagnostics - file diagnostics:"
@@ -715,6 +723,7 @@ shakeOpen recorder lspEnv defaultConfig idePlugins debouncer
         pure ShakeExtras{shakeRecorder = recorder, ..}
     shakeDb  <-
         shakeNewDatabase
+            restartQueue
             opts { shakeExtra = newShakeExtra shakeExtras }
             rules
     shakeSession <- newEmptyMVar
@@ -805,15 +814,22 @@ shakeRestart recorder IdeState{..} vfs reason acts ioActionBetweenShakeSession =
         withMVar'
             shakeSession
             (\runner -> do
-                (stopTime,()) <- duration $ logErrorAfter 10 $ cancelShakeSession runner
+                -- logWith recorder Info $ LogShakeText ("Restarting shake session: " <> T.pack reason)
+                logWith recorder Info $ LogShakeText ("0restarting shake session: " <> T.pack reason)
+                step <- withTrace "gettingShakeDB steps" $ const $ getShakeStep shakeDb
+                (stopTime,()) <- withTrace "cancelShakeSession in shakeRestart" $ \_ -> duration $ logErrorAfter 10 $ cancelShakeSession runner
+                queue <- withTrace "peekInProgress in shakeRestart" $ \_ ->  atomicallyNamed "actionQueue - peek" $ peekInProgress $ actionQueue shakeExtras
+                logWith recorder Info $ LogShakeText ("1restarting shake session: " <> T.pack (show step) <> " " <> T.pack reason <> ", waiting for current actions to finish: " <> T.pack (show (map actionName queue)))
                 keys <- ioActionBetweenShakeSession
+                -- logWith recorder Info $ LogShakeText ("2restarting shake session: " <> T.pack reason <> ", waiting for current actions to finish: " <> T.pack (show (map actionName queue)))
                 -- it is every important to update the dirty keys after we enter the critical section
                 -- see Note [Housekeeping rule cache and dirty key outside of hls-graph]
                 atomically $ modifyTVar' (dirtyKeys shakeExtras) $ \x -> foldl' (flip insertKeySet) x keys
+                -- logWith recorder Info $ LogShakeText ("3restarting shake session: " <> T.pack reason <> ", waiting for current actions to finish: " <> T.pack (show (map actionName queue)))
                 res <- shakeDatabaseProfile shakeDb
+                -- logWith recorder Info $ LogShakeText ("4restarting shake session: " <> T.pack reason <> ", waiting for current actions to finish: " <> T.pack (show (map actionName queue)))
                 backlog <- readTVarIO $ dirtyKeys shakeExtras
-                queue <- atomicallyNamed "actionQueue - peek" $ peekInProgress $ actionQueue shakeExtras
-
+                -- logWith recorder Info $ LogShakeText ("5restarting shake session: " <> T.pack reason <> ", waiting for current actions to finish: " <> T.pack (show (map actionName queue)))
                 -- this log is required by tests
                 logWith recorder Debug $ LogBuildSessionRestart reason queue backlog stopTime res
             )
@@ -871,6 +887,7 @@ newSession recorder extras@ShakeExtras{..} vfsMod shakeDb acts reason = do
 
     IdeOptions{optRunSubset} <- getIdeOptionsIO extras
     reenqueued <- atomicallyNamed "actionQueue - peek" $ peekInProgress actionQueue
+    step <- getShakeStep shakeDb
     allPendingKeys <-
         if optRunSubset
           then Just <$> readTVarIO dirtyKeys
@@ -880,7 +897,11 @@ newSession recorder extras@ShakeExtras{..} vfsMod shakeDb acts reason = do
         -- Runs actions from the work queue sequentially
         pumpActionThread otSpan = do
             d <- liftIO $ atomicallyNamed "action queue - pop" $ popQueue actionQueue
-            actionFork (run otSpan d) $ \_ -> pumpActionThread otSpan
+            actionFork (run otSpan d) $ \async -> do
+                tid <- liftIO myThreadId
+                logWith recorder Info $ LogShakeText ("Starting action thread: " <> T.pack (actionName d) <> " (" <> T.pack (show tid) <> ")")
+                pumpActionThread otSpan
+                liftIO $ wait async
 
         -- TODO figure out how to thread the otSpan into defineEarlyCutoff
         run _otSpan d  = do
@@ -891,33 +912,37 @@ newSession recorder extras@ShakeExtras{..} vfsMod shakeDb acts reason = do
             logWith recorder (actionPriority d) $ LogDelayedAction d runTime
 
         -- The inferred type signature doesn't work in ghc >= 9.0.1
-        workRun :: (forall b. IO b -> IO b) -> IO (IO ())
+        workRun :: (forall b. IO b -> IO b) -> IO ()
         workRun restore = withSpan "Shake session" $ \otSpan -> do
           setTag otSpan "reason" (fromString reason)
           setTag otSpan "queue" (fromString $ unlines $ map actionName reenqueued)
           whenJust allPendingKeys $ \kk -> setTag otSpan "keys" (BS8.pack $ unlines $ map show $ toListKeySet kk)
           let keysActs = pumpActionThread otSpan : map (run otSpan) (reenqueued ++ acts)
           res <- try @SomeException $
-            restore $ shakeRunDatabaseForKeys (toListKeySet <$> allPendingKeys) shakeDb keysActs
-          return $ do
-              let exception =
-                    case res of
-                      Left e -> Just e
-                      _      -> Nothing
-              logWith recorder Debug $ LogBuildSessionFinish exception
+                    restore $ shakeRunDatabaseForKeys (toListKeySet <$> allPendingKeys) shakeDb keysActs
+          logWith recorder Debug $ LogBuildSessionFinish step $
+            case res of
+                Left e -> Just e
+                _      -> Nothing
 
     -- Do the work in a background thread
-    workThread <- asyncWithUnmask workRun
+    parentTid <- myThreadId
+    workThread <- asyncWithUnmask $ \x -> do
+        childThreadId <- myThreadId
+        logWith recorder Info $ LogShakeText ("Starting shake thread: " <> T.pack (show childThreadId) <> " (parent: " <> T.pack (show parentTid) <> ")")
+        workRun x
 
-    -- run the wrap up in a separate thread since it contains interruptible
-    -- commands (and we are not using uninterruptible mask)
-    -- TODO: can possibly swallow exceptions?
-    _ <- async $ join $ wait workThread
 
     --  Cancelling is required to flush the Shake database when either
     --  the filesystem or the Ghc configuration have changed
+
     let cancelShakeSession :: IO ()
-        cancelShakeSession = cancel workThread
+        cancelShakeSession = do
+            logWith recorder Info $ LogShakeText ("Starting shake cancellation: " <> " (" <> T.pack (show reason) <> ")")
+            tid <- myThreadId
+            cancelWith workThread $ AsyncParentKill tid step
+            shakeShutDatabase shakeDb
+
 
     pure (ShakeSession{..})
 
@@ -1376,8 +1401,9 @@ updateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnosti
         newDiags <- liftIO $ atomicallyNamed "diagnostics - update" $ update (addTagUnsafe "shown ") currentShown diagnostics
         _ <- liftIO $ atomicallyNamed "diagnostics - hidden" $ update (addTagUnsafe "hidden ") currentHidden hiddenDiagnostics
         let uri' = filePathToUri' fp
-        let delay = if null newDiags then 0.1 else 0
-        registerEvent debouncer delay uri' $ withTrace ("report diagnostics " <> fromString (fromNormalizedFilePath fp)) $ \tag -> do
+        -- let delay = if null newDiags then 0.1 else 0
+        -- registerEvent debouncer delay uri' $ withTrace ("report diagnostics " <> fromString (fromNormalizedFilePath fp)) $ \tag -> do
+        withTrace ("report diagnostics " <> fromString (fromNormalizedFilePath fp)) $ \tag -> do
             join $ mask_ $ do
                 lastPublish <- atomicallyNamed "diagnostics - publish" $ STM.focus (Focus.lookupWithDefault [] <* Focus.insert newDiags) uri' publishedDiagnostics
                 let action = when (lastPublish /= newDiags) $ case lspEnv of
@@ -1483,9 +1509,17 @@ kickSignal testing lspEnv files msg = when testing $ liftIO $ mRunLspT lspEnv $
   toJSON $ map fromNormalizedFilePath files
 
 -- | Add kick start/done signal to rule
-runWithSignal :: (KnownSymbol s0, KnownSymbol s1, IdeRule k v) => Proxy s0 -> Proxy s1 -> [NormalizedFilePath] -> k -> Action ()
-runWithSignal msgStart msgEnd files rule = do
+runWithSignal :: (KnownSymbol s0, KnownSymbol s1, IdeRule k v) => Recorder (WithPriority Log) -> Proxy s0 -> Proxy s1 -> [NormalizedFilePath] -> k -> Action ()
+runWithSignal recorder msgStart msgEnd files rule = do
   ShakeExtras{ideTesting = Options.IdeTesting testing, lspEnv} <- getShakeExtras
-  kickSignal testing lspEnv files msgStart
-  void $ uses rule files
-  kickSignal testing lspEnv files msgEnd
+  UE.bracket
+    (withTrace ("runWithSignal begin " <> show rule) $ \_tag -> kickSignal testing lspEnv files msgStart
+    >> (logWith recorder Info $ LogShakeText (T.pack $ "Starting rule: " ++ show rule))
+    )
+    (const $
+    withTrace ("runWithSignal end " <> show rule) $ \_tag -> kickSignal testing lspEnv files msgEnd
+    >> (logWith recorder Info $ LogShakeText (T.pack $ "Finished rule: " ++ show rule))
+    )
+    (const $ void $ uses rule files
+    >> (logWith recorder Info $ LogShakeText (T.pack $ "Finishing rule: " ++ show rule))
+    )
diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
index d5d28ffaca..8948d719d1 100644
--- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs
+++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
@@ -46,14 +46,15 @@ import           Development.IDE.Core.IdeConfiguration
 import           Development.IDE.Core.Service          (shutdown)
 import           Development.IDE.Core.Shake            hiding (Log)
 import           Development.IDE.Core.Tracing
-import           Development.IDE.Core.WorkerThread
 import qualified Development.IDE.Session               as Session
 import           Development.IDE.Types.Shake           (WithHieDb,
                                                         WithHieDbShield (..))
+import           Development.IDE.WorkerThread
 import           Ide.Logger
 import           Language.LSP.Server                   (LanguageContextEnv,
                                                         LspServerLog,
                                                         type (<~>))
+import           System.Time.Extra                     (Seconds, sleep)
 import           System.Timeout                        (timeout)
 data Log
   = LogRegisteringIdeConfig !IdeConfiguration
@@ -67,10 +68,13 @@ data Log
   | LogShutDownTimeout Int
   | LogServerExitWith (Either () Int)
   | LogReactorShutdownConfirmed !T.Text
+  | LogInitializeIdeStateTookTooLong Seconds
   deriving Show
 
 instance Pretty Log where
   pretty = \case
+    LogInitializeIdeStateTookTooLong seconds ->
+        "Building the initial session took more than" <+> pretty seconds <+> "seconds"
     LogReactorShutdownRequested b ->
       "Requested reactor shutdown; stop signal posted: " <+> pretty b
     LogReactorShutdownConfirmed msg ->
@@ -350,8 +354,8 @@ handleInit initParams env (TRequestMessage _ _ m params) = otTracedHandler "Init
 runWithWorkerThreads :: Recorder (WithPriority Session.Log) -> FilePath -> (WithHieDb -> ThreadQueue -> IO ()) -> IO ()
 runWithWorkerThreads recorder dbLoc f = evalContT $ do
             (WithHieDbShield hiedb, threadQueue) <- runWithDb recorder dbLoc
-            sessionRestartTQueue <- withWorkerQueueSimple (cmapWithPrio Session.LogSessionWorkerThread recorder) "RestartTQueue"
-            sessionLoaderTQueue <- withWorkerQueueSimple (cmapWithPrio Session.LogSessionWorkerThread recorder) "SessionLoaderTQueue"
+            sessionRestartTQueue <- withWorkerQueueSimple (logWith (cmapWithPrio Session.LogSessionWorkerThread recorder) Debug) "RestartTQueue"
+            sessionLoaderTQueue <- withWorkerQueueSimple (logWith (cmapWithPrio Session.LogSessionWorkerThread recorder) Debug) "SessionLoaderTQueue"
             liftIO $ f hiedb (ThreadQueue threadQueue sessionRestartTQueue sessionLoaderTQueue)
 
 -- | Runs the action until it ends or until the given MVar is put.
diff --git a/hls-graph/hls-graph.cabal b/hls-graph/hls-graph.cabal
index 5eccb4d75e..faa1aba75d 100644
--- a/hls-graph/hls-graph.cabal
+++ b/hls-graph/hls-graph.cabal
@@ -65,11 +65,14 @@ library
     Development.IDE.Graph.KeyMap
     Development.IDE.Graph.KeySet
     Development.IDE.Graph.Rule
+    Development.IDE.WorkerThread
     Paths_hls_graph
 
   autogen-modules:    Paths_hls_graph
   hs-source-dirs:     src
   build-depends:
+    , mtl ^>=2.3.1
+    , safe-exceptions ^>=0.1.7.4
     , aeson
     , async                 >=2.0
     , base                  >=4.12    && <5
@@ -129,6 +132,7 @@ test-suite tests
     -threaded -rtsopts -with-rtsopts=-N -fno-ignore-asserts
 
   build-depends:
+    , transformers ^>=0.6.1.2
     , base
     , extra
     , hls-graph
@@ -138,5 +142,6 @@ test-suite tests
     , tasty
     , tasty-hspec >= 1.2
     , tasty-rerun
+    , transformers
 
   build-tool-depends: hspec-discover:hspec-discover
diff --git a/hls-graph/src/Development/IDE/Graph.hs b/hls-graph/src/Development/IDE/Graph.hs
index 81ad3b3dfd..915da203aa 100644
--- a/hls-graph/src/Development/IDE/Graph.hs
+++ b/hls-graph/src/Development/IDE/Graph.hs
@@ -18,6 +18,7 @@ module Development.IDE.Graph(
     -- * Actions for inspecting the keys in the database
     getDirtySet,
     getKeysAndVisitedAge,
+
     module Development.IDE.Graph.KeyMap,
     module Development.IDE.Graph.KeySet,
     ) where
diff --git a/hls-graph/src/Development/IDE/Graph/Database.hs b/hls-graph/src/Development/IDE/Graph/Database.hs
index bd8601cd16..0283bb8823 100644
--- a/hls-graph/src/Development/IDE/Graph/Database.hs
+++ b/hls-graph/src/Development/IDE/Graph/Database.hs
@@ -9,7 +9,8 @@ module Development.IDE.Graph.Database(
     shakeGetDatabaseKeys,
     shakeGetDirtySet,
     shakeGetCleanKeys
-    ,shakeGetBuildEdges) where
+    ,shakeGetBuildEdges,
+    shakeShutDatabase) where
 import           Control.Concurrent.STM.Stats            (readTVarIO)
 import           Data.Dynamic
 import           Data.Maybe
@@ -21,16 +22,20 @@ import           Development.IDE.Graph.Internal.Options
 import           Development.IDE.Graph.Internal.Profile  (writeProfile)
 import           Development.IDE.Graph.Internal.Rules
 import           Development.IDE.Graph.Internal.Types
+import           Development.IDE.WorkerThread            (TaskQueue)
 
 
 -- Placeholder to be the 'extra' if the user doesn't set it
 data NonExportedType = NonExportedType
 
-shakeNewDatabase :: ShakeOptions -> Rules () -> IO ShakeDatabase
-shakeNewDatabase opts rules = do
+shakeShutDatabase :: ShakeDatabase -> IO ()
+shakeShutDatabase (ShakeDatabase _ _ db) = shutDatabase db
+
+shakeNewDatabase :: TaskQueue (IO ()) -> ShakeOptions -> Rules () -> IO ShakeDatabase
+shakeNewDatabase que opts rules = do
     let extra = fromMaybe (toDyn NonExportedType) $ shakeExtra opts
     (theRules, actions) <- runRules extra rules
-    db <- newDatabase extra theRules
+    db <- newDatabase que extra theRules
     pure $ ShakeDatabase (length actions) actions db
 
 shakeRunDatabase :: ShakeDatabase -> [Action a] -> IO [a]
diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs b/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
index deee9b79a2..2c0a02cbbf 100644
--- a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
+++ b/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
@@ -12,9 +12,7 @@ module Development.IDE.Graph.Internal.Database (compute, newDatabase, incDatabas
 
 import           Prelude                              hiding (unzip)
 
-import           Control.Concurrent.Async
-import           Control.Concurrent.Extra
-import           Control.Concurrent.STM.Stats         (STM, TVar, atomically,
+import           Control.Concurrent.STM.Stats         (STM, atomically,
                                                        atomicallyNamed,
                                                        modifyTVar', newTVarIO,
                                                        readTVar, readTVarIO,
@@ -31,7 +29,7 @@ import           Data.IORef.Extra
 import           Data.Maybe
 import           Data.Traversable                     (for)
 import           Data.Tuple.Extra
-import           Debug.Trace                          (traceM)
+import           Debug.Trace                          (traceEvent)
 import           Development.IDE.Graph.Classes
 import           Development.IDE.Graph.Internal.Key
 import           Development.IDE.Graph.Internal.Rules
@@ -39,20 +37,21 @@ import           Development.IDE.Graph.Internal.Types
 import qualified Focus
 import qualified ListT
 import qualified StmContainers.Map                    as SMap
-import           System.Time.Extra                    (duration, sleep)
-import           UnliftIO                             (MonadUnliftIO (withRunInIO))
-import qualified UnliftIO.Exception                   as UE
+import           System.Time.Extra                    (duration)
 
 #if MIN_VERSION_base(4,19,0)
 import           Data.Functor                         (unzip)
 #else
 import           Data.List.NonEmpty                   (unzip)
 #endif
+import           Development.IDE.WorkerThread         (TaskQueue,
+                                                       awaitRunInThreadStmInNewThread)
 
 
-newDatabase :: Dynamic -> TheRules -> IO Database
-newDatabase databaseExtra databaseRules = do
+newDatabase :: TaskQueue (IO ()) -> Dynamic -> TheRules -> IO Database
+newDatabase databaseQueue databaseExtra databaseRules = do
     databaseStep <- newTVarIO $ Step 0
+    databaseThreads <- newTVarIO []
     databaseValues <- atomically SMap.new
     pure Database{..}
 
@@ -100,8 +99,9 @@ build db stack keys = do
             else throw $ AsyncParentKill i $ Step (-1)
     where
     go = do
-        step <- readTVarIO $ databaseStep db
-        !built <- runAIO step $ builder db stack (fmap newKey keys)
+        -- step <- readTVarIO $ databaseStep db
+        -- built <- mapConcurrently (builderOne db stack) (fmap newKey keys)
+        built <- builder db stack (fmap newKey keys)
         let (ids, vs) = unzip built
         pure (ids, fmap (asV . resultValue) vs)
         where
@@ -112,38 +112,39 @@ build db stack keys = do
 -- | Build a list of keys and return their results.
 --  If none of the keys are dirty, we can return the results immediately.
 --  Otherwise, a blocking computation is returned *which must be evaluated asynchronously* to avoid deadlock.
-builder :: (Traversable f) => Database -> Stack -> f Key -> AIO (f (Key, Result))
+builder :: (Traversable f) => Database -> Stack -> f Key -> IO (f (Key, Result))
 -- builder _ st kk | traceShow ("builder", st,kk) False = undefined
-builder db stack keys = do
-    keyWaits <- for keys $ \k -> builderOne db stack k
-    !res <- for keyWaits $ \(k, waitR) -> do
-        !v<- liftIO waitR
-        return (k, v)
-    return res
+builder db stack keys = for keys $ \k -> builderOne db stack k
 
-builderOne :: Database -> Stack -> Key -> AIO (Key, IO Result)
-builderOne db@Database {..} stack id = UE.uninterruptibleMask $ \restore -> do
-  current <- liftIO $ readTVarIO databaseStep
-  (k, registerWaitResult) <- restore $ liftIO $ atomicallyNamed "builder" $ do
+builderOne :: Database -> Stack -> Key -> IO (Key, Result)
+builderOne db@Database {..} stack id = do
+  traceEvent ("builderOne: " ++ show id) return ()
+  res <- liftIO $ atomicallyNamed "builder" $ do
     -- Spawn the id if needed
     status <- SMap.lookup id databaseValues
+    current@(Step cs) <- readTVar databaseStep
+    let getStep = do
+            Step current <- readTVar databaseStep
+            return current
+
     val <- case viewDirty current $ maybe (Dirty Nothing) keyStatus status of
       Dirty s -> do
-        let act =
-              asyncWithCleanUp
-                ((restore $ refresh db stack id s)
-                    `UE.onException` UE.uninterruptibleMask_ (liftIO (atomicallyNamed "builder - onException" (SMap.focus updateDirty id databaseValues)))
-                )
         SMap.focus (updateStatus $ Running current s) id databaseValues
-        return act
-      Clean r -> pure . pure . pure $ r
+        traceEvent ("Starting build of key: " ++ show id ++ ", step "++ show current)
+            $ awaitRunInThreadStmInNewThread getStep cs databaseQueue databaseThreads  (refresh db stack id s)
+            $ \e -> atomically $ SMap.focus (updateStatus $ Exception current e s) id databaseValues
+        return Nothing
+      Clean r -> return $ Just r
       -- force here might contains async exceptions from previous runs
       Running _step _s
         | memberStack id stack -> throw $ StackException stack
         | otherwise -> retry
-    pure (id, val)
-  waitR <- registerWaitResult
-  return (k, waitR)
+      Exception _ e _s -> throw e
+    pure val
+  case res of
+    Just r  -> return (id, r)
+    Nothing -> builderOne db stack id
+
 -- | isDirty
 -- only dirty when it's build time is older than the changed time of one of its dependencies
 isDirty :: Foldable t => Result -> t (a, Result) -> Bool
@@ -156,30 +157,27 @@ isDirty me = any (\(_,dep) -> resultBuilt me < resultChanged dep)
 -- * If no dirty dependencies and we have evaluated the key previously, then we refresh it in the current thread.
 --   This assumes that the implementation will be a lookup
 -- * Otherwise, we spawn a new thread to refresh the dirty deps (if any) and the key itself
-refreshDeps :: KeySet -> Database -> Stack -> Key -> Result -> [KeySet] -> AIO Result
+refreshDeps :: KeySet -> Database -> Stack -> Key -> Result -> [KeySet] -> IO Result
 refreshDeps visited db stack key result = \case
     -- no more deps to refresh
-    [] -> compute' db stack key RunDependenciesSame (Just result)
+    [] -> compute db stack key RunDependenciesSame (Just result)
     (dep:deps) -> do
         let newVisited = dep <> visited
         res <- builder db stack (toListKeySet (dep `differenceKeySet` visited))
         if isDirty result res
                 -- restart the computation if any of the deps are dirty
-                then compute' db stack key RunDependenciesChanged (Just result)
+                then compute db stack key RunDependenciesChanged (Just result)
                 -- else kick the rest of the deps
                 else refreshDeps newVisited db stack key result deps
 
 
 -- refresh :: Database -> Stack -> Key -> Maybe Result -> IO Result
 -- refresh _ st k _ | traceShow ("refresh", st, k) False = undefined
-refresh :: Database -> Stack -> Key -> Maybe Result -> AIO Result
+refresh :: Database -> Stack -> Key -> Maybe Result -> IO Result
 refresh db stack key result = case (addStack key stack, result) of
     (Left e, _) -> throw e
     (Right stack, Just me@Result{resultDeps = ResultDeps deps}) -> refreshDeps mempty db stack key me (reverse deps)
-    (Right stack, _) -> compute' db stack key RunDependenciesChanged result
-
-compute' :: Database -> Stack -> Key -> RunMode -> Maybe Result -> AIO Result
-compute' db stack key mode result = liftIO $ compute db stack key mode result
+    (Right stack, _) -> compute db stack key RunDependenciesChanged result
 -- | Compute a key.
 compute :: Database -> Stack -> Key -> RunMode -> Maybe Result -> IO Result
 -- compute _ st k _ _ | traceShow ("compute", st, k) False = undefined
@@ -284,68 +282,5 @@ transitiveDirtySet database = flip State.execStateT mempty . traverse_ loop
             next <- lift $ atomically $ getReverseDependencies database x
             traverse_ loop (maybe mempty toListKeySet next)
 
---------------------------------------------------------------------------------
--- Asynchronous computations with cancellation
-
--- | A simple monad to implement cancellation on top of 'Async',
---   generalizing 'withAsync' to monadic scopes.
-newtype AIO a = AIO { unAIO :: ReaderT (TVar [Async ()]) IO a }
-  deriving newtype (Applicative, Functor, Monad, MonadIO)
-
-data AsyncParentKill = AsyncParentKill ThreadId Step
-    deriving (Show, Eq)
-
-instance Exception AsyncParentKill where
-  toException = asyncExceptionToException
-  fromException = asyncExceptionFromException
-
--- | Run the monadic computation, cancelling all the spawned asyncs if an exception arises
-runAIO :: Step -> AIO a -> IO a
-runAIO s (AIO act) = do
-    asyncsRef <- newTVarIO []
-    -- Log the exact exception (including async exceptions) before cleanup,
-    -- then rethrow to preserve previous semantics.
-    runReaderT act asyncsRef `onException` do
-        asyncs <- atomically $ do
-            r <- readTVar asyncsRef
-            modifyTVar' asyncsRef $ const []
-            return r
-        tid <- myThreadId
-        cleanupAsync asyncs tid s
-
--- | Like 'async' but with built-in cancellation.
---   Returns an IO action to wait on the result.
-asyncWithCleanUp :: AIO a -> AIO (IO a)
-asyncWithCleanUp act = do
-    st <- AIO ask
-    io <- unliftAIO act
-    -- mask to make sure we keep track of the spawned async
-    liftIO $ uninterruptibleMask $ \restore -> do
-        a <- async $ restore io
-        atomically $ modifyTVar' st (void a :)
-        return $ wait a
-
-unliftAIO :: AIO a -> AIO (IO a)
-unliftAIO act = do
-    st <- AIO ask
-    return $ runReaderT (unAIO act) st
 
-instance MonadUnliftIO AIO where
-    withRunInIO k = do
-        st <- AIO ask
-        liftIO $ k (\aio -> runReaderT (unAIO aio) st)
 
-cleanupAsync :: [Async a] -> ThreadId -> Step -> IO ()
--- mask to make sure we interrupt all the asyncs
-cleanupAsync asyncs tid step  = uninterruptibleMask $ \unmask -> do
-    -- interrupt all the asyncs without waiting
-    -- mapM_ (\a -> throwTo (asyncThreadId a) AsyncCancelled) asyncs
-    mapM_ (\a -> throwTo (asyncThreadId a) $ AsyncParentKill tid step) asyncs
-    -- Wait until all the asyncs are done
-    -- But if it takes more than 10 seconds, log to stderr
-    unless (null asyncs) $ do
-        let warnIfTakingTooLong = unmask $ forever $ do
-                sleep 10
-                traceM "cleanupAsync: waiting for asyncs to finish"
-        withAsync warnIfTakingTooLong $ \_ ->
-            mapM_ waitCatch asyncs
diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs
index dc8fa33eb6..c05be86ef6 100644
--- a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs
+++ b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs
@@ -5,7 +5,8 @@
 
 module Development.IDE.Graph.Internal.Types where
 
-import           Control.Concurrent.STM             (STM)
+import           Control.Concurrent.STM             (STM, modifyTVar')
+import           Control.Monad                      (forever, unless)
 import           Control.Monad.Catch
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Reader
@@ -19,15 +20,24 @@ import           Data.IORef
 import           Data.List                          (intercalate)
 import           Data.Maybe
 import           Data.Typeable
+import           Debug.Trace                        (traceEventIO, traceM)
 import           Development.IDE.Graph.Classes
 import           Development.IDE.Graph.Internal.Key
+import           Development.IDE.WorkerThread       (TaskQueue)
 import           GHC.Conc                           (TVar, atomically)
 import           GHC.Generics                       (Generic)
 import qualified ListT
 import qualified StmContainers.Map                  as SMap
 import           StmContainers.Map                  (Map)
-import           System.Time.Extra                  (Seconds)
-import           UnliftIO                           (MonadUnliftIO, readTVarIO)
+import           System.Time.Extra                  (Seconds, sleep)
+import           UnliftIO                           (Async (asyncThreadId),
+                                                     MonadUnliftIO,
+                                                     asyncExceptionFromException,
+                                                     asyncExceptionToException,
+                                                     cancel, readTVarIO,
+                                                     throwTo, waitCatch,
+                                                     withAsync)
+import           UnliftIO.Concurrent                (ThreadId, myThreadId)
 
 #if !MIN_VERSION_base(4,18,0)
 import           Control.Applicative                (liftA2)
@@ -114,12 +124,41 @@ onKeyReverseDeps f it@KeyDetails{..} =
     it{keyReverseDeps = f keyReverseDeps}
 
 data Database = Database {
-    databaseExtra  :: Dynamic,
-    databaseRules  :: TheRules,
-    databaseStep   :: !(TVar Step),
-    databaseValues :: !(Map Key KeyDetails)
+    databaseExtra   :: Dynamic,
+
+    databaseThreads :: TVar [Async ()],
+    databaseQueue   :: TaskQueue (IO ()),
+
+    databaseRules   :: TheRules,
+    databaseStep    :: !(TVar Step),
+    databaseValues  :: !(Map Key KeyDetails)
     }
 
+data AsyncParentKill = AsyncParentKill ThreadId Step
+    deriving (Show, Eq)
+
+instance Exception AsyncParentKill where
+  toException = asyncExceptionToException
+  fromException = asyncExceptionFromException
+
+shutDatabase :: Database -> IO ()
+shutDatabase Database{..} = uninterruptibleMask $ \unmask -> do
+    -- wait for all threads to finish
+    asyncs <- readTVarIO databaseThreads
+    step <- readTVarIO databaseStep
+    tid <- myThreadId
+    traceEventIO ("shutDatabase: cancelling " ++ show (length asyncs) ++ " asyncs, step " ++ show step)
+    mapM_ (\a -> throwTo (asyncThreadId a) $ AsyncParentKill tid step) asyncs
+    atomically $ modifyTVar' databaseThreads (const [])
+    -- Wait until all the asyncs are done
+    -- But if it takes more than 10 seconds, log to stderr
+    unless (null asyncs) $ do
+        let warnIfTakingTooLong = unmask $ forever $ do
+                sleep 10
+                traceM "cleanupAsync: waiting for asyncs to finish"
+        withAsync warnIfTakingTooLong $ \_ ->
+            mapM_ waitCatch asyncs
+
 -- waitForDatabaseRunningKeys :: Database -> IO ()
 -- waitForDatabaseRunningKeys = getDatabaseValues >=> mapM_ (waitRunning . snd)
 
@@ -133,6 +172,7 @@ getDatabaseValues = atomically
 data Status
     = Clean !Result
     | Dirty (Maybe Result)
+    | Exception !Step !SomeException !(Maybe Result)
     | Running {
         runningStep :: !Step,
         -- runningWait   :: !(IO ()),
@@ -142,12 +182,14 @@ data Status
 
 viewDirty :: Step -> Status -> Status
 viewDirty currentStep (Running s re) | currentStep /= s = Dirty re
+viewDirty currentStep (Exception s _ re) | currentStep /= s = Dirty re
 viewDirty _ other = other
 
 getResult :: Status -> Maybe Result
-getResult (Clean re)       = Just re
-getResult (Dirty m_re)     = m_re
-getResult (Running _ m_re) = m_re -- watch out: this returns the previous result
+getResult (Clean re)           = Just re
+getResult (Dirty m_re)         = m_re
+getResult (Running _ m_re)     = m_re -- watch out: this returns the previous result
+getResult (Exception _ _ m_re) = m_re
 
 -- waitRunning :: Status -> IO ()
 -- waitRunning Running{..} = runningWait
diff --git a/ghcide/src/Development/IDE/Core/WorkerThread.hs b/hls-graph/src/Development/IDE/WorkerThread.hs
similarity index 56%
rename from ghcide/src/Development/IDE/Core/WorkerThread.hs
rename to hls-graph/src/Development/IDE/WorkerThread.hs
index 1c55d21c99..4ffc9ab8a2 100644
--- a/ghcide/src/Development/IDE/Core/WorkerThread.hs
+++ b/hls-graph/src/Development/IDE/WorkerThread.hs
@@ -1,44 +1,52 @@
 {-
-Module : Development.IDE.Core.WorkerThread
+Module : Development.IDE.WorkerThread
 Author : @soulomoon
 SPDX-License-Identifier: Apache-2.0
 
 Description : This module provides an API for managing worker threads in the IDE.
 see Note [Serializing runs in separate thread]
 -}
-module Development.IDE.Core.WorkerThread
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Development.IDE.WorkerThread
   ( LogWorkerThread (..),
     withWorkerQueue,
     awaitRunInThread,
     TaskQueue,
     writeTaskQueue,
-    withWorkerQueueSimple
-  )
-where
+    withWorkerQueueSimple,
+    awaitRunInThreadStm,
+    awaitRunInThreadStmInNewThread
+  ) where
 
-import           Control.Concurrent.Async  (withAsync)
+import           Control.Concurrent.Async (Async, async, withAsync)
 import           Control.Concurrent.STM
-import           Control.Concurrent.Strict (newBarrier, signalBarrier,
-                                            waitBarrier)
-import           Control.Exception.Safe    (SomeException, finally, throwIO,
-                                            try)
-import           Control.Monad.Cont        (ContT (ContT))
-import qualified Data.Text                 as T
-import           Ide.Logger
+import           Control.Exception.Safe   (MonadMask (..),
+                                           SomeException (SomeException),
+                                           finally, throw, try)
+import           Control.Monad.Cont       (ContT (ContT))
+import qualified Data.Text                as T
+
+import           Control.Concurrent
+import           Control.Exception        (catch)
+import           Control.Monad            (void, when)
 
 data LogWorkerThread
   = LogThreadEnding !T.Text
   | LogThreadEnded !T.Text
   | LogSingleWorkStarting !T.Text
   | LogSingleWorkEnded !T.Text
+  | LogMainThreadId !T.Text !ThreadId
   deriving (Show)
 
-instance Pretty LogWorkerThread where
-  pretty = \case
-    LogThreadEnding t -> "Worker thread ending:" <+> pretty t
-    LogThreadEnded t -> "Worker thread ended:" <+> pretty t
-    LogSingleWorkStarting t -> "Worker starting a unit of work: " <+> pretty t
-    LogSingleWorkEnded t -> "Worker ended a unit of work: " <+> pretty t
+-- instance Pretty LogWorkerThread where
+--   pretty = \case
+--     LogThreadEnding t -> "Worker thread ending:" <+> pretty t
+--     LogThreadEnded t -> "Worker thread ended:" <+> pretty t
+--     LogSingleWorkStarting t -> "Worker starting a unit of work: " <+> pretty t
+--     LogSingleWorkEnded t -> "Worker ended a unit of work: " <+> pretty t
+--     LogMainThreadId t tid -> "Main thread for" <+> pretty t <+> "is" <+> pretty (show tid)
 
 {-
 Note [Serializing runs in separate thread]
@@ -54,14 +62,17 @@ data TaskQueue a = TaskQueue (TQueue a)
 newTaskQueueIO :: IO (TaskQueue a)
 newTaskQueueIO = TaskQueue <$> newTQueueIO
 data ExitOrTask t = Exit | Task t
+type Logger = LogWorkerThread -> IO ()
 
 -- | 'withWorkerQueue' creates a new 'TQueue', and launches a worker
 -- thread which polls the queue for requests and runs the given worker
 -- function on them.
-withWorkerQueueSimple :: Recorder (WithPriority LogWorkerThread) -> T.Text -> ContT () IO (TaskQueue (IO ()))
+withWorkerQueueSimple :: Logger -> T.Text -> ContT () IO (TaskQueue (IO ()))
 withWorkerQueueSimple log title = withWorkerQueue log title id
-withWorkerQueue :: Recorder (WithPriority LogWorkerThread) -> T.Text -> (t -> IO ()) -> ContT () IO (TaskQueue t)
+withWorkerQueue :: Logger -> T.Text -> (t -> IO ()) -> ContT () IO (TaskQueue t)
 withWorkerQueue log title workerAction = ContT $ \mainAction -> do
+  tid <- myThreadId
+  log (LogMainThreadId title tid)
   q <- newTaskQueueIO
   -- Use a TMVar as a stop flag to coordinate graceful shutdown.
   -- The worker thread checks this flag before dequeuing each job; if set, it exits immediately,
@@ -76,8 +87,8 @@ withWorkerQueue log title workerAction = ContT $ \mainAction -> do
     -- if we want to debug the exact location the worker swallows an async exception, we can
     -- temporarily comment out the `finally` clause.
         `finally` atomically (putTMVar b ())
-    logWith log Debug (LogThreadEnding title)
-  logWith log Debug (LogThreadEnded title)
+    log (LogThreadEnding title)
+  log (LogThreadEnded title)
   where
     -- writerThread :: TaskQueue t -> TMVar () -> (forall a. IO a -> IO a) -> IO ()
     writerThread q b =
@@ -93,24 +104,46 @@ withWorkerQueue log title workerAction = ContT $ \mainAction -> do
         case task of
           Exit -> return ()
           Task t -> do
-                logWith log Debug $ LogSingleWorkStarting title
+                log $ LogSingleWorkStarting title
                 workerAction t
-                logWith log Debug $ LogSingleWorkEnded title
+                log $ LogSingleWorkEnded title
                 writerThread q b
 
 
 -- | 'awaitRunInThread' queues up an 'IO' action to be run by a worker thread,
 -- and then blocks until the result is computed. If the action throws an
 -- non-async exception, it is rethrown in the calling thread.
+awaitRunInThreadStm :: TaskQueue (IO ()) -> IO result -> STM result
+awaitRunInThreadStm (TaskQueue q) act = do
+  barrier <- newEmptyTMVar
+  -- Take an action from TQueue, run it and
+  -- use barrier to wait for the result
+  writeTQueue q (try act >>= atomically . putTMVar barrier)
+  resultOrException <- takeTMVar barrier
+  case resultOrException of
+    Left e  -> throw (e :: SomeException)
+    Right r -> return r
+
+awaitRunInThreadStmInNewThread :: STM Int -> Int -> TaskQueue (IO ()) -> TVar [Async ()] -> IO result -> (SomeException -> IO ()) -> STM ()
+awaitRunInThreadStmInNewThread getStep deliverStep (TaskQueue q) tthreads act handler = do
+  -- Take an action from TQueue, run it and
+  -- use barrier to wait for the result
+  writeTQueue q (uninterruptibleMask $ \restore -> do
+    curStep <- atomically getStep
+    when (curStep == deliverStep) $ do
+        sync <- async (restore (void act `catch` \(SomeException e) -> handler (SomeException e)))
+        atomically $ modifyTVar' tthreads (sync:)
+    )
+
 awaitRunInThread :: TaskQueue (IO ()) -> IO result -> IO result
 awaitRunInThread (TaskQueue q) act = do
+  barrier <- newEmptyTMVarIO
   -- Take an action from TQueue, run it and
   -- use barrier to wait for the result
-  barrier <- newBarrier
-  atomically $ writeTQueue q (try act >>= signalBarrier barrier)
-  resultOrException <- waitBarrier barrier
+  atomically $ writeTQueue q (try act >>= atomically . putTMVar barrier)
+  resultOrException <- atomically $ takeTMVar barrier
   case resultOrException of
-    Left e  -> throwIO (e :: SomeException)
+    Left e  -> throw (e :: SomeException)
     Right r -> return r
 
 writeTaskQueue :: TaskQueue a -> a -> STM ()
diff --git a/hls-graph/test/ActionSpec.hs b/hls-graph/test/ActionSpec.hs
index 97ab5555ac..a17d11a617 100644
--- a/hls-graph/test/ActionSpec.hs
+++ b/hls-graph/test/ActionSpec.hs
@@ -7,6 +7,7 @@ import           Control.Concurrent                      (MVar, readMVar)
 import qualified Control.Concurrent                      as C
 import           Control.Concurrent.STM
 import           Control.Monad.IO.Class                  (MonadIO (..))
+import           Control.Monad.Trans.Cont                (evalContT)
 import           Development.IDE.Graph                   (shakeOptions)
 import           Development.IDE.Graph.Database          (shakeNewDatabase,
                                                           shakeRunDatabase,
@@ -15,15 +16,22 @@ import           Development.IDE.Graph.Internal.Database (build, incDatabase)
 import           Development.IDE.Graph.Internal.Key
 import           Development.IDE.Graph.Internal.Types
 import           Development.IDE.Graph.Rule
+import           Development.IDE.WorkerThread            (TaskQueue,
+                                                          withWorkerQueueSimple)
 import           Example
 import qualified StmContainers.Map                       as STM
 import           Test.Hspec
 
 
 
+itInThread :: String -> (TaskQueue (IO ()) -> IO ()) -> SpecWith ()
+itInThread name ex = it name $ evalContT $ do
+    thread <- withWorkerQueueSimple (const $ return ()) "hls-graph test"
+    liftIO $ ex thread
+
 spec :: Spec
 spec = do
-  describe "apply1" $ it "Test build update, Buggy dirty mechanism in hls-graph #4237" $ do
+  describe "apply1" $ itInThread "Test build update, Buggy dirty mechanism in hls-graph #4237" $ \q -> do
     let ruleStep1 :: MVar Int -> Rules ()
         ruleStep1 m = addRule $ \CountRule _old mode -> do
             -- depends on ruleSubBranch, it always changed if dirty
@@ -39,7 +47,7 @@ spec = do
                     return $ RunResult ChangedNothing "" r (return ())
     count <- C.newMVar 0
     count1 <- C.newMVar 0
-    db <- shakeNewDatabase shakeOptions $ do
+    db <- shakeNewDatabase q shakeOptions $ do
       ruleSubBranch count
       ruleStep1 count1
     -- bootstrapping the database
@@ -58,20 +66,20 @@ spec = do
     _res3 <- shakeRunDatabaseForKeys (Just [parent]) db [apply1 CountRule] -- count = 2
     c1 <- readMVar count1
     c1 `shouldBe` 2
-  describe "apply1" $ do
-    it "computes a rule with no dependencies" $ do
-      db <- shakeNewDatabase shakeOptions ruleUnit
+  describe "apply1" $  do
+    itInThread "computes a rule with no dependencies" $ \q -> do
+      db <- shakeNewDatabase q shakeOptions ruleUnit
       res <- shakeRunDatabase db $
         pure $ apply1 (Rule @())
       res `shouldBe` [()]
-    it "computes a rule with one dependency" $ do
-      db <- shakeNewDatabase shakeOptions $ do
+    itInThread "computes a rule with one dependency" $ \q -> do
+      db <- shakeNewDatabase q shakeOptions $ do
         ruleUnit
         ruleBool
       res <- shakeRunDatabase db $ pure $ apply1 Rule
       res `shouldBe` [True]
-    it "tracks direct dependencies" $ do
-      db@(ShakeDatabase _ _ theDb) <- shakeNewDatabase shakeOptions $ do
+    itInThread "tracks direct dependencies" $ \q -> do
+      db@(ShakeDatabase _ _ theDb) <- shakeNewDatabase q shakeOptions $ do
         ruleUnit
         ruleBool
       let theKey = Rule @Bool
@@ -80,8 +88,8 @@ spec = do
       res `shouldBe` [True]
       Just (Clean res) <- lookup (newKey theKey) <$> getDatabaseValues theDb
       resultDeps res `shouldBe` ResultDeps [singletonKeySet $ newKey (Rule @())]
-    it "tracks reverse dependencies" $ do
-      db@(ShakeDatabase _ _ Database {..}) <- shakeNewDatabase shakeOptions $ do
+    itInThread "tracks reverse dependencies" $ \q -> do
+      db@(ShakeDatabase _ _ Database {..}) <- shakeNewDatabase q shakeOptions $ do
         ruleUnit
         ruleBool
       let theKey = Rule @Bool
@@ -90,14 +98,14 @@ spec = do
       res `shouldBe` [True]
       Just KeyDetails {..} <- atomically $ STM.lookup (newKey (Rule @())) databaseValues
       keyReverseDeps `shouldBe` singletonKeySet (newKey theKey)
-    it "rethrows exceptions" $ do
-      db <- shakeNewDatabase shakeOptions $ addRule $ \(Rule :: Rule ()) _old _mode -> error "boom"
+    itInThread "rethrows exceptions" $ \q -> do
+      db <- shakeNewDatabase q shakeOptions $ addRule $ \(Rule :: Rule ()) _old _mode -> error "boom"
       let res = shakeRunDatabase db $ pure $ apply1 (Rule @())
       res `shouldThrow` anyErrorCall
-    it "computes a rule with branching dependencies does not invoke phantom dependencies #3423" $ do
+    itInThread "computes a rule with branching dependencies does not invoke phantom dependencies #3423" $ \q -> do
       cond <- C.newMVar True
       count <- C.newMVar 0
-      (ShakeDatabase _ _ theDb) <- shakeNewDatabase shakeOptions $ do
+      (ShakeDatabase _ _ theDb) <- shakeNewDatabase q shakeOptions $ do
         ruleUnit
         ruleCond cond
         ruleSubBranch count
@@ -116,8 +124,8 @@ spec = do
       countRes <- build theDb emptyStack [SubBranchRule]
       snd countRes `shouldBe` [1 :: Int]
 
-  describe "applyWithoutDependency" $ it "does not track dependencies" $ do
-    db@(ShakeDatabase _ _ theDb) <- shakeNewDatabase shakeOptions $ do
+  describe "applyWithoutDependency" $ itInThread "does not track dependencies" $ \q -> do
+    db@(ShakeDatabase _ _ theDb) <- shakeNewDatabase q shakeOptions $ do
       ruleUnit
       addRule $ \Rule _old _mode -> do
           [()] <- applyWithoutDependency [Rule]
diff --git a/hls-graph/test/DatabaseSpec.hs b/hls-graph/test/DatabaseSpec.hs
index 9061bfa89d..bf78779bc6 100644
--- a/hls-graph/test/DatabaseSpec.hs
+++ b/hls-graph/test/DatabaseSpec.hs
@@ -2,6 +2,8 @@
 
 module DatabaseSpec where
 
+import           Control.Monad.IO.Class                  (MonadIO (..))
+import           Control.Monad.Trans.Cont                (evalContT)
 import           Development.IDE.Graph                   (newKey, shakeOptions)
 import           Development.IDE.Graph.Database          (shakeNewDatabase,
                                                           shakeRunDatabase)
@@ -9,16 +11,22 @@ import           Development.IDE.Graph.Internal.Action   (apply1)
 import           Development.IDE.Graph.Internal.Database (compute, incDatabase)
 import           Development.IDE.Graph.Internal.Rules    (addRule)
 import           Development.IDE.Graph.Internal.Types
+import           Development.IDE.WorkerThread
 import           Example
 import           System.Time.Extra                       (timeout)
 import           Test.Hspec
 
 
+itInThread :: String -> (TaskQueue (IO ()) -> IO ()) -> SpecWith ()
+itInThread name ex = it name $ evalContT $ do
+    thread <- withWorkerQueueSimple (const $ return ()) "hls-graph test"
+    liftIO $ ex thread
+
 spec :: Spec
 spec = do
     describe "Evaluation" $ do
-        it "detects cycles" $ do
-            db <- shakeNewDatabase shakeOptions $ do
+        itInThread "detects cycles" $ \q -> do
+            db <- shakeNewDatabase q shakeOptions $ do
                 ruleBool
                 addRule $ \Rule _old _mode -> do
                     True <- apply1 (Rule @Bool)
@@ -27,10 +35,9 @@ spec = do
             timeout 1 res `shouldThrow` \StackException{} -> True
 
     describe "compute" $ do
-      it "build step and changed step updated correctly" $ do
-        (ShakeDatabase _ _ theDb) <- shakeNewDatabase shakeOptions $ do
+      itInThread "build step and changed step updated correctly" $ \q -> do
+        (ShakeDatabase _ _ theDb) <- shakeNewDatabase q shakeOptions $ do
           ruleStep
-
         let k = newKey $ Rule @()
         -- ChangedRecomputeSame
         r1@Result{resultChanged=rc1, resultBuilt=rb1} <- compute theDb emptyStack k RunDependenciesChanged Nothing
diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/OfInterest.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/OfInterest.hs
index 67cf97ccee..784b8b1b99 100644
--- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/OfInterest.hs
+++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/OfInterest.hs
@@ -116,7 +116,7 @@ actions to produce diagnostics for cabal files.
 It is paramount that this kick-function can be run quickly, since it is a blocking
 function invocation.
 -}
-kick :: Action ()
-kick = do
+kick :: Recorder (WithPriority Shake.Log) -> Action ()
+kick recorder = do
   files <- HashMap.keys <$> getCabalFilesOfInterestUntracked
-  Shake.runWithSignal (Proxy @"kick/start/cabal") (Proxy @"kick/done/cabal") files Types.ParseCabalFile
+  Shake.runWithSignal recorder (Proxy @"kick/start/cabal") (Proxy @"kick/done/cabal") files Types.ParseCabalFile
diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Rules.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Rules.hs
index de7bb9a5fd..7c287349dd 100644
--- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Rules.hs
+++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Rules.hs
@@ -155,6 +155,6 @@ cabalRules recorder plId = do
     -- Run the cabal kick. This code always runs when 'shakeRestart' is run.
     -- Must be careful to not impede the performance too much. Crucial to
     -- a snappy IDE experience.
-    OfInterest.kick
+    OfInterest.kick (cmapWithPrio LogShake recorder)
  where
   log' = logWith recorder
diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
index 1585965132..98e3a8a7dd 100644
--- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
+++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
@@ -210,7 +210,7 @@ rules recorder plugin = do
 
   action $ do
     files <- Map.keys <$> getFilesOfInterestUntracked
-    Shake.runWithSignal (Proxy @"kick/start/hlint") (Proxy @"kick/done/hlint") files GetHlintDiagnostics
+    Shake.runWithSignal (cmapWithPrio LogShake recorder) (Proxy @"kick/start/hlint") (Proxy @"kick/done/hlint") files GetHlintDiagnostics
 
   where
 
diff --git a/scripts/eventlog-dump.fish b/scripts/eventlog-dump.fish
index 5122b48590..55c8932862 100755
--- a/scripts/eventlog-dump.fish
+++ b/scripts/eventlog-dump.fish
@@ -40,11 +40,12 @@ set filter_prefix ""
 if test (count $argv) -ge 3
   set filter_prefix $argv[3]
 end
-
-# Optional contains filter: only keep lines that contain this substring (applied after prefix filter if both provided)
+# Optional contains filter: only keep lines that contain any of the substrings (pipe-separated)
 set filter_contains ""
+set filter_contains_list
 if test (count $argv) -ge 4
   set filter_contains $argv[4]
+  set filter_contains_list (string split '|' -- $filter_contains)
 end
 
 function find_ghc_events --description "echo absolute path to ghc-events or empty"
@@ -80,19 +81,23 @@ if test -z "$ghc_events_bin"
 end
 
 echo "Dumping events from $evlog to $out..."
-set -l stream_cmd "$ghc_events_bin show $evlog"
-
 if test -n "$filter_prefix" -o -n "$filter_contains"
-  # Stream through filters
-  eval $stream_cmd | while read -l line
-    set -l keep 1
+  $ghc_events_bin show $evlog | while read -l line
+    set keep 1
     if test -n "$filter_prefix"
       if not string match -q -- "$filter_prefix*" -- $line
         set keep 0
       end
     end
-    if test $keep -eq 1 -a -n "$filter_contains"
-      if not string match -q -- "*$filter_contains*" -- $line
+    if test $keep -eq 1 -a (count $filter_contains_list) -gt 0
+      set found 0
+      for substr in $filter_contains_list
+        if string match -q -- "*$substr*" -- $line
+          set found 1
+          break
+        end
+      end
+      if test $found -eq 0
         set keep 0
       end
     end
@@ -101,7 +106,7 @@ if test -n "$filter_prefix" -o -n "$filter_contains"
     end
   end > $out
 else
-  eval $stream_cmd > $out
+  $ghc_events_bin show $evlog > $out
 end
 set exit_code $status
 
diff --git a/scripts/flaky-test-patterns.txt b/scripts/flaky-test-patterns.txt
index 63f7a9df14..004b3e98df 100644
--- a/scripts/flaky-test-patterns.txt
+++ b/scripts/flaky-test-patterns.txt
@@ -1,12 +1,12 @@
 # One tasty pattern per line. Lines starting with # are comments.
 # Blank lines are ignored.
 
-# open close
+open close
 # non local variable
 # Notification Handlers
-# bidirectional module dependency with hs-boot
+bidirectional module dependency with hs-boot
 
-# InternalError over InvalidParams
+InternalError over InvalidParams
 # ghcide restarts shake session on config changes:
 # addDependentFile
 # Another interesting one you can try:

From b771ed25c3e1eb5e89dd4176d7786dcd6c8082a3 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Sun, 7 Sep 2025 06:37:57 +0800
Subject: [PATCH 54/61] update script

---
 scripts/flaky-test-loop.sh | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/scripts/flaky-test-loop.sh b/scripts/flaky-test-loop.sh
index d4c03d1e91..c072783cd1 100755
--- a/scripts/flaky-test-loop.sh
+++ b/scripts/flaky-test-loop.sh
@@ -58,7 +58,7 @@ echo "[loop] Starting at ${start_ts}" >&2
 # - Use case-insensitive extended regex for failures/timeouts in logs
 # - Broken pipe: case-insensitive fixed-string search
 BROKEN_PIPE_RE='Broken pipe'
-TEST_FAILED_RE='failed|timeout'
+TEST_FAILED_RE='tests failed|timeout'
 DEBUG_DETECT="${DEBUG_DETECT:-0}"
 
 # Resolve what to run each iteration as pairs of BIN and PATTERN

From 08e7a8a409ae3dd3d74a74ebe12a0ad3703869cb Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Sun, 7 Sep 2025 07:12:38 +0800
Subject: [PATCH 55/61] Revert "new hls-graph runtime"

This reverts commit 773bfee9967c38a1ec2d1a2c497b06dbea59d51d.
---
 ghcide/ghcide.cabal                           |   1 +
 .../session-loader/Development/IDE/Session.hs |  12 +-
 ghcide/src/Development/IDE/Core/Compile.hs    |   2 +-
 ghcide/src/Development/IDE/Core/FileStore.hs  |   2 +-
 ghcide/src/Development/IDE/Core/Shake.hs      | 208 ++++++++----------
 .../src/Development/IDE/Core}/WorkerThread.hs |  91 +++-----
 .../src/Development/IDE/LSP/LanguageServer.hs |  10 +-
 hls-graph/hls-graph.cabal                     |   5 -
 hls-graph/src/Development/IDE/Graph.hs        |   1 -
 .../src/Development/IDE/Graph/Database.hs     |  13 +-
 .../IDE/Graph/Internal/Database.hs            | 141 ++++++++----
 .../Development/IDE/Graph/Internal/Types.hs   |  62 +-----
 hls-graph/test/ActionSpec.hs                  |  42 ++--
 hls-graph/test/DatabaseSpec.hs                |  17 +-
 .../src/Ide/Plugin/Cabal/OfInterest.hs        |   6 +-
 .../src/Ide/Plugin/Cabal/Rules.hs             |   2 +-
 .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs  |   2 +-
 scripts/eventlog-dump.fish                    |  25 +--
 scripts/flaky-test-patterns.txt               |   6 +-
 19 files changed, 281 insertions(+), 367 deletions(-)
 rename {hls-graph/src/Development/IDE => ghcide/src/Development/IDE/Core}/WorkerThread.hs (56%)

diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal
index b9dd211fa5..7dd12f9fef 100644
--- a/ghcide/ghcide.cabal
+++ b/ghcide/ghcide.cabal
@@ -142,6 +142,7 @@ library
     Development.IDE.Core.Shake
     Development.IDE.Core.Tracing
     Development.IDE.Core.UseStale
+    Development.IDE.Core.WorkerThread
     Development.IDE.GHC.Compat
     Development.IDE.GHC.Compat.Core
     Development.IDE.GHC.Compat.CmdLine
diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs
index 4a0c34aad7..4be4fd78e2 100644
--- a/ghcide/session-loader/Development/IDE/Session.hs
+++ b/ghcide/session-loader/Development/IDE/Session.hs
@@ -105,12 +105,12 @@ import qualified Data.HashSet                        as Set
 import qualified Data.Set                            as OS
 import           Database.SQLite.Simple
 import           Development.IDE.Core.Tracing        (withTrace)
+import           Development.IDE.Core.WorkerThread
 import qualified Development.IDE.GHC.Compat.Util     as Compat
 import           Development.IDE.Session.Diagnostics (renderCradleError)
 import           Development.IDE.Types.Shake         (WithHieDb,
                                                       WithHieDbShield (..),
                                                       toNoFileKey)
-import           Development.IDE.WorkerThread
 import           GHC.Data.Graph.Directed
 import           HieDb.Create
 import           HieDb.Types
@@ -153,14 +153,6 @@ data Log
   | LogSessionWorkerThread LogWorkerThread
 deriving instance Show Log
 
-instance Pretty LogWorkerThread where
-  pretty = \case
-    LogThreadEnding t -> "Worker thread ending:" <+> pretty t
-    LogThreadEnded t -> "Worker thread ended:" <+> pretty t
-    LogSingleWorkStarting t -> "Worker starting a unit of work: " <+> pretty t
-    LogSingleWorkEnded t -> "Worker ended a unit of work: " <+> pretty t
-    LogMainThreadId t tid -> "Main thread for" <+> pretty t <+> "is" <+> pretty (show tid)
-
 instance Pretty Log where
   pretty = \case
     LogSessionWorkerThread msg -> pretty msg
@@ -392,7 +384,7 @@ runWithDb recorder fp = ContT $ \k -> do
     _ <- withWriteDbRetryable deleteMissingRealFiles
     _ <- withWriteDbRetryable garbageCollectTypeNames
 
-    runContT (withWorkerQueue (logWith (cmapWithPrio LogSessionWorkerThread recorder) Debug) "hiedb thread" (writer withWriteDbRetryable))
+    runContT (withWorkerQueue (cmapWithPrio LogSessionWorkerThread recorder) "hiedb thread" (writer withWriteDbRetryable))
         $ \chan -> withHieDb fp (\readDb -> k (WithHieDbShield $ makeWithHieDbRetryable recorder rng readDb, chan))
   where
     writer withHieDbRetryable l = do
diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs
index d30eee8594..5a3039c5fe 100644
--- a/ghcide/src/Development/IDE/Core/Compile.hs
+++ b/ghcide/src/Development/IDE/Core/Compile.hs
@@ -75,7 +75,7 @@ import           Development.IDE.Core.Preprocessor
 import           Development.IDE.Core.ProgressReporting       (progressUpdate)
 import           Development.IDE.Core.RuleTypes
 import           Development.IDE.Core.Shake
-import           Development.IDE.WorkerThread            (writeTaskQueue)
+import           Development.IDE.Core.WorkerThread            (writeTaskQueue)
 import           Development.IDE.Core.Tracing                 (withTrace)
 import qualified Development.IDE.GHC.Compat                   as Compat
 import qualified Development.IDE.GHC.Compat                   as GHC
diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs
index 6b5650f90b..37177a22d1 100644
--- a/ghcide/src/Development/IDE/Core/FileStore.hs
+++ b/ghcide/src/Development/IDE/Core/FileStore.hs
@@ -45,6 +45,7 @@ import           Development.IDE.Core.IdeConfiguration        (isWorkspaceFile)
 import           Development.IDE.Core.RuleTypes
 import           Development.IDE.Core.Shake                   hiding (Log)
 import qualified Development.IDE.Core.Shake                   as Shake
+import           Development.IDE.Core.WorkerThread
 import           Development.IDE.GHC.Orphans                  ()
 import           Development.IDE.Graph
 import           Development.IDE.Import.DependencyInformation
@@ -52,7 +53,6 @@ import           Development.IDE.Types.Diagnostics
 import           Development.IDE.Types.Location
 import           Development.IDE.Types.Options
 import           Development.IDE.Types.Shake                  (toKey)
-import           Development.IDE.WorkerThread
 import           HieDb.Create                                 (deleteMissingRealFiles)
 import           Ide.Logger                                   (Pretty (pretty),
                                                                Priority (Info),
diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs
index 0c3e5e63d2..7356d673d7 100644
--- a/ghcide/src/Development/IDE/Core/Shake.hs
+++ b/ghcide/src/Development/IDE/Core/Shake.hs
@@ -81,108 +81,103 @@ module Development.IDE.Core.Shake(
 
 import           Control.Concurrent.Async
 import           Control.Concurrent.STM
-import           Control.Concurrent.STM.Stats            (atomicallyNamed)
+import           Control.Concurrent.STM.Stats           (atomicallyNamed)
 import           Control.Concurrent.Strict
 import           Control.DeepSeq
-import           Control.Exception.Extra                 hiding (bracket_)
-import           Control.Lens                            ((%~), (&), (?~))
+import           Control.Exception.Extra                hiding (bracket_)
+import           Control.Lens                           ((%~), (&), (?~))
 import           Control.Monad.Extra
 import           Control.Monad.IO.Class
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Maybe
-import           Data.Aeson                              (Result (Success),
-                                                          toJSON)
-import qualified Data.Aeson.Types                        as A
-import qualified Data.ByteString.Char8                   as BS
-import qualified Data.ByteString.Char8                   as BS8
-import           Data.Coerce                             (coerce)
+import           Data.Aeson                             (Result (Success),
+                                                         toJSON)
+import qualified Data.Aeson.Types                       as A
+import qualified Data.ByteString.Char8                  as BS
+import qualified Data.ByteString.Char8                  as BS8
+import           Data.Coerce                            (coerce)
 import           Data.Default
 import           Data.Dynamic
-import           Data.EnumMap.Strict                     (EnumMap)
-import qualified Data.EnumMap.Strict                     as EM
-import           Data.Foldable                           (find, for_)
-import           Data.Functor                            ((<&>))
+import           Data.EnumMap.Strict                    (EnumMap)
+import qualified Data.EnumMap.Strict                    as EM
+import           Data.Foldable                          (find, for_)
+import           Data.Functor                           ((<&>))
 import           Data.Functor.Identity
 import           Data.Hashable
-import qualified Data.HashMap.Strict                     as HMap
-import           Data.HashSet                            (HashSet)
-import qualified Data.HashSet                            as HSet
-import           Data.List.Extra                         (partition, takeEnd)
-import qualified Data.Map.Strict                         as Map
+import qualified Data.HashMap.Strict                    as HMap
+import           Data.HashSet                           (HashSet)
+import qualified Data.HashSet                           as HSet
+import           Data.List.Extra                        (foldl', partition,
+                                                         takeEnd)
+import qualified Data.Map.Strict                        as Map
 import           Data.Maybe
-import qualified Data.SortedList                         as SL
-import           Data.String                             (fromString)
-import qualified Data.Text                               as T
+import qualified Data.SortedList                        as SL
+import           Data.String                            (fromString)
+import qualified Data.Text                              as T
 import           Data.Time
 import           Data.Traversable
 import           Data.Tuple.Extra
 import           Data.Typeable
 import           Data.Unique
-import           Data.Vector                             (Vector)
-import qualified Data.Vector                             as Vector
+import           Data.Vector                            (Vector)
+import qualified Data.Vector                            as Vector
 import           Development.IDE.Core.Debouncer
-import           Development.IDE.Core.FileUtils          (getModTime)
+import           Development.IDE.Core.FileUtils         (getModTime)
 import           Development.IDE.Core.PositionMapping
 import           Development.IDE.Core.ProgressReporting
 import           Development.IDE.Core.RuleTypes
-import           Development.IDE.Types.Options           as Options
-import qualified Language.LSP.Protocol.Message           as LSP
-import qualified Language.LSP.Server                     as LSP
+import           Development.IDE.Types.Options          as Options
+import qualified Language.LSP.Protocol.Message          as LSP
+import qualified Language.LSP.Server                    as LSP
 
 import           Development.IDE.Core.Tracing
-import           Development.IDE.GHC.Compat              (NameCache,
-                                                          NameCacheUpdater,
-                                                          initNameCache,
-                                                          knownKeyNames)
-import           Development.IDE.GHC.Orphans             ()
-import           Development.IDE.Graph                   hiding (ShakeValue,
-                                                          action)
-import qualified Development.IDE.Graph                   as Shake
-import           Development.IDE.Graph.Database          (ShakeDatabase,
-                                                          shakeGetBuildStep,
-                                                          shakeGetDatabaseKeys,
-                                                          shakeNewDatabase,
-                                                          shakeProfileDatabase,
-                                                          shakeRunDatabaseForKeys,
-                                                          shakeShutDatabase)
-import           Development.IDE.Graph.Internal.Database (AsyncParentKill (AsyncParentKill))
-import           Development.IDE.Graph.Internal.Types    (Step (..),
-                                                          getShakeStep)
+import           Development.IDE.Core.WorkerThread
+import           Development.IDE.GHC.Compat             (NameCache,
+                                                         NameCacheUpdater,
+                                                         initNameCache,
+                                                         knownKeyNames)
+import           Development.IDE.GHC.Orphans            ()
+import           Development.IDE.Graph                  hiding (ShakeValue,
+                                                         action)
+import qualified Development.IDE.Graph                  as Shake
+import           Development.IDE.Graph.Database         (ShakeDatabase,
+                                                         shakeGetBuildStep,
+                                                         shakeGetDatabaseKeys,
+                                                         shakeNewDatabase,
+                                                         shakeProfileDatabase,
+                                                         shakeRunDatabaseForKeys)
 import           Development.IDE.Graph.Rule
 import           Development.IDE.Types.Action
 import           Development.IDE.Types.Diagnostics
-import           Development.IDE.Types.Exports           hiding (exportsMapSize)
-import qualified Development.IDE.Types.Exports           as ExportsMap
+import           Development.IDE.Types.Exports          hiding (exportsMapSize)
+import qualified Development.IDE.Types.Exports          as ExportsMap
 import           Development.IDE.Types.KnownTargets
 import           Development.IDE.Types.Location
-import           Development.IDE.Types.Monitoring        (Monitoring (..))
+import           Development.IDE.Types.Monitoring       (Monitoring (..))
 import           Development.IDE.Types.Shake
-import           Development.IDE.WorkerThread
 import qualified Focus
 import           GHC.Fingerprint
-import           GHC.Stack                               (HasCallStack)
-import           GHC.TypeLits                            (KnownSymbol)
+import           GHC.Stack                              (HasCallStack)
+import           GHC.TypeLits                           (KnownSymbol)
 import           HieDb.Types
-import           Ide.Logger                              hiding (Priority)
-import qualified Ide.Logger                              as Logger
+import           Ide.Logger                             hiding (Priority)
+import qualified Ide.Logger                             as Logger
 import           Ide.Plugin.Config
-import qualified Ide.PluginUtils                         as HLS
+import qualified Ide.PluginUtils                        as HLS
 import           Ide.Types
-import qualified Language.LSP.Protocol.Lens              as L
+import qualified Language.LSP.Protocol.Lens             as L
 import           Language.LSP.Protocol.Message
 import           Language.LSP.Protocol.Types
-import qualified Language.LSP.Protocol.Types             as LSP
-import           Language.LSP.VFS                        hiding (start)
+import qualified Language.LSP.Protocol.Types            as LSP
+import           Language.LSP.VFS                       hiding (start)
 import qualified "list-t" ListT
-import           OpenTelemetry.Eventlog                  hiding (addEvent)
-import qualified Prettyprinter                           as Pretty
-import qualified StmContainers.Map                       as STM
-import           System.FilePath                         hiding (makeRelative)
-import           System.IO.Unsafe                        (unsafePerformIO)
+import           OpenTelemetry.Eventlog                 hiding (addEvent)
+import qualified Prettyprinter                          as Pretty
+import qualified StmContainers.Map                      as STM
+import           System.FilePath                        hiding (makeRelative)
+import           System.IO.Unsafe                       (unsafePerformIO)
 import           System.Time.Extra
-import           UnliftIO                                (MonadUnliftIO (withRunInIO))
-import qualified UnliftIO.Exception                      as UE
-
+import           UnliftIO                               (MonadUnliftIO (withRunInIO))
 
 
 data Log
@@ -191,7 +186,7 @@ data Log
   | LogBuildSessionRestart !String ![DelayedActionInternal] !KeySet !Seconds !(Maybe FilePath)
   | LogBuildSessionRestartTakingTooLong !Seconds
   | LogDelayedAction !(DelayedAction ()) !Seconds
-  | LogBuildSessionFinish !Step !(Maybe SomeException)
+  | LogBuildSessionFinish !(Maybe SomeException)
   | LogDiagsDiffButNoLspEnv ![FileDiagnostic]
   | LogDefineEarlyCutoffRuleNoDiagHasDiag !FileDiagnostic
   | LogDefineEarlyCutoffRuleCustomNewnessHasDiag !FileDiagnostic
@@ -201,12 +196,10 @@ data Log
   | LogShakeGarbageCollection !T.Text !Int !Seconds
   -- * OfInterest Log messages
   | LogSetFilesOfInterest ![(NormalizedFilePath, FileOfInterestStatus)]
-  | LogShakeText !T.Text
   deriving Show
 
 instance Pretty Log where
   pretty = \case
-    LogShakeText msg -> pretty msg
     LogCreateHieDbExportsMapStart ->
       "Initializing exports map from hiedb"
     LogCreateHieDbExportsMapFinish exportsMapSize ->
@@ -223,10 +216,9 @@ instance Pretty Log where
       hsep
         [ "Finished:" <+> pretty (actionName delayedAct)
         , "Took:" <+> pretty (showDuration seconds) ]
-    LogBuildSessionFinish step e ->
+    LogBuildSessionFinish e ->
       vcat
         [ "Finished build session"
-        , "Step:" <+> pretty (show step)
         , pretty (fmap displayException e) ]
     LogDiagsDiffButNoLspEnv fileDiagnostics ->
       "updateFileDiagnostics published different from new diagnostics - file diagnostics:"
@@ -723,7 +715,6 @@ shakeOpen recorder lspEnv defaultConfig idePlugins debouncer
         pure ShakeExtras{shakeRecorder = recorder, ..}
     shakeDb  <-
         shakeNewDatabase
-            restartQueue
             opts { shakeExtra = newShakeExtra shakeExtras }
             rules
     shakeSession <- newEmptyMVar
@@ -814,22 +805,15 @@ shakeRestart recorder IdeState{..} vfs reason acts ioActionBetweenShakeSession =
         withMVar'
             shakeSession
             (\runner -> do
-                -- logWith recorder Info $ LogShakeText ("Restarting shake session: " <> T.pack reason)
-                logWith recorder Info $ LogShakeText ("0restarting shake session: " <> T.pack reason)
-                step <- withTrace "gettingShakeDB steps" $ const $ getShakeStep shakeDb
-                (stopTime,()) <- withTrace "cancelShakeSession in shakeRestart" $ \_ -> duration $ logErrorAfter 10 $ cancelShakeSession runner
-                queue <- withTrace "peekInProgress in shakeRestart" $ \_ ->  atomicallyNamed "actionQueue - peek" $ peekInProgress $ actionQueue shakeExtras
-                logWith recorder Info $ LogShakeText ("1restarting shake session: " <> T.pack (show step) <> " " <> T.pack reason <> ", waiting for current actions to finish: " <> T.pack (show (map actionName queue)))
+                (stopTime,()) <- duration $ logErrorAfter 10 $ cancelShakeSession runner
                 keys <- ioActionBetweenShakeSession
-                -- logWith recorder Info $ LogShakeText ("2restarting shake session: " <> T.pack reason <> ", waiting for current actions to finish: " <> T.pack (show (map actionName queue)))
                 -- it is every important to update the dirty keys after we enter the critical section
                 -- see Note [Housekeeping rule cache and dirty key outside of hls-graph]
                 atomically $ modifyTVar' (dirtyKeys shakeExtras) $ \x -> foldl' (flip insertKeySet) x keys
-                -- logWith recorder Info $ LogShakeText ("3restarting shake session: " <> T.pack reason <> ", waiting for current actions to finish: " <> T.pack (show (map actionName queue)))
                 res <- shakeDatabaseProfile shakeDb
-                -- logWith recorder Info $ LogShakeText ("4restarting shake session: " <> T.pack reason <> ", waiting for current actions to finish: " <> T.pack (show (map actionName queue)))
                 backlog <- readTVarIO $ dirtyKeys shakeExtras
-                -- logWith recorder Info $ LogShakeText ("5restarting shake session: " <> T.pack reason <> ", waiting for current actions to finish: " <> T.pack (show (map actionName queue)))
+                queue <- atomicallyNamed "actionQueue - peek" $ peekInProgress $ actionQueue shakeExtras
+
                 -- this log is required by tests
                 logWith recorder Debug $ LogBuildSessionRestart reason queue backlog stopTime res
             )
@@ -887,7 +871,6 @@ newSession recorder extras@ShakeExtras{..} vfsMod shakeDb acts reason = do
 
     IdeOptions{optRunSubset} <- getIdeOptionsIO extras
     reenqueued <- atomicallyNamed "actionQueue - peek" $ peekInProgress actionQueue
-    step <- getShakeStep shakeDb
     allPendingKeys <-
         if optRunSubset
           then Just <$> readTVarIO dirtyKeys
@@ -897,11 +880,7 @@ newSession recorder extras@ShakeExtras{..} vfsMod shakeDb acts reason = do
         -- Runs actions from the work queue sequentially
         pumpActionThread otSpan = do
             d <- liftIO $ atomicallyNamed "action queue - pop" $ popQueue actionQueue
-            actionFork (run otSpan d) $ \async -> do
-                tid <- liftIO myThreadId
-                logWith recorder Info $ LogShakeText ("Starting action thread: " <> T.pack (actionName d) <> " (" <> T.pack (show tid) <> ")")
-                pumpActionThread otSpan
-                liftIO $ wait async
+            actionFork (run otSpan d) $ \_ -> pumpActionThread otSpan
 
         -- TODO figure out how to thread the otSpan into defineEarlyCutoff
         run _otSpan d  = do
@@ -912,37 +891,33 @@ newSession recorder extras@ShakeExtras{..} vfsMod shakeDb acts reason = do
             logWith recorder (actionPriority d) $ LogDelayedAction d runTime
 
         -- The inferred type signature doesn't work in ghc >= 9.0.1
-        workRun :: (forall b. IO b -> IO b) -> IO ()
+        workRun :: (forall b. IO b -> IO b) -> IO (IO ())
         workRun restore = withSpan "Shake session" $ \otSpan -> do
           setTag otSpan "reason" (fromString reason)
           setTag otSpan "queue" (fromString $ unlines $ map actionName reenqueued)
           whenJust allPendingKeys $ \kk -> setTag otSpan "keys" (BS8.pack $ unlines $ map show $ toListKeySet kk)
           let keysActs = pumpActionThread otSpan : map (run otSpan) (reenqueued ++ acts)
           res <- try @SomeException $
-                    restore $ shakeRunDatabaseForKeys (toListKeySet <$> allPendingKeys) shakeDb keysActs
-          logWith recorder Debug $ LogBuildSessionFinish step $
-            case res of
-                Left e -> Just e
-                _      -> Nothing
+            restore $ shakeRunDatabaseForKeys (toListKeySet <$> allPendingKeys) shakeDb keysActs
+          return $ do
+              let exception =
+                    case res of
+                      Left e -> Just e
+                      _      -> Nothing
+              logWith recorder Debug $ LogBuildSessionFinish exception
 
     -- Do the work in a background thread
-    parentTid <- myThreadId
-    workThread <- asyncWithUnmask $ \x -> do
-        childThreadId <- myThreadId
-        logWith recorder Info $ LogShakeText ("Starting shake thread: " <> T.pack (show childThreadId) <> " (parent: " <> T.pack (show parentTid) <> ")")
-        workRun x
+    workThread <- asyncWithUnmask workRun
 
+    -- run the wrap up in a separate thread since it contains interruptible
+    -- commands (and we are not using uninterruptible mask)
+    -- TODO: can possibly swallow exceptions?
+    _ <- async $ join $ wait workThread
 
     --  Cancelling is required to flush the Shake database when either
     --  the filesystem or the Ghc configuration have changed
-
     let cancelShakeSession :: IO ()
-        cancelShakeSession = do
-            logWith recorder Info $ LogShakeText ("Starting shake cancellation: " <> " (" <> T.pack (show reason) <> ")")
-            tid <- myThreadId
-            cancelWith workThread $ AsyncParentKill tid step
-            shakeShutDatabase shakeDb
-
+        cancelShakeSession = cancel workThread
 
     pure (ShakeSession{..})
 
@@ -1401,9 +1376,8 @@ updateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnosti
         newDiags <- liftIO $ atomicallyNamed "diagnostics - update" $ update (addTagUnsafe "shown ") currentShown diagnostics
         _ <- liftIO $ atomicallyNamed "diagnostics - hidden" $ update (addTagUnsafe "hidden ") currentHidden hiddenDiagnostics
         let uri' = filePathToUri' fp
-        -- let delay = if null newDiags then 0.1 else 0
-        -- registerEvent debouncer delay uri' $ withTrace ("report diagnostics " <> fromString (fromNormalizedFilePath fp)) $ \tag -> do
-        withTrace ("report diagnostics " <> fromString (fromNormalizedFilePath fp)) $ \tag -> do
+        let delay = if null newDiags then 0.1 else 0
+        registerEvent debouncer delay uri' $ withTrace ("report diagnostics " <> fromString (fromNormalizedFilePath fp)) $ \tag -> do
             join $ mask_ $ do
                 lastPublish <- atomicallyNamed "diagnostics - publish" $ STM.focus (Focus.lookupWithDefault [] <* Focus.insert newDiags) uri' publishedDiagnostics
                 let action = when (lastPublish /= newDiags) $ case lspEnv of
@@ -1509,17 +1483,9 @@ kickSignal testing lspEnv files msg = when testing $ liftIO $ mRunLspT lspEnv $
   toJSON $ map fromNormalizedFilePath files
 
 -- | Add kick start/done signal to rule
-runWithSignal :: (KnownSymbol s0, KnownSymbol s1, IdeRule k v) => Recorder (WithPriority Log) -> Proxy s0 -> Proxy s1 -> [NormalizedFilePath] -> k -> Action ()
-runWithSignal recorder msgStart msgEnd files rule = do
+runWithSignal :: (KnownSymbol s0, KnownSymbol s1, IdeRule k v) => Proxy s0 -> Proxy s1 -> [NormalizedFilePath] -> k -> Action ()
+runWithSignal msgStart msgEnd files rule = do
   ShakeExtras{ideTesting = Options.IdeTesting testing, lspEnv} <- getShakeExtras
-  UE.bracket
-    (withTrace ("runWithSignal begin " <> show rule) $ \_tag -> kickSignal testing lspEnv files msgStart
-    >> (logWith recorder Info $ LogShakeText (T.pack $ "Starting rule: " ++ show rule))
-    )
-    (const $
-    withTrace ("runWithSignal end " <> show rule) $ \_tag -> kickSignal testing lspEnv files msgEnd
-    >> (logWith recorder Info $ LogShakeText (T.pack $ "Finished rule: " ++ show rule))
-    )
-    (const $ void $ uses rule files
-    >> (logWith recorder Info $ LogShakeText (T.pack $ "Finishing rule: " ++ show rule))
-    )
+  kickSignal testing lspEnv files msgStart
+  void $ uses rule files
+  kickSignal testing lspEnv files msgEnd
diff --git a/hls-graph/src/Development/IDE/WorkerThread.hs b/ghcide/src/Development/IDE/Core/WorkerThread.hs
similarity index 56%
rename from hls-graph/src/Development/IDE/WorkerThread.hs
rename to ghcide/src/Development/IDE/Core/WorkerThread.hs
index 4ffc9ab8a2..1c55d21c99 100644
--- a/hls-graph/src/Development/IDE/WorkerThread.hs
+++ b/ghcide/src/Development/IDE/Core/WorkerThread.hs
@@ -1,52 +1,44 @@
 {-
-Module : Development.IDE.WorkerThread
+Module : Development.IDE.Core.WorkerThread
 Author : @soulomoon
 SPDX-License-Identifier: Apache-2.0
 
 Description : This module provides an API for managing worker threads in the IDE.
 see Note [Serializing runs in separate thread]
 -}
-{-# LANGUAGE LambdaCase        #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Development.IDE.WorkerThread
+module Development.IDE.Core.WorkerThread
   ( LogWorkerThread (..),
     withWorkerQueue,
     awaitRunInThread,
     TaskQueue,
     writeTaskQueue,
-    withWorkerQueueSimple,
-    awaitRunInThreadStm,
-    awaitRunInThreadStmInNewThread
-  ) where
+    withWorkerQueueSimple
+  )
+where
 
-import           Control.Concurrent.Async (Async, async, withAsync)
+import           Control.Concurrent.Async  (withAsync)
 import           Control.Concurrent.STM
-import           Control.Exception.Safe   (MonadMask (..),
-                                           SomeException (SomeException),
-                                           finally, throw, try)
-import           Control.Monad.Cont       (ContT (ContT))
-import qualified Data.Text                as T
-
-import           Control.Concurrent
-import           Control.Exception        (catch)
-import           Control.Monad            (void, when)
+import           Control.Concurrent.Strict (newBarrier, signalBarrier,
+                                            waitBarrier)
+import           Control.Exception.Safe    (SomeException, finally, throwIO,
+                                            try)
+import           Control.Monad.Cont        (ContT (ContT))
+import qualified Data.Text                 as T
+import           Ide.Logger
 
 data LogWorkerThread
   = LogThreadEnding !T.Text
   | LogThreadEnded !T.Text
   | LogSingleWorkStarting !T.Text
   | LogSingleWorkEnded !T.Text
-  | LogMainThreadId !T.Text !ThreadId
   deriving (Show)
 
--- instance Pretty LogWorkerThread where
---   pretty = \case
---     LogThreadEnding t -> "Worker thread ending:" <+> pretty t
---     LogThreadEnded t -> "Worker thread ended:" <+> pretty t
---     LogSingleWorkStarting t -> "Worker starting a unit of work: " <+> pretty t
---     LogSingleWorkEnded t -> "Worker ended a unit of work: " <+> pretty t
---     LogMainThreadId t tid -> "Main thread for" <+> pretty t <+> "is" <+> pretty (show tid)
+instance Pretty LogWorkerThread where
+  pretty = \case
+    LogThreadEnding t -> "Worker thread ending:" <+> pretty t
+    LogThreadEnded t -> "Worker thread ended:" <+> pretty t
+    LogSingleWorkStarting t -> "Worker starting a unit of work: " <+> pretty t
+    LogSingleWorkEnded t -> "Worker ended a unit of work: " <+> pretty t
 
 {-
 Note [Serializing runs in separate thread]
@@ -62,17 +54,14 @@ data TaskQueue a = TaskQueue (TQueue a)
 newTaskQueueIO :: IO (TaskQueue a)
 newTaskQueueIO = TaskQueue <$> newTQueueIO
 data ExitOrTask t = Exit | Task t
-type Logger = LogWorkerThread -> IO ()
 
 -- | 'withWorkerQueue' creates a new 'TQueue', and launches a worker
 -- thread which polls the queue for requests and runs the given worker
 -- function on them.
-withWorkerQueueSimple :: Logger -> T.Text -> ContT () IO (TaskQueue (IO ()))
+withWorkerQueueSimple :: Recorder (WithPriority LogWorkerThread) -> T.Text -> ContT () IO (TaskQueue (IO ()))
 withWorkerQueueSimple log title = withWorkerQueue log title id
-withWorkerQueue :: Logger -> T.Text -> (t -> IO ()) -> ContT () IO (TaskQueue t)
+withWorkerQueue :: Recorder (WithPriority LogWorkerThread) -> T.Text -> (t -> IO ()) -> ContT () IO (TaskQueue t)
 withWorkerQueue log title workerAction = ContT $ \mainAction -> do
-  tid <- myThreadId
-  log (LogMainThreadId title tid)
   q <- newTaskQueueIO
   -- Use a TMVar as a stop flag to coordinate graceful shutdown.
   -- The worker thread checks this flag before dequeuing each job; if set, it exits immediately,
@@ -87,8 +76,8 @@ withWorkerQueue log title workerAction = ContT $ \mainAction -> do
     -- if we want to debug the exact location the worker swallows an async exception, we can
     -- temporarily comment out the `finally` clause.
         `finally` atomically (putTMVar b ())
-    log (LogThreadEnding title)
-  log (LogThreadEnded title)
+    logWith log Debug (LogThreadEnding title)
+  logWith log Debug (LogThreadEnded title)
   where
     -- writerThread :: TaskQueue t -> TMVar () -> (forall a. IO a -> IO a) -> IO ()
     writerThread q b =
@@ -104,46 +93,24 @@ withWorkerQueue log title workerAction = ContT $ \mainAction -> do
         case task of
           Exit -> return ()
           Task t -> do
-                log $ LogSingleWorkStarting title
+                logWith log Debug $ LogSingleWorkStarting title
                 workerAction t
-                log $ LogSingleWorkEnded title
+                logWith log Debug $ LogSingleWorkEnded title
                 writerThread q b
 
 
 -- | 'awaitRunInThread' queues up an 'IO' action to be run by a worker thread,
 -- and then blocks until the result is computed. If the action throws an
 -- non-async exception, it is rethrown in the calling thread.
-awaitRunInThreadStm :: TaskQueue (IO ()) -> IO result -> STM result
-awaitRunInThreadStm (TaskQueue q) act = do
-  barrier <- newEmptyTMVar
-  -- Take an action from TQueue, run it and
-  -- use barrier to wait for the result
-  writeTQueue q (try act >>= atomically . putTMVar barrier)
-  resultOrException <- takeTMVar barrier
-  case resultOrException of
-    Left e  -> throw (e :: SomeException)
-    Right r -> return r
-
-awaitRunInThreadStmInNewThread :: STM Int -> Int -> TaskQueue (IO ()) -> TVar [Async ()] -> IO result -> (SomeException -> IO ()) -> STM ()
-awaitRunInThreadStmInNewThread getStep deliverStep (TaskQueue q) tthreads act handler = do
-  -- Take an action from TQueue, run it and
-  -- use barrier to wait for the result
-  writeTQueue q (uninterruptibleMask $ \restore -> do
-    curStep <- atomically getStep
-    when (curStep == deliverStep) $ do
-        sync <- async (restore (void act `catch` \(SomeException e) -> handler (SomeException e)))
-        atomically $ modifyTVar' tthreads (sync:)
-    )
-
 awaitRunInThread :: TaskQueue (IO ()) -> IO result -> IO result
 awaitRunInThread (TaskQueue q) act = do
-  barrier <- newEmptyTMVarIO
   -- Take an action from TQueue, run it and
   -- use barrier to wait for the result
-  atomically $ writeTQueue q (try act >>= atomically . putTMVar barrier)
-  resultOrException <- atomically $ takeTMVar barrier
+  barrier <- newBarrier
+  atomically $ writeTQueue q (try act >>= signalBarrier barrier)
+  resultOrException <- waitBarrier barrier
   case resultOrException of
-    Left e  -> throw (e :: SomeException)
+    Left e  -> throwIO (e :: SomeException)
     Right r -> return r
 
 writeTaskQueue :: TaskQueue a -> a -> STM ()
diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
index 8948d719d1..d5d28ffaca 100644
--- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs
+++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
@@ -46,15 +46,14 @@ import           Development.IDE.Core.IdeConfiguration
 import           Development.IDE.Core.Service          (shutdown)
 import           Development.IDE.Core.Shake            hiding (Log)
 import           Development.IDE.Core.Tracing
+import           Development.IDE.Core.WorkerThread
 import qualified Development.IDE.Session               as Session
 import           Development.IDE.Types.Shake           (WithHieDb,
                                                         WithHieDbShield (..))
-import           Development.IDE.WorkerThread
 import           Ide.Logger
 import           Language.LSP.Server                   (LanguageContextEnv,
                                                         LspServerLog,
                                                         type (<~>))
-import           System.Time.Extra                     (Seconds, sleep)
 import           System.Timeout                        (timeout)
 data Log
   = LogRegisteringIdeConfig !IdeConfiguration
@@ -68,13 +67,10 @@ data Log
   | LogShutDownTimeout Int
   | LogServerExitWith (Either () Int)
   | LogReactorShutdownConfirmed !T.Text
-  | LogInitializeIdeStateTookTooLong Seconds
   deriving Show
 
 instance Pretty Log where
   pretty = \case
-    LogInitializeIdeStateTookTooLong seconds ->
-        "Building the initial session took more than" <+> pretty seconds <+> "seconds"
     LogReactorShutdownRequested b ->
       "Requested reactor shutdown; stop signal posted: " <+> pretty b
     LogReactorShutdownConfirmed msg ->
@@ -354,8 +350,8 @@ handleInit initParams env (TRequestMessage _ _ m params) = otTracedHandler "Init
 runWithWorkerThreads :: Recorder (WithPriority Session.Log) -> FilePath -> (WithHieDb -> ThreadQueue -> IO ()) -> IO ()
 runWithWorkerThreads recorder dbLoc f = evalContT $ do
             (WithHieDbShield hiedb, threadQueue) <- runWithDb recorder dbLoc
-            sessionRestartTQueue <- withWorkerQueueSimple (logWith (cmapWithPrio Session.LogSessionWorkerThread recorder) Debug) "RestartTQueue"
-            sessionLoaderTQueue <- withWorkerQueueSimple (logWith (cmapWithPrio Session.LogSessionWorkerThread recorder) Debug) "SessionLoaderTQueue"
+            sessionRestartTQueue <- withWorkerQueueSimple (cmapWithPrio Session.LogSessionWorkerThread recorder) "RestartTQueue"
+            sessionLoaderTQueue <- withWorkerQueueSimple (cmapWithPrio Session.LogSessionWorkerThread recorder) "SessionLoaderTQueue"
             liftIO $ f hiedb (ThreadQueue threadQueue sessionRestartTQueue sessionLoaderTQueue)
 
 -- | Runs the action until it ends or until the given MVar is put.
diff --git a/hls-graph/hls-graph.cabal b/hls-graph/hls-graph.cabal
index faa1aba75d..5eccb4d75e 100644
--- a/hls-graph/hls-graph.cabal
+++ b/hls-graph/hls-graph.cabal
@@ -65,14 +65,11 @@ library
     Development.IDE.Graph.KeyMap
     Development.IDE.Graph.KeySet
     Development.IDE.Graph.Rule
-    Development.IDE.WorkerThread
     Paths_hls_graph
 
   autogen-modules:    Paths_hls_graph
   hs-source-dirs:     src
   build-depends:
-    , mtl ^>=2.3.1
-    , safe-exceptions ^>=0.1.7.4
     , aeson
     , async                 >=2.0
     , base                  >=4.12    && <5
@@ -132,7 +129,6 @@ test-suite tests
     -threaded -rtsopts -with-rtsopts=-N -fno-ignore-asserts
 
   build-depends:
-    , transformers ^>=0.6.1.2
     , base
     , extra
     , hls-graph
@@ -142,6 +138,5 @@ test-suite tests
     , tasty
     , tasty-hspec >= 1.2
     , tasty-rerun
-    , transformers
 
   build-tool-depends: hspec-discover:hspec-discover
diff --git a/hls-graph/src/Development/IDE/Graph.hs b/hls-graph/src/Development/IDE/Graph.hs
index 915da203aa..81ad3b3dfd 100644
--- a/hls-graph/src/Development/IDE/Graph.hs
+++ b/hls-graph/src/Development/IDE/Graph.hs
@@ -18,7 +18,6 @@ module Development.IDE.Graph(
     -- * Actions for inspecting the keys in the database
     getDirtySet,
     getKeysAndVisitedAge,
-
     module Development.IDE.Graph.KeyMap,
     module Development.IDE.Graph.KeySet,
     ) where
diff --git a/hls-graph/src/Development/IDE/Graph/Database.hs b/hls-graph/src/Development/IDE/Graph/Database.hs
index 0283bb8823..bd8601cd16 100644
--- a/hls-graph/src/Development/IDE/Graph/Database.hs
+++ b/hls-graph/src/Development/IDE/Graph/Database.hs
@@ -9,8 +9,7 @@ module Development.IDE.Graph.Database(
     shakeGetDatabaseKeys,
     shakeGetDirtySet,
     shakeGetCleanKeys
-    ,shakeGetBuildEdges,
-    shakeShutDatabase) where
+    ,shakeGetBuildEdges) where
 import           Control.Concurrent.STM.Stats            (readTVarIO)
 import           Data.Dynamic
 import           Data.Maybe
@@ -22,20 +21,16 @@ import           Development.IDE.Graph.Internal.Options
 import           Development.IDE.Graph.Internal.Profile  (writeProfile)
 import           Development.IDE.Graph.Internal.Rules
 import           Development.IDE.Graph.Internal.Types
-import           Development.IDE.WorkerThread            (TaskQueue)
 
 
 -- Placeholder to be the 'extra' if the user doesn't set it
 data NonExportedType = NonExportedType
 
-shakeShutDatabase :: ShakeDatabase -> IO ()
-shakeShutDatabase (ShakeDatabase _ _ db) = shutDatabase db
-
-shakeNewDatabase :: TaskQueue (IO ()) -> ShakeOptions -> Rules () -> IO ShakeDatabase
-shakeNewDatabase que opts rules = do
+shakeNewDatabase :: ShakeOptions -> Rules () -> IO ShakeDatabase
+shakeNewDatabase opts rules = do
     let extra = fromMaybe (toDyn NonExportedType) $ shakeExtra opts
     (theRules, actions) <- runRules extra rules
-    db <- newDatabase que extra theRules
+    db <- newDatabase extra theRules
     pure $ ShakeDatabase (length actions) actions db
 
 shakeRunDatabase :: ShakeDatabase -> [Action a] -> IO [a]
diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs b/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
index 2c0a02cbbf..deee9b79a2 100644
--- a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
+++ b/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
@@ -12,7 +12,9 @@ module Development.IDE.Graph.Internal.Database (compute, newDatabase, incDatabas
 
 import           Prelude                              hiding (unzip)
 
-import           Control.Concurrent.STM.Stats         (STM, atomically,
+import           Control.Concurrent.Async
+import           Control.Concurrent.Extra
+import           Control.Concurrent.STM.Stats         (STM, TVar, atomically,
                                                        atomicallyNamed,
                                                        modifyTVar', newTVarIO,
                                                        readTVar, readTVarIO,
@@ -29,7 +31,7 @@ import           Data.IORef.Extra
 import           Data.Maybe
 import           Data.Traversable                     (for)
 import           Data.Tuple.Extra
-import           Debug.Trace                          (traceEvent)
+import           Debug.Trace                          (traceM)
 import           Development.IDE.Graph.Classes
 import           Development.IDE.Graph.Internal.Key
 import           Development.IDE.Graph.Internal.Rules
@@ -37,21 +39,20 @@ import           Development.IDE.Graph.Internal.Types
 import qualified Focus
 import qualified ListT
 import qualified StmContainers.Map                    as SMap
-import           System.Time.Extra                    (duration)
+import           System.Time.Extra                    (duration, sleep)
+import           UnliftIO                             (MonadUnliftIO (withRunInIO))
+import qualified UnliftIO.Exception                   as UE
 
 #if MIN_VERSION_base(4,19,0)
 import           Data.Functor                         (unzip)
 #else
 import           Data.List.NonEmpty                   (unzip)
 #endif
-import           Development.IDE.WorkerThread         (TaskQueue,
-                                                       awaitRunInThreadStmInNewThread)
 
 
-newDatabase :: TaskQueue (IO ()) -> Dynamic -> TheRules -> IO Database
-newDatabase databaseQueue databaseExtra databaseRules = do
+newDatabase :: Dynamic -> TheRules -> IO Database
+newDatabase databaseExtra databaseRules = do
     databaseStep <- newTVarIO $ Step 0
-    databaseThreads <- newTVarIO []
     databaseValues <- atomically SMap.new
     pure Database{..}
 
@@ -99,9 +100,8 @@ build db stack keys = do
             else throw $ AsyncParentKill i $ Step (-1)
     where
     go = do
-        -- step <- readTVarIO $ databaseStep db
-        -- built <- mapConcurrently (builderOne db stack) (fmap newKey keys)
-        built <- builder db stack (fmap newKey keys)
+        step <- readTVarIO $ databaseStep db
+        !built <- runAIO step $ builder db stack (fmap newKey keys)
         let (ids, vs) = unzip built
         pure (ids, fmap (asV . resultValue) vs)
         where
@@ -112,39 +112,38 @@ build db stack keys = do
 -- | Build a list of keys and return their results.
 --  If none of the keys are dirty, we can return the results immediately.
 --  Otherwise, a blocking computation is returned *which must be evaluated asynchronously* to avoid deadlock.
-builder :: (Traversable f) => Database -> Stack -> f Key -> IO (f (Key, Result))
+builder :: (Traversable f) => Database -> Stack -> f Key -> AIO (f (Key, Result))
 -- builder _ st kk | traceShow ("builder", st,kk) False = undefined
-builder db stack keys = for keys $ \k -> builderOne db stack k
+builder db stack keys = do
+    keyWaits <- for keys $ \k -> builderOne db stack k
+    !res <- for keyWaits $ \(k, waitR) -> do
+        !v<- liftIO waitR
+        return (k, v)
+    return res
 
-builderOne :: Database -> Stack -> Key -> IO (Key, Result)
-builderOne db@Database {..} stack id = do
-  traceEvent ("builderOne: " ++ show id) return ()
-  res <- liftIO $ atomicallyNamed "builder" $ do
+builderOne :: Database -> Stack -> Key -> AIO (Key, IO Result)
+builderOne db@Database {..} stack id = UE.uninterruptibleMask $ \restore -> do
+  current <- liftIO $ readTVarIO databaseStep
+  (k, registerWaitResult) <- restore $ liftIO $ atomicallyNamed "builder" $ do
     -- Spawn the id if needed
     status <- SMap.lookup id databaseValues
-    current@(Step cs) <- readTVar databaseStep
-    let getStep = do
-            Step current <- readTVar databaseStep
-            return current
-
     val <- case viewDirty current $ maybe (Dirty Nothing) keyStatus status of
       Dirty s -> do
+        let act =
+              asyncWithCleanUp
+                ((restore $ refresh db stack id s)
+                    `UE.onException` UE.uninterruptibleMask_ (liftIO (atomicallyNamed "builder - onException" (SMap.focus updateDirty id databaseValues)))
+                )
         SMap.focus (updateStatus $ Running current s) id databaseValues
-        traceEvent ("Starting build of key: " ++ show id ++ ", step "++ show current)
-            $ awaitRunInThreadStmInNewThread getStep cs databaseQueue databaseThreads  (refresh db stack id s)
-            $ \e -> atomically $ SMap.focus (updateStatus $ Exception current e s) id databaseValues
-        return Nothing
-      Clean r -> return $ Just r
+        return act
+      Clean r -> pure . pure . pure $ r
       -- force here might contains async exceptions from previous runs
       Running _step _s
         | memberStack id stack -> throw $ StackException stack
         | otherwise -> retry
-      Exception _ e _s -> throw e
-    pure val
-  case res of
-    Just r  -> return (id, r)
-    Nothing -> builderOne db stack id
-
+    pure (id, val)
+  waitR <- registerWaitResult
+  return (k, waitR)
 -- | isDirty
 -- only dirty when it's build time is older than the changed time of one of its dependencies
 isDirty :: Foldable t => Result -> t (a, Result) -> Bool
@@ -157,27 +156,30 @@ isDirty me = any (\(_,dep) -> resultBuilt me < resultChanged dep)
 -- * If no dirty dependencies and we have evaluated the key previously, then we refresh it in the current thread.
 --   This assumes that the implementation will be a lookup
 -- * Otherwise, we spawn a new thread to refresh the dirty deps (if any) and the key itself
-refreshDeps :: KeySet -> Database -> Stack -> Key -> Result -> [KeySet] -> IO Result
+refreshDeps :: KeySet -> Database -> Stack -> Key -> Result -> [KeySet] -> AIO Result
 refreshDeps visited db stack key result = \case
     -- no more deps to refresh
-    [] -> compute db stack key RunDependenciesSame (Just result)
+    [] -> compute' db stack key RunDependenciesSame (Just result)
     (dep:deps) -> do
         let newVisited = dep <> visited
         res <- builder db stack (toListKeySet (dep `differenceKeySet` visited))
         if isDirty result res
                 -- restart the computation if any of the deps are dirty
-                then compute db stack key RunDependenciesChanged (Just result)
+                then compute' db stack key RunDependenciesChanged (Just result)
                 -- else kick the rest of the deps
                 else refreshDeps newVisited db stack key result deps
 
 
 -- refresh :: Database -> Stack -> Key -> Maybe Result -> IO Result
 -- refresh _ st k _ | traceShow ("refresh", st, k) False = undefined
-refresh :: Database -> Stack -> Key -> Maybe Result -> IO Result
+refresh :: Database -> Stack -> Key -> Maybe Result -> AIO Result
 refresh db stack key result = case (addStack key stack, result) of
     (Left e, _) -> throw e
     (Right stack, Just me@Result{resultDeps = ResultDeps deps}) -> refreshDeps mempty db stack key me (reverse deps)
-    (Right stack, _) -> compute db stack key RunDependenciesChanged result
+    (Right stack, _) -> compute' db stack key RunDependenciesChanged result
+
+compute' :: Database -> Stack -> Key -> RunMode -> Maybe Result -> AIO Result
+compute' db stack key mode result = liftIO $ compute db stack key mode result
 -- | Compute a key.
 compute :: Database -> Stack -> Key -> RunMode -> Maybe Result -> IO Result
 -- compute _ st k _ _ | traceShow ("compute", st, k) False = undefined
@@ -282,5 +284,68 @@ transitiveDirtySet database = flip State.execStateT mempty . traverse_ loop
             next <- lift $ atomically $ getReverseDependencies database x
             traverse_ loop (maybe mempty toListKeySet next)
 
+--------------------------------------------------------------------------------
+-- Asynchronous computations with cancellation
+
+-- | A simple monad to implement cancellation on top of 'Async',
+--   generalizing 'withAsync' to monadic scopes.
+newtype AIO a = AIO { unAIO :: ReaderT (TVar [Async ()]) IO a }
+  deriving newtype (Applicative, Functor, Monad, MonadIO)
+
+data AsyncParentKill = AsyncParentKill ThreadId Step
+    deriving (Show, Eq)
+
+instance Exception AsyncParentKill where
+  toException = asyncExceptionToException
+  fromException = asyncExceptionFromException
+
+-- | Run the monadic computation, cancelling all the spawned asyncs if an exception arises
+runAIO :: Step -> AIO a -> IO a
+runAIO s (AIO act) = do
+    asyncsRef <- newTVarIO []
+    -- Log the exact exception (including async exceptions) before cleanup,
+    -- then rethrow to preserve previous semantics.
+    runReaderT act asyncsRef `onException` do
+        asyncs <- atomically $ do
+            r <- readTVar asyncsRef
+            modifyTVar' asyncsRef $ const []
+            return r
+        tid <- myThreadId
+        cleanupAsync asyncs tid s
+
+-- | Like 'async' but with built-in cancellation.
+--   Returns an IO action to wait on the result.
+asyncWithCleanUp :: AIO a -> AIO (IO a)
+asyncWithCleanUp act = do
+    st <- AIO ask
+    io <- unliftAIO act
+    -- mask to make sure we keep track of the spawned async
+    liftIO $ uninterruptibleMask $ \restore -> do
+        a <- async $ restore io
+        atomically $ modifyTVar' st (void a :)
+        return $ wait a
+
+unliftAIO :: AIO a -> AIO (IO a)
+unliftAIO act = do
+    st <- AIO ask
+    return $ runReaderT (unAIO act) st
 
+instance MonadUnliftIO AIO where
+    withRunInIO k = do
+        st <- AIO ask
+        liftIO $ k (\aio -> runReaderT (unAIO aio) st)
 
+cleanupAsync :: [Async a] -> ThreadId -> Step -> IO ()
+-- mask to make sure we interrupt all the asyncs
+cleanupAsync asyncs tid step  = uninterruptibleMask $ \unmask -> do
+    -- interrupt all the asyncs without waiting
+    -- mapM_ (\a -> throwTo (asyncThreadId a) AsyncCancelled) asyncs
+    mapM_ (\a -> throwTo (asyncThreadId a) $ AsyncParentKill tid step) asyncs
+    -- Wait until all the asyncs are done
+    -- But if it takes more than 10 seconds, log to stderr
+    unless (null asyncs) $ do
+        let warnIfTakingTooLong = unmask $ forever $ do
+                sleep 10
+                traceM "cleanupAsync: waiting for asyncs to finish"
+        withAsync warnIfTakingTooLong $ \_ ->
+            mapM_ waitCatch asyncs
diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs
index c05be86ef6..dc8fa33eb6 100644
--- a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs
+++ b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs
@@ -5,8 +5,7 @@
 
 module Development.IDE.Graph.Internal.Types where
 
-import           Control.Concurrent.STM             (STM, modifyTVar')
-import           Control.Monad                      (forever, unless)
+import           Control.Concurrent.STM             (STM)
 import           Control.Monad.Catch
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Reader
@@ -20,24 +19,15 @@ import           Data.IORef
 import           Data.List                          (intercalate)
 import           Data.Maybe
 import           Data.Typeable
-import           Debug.Trace                        (traceEventIO, traceM)
 import           Development.IDE.Graph.Classes
 import           Development.IDE.Graph.Internal.Key
-import           Development.IDE.WorkerThread       (TaskQueue)
 import           GHC.Conc                           (TVar, atomically)
 import           GHC.Generics                       (Generic)
 import qualified ListT
 import qualified StmContainers.Map                  as SMap
 import           StmContainers.Map                  (Map)
-import           System.Time.Extra                  (Seconds, sleep)
-import           UnliftIO                           (Async (asyncThreadId),
-                                                     MonadUnliftIO,
-                                                     asyncExceptionFromException,
-                                                     asyncExceptionToException,
-                                                     cancel, readTVarIO,
-                                                     throwTo, waitCatch,
-                                                     withAsync)
-import           UnliftIO.Concurrent                (ThreadId, myThreadId)
+import           System.Time.Extra                  (Seconds)
+import           UnliftIO                           (MonadUnliftIO, readTVarIO)
 
 #if !MIN_VERSION_base(4,18,0)
 import           Control.Applicative                (liftA2)
@@ -124,41 +114,12 @@ onKeyReverseDeps f it@KeyDetails{..} =
     it{keyReverseDeps = f keyReverseDeps}
 
 data Database = Database {
-    databaseExtra   :: Dynamic,
-
-    databaseThreads :: TVar [Async ()],
-    databaseQueue   :: TaskQueue (IO ()),
-
-    databaseRules   :: TheRules,
-    databaseStep    :: !(TVar Step),
-    databaseValues  :: !(Map Key KeyDetails)
+    databaseExtra  :: Dynamic,
+    databaseRules  :: TheRules,
+    databaseStep   :: !(TVar Step),
+    databaseValues :: !(Map Key KeyDetails)
     }
 
-data AsyncParentKill = AsyncParentKill ThreadId Step
-    deriving (Show, Eq)
-
-instance Exception AsyncParentKill where
-  toException = asyncExceptionToException
-  fromException = asyncExceptionFromException
-
-shutDatabase :: Database -> IO ()
-shutDatabase Database{..} = uninterruptibleMask $ \unmask -> do
-    -- wait for all threads to finish
-    asyncs <- readTVarIO databaseThreads
-    step <- readTVarIO databaseStep
-    tid <- myThreadId
-    traceEventIO ("shutDatabase: cancelling " ++ show (length asyncs) ++ " asyncs, step " ++ show step)
-    mapM_ (\a -> throwTo (asyncThreadId a) $ AsyncParentKill tid step) asyncs
-    atomically $ modifyTVar' databaseThreads (const [])
-    -- Wait until all the asyncs are done
-    -- But if it takes more than 10 seconds, log to stderr
-    unless (null asyncs) $ do
-        let warnIfTakingTooLong = unmask $ forever $ do
-                sleep 10
-                traceM "cleanupAsync: waiting for asyncs to finish"
-        withAsync warnIfTakingTooLong $ \_ ->
-            mapM_ waitCatch asyncs
-
 -- waitForDatabaseRunningKeys :: Database -> IO ()
 -- waitForDatabaseRunningKeys = getDatabaseValues >=> mapM_ (waitRunning . snd)
 
@@ -172,7 +133,6 @@ getDatabaseValues = atomically
 data Status
     = Clean !Result
     | Dirty (Maybe Result)
-    | Exception !Step !SomeException !(Maybe Result)
     | Running {
         runningStep :: !Step,
         -- runningWait   :: !(IO ()),
@@ -182,14 +142,12 @@ data Status
 
 viewDirty :: Step -> Status -> Status
 viewDirty currentStep (Running s re) | currentStep /= s = Dirty re
-viewDirty currentStep (Exception s _ re) | currentStep /= s = Dirty re
 viewDirty _ other = other
 
 getResult :: Status -> Maybe Result
-getResult (Clean re)           = Just re
-getResult (Dirty m_re)         = m_re
-getResult (Running _ m_re)     = m_re -- watch out: this returns the previous result
-getResult (Exception _ _ m_re) = m_re
+getResult (Clean re)       = Just re
+getResult (Dirty m_re)     = m_re
+getResult (Running _ m_re) = m_re -- watch out: this returns the previous result
 
 -- waitRunning :: Status -> IO ()
 -- waitRunning Running{..} = runningWait
diff --git a/hls-graph/test/ActionSpec.hs b/hls-graph/test/ActionSpec.hs
index a17d11a617..97ab5555ac 100644
--- a/hls-graph/test/ActionSpec.hs
+++ b/hls-graph/test/ActionSpec.hs
@@ -7,7 +7,6 @@ import           Control.Concurrent                      (MVar, readMVar)
 import qualified Control.Concurrent                      as C
 import           Control.Concurrent.STM
 import           Control.Monad.IO.Class                  (MonadIO (..))
-import           Control.Monad.Trans.Cont                (evalContT)
 import           Development.IDE.Graph                   (shakeOptions)
 import           Development.IDE.Graph.Database          (shakeNewDatabase,
                                                           shakeRunDatabase,
@@ -16,22 +15,15 @@ import           Development.IDE.Graph.Internal.Database (build, incDatabase)
 import           Development.IDE.Graph.Internal.Key
 import           Development.IDE.Graph.Internal.Types
 import           Development.IDE.Graph.Rule
-import           Development.IDE.WorkerThread            (TaskQueue,
-                                                          withWorkerQueueSimple)
 import           Example
 import qualified StmContainers.Map                       as STM
 import           Test.Hspec
 
 
 
-itInThread :: String -> (TaskQueue (IO ()) -> IO ()) -> SpecWith ()
-itInThread name ex = it name $ evalContT $ do
-    thread <- withWorkerQueueSimple (const $ return ()) "hls-graph test"
-    liftIO $ ex thread
-
 spec :: Spec
 spec = do
-  describe "apply1" $ itInThread "Test build update, Buggy dirty mechanism in hls-graph #4237" $ \q -> do
+  describe "apply1" $ it "Test build update, Buggy dirty mechanism in hls-graph #4237" $ do
     let ruleStep1 :: MVar Int -> Rules ()
         ruleStep1 m = addRule $ \CountRule _old mode -> do
             -- depends on ruleSubBranch, it always changed if dirty
@@ -47,7 +39,7 @@ spec = do
                     return $ RunResult ChangedNothing "" r (return ())
     count <- C.newMVar 0
     count1 <- C.newMVar 0
-    db <- shakeNewDatabase q shakeOptions $ do
+    db <- shakeNewDatabase shakeOptions $ do
       ruleSubBranch count
       ruleStep1 count1
     -- bootstrapping the database
@@ -66,20 +58,20 @@ spec = do
     _res3 <- shakeRunDatabaseForKeys (Just [parent]) db [apply1 CountRule] -- count = 2
     c1 <- readMVar count1
     c1 `shouldBe` 2
-  describe "apply1" $  do
-    itInThread "computes a rule with no dependencies" $ \q -> do
-      db <- shakeNewDatabase q shakeOptions ruleUnit
+  describe "apply1" $ do
+    it "computes a rule with no dependencies" $ do
+      db <- shakeNewDatabase shakeOptions ruleUnit
       res <- shakeRunDatabase db $
         pure $ apply1 (Rule @())
       res `shouldBe` [()]
-    itInThread "computes a rule with one dependency" $ \q -> do
-      db <- shakeNewDatabase q shakeOptions $ do
+    it "computes a rule with one dependency" $ do
+      db <- shakeNewDatabase shakeOptions $ do
         ruleUnit
         ruleBool
       res <- shakeRunDatabase db $ pure $ apply1 Rule
       res `shouldBe` [True]
-    itInThread "tracks direct dependencies" $ \q -> do
-      db@(ShakeDatabase _ _ theDb) <- shakeNewDatabase q shakeOptions $ do
+    it "tracks direct dependencies" $ do
+      db@(ShakeDatabase _ _ theDb) <- shakeNewDatabase shakeOptions $ do
         ruleUnit
         ruleBool
       let theKey = Rule @Bool
@@ -88,8 +80,8 @@ spec = do
       res `shouldBe` [True]
       Just (Clean res) <- lookup (newKey theKey) <$> getDatabaseValues theDb
       resultDeps res `shouldBe` ResultDeps [singletonKeySet $ newKey (Rule @())]
-    itInThread "tracks reverse dependencies" $ \q -> do
-      db@(ShakeDatabase _ _ Database {..}) <- shakeNewDatabase q shakeOptions $ do
+    it "tracks reverse dependencies" $ do
+      db@(ShakeDatabase _ _ Database {..}) <- shakeNewDatabase shakeOptions $ do
         ruleUnit
         ruleBool
       let theKey = Rule @Bool
@@ -98,14 +90,14 @@ spec = do
       res `shouldBe` [True]
       Just KeyDetails {..} <- atomically $ STM.lookup (newKey (Rule @())) databaseValues
       keyReverseDeps `shouldBe` singletonKeySet (newKey theKey)
-    itInThread "rethrows exceptions" $ \q -> do
-      db <- shakeNewDatabase q shakeOptions $ addRule $ \(Rule :: Rule ()) _old _mode -> error "boom"
+    it "rethrows exceptions" $ do
+      db <- shakeNewDatabase shakeOptions $ addRule $ \(Rule :: Rule ()) _old _mode -> error "boom"
       let res = shakeRunDatabase db $ pure $ apply1 (Rule @())
       res `shouldThrow` anyErrorCall
-    itInThread "computes a rule with branching dependencies does not invoke phantom dependencies #3423" $ \q -> do
+    it "computes a rule with branching dependencies does not invoke phantom dependencies #3423" $ do
       cond <- C.newMVar True
       count <- C.newMVar 0
-      (ShakeDatabase _ _ theDb) <- shakeNewDatabase q shakeOptions $ do
+      (ShakeDatabase _ _ theDb) <- shakeNewDatabase shakeOptions $ do
         ruleUnit
         ruleCond cond
         ruleSubBranch count
@@ -124,8 +116,8 @@ spec = do
       countRes <- build theDb emptyStack [SubBranchRule]
       snd countRes `shouldBe` [1 :: Int]
 
-  describe "applyWithoutDependency" $ itInThread "does not track dependencies" $ \q -> do
-    db@(ShakeDatabase _ _ theDb) <- shakeNewDatabase q shakeOptions $ do
+  describe "applyWithoutDependency" $ it "does not track dependencies" $ do
+    db@(ShakeDatabase _ _ theDb) <- shakeNewDatabase shakeOptions $ do
       ruleUnit
       addRule $ \Rule _old _mode -> do
           [()] <- applyWithoutDependency [Rule]
diff --git a/hls-graph/test/DatabaseSpec.hs b/hls-graph/test/DatabaseSpec.hs
index bf78779bc6..9061bfa89d 100644
--- a/hls-graph/test/DatabaseSpec.hs
+++ b/hls-graph/test/DatabaseSpec.hs
@@ -2,8 +2,6 @@
 
 module DatabaseSpec where
 
-import           Control.Monad.IO.Class                  (MonadIO (..))
-import           Control.Monad.Trans.Cont                (evalContT)
 import           Development.IDE.Graph                   (newKey, shakeOptions)
 import           Development.IDE.Graph.Database          (shakeNewDatabase,
                                                           shakeRunDatabase)
@@ -11,22 +9,16 @@ import           Development.IDE.Graph.Internal.Action   (apply1)
 import           Development.IDE.Graph.Internal.Database (compute, incDatabase)
 import           Development.IDE.Graph.Internal.Rules    (addRule)
 import           Development.IDE.Graph.Internal.Types
-import           Development.IDE.WorkerThread
 import           Example
 import           System.Time.Extra                       (timeout)
 import           Test.Hspec
 
 
-itInThread :: String -> (TaskQueue (IO ()) -> IO ()) -> SpecWith ()
-itInThread name ex = it name $ evalContT $ do
-    thread <- withWorkerQueueSimple (const $ return ()) "hls-graph test"
-    liftIO $ ex thread
-
 spec :: Spec
 spec = do
     describe "Evaluation" $ do
-        itInThread "detects cycles" $ \q -> do
-            db <- shakeNewDatabase q shakeOptions $ do
+        it "detects cycles" $ do
+            db <- shakeNewDatabase shakeOptions $ do
                 ruleBool
                 addRule $ \Rule _old _mode -> do
                     True <- apply1 (Rule @Bool)
@@ -35,9 +27,10 @@ spec = do
             timeout 1 res `shouldThrow` \StackException{} -> True
 
     describe "compute" $ do
-      itInThread "build step and changed step updated correctly" $ \q -> do
-        (ShakeDatabase _ _ theDb) <- shakeNewDatabase q shakeOptions $ do
+      it "build step and changed step updated correctly" $ do
+        (ShakeDatabase _ _ theDb) <- shakeNewDatabase shakeOptions $ do
           ruleStep
+
         let k = newKey $ Rule @()
         -- ChangedRecomputeSame
         r1@Result{resultChanged=rc1, resultBuilt=rb1} <- compute theDb emptyStack k RunDependenciesChanged Nothing
diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/OfInterest.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/OfInterest.hs
index 784b8b1b99..67cf97ccee 100644
--- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/OfInterest.hs
+++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/OfInterest.hs
@@ -116,7 +116,7 @@ actions to produce diagnostics for cabal files.
 It is paramount that this kick-function can be run quickly, since it is a blocking
 function invocation.
 -}
-kick :: Recorder (WithPriority Shake.Log) -> Action ()
-kick recorder = do
+kick :: Action ()
+kick = do
   files <- HashMap.keys <$> getCabalFilesOfInterestUntracked
-  Shake.runWithSignal recorder (Proxy @"kick/start/cabal") (Proxy @"kick/done/cabal") files Types.ParseCabalFile
+  Shake.runWithSignal (Proxy @"kick/start/cabal") (Proxy @"kick/done/cabal") files Types.ParseCabalFile
diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Rules.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Rules.hs
index 7c287349dd..de7bb9a5fd 100644
--- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Rules.hs
+++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Rules.hs
@@ -155,6 +155,6 @@ cabalRules recorder plId = do
     -- Run the cabal kick. This code always runs when 'shakeRestart' is run.
     -- Must be careful to not impede the performance too much. Crucial to
     -- a snappy IDE experience.
-    OfInterest.kick (cmapWithPrio LogShake recorder)
+    OfInterest.kick
  where
   log' = logWith recorder
diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
index 98e3a8a7dd..1585965132 100644
--- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
+++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
@@ -210,7 +210,7 @@ rules recorder plugin = do
 
   action $ do
     files <- Map.keys <$> getFilesOfInterestUntracked
-    Shake.runWithSignal (cmapWithPrio LogShake recorder) (Proxy @"kick/start/hlint") (Proxy @"kick/done/hlint") files GetHlintDiagnostics
+    Shake.runWithSignal (Proxy @"kick/start/hlint") (Proxy @"kick/done/hlint") files GetHlintDiagnostics
 
   where
 
diff --git a/scripts/eventlog-dump.fish b/scripts/eventlog-dump.fish
index 55c8932862..5122b48590 100755
--- a/scripts/eventlog-dump.fish
+++ b/scripts/eventlog-dump.fish
@@ -40,12 +40,11 @@ set filter_prefix ""
 if test (count $argv) -ge 3
   set filter_prefix $argv[3]
 end
-# Optional contains filter: only keep lines that contain any of the substrings (pipe-separated)
+
+# Optional contains filter: only keep lines that contain this substring (applied after prefix filter if both provided)
 set filter_contains ""
-set filter_contains_list
 if test (count $argv) -ge 4
   set filter_contains $argv[4]
-  set filter_contains_list (string split '|' -- $filter_contains)
 end
 
 function find_ghc_events --description "echo absolute path to ghc-events or empty"
@@ -81,23 +80,19 @@ if test -z "$ghc_events_bin"
 end
 
 echo "Dumping events from $evlog to $out..."
+set -l stream_cmd "$ghc_events_bin show $evlog"
+
 if test -n "$filter_prefix" -o -n "$filter_contains"
-  $ghc_events_bin show $evlog | while read -l line
-    set keep 1
+  # Stream through filters
+  eval $stream_cmd | while read -l line
+    set -l keep 1
     if test -n "$filter_prefix"
       if not string match -q -- "$filter_prefix*" -- $line
         set keep 0
       end
     end
-    if test $keep -eq 1 -a (count $filter_contains_list) -gt 0
-      set found 0
-      for substr in $filter_contains_list
-        if string match -q -- "*$substr*" -- $line
-          set found 1
-          break
-        end
-      end
-      if test $found -eq 0
+    if test $keep -eq 1 -a -n "$filter_contains"
+      if not string match -q -- "*$filter_contains*" -- $line
         set keep 0
       end
     end
@@ -106,7 +101,7 @@ if test -n "$filter_prefix" -o -n "$filter_contains"
     end
   end > $out
 else
-  $ghc_events_bin show $evlog > $out
+  eval $stream_cmd > $out
 end
 set exit_code $status
 
diff --git a/scripts/flaky-test-patterns.txt b/scripts/flaky-test-patterns.txt
index 004b3e98df..63f7a9df14 100644
--- a/scripts/flaky-test-patterns.txt
+++ b/scripts/flaky-test-patterns.txt
@@ -1,12 +1,12 @@
 # One tasty pattern per line. Lines starting with # are comments.
 # Blank lines are ignored.
 
-open close
+# open close
 # non local variable
 # Notification Handlers
-bidirectional module dependency with hs-boot
+# bidirectional module dependency with hs-boot
 
-InternalError over InvalidParams
+# InternalError over InvalidParams
 # ghcide restarts shake session on config changes:
 # addDependentFile
 # Another interesting one you can try:

From 075b7428b66ecf0e64f38c2ac05f43fba8e3350a Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Sun, 7 Sep 2025 07:21:25 +0800
Subject: [PATCH 56/61] revert hls-graph changes

---
 .../Development/IDE/Graph/Internal/Action.hs  |   2 -
 .../IDE/Graph/Internal/Database.hs            | 232 ++++++++++--------
 .../Development/IDE/Graph/Internal/Types.hs   |  39 ++-
 3 files changed, 147 insertions(+), 126 deletions(-)

diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Action.hs b/hls-graph/src/Development/IDE/Graph/Internal/Action.hs
index 30ef078ffe..6d47d9b511 100644
--- a/hls-graph/src/Development/IDE/Graph/Internal/Action.hs
+++ b/hls-graph/src/Development/IDE/Graph/Internal/Action.hs
@@ -81,10 +81,8 @@ actionFork act k = do
 
 isAsyncException :: SomeException -> Bool
 isAsyncException e
-    | Just (_ :: SomeAsyncException) <- fromException e = True
     | Just (_ :: AsyncCancelled) <- fromException e = True
     | Just (_ :: AsyncException) <- fromException e = True
-    | Just (_ :: AsyncParentKill) <- fromException e = True
     | Just (_ :: ExitCode) <- fromException e = True
     | otherwise = False
 
diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs b/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
index deee9b79a2..359e5ceb6a 100644
--- a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
+++ b/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
@@ -8,17 +8,16 @@
 {-# LANGUAGE RecordWildCards    #-}
 {-# LANGUAGE TypeFamilies       #-}
 
-module Development.IDE.Graph.Internal.Database (compute, newDatabase, incDatabase, build, getDirtySet, getKeysAndVisitAge, AsyncParentKill(..)) where
+module Development.IDE.Graph.Internal.Database (compute, newDatabase, incDatabase, build, getDirtySet, getKeysAndVisitAge) where
 
 import           Prelude                              hiding (unzip)
 
 import           Control.Concurrent.Async
 import           Control.Concurrent.Extra
-import           Control.Concurrent.STM.Stats         (STM, TVar, atomically,
+import           Control.Concurrent.STM.Stats         (STM, atomically,
                                                        atomicallyNamed,
                                                        modifyTVar', newTVarIO,
-                                                       readTVar, readTVarIO,
-                                                       retry)
+                                                       readTVarIO)
 import           Control.Exception
 import           Control.Monad
 import           Control.Monad.IO.Class               (MonadIO (liftIO))
@@ -26,6 +25,7 @@ import           Control.Monad.Trans.Class            (lift)
 import           Control.Monad.Trans.Reader
 import qualified Control.Monad.Trans.State.Strict     as State
 import           Data.Dynamic
+import           Data.Either
 import           Data.Foldable                        (for_, traverse_)
 import           Data.IORef.Extra
 import           Data.Maybe
@@ -39,9 +39,8 @@ import           Development.IDE.Graph.Internal.Types
 import qualified Focus
 import qualified ListT
 import qualified StmContainers.Map                    as SMap
+import           System.IO.Unsafe
 import           System.Time.Extra                    (duration, sleep)
-import           UnliftIO                             (MonadUnliftIO (withRunInIO))
-import qualified UnliftIO.Exception                   as UE
 
 #if MIN_VERSION_base(4,19,0)
 import           Data.Functor                         (unzip)
@@ -68,22 +67,18 @@ incDatabase db (Just kk) = do
         -- since we assume that no build is mutating the db.
         -- Therefore run one transaction per key to minimise contention.
         atomicallyNamed "incDatabase" $ SMap.focus updateDirty k (databaseValues db)
-    -- let list = SMap.listT (databaseValues db)
-    -- atomicallyNamed "incDatabase - all " $ flip ListT.traverse_ list $ \(k,_) ->
-    --     SMap.focus dirtyRunningKey k (databaseValues db)
 
 -- all keys are dirty
 incDatabase db Nothing = do
     atomically $ modifyTVar'  (databaseStep db) $ \(Step i) -> Step $ i + 1
     let list = SMap.listT (databaseValues db)
-    -- all running keys are also dirty
     atomicallyNamed "incDatabase - all " $ flip ListT.traverse_ list $ \(k,_) ->
         SMap.focus updateDirty k (databaseValues db)
 
 updateDirty :: Monad m => Focus.Focus KeyDetails m ()
 updateDirty = Focus.adjust $ \(KeyDetails status rdeps) ->
             let status'
-                  | Running _ x <- status = Dirty x
+                  | Running _ _ _ x <- status = Dirty x
                   | Clean x <- status = Dirty (Just x)
                   | otherwise = status
             in KeyDetails status' rdeps
@@ -93,57 +88,58 @@ build
     => Database -> Stack -> f key -> IO (f Key, f value)
 -- build _ st k | traceShow ("build", st, k) False = undefined
 build db stack keys = do
-    step <- readTVarIO $ databaseStep db
-    go `catch` \e@(AsyncParentKill i s) -> do
-        if s == step
-            then throw e
-            else throw $ AsyncParentKill i $ Step (-1)
+    built <- runAIO $ do
+        built <- builder db stack (fmap newKey keys)
+        case built of
+          Left clean  -> return clean
+          Right dirty -> liftIO dirty
+    let (ids, vs) = unzip built
+    pure (ids, fmap (asV . resultValue) vs)
     where
-    go = do
-        step <- readTVarIO $ databaseStep db
-        !built <- runAIO step $ builder db stack (fmap newKey keys)
-        let (ids, vs) = unzip built
-        pure (ids, fmap (asV . resultValue) vs)
-        where
-            asV :: Value -> value
-            asV (Value x) = unwrapDynamic x
-
+        asV :: Value -> value
+        asV (Value x) = unwrapDynamic x
 
 -- | Build a list of keys and return their results.
 --  If none of the keys are dirty, we can return the results immediately.
 --  Otherwise, a blocking computation is returned *which must be evaluated asynchronously* to avoid deadlock.
-builder :: (Traversable f) => Database -> Stack -> f Key -> AIO (f (Key, Result))
+builder
+    :: Traversable f => Database -> Stack -> f Key -> AIO (Either (f (Key, Result)) (IO (f (Key, Result))))
 -- builder _ st kk | traceShow ("builder", st,kk) False = undefined
-builder db stack keys = do
-    keyWaits <- for keys $ \k -> builderOne db stack k
-    !res <- for keyWaits $ \(k, waitR) -> do
-        !v<- liftIO waitR
-        return (k, v)
-    return res
-
-builderOne :: Database -> Stack -> Key -> AIO (Key, IO Result)
-builderOne db@Database {..} stack id = UE.uninterruptibleMask $ \restore -> do
-  current <- liftIO $ readTVarIO databaseStep
-  (k, registerWaitResult) <- restore $ liftIO $ atomicallyNamed "builder" $ do
-    -- Spawn the id if needed
-    status <- SMap.lookup id databaseValues
-    val <- case viewDirty current $ maybe (Dirty Nothing) keyStatus status of
-      Dirty s -> do
-        let act =
-              asyncWithCleanUp
-                ((restore $ refresh db stack id s)
-                    `UE.onException` UE.uninterruptibleMask_ (liftIO (atomicallyNamed "builder - onException" (SMap.focus updateDirty id databaseValues)))
-                )
-        SMap.focus (updateStatus $ Running current s) id databaseValues
-        return act
-      Clean r -> pure . pure . pure $ r
-      -- force here might contains async exceptions from previous runs
-      Running _step _s
-        | memberStack id stack -> throw $ StackException stack
-        | otherwise -> retry
-    pure (id, val)
-  waitR <- registerWaitResult
-  return (k, waitR)
+builder db@Database{..} stack keys = withRunInIO $ \(RunInIO run) -> do
+    -- Things that I need to force before my results are ready
+    toForce <- liftIO $ newTVarIO []
+    current <- liftIO $ readTVarIO databaseStep
+    results <- liftIO $ for keys $ \id ->
+        -- Updating the status of all the dependencies atomically is not necessary.
+        -- Therefore, run one transaction per dep. to avoid contention
+        atomicallyNamed "builder" $ do
+            -- Spawn the id if needed
+            status <- SMap.lookup id databaseValues
+            val <- case viewDirty current $ maybe (Dirty Nothing) keyStatus status of
+                Clean r -> pure r
+                Running _ force val _
+                  | memberStack id stack -> throw $ StackException stack
+                  | otherwise -> do
+                    modifyTVar' toForce (Wait force :)
+                    pure val
+                Dirty s -> do
+                    let act = run (refresh db stack id s)
+                        (force, val) = splitIO (join act)
+                    SMap.focus (updateStatus $ Running current force val s) id databaseValues
+                    modifyTVar' toForce (Spawn force:)
+                    pure val
+
+            pure (id, val)
+
+    toForceList <- liftIO $ readTVarIO toForce
+    let waitAll = run $ waitConcurrently_ toForceList
+    case toForceList of
+        [] -> return $ Left results
+        _ -> return $ Right $ do
+                waitAll
+                pure results
+
+
 -- | isDirty
 -- only dirty when it's build time is older than the changed time of one of its dependencies
 isDirty :: Foldable t => Result -> t (a, Result) -> Bool
@@ -159,37 +155,41 @@ isDirty me = any (\(_,dep) -> resultBuilt me < resultChanged dep)
 refreshDeps :: KeySet -> Database -> Stack -> Key -> Result -> [KeySet] -> AIO Result
 refreshDeps visited db stack key result = \case
     -- no more deps to refresh
-    [] -> compute' db stack key RunDependenciesSame (Just result)
+    [] -> liftIO $ compute db stack key RunDependenciesSame (Just result)
     (dep:deps) -> do
         let newVisited = dep <> visited
         res <- builder db stack (toListKeySet (dep `differenceKeySet` visited))
-        if isDirty result res
+        case res of
+            Left res ->  if isDirty result res
                 -- restart the computation if any of the deps are dirty
-                then compute' db stack key RunDependenciesChanged (Just result)
+                then liftIO $ compute db stack key RunDependenciesChanged (Just result)
                 -- else kick the rest of the deps
                 else refreshDeps newVisited db stack key result deps
-
-
--- refresh :: Database -> Stack -> Key -> Maybe Result -> IO Result
+            Right iores -> do
+                res <- liftIO iores
+                if isDirty result res
+                    then liftIO $ compute db stack key RunDependenciesChanged (Just result)
+                    else refreshDeps newVisited db stack key result deps
+
+-- | Refresh a key:
+refresh :: Database -> Stack -> Key -> Maybe Result -> AIO (IO Result)
 -- refresh _ st k _ | traceShow ("refresh", st, k) False = undefined
-refresh :: Database -> Stack -> Key -> Maybe Result -> AIO Result
 refresh db stack key result = case (addStack key stack, result) of
     (Left e, _) -> throw e
-    (Right stack, Just me@Result{resultDeps = ResultDeps deps}) -> refreshDeps mempty db stack key me (reverse deps)
-    (Right stack, _) -> compute' db stack key RunDependenciesChanged result
+    (Right stack, Just me@Result{resultDeps = ResultDeps deps}) -> asyncWithCleanUp $ refreshDeps mempty db stack key me (reverse deps)
+    (Right stack, _) ->
+        asyncWithCleanUp $ liftIO $ compute db stack key RunDependenciesChanged result
 
-compute' :: Database -> Stack -> Key -> RunMode -> Maybe Result -> AIO Result
-compute' db stack key mode result = liftIO $ compute db stack key mode result
 -- | Compute a key.
 compute :: Database -> Stack -> Key -> RunMode -> Maybe Result -> IO Result
 -- compute _ st k _ _ | traceShow ("compute", st, k) False = undefined
 compute db@Database{..} stack key mode result = do
     let act = runRule databaseRules key (fmap resultData result) mode
-    deps <- liftIO $ newIORef UnknownDeps
+    deps <- newIORef UnknownDeps
     (execution, RunResult{..}) <-
-        liftIO $ duration $ runReaderT (fromAction act) $ SAction db deps stack
-    curStep <- liftIO $ readTVarIO databaseStep
-    deps <- liftIO $ readIORef deps
+        duration $ runReaderT (fromAction act) $ SAction db deps stack
+    curStep <- readTVarIO databaseStep
+    deps <- readIORef deps
     let lastChanged = maybe curStep resultChanged result
     let lastBuild = maybe curStep resultBuilt result
     -- changed time is always older than or equal to build time
@@ -212,12 +212,12 @@ compute db@Database{..} stack key mode result = do
             -- If an async exception strikes before the deps have been recorded,
             -- we won't be able to accurately propagate dirtiness for this key
             -- on the next build.
-            liftIO $ void $
+            void $
                 updateReverseDeps key db
                     (getResultDepsDefault mempty previousDeps)
                     deps
         _ -> pure ()
-    liftIO $ atomicallyNamed "compute and run hook" $ do
+    atomicallyNamed "compute and run hook" $ do
         runHook
         SMap.focus (updateStatus $ Clean res) key databaseValues
     pure res
@@ -247,6 +247,18 @@ getKeysAndVisitAge db = do
         getAge Result{resultVisited = Step s} = curr - s
     return keysWithVisitAge
 --------------------------------------------------------------------------------
+-- Lazy IO trick
+
+data Box a = Box {fromBox :: a}
+
+-- | Split an IO computation into an unsafe lazy value and a forcing computation
+splitIO :: IO a -> (IO (), a)
+splitIO act = do
+    let act2 = Box <$> act
+    let res = unsafePerformIO act2
+    (void $ evaluate res, fromBox res)
+
+--------------------------------------------------------------------------------
 -- Reverse dependencies
 
 -- | Update the reverse dependencies of an Id
@@ -289,29 +301,14 @@ transitiveDirtySet database = flip State.execStateT mempty . traverse_ loop
 
 -- | A simple monad to implement cancellation on top of 'Async',
 --   generalizing 'withAsync' to monadic scopes.
-newtype AIO a = AIO { unAIO :: ReaderT (TVar [Async ()]) IO a }
+newtype AIO a = AIO { unAIO :: ReaderT (IORef [Async ()]) IO a }
   deriving newtype (Applicative, Functor, Monad, MonadIO)
 
-data AsyncParentKill = AsyncParentKill ThreadId Step
-    deriving (Show, Eq)
-
-instance Exception AsyncParentKill where
-  toException = asyncExceptionToException
-  fromException = asyncExceptionFromException
-
 -- | Run the monadic computation, cancelling all the spawned asyncs if an exception arises
-runAIO :: Step -> AIO a -> IO a
-runAIO s (AIO act) = do
-    asyncsRef <- newTVarIO []
-    -- Log the exact exception (including async exceptions) before cleanup,
-    -- then rethrow to preserve previous semantics.
-    runReaderT act asyncsRef `onException` do
-        asyncs <- atomically $ do
-            r <- readTVar asyncsRef
-            modifyTVar' asyncsRef $ const []
-            return r
-        tid <- myThreadId
-        cleanupAsync asyncs tid s
+runAIO :: AIO a -> IO a
+runAIO (AIO act) = do
+    asyncs <- newIORef []
+    runReaderT act asyncs `onException` cleanupAsync asyncs
 
 -- | Like 'async' but with built-in cancellation.
 --   Returns an IO action to wait on the result.
@@ -322,7 +319,7 @@ asyncWithCleanUp act = do
     -- mask to make sure we keep track of the spawned async
     liftIO $ uninterruptibleMask $ \restore -> do
         a <- async $ restore io
-        atomically $ modifyTVar' st (void a :)
+        atomicModifyIORef'_ st (void a :)
         return $ wait a
 
 unliftAIO :: AIO a -> AIO (IO a)
@@ -330,17 +327,19 @@ unliftAIO act = do
     st <- AIO ask
     return $ runReaderT (unAIO act) st
 
-instance MonadUnliftIO AIO where
-    withRunInIO k = do
-        st <- AIO ask
-        liftIO $ k (\aio -> runReaderT (unAIO aio) st)
+newtype RunInIO = RunInIO (forall a. AIO a -> IO a)
 
-cleanupAsync :: [Async a] -> ThreadId -> Step -> IO ()
+withRunInIO :: (RunInIO -> AIO b) -> AIO b
+withRunInIO k = do
+    st <- AIO ask
+    k $ RunInIO (\aio -> runReaderT (unAIO aio) st)
+
+cleanupAsync :: IORef [Async a] -> IO ()
 -- mask to make sure we interrupt all the asyncs
-cleanupAsync asyncs tid step  = uninterruptibleMask $ \unmask -> do
+cleanupAsync ref = uninterruptibleMask $ \unmask -> do
+    asyncs <- atomicModifyIORef' ref ([],)
     -- interrupt all the asyncs without waiting
-    -- mapM_ (\a -> throwTo (asyncThreadId a) AsyncCancelled) asyncs
-    mapM_ (\a -> throwTo (asyncThreadId a) $ AsyncParentKill tid step) asyncs
+    mapM_ (\a -> throwTo (asyncThreadId a) AsyncCancelled) asyncs
     -- Wait until all the asyncs are done
     -- But if it takes more than 10 seconds, log to stderr
     unless (null asyncs) $ do
@@ -349,3 +348,32 @@ cleanupAsync asyncs tid step  = uninterruptibleMask $ \unmask -> do
                 traceM "cleanupAsync: waiting for asyncs to finish"
         withAsync warnIfTakingTooLong $ \_ ->
             mapM_ waitCatch asyncs
+
+data Wait
+    = Wait {justWait :: !(IO ())}
+    | Spawn {justWait :: !(IO ())}
+
+fmapWait :: (IO () -> IO ()) -> Wait -> Wait
+fmapWait f (Wait io)  = Wait (f io)
+fmapWait f (Spawn io) = Spawn (f io)
+
+waitOrSpawn :: Wait -> IO (Either (IO ()) (Async ()))
+waitOrSpawn (Wait io)  = pure $ Left io
+waitOrSpawn (Spawn io) = Right <$> async io
+
+waitConcurrently_ :: [Wait] -> AIO ()
+waitConcurrently_ [] = pure ()
+waitConcurrently_ [one] = liftIO $ justWait one
+waitConcurrently_ many = do
+    ref <- AIO ask
+    -- spawn the async computations.
+    -- mask to make sure we keep track of all the asyncs.
+    (asyncs, syncs) <- liftIO $ uninterruptibleMask $ \unmask -> do
+        waits <- liftIO $ traverse (waitOrSpawn . fmapWait unmask) many
+        let (syncs, asyncs) = partitionEithers waits
+        liftIO $ atomicModifyIORef'_ ref (asyncs ++)
+        return (asyncs, syncs)
+    -- work on the sync computations
+    liftIO $ sequence_ syncs
+    -- wait for the async computations before returning
+    liftIO $ traverse_ wait asyncs
diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs
index dc8fa33eb6..34bed42391 100644
--- a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs
+++ b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs
@@ -6,6 +6,7 @@
 module Development.IDE.Graph.Internal.Types where
 
 import           Control.Concurrent.STM             (STM)
+import           Control.Monad                      ((>=>))
 import           Control.Monad.Catch
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Reader
@@ -27,7 +28,7 @@ import qualified ListT
 import qualified StmContainers.Map                  as SMap
 import           StmContainers.Map                  (Map)
 import           System.Time.Extra                  (Seconds)
-import           UnliftIO                           (MonadUnliftIO, readTVarIO)
+import           UnliftIO                           (MonadUnliftIO)
 
 #if !MIN_VERSION_base(4,18,0)
 import           Control.Applicative                (liftA2)
@@ -79,8 +80,8 @@ getDatabase :: Action Database
 getDatabase = Action $ asks actionDatabase
 
 -- | waitForDatabaseRunningKeysAction waits for all keys in the database to finish running.
--- waitForDatabaseRunningKeysAction :: Action ()
--- waitForDatabaseRunningKeysAction = getDatabase >>= liftIO . waitForDatabaseRunningKeys
+waitForDatabaseRunningKeysAction :: Action ()
+waitForDatabaseRunningKeysAction = getDatabase >>= liftIO . waitForDatabaseRunningKeys
 
 ---------------------------------------------------------------------
 -- DATABASE
@@ -90,12 +91,6 @@ data ShakeDatabase = ShakeDatabase !Int [Action ()] Database
 newtype Step = Step Int
     deriving newtype (Eq,Ord,Hashable,Show)
 
-
-getShakeStep :: MonadIO m => ShakeDatabase -> m Step
-getShakeStep (ShakeDatabase _ _ db) = do
-    s <- readTVarIO $ databaseStep db
-    return s
-
 ---------------------------------------------------------------------
 -- Keys
 
@@ -120,8 +115,8 @@ data Database = Database {
     databaseValues :: !(Map Key KeyDetails)
     }
 
--- waitForDatabaseRunningKeys :: Database -> IO ()
--- waitForDatabaseRunningKeys = getDatabaseValues >=> mapM_ (waitRunning . snd)
+waitForDatabaseRunningKeys :: Database -> IO ()
+waitForDatabaseRunningKeys = getDatabaseValues >=> mapM_ (waitRunning . snd)
 
 getDatabaseValues :: Database -> IO [(Key, Status)]
 getDatabaseValues = atomically
@@ -134,24 +129,24 @@ data Status
     = Clean !Result
     | Dirty (Maybe Result)
     | Running {
-        runningStep :: !Step,
-        -- runningWait   :: !(IO ()),
-        -- runningResult :: Result,     -- LAZY
-        runningPrev :: !(Maybe Result)
+        runningStep   :: !Step,
+        runningWait   :: !(IO ()),
+        runningResult :: Result,     -- LAZY
+        runningPrev   :: !(Maybe Result)
         }
 
 viewDirty :: Step -> Status -> Status
-viewDirty currentStep (Running s re) | currentStep /= s = Dirty re
+viewDirty currentStep (Running s _ _ re) | currentStep /= s = Dirty re
 viewDirty _ other = other
 
 getResult :: Status -> Maybe Result
-getResult (Clean re)       = Just re
-getResult (Dirty m_re)     = m_re
-getResult (Running _ m_re) = m_re -- watch out: this returns the previous result
+getResult (Clean re)           = Just re
+getResult (Dirty m_re)         = m_re
+getResult (Running _ _ _ m_re) = m_re -- watch out: this returns the previous result
 
--- waitRunning :: Status -> IO ()
--- waitRunning Running{..} = runningWait
--- waitRunning _           = return ()
+waitRunning :: Status -> IO ()
+waitRunning Running{..} = runningWait
+waitRunning _           = return ()
 
 data Result = Result {
     resultValue     :: !Value,

From 767ca290fd2a6bfa08b3d2797379c4e0543376d5 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Sun, 7 Sep 2025 07:25:26 +0800
Subject: [PATCH 57/61] fix build

---
 plugins/hls-signature-help-plugin/test/Main.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/plugins/hls-signature-help-plugin/test/Main.hs b/plugins/hls-signature-help-plugin/test/Main.hs
index 4ac665e7d1..f6518552ae 100644
--- a/plugins/hls-signature-help-plugin/test/Main.hs
+++ b/plugins/hls-signature-help-plugin/test/Main.hs
@@ -11,7 +11,8 @@ import qualified Data.Text                                as T
 import           Development.IDE.Plugin.Completions.Types (PosPrefixInfo (PosPrefixInfo))
 import           Ide.Plugin.SignatureHelp                 (descriptor)
 import qualified Language.LSP.Protocol.Lens               as L
-import           Test.Hls
+import           Test.Hls                                 hiding
+                                                          (getSignatureHelp)
 import           Test.Hls.FileSystem                      (VirtualFileTree,
                                                            directCradle, file,
                                                            mkVirtualFileTree,

From 73ce4124150d048a17adaf81b5351c361cbc0693 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Sun, 7 Sep 2025 07:54:46 +0800
Subject: [PATCH 58/61] revert test CI changes

---
 .github/workflows/test.yml | 64 +++++++++++++++++++-------------------
 1 file changed, 32 insertions(+), 32 deletions(-)

diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml
index 4082a49bd9..b2870d3076 100644
--- a/.github/workflows/test.yml
+++ b/.github/workflows/test.yml
@@ -114,18 +114,18 @@ jobs:
       - if: needs.pre_job.outputs.should_skip_ghcide != 'true' && matrix.test
         name: Test ghcide
         # run the tests without parallelism to avoid running out of memory
-        run: cabal test ghcide-tests
+        run: cabal test ghcide-tests || cabal test ghcide-tests
 
       - if: matrix.test
         name: Test hls-plugin-api
-        run: cabal test hls-plugin-api
+        run: cabal test hls-plugin-api || cabal test hls-plugin-api
 
       - if: matrix.test
         name: Test func-test suite
         env:
           HLS_TEST_EXE: hls
           HLS_WRAPPER_TEST_EXE: hls-wrapper
-        run: cabal test func-test
+        run: cabal test func-test || cabal test func-test
 
       - if: matrix.test
         name: Test wrapper-test suite
@@ -136,124 +136,124 @@ jobs:
 
       - if: matrix.test
         name: Test hls-refactor-plugin
-        run: cabal test hls-refactor-plugin-tests
+        run: cabal test hls-refactor-plugin-tests || cabal test hls-refactor-plugin-tests
 
       # TODO enable when it supports 9.10
       - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12'
         name: Test hls-floskell-plugin
-        run: cabal test hls-floskell-plugin-tests
+        run: cabal test hls-floskell-plugin-tests || cabal test hls-floskell-plugin-tests
 
       - if: matrix.test
         name: Test hls-class-plugin
-        run: cabal test hls-class-plugin-tests
+        run: cabal test hls-class-plugin-tests || cabal test hls-class-plugin-tests
 
       - if: matrix.test
         name: Test hls-pragmas-plugin
-        run: cabal test hls-pragmas-plugin-tests
+        run: cabal test hls-pragmas-plugin-tests || cabal test hls-pragmas-plugin-tests
 
       - if: matrix.test
         name: Test hls-eval-plugin
-        run: cabal test hls-eval-plugin-tests
+        run: cabal test hls-eval-plugin-tests || cabal test hls-eval-plugin-tests
 
       # TODO enable when it supports 9.10
       - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12'
         name: Test hls-splice-plugin
-        run: cabal test hls-splice-plugin-tests
+        run: cabal test hls-splice-plugin-tests || cabal test hls-splice-plugin-tests
 
       - if: matrix.test && matrix.ghc != '9.12'
         name: Test hls-stan-plugin
-        run: cabal test hls-stan-plugin-tests
+        run: cabal test hls-stan-plugin-tests || cabal test hls-stan-plugin-tests
 
       - if: matrix.test
         name: Test hls-stylish-haskell-plugin
-        run: cabal test hls-stylish-haskell-plugin-tests
+        run: cabal test hls-stylish-haskell-plugin-tests || cabal test hls-stylish-haskell-plugin-tests
 
       - if: matrix.test
         name: Test hls-ormolu-plugin
-        run: cabal test hls-ormolu-plugin-tests
+        run: cabal test hls-ormolu-plugin-tests || cabal test hls-ormolu-plugin-tests
 
       - if: matrix.test
         name: Test hls-fourmolu-plugin
-        run: cabal test hls-fourmolu-plugin-tests
+        run: cabal test hls-fourmolu-plugin-tests || cabal test hls-fourmolu-plugin-tests
 
       - if: matrix.test
         name: Test hls-explicit-imports-plugin test suite
-        run: cabal test hls-explicit-imports-plugin-tests
+        run: cabal test hls-explicit-imports-plugin-tests || cabal test hls-explicit-imports-plugin-tests
 
       - if: matrix.test
         name: Test hls-call-hierarchy-plugin test suite
-        run: cabal test hls-call-hierarchy-plugin-tests
+        run: cabal test hls-call-hierarchy-plugin-tests || cabal test hls-call-hierarchy-plugin-tests
 
       - if: matrix.test && matrix.os != 'windows-latest'
         name: Test hls-rename-plugin test suite
-        run: cabal test hls-rename-plugin-tests
+        run: cabal test hls-rename-plugin-tests || cabal test hls-rename-plugin-tests
 
       # TODO enable when it supports 9.10
       - if: matrix.test && matrix.ghc != '9.10'
         name: Test hls-hlint-plugin test suite
-        run: cabal test hls-hlint-plugin-tests
+        run: cabal test hls-hlint-plugin-tests || cabal test hls-hlint-plugin-tests
 
       - if: matrix.test
         name: Test hls-module-name-plugin test suite
-        run: cabal test hls-module-name-plugin-tests
+        run: cabal test hls-module-name-plugin-tests || cabal test hls-module-name-plugin-tests
 
       - if: matrix.test
         name: Test hls-alternate-number-format-plugin test suite
-        run: cabal test hls-alternate-number-format-plugin-tests
+        run: cabal test hls-alternate-number-format-plugin-tests || cabal test hls-alternate-number-format-plugin-tests
 
       - if: matrix.test
         name: Test hls-qualify-imported-names-plugin test suite
-        run: cabal test hls-qualify-imported-names-plugin-tests
+        run: cabal test hls-qualify-imported-names-plugin-tests || cabal test hls-qualify-imported-names-plugin-tests
 
       - if: matrix.test
         name: Test hls-code-range-plugin test suite
-        run: cabal test hls-code-range-plugin-tests
+        run: cabal test hls-code-range-plugin-tests || cabal test hls-code-range-plugin-tests
 
       - if: matrix.test
         name: Test hls-change-type-signature test suite
-        run: cabal test hls-change-type-signature-plugin-tests
+        run: cabal test hls-change-type-signature-plugin-tests || cabal test hls-change-type-signature-plugin-tests
 
       - if: matrix.test
         name: Test hls-gadt-plugin test suit
-        run: cabal test hls-gadt-plugin-tests
+        run: cabal test hls-gadt-plugin-tests || cabal test hls-gadt-plugin-tests
 
       - if: matrix.test
         name: Test hls-explicit-fixity-plugin test suite
-        run: cabal test hls-explicit-fixity-plugin-tests
+        run: cabal test hls-explicit-fixity-plugin-tests || cabal test hls-explicit-fixity-plugin-tests
 
       - if: matrix.test
         name: Test hls-explicit-record-fields-plugin test suite
-        run: cabal test hls-explicit-record-fields-plugin-tests
+        run: cabal test hls-explicit-record-fields-plugin-tests || cabal test hls-explicit-record-fields-plugin-tests
 
       # versions need to be limited since the tests depend on cabal-fmt which only builds with ghc <9.10
       - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12'
         name: Test hls-cabal-fmt-plugin test suite
-        run: cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests
+        run: cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests || cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests
 
       - if: matrix.test && matrix.ghc != '9.12'
         name: Test hls-cabal-gild-plugin test suite
-        run: cabal test hls-cabal-gild-plugin-tests --flag=isolateCabalGildTests
+        run: cabal test hls-cabal-gild-plugin-tests --flag=isolateCabalGildTests || cabal test hls-cabal-gild-plugin-tests --flag=isolateCabalGildTests
 
       - if: matrix.test
         name: Test hls-cabal-plugin test suite
-        run: cabal test hls-cabal-plugin-tests
+        run: cabal test hls-cabal-plugin-tests || cabal test hls-cabal-plugin-tests
 
       # TODO enable when it supports 9.10
       - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12'
         name: Test hls-retrie-plugin test suite
-        run: cabal test hls-retrie-plugin-tests
+        run: cabal test hls-retrie-plugin-tests || cabal test hls-retrie-plugin-tests
 
       - if: matrix.test
         name: Test hls-overloaded-record-dot-plugin test suite
-        run: cabal test hls-overloaded-record-dot-plugin-tests
+        run: cabal test hls-overloaded-record-dot-plugin-tests || cabal test hls-overloaded-record-dot-plugin-tests
 
       - if: matrix.test
         name: Test hls-semantic-tokens-plugin test suite
-        run: cabal test hls-semantic-tokens-plugin-tests
+        run: cabal test hls-semantic-tokens-plugin-tests || cabal test hls-semantic-tokens-plugin-tests
 
       - if: matrix.test
         name: Test hls-notes-plugin test suite
-        run: cabal test hls-notes-plugin-tests
+        run: cabal test hls-notes-plugin-tests || cabal test hls-notes-plugin-tests
 
       # The plugin tutorial is only compatible with 9.6 and 9.8.
       # No particular reason, just to avoid excessive CPP.

From 42bbfbeddd1522357150775d8606fc12b8619b07 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Sun, 7 Sep 2025 09:06:54 +0800
Subject: [PATCH 59/61] Refactor flakiness workflow and CI

---
 .github/workflows/flakiness.yml |  9 ++++---
 scripts/flaky-test-loop.sh      | 44 ++++++++++++++++++++++++++++-----
 scripts/flaky-test-patterns.txt |  4 +--
 3 files changed, 46 insertions(+), 11 deletions(-)

diff --git a/.github/workflows/flakiness.yml b/.github/workflows/flakiness.yml
index ae8824699a..4341946542 100644
--- a/.github/workflows/flakiness.yml
+++ b/.github/workflows/flakiness.yml
@@ -66,9 +66,11 @@ jobs:
         run: |
           cabal --version
           ghc --version
-      - name: build
-        run: |
-          cabal build all
+      - name: Build
+        env:
+          PATTERN_FILE: 'scripts/flaky-test-patterns.txt'
+          RUN_MODE: 'build'
+        run: HLS_TEST_EXE="$(cabal exec which hls)" bash scripts/flaky-test-loop.sh
 
       - name: Run flakiness loop
         id: run-loop
@@ -81,6 +83,7 @@ jobs:
           TEST_PATTERNS: ${{ github.event.inputs.test_patterns }}
           PATTERN_FILE: 'scripts/flaky-test-patterns.txt'
           NO_BUILD_ONCE: '1'
+          RUN_MODE: 'run'
           # HLS_TEST_EXE: 'hls' # HLS_WRAPPER_TEST_EXE: 'hls-wrapper'
         run: |
           # Run with a sensible default of 500 iterations on PRs;
diff --git a/scripts/flaky-test-loop.sh b/scripts/flaky-test-loop.sh
index c072783cd1..ec3f1010eb 100755
--- a/scripts/flaky-test-loop.sh
+++ b/scripts/flaky-test-loop.sh
@@ -10,6 +10,7 @@
 #   SHOW_EVERY    : print progress/iteration header every N iterations (default: 100, 1 = every run, <=0 = disabled)
 #   LOG_STDERR    : set to 1 to enable verbose stderr logging (HLS_TEST_LOG_STDERR & HLS_TEST_HARNESS_STDERR) (default: 1)
 #   NO_BUILD_ONCE : set to non-empty to skip the initial cabal build step
+#   RUN_MODE      : choose 'build' (build once and exit), 'run' (skip upfront build and just run), or 'both' (default)
 #
 # Test selection:
 #   TEST_PATTERNS : comma-separated list of entries to run each iteration.
@@ -37,6 +38,7 @@ MAX_ITER="${MAX_ITER:-}"
 SLEEP_SECS="${SLEEP_SECS:-0}"
 SHOW_EVERY="${SHOW_EVERY:-1}"
 LOG_STDERR="${LOG_STDERR:-1}"
+RUN_MODE="${RUN_MODE:-both}"  # build | run | both
 
 # Allow providing a positional max iteration: ./open-close-loop.sh 50
 if [[ $# -ge 1 && -z "${MAX_ITER}" ]]; then
@@ -96,10 +98,11 @@ if [[ ${#items[@]} -eq 0 ]]; then
   exit 2
 fi
 
-# Build required test binaries once upfront (unless NO_BUILD_ONCE is set)
-if [[ -z "${NO_BUILD_ONCE:-}" ]]; then
-  # collect unique BIN names
+# Helper to build required test binaries once
+build_required_bins_once() {
+  # collect unique BIN names from global 'items'
   declare -a bins_to_build=()
+  local it bin seen b
   for it in "${items[@]}"; do
     bin="${it%%::*}"; seen=0
     if (( ${#bins_to_build[@]} > 0 )); then
@@ -110,11 +113,40 @@ if [[ -z "${NO_BUILD_ONCE:-}" ]]; then
   if (( ${#bins_to_build[@]} > 0 )); then
     echo "[loop] Building test targets once upfront: ${bins_to_build[*]}" >&2
     if ! cabal build "${bins_to_build[@]}" >&2; then
-      echo "[loop][error] Build failed. Cannot proceed with tests." >&2
-      exit 2
+      echo "[loop][error] Build failed." >&2
+      return 2
     fi
-    echo "[loop] Build succeeded. Proceeding with tests." >&2
+    echo "[loop] Build succeeded." >&2
   fi
+  return 0
+}
+
+# Honor RUN_MODE before any build/run
+case "${RUN_MODE}" in
+  build)
+    if ! build_required_bins_once; then exit 2; fi
+    echo "[loop] RUN_MODE=build completed. Exiting without running tests." >&2
+    exit 0
+    ;;
+  run)
+    echo "[loop] RUN_MODE=run: skipping upfront build, proceeding to run loop." >&2
+    ;;
+  both)
+    : # default behavior below
+    ;;
+  *)
+    echo "[loop][error] Invalid RUN_MODE='${RUN_MODE}'. Use one of: build | run | both." >&2
+    exit 2
+    ;;
+esac
+
+# Build required test binaries once upfront (unless NO_BUILD_ONCE is set or RUN_MODE=run)
+if [[ -z "${NO_BUILD_ONCE:-}" && "${RUN_MODE}" != "run" ]]; then
+  if ! build_required_bins_once; then
+    echo "[loop][error] Cannot proceed with tests due to build failure." >&2
+    exit 2
+  fi
+  echo "[loop] Proceeding with tests." >&2
 fi
 
 # Resolve binary path by name (cache results)
diff --git a/scripts/flaky-test-patterns.txt b/scripts/flaky-test-patterns.txt
index 63f7a9df14..4a4b4681d1 100644
--- a/scripts/flaky-test-patterns.txt
+++ b/scripts/flaky-test-patterns.txt
@@ -1,7 +1,7 @@
 # One tasty pattern per line. Lines starting with # are comments.
 # Blank lines are ignored.
 
-# open close
+open close
 # non local variable
 # Notification Handlers
 # bidirectional module dependency with hs-boot
@@ -17,4 +17,4 @@
 # hls-hlint-plugin-tests::adding hlint flags to plugin configuration removes hlint diagnostics
 # hls-explicit-imports-plugin-tests::ExplicitUsualCase inlay hints with client caps
 # hls-class-plugin-tests::Creates a placeholder for fmap
-hls-rename-plugin-tests::Rename
+# hls-rename-plugin-tests::Rename

From 81c46b69910442ffde652edb8b17136b0fbf94eb Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Thu, 18 Sep 2025 18:34:55 +0800
Subject: [PATCH 60/61] clean up and revert other flakiness test changes

---
 ghcide-test/exe/ResolveTests.hs               |   8 +-
 .../session-loader/Development/IDE/Session.hs |   7 +-
 .../Development/IDE/Core/ProgressReporting.hs |  42 +-----
 ghcide/src/Development/IDE/Main.hs            |   8 +-
 ghcide/src/Development/IDE/Types/Options.hs   |   1 -
 hls-test-utils/src/Test/Hls.hs                |   1 -
 .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs  |   5 +-
 .../src/Ide/Plugin/SignatureHelp.hs           |   2 +-
 scripts/eventlog-dump.fish                    | 122 -----------------
 scripts/eventlog_dump.py                      | 127 ++++++++++++++++++
 scripts/flaky-test-loop.sh                    |  45 +------
 11 files changed, 149 insertions(+), 219 deletions(-)
 delete mode 100755 scripts/eventlog-dump.fish
 create mode 100644 scripts/eventlog_dump.py

diff --git a/ghcide-test/exe/ResolveTests.hs b/ghcide-test/exe/ResolveTests.hs
index 0886fd62ce..4fc917c56b 100644
--- a/ghcide-test/exe/ResolveTests.hs
+++ b/ghcide-test/exe/ResolveTests.hs
@@ -24,7 +24,7 @@ import           Language.LSP.Test             hiding (resolveCompletion)
 import           Test.Hls                      (IdeState, SMethod (..), liftIO,
                                                 mkPluginTestDescriptor,
                                                 someMethodToMethodString,
-                                                waitForKickDone)
+                                                waitForAllProgressDone)
 import qualified Test.Hls.FileSystem           as FS
 import           Test.Tasty
 import           Test.Tasty.HUnit
@@ -100,7 +100,7 @@ resolveRequests =
         , "data Foo = Foo { foo :: Int }"
         , "bar = Foo 4"
         ]
-      waitForKickDone
+      waitForAllProgressDone
       items <- getCompletions doc (Position 2 7)
       let resolveCompItems = filter (\i -> "test item" `T.isPrefixOf` (i ^. J.label)) items
       liftIO $ assertEqual "There must be exactly two results" 2 (length resolveCompItems)
@@ -113,7 +113,7 @@ resolveRequests =
         , "data Foo = Foo { foo :: Int }"
         , "bar = Foo 4"
         ]
-      waitForKickDone
+      waitForAllProgressDone
       -- Cant use 'getAllCodeActions', as this lsp-test function queries the diagnostic
       -- locations and we don't have diagnostics in these tests.
       cas <- Maybe.mapMaybe (preview _R) <$> getCodeActions doc (Range (Position 0 0) (Position 1 0))
@@ -128,7 +128,7 @@ resolveRequests =
         , "data Foo = Foo { foo :: Int }"
         , "bar = Foo 4"
         ]
-      waitForKickDone
+      waitForAllProgressDone
       cd <- getCodeLenses doc
       let resolveCodeLenses = filter (\i -> case i ^. J.command of
             Just cmd -> "test item" `T.isPrefixOf` (cmd ^. J.title)
diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs
index 4be4fd78e2..84ad33bbd0 100644
--- a/ghcide/session-loader/Development/IDE/Session.hs
+++ b/ghcide/session-loader/Development/IDE/Session.hs
@@ -1,6 +1,5 @@
-{-# LANGUAGE CPP                #-}
-{-# LANGUAGE ImpredicativeTypes #-}
-{-# LANGUAGE TypeFamilies       #-}
+{-# LANGUAGE CPP          #-}
+{-# LANGUAGE TypeFamilies #-}
 
 {-|
 The logic for setting up a ghcide session by tapping into hie-bios.
@@ -119,7 +118,6 @@ import qualified System.Random                       as Random
 import           System.Random                       (RandomGen)
 import           Text.ParserCombinators.ReadP        (readP_to_S)
 
-import qualified Control.Monad.Catch                 as MC
 import           GHC.Driver.Env                      (hsc_all_home_unit_ids)
 import           GHC.Driver.Errors.Types
 import           GHC.Types.Error                     (errMsgDiagnostic,
@@ -756,7 +754,6 @@ emptyHscEnv :: NameCache -> FilePath -> IO HscEnv
 emptyHscEnv nc libDir = do
     -- We call setSessionDynFlags so that the loader is initialised
     -- We need to do this before we call initUnits.
-    -- we mask_ here because asynchronous exceptions might be swallowed
     env <- runGhc (Just libDir) $
       getSessionDynFlags >>= setSessionDynFlags >> getSession
     pure $ setNameCache nc (hscSetFlags ((hsc_dflags env){useUnicode = True }) env)
diff --git a/ghcide/src/Development/IDE/Core/ProgressReporting.hs b/ghcide/src/Development/IDE/Core/ProgressReporting.hs
index 868674f99d..3d8a2bf989 100644
--- a/ghcide/src/Development/IDE/Core/ProgressReporting.hs
+++ b/ghcide/src/Development/IDE/Core/ProgressReporting.hs
@@ -23,30 +23,24 @@ import           Control.Concurrent.STM         (STM)
 import           Control.Concurrent.STM.Stats   (TVar, atomically,
                                                  atomicallyNamed, modifyTVar',
                                                  newTVarIO, readTVar, retry)
-import           Control.Concurrent.Strict      (modifyVar_, newBarrier, newVar,
-                                                 signalBarrier, threadDelay)
+import           Control.Concurrent.Strict      (modifyVar_, newVar,
+                                                 threadDelay)
 import           Control.Monad.Extra            hiding (loop)
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Class      (lift)
-import qualified Data.Aeson                     as J
 import           Data.Functor                   (($>))
 import qualified Data.Text                      as T
-import           Data.Unique                    (hashUnique, newUnique)
 import           Development.IDE.GHC.Orphans    ()
 import           Development.IDE.Types.Location
 import           Development.IDE.Types.Options
 import qualified Focus
-import           Language.LSP.Protocol.Message
 import           Language.LSP.Protocol.Types
-import qualified Language.LSP.Protocol.Types    as L
-import           Language.LSP.Server            (MonadLsp, ProgressAmount (..),
+import           Language.LSP.Server            (ProgressAmount (..),
                                                  ProgressCancellable (..),
-                                                 sendNotification, sendRequest,
                                                  withProgress)
 import qualified Language.LSP.Server            as LSP
 import qualified StmContainers.Map              as STM
 import           UnliftIO                       (Async, async, bracket, cancel)
-import qualified UnliftIO.Exception             as UE
 
 data ProgressEvent
   = ProgressNewStarted
@@ -174,7 +168,7 @@ progressReportingNoTrace todo done (Just lspEnv) title optProgressStyle = do
   let _progressUpdate event = liftIO $ updateStateVar $ Event event
       _progressStop = updateStateVar StopProgress
       updateStateVar = modifyVar_ progressState . updateState (progressCounter lspEnv title optProgressStyle todo done)
-  return ProgressReporting {_progressUpdate, _progressStop}
+  return ProgressReporting {..}
 
 -- | `progressReporting` initiates a new progress reporting session.
 -- It necessitates the active tracking of progress using the `inProgress` function.
@@ -202,28 +196,6 @@ progressReporting (Just lspEnv) title optProgressStyle = do
 
         f = recordProgress inProgress file
 
-withProgressDummy ::
-  forall c m a.
-  MonadLsp c m =>
-  T.Text ->
-  Maybe ProgressToken ->
-  ProgressCancellable ->
-  ((ProgressAmount -> m ()) -> m a) ->
-  m a
-withProgressDummy title _ _ f = do
-        UE.bracket start end $ \_ ->
-            f (const $ return ())
-  where
-    sendProgressReport token report = sendNotification SMethod_Progress $ ProgressParams token $ J.toJSON report
-    start = UE.uninterruptibleMask_ $ do
-        t <- L.ProgressToken . L.InR . T.pack . show . hashUnique <$> liftIO newUnique
-        r <- liftIO newBarrier
-        _ <- sendRequest SMethod_WindowWorkDoneProgressCreate (WorkDoneProgressCreateParams t) $ \_ -> liftIO $ signalBarrier r ()
-        sendProgressReport t $ WorkDoneProgressBegin L.AString title Nothing Nothing Nothing
-        return t
-    end t = do
-        sendProgressReport t (WorkDoneProgressEnd L.AString Nothing)
-
 -- Kill this to complete the progress session
 progressCounter ::
   LSP.LanguageContextEnv c ->
@@ -233,12 +205,8 @@ progressCounter ::
   STM Int ->
   IO ()
 progressCounter lspEnv title optProgressStyle getTodo getDone =
-    LSP.runLspT lspEnv $ withProgressChoice title Nothing NotCancellable $ \update -> loop update 0
+  LSP.runLspT lspEnv $ withProgress title Nothing NotCancellable $ \update -> loop update 0
   where
-    withProgressChoice = case optProgressStyle of
-        TestReporting -> withProgressDummy
-        _             -> withProgress
-
     loop _ _ | optProgressStyle == NoProgress = forever $ liftIO $ threadDelay maxBound
     loop update prevPct = do
       (todo, done, nextPct) <- liftIO $ atomically $ do
diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs
index fec6aaf725..ad4a36327a 100644
--- a/ghcide/src/Development/IDE/Main.hs
+++ b/ghcide/src/Development/IDE/Main.hs
@@ -77,9 +77,8 @@ import           Development.IDE.Types.Location           (NormalizedUri,
                                                            toNormalizedFilePath')
 import           Development.IDE.Types.Monitoring         (Monitoring)
 import           Development.IDE.Types.Options            (IdeGhcSession,
-                                                           IdeOptions (..),
+                                                           IdeOptions (optCheckParents, optCheckProject, optReportProgress, optRunSubset),
                                                            IdeTesting (IdeTesting),
-                                                           ProgressReportingStyle (TestReporting),
                                                            clientSupportsProgress,
                                                            defaultIdeOptions,
                                                            optModifyDynFlags,
@@ -277,10 +276,7 @@ testing recorder projectRoot plugins =
       let
         defOptions = argsIdeOptions config sessionLoader
       in
-        defOptions{
-            optTesting = IdeTesting True
-            , optProgressStyle = TestReporting
-            }
+        defOptions{ optTesting = IdeTesting True }
     lspOptions = argsLspOptions { LSP.optProgressStartDelay = 0, LSP.optProgressUpdateDelay = 0 }
   in
     arguments
diff --git a/ghcide/src/Development/IDE/Types/Options.hs b/ghcide/src/Development/IDE/Types/Options.hs
index 124e7a9469..8d4d91e166 100644
--- a/ghcide/src/Development/IDE/Types/Options.hs
+++ b/ghcide/src/Development/IDE/Types/Options.hs
@@ -107,7 +107,6 @@ newtype IdeOTMemoryProfiling = IdeOTMemoryProfiling    Bool
 data ProgressReportingStyle
     = Percentage -- ^ Report using the LSP @_percentage@ field
     | Explicit   -- ^ Report using explicit 123/456 text
-    | TestReporting -- ^ Special mode for testing, reports only start/stop
     | NoProgress -- ^ Do not report any percentage
     deriving Eq
 
diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs
index 9e913662c8..9ec15c0f96 100644
--- a/hls-test-utils/src/Test/Hls.hs
+++ b/hls-test-utils/src/Test/Hls.hs
@@ -758,7 +758,6 @@ wrapClientLogger logger = do
     let lspLogRecorder = cmapWithPrio (renderStrict . layoutPretty defaultLayoutOptions. pretty) lspLogRecorder'
     return (lspLogRecorder <> logger, cb1)
 
-
 -- | Host a server, and run a test session on it.
 -- For setting custom timeout, set the environment variable 'LSP_TIMEOUT'
 -- * LSP_TIMEOUT=10 cabal test
diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
index 1585965132..210e9f3910 100644
--- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
+++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
@@ -66,8 +66,7 @@ import           System.Environment                                 (setEnv,
 import           Development.IDE.GHC.Compat                         (DynFlags,
                                                                      extensionFlags,
                                                                      ms_hspp_opts,
-                                                                     topDir,
-                                                                     uninterruptibleMaskM_)
+                                                                     topDir)
 import qualified Development.IDE.GHC.Compat.Util                    as EnumSet
 
 #if MIN_GHC_API_VERSION(9,4,0)
@@ -206,7 +205,7 @@ rules recorder plugin = do
 
   defineNoFile (cmapWithPrio LogShake recorder) $ \GetHlintSettings -> do
     (Config flags) <- getHlintConfig plugin
-    liftIO $ uninterruptibleMask_ $ argsSettings flags
+    liftIO $ argsSettings flags
 
   action $ do
     files <- Map.keys <$> getFilesOfInterestUntracked
diff --git a/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs b/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs
index ada4d70872..e8ac3cac0d 100644
--- a/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs
+++ b/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs
@@ -94,7 +94,7 @@ help when a space char is inserted, we probably have to use up-to-date results.
 
 {-
 Here is a brief description of the algorithm of finding relevant bits from HIE AST
-1. let 'hsAppNode' = the smallest 'HsApp' AST node which contains the cursor postion
+1. let 'hsAppNode' = the smallest 'HsApp' AST node which contains the cursor position
    See 'extractInfoFromSmallestContainingFunctionApplicationAst'
 2. let 'functionNode' = the left-most node of 'hsAppNode'
    See 'getLeftMostNode'
diff --git a/scripts/eventlog-dump.fish b/scripts/eventlog-dump.fish
deleted file mode 100755
index 5122b48590..0000000000
--- a/scripts/eventlog-dump.fish
+++ /dev/null
@@ -1,122 +0,0 @@
-#!/usr/bin/env fish
-
-# Dump a GHC RTS .eventlog to a plain-text file using the ghc-events CLI.
-# Usage:
-#   scripts/eventlog-dump.fish <file.eventlog> [output.txt] [starts_with_prefix] [contains_substring]
-#
-# Notes:
-# - Attempts to find ghc-events in PATH, ~/.cabal/bin, or ~/.local/bin.
-# - If not found, will try: cabal install ghc-events
-# - Output defaults to <basename>.events.txt in the current directory.
-
-function usage
-  echo "Usage: (basename (status filename)) <file.eventlog> [output.txt] [starts_with_prefix] [contains_substring]"
-  exit 2
-end
-
-if test (count $argv) -lt 1
-  usage
-end
-
-set evlog $argv[1]
-if not test -f $evlog
-  echo "error: file not found: $evlog" >&2
-  exit 1
-end
-
-if test (count $argv) -ge 2
-  set out $argv[2]
-else
-  set base (basename $evlog)
-  if string match -q '*\.eventlog' $base
-    set out (string replace -r '\\.eventlog$' '.events.txt' -- $base)
-  else
-    set out "$base.events.txt"
-  end
-end
-
-# Optional prefix filter: only keep lines that start with this string
-set filter_prefix ""
-if test (count $argv) -ge 3
-  set filter_prefix $argv[3]
-end
-
-# Optional contains filter: only keep lines that contain this substring (applied after prefix filter if both provided)
-set filter_contains ""
-if test (count $argv) -ge 4
-  set filter_contains $argv[4]
-end
-
-function find_ghc_events --description "echo absolute path to ghc-events or empty"
-  if command -sq ghc-events
-    command -s ghc-events
-    return 0
-  end
-  if test -x ~/.cabal/bin/ghc-events
-    echo ~/.cabal/bin/ghc-events
-    return 0
-  end
-  if test -x ~/.local/bin/ghc-events
-    echo ~/.local/bin/ghc-events
-    return 0
-  end
-  return 1
-end
-
-set ghc_events_bin (find_ghc_events)
-
-if test -z "$ghc_events_bin"
-  echo "ghc-events not found; attempting to install via 'cabal install ghc-events'..." >&2
-  if not command -sq cabal
-    echo "error: cabal not found; please install ghc-events manually (e.g., via cabal)." >&2
-    exit 1
-  end
-  cabal install ghc-events
-  set ghc_events_bin (find_ghc_events)
-  if test -z "$ghc_events_bin"
-    echo "error: ghc-events still not found after installation." >&2
-    exit 1
-  end
-end
-
-echo "Dumping events from $evlog to $out..."
-set -l stream_cmd "$ghc_events_bin show $evlog"
-
-if test -n "$filter_prefix" -o -n "$filter_contains"
-  # Stream through filters
-  eval $stream_cmd | while read -l line
-    set -l keep 1
-    if test -n "$filter_prefix"
-      if not string match -q -- "$filter_prefix*" -- $line
-        set keep 0
-      end
-    end
-    if test $keep -eq 1 -a -n "$filter_contains"
-      if not string match -q -- "*$filter_contains*" -- $line
-        set keep 0
-      end
-    end
-    if test $keep -eq 1
-      echo $line
-    end
-  end > $out
-else
-  eval $stream_cmd > $out
-end
-set exit_code $status
-
-if test $exit_code -ne 0
-  echo "error: dump failed with exit code $exit_code" >&2
-  exit $exit_code
-end
-
-set -l size ""
-if command -sq stat
-  # macOS stat prints size with -f%z; suppress errors if not supported
-  set size (stat -f%z $out 2>/dev/null)
-end
-if test -z "$size"
-  set size (wc -c < $out)
-end
-
-echo "Wrote $out ($size bytes)."
diff --git a/scripts/eventlog_dump.py b/scripts/eventlog_dump.py
new file mode 100644
index 0000000000..9fb6602269
--- /dev/null
+++ b/scripts/eventlog_dump.py
@@ -0,0 +1,127 @@
+#!/usr/bin/env python3
+"""
+Dump a GHC RTS .eventlog to a plain-text file using the ghc-events CLI.
+Usage:
+  scripts/eventlog_dump.py <file.eventlog> [--out output.txt] [--contains SUBSTR1|SUBSTR2]
+
+Behavior mirrors scripts/eventlog-dump.fish: tries to find ghc-events in PATH,
+~/.cabal/bin, or ~/.local/bin. If not found and `cabal` exists in PATH, it will run
+`cabal install ghc-events` and retry.
+
+Filtering: if --contains is provided it should be a pipe-separated list of
+substrings; a line is kept if it contains any of the substrings.
+
+Exit codes:
+  0  : success
+  >0 : failures from ghc-events or setup errors
+"""
+from __future__ import annotations
+
+import argparse
+import os
+import shutil
+import subprocess
+import sys
+from typing import Iterable, List, Optional
+
+
+def find_ghc_events() -> Optional[str]:
+    # 1) PATH
+    path = shutil.which("ghc-events")
+    if path:
+        return path
+    # 2) common user bins
+    cand = os.path.expanduser("~/.cabal/bin/ghc-events")
+    if os.path.isfile(cand) and os.access(cand, os.X_OK):
+        return cand
+    cand = os.path.expanduser("~/.local/bin/ghc-events")
+    if os.path.isfile(cand) and os.access(cand, os.X_OK):
+        return cand
+    return None
+
+
+def try_install_ghc_events() -> bool:
+    if shutil.which("cabal") is None:
+        return False
+    print("ghc-events not found; attempting to install via 'cabal install ghc-events'...", file=sys.stderr)
+    rc = subprocess.run(["cabal", "install", "ghc-events"])  # let cabal print its own output
+    return rc.returncode == 0
+
+
+def stream_and_filter(cmd: List[str], out_path: str, contains: Optional[Iterable[str]]) -> int:
+    proc = subprocess.Popen(cmd, stdout=subprocess.PIPE, stderr=subprocess.PIPE, text=True)
+    assert proc.stdout is not None
+    with open(out_path, "w", encoding="utf-8", newline="\n") as fout:
+        for line in proc.stdout:
+            if contains:
+                if any(sub in line for sub in contains):
+                    fout.write(line)
+            else:
+                fout.write(line)
+    # wait for process to finish and capture stderr
+    _, err = proc.communicate()
+    if proc.returncode != 0:
+        # write stderr for debugging
+        sys.stderr.write(err)
+    return proc.returncode
+
+
+def parse_args(argv: Optional[List[str]] = None) -> argparse.Namespace:
+    ap = argparse.ArgumentParser(description="Dump GHC eventlog to text with optional substring filtering")
+    ap.add_argument("eventlog", help=".eventlog file to dump")
+    ap.add_argument("--out", "-o", default=None, help="Output text file (default: <basename>.events.txt)")
+    ap.add_argument("--contains", "-c", default=None,
+                    help="Pipe-separated substrings to keep (e.g. 'foo|bar'). If omitted, keep all lines.")
+    return ap.parse_args(argv)
+
+
+def main(argv: Optional[List[str]] = None) -> int:
+    args = parse_args(argv)
+    evlog = args.eventlog
+    if not os.path.isfile(evlog):
+        print(f"error: file not found: {evlog}", file=sys.stderr)
+        return 1
+
+    out = args.out
+    if out is None:
+        base = os.path.basename(evlog)
+        if base.endswith(".eventlog"):
+            out = base[:-len(".eventlog")] + ".events.txt"
+        else:
+            out = base + ".events.txt"
+
+    contains_list: Optional[List[str]] = None
+    if args.contains:
+        contains_list = [s for s in args.contains.split("|") if s != ""]
+
+    ghc_events = find_ghc_events()
+    if ghc_events is None:
+        if try_install_ghc_events():
+            ghc_events = find_ghc_events()
+        else:
+            print("error: ghc-events not found; please install it (e.g., 'cabal install ghc-events')", file=sys.stderr)
+            return 1
+    if ghc_events is None:
+        print("error: ghc-events still not found after installation.", file=sys.stderr)
+        return 1
+
+    cmd = [ghc_events, "show", evlog]
+    print(f"Dumping events from {evlog} to {out} using {ghc_events}...", file=sys.stderr)
+    rc = stream_and_filter(cmd, out, contains_list)
+    if rc != 0:
+        print(f"error: dump failed with exit code {rc}", file=sys.stderr)
+        return rc
+
+    try:
+        size = os.path.getsize(out)
+    except Exception:
+        size = None
+    if size is None:
+        print(f"Wrote {out}.")
+    else:
+        print(f"Wrote {out} ({size} bytes).")
+    return 0
+
+
+if __name__ == "__main__":
+    raise SystemExit(main())
diff --git a/scripts/flaky-test-loop.sh b/scripts/flaky-test-loop.sh
index ec3f1010eb..2e3dfa9906 100755
--- a/scripts/flaky-test-loop.sh
+++ b/scripts/flaky-test-loop.sh
@@ -10,7 +10,6 @@
 #   SHOW_EVERY    : print progress/iteration header every N iterations (default: 100, 1 = every run, <=0 = disabled)
 #   LOG_STDERR    : set to 1 to enable verbose stderr logging (HLS_TEST_LOG_STDERR & HLS_TEST_HARNESS_STDERR) (default: 1)
 #   NO_BUILD_ONCE : set to non-empty to skip the initial cabal build step
-#   RUN_MODE      : choose 'build' (build once and exit), 'run' (skip upfront build and just run), or 'both' (default)
 #
 # Test selection:
 #   TEST_PATTERNS : comma-separated list of entries to run each iteration.
@@ -38,7 +37,6 @@ MAX_ITER="${MAX_ITER:-}"
 SLEEP_SECS="${SLEEP_SECS:-0}"
 SHOW_EVERY="${SHOW_EVERY:-1}"
 LOG_STDERR="${LOG_STDERR:-1}"
-RUN_MODE="${RUN_MODE:-both}"  # build | run | both
 
 # Allow providing a positional max iteration: ./open-close-loop.sh 50
 if [[ $# -ge 1 && -z "${MAX_ITER}" ]]; then
@@ -98,11 +96,10 @@ if [[ ${#items[@]} -eq 0 ]]; then
   exit 2
 fi
 
-# Helper to build required test binaries once
-build_required_bins_once() {
-  # collect unique BIN names from global 'items'
+# Build required test binaries once upfront (unless NO_BUILD_ONCE is set)
+if [[ -z "${NO_BUILD_ONCE:-}" ]]; then
+  # collect unique BIN names
   declare -a bins_to_build=()
-  local it bin seen b
   for it in "${items[@]}"; do
     bin="${it%%::*}"; seen=0
     if (( ${#bins_to_build[@]} > 0 )); then
@@ -113,40 +110,11 @@ build_required_bins_once() {
   if (( ${#bins_to_build[@]} > 0 )); then
     echo "[loop] Building test targets once upfront: ${bins_to_build[*]}" >&2
     if ! cabal build "${bins_to_build[@]}" >&2; then
-      echo "[loop][error] Build failed." >&2
-      return 2
+      echo "[loop][error] Build failed. Cannot proceed with tests." >&2
+      exit 2
     fi
-    echo "[loop] Build succeeded." >&2
+    echo "[loop] Build succeeded. Proceeding with tests." >&2
   fi
-  return 0
-}
-
-# Honor RUN_MODE before any build/run
-case "${RUN_MODE}" in
-  build)
-    if ! build_required_bins_once; then exit 2; fi
-    echo "[loop] RUN_MODE=build completed. Exiting without running tests." >&2
-    exit 0
-    ;;
-  run)
-    echo "[loop] RUN_MODE=run: skipping upfront build, proceeding to run loop." >&2
-    ;;
-  both)
-    : # default behavior below
-    ;;
-  *)
-    echo "[loop][error] Invalid RUN_MODE='${RUN_MODE}'. Use one of: build | run | both." >&2
-    exit 2
-    ;;
-esac
-
-# Build required test binaries once upfront (unless NO_BUILD_ONCE is set or RUN_MODE=run)
-if [[ -z "${NO_BUILD_ONCE:-}" && "${RUN_MODE}" != "run" ]]; then
-  if ! build_required_bins_once; then
-    echo "[loop][error] Cannot proceed with tests due to build failure." >&2
-    exit 2
-  fi
-  echo "[loop] Proceeding with tests." >&2
 fi
 
 # Resolve binary path by name (cache results)
@@ -170,7 +138,6 @@ while true; do
   iter=$((iter+1))
   ts=$(date -Iseconds)
   file_num=$((iter % 2))
-  # if [[ ${file_num} -eq 0 ]]; then file_num=100; fi
 
   # Run each selected item (BIN::PATTERN) in this iteration
   for item in "${items[@]}"; do

From 405ea59ce95460522033884217b24146363d7a73 Mon Sep 17 00:00:00 2001
From: soulomoon <patrickwalesss@gmail.com>
Date: Thu, 18 Sep 2025 21:12:05 +0800
Subject: [PATCH 61/61] cleanup

---
 ghcide/src/Development/IDE/LSP/LanguageServer.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
index d5d28ffaca..86af5641ad 100644
--- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs
+++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs
@@ -59,7 +59,7 @@ data Log
   = LogRegisteringIdeConfig !IdeConfiguration
   | LogReactorThreadException !SomeException
   | LogReactorMessageActionException !SomeException
-  | LogReactorThreadStopped Int
+  | LogReactorThreadStopped
   | LogCancelledRequest !SomeLspId
   | LogSession Session.Log
   | LogLspServer LspServerLog
@@ -96,8 +96,8 @@ instance Pretty Log where
       vcat
         [ "ReactorMessageActionException"
         , pretty $ displayException e ]
-    LogReactorThreadStopped i ->
-      "Reactor thread stopped" <+> pretty i
+    LogReactorThreadStopped ->
+      "Reactor thread stopped"
     LogCancelledRequest requestId ->
       "Cancelled request" <+> viaShow requestId
     LogSession msg -> pretty msg
@@ -338,6 +338,7 @@ handleInit initParams env (TRequestMessage _ _ m params) = otTracedHandler "Init
                     case msg of
                         ReactorNotification act -> handle exceptionInHandler act
                         ReactorRequest _id act k -> void $ async $ checkCancelled _id act k
+            logWith recorder Info LogReactorThreadStopped
 
     ide <- readMVar ideMVar
     registerIdeConfiguration (shakeExtras ide) initConfig