Completions for project identifiers

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

@@ -9,6 +9,7 @@ module Development.IDE.Plugin.Completions
     ) where
 
 import           Control.Concurrent.Async                     (concurrently)
+import           Control.Concurrent.Extra
 import           Control.Monad.Extra
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Maybe
@@ -30,7 +31,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.Import.FindImports           
+import           Development.IDE.Import.FindImports
 import           Development.IDE.Plugin.CodeAction            (newImport,
                                                                newImportToEdit)
 import           Development.IDE.Plugin.CodeAction.ExactPrint
@@ -138,15 +139,19 @@ getCompletionsLSP ide plId
             nonLocalCompls <- useWithStaleFast NonLocalCompletions npath
             pm <- useWithStaleFast GetParsedModule npath
             binds <- fromMaybe (mempty, zeroMapping) <$> useWithStaleFast GetBindings npath
-            exportsMapIO <- fmap(envPackageExports . fst) <$> useWithStaleFast GhcSession npath
-            exportsMap <- mapM liftIO exportsMapIO
-            locatedImports <- fromMaybe (mempty, zeroMapping) <$> useWithStaleFast GetLocatedImports npath
-            localModuleExports <- liftIO $ buildLocalModuleExports ide locatedImports
-            let moduleExports = maybe Map.empty getModuleExportsMap exportsMap
-                exportsCompItems = foldMap (map (fromIdentInfo uri) . Set.toList) . Map.elems . getExportsMap <$> exportsMap
-                exportsCompls = mempty{anyQualCompls = fromMaybe [] exportsCompItems}
+
+            -- set up the exports map including both package and project-level identifiers
+            packageExportsMapIO <- fmap(envPackageExports . fst) <$> useWithStaleFast GhcSession npath
+            packageExportsMap <- mapM liftIO packageExportsMapIO
+            projectExportsMap <- liftIO $ readVar (exportsMap $ shakeExtras ide)
+            let exportsMap = fromMaybe mempty packageExportsMap <> projectExportsMap
+
+            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
-            pure (opts, fmap (,pm,binds) compls, Map.unionWith (<>) localModuleExports moduleExports)
+
+            pure (opts, fmap (,pm,binds) compls, moduleExports)
         case compls of
           Just (cci', parsedMod, bindMap) -> do
             pfix <- VFS.getCompletionPrefix position cnts
@@ -163,14 +168,6 @@ getCompletionsLSP ide plId
       _ -> return (InL $ List [])
 
 ----------------------------------------------------------------------------------------------------
-
-buildLocalModuleExports:: IdeState -> ([(Located ModuleName, Maybe ArtifactsLocation)], PositionMapping) -> IO (Map.HashMap T.Text (Set.HashSet IdentInfo))
-buildLocalModuleExports ide inMap = do
-  let artifactLoctions = mapMaybe snd (fst inMap)
-  let afp = map artifactFilePath artifactLoctions
-  let queries = map (useWithStaleFast GetModIface) afp
-  files <- liftIO $ mapM (runIdeAction "Completion" (shakeExtras ide)) queries
-  pure (buildModuleExportMapFrom $ map (hirModIface . fst) $ catMaybes files)
 
 extendImportCommand :: PluginCommand IdeState
 extendImportCommand =

ghcide/test/exe/Main.hs

@@ -4058,7 +4058,8 @@ completionTests
     [ testGroup "non local" nonLocalCompletionTests
     , testGroup "topLevel" topLevelCompletionTests
     , testGroup "local" localCompletionTests
-    , testGroup "global" globalCompletionTests
+    , testGroup "package" packageCompletionTests
+    , testGroup "project" projectCompletionTests
     , testGroup "other" otherCompletionTests
     ]
 
@@ -4467,8 +4468,8 @@ otherCompletionTests = [
         liftIO $ length compls @?= maxCompletions def
   ]
 
-globalCompletionTests :: [TestTree]
-globalCompletionTests =
+packageCompletionTests :: [TestTree]
+packageCompletionTests =
   [ testSessionWait "fromList" $ do
         doc <- createDoc "A.hs" "haskell" $ T.unlines
             [ "{-# OPTIONS_GHC -Wunused-binds #-}",
@@ -4566,6 +4567,31 @@ globalCompletionTests =
     ]
   ]
 
+projectCompletionTests :: [TestTree]
+projectCompletionTests =
+    [ testSession' "from hiedb" $ \dir-> do
+        liftIO $ writeFile (dir </> "hie.yaml")
+            "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}"
+        _ <- createDoc "A.hs" "haskell" $ T.unlines
+            [  "module A (anidentifier) where",
+               "anidentifier = ()"
+            ]
+        _ <- waitForDiagnostics
+        -- Note that B does not import A
+        doc <- createDoc "B.hs" "haskell" $ T.unlines
+            [ "module B where",
+              "b = anidenti"
+            ]
+        compls <- getCompletions doc (Position 1 10)
+        let compls' =
+              [T.drop 1 $ T.dropEnd 10 d
+              | CompletionItem {_documentation = Just (CompletionDocMarkup (MarkupContent MkMarkdown d)), _label}
+                <- compls
+              , _label == "anidentifier"
+              ]
+        liftIO $ compls' @?= ["Defined in 'A"]
+    ]
+
 highlightTests :: TestTree
 highlightTests = testGroup "highlight"
   [ testSessionWait "value" $ do
@@ -5995,4 +6021,4 @@ thDollarIdx | ghcVersion >= GHC90 = 1
 -- | We don't have a uinteger type yet. So hardcode the maxBound of uinteger, 2 ^ 31 - 1
 -- as a constant.
 maxBoundUinteger :: Int
-maxBoundUinteger = 2147483647
+maxBoundUinteger = 2147483647