Skip to content

Implement signature help #4626

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
wants to merge 2 commits into
base: master
Choose a base branch
from
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
54 changes: 54 additions & 0 deletions haskell-language-server.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -834,6 +834,59 @@ test-suite hls-stan-plugin-tests
default-extensions:
OverloadedStrings

-----------------------------
-- signature help plugin
-----------------------------

flag signatureHelp
description: Enable signature help plugin
default: True
manual: True

common signatureHelp
if flag(signatureHelp)
build-depends: haskell-language-server:hls-signature-help-plugin
cpp-options: -Dhls_signatureHelp

-- TODO(@linj) remove unneeded deps
library hls-signature-help-plugin
import: defaults, pedantic, warnings
if !flag(signatureHelp)
buildable: False
exposed-modules: Ide.Plugin.SignatureHelp
hs-source-dirs: plugins/hls-signature-help-plugin/src
default-extensions:
DerivingStrategies
LambdaCase
OverloadedStrings
build-depends:
, containers
, ghc
, ghcide == 2.11.0.0
, hashable
, hls-plugin-api == 2.11.0.0
, haskell-language-server:hls-refactor-plugin
, lens
, lsp-types
, mtl
, text
, transformers
, unordered-containers
, regex-tdfa


-- test-suite hls-signature-help-plugin-tests
-- import: defaults, pedantic, test-defaults, warnings
-- if !flag(signatureHelp)
-- buildable: False
-- type: exitcode-stdio-1.0
-- hs-source-dirs: plugins/hls-signature-help-plugin/test
-- main-is: Main.hs
-- build-depends:
-- , haskell-language-server:hls-signature-help-plugin
-- , hls-test-utils == 2.11.0.0
-- , hls-plugin-api == 2.11.0.0

-----------------------------
-- module name plugin
-----------------------------
Expand Down Expand Up @@ -1846,6 +1899,7 @@ library
, retrie
, hlint
, stan
, signatureHelp
, moduleName
, pragmas
, splice
Expand Down
1 change: 1 addition & 0 deletions hls-plugin-api/src/Ide/Plugin/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -72,6 +72,7 @@ parsePluginConfig def = A.withObject "PluginConfig" $ \o -> PluginConfig
<*> o .:? "diagnosticsOn" .!= plcDiagnosticsOn def -- AZ
<*> o .:? "hoverOn" .!= plcHoverOn def
<*> o .:? "symbolsOn" .!= plcSymbolsOn def
<*> o .:? "signatureHelpOn" .!= plcSignatureHelpOn def
<*> o .:? "completionOn" .!= plcCompletionOn def
<*> o .:? "renameOn" .!= plcRenameOn def
<*> o .:? "selectionRangeOn" .!= plcSelectionRangeOn def
Expand Down
2 changes: 2 additions & 0 deletions hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -104,6 +104,7 @@ pluginsToDefaultConfig IdePlugins {..} =
SMethod_TextDocumentRename -> ["renameOn" A..= plcRenameOn]
SMethod_TextDocumentHover -> ["hoverOn" A..= plcHoverOn]
SMethod_TextDocumentDocumentSymbol -> ["symbolsOn" A..= plcSymbolsOn]
SMethod_TextDocumentSignatureHelp -> ["signatureHelpOn" A..= plcSignatureHelpOn]
SMethod_TextDocumentCompletion -> ["completionOn" A..= plcCompletionOn]
SMethod_TextDocumentPrepareCallHierarchy -> ["callHierarchyOn" A..= plcCallHierarchyOn]
SMethod_TextDocumentSemanticTokensFull -> ["semanticTokensOn" A..= plcSemanticTokensOn]
Expand Down Expand Up @@ -137,6 +138,7 @@ pluginsToVSCodeExtensionSchema IdePlugins {..} = A.object $ mconcat $ singlePlug
SMethod_TextDocumentRename -> [toKey' "renameOn" A..= schemaEntry "rename" plcRenameOn]
SMethod_TextDocumentHover -> [toKey' "hoverOn" A..= schemaEntry "hover" plcHoverOn]
SMethod_TextDocumentDocumentSymbol -> [toKey' "symbolsOn" A..= schemaEntry "symbols" plcSymbolsOn]
SMethod_TextDocumentSignatureHelp -> [toKey' "signatureHelpOn" A..= schemaEntry "signature help" plcSignatureHelpOn]
SMethod_TextDocumentCompletion -> [toKey' "completionOn" A..= schemaEntry "completions" plcCompletionOn]
SMethod_TextDocumentPrepareCallHierarchy -> [toKey' "callHierarchyOn" A..= schemaEntry "call hierarchy" plcCallHierarchyOn]
SMethod_TextDocumentSemanticTokensFull -> [toKey' "semanticTokensOn" A..= schemaEntry "semantic tokens" plcSemanticTokensOn]
Expand Down
12 changes: 11 additions & 1 deletion hls-plugin-api/src/Ide/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -263,6 +263,7 @@ data PluginConfig =
, plcDiagnosticsOn :: !Bool
, plcHoverOn :: !Bool
, plcSymbolsOn :: !Bool
, plcSignatureHelpOn :: !Bool
, plcCompletionOn :: !Bool
, plcRenameOn :: !Bool
, plcSelectionRangeOn :: !Bool
Expand All @@ -281,6 +282,7 @@ instance Default PluginConfig where
, plcDiagnosticsOn = True
, plcHoverOn = True
, plcSymbolsOn = True
, plcSignatureHelpOn = True
, plcCompletionOn = True
, plcRenameOn = True
, plcSelectionRangeOn = True
Expand All @@ -290,7 +292,7 @@ instance Default PluginConfig where
}

instance ToJSON PluginConfig where
toJSON (PluginConfig g ch ca ih cl d h s c rn sr fr st cfg) = r
toJSON (PluginConfig g ch ca ih cl d h s sh c rn sr fr st cfg) = r
where
r = object [ "globalOn" .= g
, "callHierarchyOn" .= ch
Expand All @@ -300,6 +302,7 @@ instance ToJSON PluginConfig where
, "diagnosticsOn" .= d
, "hoverOn" .= h
, "symbolsOn" .= s
, "signatureHelpOn" .= sh
, "completionOn" .= c
, "renameOn" .= rn
, "selectionRangeOn" .= sr
Expand Down Expand Up @@ -541,6 +544,9 @@ instance PluginMethod Request Method_TextDocumentHover where
instance PluginMethod Request Method_TextDocumentDocumentSymbol where
handlesRequest = pluginEnabledWithFeature plcSymbolsOn

instance PluginMethod Request Method_TextDocumentSignatureHelp where
handlesRequest = pluginEnabledWithFeature plcSignatureHelpOn

instance PluginMethod Request Method_CompletionItemResolve where
-- See Note [Resolve in PluginHandlers]
handlesRequest = pluginEnabledResolve plcCompletionOn
Expand Down Expand Up @@ -764,6 +770,10 @@ instance PluginRequestMethod Method_TextDocumentDocumentSymbol where
si = SymbolInformation name' (ds ^. L.kind) Nothing parent (ds ^. L.deprecated) loc
in [si] <> children'

-- TODO(@linj) is this correct?
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think this is reasonable. Really combineResponses should have a way to return an error. There are a bunch of methods where it really only makes sense if we have one handler.

We could try to combine responses: we would combine the signatures, and so long as only one of them indicated an active signature it would be okay. But that's a bit sketchy and I doubt we'll have several anyway!

instance PluginRequestMethod Method_TextDocumentSignatureHelp where
combineResponses _ _ _ _ (x :| _) = x

instance PluginRequestMethod Method_CompletionItemResolve where
-- A resolve request should only have one response.
-- See Note [Resolve in PluginHandlers]
Expand Down
208 changes: 208 additions & 0 deletions plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,208 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}

module Ide.Plugin.SignatureHelp (descriptor) where

import Control.Arrow ((>>>))
import Data.Bifunctor (bimap)
import qualified Data.Map.Strict as M
import Data.Maybe (mapMaybe)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Development.IDE (GetHieAst (GetHieAst),
HieAstResult (HAR, hieAst, hieKind),
HieKind (..),
IdeState (shakeExtras),
Pretty (pretty),
Recorder, WithPriority,
printOutputable)
import Development.IDE.Core.PluginUtils (runIdeActionE,
useWithStaleFastE)
import Development.IDE.Core.PositionMapping (fromCurrentPosition)
import Development.IDE.GHC.Compat (ContextInfo (Use),
FastStringCompat, HieAST,
HieASTs,
IdentifierDetails, Name,
RealSrcSpan, SDoc,
getAsts,
getSourceNodeIds,
hieTypeToIface,
hie_types, identInfo,
identType,
isAnnotationInNodeInfo,
mkRealSrcLoc,
mkRealSrcSpan,
nodeChildren, nodeSpan,
ppr, recoverFullType,
smallestContainingSatisfying,
sourceNodeInfo)
import Development.IDE.GHC.Compat.Util (LexicalFastString (LexicalFastString))
import GHC.Data.Maybe (rightToMaybe)
import GHC.Types.SrcLoc (isRealSubspanOf)
import Ide.Plugin.Error (getNormalizedFilePathE)
import Ide.Types (PluginDescriptor (pluginHandlers),
PluginId,
PluginMethodHandler,
defaultPluginDescriptor,
mkPluginHandler)
import Language.LSP.Protocol.Message (Method (Method_TextDocumentSignatureHelp),
SMethod (SMethod_TextDocumentSignatureHelp))
import Language.LSP.Protocol.Types (Null (Null),
ParameterInformation (ParameterInformation),
Position (Position),
SignatureHelp (SignatureHelp),
SignatureHelpParams (SignatureHelpParams),
SignatureInformation (SignatureInformation),
TextDocumentIdentifier (TextDocumentIdentifier),
UInt,
type (|?) (InL, InR))

data Log = LogDummy

instance Pretty Log where
pretty = \case
LogDummy -> "TODO(@linj) remove this dummy log"

descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor _recorder pluginId =
(defaultPluginDescriptor pluginId "Provides signature help of something callable")
{ Ide.Types.pluginHandlers = mkPluginHandler SMethod_TextDocumentSignatureHelp signatureHelpProvider
}

-- TODO(@linj) get doc
signatureHelpProvider :: PluginMethodHandler IdeState Method_TextDocumentSignatureHelp
signatureHelpProvider ideState _pluginId (SignatureHelpParams (TextDocumentIdentifier uri) position _mProgreeToken _mContext) = do
nfp <- getNormalizedFilePathE uri
mResult <- runIdeActionE "signatureHelp" (shakeExtras ideState) $ do
-- TODO(@linj) why HAR {hieAst} may have more than one AST?
(HAR {hieAst, hieKind}, positionMapping) <- useWithStaleFastE GetHieAst nfp
case fromCurrentPosition positionMapping position of
Nothing -> pure Nothing
Just oldPosition -> do
let functionName =
extractInfoFromSmallestContainingFunctionApplicationAst
oldPosition
hieAst
(\span -> getLeftMostNode >>> getNodeName span)
functionType =
extractInfoFromSmallestContainingFunctionApplicationAst
oldPosition
hieAst
(\span -> getLeftMostNode >>> getNodeType hieKind span)
argumentNumber =
extractInfoFromSmallestContainingFunctionApplicationAst
oldPosition
hieAst
getArgumentNumber
pure $ Just (functionName, functionType, argumentNumber)
case mResult of
-- TODO(@linj) what do non-singleton lists mean?
Just (functionName : _, functionType : _, argumentNumber : _) -> do
pure $ InL $ mkSignatureHelp functionName functionType (fromIntegral argumentNumber - 1)
_ -> pure $ InR Null

mkSignatureHelp :: Name -> Text -> UInt -> SignatureHelp
mkSignatureHelp functionName functionType argumentNumber =
let functionNameLabelPrefix = printOutputable (ppr functionName) <> " :: "
in SignatureHelp
[ SignatureInformation
(functionNameLabelPrefix <> functionType)
Nothing
(Just $ mkArguments (fromIntegral $ T.length functionNameLabelPrefix) functionType)
(Just $ InL argumentNumber)
]
(Just 0)
(Just $ InL argumentNumber)

-- TODO(@linj) can type string be a multi-line string?
mkArguments :: UInt -> Text -> [ParameterInformation]
mkArguments offset functionType =
let separator = " -> "
separatorLength = fromIntegral $ T.length separator
splits = T.breakOnAll separator functionType
prefixes = fst <$> splits
prefixLengths = fmap (T.length >>> fromIntegral) prefixes
ranges =
[ ( if previousPrefixLength == 0 then 0 else previousPrefixLength + separatorLength,
currentPrefixLength
)
| (previousPrefixLength, currentPrefixLength) <- zip (0: prefixLengths) prefixLengths
]
in [ ParameterInformation (InR range) Nothing
| range <- bimap (+offset) (+offset) <$> ranges
]

extractInfoFromSmallestContainingFunctionApplicationAst ::
Position -> HieASTs a -> (RealSrcSpan -> HieAST a -> Maybe b) -> [b]
extractInfoFromSmallestContainingFunctionApplicationAst position hieAsts extractInfo =
M.elems $ flip M.mapMaybeWithKey (getAsts hieAsts) $ \hiePath hieAst ->
smallestContainingSatisfying (positionToSpan hiePath position) (nodeHasAnnotation ("HsApp", "HsExpr")) hieAst
>>= extractInfo (positionToSpan hiePath position)
where
positionToSpan hiePath position =
let loc = mkLoc hiePath position in mkRealSrcSpan loc loc
mkLoc (LexicalFastString hiePath) (Position line character) =
mkRealSrcLoc hiePath (fromIntegral line + 1) (fromIntegral character + 1)

type Annotation = (FastStringCompat, FastStringCompat)

nodeHasAnnotation :: Annotation -> HieAST a -> Bool
nodeHasAnnotation annotation = sourceNodeInfo >>> maybe False (isAnnotationInNodeInfo annotation)

-- TODO(@linj): the left most node may not be the function node. example: (if True then f else g) x
getLeftMostNode :: HieAST a -> HieAST a
getLeftMostNode thisNode =
case nodeChildren thisNode of
[] -> thisNode
leftChild: _ -> getLeftMostNode leftChild

getNodeName :: RealSrcSpan -> HieAST a -> Maybe Name
getNodeName _span hieAst =
if nodeHasAnnotation ("HsVar", "HsExpr") hieAst
then
case mapMaybe extractName $ M.keys $ M.filter isUse $ getSourceNodeIds hieAst of
[name] -> Just name -- TODO(@linj) will there be more than one name?
_ -> Nothing
else Nothing -- TODO(@linj) must function node be HsVar?
where
extractName = rightToMaybe

-- TODO(@linj) share code with getNodeName
getNodeType :: HieKind a -> RealSrcSpan -> HieAST a -> Maybe Text
getNodeType (hieKind :: HieKind a) _span hieAst =
if nodeHasAnnotation ("HsVar", "HsExpr") hieAst
then
case M.elems $ M.filter isUse $ getSourceNodeIds hieAst of
[identifierDetails] -> identType identifierDetails >>= (prettyType >>> Just)
_ -> Nothing -- TODO(@linj) will there be more than one identifierDetails?
else Nothing
where
-- modified from Development.IDE.Spans.AtPoint.atPoint
prettyType :: a -> Text
prettyType = expandType >>> printOutputable

expandType :: a -> SDoc
expandType t = case hieKind of
HieFresh -> ppr t
HieFromDisk full_file -> ppr $ hieTypeToIface $ recoverFullType t (hie_types full_file)

isUse :: IdentifierDetails a -> Bool
isUse = identInfo >>> S.member Use

-- Just 1 means the first argument
getArgumentNumber :: RealSrcSpan -> HieAST a -> Maybe Integer
getArgumentNumber span hieAst =
if nodeHasAnnotation ("HsApp", "HsExpr") hieAst
then
case nodeChildren hieAst of
[leftChild, _] ->
if span `isRealSubspanOf` nodeSpan leftChild
then Nothing
else getArgumentNumber span leftChild >>= \argumentNumber -> Just (argumentNumber + 1)
_ -> Nothing -- impossible
else
case nodeChildren hieAst of
[] -> Just 0 -- the function is found
[child] -> getArgumentNumber span child -- ignore irrelevant nodes
_ -> Nothing -- TODO(@linj) handle more cases such as `if`
8 changes: 7 additions & 1 deletion src/HlsPlugins.hs
Original file line number Diff line number Diff line change
Expand Up @@ -53,6 +53,10 @@ import qualified Ide.Plugin.Hlint as Hlint
import qualified Ide.Plugin.Stan as Stan
#endif

#if hls_signatureHelp
import qualified Ide.Plugin.SignatureHelp as SignatureHelp
#endif

#if hls_moduleName
import qualified Ide.Plugin.ModuleName as ModuleName
#endif
Expand Down Expand Up @@ -214,6 +218,9 @@ idePlugins recorder = pluginDescToIdePlugins allPlugins
#if hls_stan
let pId = "stan" in Stan.descriptor (pluginRecorder pId) pId :
#endif
#if hls_signatureHelp
let pId = "signatureHelp" in SignatureHelp.descriptor (pluginRecorder pId) pId:
#endif
#if hls_splice
Splice.descriptor "splice" :
#endif
Expand Down Expand Up @@ -249,4 +256,3 @@ idePlugins recorder = pluginDescToIdePlugins allPlugins
let pId = "notes" in Notes.descriptor (pluginRecorder pId) pId :
#endif
GhcIde.descriptors (pluginRecorder "ghcide")

Loading