From 047ffc366461470a27ea47c2042c76bbf97e1d15 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= <anka.213@gmail.com>
Date: Mon, 2 Aug 2021 20:33:43 +0800
Subject: [PATCH] Don't suggest disabling type errors (#2061)

* Add a failing test for #2032

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

Fixes #2032
---
 plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs      | 8 +++++++-
 plugins/hls-pragmas-plugin/test/Main.hs                   | 7 +++++++
 .../test/testdata/DeferredTypeErrors.expected.hs          | 4 ++++
 .../test/testdata/DeferredTypeErrors.hs                   | 4 ++++
 4 files changed, 22 insertions(+), 1 deletion(-)
 create mode 100644 plugins/hls-pragmas-plugin/test/testdata/DeferredTypeErrors.expected.hs
 create mode 100644 plugins/hls-pragmas-plugin/test/testdata/DeferredTypeErrors.hs

diff --git a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs
index bc00c9b0a3..c993ae5cf0 100644
--- a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs
+++ b/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.
diff --git a/plugins/hls-pragmas-plugin/test/Main.hs b/plugins/hls-pragmas-plugin/test/Main.hs
index d9af4bbc0f..b48591dda2 100644
--- a/plugins/hls-pragmas-plugin/test/Main.hs
+++ b/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
diff --git a/plugins/hls-pragmas-plugin/test/testdata/DeferredTypeErrors.expected.hs b/plugins/hls-pragmas-plugin/test/testdata/DeferredTypeErrors.expected.hs
new file mode 100644
index 0000000000..a0e2fd6162
--- /dev/null
+++ b/plugins/hls-pragmas-plugin/test/testdata/DeferredTypeErrors.expected.hs
@@ -0,0 +1,4 @@
+module DeferredTypeErrors where
+
+foo :: Int
+foo = ()
diff --git a/plugins/hls-pragmas-plugin/test/testdata/DeferredTypeErrors.hs b/plugins/hls-pragmas-plugin/test/testdata/DeferredTypeErrors.hs
new file mode 100644
index 0000000000..a0e2fd6162
--- /dev/null
+++ b/plugins/hls-pragmas-plugin/test/testdata/DeferredTypeErrors.hs
@@ -0,0 +1,4 @@
+module DeferredTypeErrors where
+
+foo :: Int
+foo = ()