Remove language extension completions. (haskell/ghcide#948)

* Remove language extension completions. * Remove code actions for language pragma extensions. * Remove unused defintions and imports * Remove test defintion use * Update comment describing why we return an empty list
pepeiborra · Dec 13, 2020 · 55eba31 · 55eba31
1 parent 5ecb835
commit 55eba31
Show file tree

Hide file tree

Showing 3 changed files with 16 additions and 109 deletions.
diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs
@@ -49,10 +49,8 @@ import Data.Char
 import Data.Maybe
 import Data.List.Extra
 import qualified Data.Text as T
-import Data.Tuple.Extra ((&&&))
 import Text.Regex.TDFA (mrAfter, (=~), (=~~))
 import Outputable (ppr, showSDocUnsafe)
-import GHC.LanguageExtensions.Type (Extension)
 import Data.Function
 import Control.Arrow ((>>>))
 import Data.Functor
@@ -157,8 +155,7 @@ suggestAction
   -> [(T.Text, [TextEdit])]
 suggestAction packageExports ideOptions parsedModule text diag = concat
    -- Order these suggestions by priority
-    [ suggestAddExtension diag             -- Highest priority
-    , suggestSignature True diag
+    [ suggestSignature True diag
     , suggestExtendImport packageExports text diag
     , suggestFillTypeWildcard diag
     , suggestFixConstructorImport text diag
@@ -518,40 +515,6 @@ suggestFillTypeWildcard Diagnostic{_range=_range,..}
         =  [("Use type signature: ‘" <> typeSignature <> "’", [TextEdit _range typeSignature])]
     | otherwise = []
 
-suggestAddExtension :: Diagnostic -> [(T.Text, [TextEdit])]
-suggestAddExtension Diagnostic{_range=_range,..}
--- File.hs:22:8: error:
---     Illegal lambda-case (use -XLambdaCase)
--- File.hs:22:6: error:
---     Illegal view pattern:  x -> foo
---     Use ViewPatterns to enable view patterns
--- File.hs:26:8: error:
---     Illegal `..' in record pattern
---     Use RecordWildCards to permit this
--- File.hs:53:28: error:
---     Illegal tuple section: use TupleSections
--- File.hs:238:29: error:
---     * Can't make a derived instance of `Data FSATrace':
---         You need DeriveDataTypeable to derive an instance for this class
---     * In the data declaration for `FSATrace'
--- C:\Neil\shake\src\Development\Shake\Command.hs:515:31: error:
---     * Illegal equational constraint a ~ ()
---       (Use GADTs or TypeFamilies to permit this)
---     * In the context: a ~ ()
---       While checking an instance declaration
---       In the instance declaration for `Unit (m a)'
-    | exts@(_:_) <- filter (`Map.member` ghcExtensions) $ T.split (not . isAlpha) $ T.replace "-X" "" _message
-        = [("Add " <> x <> " extension", [TextEdit (Range (Position 0 0) (Position 0 0)) $ "{-# LANGUAGE " <> x <> " #-}\n"]) | x <- exts]
-    | otherwise = []
-
--- | All the GHC extensions
-ghcExtensions :: Map.HashMap T.Text Extension
-ghcExtensions = Map.fromList . filter notStrictFlag . map ( ( T.pack . flagSpecName ) &&& flagSpecFlag ) $ xFlags
-  where
-    -- Strict often causes false positives, as in Data.Map.Strict imports.
-    -- See discussion at https://github.com/haskell/ghcide/pull/638
-    notStrictFlag (name, _) = name /= "Strict"
-
 suggestModuleTypo :: Diagnostic -> [(T.Text, [TextEdit])]
 suggestModuleTypo Diagnostic{_range=_range,..}
 -- src/Development/IDE/Core/Compile.hs:58:1: error:
@@ -648,7 +611,7 @@ suggestExtendImport exportsMap contents Diagnostic{_range=_range,..}
     | Just (binding, mod_srcspan) <-
       matchRegExMultipleImports _message
     , Just c <- contents
-    = mod_srcspan >>= (\(x, y) -> suggestions c binding x y) 
+    = mod_srcspan >>= (\(x, y) -> suggestions c binding x y)
     | otherwise = []
     where
         suggestions c binding mod srcspan
@@ -664,7 +627,7 @@ suggestExtendImport exportsMap contents Diagnostic{_range=_range,..}
         renderImport IdentInfo {parent, rendered}
           | Just p <- parent = p <> "(" <> rendered <> ")"
           | otherwise        = rendered
-        lookupExportMap binding mod 
+        lookupExportMap binding mod
           | Just match <- Map.lookup binding (getExportsMap exportsMap)
           , [(ident, _)] <- filter (\(_,m) -> mod == m) (Set.toList match)
            = Just ident

diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs
@@ -29,7 +29,6 @@ import Type
 import Packages
 #if MIN_GHC_API_VERSION(8,10,0)
 import Predicate (isDictTy)
-import GHC.Platform
 import Pair
 import Coercion
 #endif
@@ -560,8 +559,10 @@ getCompletions ideOpts CC { allModNamesAsNS, unqualCompls, qualCompls, importabl
       result
         | "import " `T.isPrefixOf` fullLine
         = filtImportCompls
+        -- we leave this condition here to avoid duplications and return empty list
+        -- since HLS implements this completion (#haskell-language-server/pull/662)
         | "{-# language" `T.isPrefixOf` T.toLower fullLine
-        = filtOptsCompls languagesAndExts
+        = []
         | "{-# options_ghc" `T.isPrefixOf` T.toLower fullLine
         = filtOptsCompls (map (T.pack . stripLeading '-') $ flagsForCompletion False)
         | "{-# " `T.isPrefixOf` fullLine
@@ -574,14 +575,6 @@ getCompletions ideOpts CC { allModNamesAsNS, unqualCompls, qualCompls, importabl
   return result
 
 
--- The supported languages and extensions
-languagesAndExts :: [T.Text]
-#if MIN_GHC_API_VERSION(8,10,0)
-languagesAndExts = map T.pack $ GHC.supportedLanguagesAndExtensions ( PlatformMini ArchUnknown OSUnknown )
-#else
-languagesAndExts = map T.pack GHC.supportedLanguagesAndExtensions
-#endif
-
 -- ---------------------------------------------------------------------
 -- helper functions for pragmas
 -- ---------------------------------------------------------------------

diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs
@@ -547,7 +547,6 @@ codeActionTests = testGroup "code actions"
   , removeImportTests
   , extendImportTests
   , suggestImportTests
-  , addExtensionTests
   , fixConstructorImportTests
   , importRenameActionTests
   , fillTypedHoleTests
@@ -1038,7 +1037,7 @@ extendImportTests = testGroup "extend import actions"
             , "import ModuleA (A(Constructor))"
             , "b :: A"
             , "b = Constructor"
-            ])  
+            ])
   , testSession "extend single line import with mixed constructors" $ template
       [("ModuleA.hs", T.unlines
             [ "module ModuleA where"
@@ -1230,63 +1229,6 @@ suggestImportTests = testGroup "suggest import actions"
           else
               liftIO $ [_title | CACodeAction CodeAction{_title} <- actions, _title == newImp ] @?= []
 
-
-addExtensionTests :: TestTree
-addExtensionTests = testGroup "add language extension actions"
-  [ testSession "add NamedFieldPuns language extension" $ template
-      (T.unlines
-            [ "module Module where"
-            , ""
-            , "data A = A { getA :: Bool }"
-            , ""
-            , "f :: A -> Bool"
-            , "f A { getA } = getA"
-            ])
-      (Range (Position 0 0) (Position 0 0))
-      "Add NamedFieldPuns extension"
-      (T.unlines
-            [ "{-# LANGUAGE NamedFieldPuns #-}"
-            , "module Module where"
-            , ""
-            , "data A = A { getA :: Bool }"
-            , ""
-            , "f :: A -> Bool"
-            , "f A { getA } = getA"
-            ])
-  , testSession "add RecordWildCards language extension" $ template
-      (T.unlines
-            [ "module Module where"
-            , ""
-            , "data A = A { getA :: Bool }"
-            , ""
-            , "f :: A -> Bool"
-            , "f A { .. } = getA"
-            ])
-      (Range (Position 0 0) (Position 0 0))
-      "Add RecordWildCards extension"
-      (T.unlines
-            [ "{-# LANGUAGE RecordWildCards #-}"
-            , "module Module where"
-            , ""
-            , "data A = A { getA :: Bool }"
-            , ""
-            , "f :: A -> Bool"
-            , "f A { .. } = getA"
-            ])
-  ]
-    where
-      template initialContent range expectedAction expectedContents = do
-        doc <- createDoc "Module.hs" "haskell" initialContent
-        _ <- waitForDiagnostics
-        CACodeAction action@CodeAction { _title = actionTitle } : _
-                    <- sortOn (\(CACodeAction CodeAction{_title=x}) -> x) <$>
-                       getCodeActions doc range
-        liftIO $ expectedAction @=? actionTitle
-        executeCodeAction action
-        contentAfterAction <- documentContents doc
-        liftIO $ expectedContents @=? contentAfterAction
-
-
 insertNewDefinitionTests :: TestTree
 insertNewDefinitionTests = testGroup "insert new definition actions"
   [ testSession "insert new function definition" $ do
@@ -2952,7 +2894,16 @@ nonLocalCompletionTests =
        Just (List [TextEdit {_range = Range {_start = Position {_line = 1, _character = 44}, _end = Position {_line = 1, _character = 44}}, _newText = "FormatParse, "}])),
        ("FormatParse", CiSnippet, "FormatParse {fpModifiers=${1:_fpModifiers}, fpChar=${2:_fpChar}, fpRest=${3:_fpRest}}", False, False,
        Just (List [TextEdit {_range = Range {_start = Position {_line = 1, _character = 44}, _end = Position {_line = 1, _character = 44}}, _newText = "FormatParse, "}]))
+      ],
+      -- we need this test to make sure the ghcide completions module does not return completions for language pragmas. this functionality is turned on in hls
+     completionTest
+      "do not show pragma completions"
+      [ "{-# LANGUAGE  ",
+        "{module A where}",
+        "main = return ()"
       ]
+      (Position 0 13)
+      []
   ]
 
 otherCompletionTests :: [TestTree]