Don't suggest disabling type errors (#2061)

* Add a failing test for #2032

* Don't suggest -Wno-deferred-type-errors

Fixes #2032

Author: anka-213

plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs

@@ -81,10 +81,16 @@ suggest dflags diag =
 
 suggestDisableWarning :: Diagnostic -> [PragmaEdit]
 suggestDisableWarning Diagnostic {_code}
-  | Just (J.InR (T.stripPrefix "-W" -> Just w)) <- _code =
+  | Just (J.InR (T.stripPrefix "-W" -> Just w)) <- _code
+  , w `notElem` warningBlacklist =
     pure ("Disable \"" <> w <> "\" warnings", OptGHC w)
   | otherwise = []
 
+-- Don't suggest disabling type errors as a solution to all type errors
+warningBlacklist :: [T.Text]
+-- warningBlacklist = []
+warningBlacklist = ["deferred-type-errors"]
+
 -- ---------------------------------------------------------------------
 
 -- | Offer to add a missing Language Pragma to the top of a file.

plugins/hls-pragmas-plugin/test/Main.hs

@@ -123,6 +123,13 @@ codeActionTests =
       cas <- map fromAction <$> getAllCodeActions doc
       liftIO $ "Disable \"unused-imports\" warnings" `elem` map (^. L.title) cas @? "Contains unused-imports code action"
       executeCodeAction $ head cas
+
+  , goldenWithPragmas "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
   ]
 
 completionTests :: TestTree

plugins/hls-pragmas-plugin/test/testdata/DeferredTypeErrors.expected.hs

@@ -0,0 +1,4 @@
+module DeferredTypeErrors where
+
+foo :: Int
+foo = ()

plugins/hls-pragmas-plugin/test/testdata/DeferredTypeErrors.hs

@@ -0,0 +1,4 @@
+module DeferredTypeErrors where
+
+foo :: Int
+foo = ()