diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 5d6607a5da..37bfa9dc6a 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -109,8 +109,7 @@ import Development.IDE.Core.PositionMapping import Development.IDE.Core.ProgressReporting import Development.IDE.Core.RuleTypes import Development.IDE.Core.Tracing -import Development.IDE.GHC.Compat (NameCacheUpdater (..), - upNameCache) +import Development.IDE.GHC.Compat (NameCacheUpdater (..), upNameCache) import Development.IDE.GHC.Orphans () import Development.IDE.Graph hiding (ShakeValue) import qualified Development.IDE.Graph as Shake diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index e3753cb844..6aac585135 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.Import.FindImports import Development.IDE.Plugin.CodeAction (newImport, newImportToEdit) import Development.IDE.Plugin.CodeAction.ExactPrint @@ -131,7 +132,7 @@ getCompletionsLSP ide plId fmap Right $ case (contents, uriToFilePath' uri) of (Just cnts, Just path) -> do let npath = toNormalizedFilePath' path - (ideOpts, compls) <- 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 @@ -139,10 +140,13 @@ getCompletionsLSP ide plId binds <- fromMaybe (mempty, zeroMapping) <$> useWithStaleFast GetBindings npath exportsMapIO <- fmap(envPackageExports . fst) <$> useWithStaleFast GhcSession npath exportsMap <- mapM liftIO exportsMapIO - let exportsCompItems = foldMap (map (fromIdentInfo uri) . Set.toList) . Map.elems . getExportsMap <$> exportsMap + 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} let compls = (fst <$> localCompls) <> (fst <$> nonLocalCompls) <> Just exportsCompls - pure (opts, fmap (,pm,binds) compls) + pure (opts, fmap (,pm,binds) compls, Map.unionWith (<>) localModuleExports moduleExports) case compls of Just (cci', parsedMod, bindMap) -> do pfix <- VFS.getCompletionPrefix position cnts @@ -152,13 +156,21 @@ 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 + allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps config moduleExports pure $ InL (List allCompletions) _ -> return (InL $ List []) _ -> return (InL $ List []) _ -> 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/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index cacd881954..c3f1de1a4a 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -41,7 +41,9 @@ import Control.Monad import Data.Aeson (ToJSON (toJSON)) import Data.Either (fromRight) import Data.Functor +import qualified Data.HashMap.Strict as HM import qualified Data.Set as Set +import qualified Data.HashSet as HashSet import Development.IDE.Core.Compile import Development.IDE.Core.PositionMapping import Development.IDE.GHC.Compat as GHC @@ -285,6 +287,12 @@ mkModCompl label = Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing +mkModuleFunctionImport :: T.Text -> T.Text -> CompletionItem +mkModuleFunctionImport moduleName label = + CompletionItem label (Just CiFunction) Nothing (Just moduleName) + Nothing Nothing Nothing Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing Nothing Nothing + mkImportCompl :: T.Text -> T.Text -> CompletionItem mkImportCompl enteredQual label = CompletionItem m (Just CiModule) Nothing (Just label) @@ -525,9 +533,10 @@ getCompletions -> VFS.PosPrefixInfo -> ClientCapabilities -> CompletionsConfig + -> HM.HashMap T.Text (HashSet.HashSet IdentInfo) -> IO [CompletionItem] getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qualCompls, importableModules} - maybe_parsed (localBindings, bmapping) prefixInfo caps config = 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 @@ -596,12 +605,21 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu ] 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 + && (List.length (words (T.unpack fullLine)) >= 2) + && "(" `isInfixOf` T.unpack fullLine + -> do + let moduleName = T.pack $ words (T.unpack fullLine) !! 1 + funcs = HM.lookupDefault HashSet.empty moduleName moduleExportsMap + funs = map (show . name) $ HashSet.toList funcs + return $ filterModuleExports moduleName $ map T.pack funs | "import " `T.isPrefixOf` fullLine -> return filtImportCompls -- we leave this condition here to avoid duplications and return empty list diff --git a/ghcide/src/Development/IDE/Types/Exports.hs b/ghcide/src/Development/IDE/Types/Exports.hs index 36594d2b56..58603efb1b 100644 --- a/ghcide/src/Development/IDE/Types/Exports.hs +++ b/ghcide/src/Development/IDE/Types/Exports.hs @@ -6,7 +6,8 @@ module Development.IDE.Types.Exports ExportsMap(..), createExportsMap, createExportsMapMg, - createExportsMapTc + createExportsMapTc, + buildModuleExportMapFrom ,createExportsMapHieDb,size) where import Avail (AvailInfo (..)) @@ -30,17 +31,24 @@ import HieDb import Name import TcRnTypes (TcGblEnv (..)) -newtype ExportsMap = ExportsMap - {getExportsMap :: HashMap IdentifierText (HashSet IdentInfo)} - deriving newtype (Monoid, NFData, Show) + +data ExportsMap = ExportsMap + {getExportsMap :: HashMap IdentifierText (HashSet IdentInfo) + , getModuleExportsMap :: Map.HashMap ModuleNameText (HashSet IdentInfo) + } + deriving (Show) size :: ExportsMap -> Int size = sum . map length . elems . getExportsMap instance Semigroup ExportsMap where - ExportsMap a <> ExportsMap b = ExportsMap $ Map.unionWith (<>) a b + ExportsMap a b <> ExportsMap c d = ExportsMap (Map.unionWith (<>) a c) (Map.unionWith (<>) b d) + +instance Monoid ExportsMap where + mempty = ExportsMap Map.empty Map.empty type IdentifierText = Text +type ModuleNameText = Text data IdentInfo = IdentInfo { name :: !OccName @@ -91,25 +99,34 @@ mkIdentInfos mod (AvailTC _ nn flds) ] createExportsMap :: [ModIface] -> ExportsMap -createExportsMap = ExportsMap . Map.fromListWith (<>) . concatMap doOne +createExportsMap modIface = do + let exportList = concatMap doOne modIface + let exportsMap = Map.fromListWith (<>) $ map (\(a,_,c) -> (a, c)) exportList + ExportsMap exportsMap $ buildModuleExportMap $ map (\(_,b,c) -> (b, c)) exportList where - doOne mi = concatMap (fmap (second Set.fromList) . unpackAvail mn) (mi_exports mi) - where - mn = moduleName $ mi_module mi + doOne modIFace = do + let getModDetails = unpackAvail $ moduleName $ mi_module modIFace + concatMap (fmap (second Set.fromList) . getModDetails) (mi_exports modIFace) createExportsMapMg :: [ModGuts] -> ExportsMap -createExportsMapMg = ExportsMap . Map.fromListWith (<>) . concatMap doOne +createExportsMapMg modGuts = do + let exportList = concatMap doOne modGuts + let exportsMap = Map.fromListWith (<>) $ map (\(a,_,c) -> (a, c)) exportList + ExportsMap exportsMap $ buildModuleExportMap $ map (\(_,b,c) -> (b, c)) exportList where - doOne mi = concatMap (fmap (second Set.fromList) . unpackAvail mn) (mg_exports mi) - where - mn = moduleName $ mg_module mi + doOne mi = do + let getModuleName = moduleName $ mg_module mi + concatMap (fmap (second Set.fromList) . unpackAvail getModuleName) (mg_exports mi) createExportsMapTc :: [TcGblEnv] -> ExportsMap -createExportsMapTc = ExportsMap . Map.fromListWith (<>) . concatMap doOne +createExportsMapTc modIface = do + let exportList = concatMap doOne modIface + let exportsMap = Map.fromListWith (<>) $ map (\(a,_,c) -> (a, c)) exportList + ExportsMap exportsMap $ buildModuleExportMap $ map (\(_,b,c) -> (b, c)) exportList where - doOne mi = concatMap (fmap (second Set.fromList) . unpackAvail mn) (tcg_exports mi) - where - mn = moduleName $ tcg_mod mi + doOne mi = do + let getModuleName = moduleName $ tcg_mod mi + concatMap (fmap (second Set.fromList) . unpackAvail getModuleName) (tcg_exports mi) nonInternalModules :: ModuleName -> Bool nonInternalModules = not . (".Internal" `isSuffixOf`) . moduleNameString @@ -121,7 +138,8 @@ createExportsMapHieDb hiedb = do let mn = modInfoName $ hieModInfo m mText = pack $ moduleNameString mn fmap (wrap . unwrap mText) <$> getExportsForModule hiedb mn - return $ ExportsMap $ Map.fromListWith (<>) (concat idents) + let exportsMap = Map.fromListWith (<>) (concat idents) + return $ ExportsMap exportsMap $ buildModuleExportMap (concat idents) where wrap identInfo = (rendered identInfo, Set.fromList [identInfo]) -- unwrap :: ExportRow -> IdentInfo @@ -130,10 +148,35 @@ createExportsMapHieDb hiedb = do n = pack (occNameString exportName) p = pack . occNameString <$> exportParent -unpackAvail :: ModuleName -> IfaceExport -> [(Text, [IdentInfo])] +unpackAvail :: ModuleName -> IfaceExport -> [(Text, Text, [IdentInfo])] unpackAvail mn | nonInternalModules mn = map f . mkIdentInfos mod | otherwise = const [] where !mod = pack $ moduleNameString mn - f id@IdentInfo {..} = (pack (prettyPrint name), [id]) + f id@IdentInfo {..} = (pack (prettyPrint name), moduleNameText,[id]) + + +identInfoToKeyVal :: IdentInfo -> (ModuleNameText, IdentInfo) +identInfoToKeyVal identInfo = + (moduleNameText identInfo, identInfo) + +buildModuleExportMap:: [(Text, HashSet IdentInfo)] -> Map.HashMap ModuleNameText (HashSet IdentInfo) +buildModuleExportMap exportsMap = do + let lst = concatMap (Set.toList. snd) exportsMap + let lstThree = map identInfoToKeyVal lst + sortAndGroup lstThree + +buildModuleExportMapFrom:: [ModIface] -> Map.HashMap Text (HashSet IdentInfo) +buildModuleExportMapFrom modIfaces = do + let exports = map extractModuleExports modIfaces + Map.fromListWith (<>) exports + +extractModuleExports :: ModIface -> (Text, HashSet IdentInfo) +extractModuleExports modIFace = do + let modName = pack $ moduleNameString $ moduleName $ mi_module modIFace + let functionSet = Set.fromList $ concatMap (mkIdentInfos modName) $ mi_exports modIFace + (modName, functionSet) + +sortAndGroup :: [(ModuleNameText, IdentInfo)] -> Map.HashMap ModuleNameText (HashSet IdentInfo) +sortAndGroup assocs = Map.fromListWith (<>) [(k, Set.fromList [v]) | (k, v) <- assocs] diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index 2585a1e00d..94faa05f1e 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -121,6 +121,31 @@ tests = testGroup "completions" [ compls <- getCompletions doc (Position 5 7) liftIO $ length compls @?= maxCompletions def + , testCase "import function completions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "FunctionCompletions.hs" "haskell" + + let te = TextEdit (Range (Position 0 30) (Position 0 41)) "A" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 0 31) + let item = head $ filter ((== "Alternative") . (^. label)) compls + liftIO $ do + item ^. label @?= "Alternative" + item ^. kind @?= Just CiFunction + item ^. detail @?= Just "Control.Applicative" + + , testCase "import second function completion" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "FunctionCompletions.hs" "haskell" + + let te = TextEdit (Range (Position 0 41) (Position 0 42)) ", l" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 0 41) + let item = head $ filter ((== "liftA") . (^. label)) compls + liftIO $ do + item ^. label @?= "liftA" + item ^. kind @?= Just CiFunction + item ^. detail @?= Just "Control.Applicative" , contextTests , snippetTests ] diff --git a/test/testdata/completion/FunctionCompletions.hs b/test/testdata/completion/FunctionCompletions.hs new file mode 100644 index 0000000000..eeda925498 --- /dev/null +++ b/test/testdata/completion/FunctionCompletions.hs @@ -0,0 +1,8 @@ +import Control.Applicative (Alternative) +import qualified Data.List + +main :: IO () +main = putStrLn "hello" + +foo :: Either a b -> Either a b +foo = id