Skip to content

Commit 7a54a1d

Browse files
jian-linjian-lin
committed
WIP: add basic boilerplate for signature help plugin
1 parent 8aeda29 commit 7a54a1d

File tree

7 files changed

+161
-3
lines changed

7 files changed

+161
-3
lines changed

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

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -574,7 +574,8 @@ pointCommand hf pos k =
574574
--
575575
-- 'coerce' here to avoid an additional function for maintaining
576576
-- backwards compatibility.
577-
case selectSmallestContaining (sp $ coerce fs) ast of
577+
case smallestContainingSatisfying (sp $ coerce fs) isFunction ast of
578+
-- case selectSmallestContaining (sp $ coerce fs) ast of
578579
Nothing -> Nothing
579580
Just ast' -> Just $ k ast'
580581
where
@@ -583,6 +584,8 @@ pointCommand hf pos k =
583584
line :: UInt
584585
line = _line pos
585586
cha = _character pos
587+
isFunction ast = not $ null $ flip M.mapMaybeWithKey (getSourcedNodeInfo $ sourcedNodeInfo ast) $ \_nodeOrigin (NodeInfo _nodeAnnotations _nodeType _nodeIdentifiers) ->
588+
Just True
586589

587590
-- In ghc9, nodeInfo is monomorphic, so we need a case split here
588591
nodeInfoH :: HieKind a -> HieAST a -> NodeInfo a

‎haskell-language-server.cabal

Lines changed: 53 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -834,6 +834,58 @@ test-suite hls-stan-plugin-tests
834834
default-extensions:
835835
OverloadedStrings
836836

837+
-----------------------------
838+
-- signature help plugin
839+
-----------------------------
840+
841+
flag signatureHelp
842+
description: Enable signature help plugin
843+
default: True
844+
manual: True
845+
846+
common signatureHelp
847+
if flag(signatureHelp)
848+
build-depends: haskell-language-server:hls-signature-help-plugin
849+
cpp-options: -Dhls_signatureHelp
850+
851+
-- TODO(@linj) remove unneeded deps
852+
library hls-signature-help-plugin
853+
import: defaults, pedantic, warnings
854+
if !flag(signatureHelp)
855+
buildable: False
856+
exposed-modules: Ide.Plugin.SignatureHelp
857+
hs-source-dirs: plugins/hls-signature-help-plugin/src
858+
default-extensions:
859+
DerivingStrategies
860+
LambdaCase
861+
OverloadedStrings
862+
build-depends:
863+
, containers
864+
, ghcide == 2.11.0.0
865+
, hashable
866+
, hls-plugin-api == 2.11.0.0
867+
, haskell-language-server:hls-refactor-plugin
868+
, lens
869+
, lsp-types
870+
, mtl
871+
, text
872+
, transformers
873+
, unordered-containers
874+
, regex-tdfa
875+
876+
877+
-- test-suite hls-signature-help-plugin-tests
878+
-- import: defaults, pedantic, test-defaults, warnings
879+
-- if !flag(signatureHelp)
880+
-- buildable: False
881+
-- type: exitcode-stdio-1.0
882+
-- hs-source-dirs: plugins/hls-signature-help-plugin/test
883+
-- main-is: Main.hs
884+
-- build-depends:
885+
-- , haskell-language-server:hls-signature-help-plugin
886+
-- , hls-test-utils == 2.11.0.0
887+
-- , hls-plugin-api == 2.11.0.0
888+
837889
-----------------------------
838890
-- module name plugin
839891
-----------------------------
@@ -1846,6 +1898,7 @@ library
18461898
, retrie
18471899
, hlint
18481900
, stan
1901+
, signatureHelp
18491902
, moduleName
18501903
, pragmas
18511904
, splice

‎hls-plugin-api/src/Ide/Plugin/Config.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -72,6 +72,7 @@ parsePluginConfig def = A.withObject "PluginConfig" $ \o -> PluginConfig
7272
<*> o .:? "diagnosticsOn" .!= plcDiagnosticsOn def -- AZ
7373
<*> o .:? "hoverOn" .!= plcHoverOn def
7474
<*> o .:? "symbolsOn" .!= plcSymbolsOn def
75+
<*> o .:? "signatureHelpOn" .!= plcSignatureHelpOn def
7576
<*> o .:? "completionOn" .!= plcCompletionOn def
7677
<*> o .:? "renameOn" .!= plcRenameOn def
7778
<*> o .:? "selectionRangeOn" .!= plcSelectionRangeOn def

‎hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -104,6 +104,7 @@ pluginsToDefaultConfig IdePlugins {..} =
104104
SMethod_TextDocumentRename -> ["renameOn" A..= plcRenameOn]
105105
SMethod_TextDocumentHover -> ["hoverOn" A..= plcHoverOn]
106106
SMethod_TextDocumentDocumentSymbol -> ["symbolsOn" A..= plcSymbolsOn]
107+
SMethod_TextDocumentSignatureHelp -> ["signatureHelpOn" A..= plcSignatureHelpOn]
107108
SMethod_TextDocumentCompletion -> ["completionOn" A..= plcCompletionOn]
108109
SMethod_TextDocumentPrepareCallHierarchy -> ["callHierarchyOn" A..= plcCallHierarchyOn]
109110
SMethod_TextDocumentSemanticTokensFull -> ["semanticTokensOn" A..= plcSemanticTokensOn]
@@ -137,6 +138,7 @@ pluginsToVSCodeExtensionSchema IdePlugins {..} = A.object $ mconcat $ singlePlug
137138
SMethod_TextDocumentRename -> [toKey' "renameOn" A..= schemaEntry "rename" plcRenameOn]
138139
SMethod_TextDocumentHover -> [toKey' "hoverOn" A..= schemaEntry "hover" plcHoverOn]
139140
SMethod_TextDocumentDocumentSymbol -> [toKey' "symbolsOn" A..= schemaEntry "symbols" plcSymbolsOn]
141+
SMethod_TextDocumentSignatureHelp -> [toKey' "signatureHelpOn" A..= schemaEntry "signature help" plcSignatureHelpOn]
140142
SMethod_TextDocumentCompletion -> [toKey' "completionOn" A..= schemaEntry "completions" plcCompletionOn]
141143
SMethod_TextDocumentPrepareCallHierarchy -> [toKey' "callHierarchyOn" A..= schemaEntry "call hierarchy" plcCallHierarchyOn]
142144
SMethod_TextDocumentSemanticTokensFull -> [toKey' "semanticTokensOn" A..= schemaEntry "semantic tokens" plcSemanticTokensOn]

‎hls-plugin-api/src/Ide/Types.hs

Lines changed: 11 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -263,6 +263,7 @@ data PluginConfig =
263263
, plcDiagnosticsOn :: !Bool
264264
, plcHoverOn :: !Bool
265265
, plcSymbolsOn :: !Bool
266+
, plcSignatureHelpOn :: !Bool
266267
, plcCompletionOn :: !Bool
267268
, plcRenameOn :: !Bool
268269
, plcSelectionRangeOn :: !Bool
@@ -281,6 +282,7 @@ instance Default PluginConfig where
281282
, plcDiagnosticsOn = True
282283
, plcHoverOn = True
283284
, plcSymbolsOn = True
285+
, plcSignatureHelpOn = True
284286
, plcCompletionOn = True
285287
, plcRenameOn = True
286288
, plcSelectionRangeOn = True
@@ -290,7 +292,7 @@ instance Default PluginConfig where
290292
}
291293

292294
instance ToJSON PluginConfig where
293-
toJSON (PluginConfig g ch ca ih cl d h s c rn sr fr st cfg) = r
295+
toJSON (PluginConfig g ch ca ih cl d h s sh c rn sr fr st cfg) = r
294296
where
295297
r = object [ "globalOn" .= g
296298
, "callHierarchyOn" .= ch
@@ -300,6 +302,7 @@ instance ToJSON PluginConfig where
300302
, "diagnosticsOn" .= d
301303
, "hoverOn" .= h
302304
, "symbolsOn" .= s
305+
, "signatureHelpOn" .= sh
303306
, "completionOn" .= c
304307
, "renameOn" .= rn
305308
, "selectionRangeOn" .= sr
@@ -541,6 +544,9 @@ instance PluginMethod Request Method_TextDocumentHover where
541544
instance PluginMethod Request Method_TextDocumentDocumentSymbol where
542545
handlesRequest = pluginEnabledWithFeature plcSymbolsOn
543546

547+
instance PluginMethod Request Method_TextDocumentSignatureHelp where
548+
handlesRequest = pluginEnabledWithFeature plcSignatureHelpOn
549+
544550
instance PluginMethod Request Method_CompletionItemResolve where
545551
-- See Note [Resolve in PluginHandlers]
546552
handlesRequest = pluginEnabledResolve plcCompletionOn
@@ -764,6 +770,10 @@ instance PluginRequestMethod Method_TextDocumentDocumentSymbol where
764770
si = SymbolInformation name' (ds ^. L.kind) Nothing parent (ds ^. L.deprecated) loc
765771
in [si] <> children'
766772

773+
-- TODO(@linj) is this correct?
774+
instance PluginRequestMethod Method_TextDocumentSignatureHelp where
775+
combineResponses _ _ _ _ (x :| _) = x
776+
767777
instance PluginRequestMethod Method_CompletionItemResolve where
768778
-- A resolve request should only have one response.
769779
-- See Note [Resolve in PluginHandlers]

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

Lines changed: 83 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,83 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE DuplicateRecordFields #-}
3+
4+
module Ide.Plugin.SignatureHelp (descriptor) where
5+
6+
import Control.Monad.Trans (lift)
7+
import qualified Data.List.NonEmpty as NL
8+
import qualified Data.Text as T
9+
import Development.IDE
10+
import Development.IDE.Core.PluginUtils (runIdeActionE,
11+
useWithStaleFastE)
12+
import Development.IDE.Spans.AtPoint (getNamesAtPoint)
13+
import Ide.Plugin.Error
14+
import Ide.Types
15+
import Language.LSP.Protocol.Message
16+
import Language.LSP.Protocol.Types
17+
import Text.Regex.TDFA ((=~))
18+
19+
data Log = LogDummy
20+
21+
instance Pretty Log where
22+
pretty = \case
23+
LogDummy -> "TODO(@linj) remove this dummy log"
24+
25+
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
26+
descriptor _recorder pluginId =
27+
(defaultPluginDescriptor pluginId "Provides signature help of something callable")
28+
{ pluginHandlers = mkPluginHandler SMethod_TextDocumentSignatureHelp signatureHelpProvider
29+
}
30+
31+
-- get src info
32+
-- function
33+
-- which arg is under the cursor
34+
-- get function type (and arg doc)
35+
-- assemble result
36+
-- TODO(@linj)
37+
signatureHelpProvider :: PluginMethodHandler IdeState Method_TextDocumentSignatureHelp
38+
signatureHelpProvider ideState _pluginId (SignatureHelpParams (TextDocumentIdentifier uri) position _mProgreeToken _mContext) = do
39+
nfp <- getNormalizedFilePathE uri
40+
names <- runIdeActionE "signatureHelp" (shakeExtras ideState) $ do
41+
(HAR {hieAst}, positionMapping) <- useWithStaleFastE GetHieAst nfp
42+
let ns = getNamesAtPoint hieAst position positionMapping
43+
pure ns
44+
mRangeAndDoc <-
45+
runIdeActionE
46+
"signatureHelp.getDoc"
47+
(shakeExtras ideState)
48+
(lift (getAtPoint nfp position))
49+
let (_mRange, contents) = case mRangeAndDoc of
50+
Just (mRange, contents) -> (mRange, contents)
51+
Nothing -> (Nothing, [])
52+
53+
pure $
54+
InL $
55+
SignatureHelp
56+
( case mkSignatureHelpLabel names contents of
57+
Just label ->
58+
[ SignatureInformation
59+
label
60+
Nothing
61+
(Just [ParameterInformation (InR (5, 8)) Nothing])
62+
Nothing
63+
]
64+
Nothing -> []
65+
)
66+
(Just 0)
67+
(Just $ InL 0)
68+
where
69+
mkSignatureHelpLabel names types =
70+
case (chooseName $ printName <$> names, chooseType types >>= showType) of
71+
(Just name, Just typ) -> Just $ T.pack name <> " :: " <> typ
72+
_ -> Nothing
73+
chooseName names = case names of
74+
[] -> Nothing
75+
name : names' -> Just $ NL.last (name NL.:| names')
76+
chooseType types = case types of
77+
[] -> Nothing
78+
[t] -> Just t
79+
_ -> Just $ types !! (length types - 2)
80+
showType typ = getMatchedType $ typ =~ ("\n```haskell\n(.*) :: (.*)\n```\n" :: T.Text)
81+
getMatchedType :: (T.Text, T.Text, T.Text, [T.Text]) -> Maybe T.Text
82+
getMatchedType (_, _, _, [_, t]) = Just t
83+
getMatchedType _ = Nothing

‎src/HlsPlugins.hs

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -53,6 +53,10 @@ import qualified Ide.Plugin.Hlint as Hlint
5353
import qualified Ide.Plugin.Stan as Stan
5454
#endif
5555

56+
#if hls_signatureHelp
57+
import qualified Ide.Plugin.SignatureHelp as SignatureHelp
58+
#endif
59+
5660
#if hls_moduleName
5761
import qualified Ide.Plugin.ModuleName as ModuleName
5862
#endif
@@ -214,6 +218,9 @@ idePlugins recorder = pluginDescToIdePlugins allPlugins
214218
#if hls_stan
215219
let pId = "stan" in Stan.descriptor (pluginRecorder pId) pId :
216220
#endif
221+
#if hls_signatureHelp
222+
let pId = "signatureHelp" in SignatureHelp.descriptor (pluginRecorder pId) pId:
223+
#endif
217224
#if hls_splice
218225
Splice.descriptor "splice" :
219226
#endif
@@ -249,4 +256,3 @@ idePlugins recorder = pluginDescToIdePlugins allPlugins
249256
let pId = "notes" in Notes.descriptor (pluginRecorder pId) pId :
250257
#endif
251258
GhcIde.descriptors (pluginRecorder "ghcide")
252-

0 commit comments

Comments
 (0)