diff --git a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs index 3bca988580..13a6f08b4b 100644 --- a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs +++ b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs @@ -126,9 +126,13 @@ suggestDisableWarning Diagnostic {_code} pure ("Disable \"" <> w <> "\" warnings", OptGHC w) | otherwise = [] --- Don't suggest disabling type errors as a solution to all type errors warningBlacklist :: [T.Text] -warningBlacklist = ["deferred-type-errors"] +warningBlacklist = + -- Don't suggest disabling type errors as a solution to all type errors. + [ "deferred-type-errors" + -- Don't suggest disabling out of scope errors as a solution to all out of scope errors. + , "deferred-out-of-scope-variables" + ] -- --------------------------------------------------------------------- diff --git a/plugins/hls-pragmas-plugin/test/Main.hs b/plugins/hls-pragmas-plugin/test/Main.hs index dc62c14860..9b1eb10181 100644 --- a/plugins/hls-pragmas-plugin/test/Main.hs +++ b/plugins/hls-pragmas-plugin/test/Main.hs @@ -109,11 +109,16 @@ codeActionTests' = _ -> assertFailure $ "Expected one code action, but got: " <> show cas liftIO $ (ca ^. L.title == "Add \"NamedFieldPuns\"") @? "NamedFieldPuns code action" executeCodeAction ca - , goldenWithPragmas pragmasSuggestPlugin "doesn't suggest disabling type errors" "DeferredTypeErrors" $ \doc -> do + , goldenWithPragmas pragmasDisableWarningPlugin "doesn't suggest disabling type errors" "DeferredTypeErrors" $ \doc -> do _ <- waitForDiagnosticsFrom doc cas <- map fromAction <$> getAllCodeActions doc liftIO $ "Disable \"deferred-type-errors\" warnings" `notElem` map (^. L.title) cas @? "Doesn't contain deferred-type-errors code action" liftIO $ length cas == 0 @? "Expected no code actions, but got: " <> show cas + , goldenWithPragmas pragmasDisableWarningPlugin "doesn't suggest disabling out of scope variables" "DeferredOutOfScopeVariables" $ \doc -> do + _ <- waitForDiagnosticsFrom doc + cas <- map fromAction <$> getAllCodeActions doc + liftIO $ "Disable \"deferred-out-of-scope-variables\" warnings" `notElem` map (^. L.title) cas @? "Doesn't contain deferred-out-of-scope-variables code action" + liftIO $ length cas == 0 @? "Expected no code actions, but got: " <> show cas ] completionTests :: TestTree diff --git a/plugins/hls-pragmas-plugin/test/testdata/DeferredOutOfScopeVariables.expected.hs b/plugins/hls-pragmas-plugin/test/testdata/DeferredOutOfScopeVariables.expected.hs new file mode 100644 index 0000000000..38d17261dc --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/DeferredOutOfScopeVariables.expected.hs @@ -0,0 +1,5 @@ +module DeferredOutOfScopeVariables where + +f :: () +f = let x = Doesn'tExist + in undefined diff --git a/plugins/hls-pragmas-plugin/test/testdata/DeferredOutOfScopeVariables.hs b/plugins/hls-pragmas-plugin/test/testdata/DeferredOutOfScopeVariables.hs new file mode 100644 index 0000000000..38d17261dc --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/DeferredOutOfScopeVariables.hs @@ -0,0 +1,5 @@ +module DeferredOutOfScopeVariables where + +f :: () +f = let x = Doesn'tExist + in undefined