Skip to content

Commit dee48c1

Browse files
wz1000wz1000
committed
Implement completionItem/resolve
1 parent 924b932 commit dee48c1

File tree

9 files changed

+332
-212
lines changed

9 files changed

+332
-212
lines changed

Diff for: ‎ghcide/src/Development/IDE/Core/Compile.hs

+26-29
Original file line numberDiff line numberDiff line change
@@ -1598,15 +1598,14 @@ coreFileToLinkable linkableType session ms iface details core_file t = do
15981598
--- and leads to fun errors like "Cannot continue after interface file error".
15991599
getDocsBatch
16001600
:: HscEnv
1601-
-> Module -- ^ a module where the names are in scope
16021601
-> [Name]
16031602
#if MIN_VERSION_ghc(9,3,0)
16041603
-> IO [Either String (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
16051604
#else
16061605
-> IO [Either String (Maybe HsDocString, IntMap HsDocString)]
16071606
#endif
1608-
getDocsBatch hsc_env _mod _names = do
1609-
(msgs, res) <- initTc hsc_env HsSrcFile False _mod fakeSpan $ forM _names $ \name ->
1607+
getDocsBatch hsc_env _names = do
1608+
res <- initIfaceLoad hsc_env $ forM _names $ \name ->
16101609
case nameModule_maybe name of
16111610
Nothing -> return (Left $ NameHasNoModule name)
16121611
Just mod -> do
@@ -1621,7 +1620,7 @@ getDocsBatch hsc_env _mod _names = do
16211620
, mi_decl_docs = DeclDocMap dmap
16221621
, mi_arg_docs = ArgDocMap amap
16231622
#endif
1624-
} <- loadModuleInterface "getModuleInterface" mod
1623+
} <- loadSysInterface (text "getModuleInterface") mod
16251624
#if MIN_VERSION_ghc(9,3,0)
16261625
if isNothing mb_doc_hdr && isNullUniqMap dmap && isNullUniqMap amap
16271626
#else
@@ -1642,44 +1641,42 @@ getDocsBatch hsc_env _mod _names = do
16421641
#else
16431642
Map.findWithDefault mempty name amap))
16441643
#endif
1645-
case res of
1646-
Just x -> return $ map (first $ T.unpack . printOutputable)
1647-
$ x
1648-
Nothing -> throwErrors
1649-
#if MIN_VERSION_ghc(9,3,0)
1650-
$ fmap GhcTcRnMessage msgs
1651-
#elif MIN_VERSION_ghc(9,2,0)
1652-
$ Error.getErrorMessages msgs
1653-
#else
1654-
$ snd msgs
1655-
#endif
1644+
return $ map (first $ T.unpack . printOutputable)
1645+
$ res
16561646
where
1657-
throwErrors = liftIO . throwIO . mkSrcErr
16581647
compiled n =
16591648
-- TODO: Find a more direct indicator.
16601649
case nameSrcLoc n of
16611650
RealSrcLoc {} -> False
16621651
UnhelpfulLoc {} -> True
16631652

1664-
fakeSpan :: RealSrcSpan
1665-
fakeSpan = realSrcLocSpan $ mkRealSrcLoc (Util.fsLit "<ghcide>") 1 1
1666-
16671653
-- | Non-interactive, batch version of 'InteractiveEval.lookupNames'.
16681654
-- The interactive paths create problems in ghc-lib builds
16691655
--- and leads to fun errors like "Cannot continue after interface file error".
16701656
lookupName :: HscEnv
1671-
-> Module -- ^ A module where the Names are in scope
16721657
-> Name
16731658
-> IO (Maybe TyThing)
1674-
lookupName hsc_env mod name = do
1675-
(_messages, res) <- initTc hsc_env HsSrcFile False mod fakeSpan $ do
1676-
tcthing <- tcLookup name
1677-
case tcthing of
1678-
AGlobal thing -> return thing
1679-
ATcId{tct_id=id} -> return (AnId id)
1680-
_ -> panic "tcRnLookupName'"
1681-
return res
1682-
1659+
lookupName _ name
1660+
| Nothing <- nameModule_maybe name = pure Nothing
1661+
lookupName hsc_env name = do
1662+
#if MIN_VERSION_ghc(9,2,0)
1663+
mb_thing <- liftIO $ lookupType hsc_env name
1664+
#else
1665+
eps <- liftIO $ readIORef (hsc_EPS hsc_env)
1666+
let mb_thing = lookupType (hsc_dflags hsc_env) (hsc_HPT hsc_env) (eps_PTE eps) name
1667+
#endif
1668+
case mb_thing of
1669+
x@(Just _) -> return x
1670+
Nothing
1671+
| x@(Just thing) <- wiredInNameTyThing_maybe name
1672+
-> do when (needWiredInHomeIface thing)
1673+
(initIfaceLoad hsc_env (loadWiredInHomeIface name))
1674+
return x
1675+
| otherwise -> do
1676+
res <- initIfaceLoad hsc_env $ importDecl name
1677+
case res of
1678+
Util.Succeeded x -> return (Just x)
1679+
_ -> return Nothing
16831680

16841681
pathToModuleName :: FilePath -> ModuleName
16851682
pathToModuleName = mkModuleName . map rep

Diff for: ‎ghcide/src/Development/IDE/GHC/Compat.hs

+20
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,7 @@ module Development.IDE.GHC.Compat(
2222
#else
2323
upNameCache,
2424
#endif
25+
lookupNameCache,
2526
disableWarningsAsErrors,
2627
reLoc,
2728
reLocA,
@@ -416,6 +417,25 @@ hieExportNames = nameListFromAvails . hie_exports
416417
#if MIN_VERSION_ghc(9,3,0)
417418
type NameCacheUpdater = NameCache
418419
#else
420+
421+
lookupNameCache :: Module -> OccName -> NameCache -> (NameCache, Name)
422+
-- Lookup up the (Module,OccName) in the NameCache
423+
-- If you find it, return it; if not, allocate a fresh original name and extend
424+
-- the NameCache.
425+
-- Reason: this may the first occurrence of (say) Foo.bar we have encountered.
426+
-- If we need to explore its value we will load Foo.hi; but meanwhile all we
427+
-- need is a Name for it.
428+
lookupNameCache mod occ name_cache =
429+
case lookupOrigNameCache (nsNames name_cache) mod occ of {
430+
Just name -> (name_cache, name);
431+
Nothing ->
432+
case takeUniqFromSupply (nsUniqs name_cache) of {
433+
(uniq, us) ->
434+
let
435+
name = mkExternalName uniq mod occ noSrcSpan
436+
new_cache = extendNameCache (nsNames name_cache) mod occ name
437+
in (name_cache{ nsUniqs = us, nsNames = new_cache }, name) }}
438+
419439
upNameCache :: IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
420440
upNameCache = updNameCache
421441
#endif

Diff for: ‎ghcide/src/Development/IDE/GHC/Compat/Core.hs

+7
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,14 @@ module Development.IDE.GHC.Compat.Core (
3636
maxRefHoleFits,
3737
maxValidHoleFits,
3838
setOutputFile,
39+
lookupType,
40+
needWiredInHomeIface,
41+
loadWiredInHomeIface,
42+
loadSysInterface,
43+
importDecl,
44+
#if MIN_VERSION_ghc(8,8,0)
3945
CommandLineOption,
46+
#endif
4047
#if !MIN_VERSION_ghc(9,2,0)
4148
staticPlugins,
4249
#endif

Diff for: ‎ghcide/src/Development/IDE/Plugin/Completions.hs

+57-3
Original file line numberDiff line numberDiff line change
@@ -12,21 +12,27 @@ module Development.IDE.Plugin.Completions
1212
import Control.Concurrent.Async (concurrently)
1313
import Control.Concurrent.STM.Stats (readTVarIO)
1414
import Control.Monad.IO.Class
15+
import Control.Lens ((&), (.~))
1516
import qualified Data.HashMap.Strict as Map
1617
import qualified Data.HashSet as Set
18+
import Data.Aeson
1719
import Data.Maybe
1820
import qualified Data.Text as T
1921
import Development.IDE.Core.PositionMapping
22+
import Development.IDE.Core.Compile
2023
import Development.IDE.Core.RuleTypes
2124
import Development.IDE.Core.Service hiding (Log, LogShake)
2225
import Development.IDE.Core.Shake hiding (Log)
2326
import qualified Development.IDE.Core.Shake as Shake
2427
import Development.IDE.GHC.Compat
28+
import Development.IDE.GHC.Util
2529
import Development.IDE.Graph
30+
import Development.IDE.Spans.Common
31+
import Development.IDE.Spans.Documentation
2632
import Development.IDE.Plugin.Completions.Logic
2733
import Development.IDE.Plugin.Completions.Types
2834
import Development.IDE.Types.Exports
29-
import Development.IDE.Types.HscEnvEq (HscEnvEq (envPackageExports),
35+
import Development.IDE.Types.HscEnvEq (HscEnvEq (envPackageExports, envVisibleModuleNames),
3036
hscEnv)
3137
import qualified Development.IDE.Types.KnownTargets as KT
3238
import Development.IDE.Types.Location
@@ -37,6 +43,8 @@ import Development.IDE.Types.Logger (Pretty (pretty),
3743
import Ide.Types
3844
import qualified Language.LSP.Server as LSP
3945
import Language.LSP.Types
46+
import qualified Language.LSP.Types.Lens as J
47+
import qualified Language.LSP.VFS as VFS
4048
import Numeric.Natural
4149
import Text.Fuzzy.Parallel (Scored (..))
4250

@@ -57,10 +65,12 @@ descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeSta
5765
descriptor recorder plId = (defaultPluginDescriptor plId)
5866
{ pluginRules = produceCompletions recorder
5967
, pluginHandlers = mkPluginHandler STextDocumentCompletion getCompletionsLSP
68+
<> mkPluginHandler SCompletionItemResolve resolveCompletion
6069
, pluginConfigDescriptor = defaultConfigDescriptor {configCustomConfig = mkCustomConfig properties}
6170
, pluginPriority = ghcideCompletionsPluginPriority
6271
}
6372

73+
6474
produceCompletions :: Recorder (WithPriority Log) -> Rules ()
6575
produceCompletions recorder = do
6676
define (cmapWithPrio LogShake recorder) $ \LocalCompletions file -> do
@@ -85,8 +95,9 @@ produceCompletions recorder = do
8595
(global, inScope) <- liftIO $ tcRnImportDecls env (dropListFromImportDecl <$> msrImports) `concurrently` tcRnImportDecls env msrImports
8696
case (global, inScope) of
8797
((_, Just globalEnv), (_, Just inScopeEnv)) -> do
98+
visibleMods <- liftIO $ fmap (fromMaybe []) $ envVisibleModuleNames sess
8899
let uri = fromNormalizedUri $ normalizedFilePathToUri file
89-
cdata <- liftIO $ cacheDataProducer uri sess (ms_mod msrModSummary) globalEnv inScopeEnv msrImports
100+
let cdata = cacheDataProducer uri visibleMods (ms_mod msrModSummary) globalEnv inScopeEnv msrImports
90101
return ([], Just cdata)
91102
(_diag, _) ->
92103
return ([], Nothing)
@@ -102,6 +113,49 @@ dropListFromImportDecl iDecl = let
102113
f x = x
103114
in f <$> iDecl
104115

116+
resolveCompletion :: IdeState -> PluginId -> CompletionItem -> LSP.LspM Config (Either ResponseError CompletionItem)
117+
resolveCompletion ide _ comp@CompletionItem{_detail,_documentation,_xdata}
118+
| Just resolveData <- _xdata
119+
, Success (CompletionResolveData uri needType (NameDetails mod occ)) <- fromJSON resolveData
120+
, Just file <- uriToNormalizedFilePath $ toNormalizedUri uri
121+
= liftIO $ runIdeAction "Completion resolve" (shakeExtras ide) $ do
122+
msess <- useWithStaleFast GhcSessionDeps file
123+
case msess of
124+
Nothing -> pure (Right comp) -- File doesn't compile, return original completion item
125+
Just (sess,_) -> do
126+
let nc = ideNc $ shakeExtras ide
127+
#if MIN_VERSION_ghc(9,3,0)
128+
name <- liftIO $ lookupNameCache nc mod occ
129+
#else
130+
name <- liftIO $ upNameCache nc (lookupNameCache mod occ)
131+
#endif
132+
mdkm <- useWithStaleFast GetDocMap file
133+
let (dm,km) = case mdkm of
134+
Just (DKMap dm km, _) -> (dm,km)
135+
Nothing -> (mempty, mempty)
136+
doc <- case lookupNameEnv dm name of
137+
Just doc -> pure $ spanDocToMarkdown doc
138+
Nothing -> liftIO $ spanDocToMarkdown <$> getDocumentationTryGhc (hscEnv sess) name
139+
typ <- case lookupNameEnv km name of
140+
_ | not needType -> pure Nothing
141+
Just ty -> pure (safeTyThingType ty)
142+
Nothing -> do
143+
(safeTyThingType =<<) <$> liftIO (lookupName (hscEnv sess) name)
144+
let det1 = case typ of
145+
Just ty -> Just (":: " <> printOutputable (stripForall ty) <> "\n")
146+
Nothing -> Nothing
147+
doc1 = case _documentation of
148+
Just (CompletionDocMarkup (MarkupContent MkMarkdown old)) ->
149+
CompletionDocMarkup $ MarkupContent MkMarkdown $ T.intercalate sectionSeparator (old:doc)
150+
_ -> CompletionDocMarkup $ MarkupContent MkMarkdown $ T.intercalate sectionSeparator doc
151+
pure (Right $ comp & J.detail .~ (det1 <> _detail)
152+
& J.documentation .~ Just doc1
153+
)
154+
where
155+
stripForall ty = case splitForAllTyCoVars ty of
156+
(_,res) -> res
157+
resolveCompletion _ _ comp = pure (Right comp)
158+
105159
-- | Generate code actions.
106160
getCompletionsLSP
107161
:: IdeState
@@ -160,7 +214,7 @@ getCompletionsLSP ide plId
160214
plugins = idePlugins $ shakeExtras ide
161215
config <- liftIO $ runAction "" ide $ getCompletionsConfig plId
162216

163-
allCompletions <- liftIO $ getCompletions plugins ideOpts cci' parsedMod astres bindMap pfix clientCaps config moduleExports
217+
allCompletions <- liftIO $ getCompletions plugins ideOpts cci' parsedMod astres bindMap pfix clientCaps config moduleExports uri
164218
pure $ InL (List $ orderedCompletions allCompletions)
165219
_ -> return (InL $ List [])
166220
_ -> return (InL $ List [])

0 commit comments

Comments
 (0)