diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 6fc9a4d00e..ccc23c3f1a 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -178,6 +178,7 @@ import System.FilePath hiding (makeRelative) import System.IO.Unsafe (unsafePerformIO) import System.Time.Extra import UnliftIO (MonadUnliftIO (withRunInIO)) +import qualified UnliftIO.Exception as UE data Log @@ -1477,7 +1478,8 @@ kickSignal testing lspEnv files msg = when testing $ liftIO $ mRunLspT lspEnv $ -- | 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 - ShakeExtras{ideTesting = Options.IdeTesting testing, lspEnv} <- getShakeExtras - kickSignal testing lspEnv files msgStart - void $ uses rule files - kickSignal testing lspEnv files msgEnd + ShakeExtras {ideTesting = Options.IdeTesting testing, lspEnv} <- getShakeExtras + UE.bracket_ + (kickSignal testing lspEnv files msgStart) + (kickSignal testing lspEnv files msgEnd) + $ void $ uses rule files diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 210e9f3910..ff581b8fb2 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,10 @@ rules recorder plugin = do defineNoFile (cmapWithPrio LogShake recorder) $ \GetHlintSettings -> do (Config flags) <- getHlintConfig plugin - liftIO $ argsSettings flags + -- argsSettings might capture async exceptions and throw it everytime we call it. + -- So we must mask async exceptions here as an workaround. + -- See https://github.com/haskell/haskell-language-server/issues/4718 + liftIO $ uninterruptibleMask_ $ argsSettings flags action $ do files <- Map.keys <$> getFilesOfInterestUntracked