From 55eba31232bd41ff3085d4557824d9d0cb4b3c70 Mon Sep 17 00:00:00 2001 From: Guru Devanla Date: Sun, 13 Dec 2020 08:51:57 -0800 Subject: [PATCH] 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 --- .../src/Development/IDE/Plugin/CodeAction.hs | 43 +----------- .../IDE/Plugin/Completions/Logic.hs | 13 +--- ghcide/test/exe/Main.hs | 69 +++---------------- 3 files changed, 16 insertions(+), 109 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index b17b350420..9468cded70 100644 --- 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 index f91a3f7eae..dbfcb62f22 100644 --- 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 index 1438c85274..ee198b1d60 100644 --- 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]