Skip to content

Commit 868e476

Browse files
pepeiborrapepeiborra
authored
Completions from non-imported modules (#2040)
* Completions from exports map * Add new import on completion * skip internal modules in exports map * preserve OccNames in exports map * fix uniqueness filter * fix tests * add tests * hlint * remove duplicate Orphan instance * attempt compat. with GHC 9.x * handle qualified imports
1 parent d815d04 commit 868e476

File tree

8 files changed

+227
-50
lines changed

8 files changed

+227
-50
lines changed

‎ghcide/src/Development/IDE/GHC/Orphans.hs

+6
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ import GHC ()
2121
import GhcPlugins
2222
import Retrie.ExactPrint (Annotated)
2323
import qualified StringBuffer as SB
24+
import Unique (getKey)
2425

2526

2627
-- Orphan instances for types from the GHC API.
@@ -50,6 +51,8 @@ instance Hashable GhcPlugins.InstalledUnitId where
5051
hashWithSalt salt = hashWithSalt salt . installedUnitIdString
5152
#else
5253
instance Show InstalledUnitId where show = prettyPrint
54+
deriving instance Ord SrcSpan
55+
deriving instance Ord UnhelpfulSpanReason
5356
#endif
5457

5558
instance NFData SB.StringBuffer where rnf = rwhnf
@@ -162,3 +165,6 @@ instance (NFData HsModule) where
162165
instance (NFData (HsModule a)) where
163166
#endif
164167
rnf = rwhnf
168+
169+
instance Show OccName where show = prettyPrint
170+
instance Hashable OccName where hashWithSalt s n = hashWithSalt s (getKey $ getUnique n)

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

+4-2
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,9 @@ module Development.IDE.Plugin.CodeAction
1111
iePluginDescriptor,
1212
typeSigsPluginDescriptor,
1313
bindingsPluginDescriptor,
14-
fillHolePluginDescriptor
14+
fillHolePluginDescriptor,
15+
newImport,
16+
newImportToEdit
1517
-- * For testing
1618
, matchRegExMultipleImports
1719
) where
@@ -835,7 +837,7 @@ suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_
835837
-- fallback to using GHC suggestion even though it is not always correct
836838
| otherwise
837839
= Just IdentInfo
838-
{ name = binding
840+
{ name = mkVarOcc $ T.unpack binding
839841
, rendered = binding
840842
, parent = Nothing
841843
, isDatacon = False

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

+30-8
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,8 @@ import Control.Monad.Extra
1313
import Control.Monad.IO.Class
1414
import Control.Monad.Trans.Maybe
1515
import Data.Aeson
16+
import qualified Data.HashMap.Strict as Map
17+
import qualified Data.HashSet as Set
1618
import Data.List (find)
1719
import Data.Maybe
1820
import qualified Data.Text as T
@@ -23,16 +25,21 @@ import Development.IDE.Core.Shake
2325
import Development.IDE.GHC.Compat
2426
import Development.IDE.GHC.Error (rangeToSrcSpan)
2527
import Development.IDE.GHC.ExactPrint (Annotated (annsA),
26-
GetAnnotatedParsedSource (GetAnnotatedParsedSource))
28+
GetAnnotatedParsedSource (GetAnnotatedParsedSource),
29+
astA)
2730
import Development.IDE.GHC.Util (prettyPrint)
2831
import Development.IDE.Graph
2932
import Development.IDE.Graph.Classes
33+
import Development.IDE.Plugin.CodeAction (newImport,
34+
newImportToEdit)
3035
import Development.IDE.Plugin.CodeAction.ExactPrint
3136
import Development.IDE.Plugin.Completions.Logic
3237
import Development.IDE.Plugin.Completions.Types
33-
import Development.IDE.Types.HscEnvEq (hscEnv)
38+
import Development.IDE.Types.Exports
39+
import Development.IDE.Types.HscEnvEq (HscEnvEq (envPackageExports),
40+
hscEnv)
3441
import Development.IDE.Types.Location
35-
import GHC.Exts (toList)
42+
import GHC.Exts (fromList, toList)
3643
import GHC.Generics
3744
import Ide.Plugin.Config (Config)
3845
import Ide.Types
@@ -130,7 +137,12 @@ getCompletionsLSP ide plId
130137
nonLocalCompls <- useWithStaleFast NonLocalCompletions npath
131138
pm <- useWithStaleFast GetParsedModule npath
132139
binds <- fromMaybe (mempty, zeroMapping) <$> useWithStaleFast GetBindings npath
133-
pure (opts, fmap (,pm,binds) ((fst <$> localCompls) <> (fst <$> nonLocalCompls)))
140+
exportsMapIO <- fmap(envPackageExports . fst) <$> useWithStaleFast GhcSession npath
141+
exportsMap <- mapM liftIO exportsMapIO
142+
let exportsCompItems = foldMap (map (fromIdentInfo uri) . Set.toList) . Map.elems . getExportsMap <$> exportsMap
143+
exportsCompls = mempty{anyQualCompls = fromMaybe [] exportsCompItems}
144+
let compls = (fst <$> localCompls) <> (fst <$> nonLocalCompls) <> Just exportsCompls
145+
pure (opts, fmap (,pm,binds) compls)
134146
case compls of
135147
Just (cci', parsedMod, bindMap) -> do
136148
pfix <- VFS.getCompletionPrefix position cnts
@@ -185,10 +197,20 @@ extendImportHandler' ideState ExtendImport {..}
185197
let df = ms_hspp_opts msrModSummary
186198
wantedModule = mkModuleName (T.unpack importName)
187199
wantedQual = mkModuleName . T.unpack <$> importQual
188-
imp <- liftMaybe $ find (isWantedModule wantedModule wantedQual) msrImports
189-
fmap (nfp,) $ liftEither $
190-
rewriteToWEdit df doc (annsA ps) $
191-
extendImport (T.unpack <$> thingParent) (T.unpack newThing) imp
200+
existingImport = find (isWantedModule wantedModule wantedQual) msrImports
201+
case existingImport of
202+
Just imp -> do
203+
fmap (nfp,) $ liftEither $
204+
rewriteToWEdit df doc (annsA ps) $
205+
extendImport (T.unpack <$> thingParent) (T.unpack newThing) imp
206+
Nothing -> do
207+
let n = newImport importName sym importQual False
208+
sym = if isNothing importQual then Just it else Nothing
209+
it = case thingParent of
210+
Nothing -> newThing
211+
Just p -> p <> "(" <> newThing <> ")"
212+
t <- liftMaybe $ snd <$> newImportToEdit n (astA ps)
213+
return (nfp, WorkspaceEdit {_changes=Just (fromList [(doc,List [t])]), _documentChanges=Nothing, _changeAnnotations=Nothing})
192214
| otherwise =
193215
mzero
194216

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

+43-5
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@ module Development.IDE.Plugin.Completions.Logic (
99
, cacheDataProducer
1010
, localCompletionsForParsedModule
1111
, getCompletions
12+
, fromIdentInfo
1213
) where
1314

1415
import Control.Applicative
@@ -19,6 +20,7 @@ import Data.List.Extra as List hiding
1920
import qualified Data.Map as Map
2021

2122
import Data.Maybe (fromMaybe, isJust,
23+
isNothing,
2224
listToMaybe,
2325
mapMaybe)
2426
import qualified Data.Text as T
@@ -49,6 +51,7 @@ import Development.IDE.Plugin.Completions.Types
4951
import Development.IDE.Spans.Common
5052
import Development.IDE.Spans.Documentation
5153
import Development.IDE.Spans.LocalBindings
54+
import Development.IDE.Types.Exports
5255
import Development.IDE.Types.HscEnvEq
5356
import Development.IDE.Types.Options
5457
import GhcPlugins (flLabel, unpackFS)
@@ -302,6 +305,25 @@ mkPragmaCompl label insertText =
302305
Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just Snippet)
303306
Nothing Nothing Nothing Nothing Nothing Nothing
304307

308+
fromIdentInfo :: Uri -> IdentInfo -> Maybe T.Text -> CompItem
309+
fromIdentInfo doc IdentInfo{..} q = CI
310+
{ compKind= occNameToComKind Nothing name
311+
, insertText=rendered
312+
, importedFrom=Right moduleNameText
313+
, typeText=Nothing
314+
, label=rendered
315+
, isInfix=Nothing
316+
, docs=emptySpanDoc
317+
, isTypeCompl= not isDatacon && isUpper (T.head rendered)
318+
, additionalTextEdits= Just $
319+
ExtendImport
320+
{ doc,
321+
thingParent = parent,
322+
importName = moduleNameText,
323+
importQual = q,
324+
newThing = rendered
325+
}
326+
}
305327

306328
cacheDataProducer :: Uri -> HscEnvEq -> Module -> GlobalRdrEnv-> GlobalRdrEnv -> [LImportDecl GhcPs] -> IO CachedCompletions
307329
cacheDataProducer uri env curMod globalEnv inScopeEnv limports = do
@@ -385,6 +407,7 @@ cacheDataProducer uri env curMod globalEnv inScopeEnv limports = do
385407
{ allModNamesAsNS = allModNamesAsNS
386408
, unqualCompls = unquals
387409
, qualCompls = quals
410+
, anyQualCompls = []
388411
, importableModules = moduleNames
389412
}
390413

@@ -394,6 +417,7 @@ localCompletionsForParsedModule uri pm@ParsedModule{pm_parsed_source = L _ HsMod
394417
CC { allModNamesAsNS = mempty
395418
, unqualCompls = compls
396419
, qualCompls = mempty
420+
, anyQualCompls = []
397421
, importableModules = mempty
398422
}
399423
where
@@ -507,7 +531,7 @@ getCompletions
507531
-> ClientCapabilities
508532
-> CompletionsConfig
509533
-> IO [CompletionItem]
510-
getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, importableModules}
534+
getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qualCompls, importableModules}
511535
maybe_parsed (localBindings, bmapping) prefixInfo caps config = do
512536
let VFS.PosPrefixInfo { fullLine, prefixModule, prefixText } = prefixInfo
513537
enteredQual = if T.null prefixModule then "" else prefixModule <> "."
@@ -566,8 +590,9 @@ getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, impor
566590
Just m -> Right $ ppr m
567591

568592
compls = if T.null prefixModule
569-
then localCompls ++ unqualCompls
570-
else Map.findWithDefault [] prefixModule $ getQualCompls qualCompls
593+
then localCompls ++ unqualCompls ++ (($Nothing) <$> anyQualCompls)
594+
else Map.findWithDefault [] prefixModule (getQualCompls qualCompls)
595+
++ (($ Just prefixModule) <$> anyQualCompls)
571596

572597
filtListWith f list =
573598
[ f label
@@ -606,13 +631,26 @@ getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, impor
606631
| "{-# " `T.isPrefixOf` fullLine
607632
-> return $ filtPragmaCompls (pragmaSuffix fullLine)
608633
| otherwise -> do
609-
let uniqueFiltCompls = nubOrdOn insertText filtCompls
634+
-- assumes that nubOrdBy is stable
635+
let uniqueFiltCompls = nubOrdBy uniqueCompl filtCompls
610636
compls <- mapM (mkCompl plId ideOpts) uniqueFiltCompls
611637
return $ filtModNameCompls
612638
++ filtKeywordCompls
613639
++ map (toggleSnippets caps config) compls
614640

615-
641+
uniqueCompl :: CompItem -> CompItem -> Ordering
642+
uniqueCompl x y =
643+
case compare (label x, importedFrom x, compKind x)
644+
(label y, importedFrom y, compKind y) of
645+
EQ ->
646+
-- preserve completions for duplicate record fields where the only difference is in the type
647+
-- remove redundant completions with less type info
648+
if typeText x == typeText y
649+
|| isNothing (typeText x)
650+
|| isNothing (typeText y)
651+
then EQ
652+
else compare (insertText x) (insertText y)
653+
other -> other
616654
-- ---------------------------------------------------------------------
617655
-- helper functions for pragmas
618656
-- ---------------------------------------------------------------------

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

+9-6
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@ import Ide.Plugin.Properties
2020
import Ide.PluginUtils (usePropertyLsp)
2121
import Ide.Types (PluginId)
2222
import Language.LSP.Server (MonadLsp)
23-
import Language.LSP.Types (CompletionItemKind, Uri)
23+
import Language.LSP.Types (CompletionItemKind (..), Uri)
2424

2525
-- From haskell-ide-engine/src/Haskell/Ide/Engine/LSP/Completions.hs
2626

@@ -91,18 +91,21 @@ instance Monoid QualCompls where
9191
data CachedCompletions = CC
9292
{ allModNamesAsNS :: [T.Text] -- ^ All module names in scope.
9393
-- Prelude is a single module
94-
, unqualCompls :: [CompItem] -- ^ All Possible completion items
94+
, unqualCompls :: [CompItem] -- ^ Unqualified completion items
9595
, qualCompls :: QualCompls -- ^ Completion items associated to
9696
-- to a specific module name.
97+
, anyQualCompls :: [Maybe T.Text -> CompItem] -- ^ Items associated to any qualifier
9798
, importableModules :: [T.Text] -- ^ All modules that may be imported.
98-
} deriving Show
99+
}
100+
101+
instance Show CachedCompletions where show _ = "<cached completions>"
99102

100103
instance NFData CachedCompletions where
101104
rnf = rwhnf
102105

103106
instance Monoid CachedCompletions where
104-
mempty = CC mempty mempty mempty mempty
107+
mempty = CC mempty mempty mempty mempty mempty
105108

106109
instance Semigroup CachedCompletions where
107-
CC a b c d <> CC a' b' c' d' =
108-
CC (a<>a') (b<>b') (c<>c') (d<>d')
110+
CC a b c d e <> CC a' b' c' d' e' =
111+
CC (a<>a') (b<>b') (c<>c') (d<>d') (e<>e')

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

+31-23
Original file line numberDiff line numberDiff line change
@@ -9,24 +9,26 @@ module Development.IDE.Types.Exports
99
createExportsMapTc
1010
,createExportsMapHieDb,size) where
1111

12-
import Avail (AvailInfo (..))
13-
import Control.DeepSeq (NFData (..))
12+
import Avail (AvailInfo (..))
13+
import Control.DeepSeq (NFData (..))
1414
import Control.Monad
15-
import Data.Bifunctor (Bifunctor (second))
16-
import Data.HashMap.Strict (HashMap, elems)
17-
import qualified Data.HashMap.Strict as Map
18-
import Data.HashSet (HashSet)
19-
import qualified Data.HashSet as Set
20-
import Data.Hashable (Hashable)
21-
import Data.Text (Text, pack)
15+
import Data.Bifunctor (Bifunctor (second))
16+
import Data.HashMap.Strict (HashMap, elems)
17+
import qualified Data.HashMap.Strict as Map
18+
import Data.HashSet (HashSet)
19+
import qualified Data.HashSet as Set
20+
import Data.Hashable (Hashable)
21+
import Data.List (isSuffixOf)
22+
import Data.Text (Text, pack)
2223
import Development.IDE.GHC.Compat
24+
import Development.IDE.GHC.Orphans ()
2325
import Development.IDE.GHC.Util
24-
import FieldLabel (flSelector)
25-
import GHC.Generics (Generic)
26-
import GhcPlugins (IfaceExport, ModGuts (..))
26+
import FieldLabel (flSelector)
27+
import GHC.Generics (Generic)
28+
import GhcPlugins (IfaceExport, ModGuts (..))
2729
import HieDb
2830
import Name
29-
import TcRnTypes (TcGblEnv (..))
31+
import TcRnTypes (TcGblEnv (..))
3032

3133
newtype ExportsMap = ExportsMap
3234
{getExportsMap :: HashMap IdentifierText (HashSet IdentInfo)}
@@ -41,7 +43,7 @@ instance Semigroup ExportsMap where
4143
type IdentifierText = Text
4244

4345
data IdentInfo = IdentInfo
44-
{ name :: !Text
46+
{ name :: !OccName
4547
, rendered :: Text
4648
, parent :: !(Maybe Text)
4749
, isDatacon :: !Bool
@@ -72,19 +74,19 @@ renderIEWrapped n
7274

7375
mkIdentInfos :: Text -> AvailInfo -> [IdentInfo]
7476
mkIdentInfos mod (Avail n) =
75-
[IdentInfo (pack (prettyPrint n)) (renderIEWrapped n) Nothing (isDataConName n) mod]
77+
[IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod]
7678
mkIdentInfos mod (AvailTC parent (n:nn) flds)
7779
-- Following the GHC convention that parent == n if parent is exported
7880
| n == parent
79-
= [ IdentInfo (pack (prettyPrint n)) (renderIEWrapped n) (Just $! parentP) (isDataConName n) mod
81+
= [ IdentInfo (nameOccName n) (renderIEWrapped n) (Just $! parentP) (isDataConName n) mod
8082
| n <- nn ++ map flSelector flds
8183
] ++
82-
[ IdentInfo (pack (prettyPrint n)) (renderIEWrapped n) Nothing (isDataConName n) mod]
84+
[ IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod]
8385
where
8486
parentP = pack $ printName parent
8587

8688
mkIdentInfos mod (AvailTC _ nn flds)
87-
= [ IdentInfo (pack (prettyPrint n)) (renderIEWrapped n) Nothing (isDataConName n) mod
89+
= [ IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod
8890
| n <- nn ++ map flSelector flds
8991
]
9092

@@ -109,23 +111,29 @@ createExportsMapTc = ExportsMap . Map.fromListWith (<>) . concatMap doOne
109111
where
110112
mn = moduleName $ tcg_mod mi
111113

114+
nonInternalModules :: ModuleName -> Bool
115+
nonInternalModules = not . (".Internal" `isSuffixOf`) . moduleNameString
116+
112117
createExportsMapHieDb :: HieDb -> IO ExportsMap
113118
createExportsMapHieDb hiedb = do
114119
mods <- getAllIndexedMods hiedb
115-
idents <- forM mods $ \m -> do
120+
idents <- forM (filter (nonInternalModules . modInfoName . hieModInfo) mods) $ \m -> do
116121
let mn = modInfoName $ hieModInfo m
117122
mText = pack $ moduleNameString mn
118123
fmap (wrap . unwrap mText) <$> getExportsForModule hiedb mn
119124
return $ ExportsMap $ Map.fromListWith (<>) (concat idents)
120125
where
121-
wrap identInfo = (name identInfo, Set.fromList [identInfo])
126+
wrap identInfo = (rendered identInfo, Set.fromList [identInfo])
122127
-- unwrap :: ExportRow -> IdentInfo
123-
unwrap m ExportRow{..} = IdentInfo n n p exportIsDatacon m
128+
unwrap m ExportRow{..} = IdentInfo exportName n p exportIsDatacon m
124129
where
125130
n = pack (occNameString exportName)
126131
p = pack . occNameString <$> exportParent
127132

128133
unpackAvail :: ModuleName -> IfaceExport -> [(Text, [IdentInfo])]
129-
unpackAvail !(pack . moduleNameString -> mod) = map f . mkIdentInfos mod
134+
unpackAvail mn
135+
| nonInternalModules mn = map f . mkIdentInfos mod
136+
| otherwise = const []
130137
where
131-
f id@IdentInfo {..} = (name, [id])
138+
!mod = pack $ moduleNameString mn
139+
f id@IdentInfo {..} = (pack (prettyPrint name), [id])

0 commit comments

Comments
 (0)