Skip to content

Commit d826d06

Browse files
jian-linjian-lin
committed
Show function argument documentation in signature help
1 parent a522e88 commit d826d06

File tree

9 files changed

+72
-32
lines changed

9 files changed

+72
-32
lines changed

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -62,7 +62,7 @@ getAtPoint file pos = runMaybeT $ do
6262

6363
(hf, mapping) <- useWithStaleFastMT GetHieAst file
6464
env <- hscEnv . fst <$> useWithStaleFastMT GhcSession file
65-
dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> runMaybeT (useWithStaleFastMT GetDocMap file)
65+
dkMap <- lift $ maybe (DKMap mempty mempty mempty) fst <$> runMaybeT (useWithStaleFastMT GetDocMap file)
6666

6767
!pos' <- MaybeT (return $ fromCurrentPosition mapping pos)
6868
MaybeT $ liftIO $ fmap (first (toCurrentRange mapping =<<)) <$> AtPoint.atPoint opts hf dkMap env pos'

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -249,9 +249,9 @@ type instance RuleResult GetHieAst = HieAstResult
249249
-- | A IntervalMap telling us what is in scope at each point
250250
type instance RuleResult GetBindings = Bindings
251251

252-
data DocAndTyThingMap = DKMap {getDocMap :: !DocMap, getTyThingMap :: !TyThingMap}
252+
data DocAndTyThingMap = DKMap {getDocMap :: !DocMap, getTyThingMap :: !TyThingMap, getArgDocMap :: !ArgDocMap}
253253
instance NFData DocAndTyThingMap where
254-
rnf (DKMap a b) = rwhnf a `seq` rwhnf b
254+
rnf (DKMap a b c) = rwhnf a `seq` rwhnf b `seq` rwhnf c
255255

256256
instance Show DocAndTyThingMap where
257257
show = const "docmap"

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -576,7 +576,7 @@ getDocMapRule recorder =
576576

577577
-- | Persistent rule to ensure that hover doesn't block on startup
578578
persistentDocMapRule :: Rules ()
579-
persistentDocMapRule = addPersistentRule GetDocMap $ \_ -> pure $ Just (DKMap mempty mempty, idDelta, Nothing)
579+
persistentDocMapRule = addPersistentRule GetDocMap $ \_ -> pure $ Just (DKMap mempty mempty mempty, idDelta, Nothing)
580580

581581
readHieFileForSrcFromDisk :: Recorder (WithPriority Log) -> NormalizedFilePath -> MaybeT IdeAction Compat.HieFile
582582
readHieFileForSrcFromDisk recorder file = do

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -132,11 +132,11 @@ resolveCompletion ide _pid comp@CompletionItem{_detail,_documentation,_data_} ur
132132
name <- liftIO $ lookupNameCache nc mod occ
133133
mdkm <- liftIO $ runIdeAction "CompletionResolve.GetDocMap" (shakeExtras ide) $ useWithStaleFast GetDocMap file
134134
let (dm,km) = case mdkm of
135-
Just (DKMap docMap tyThingMap, _) -> (docMap,tyThingMap)
136-
Nothing -> (mempty, mempty)
135+
Just (DKMap docMap tyThingMap _argDocMap, _) -> (docMap,tyThingMap)
136+
Nothing -> (mempty, mempty)
137137
doc <- case lookupNameEnv dm name of
138138
Just doc -> pure $ spanDocToMarkdown doc
139-
Nothing -> liftIO $ spanDocToMarkdown <$> getDocumentationTryGhc (hscEnv sess) name
139+
Nothing -> liftIO $ spanDocToMarkdown . fst <$> getDocumentationTryGhc (hscEnv sess) name
140140
typ <- case lookupNameEnv km name of
141141
_ | not needType -> pure Nothing
142142
Just ty -> pure (safeTyThingType ty)

‎ghcide/src/Development/IDE/Spans/AtPoint.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -239,7 +239,7 @@ atPoint
239239
-> HscEnv
240240
-> Position
241241
-> IO (Maybe (Maybe Range, [T.Text]))
242-
atPoint IdeOptions{} (HAR _ (hf :: HieASTs a) rf _ (kind :: HieKind hietype)) (DKMap dm km) env pos =
242+
atPoint IdeOptions{} (HAR _ (hf :: HieASTs a) rf _ (kind :: HieKind hietype)) (DKMap dm km _am) env pos =
243243
listToMaybe <$> sequence (pointCommand hf pos hoverInfo)
244244
where
245245
-- Hover info for values/data

‎ghcide/src/Development/IDE/Spans/Common.hs‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@ module Development.IDE.Spans.Common (
1313
, spanDocToMarkdownForTest
1414
, DocMap
1515
, TyThingMap
16+
, ArgDocMap
1617
, srcSpanToMdLink
1718
) where
1819

@@ -29,13 +30,15 @@ import GHC.Generics
2930
import System.FilePath
3031

3132
import Control.Lens
33+
import Data.IntMap (IntMap)
3234
import Development.IDE.GHC.Compat
3335
import Development.IDE.GHC.Orphans ()
3436
import qualified Language.LSP.Protocol.Lens as JL
3537
import Language.LSP.Protocol.Types
3638

3739
type DocMap = NameEnv SpanDoc
3840
type TyThingMap = NameEnv TyThing
41+
type ArgDocMap = NameEnv (IntMap SpanDoc)
3942

4043
-- | Shows IEWrappedName, without any modifier, qualifier or unique identifier.
4144
unqualIEWrapName :: IEWrappedName GhcPs -> T.Text

‎ghcide/src/Development/IDE/Spans/Documentation.hs‎

Lines changed: 16 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,7 @@ import Control.Monad.Extra (findM)
1616
import Control.Monad.IO.Class
1717
import Data.Either
1818
import Data.Foldable
19+
import Data.IntMap (IntMap)
1920
import Data.List.Extra
2021
import qualified Data.Map as M
2122
import Data.Maybe
@@ -41,21 +42,27 @@ mkDocMap
4142
-> IO DocAndTyThingMap
4243
mkDocMap env rm this_mod =
4344
do
44-
(Just Docs{docs_decls = UniqMap this_docs}) <- extractDocs (hsc_dflags env) this_mod
45+
(Just Docs{docs_decls = UniqMap this_docs, docs_args = UniqMap this_arg_docs}) <- extractDocs (hsc_dflags env) this_mod
4546
d <- foldrM getDocs (fmap (\(_, x) -> (map hsDocString x) `SpanDocString` SpanDocUris Nothing Nothing) this_docs) names
4647
k <- foldrM getType (tcg_type_env this_mod) names
47-
pure $ DKMap d k
48+
a <- foldrM getArgDocs (fmap (\(_, m) -> fmap (\x -> [hsDocString x] `SpanDocString` SpanDocUris Nothing Nothing) m) this_arg_docs) names
49+
pure $ DKMap d k a
4850
where
4951
getDocs n nameMap
5052
| maybe True (mod ==) $ nameModule_maybe n = pure nameMap -- we already have the docs in this_docs, or they do not exist
5153
| otherwise = do
52-
doc <- getDocumentationTryGhc env n
54+
(doc, _argDoc) <- getDocumentationTryGhc env n
5355
pure $ extendNameEnv nameMap n doc
5456
getType n nameMap
5557
| Nothing <- lookupNameEnv nameMap n
5658
= do kind <- lookupKind env n
5759
pure $ maybe nameMap (extendNameEnv nameMap n) kind
5860
| otherwise = pure nameMap
61+
getArgDocs n nameMap
62+
| maybe True (mod ==) $ nameModule_maybe n = pure nameMap
63+
| otherwise = do
64+
(_doc, argDoc) <- getDocumentationTryGhc env n
65+
pure $ extendNameEnv nameMap n argDoc
5966
names = rights $ S.toList idents
6067
idents = M.keysSet rm
6168
mod = tcg_mod this_mod
@@ -64,23 +71,23 @@ lookupKind :: HscEnv -> Name -> IO (Maybe TyThing)
6471
lookupKind env =
6572
fmap (fromRight Nothing) . catchSrcErrors (hsc_dflags env) "span" . lookupName env
6673

67-
getDocumentationTryGhc :: HscEnv -> Name -> IO SpanDoc
74+
getDocumentationTryGhc :: HscEnv -> Name -> IO (SpanDoc, IntMap SpanDoc)
6875
getDocumentationTryGhc env n =
69-
(fromMaybe emptySpanDoc . listToMaybe <$> getDocumentationsTryGhc env [n])
70-
`catch` (\(_ :: IOEnvFailure) -> pure emptySpanDoc)
76+
(fromMaybe (emptySpanDoc, mempty) . listToMaybe <$> getDocumentationsTryGhc env [n])
77+
`catch` (\(_ :: IOEnvFailure) -> pure (emptySpanDoc, mempty))
7178

72-
getDocumentationsTryGhc :: HscEnv -> [Name] -> IO [SpanDoc]
79+
getDocumentationsTryGhc :: HscEnv -> [Name] -> IO [(SpanDoc, IntMap SpanDoc)]
7380
getDocumentationsTryGhc env names = do
7481
resOr <- catchSrcErrors (hsc_dflags env) "docs" $ getDocsBatch env names
7582
case resOr of
7683
Left _ -> return []
7784
Right res -> zipWithM unwrap res names
7885
where
79-
unwrap (Right (Just docs, _)) n = SpanDocString (map hsDocString docs) <$> getUris n
86+
unwrap (Right (Just docs, argDocs)) n = (\uris -> (SpanDocString (map hsDocString docs) uris, fmap (\x -> SpanDocString [hsDocString x] uris) argDocs)) <$> getUris n
8087
unwrap _ n = mkSpanDocText n
8188

8289
mkSpanDocText name =
83-
SpanDocText [] <$> getUris name
90+
(\uris -> (SpanDocText [] uris, mempty)) <$> getUris name
8491

8592
-- Get the uris to the documentation and source html pages if they exist
8693
getUris name = do

‎plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs‎

Lines changed: 27 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,8 @@ module Ide.Plugin.SignatureHelp (descriptor) where
66
import Control.Arrow ((>>>))
77
import Data.Bifunctor (bimap)
88
import Data.Function ((&))
9+
import Data.IntMap (IntMap)
10+
import qualified Data.IntMap as IntMap
911
import qualified Data.Map.Strict as M
1012
import qualified Data.Set as S
1113
import Data.Text (Text)
@@ -30,7 +32,8 @@ import Development.IDE.GHC.Compat (FastStringCompat, Name,
3032
mkRealSrcSpan, ppr,
3133
sourceNodeInfo)
3234
import Development.IDE.GHC.Compat.Util (LexicalFastString (LexicalFastString))
33-
import Development.IDE.Spans.Common (DocMap,
35+
import Development.IDE.Spans.Common (ArgDocMap, DocMap,
36+
SpanDoc,
3437
spanDocToMarkdown)
3538
import GHC.Core.Map.Type (deBruijnize)
3639
import GHC.Core.Type (FunTyFlag (FTF_T_T),
@@ -97,25 +100,25 @@ signatureHelpProvider ideState _pluginId (SignatureHelpParams (TextDocumentIdent
97100
argumentNumber <- getArgumentNumber span hieAst
98101
Just (functionName, functionTypes, argumentNumber)
99102
)
100-
docMap <- runIdeActionE "signatureHelp.docMap" (shakeExtras ideState) $ do
101-
(DKMap docMap _tyThingMap, _positionMapping) <- useWithStaleFastE GetDocMap nfp
102-
pure docMap
103+
(docMap, argDocMap) <- runIdeActionE "signatureHelp.docMap" (shakeExtras ideState) $ do
104+
(DKMap docMap _tyThingMap argDocMap, _positionMapping) <- useWithStaleFastE GetDocMap nfp
105+
pure (docMap, argDocMap)
103106
case results of
104107
[(_functionName, [], _argumentNumber)] -> pure $ InR Null
105108
[(functionName, functionTypes, argumentNumber)] ->
106-
pure $ InL $ mkSignatureHelp docMap (fromIntegral argumentNumber - 1) functionName functionTypes
109+
pure $ InL $ mkSignatureHelp docMap argDocMap (fromIntegral argumentNumber - 1) functionName functionTypes
107110
-- TODO(@linj) what does non-singleton list mean?
108111
_ -> pure $ InR Null
109112

110-
mkSignatureHelp :: DocMap -> UInt -> Name -> [Type] -> SignatureHelp
111-
mkSignatureHelp docMap argumentNumber functionName functionTypes =
113+
mkSignatureHelp :: DocMap -> ArgDocMap -> UInt -> Name -> [Type] -> SignatureHelp
114+
mkSignatureHelp docMap argDocMap argumentNumber functionName functionTypes =
112115
SignatureHelp
113-
(mkSignatureInformation docMap argumentNumber functionName <$> functionTypes)
116+
(mkSignatureInformation docMap argDocMap argumentNumber functionName <$> functionTypes)
114117
(Just 0)
115118
(Just $ InL argumentNumber)
116119

117-
mkSignatureInformation :: DocMap -> UInt -> Name -> Type -> SignatureInformation
118-
mkSignatureInformation docMap argumentNumber functionName functionType =
120+
mkSignatureInformation :: DocMap -> ArgDocMap -> UInt -> Name -> Type -> SignatureInformation
121+
mkSignatureInformation docMap argDocMap argumentNumber functionName functionType =
119122
let functionNameLabelPrefix = printOutputableOneLine (ppr functionName) <> " :: "
120123
mFunctionDoc = case lookupNameEnv docMap functionName of
121124
Nothing -> Nothing
@@ -125,16 +128,25 @@ mkSignatureInformation docMap argumentNumber functionName functionType =
125128
MarkupContent
126129
MarkupKind_Markdown
127130
(T.unlines . spanDocToMarkdown $ spanDoc)
131+
thisArgDocMap = case lookupNameEnv argDocMap functionName of
132+
Nothing -> mempty
133+
Just argumentDocMap' -> argumentDocMap'
128134
in SignatureInformation
129135
(functionNameLabelPrefix <> printOutputableOneLine functionType)
130136
mFunctionDoc
131-
(Just $ mkArguments (fromIntegral $ T.length functionNameLabelPrefix) functionType)
137+
(Just $ mkArguments thisArgDocMap (fromIntegral $ T.length functionNameLabelPrefix) functionType)
132138
(Just $ InL argumentNumber)
133139

134-
mkArguments :: UInt -> Type -> [ParameterInformation]
135-
mkArguments offset functionType =
136-
[ ParameterInformation (InR range) Nothing
137-
| range <- bimap (+offset) (+offset) <$> findArgumentRanges functionType
140+
mkArguments :: IntMap SpanDoc -> UInt -> Type -> [ParameterInformation]
141+
mkArguments thisArgDocMap offset functionType =
142+
[ ParameterInformation (InR range) mArgDoc
143+
| (argIndex, range) <- zip [0..] (bimap (+offset) (+offset) <$> findArgumentRanges functionType)
144+
, let mArgDoc = case IntMap.lookup argIndex thisArgDocMap of
145+
Nothing -> Nothing
146+
Just spanDoc ->
147+
Just $
148+
InR $
149+
MarkupContent MarkupKind_Markdown (T.unlines . spanDocToMarkdown $ spanDoc)
138150
]
139151

140152
findArgumentRanges :: Type -> [(UInt, UInt)]

‎plugins/hls-signature-help-plugin/test/Main.hs‎

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -298,6 +298,24 @@ main =
298298
|]
299299
[ Nothing,
300300
Just $ SignatureHelp [SignatureInformation "f :: Bool -> Bool" (Just $ InR $ MarkupContent MarkupKind_Markdown "\n\nThe `f` function does something to a bool value.\n\n") (Just [ParameterInformation (InR (5,9)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0))
301+
],
302+
mkTest
303+
"function and arguments documentation"
304+
[trimming|
305+
-- |Doc for function 'f'.
306+
f ::
307+
-- | The first 'Bool' argument
308+
Bool ->
309+
-- | The second 'Int' argument
310+
Int ->
311+
-- | The return value
312+
Bool
313+
f = _
314+
x = f True 1
315+
^ ^
316+
|]
317+
[ Nothing,
318+
Just $ SignatureHelp [SignatureInformation "f :: Bool -> Int -> Bool" (Just $ InR $ MarkupContent MarkupKind_Markdown "\n\nDoc for function `f` .\n\n") (Just [ParameterInformation (InR (5,9)) (Just $ InR $ MarkupContent MarkupKind_Markdown "\n\nThe first `Bool` argument\n\n"), ParameterInformation (InR (13,16)) (Just $ InR $ MarkupContent MarkupKind_Markdown "\n\nThe second `Int` argument\n\n")]) (Just (InL 0))] (Just 0) (Just (InL 0))
301319
]
302320
]
303321

0 commit comments

Comments
 (0)