From a52894f480dfc253b32ef232f0024e4d9090eaf0 Mon Sep 17 00:00:00 2001 From: Alex Naspo Date: Mon, 13 Sep 2021 07:59:42 -0400 Subject: [PATCH 01/11] enable completions of local imports --- .../src/Development/IDE/Plugin/Completions/Logic.hs | 11 +++-------- .../src/Development/IDE/Plugin/Completions/Types.hs | 7 +++---- 2 files changed, 6 insertions(+), 12 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index c3f1de1a4a..d27815b981 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -2,7 +2,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiWayIf #-} - -- Mostly taken from "haskell-ide-engine" module Development.IDE.Plugin.Completions.Logic ( CachedCompletions @@ -66,6 +65,7 @@ import qualified Language.LSP.VFS as VFS import Outputable (Outputable) import TyCoRep + -- From haskell-ide-engine/hie-plugin-api/Haskell/Ide/Engine/Context.hs -- | A context of a declaration in the program @@ -403,15 +403,12 @@ cacheDataProducer uri env curMod globalEnv inScopeEnv limports = do (unquals,quals) <- getCompls rdrElts - -- The list of all importable Modules from all packages - moduleNames <- maybe [] (map showModName) <$> envVisibleModuleNames env return $ CC { allModNamesAsNS = allModNamesAsNS , unqualCompls = unquals , qualCompls = quals , anyQualCompls = [] - , importableModules = moduleNames } -- | Produces completions from the top level declarations of a module. @@ -421,7 +418,6 @@ localCompletionsForParsedModule uri pm@ParsedModule{pm_parsed_source = L _ HsMod , unqualCompls = compls , qualCompls = mempty , anyQualCompls = [] - , importableModules = mempty } where typeSigIds = Set.fromList @@ -535,7 +531,7 @@ getCompletions -> CompletionsConfig -> HM.HashMap T.Text (HashSet.HashSet IdentInfo) -> IO [CompletionItem] -getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qualCompls, importableModules} +getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qualCompls} maybe_parsed (localBindings, bmapping) prefixInfo caps config moduleExportsMap = do let VFS.PosPrefixInfo { fullLine, prefixModule, prefixText } = prefixInfo enteredQual = if T.null prefixModule then "" else prefixModule <> "." @@ -604,12 +600,11 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu , enteredQual `T.isPrefixOf` label ] - filtImportCompls = filtListWith (mkImportCompl enteredQual) importableModules + filtImportCompls = filtListWith (mkImportCompl enteredQual) $ map fst $ HM.toList moduleExportsMap filterModuleExports moduleName = filtListWith $ mkModuleFunctionImport moduleName filtKeywordCompls | T.null prefixModule = filtListWith mkExtCompl (optKeywords ideOpts) | otherwise = [] - if -- TODO: handle multiline imports | "import " `T.isPrefixOf` fullLine diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs index b8660887b6..998355664c 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs @@ -95,7 +95,6 @@ data CachedCompletions = CC , qualCompls :: QualCompls -- ^ Completion items associated to -- to a specific module name. , anyQualCompls :: [Maybe T.Text -> CompItem] -- ^ Items associated to any qualifier - , importableModules :: [T.Text] -- ^ All modules that may be imported. } instance Show CachedCompletions where show _ = "" @@ -104,8 +103,8 @@ instance NFData CachedCompletions where rnf = rwhnf instance Monoid CachedCompletions where - mempty = CC mempty mempty mempty mempty mempty + mempty = CC mempty mempty mempty mempty instance Semigroup CachedCompletions where - CC a b c d e <> CC a' b' c' d' e' = - CC (a<>a') (b<>b') (c<>c') (d<>d') (e<>e') + CC a b c d <> CC a' b' c' d' = + CC (a<>a') (b<>b') (c<>c') (d<>d') From b7d34a8858267584b248b467fadf69753b170896 Mon Sep 17 00:00:00 2001 From: Alex Naspo Date: Mon, 13 Sep 2021 08:30:10 -0400 Subject: [PATCH 02/11] added unit test --- ghcide/test/exe/Main.hs | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index d3a896a785..162bcfae23 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -56,6 +56,7 @@ import Development.IDE.Test (Cursor, import Development.IDE.Test.Runfiles import qualified Development.IDE.Types.Diagnostics as Diagnostics import Development.IDE.Types.Location +import qualified Language.LSP.Types.Lens as Lens (label) import Development.Shake (getDirectoryFilesIO) import qualified Experiments as Bench import Ide.Plugin.Config @@ -4589,7 +4590,24 @@ projectCompletionTests = <- compls , _label == "anidentifier" ] - liftIO $ compls' @?= ["Defined in 'A"] + liftIO $ compls' @?= ["Defined in 'A"], + testSession' "from hiedb" $ \dir-> do + liftIO $ writeFile (dir "hie.yaml") + "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"ALocalModule\", \"B\"]}}" + _ <- createDoc "ALocalModule.hs" "haskell" $ T.unlines + [ "module ALocalModule (anidentifier) where", + "anidentifier = ()" + ] + _ <- waitForDiagnostics + -- Note that B does not import A + doc <- createDoc "B.hs" "haskell" $ T.unlines + [ "module B where", + "import ALocal" + ] + compls <- getCompletions doc (Position 1 13) + let item = head $ filter ((== "ALocalModule") . (^. Lens.label)) compls + liftIO $ do + item ^. Lens.label @?= "ALocalModule" ] highlightTests :: TestTree From 30b1da406e5c4321ef12c139fa31d4cb12fab613 Mon Sep 17 00:00:00 2001 From: Alex Naspo Date: Mon, 13 Sep 2021 08:36:36 -0400 Subject: [PATCH 03/11] use HM.keys --- ghcide/src/Development/IDE/Plugin/Completions/Logic.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index d27815b981..b628ef6dfc 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -600,7 +600,7 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu , enteredQual `T.isPrefixOf` label ] - filtImportCompls = filtListWith (mkImportCompl enteredQual) $ map fst $ HM.toList moduleExportsMap + filtImportCompls = filtListWith (mkImportCompl enteredQual) $ HM.keys moduleExportsMap filterModuleExports moduleName = filtListWith $ mkModuleFunctionImport moduleName filtKeywordCompls | T.null prefixModule = filtListWith mkExtCompl (optKeywords ideOpts) From 0691a180c74fdf4e51341b376468fe7777dd8505 Mon Sep 17 00:00:00 2001 From: Alex Naspo Date: Mon, 13 Sep 2021 08:39:14 -0400 Subject: [PATCH 04/11] rename test --- ghcide/test/exe/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 162bcfae23..10220775a7 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -4591,7 +4591,7 @@ projectCompletionTests = , _label == "anidentifier" ] liftIO $ compls' @?= ["Defined in 'A"], - testSession' "from hiedb" $ \dir-> do + testSession' "auto complete project imports" $ \dir-> do liftIO $ writeFile (dir "hie.yaml") "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"ALocalModule\", \"B\"]}}" _ <- createDoc "ALocalModule.hs" "haskell" $ T.unlines From eca712714c02b820457d84ef043acf1a433fe557 Mon Sep 17 00:00:00 2001 From: Alex Naspo Date: Tue, 14 Sep 2021 19:58:09 -0400 Subject: [PATCH 05/11] Revert "enable completions of local imports" This reverts commit a52894f480dfc253b32ef232f0024e4d9090eaf0. --- .../src/Development/IDE/Plugin/Completions/Logic.hs | 11 ++++++++--- .../src/Development/IDE/Plugin/Completions/Types.hs | 7 ++++--- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index b628ef6dfc..c3f1de1a4a 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -2,6 +2,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiWayIf #-} + -- Mostly taken from "haskell-ide-engine" module Development.IDE.Plugin.Completions.Logic ( CachedCompletions @@ -65,7 +66,6 @@ import qualified Language.LSP.VFS as VFS import Outputable (Outputable) import TyCoRep - -- From haskell-ide-engine/hie-plugin-api/Haskell/Ide/Engine/Context.hs -- | A context of a declaration in the program @@ -403,12 +403,15 @@ cacheDataProducer uri env curMod globalEnv inScopeEnv limports = do (unquals,quals) <- getCompls rdrElts + -- The list of all importable Modules from all packages + moduleNames <- maybe [] (map showModName) <$> envVisibleModuleNames env return $ CC { allModNamesAsNS = allModNamesAsNS , unqualCompls = unquals , qualCompls = quals , anyQualCompls = [] + , importableModules = moduleNames } -- | Produces completions from the top level declarations of a module. @@ -418,6 +421,7 @@ localCompletionsForParsedModule uri pm@ParsedModule{pm_parsed_source = L _ HsMod , unqualCompls = compls , qualCompls = mempty , anyQualCompls = [] + , importableModules = mempty } where typeSigIds = Set.fromList @@ -531,7 +535,7 @@ getCompletions -> CompletionsConfig -> HM.HashMap T.Text (HashSet.HashSet IdentInfo) -> IO [CompletionItem] -getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qualCompls} +getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qualCompls, importableModules} maybe_parsed (localBindings, bmapping) prefixInfo caps config moduleExportsMap = do let VFS.PosPrefixInfo { fullLine, prefixModule, prefixText } = prefixInfo enteredQual = if T.null prefixModule then "" else prefixModule <> "." @@ -600,11 +604,12 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu , enteredQual `T.isPrefixOf` label ] - filtImportCompls = filtListWith (mkImportCompl enteredQual) $ HM.keys moduleExportsMap + filtImportCompls = filtListWith (mkImportCompl enteredQual) importableModules filterModuleExports moduleName = filtListWith $ mkModuleFunctionImport moduleName filtKeywordCompls | T.null prefixModule = filtListWith mkExtCompl (optKeywords ideOpts) | otherwise = [] + if -- TODO: handle multiline imports | "import " `T.isPrefixOf` fullLine diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs index 998355664c..b8660887b6 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs @@ -95,6 +95,7 @@ data CachedCompletions = CC , qualCompls :: QualCompls -- ^ Completion items associated to -- to a specific module name. , anyQualCompls :: [Maybe T.Text -> CompItem] -- ^ Items associated to any qualifier + , importableModules :: [T.Text] -- ^ All modules that may be imported. } instance Show CachedCompletions where show _ = "" @@ -103,8 +104,8 @@ instance NFData CachedCompletions where rnf = rwhnf instance Monoid CachedCompletions where - mempty = CC mempty mempty mempty mempty + mempty = CC mempty mempty mempty mempty mempty instance Semigroup CachedCompletions where - CC a b c d <> CC a' b' c' d' = - CC (a<>a') (b<>b') (c<>c') (d<>d') + CC a b c d e <> CC a' b' c' d' e' = + CC (a<>a') (b<>b') (c<>c') (d<>d') (e<>e') From 89fb241efa76929f8dcef238cc3fe93540841956 Mon Sep 17 00:00:00 2001 From: Alex Naspo Date: Tue, 14 Sep 2021 19:59:05 -0400 Subject: [PATCH 06/11] use GetKnownTargets --- .../src/Development/IDE/Plugin/Completions.hs | 18 ++++++++++++++---- .../IDE/Plugin/Completions/Logic.hs | 7 ++++--- 2 files changed, 18 insertions(+), 7 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 9b1b203262..a96ba446e4 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -48,10 +48,13 @@ import Ide.Types import qualified Language.LSP.Server as LSP import Language.LSP.Types import qualified Language.LSP.VFS as VFS + +import Development.IDE.Types.KnownTargets (Target(..)) #if MIN_VERSION_ghc(9,0,0) import GHC.Tc.Module (tcRnImportDecls) #else import TcRnDriver (tcRnImportDecls) +import qualified Data.HashMap.Strict as HM #endif descriptor :: PluginId -> PluginDescriptor IdeState @@ -133,13 +136,15 @@ getCompletionsLSP ide plId fmap Right $ case (contents, uriToFilePath' uri) of (Just cnts, Just path) -> do let npath = toNormalizedFilePath' path - (ideOpts, compls, moduleExports) <- liftIO $ runIdeAction "Completion" (shakeExtras ide) $ do + (ideOpts, compls, moduleExports, lModules) <- liftIO $ runIdeAction "Completion" (shakeExtras ide) $ do opts <- liftIO $ getIdeOptionsIO $ shakeExtras ide localCompls <- useWithStaleFast LocalCompletions npath nonLocalCompls <- useWithStaleFast NonLocalCompletions npath pm <- useWithStaleFast GetParsedModule npath binds <- fromMaybe (mempty, zeroMapping) <$> useWithStaleFast GetBindings npath - + knownTargets <- liftIO $ runAction "Completion" ide $ useNoFile GetKnownTargets + let localModules = maybe [] HM.keys knownTargets + let lModules = map toModueNameText localModules -- set up the exports map including both package and project-level identifiers packageExportsMapIO <- fmap(envPackageExports . fst) <$> useWithStaleFast GhcSession npath packageExportsMap <- mapM liftIO packageExportsMapIO @@ -151,7 +156,7 @@ getCompletionsLSP ide plId exportsCompls = mempty{anyQualCompls = exportsCompItems} let compls = (fst <$> localCompls) <> (fst <$> nonLocalCompls) <> Just exportsCompls - pure (opts, fmap (,pm,binds) compls, moduleExports) + pure (opts, fmap (,pm,binds) compls, moduleExports, lModules) case compls of Just (cci', parsedMod, bindMap) -> do pfix <- VFS.getCompletionPrefix position cnts @@ -161,7 +166,7 @@ getCompletionsLSP ide plId (Just pfix', _) -> do let clientCaps = clientCapabilities $ shakeExtras ide config <- getCompletionsConfig plId - allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps config moduleExports + allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps config moduleExports lModules pure $ InL (List allCompletions) _ -> return (InL $ List []) _ -> return (InL $ List []) @@ -169,6 +174,11 @@ getCompletionsLSP ide plId ---------------------------------------------------------------------------------------------------- +toModueNameText :: Development.IDE.Types.KnownTargets.Target -> T.Text +toModueNameText target = case target of + Development.IDE.Types.KnownTargets.TargetModule m -> T.pack $ moduleNameString m + _ -> T.empty + extendImportCommand :: PluginCommand IdeState extendImportCommand = PluginCommand (CommandId extendImportCommandId) "additional edits for a completion" extendImportHandler diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index c3f1de1a4a..befafdb2d4 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -534,9 +534,10 @@ getCompletions -> ClientCapabilities -> CompletionsConfig -> HM.HashMap T.Text (HashSet.HashSet IdentInfo) + -> [T.Text] -> IO [CompletionItem] getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qualCompls, importableModules} - maybe_parsed (localBindings, bmapping) prefixInfo caps config moduleExportsMap = do + maybe_parsed (localBindings, bmapping) prefixInfo caps config moduleExportsMap localImportableModues = do let VFS.PosPrefixInfo { fullLine, prefixModule, prefixText } = prefixInfo enteredQual = if T.null prefixModule then "" else prefixModule <> "." fullPrefix = enteredQual <> prefixText @@ -604,7 +605,7 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu , enteredQual `T.isPrefixOf` label ] - filtImportCompls = filtListWith (mkImportCompl enteredQual) importableModules + filtImportCompls localModules = filtListWith (mkImportCompl enteredQual) (importableModules <> localModules) filterModuleExports moduleName = filtListWith $ mkModuleFunctionImport moduleName filtKeywordCompls | T.null prefixModule = filtListWith mkExtCompl (optKeywords ideOpts) @@ -621,7 +622,7 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu funs = map (show . name) $ HashSet.toList funcs return $ filterModuleExports moduleName $ map T.pack funs | "import " `T.isPrefixOf` fullLine - -> return filtImportCompls + -> return $ filtImportCompls localImportableModues -- we leave this condition here to avoid duplications and return empty list -- since HLS implements these completions (#haskell-language-server/pull/662) | "{-# " `T.isPrefixOf` fullLine From 580796d5968775d43cb6caab85b4d8d2ee42315e Mon Sep 17 00:00:00 2001 From: Alex Naspo Date: Tue, 14 Sep 2021 20:22:44 -0400 Subject: [PATCH 07/11] clean up --- ghcide/src/Development/IDE/Plugin/Completions.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index a96ba446e4..d69444d5f2 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -143,7 +143,7 @@ getCompletionsLSP ide plId pm <- useWithStaleFast GetParsedModule npath binds <- fromMaybe (mempty, zeroMapping) <$> useWithStaleFast GetBindings npath knownTargets <- liftIO $ runAction "Completion" ide $ useNoFile GetKnownTargets - let localModules = maybe [] HM.keys knownTargets + let localModules = maybe [] Map.keys knownTargets let lModules = map toModueNameText localModules -- set up the exports map including both package and project-level identifiers packageExportsMapIO <- fmap(envPackageExports . fst) <$> useWithStaleFast GhcSession npath From 6b80ed5753a84e363ce660b08e23eb2aaffd9c3d Mon Sep 17 00:00:00 2001 From: Alex Naspo Date: Wed, 15 Sep 2021 17:47:09 -0400 Subject: [PATCH 08/11] clean up --- ghcide/src/Development/IDE/Plugin/Completions.hs | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 19465e6363..bf1031dc6d 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -47,14 +47,7 @@ import qualified Language.LSP.Server as LSP import Language.LSP.Types import qualified Language.LSP.VFS as VFS -import Development.IDE.Types.KnownTargets (Target(..)) -#if MIN_VERSION_ghc(9,0,0) -import GHC.Tc.Module (tcRnImportDecls) -#else -import TcRnDriver (tcRnImportDecls) -import qualified Data.HashMap.Strict as HM -#endif - +import Development.IDE.Types.KnownTargets (Target(..)) descriptor :: PluginId -> PluginDescriptor IdeState descriptor plId = (defaultPluginDescriptor plId) From 7d7737494ed1c746a16c6db90b2e184712ba9a51 Mon Sep 17 00:00:00 2001 From: Alex Naspo Date: Wed, 15 Sep 2021 18:02:11 -0400 Subject: [PATCH 09/11] leverage CachedCompletions over argument --- ghcide/src/Development/IDE/Plugin/Completions.hs | 6 +++--- ghcide/src/Development/IDE/Plugin/Completions/Logic.hs | 7 +++---- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index bf1031dc6d..577b59f55e 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -136,7 +136,7 @@ getCompletionsLSP ide plId binds <- fromMaybe (mempty, zeroMapping) <$> useWithStaleFast GetBindings npath knownTargets <- liftIO $ runAction "Completion" ide $ useNoFile GetKnownTargets let localModules = maybe [] Map.keys knownTargets - let lModules = map toModueNameText localModules + let lModules = mempty{importableModules = map toModueNameText localModules} -- set up the exports map including both package and project-level identifiers packageExportsMapIO <- fmap(envPackageExports . fst) <$> useWithStaleFast GhcSession npath packageExportsMap <- mapM liftIO packageExportsMapIO @@ -146,7 +146,7 @@ getCompletionsLSP ide plId let moduleExports = getModuleExportsMap exportsMap exportsCompItems = foldMap (map (fromIdentInfo uri) . Set.toList) . Map.elems . getExportsMap $ exportsMap exportsCompls = mempty{anyQualCompls = exportsCompItems} - let compls = (fst <$> localCompls) <> (fst <$> nonLocalCompls) <> Just exportsCompls + let compls = (fst <$> localCompls) <> (fst <$> nonLocalCompls) <> Just exportsCompls <> Just lModules pure (opts, fmap (,pm,binds) compls, moduleExports, lModules) case compls of @@ -158,7 +158,7 @@ getCompletionsLSP ide plId (Just pfix', _) -> do let clientCaps = clientCapabilities $ shakeExtras ide config <- getCompletionsConfig plId - allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps config moduleExports lModules + allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps config moduleExports pure $ InL (List allCompletions) _ -> return (InL $ List []) _ -> return (InL $ List []) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 843b4f6fef..fbf66ab366 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -521,10 +521,9 @@ getCompletions -> ClientCapabilities -> CompletionsConfig -> HM.HashMap T.Text (HashSet.HashSet IdentInfo) - -> [T.Text] -> IO [CompletionItem] getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qualCompls, importableModules} - maybe_parsed (localBindings, bmapping) prefixInfo caps config moduleExportsMap localImportableModues = do + maybe_parsed (localBindings, bmapping) prefixInfo caps config moduleExportsMap = do let VFS.PosPrefixInfo { fullLine, prefixModule, prefixText } = prefixInfo enteredQual = if T.null prefixModule then "" else prefixModule <> "." fullPrefix = enteredQual <> prefixText @@ -592,7 +591,7 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu , enteredQual `T.isPrefixOf` label ] - filtImportCompls localModules = filtListWith (mkImportCompl enteredQual) (importableModules <> localModules) + filtImportCompls = filtListWith (mkImportCompl enteredQual) importableModules filterModuleExports moduleName = filtListWith $ mkModuleFunctionImport moduleName filtKeywordCompls | T.null prefixModule = filtListWith mkExtCompl (optKeywords ideOpts) @@ -609,7 +608,7 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu funs = map (show . name) $ HashSet.toList funcs return $ filterModuleExports moduleName $ map T.pack funs | "import " `T.isPrefixOf` fullLine - -> return $ filtImportCompls localImportableModues + -> return filtImportCompls -- we leave this condition here to avoid duplications and return empty list -- since HLS implements these completions (#haskell-language-server/pull/662) | "{-# " `T.isPrefixOf` fullLine From b7dd3bf5c46698855dfba3da04ae3bd280da82f6 Mon Sep 17 00:00:00 2001 From: Alex Naspo Date: Wed, 15 Sep 2021 18:05:12 -0400 Subject: [PATCH 10/11] clean up --- ghcide/src/Development/IDE/Plugin/Completions.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 577b59f55e..fc0a26da67 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -30,6 +30,7 @@ import Development.IDE.GHC.ExactPrint (Annotated (annsA) import Development.IDE.GHC.Util (prettyPrint) import Development.IDE.Graph import Development.IDE.Graph.Classes +import Development.IDE.Types.KnownTargets (Target(..)) import Development.IDE.Plugin.CodeAction (newImport, newImportToEdit) import Development.IDE.Plugin.CodeAction.ExactPrint @@ -47,8 +48,6 @@ import qualified Language.LSP.Server as LSP import Language.LSP.Types import qualified Language.LSP.VFS as VFS -import Development.IDE.Types.KnownTargets (Target(..)) - descriptor :: PluginId -> PluginDescriptor IdeState descriptor plId = (defaultPluginDescriptor plId) { pluginRules = produceCompletions @@ -128,7 +127,7 @@ getCompletionsLSP ide plId fmap Right $ case (contents, uriToFilePath' uri) of (Just cnts, Just path) -> do let npath = toNormalizedFilePath' path - (ideOpts, compls, moduleExports, lModules) <- liftIO $ runIdeAction "Completion" (shakeExtras ide) $ do + (ideOpts, compls, moduleExports) <- liftIO $ runIdeAction "Completion" (shakeExtras ide) $ do opts <- liftIO $ getIdeOptionsIO $ shakeExtras ide localCompls <- useWithStaleFast LocalCompletions npath nonLocalCompls <- useWithStaleFast NonLocalCompletions npath @@ -148,7 +147,7 @@ getCompletionsLSP ide plId exportsCompls = mempty{anyQualCompls = exportsCompItems} let compls = (fst <$> localCompls) <> (fst <$> nonLocalCompls) <> Just exportsCompls <> Just lModules - pure (opts, fmap (,pm,binds) compls, moduleExports, lModules) + pure (opts, fmap (,pm,binds) compls, moduleExports) case compls of Just (cci', parsedMod, bindMap) -> do pfix <- VFS.getCompletionPrefix position cnts From 7444201bc7c56650c073887e058945e114eaeaa0 Mon Sep 17 00:00:00 2001 From: Alex Naspo Date: Wed, 15 Sep 2021 18:14:25 -0400 Subject: [PATCH 11/11] clean --- ghcide/src/Development/IDE/Plugin/Completions.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index fc0a26da67..5d764f12df 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -30,7 +30,7 @@ import Development.IDE.GHC.ExactPrint (Annotated (annsA) import Development.IDE.GHC.Util (prettyPrint) import Development.IDE.Graph import Development.IDE.Graph.Classes -import Development.IDE.Types.KnownTargets (Target(..)) +import qualified Development.IDE.Types.KnownTargets as KT import Development.IDE.Plugin.CodeAction (newImport, newImportToEdit) import Development.IDE.Plugin.CodeAction.ExactPrint @@ -165,9 +165,9 @@ getCompletionsLSP ide plId ---------------------------------------------------------------------------------------------------- -toModueNameText :: Development.IDE.Types.KnownTargets.Target -> T.Text +toModueNameText :: KT.Target -> T.Text toModueNameText target = case target of - Development.IDE.Types.KnownTargets.TargetModule m -> T.pack $ moduleNameString m + KT.TargetModule m -> T.pack $ moduleNameString m _ -> T.empty extendImportCommand :: PluginCommand IdeState