Skip to content

Commit c983c6b

Browse files
wz1000wz1000
committed
Implement completionItem/resolve
1 parent ac83ca4 commit c983c6b

File tree

10 files changed

+428
-219
lines changed

10 files changed

+428
-219
lines changed

‎cabal.project.orig

Lines changed: 112 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,112 @@
1+
packages:
2+
./
3+
./hie-compat
4+
./shake-bench
5+
./hls-graph
6+
./ghcide
7+
./ghcide-bench
8+
./ghcide/test
9+
./hls-plugin-api
10+
./hls-test-utils
11+
./plugins/hls-tactics-plugin
12+
./plugins/hls-brittany-plugin
13+
./plugins/hls-stylish-haskell-plugin
14+
./plugins/hls-fourmolu-plugin
15+
./plugins/hls-class-plugin
16+
./plugins/hls-eval-plugin
17+
./plugins/hls-explicit-imports-plugin
18+
./plugins/hls-refine-imports-plugin
19+
./plugins/hls-hlint-plugin
20+
./plugins/hls-rename-plugin
21+
./plugins/hls-retrie-plugin
22+
./plugins/hls-haddock-comments-plugin
23+
./plugins/hls-splice-plugin
24+
./plugins/hls-floskell-plugin
25+
./plugins/hls-pragmas-plugin
26+
./plugins/hls-module-name-plugin
27+
./plugins/hls-ormolu-plugin
28+
./plugins/hls-call-hierarchy-plugin
29+
./plugins/hls-alternate-number-format-plugin
30+
./plugins/hls-qualify-imported-names-plugin
31+
./plugins/hls-code-range-plugin
32+
./plugins/hls-change-type-signature-plugin
33+
./plugins/hls-stan-plugin
34+
./plugins/hls-gadt-plugin
35+
./plugins/hls-explicit-fixity-plugin
36+
./plugins/hls-refactor-plugin
37+
<<<<<<< HEAD
38+
||||||| parent of eae5d2e7 (fixes)
39+
/home/zubin/ghc-debug/stub/
40+
/home/zubin/ghc-debug/convention/
41+
=======
42+
/home/zubin/ghc-debug/stub/
43+
/home/zubin/ghc-debug/convention/
44+
/home/zubin/ghc-debug/client/
45+
/home/zubin/ghc-debug/common/
46+
/home/zubin/ghc-debug/ghc-debug-brick/
47+
>>>>>>> eae5d2e7 (fixes)
48+
49+
-- Standard location for temporary packages needed for particular environments
50+
-- For example it is used in the project gitlab mirror to help in the MAcOS M1 build script
51+
-- See https://github.com/haskell/haskell-language-server/blob/master/.gitlab-ci.yml
52+
optional-packages: vendored/*/*.cabal
53+
54+
tests: true
55+
56+
package *
57+
ghc-options: -haddock
58+
test-show-details: direct
59+
60+
write-ghc-environment-files: never
61+
62+
index-state: 2022-10-07T12:19:15Z
63+
64+
constraints:
65+
-- For GHC 9.4, older versions of entropy fail to build on Windows
66+
entropy >= 0.4.1.10,
67+
-- For GHC 9.4
68+
basement >= 0.0.15,
69+
hyphenation +embed,
70+
-- remove this when hlint sets ghc-lib to true by default
71+
-- https://github.com/ndmitchell/hlint/issues/1376
72+
hlint +ghc-lib,
73+
ghc-lib-parser-ex -auto,
74+
stylish-haskell +ghc-lib
75+
76+
-- This is benign and won't affect our ability to release to Hackage,
77+
-- because we only depend on `ekg-json` when a non-default flag
78+
-- is turned on.
79+
-- DELETE MARKER FOR CI
80+
-- centos7 has an old version of git which cabal doesn't
81+
-- support. We delete these lines in gitlab ci to workaround
82+
-- this issue, as this is not necessary to build our binaries.
83+
source-repository-package
84+
type:git
85+
location: https://github.com/pepeiborra/ekg-json
86+
tag: 7a0af7a8fd38045fd15fb13445bdcc7085325460
87+
-- https://github.com/tibbe/ekg-json/pull/12
88+
-- END DELETE
89+
90+
allow-newer:
91+
-- ghc-9.4
92+
Chart-diagrams:lens,
93+
Chart:lens,
94+
co-log-core:base,
95+
constraints-extras:base,
96+
constraints-extras:template-haskell,
97+
dependent-sum:some,
98+
diagrams-contrib:base,
99+
diagrams-contrib:lens,
100+
diagrams-postscript:base,
101+
diagrams-postscript:lens,
102+
diagrams-svg:base,
103+
diagrams-svg:lens,
104+
ekg-json:base,
105+
ghc-paths:Cabal,
106+
haddock-library:base,
107+
monoid-extras:base,
108+
monoid-subclasses:vector,
109+
svg-builder:base,
110+
uuid:time,
111+
vector-space:base,
112+
ekg-wai:time,

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

Lines changed: 26 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -133,6 +133,8 @@ import GHC.Hs (LEpaComment)
133133
import qualified GHC.Types.Error as Error
134134
#endif
135135

136+
import GHC.Stack
137+
136138
-- | Given a string buffer, return the string (after preprocessing) and the 'ParsedModule'.
137139
parseModule
138140
:: IdeOptions
@@ -1598,15 +1600,14 @@ coreFileToLinkable linkableType session ms iface details core_file t = do
15981600
--- and leads to fun errors like "Cannot continue after interface file error".
15991601
getDocsBatch
16001602
:: HscEnv
1601-
-> Module -- ^ a module where the names are in scope
16021603
-> [Name]
16031604
#if MIN_VERSION_ghc(9,3,0)
16041605
-> IO [Either String (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
16051606
#else
16061607
-> IO [Either String (Maybe HsDocString, IntMap HsDocString)]
16071608
#endif
1608-
getDocsBatch hsc_env _mod _names = do
1609-
(msgs, res) <- initTc hsc_env HsSrcFile False _mod fakeSpan $ forM _names $ \name ->
1609+
getDocsBatch hsc_env _names = do
1610+
res <- initIfaceLoad hsc_env $ forM _names $ \name ->
16101611
case nameModule_maybe name of
16111612
Nothing -> return (Left $ NameHasNoModule name)
16121613
Just mod -> do
@@ -1621,7 +1622,7 @@ getDocsBatch hsc_env _mod _names = do
16211622
, mi_decl_docs = DeclDocMap dmap
16221623
, mi_arg_docs = ArgDocMap amap
16231624
#endif
1624-
} <- loadModuleInterface "getModuleInterface" mod
1625+
} <- loadSysInterface (text "getModuleInterface") mod
16251626
#if MIN_VERSION_ghc(9,3,0)
16261627
if isNothing mb_doc_hdr && isNullUniqMap dmap && isNullUniqMap amap
16271628
#else
@@ -1642,44 +1643,39 @@ getDocsBatch hsc_env _mod _names = do
16421643
#else
16431644
Map.findWithDefault mempty name amap))
16441645
#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
1646+
return $ map (first $ T.unpack . printOutputable)
1647+
$ res
16561648
where
1657-
throwErrors = liftIO . throwIO . mkSrcErr
16581649
compiled n =
16591650
-- TODO: Find a more direct indicator.
16601651
case nameSrcLoc n of
16611652
RealSrcLoc {} -> False
16621653
UnhelpfulLoc {} -> True
16631654

1664-
fakeSpan :: RealSrcSpan
1665-
fakeSpan = realSrcLocSpan $ mkRealSrcLoc (Util.fsLit "<ghcide>") 1 1
1666-
16671655
-- | Non-interactive, batch version of 'InteractiveEval.lookupNames'.
16681656
-- The interactive paths create problems in ghc-lib builds
16691657
--- and leads to fun errors like "Cannot continue after interface file error".
1670-
lookupName :: HscEnv
1671-
-> Module -- ^ A module where the Names are in scope
1658+
lookupName :: HasCallStack
1659+
=> HscEnv
16721660
-> Name
16731661
-> 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-
1662+
lookupName _ name
1663+
| Nothing <- nameModule_maybe name = pure Nothing
1664+
lookupName hsc_env name = do
1665+
mb_thing <- liftIO $ lookupType hsc_env name
1666+
case mb_thing of
1667+
x@(Just _) -> return x
1668+
Nothing
1669+
| x@(Just thing) <- wiredInNameTyThing_maybe name
1670+
-> do when (needWiredInHomeIface thing)
1671+
(initIfaceLoad hsc_env (loadWiredInHomeIface name))
1672+
return x
1673+
| otherwise -> do
1674+
traceM $ "Iface Load $$$$$$$$$$" ++ show (nameModule name) ++ show (nameOccName name) ++ show callStack
1675+
res <- initIfaceLoad hsc_env $ importDecl name
1676+
case res of
1677+
Util.Succeeded x -> return (Just x)
1678+
_ -> return Nothing
16831679

16841680
pathToModuleName :: FilePath -> ModuleName
16851681
pathToModuleName = mkModuleName . map rep

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

Lines changed: 20 additions & 0 deletions
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

‎ghcide/src/Development/IDE/GHC/Compat/Core.hs

Lines changed: 7 additions & 0 deletions
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

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

Lines changed: 54 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -10,40 +10,40 @@ module Development.IDE.Plugin.Completions
1010

1111
import Control.Concurrent.Async (concurrently)
1212
import Control.Concurrent.STM.Stats (readTVarIO)
13-
import Control.Monad.Extra
1413
import Control.Monad.IO.Class
15-
import Control.Monad.Trans.Maybe
14+
import Control.Lens ((&), (.~))
1615
import Data.Aeson
1716
import qualified Data.HashMap.Strict as Map
1817
import qualified Data.HashSet as Set
19-
import Data.List (find)
2018
import Data.Maybe
2119
import qualified Data.Text as T
2220
import Development.IDE.Core.PositionMapping
21+
import Development.IDE.Core.Compile
2322
import Development.IDE.Core.RuleTypes
2423
import Development.IDE.Core.Service hiding (Log, LogShake)
2524
import Development.IDE.Core.Shake hiding (Log)
2625
import qualified Development.IDE.Core.Shake as Shake
2726
import Development.IDE.GHC.Compat
28-
import Development.IDE.GHC.Error (rangeToSrcSpan)
2927
import Development.IDE.GHC.Util (printOutputable)
3028
import Development.IDE.Graph
29+
import Development.IDE.Spans.Common
30+
import Development.IDE.Spans.Documentation
3131
import Development.IDE.Plugin.Completions.Logic
3232
import Development.IDE.Plugin.Completions.Types
3333
import Development.IDE.Types.Exports
34-
import Development.IDE.Types.HscEnvEq (HscEnvEq (envPackageExports),
34+
import Development.IDE.Types.HscEnvEq (HscEnvEq (envPackageExports, envVisibleModuleNames),
3535
hscEnv)
3636
import qualified Development.IDE.Types.KnownTargets as KT
3737
import Development.IDE.Types.Location
3838
import Development.IDE.Types.Logger (Pretty (pretty),
3939
Recorder,
4040
WithPriority,
4141
cmapWithPrio)
42-
import GHC.Exts (fromList, toList)
4342
import Ide.Plugin.Config (Config)
4443
import Ide.Types
4544
import qualified Language.LSP.Server as LSP
4645
import Language.LSP.Types
46+
import qualified Language.LSP.Types.Lens as J
4747
import qualified Language.LSP.VFS as VFS
4848
import Numeric.Natural
4949
import Text.Fuzzy.Parallel (Scored (..))
@@ -64,10 +64,12 @@ descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeSta
6464
descriptor recorder plId = (defaultPluginDescriptor plId)
6565
{ pluginRules = produceCompletions recorder
6666
, pluginHandlers = mkPluginHandler STextDocumentCompletion getCompletionsLSP
67+
<> mkPluginHandler SCompletionItemResolve resolveCompletion
6768
, pluginConfigDescriptor = defaultConfigDescriptor {configCustomConfig = mkCustomConfig properties}
6869
, pluginPriority = ghcideCompletionsPluginPriority
6970
}
7071

72+
7173
produceCompletions :: Recorder (WithPriority Log) -> Rules ()
7274
produceCompletions recorder = do
7375
define (cmapWithPrio LogShake recorder) $ \LocalCompletions file -> do
@@ -92,8 +94,9 @@ produceCompletions recorder = do
9294
(global, inScope) <- liftIO $ tcRnImportDecls env (dropListFromImportDecl <$> msrImports) `concurrently` tcRnImportDecls env msrImports
9395
case (global, inScope) of
9496
((_, Just globalEnv), (_, Just inScopeEnv)) -> do
97+
visibleMods <- liftIO $ fmap (fromMaybe []) $ envVisibleModuleNames sess
9598
let uri = fromNormalizedUri $ normalizedFilePathToUri file
96-
cdata <- liftIO $ cacheDataProducer uri sess (ms_mod msrModSummary) globalEnv inScopeEnv msrImports
99+
let cdata = cacheDataProducer uri visibleMods (ms_mod msrModSummary) globalEnv inScopeEnv msrImports
97100
return ([], Just cdata)
98101
(_diag, _) ->
99102
return ([], Nothing)
@@ -109,6 +112,49 @@ dropListFromImportDecl iDecl = let
109112
f x = x
110113
in f <$> iDecl
111114

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

0 commit comments

Comments
 (0)