From 8f58652f6a80b652e523bb193819ee15b9c76842 Mon Sep 17 00:00:00 2001
From: mrBliss <dewinant@gmail.com>
Date: Wed, 20 Jan 2021 12:18:38 +0100
Subject: [PATCH] Complete the No- variants of language extensions

Fixes #1187.

Separate the list of pragmas used for completion from the list of pragmas used
to suggest enabling a language extension to fix an error. The former now include
the `No-` variants of the language extensions, e.g., `NoDuplicateRecordFields`.
---
 plugins/default/src/Ide/Plugin/Pragmas.hs | 24 +++++++++++++++----
 test/functional/Completion.hs             | 28 +++++++++++++++++++++++
 2 files changed, 47 insertions(+), 5 deletions(-)

diff --git a/plugins/default/src/Ide/Plugin/Pragmas.hs b/plugins/default/src/Ide/Plugin/Pragmas.hs
index ca595873f2..a74a26ae3b 100644
--- a/plugins/default/src/Ide/Plugin/Pragmas.hs
+++ b/plugins/default/src/Ide/Plugin/Pragmas.hs
@@ -99,12 +99,26 @@ findPragma str = concatMap check possiblePragmas
   where
     check p = [p | T.isInfixOf p str]
 
+    -- We exclude the Strict extension as it causes many false positives, see
+    -- the discussion at https://github.com/haskell/ghcide/pull/638
+    --
+    -- We don't include the No- variants, as GHC never suggests disabling an
+    -- extension in an error message.
+    possiblePragmas :: [T.Text]
+    possiblePragmas =
+       [ name
+       | FlagSpec{flagSpecName = T.pack -> name} <- xFlags
+       , "Strict" /= name
+       ]
+
 -- ---------------------------------------------------------------------
 
--- | Possible Pragma names.
--- See discussion at https://github.com/haskell/ghcide/pull/638
-possiblePragmas :: [T.Text]
-possiblePragmas = [name | FlagSpec{flagSpecName = T.pack -> name} <- xFlags, "Strict" /= name]
+-- | All language pragmas, including the No- variants
+allPragmas :: [T.Text]
+allPragmas = concat
+    [ [name, "No" <> name]
+    | FlagSpec{flagSpecName = T.pack -> name} <- xFlags
+    ]
 
 -- ---------------------------------------------------------------------
 
@@ -120,7 +134,7 @@ completion lspFuncs _ide complParams = do
             where
                 result (Just pfix)
                     | "{-# LANGUAGE" `T.isPrefixOf` VFS.fullLine pfix
-                    = Completions $ List $ map buildCompletion possiblePragmas
+                    = Completions $ List $ map buildCompletion allPragmas
                     | otherwise
                     = Completions $ List []
                 result Nothing = Completions $ List []
diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs
index a07988f12e..a3e7e149a4 100644
--- a/test/functional/Completion.hs
+++ b/test/functional/Completion.hs
@@ -94,6 +94,34 @@ tests = testGroup "completions" [
              item ^. label @?= "OverloadedStrings"
              item ^. kind @?= Just CiKeyword
 
+     , testCase "completes the Strict language extension" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
+         doc <- openDoc "Completion.hs" "haskell"
+
+         _ <- waitForDiagnostics
+
+         let te = TextEdit (Range (Position 0 13) (Position 0 31)) "Str"
+         _ <- applyEdit doc te
+
+         compls <- getCompletions doc (Position 0 24)
+         let item = head $ filter ((== "Strict") . (^. label)) compls
+         liftIO $ do
+             item ^. label @?= "Strict"
+             item ^. kind @?= Just CiKeyword
+
+     , testCase "completes No- language extensions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
+         doc <- openDoc "Completion.hs" "haskell"
+
+         _ <- waitForDiagnostics
+
+         let te = TextEdit (Range (Position 0 13) (Position 0 31)) "NoOverload"
+         _ <- applyEdit doc te
+
+         compls <- getCompletions doc (Position 0 24)
+         let item = head $ filter ((== "NoOverloadedStrings") . (^. label)) compls
+         liftIO $ do
+             item ^. label @?= "NoOverloadedStrings"
+             item ^. kind @?= Just CiKeyword
+
      , testCase "completes pragmas" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
          doc <- openDoc "Completion.hs" "haskell"