Skip to content

Commit 1daecd4

Browse files
alexnaspojneiraalexnaspoleappepeiborramergify[bot]
authored
Auto complete definitions within imports (#2152)
* auto complete functions from imports * address PR comments * clean up * remove duplicate HashMap import * use lookupDefault * fuzzy match filter * add field to exportsMap * generate map from modIFace * Update ghcide/src/Development/IDE/Types/Exports.hs Co-authored-by: Pepe Iborra <pepeiborra@me.com> * module name text alias * use hashset; enable local modules * local module imports now working * derive map from exportMap * generate maps from list * clean up * addressing PR comments * clean up * clean up * useWithStaleFast Co-authored-by: Javier Neira <atreyu.bbb@gmail.com> Co-authored-by: alexnaspoleap <88672779+alexnaspoleap@users.noreply.github.com> Co-authored-by: Alex Naspo <alex.naspo@leapyear.io> Co-authored-by: Pepe Iborra <pepeiborra@me.com> Co-authored-by: Pepe Iborra <pepeiborra@gmail.com> Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>
1 parent 12e7742 commit 1daecd4

File tree

6 files changed

+133
-28
lines changed

6 files changed

+133
-28
lines changed

‎ghcide/src/Development/IDE/Core/Shake.hs‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -109,8 +109,7 @@ import Development.IDE.Core.PositionMapping
109109
import Development.IDE.Core.ProgressReporting
110110
import Development.IDE.Core.RuleTypes
111111
import Development.IDE.Core.Tracing
112-
import Development.IDE.GHC.Compat (NameCacheUpdater (..),
113-
upNameCache)
112+
import Development.IDE.GHC.Compat (NameCacheUpdater (..), upNameCache)
114113
import Development.IDE.GHC.Orphans ()
115114
import Development.IDE.Graph hiding (ShakeValue)
116115
import qualified Development.IDE.Graph as Shake

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

Lines changed: 16 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,7 @@ import Development.IDE.GHC.ExactPrint (Annotated (annsA)
3030
import Development.IDE.GHC.Util (prettyPrint)
3131
import Development.IDE.Graph
3232
import Development.IDE.Graph.Classes
33+
import Development.IDE.Import.FindImports
3334
import Development.IDE.Plugin.CodeAction (newImport,
3435
newImportToEdit)
3536
import Development.IDE.Plugin.CodeAction.ExactPrint
@@ -131,18 +132,21 @@ getCompletionsLSP ide plId
131132
fmap Right $ case (contents, uriToFilePath' uri) of
132133
(Just cnts, Just path) -> do
133134
let npath = toNormalizedFilePath' path
134-
(ideOpts, compls) <- liftIO $ runIdeAction "Completion" (shakeExtras ide) $ do
135+
(ideOpts, compls, moduleExports) <- liftIO $ runIdeAction "Completion" (shakeExtras ide) $ do
135136
opts <- liftIO $ getIdeOptionsIO $ shakeExtras ide
136137
localCompls <- useWithStaleFast LocalCompletions npath
137138
nonLocalCompls <- useWithStaleFast NonLocalCompletions npath
138139
pm <- useWithStaleFast GetParsedModule npath
139140
binds <- fromMaybe (mempty, zeroMapping) <$> useWithStaleFast GetBindings npath
140141
exportsMapIO <- fmap(envPackageExports . fst) <$> useWithStaleFast GhcSession npath
141142
exportsMap <- mapM liftIO exportsMapIO
142-
let exportsCompItems = foldMap (map (fromIdentInfo uri) . Set.toList) . Map.elems . getExportsMap <$> exportsMap
143+
locatedImports <- fromMaybe (mempty, zeroMapping) <$> useWithStaleFast GetLocatedImports npath
144+
localModuleExports <- liftIO $ buildLocalModuleExports ide locatedImports
145+
let moduleExports = maybe Map.empty getModuleExportsMap exportsMap
146+
exportsCompItems = foldMap (map (fromIdentInfo uri) . Set.toList) . Map.elems . getExportsMap <$> exportsMap
143147
exportsCompls = mempty{anyQualCompls = fromMaybe [] exportsCompItems}
144148
let compls = (fst <$> localCompls) <> (fst <$> nonLocalCompls) <> Just exportsCompls
145-
pure (opts, fmap (,pm,binds) compls)
149+
pure (opts, fmap (,pm,binds) compls, Map.unionWith (<>) localModuleExports moduleExports)
146150
case compls of
147151
Just (cci', parsedMod, bindMap) -> do
148152
pfix <- VFS.getCompletionPrefix position cnts
@@ -152,13 +156,21 @@ getCompletionsLSP ide plId
152156
(Just pfix', _) -> do
153157
let clientCaps = clientCapabilities $ shakeExtras ide
154158
config <- getCompletionsConfig plId
155-
allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps config
159+
allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps config moduleExports
156160
pure $ InL (List allCompletions)
157161
_ -> return (InL $ List [])
158162
_ -> return (InL $ List [])
159163
_ -> return (InL $ List [])
160164

161165
----------------------------------------------------------------------------------------------------
166+
167+
buildLocalModuleExports:: IdeState -> ([(Located ModuleName, Maybe ArtifactsLocation)], PositionMapping) -> IO (Map.HashMap T.Text (Set.HashSet IdentInfo))
168+
buildLocalModuleExports ide inMap = do
169+
let artifactLoctions = mapMaybe snd (fst inMap)
170+
let afp = map artifactFilePath artifactLoctions
171+
let queries = map (useWithStaleFast GetModIface) afp
172+
files <- liftIO $ mapM (runIdeAction "Completion" (shakeExtras ide)) queries
173+
pure (buildModuleExportMapFrom $ map (hirModIface . fst) $ catMaybes files)
162174

163175
extendImportCommand :: PluginCommand IdeState
164176
extendImportCommand =

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

Lines changed: 20 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -41,7 +41,9 @@ import Control.Monad
4141
import Data.Aeson (ToJSON (toJSON))
4242
import Data.Either (fromRight)
4343
import Data.Functor
44+
import qualified Data.HashMap.Strict as HM
4445
import qualified Data.Set as Set
46+
import qualified Data.HashSet as HashSet
4547
import Development.IDE.Core.Compile
4648
import Development.IDE.Core.PositionMapping
4749
import Development.IDE.GHC.Compat as GHC
@@ -285,6 +287,12 @@ mkModCompl label =
285287
Nothing Nothing Nothing Nothing Nothing Nothing Nothing
286288
Nothing Nothing Nothing Nothing Nothing Nothing
287289

290+
mkModuleFunctionImport :: T.Text -> T.Text -> CompletionItem
291+
mkModuleFunctionImport moduleName label =
292+
CompletionItem label (Just CiFunction) Nothing (Just moduleName)
293+
Nothing Nothing Nothing Nothing Nothing Nothing Nothing
294+
Nothing Nothing Nothing Nothing Nothing Nothing
295+
288296
mkImportCompl :: T.Text -> T.Text -> CompletionItem
289297
mkImportCompl enteredQual label =
290298
CompletionItem m (Just CiModule) Nothing (Just label)
@@ -525,9 +533,10 @@ getCompletions
525533
-> VFS.PosPrefixInfo
526534
-> ClientCapabilities
527535
-> CompletionsConfig
536+
-> HM.HashMap T.Text (HashSet.HashSet IdentInfo)
528537
-> IO [CompletionItem]
529538
getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qualCompls, importableModules}
530-
maybe_parsed (localBindings, bmapping) prefixInfo caps config = do
539+
maybe_parsed (localBindings, bmapping) prefixInfo caps config moduleExportsMap = do
531540
let VFS.PosPrefixInfo { fullLine, prefixModule, prefixText } = prefixInfo
532541
enteredQual = if T.null prefixModule then "" else prefixModule <> "."
533542
fullPrefix = enteredQual <> prefixText
@@ -596,12 +605,21 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu
596605
]
597606

598607
filtImportCompls = filtListWith (mkImportCompl enteredQual) importableModules
608+
filterModuleExports moduleName = filtListWith $ mkModuleFunctionImport moduleName
599609
filtKeywordCompls
600610
| T.null prefixModule = filtListWith mkExtCompl (optKeywords ideOpts)
601611
| otherwise = []
602612

603-
604613
if
614+
-- TODO: handle multiline imports
615+
| "import " `T.isPrefixOf` fullLine
616+
&& (List.length (words (T.unpack fullLine)) >= 2)
617+
&& "(" `isInfixOf` T.unpack fullLine
618+
-> do
619+
let moduleName = T.pack $ words (T.unpack fullLine) !! 1
620+
funcs = HM.lookupDefault HashSet.empty moduleName moduleExportsMap
621+
funs = map (show . name) $ HashSet.toList funcs
622+
return $ filterModuleExports moduleName $ map T.pack funs
605623
| "import " `T.isPrefixOf` fullLine
606624
-> return filtImportCompls
607625
-- we leave this condition here to avoid duplications and return empty list

‎ghcide/src/Development/IDE/Types/Exports.hs‎

Lines changed: 63 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,8 @@ module Development.IDE.Types.Exports
66
ExportsMap(..),
77
createExportsMap,
88
createExportsMapMg,
9-
createExportsMapTc
9+
createExportsMapTc,
10+
buildModuleExportMapFrom
1011
,createExportsMapHieDb,size) where
1112

1213
import Avail (AvailInfo (..))
@@ -30,17 +31,24 @@ import HieDb
3031
import Name
3132
import TcRnTypes (TcGblEnv (..))
3233

33-
newtype ExportsMap = ExportsMap
34-
{getExportsMap :: HashMap IdentifierText (HashSet IdentInfo)}
35-
deriving newtype (Monoid, NFData, Show)
34+
35+
data ExportsMap = ExportsMap
36+
{getExportsMap :: HashMap IdentifierText (HashSet IdentInfo)
37+
, getModuleExportsMap :: Map.HashMap ModuleNameText (HashSet IdentInfo)
38+
}
39+
deriving (Show)
3640

3741
size :: ExportsMap -> Int
3842
size = sum . map length . elems . getExportsMap
3943

4044
instance Semigroup ExportsMap where
41-
ExportsMap a <> ExportsMap b = ExportsMap $ Map.unionWith (<>) a b
45+
ExportsMap a b <> ExportsMap c d = ExportsMap (Map.unionWith (<>) a c) (Map.unionWith (<>) b d)
46+
47+
instance Monoid ExportsMap where
48+
mempty = ExportsMap Map.empty Map.empty
4249

4350
type IdentifierText = Text
51+
type ModuleNameText = Text
4452

4553
data IdentInfo = IdentInfo
4654
{ name :: !OccName
@@ -91,25 +99,34 @@ mkIdentInfos mod (AvailTC _ nn flds)
9199
]
92100

93101
createExportsMap :: [ModIface] -> ExportsMap
94-
createExportsMap = ExportsMap . Map.fromListWith (<>) . concatMap doOne
102+
createExportsMap modIface = do
103+
let exportList = concatMap doOne modIface
104+
let exportsMap = Map.fromListWith (<>) $ map (\(a,_,c) -> (a, c)) exportList
105+
ExportsMap exportsMap $ buildModuleExportMap $ map (\(_,b,c) -> (b, c)) exportList
95106
where
96-
doOne mi = concatMap (fmap (second Set.fromList) . unpackAvail mn) (mi_exports mi)
97-
where
98-
mn = moduleName $ mi_module mi
107+
doOne modIFace = do
108+
let getModDetails = unpackAvail $ moduleName $ mi_module modIFace
109+
concatMap (fmap (second Set.fromList) . getModDetails) (mi_exports modIFace)
99110

100111
createExportsMapMg :: [ModGuts] -> ExportsMap
101-
createExportsMapMg = ExportsMap . Map.fromListWith (<>) . concatMap doOne
112+
createExportsMapMg modGuts = do
113+
let exportList = concatMap doOne modGuts
114+
let exportsMap = Map.fromListWith (<>) $ map (\(a,_,c) -> (a, c)) exportList
115+
ExportsMap exportsMap $ buildModuleExportMap $ map (\(_,b,c) -> (b, c)) exportList
102116
where
103-
doOne mi = concatMap (fmap (second Set.fromList) . unpackAvail mn) (mg_exports mi)
104-
where
105-
mn = moduleName $ mg_module mi
117+
doOne mi = do
118+
let getModuleName = moduleName $ mg_module mi
119+
concatMap (fmap (second Set.fromList) . unpackAvail getModuleName) (mg_exports mi)
106120

107121
createExportsMapTc :: [TcGblEnv] -> ExportsMap
108-
createExportsMapTc = ExportsMap . Map.fromListWith (<>) . concatMap doOne
122+
createExportsMapTc modIface = do
123+
let exportList = concatMap doOne modIface
124+
let exportsMap = Map.fromListWith (<>) $ map (\(a,_,c) -> (a, c)) exportList
125+
ExportsMap exportsMap $ buildModuleExportMap $ map (\(_,b,c) -> (b, c)) exportList
109126
where
110-
doOne mi = concatMap (fmap (second Set.fromList) . unpackAvail mn) (tcg_exports mi)
111-
where
112-
mn = moduleName $ tcg_mod mi
127+
doOne mi = do
128+
let getModuleName = moduleName $ tcg_mod mi
129+
concatMap (fmap (second Set.fromList) . unpackAvail getModuleName) (tcg_exports mi)
113130

114131
nonInternalModules :: ModuleName -> Bool
115132
nonInternalModules = not . (".Internal" `isSuffixOf`) . moduleNameString
@@ -121,7 +138,8 @@ createExportsMapHieDb hiedb = do
121138
let mn = modInfoName $ hieModInfo m
122139
mText = pack $ moduleNameString mn
123140
fmap (wrap . unwrap mText) <$> getExportsForModule hiedb mn
124-
return $ ExportsMap $ Map.fromListWith (<>) (concat idents)
141+
let exportsMap = Map.fromListWith (<>) (concat idents)
142+
return $ ExportsMap exportsMap $ buildModuleExportMap (concat idents)
125143
where
126144
wrap identInfo = (rendered identInfo, Set.fromList [identInfo])
127145
-- unwrap :: ExportRow -> IdentInfo
@@ -130,10 +148,35 @@ createExportsMapHieDb hiedb = do
130148
n = pack (occNameString exportName)
131149
p = pack . occNameString <$> exportParent
132150

133-
unpackAvail :: ModuleName -> IfaceExport -> [(Text, [IdentInfo])]
151+
unpackAvail :: ModuleName -> IfaceExport -> [(Text, Text, [IdentInfo])]
134152
unpackAvail mn
135153
| nonInternalModules mn = map f . mkIdentInfos mod
136154
| otherwise = const []
137155
where
138156
!mod = pack $ moduleNameString mn
139-
f id@IdentInfo {..} = (pack (prettyPrint name), [id])
157+
f id@IdentInfo {..} = (pack (prettyPrint name), moduleNameText,[id])
158+
159+
160+
identInfoToKeyVal :: IdentInfo -> (ModuleNameText, IdentInfo)
161+
identInfoToKeyVal identInfo =
162+
(moduleNameText identInfo, identInfo)
163+
164+
buildModuleExportMap:: [(Text, HashSet IdentInfo)] -> Map.HashMap ModuleNameText (HashSet IdentInfo)
165+
buildModuleExportMap exportsMap = do
166+
let lst = concatMap (Set.toList. snd) exportsMap
167+
let lstThree = map identInfoToKeyVal lst
168+
sortAndGroup lstThree
169+
170+
buildModuleExportMapFrom:: [ModIface] -> Map.HashMap Text (HashSet IdentInfo)
171+
buildModuleExportMapFrom modIfaces = do
172+
let exports = map extractModuleExports modIfaces
173+
Map.fromListWith (<>) exports
174+
175+
extractModuleExports :: ModIface -> (Text, HashSet IdentInfo)
176+
extractModuleExports modIFace = do
177+
let modName = pack $ moduleNameString $ moduleName $ mi_module modIFace
178+
let functionSet = Set.fromList $ concatMap (mkIdentInfos modName) $ mi_exports modIFace
179+
(modName, functionSet)
180+
181+
sortAndGroup :: [(ModuleNameText, IdentInfo)] -> Map.HashMap ModuleNameText (HashSet IdentInfo)
182+
sortAndGroup assocs = Map.fromListWith (<>) [(k, Set.fromList [v]) | (k, v) <- assocs]

‎test/functional/Completion.hs‎

Lines changed: 25 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -121,6 +121,31 @@ tests = testGroup "completions" [
121121
compls <- getCompletions doc (Position 5 7)
122122
liftIO $ length compls @?= maxCompletions def
123123

124+
, testCase "import function completions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
125+
doc <- openDoc "FunctionCompletions.hs" "haskell"
126+
127+
let te = TextEdit (Range (Position 0 30) (Position 0 41)) "A"
128+
_ <- applyEdit doc te
129+
130+
compls <- getCompletions doc (Position 0 31)
131+
let item = head $ filter ((== "Alternative") . (^. label)) compls
132+
liftIO $ do
133+
item ^. label @?= "Alternative"
134+
item ^. kind @?= Just CiFunction
135+
item ^. detail @?= Just "Control.Applicative"
136+
137+
, testCase "import second function completion" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
138+
doc <- openDoc "FunctionCompletions.hs" "haskell"
139+
140+
let te = TextEdit (Range (Position 0 41) (Position 0 42)) ", l"
141+
_ <- applyEdit doc te
142+
143+
compls <- getCompletions doc (Position 0 41)
144+
let item = head $ filter ((== "liftA") . (^. label)) compls
145+
liftIO $ do
146+
item ^. label @?= "liftA"
147+
item ^. kind @?= Just CiFunction
148+
item ^. detail @?= Just "Control.Applicative"
124149
, contextTests
125150
, snippetTests
126151
]

‎test/testdata/completion/FunctionCompletions.hs‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
import Control.Applicative (Alternative)
2+
import qualified Data.List
3+
4+
main :: IO ()
5+
main = putStrLn "hello"
6+
7+
foo :: Either a b -> Either a b
8+
foo = id

0 commit comments

Comments
 (0)