Use bracket_ for kick signal in runWithSignal and mask async exceptions in Hlint plugin

Author: soulomoon

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

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