diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 6aac585135..9b1b203262 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/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 = diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 99c0b7c7a2..d3a896a785 100644 --- a/ghcide/test/exe/Main.hs +++ b/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 \ No newline at end of file +maxBoundUinteger = 2147483647