Trigger extending import only when the item is not in scope (#1309)

* Trigger extending import only when it's not in scope

* Extract GlobalRdrElts before getting into the producer

* Fix macros

* Compare only elements' name

* Rollback due to performance

ghcide/src/Development/IDE/Plugin/Completions.hs

@@ -35,6 +35,7 @@ import Ide.Plugin.Config (Config (completionSnippetsOn))
 import Ide.PluginUtils (getClientConfig)
 import Ide.Types
 import TcRnDriver (tcRnImportDecls)
+import Control.Concurrent.Async (concurrently)
 #if defined(GHC_LIB)
 import Development.IDE.Import.DependencyInformation
 #endif
@@ -76,11 +77,11 @@ produceCompletions = do
             (Just (ms,imps), Just sess) -> do
               let env = hscEnv sess
               -- We do this to be able to provide completions of items that are not restricted to the explicit list
-              res <- liftIO $ tcRnImportDecls env (dropListFromImportDecl <$> imps)
-              case res of
-                  (_, Just rdrEnv) -> do
+              (global, inScope) <- liftIO $ tcRnImportDecls env (dropListFromImportDecl <$> imps) `concurrently` tcRnImportDecls env imps
+              case (global, inScope) of
+                  ((_, Just globalEnv), (_, Just inScopeEnv)) -> do
                       let uri = fromNormalizedUri $ normalizedFilePathToUri file
-                      cdata <- liftIO $ cacheDataProducer uri env (ms_mod ms) rdrEnv imps parsedDeps
+                      cdata <- liftIO $ cacheDataProducer uri env (ms_mod ms) globalEnv inScopeEnv imps parsedDeps
                       return ([], Just cdata)
                   (_diag, _) ->
                       return ([], Nothing)

ghcide/src/Development/IDE/Plugin/Completions/Logic.hs

@@ -293,8 +293,9 @@ mkPragmaCompl label insertText =
     Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just Snippet)
     Nothing Nothing Nothing Nothing Nothing
 
-cacheDataProducer :: Uri -> HscEnv -> Module -> GlobalRdrEnv -> [LImportDecl GhcPs] -> [ParsedModule] -> IO CachedCompletions
-cacheDataProducer uri packageState curMod rdrEnv limports deps = do
+
+cacheDataProducer :: Uri -> HscEnv -> Module -> GlobalRdrEnv-> GlobalRdrEnv -> [LImportDecl GhcPs] -> [ParsedModule] -> IO CachedCompletions
+cacheDataProducer uri packageState curMod globalEnv inScopeEnv limports deps = do
   let dflags = hsc_dflags packageState
       curModName = moduleName curMod
 
@@ -314,7 +315,7 @@ cacheDataProducer uri packageState curMod rdrEnv limports deps = do
       -- The given namespaces for the imported modules (ie. full name, or alias if used)
       allModNamesAsNS = map (showModName . asNamespace) importDeclerations
 
-      rdrElts = globalRdrEnvElts rdrEnv
+      rdrElts = globalRdrEnvElts globalEnv
 
       foldMapM :: (Foldable f, Monad m, Monoid b) => (a -> m b) -> f a -> m b
       foldMapM f xs = foldr step return xs mempty where
@@ -328,7 +329,8 @@ cacheDataProducer uri packageState curMod rdrEnv limports deps = do
           (, mempty) <$> toCompItem par curMod curModName n Nothing
       getComplsForOne (GRE n par False prov) =
         flip foldMapM (map is_decl prov) $ \spec -> do
-          let originalImportDecl = Map.lookup (is_dloc spec) importMap
+          -- we don't want to extend import if it's already in scope
+          let originalImportDecl = if null $ lookupGRE_Name inScopeEnv n then Map.lookup (is_dloc spec) importMap else Nothing
           compItem <- toCompItem par curMod (is_mod spec) n originalImportDecl
           let unqual
                 | is_qual spec = []
@@ -371,7 +373,6 @@ cacheDataProducer uri packageState curMod rdrEnv limports deps = do
     , importableModules = moduleNames
     }
 
-
 -- | Produces completions from the top level declarations of a module.
 localCompletionsForParsedModule :: Uri -> ParsedModule -> CachedCompletions
 localCompletionsForParsedModule uri pm@ParsedModule{pm_parsed_source = L _ HsModule{hsmodDecls, hsmodName}} =

ghcide/test/exe/Main.hs

@@ -3454,6 +3454,26 @@ completionCommandTest name src pos wanted expected = testSession name $ do
             expectMessages @ApplyWorkspaceEditRequest 1 $ \edit ->
               liftIO $ assertFailure $ "Expected no edit but got: " <> show edit
 
+completionNoCommandTest ::
+  String ->
+  [T.Text] ->
+  Position ->
+  T.Text ->
+  TestTree
+completionNoCommandTest name src pos wanted = testSession name $ do
+  docId <- createDoc "A.hs" "haskell" (T.unlines src)
+  _ <- waitForDiagnostics
+  compls <- getCompletions docId pos
+  let wantedC = find ( \case
+            CompletionItem {_insertText = Just x} -> wanted `T.isPrefixOf` x
+            _ -> False
+            ) compls
+  case wantedC of
+    Nothing ->
+      liftIO $ assertFailure $ "Cannot find expected completion in: " <> show [_label | CompletionItem {_label} <- compls]
+    Just CompletionItem{..} -> liftIO . assertBool ("Expected no command but got: " <> show _command) $ null _command
+
+
 topLevelCompletionTests :: [TestTree]
 topLevelCompletionTests = [
     completionTest
@@ -3674,18 +3694,21 @@ nonLocalCompletionTests =
             (Position 2 4)
             "ZeroPad"
             ["module A where", "import Text.Printf (FormatAdjustment (ZeroPad))", "ZeroPad"]
-        , completionCommandTest
+        , completionNoCommandTest
             "parent imported all"
             ["module A where", "import Text.Printf (FormatAdjustment (..))", "ZeroPad"]
             (Position 2 4)
             "ZeroPad"
-            ["module A where", "import Text.Printf (FormatAdjustment (..))", "ZeroPad"]
-        , completionCommandTest
+        , completionNoCommandTest
             "already imported"
             ["module A where", "import Text.Printf (FormatAdjustment (ZeroPad))", "ZeroPad"]
             (Position 2 4)
-            "ZeroPad"
-            ["module A where", "import Text.Printf (FormatAdjustment (ZeroPad))", "ZeroPad"]
+            "ZeroPad"        
+        , completionNoCommandTest
+            "function from Prelude"
+            ["module A where", "import Data.Maybe ()", "Nothing"]
+            (Position 2 4)
+            "Nothing"
         ]
       , testGroup "Record completion"
         [ completionCommandTest
@@ -3700,12 +3723,11 @@ nonLocalCompletionTests =
             (Position 2 10)
             "FormatParse {"
             ["module A where", "import Text.Printf (FormatParse (FormatParse))", "FormatParse"]
-        , completionCommandTest
+        , completionNoCommandTest
             "already imported"
             ["module A where", "import Text.Printf (FormatParse (FormatParse))", "FormatParse"]
             (Position 2 10)
             "FormatParse {"
-            ["module A where", "import Text.Printf (FormatParse (FormatParse))", "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