From 7a54a1dc5d5c360eb57a7c0f6e84f60349cf49ba Mon Sep 17 00:00:00 2001 From: Lin Jian Date: Mon, 9 Jun 2025 03:54:31 +0800 Subject: [PATCH 01/20] WIP: add basic boilerplate for signature help plugin --- ghcide/src/Development/IDE/Spans/AtPoint.hs | 5 +- haskell-language-server.cabal | 53 ++++++++++++ hls-plugin-api/src/Ide/Plugin/Config.hs | 1 + hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs | 2 + hls-plugin-api/src/Ide/Types.hs | 12 ++- .../src/Ide/Plugin/SignatureHelp.hs | 83 +++++++++++++++++++ src/HlsPlugins.hs | 8 +- 7 files changed, 161 insertions(+), 3 deletions(-) create mode 100644 plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index a577cae32e..88834579e2 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -574,7 +574,8 @@ pointCommand hf pos k = -- -- 'coerce' here to avoid an additional function for maintaining -- backwards compatibility. - case selectSmallestContaining (sp $ coerce fs) ast of + case smallestContainingSatisfying (sp $ coerce fs) isFunction ast of + -- case selectSmallestContaining (sp $ coerce fs) ast of Nothing -> Nothing Just ast' -> Just $ k ast' where @@ -583,6 +584,8 @@ pointCommand hf pos k = line :: UInt line = _line pos cha = _character pos + isFunction ast = not $ null $ flip M.mapMaybeWithKey (getSourcedNodeInfo $ sourcedNodeInfo ast) $ \_nodeOrigin (NodeInfo _nodeAnnotations _nodeType _nodeIdentifiers) -> + Just True -- In ghc9, nodeInfo is monomorphic, so we need a case split here nodeInfoH :: HieKind a -> HieAST a -> NodeInfo a diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index bfa4f40185..d3e991df41 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -834,6 +834,58 @@ 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 + , 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 ----------------------------- @@ -1846,6 +1898,7 @@ library , retrie , hlint , stan + , signatureHelp , moduleName , pragmas , splice diff --git a/hls-plugin-api/src/Ide/Plugin/Config.hs b/hls-plugin-api/src/Ide/Plugin/Config.hs index 4fee92c309..ecaf5f5d41 100644 --- a/hls-plugin-api/src/Ide/Plugin/Config.hs +++ b/hls-plugin-api/src/Ide/Plugin/Config.hs @@ -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 diff --git a/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs b/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs index a7350ab344..f352cc179d 100644 --- a/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs +++ b/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs @@ -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] @@ -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] diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 3a06656a77..662b424bf7 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -263,6 +263,7 @@ data PluginConfig = , plcDiagnosticsOn :: !Bool , plcHoverOn :: !Bool , plcSymbolsOn :: !Bool + , plcSignatureHelpOn :: !Bool , plcCompletionOn :: !Bool , plcRenameOn :: !Bool , plcSelectionRangeOn :: !Bool @@ -281,6 +282,7 @@ instance Default PluginConfig where , plcDiagnosticsOn = True , plcHoverOn = True , plcSymbolsOn = True + , plcSignatureHelpOn = True , plcCompletionOn = True , plcRenameOn = True , plcSelectionRangeOn = True @@ -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 @@ -300,6 +302,7 @@ instance ToJSON PluginConfig where , "diagnosticsOn" .= d , "hoverOn" .= h , "symbolsOn" .= s + , "signatureHelpOn" .= sh , "completionOn" .= c , "renameOn" .= rn , "selectionRangeOn" .= sr @@ -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 @@ -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? +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] diff --git a/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs b/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs new file mode 100644 index 0000000000..8e14e962e4 --- /dev/null +++ b/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} + +module Ide.Plugin.SignatureHelp (descriptor) where + +import Control.Monad.Trans (lift) +import qualified Data.List.NonEmpty as NL +import qualified Data.Text as T +import Development.IDE +import Development.IDE.Core.PluginUtils (runIdeActionE, + useWithStaleFastE) +import Development.IDE.Spans.AtPoint (getNamesAtPoint) +import Ide.Plugin.Error +import Ide.Types +import Language.LSP.Protocol.Message +import Language.LSP.Protocol.Types +import Text.Regex.TDFA ((=~)) + +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") + { pluginHandlers = mkPluginHandler SMethod_TextDocumentSignatureHelp signatureHelpProvider + } + +-- get src info +-- function +-- which arg is under the cursor +-- get function type (and arg doc) +-- assemble result +-- TODO(@linj) +signatureHelpProvider :: PluginMethodHandler IdeState Method_TextDocumentSignatureHelp +signatureHelpProvider ideState _pluginId (SignatureHelpParams (TextDocumentIdentifier uri) position _mProgreeToken _mContext) = do + nfp <- getNormalizedFilePathE uri + names <- runIdeActionE "signatureHelp" (shakeExtras ideState) $ do + (HAR {hieAst}, positionMapping) <- useWithStaleFastE GetHieAst nfp + let ns = getNamesAtPoint hieAst position positionMapping + pure ns + mRangeAndDoc <- + runIdeActionE + "signatureHelp.getDoc" + (shakeExtras ideState) + (lift (getAtPoint nfp position)) + let (_mRange, contents) = case mRangeAndDoc of + Just (mRange, contents) -> (mRange, contents) + Nothing -> (Nothing, []) + + pure $ + InL $ + SignatureHelp + ( case mkSignatureHelpLabel names contents of + Just label -> + [ SignatureInformation + label + Nothing + (Just [ParameterInformation (InR (5, 8)) Nothing]) + Nothing + ] + Nothing -> [] + ) + (Just 0) + (Just $ InL 0) + where + mkSignatureHelpLabel names types = + case (chooseName $ printName <$> names, chooseType types >>= showType) of + (Just name, Just typ) -> Just $ T.pack name <> " :: " <> typ + _ -> Nothing + chooseName names = case names of + [] -> Nothing + name : names' -> Just $ NL.last (name NL.:| names') + chooseType types = case types of + [] -> Nothing + [t] -> Just t + _ -> Just $ types !! (length types - 2) + showType typ = getMatchedType $ typ =~ ("\n```haskell\n(.*) :: (.*)\n```\n" :: T.Text) + getMatchedType :: (T.Text, T.Text, T.Text, [T.Text]) -> Maybe T.Text + getMatchedType (_, _, _, [_, t]) = Just t + getMatchedType _ = Nothing diff --git a/src/HlsPlugins.hs b/src/HlsPlugins.hs index 87a1af7392..ee416047b4 100644 --- a/src/HlsPlugins.hs +++ b/src/HlsPlugins.hs @@ -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 @@ -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 @@ -249,4 +256,3 @@ idePlugins recorder = pluginDescToIdePlugins allPlugins let pId = "notes" in Notes.descriptor (pluginRecorder pId) pId : #endif GhcIde.descriptors (pluginRecorder "ghcide") - From 9168b740867611439c0b030d1c07e209e8489ace Mon Sep 17 00:00:00 2001 From: Lin Jian Date: Thu, 10 Jul 2025 16:59:55 +0800 Subject: [PATCH 02/20] WIP: finish signature help plugin MVP TODO: - handle more cases - add successful and (currently failed) tests - show documentation --- ghcide/src/Development/IDE/Spans/AtPoint.hs | 5 +- haskell-language-server.cabal | 1 + .../src/Ide/Plugin/SignatureHelp.hs | 253 +++++++++++++----- 3 files changed, 191 insertions(+), 68 deletions(-) diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 88834579e2..a577cae32e 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -574,8 +574,7 @@ pointCommand hf pos k = -- -- 'coerce' here to avoid an additional function for maintaining -- backwards compatibility. - case smallestContainingSatisfying (sp $ coerce fs) isFunction ast of - -- case selectSmallestContaining (sp $ coerce fs) ast of + case selectSmallestContaining (sp $ coerce fs) ast of Nothing -> Nothing Just ast' -> Just $ k ast' where @@ -584,8 +583,6 @@ pointCommand hf pos k = line :: UInt line = _line pos cha = _character pos - isFunction ast = not $ null $ flip M.mapMaybeWithKey (getSourcedNodeInfo $ sourcedNodeInfo ast) $ \_nodeOrigin (NodeInfo _nodeAnnotations _nodeType _nodeIdentifiers) -> - Just True -- In ghc9, nodeInfo is monomorphic, so we need a case split here nodeInfoH :: HieKind a -> HieAST a -> NodeInfo a diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index d3e991df41..c441289b01 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -861,6 +861,7 @@ library hls-signature-help-plugin OverloadedStrings build-depends: , containers + , ghc , ghcide == 2.11.0.0 , hashable , hls-plugin-api == 2.11.0.0 diff --git a/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs b/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs index 8e14e962e4..78219950ad 100644 --- a/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs +++ b/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs @@ -1,20 +1,62 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} module Ide.Plugin.SignatureHelp (descriptor) where -import Control.Monad.Trans (lift) -import qualified Data.List.NonEmpty as NL -import qualified Data.Text as T -import Development.IDE -import Development.IDE.Core.PluginUtils (runIdeActionE, - useWithStaleFastE) -import Development.IDE.Spans.AtPoint (getNamesAtPoint) -import Ide.Plugin.Error -import Ide.Types -import Language.LSP.Protocol.Message -import Language.LSP.Protocol.Types -import Text.Regex.TDFA ((=~)) +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 @@ -25,59 +67,142 @@ instance Pretty Log where descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState descriptor _recorder pluginId = (defaultPluginDescriptor pluginId "Provides signature help of something callable") - { pluginHandlers = mkPluginHandler SMethod_TextDocumentSignatureHelp signatureHelpProvider + { Ide.Types.pluginHandlers = mkPluginHandler SMethod_TextDocumentSignatureHelp signatureHelpProvider } --- get src info --- function --- which arg is under the cursor --- get function type (and arg doc) --- assemble result --- TODO(@linj) +-- TODO(@linj) get doc signatureHelpProvider :: PluginMethodHandler IdeState Method_TextDocumentSignatureHelp signatureHelpProvider ideState _pluginId (SignatureHelpParams (TextDocumentIdentifier uri) position _mProgreeToken _mContext) = do nfp <- getNormalizedFilePathE uri - names <- runIdeActionE "signatureHelp" (shakeExtras ideState) $ do - (HAR {hieAst}, positionMapping) <- useWithStaleFastE GetHieAst nfp - let ns = getNamesAtPoint hieAst position positionMapping - pure ns - mRangeAndDoc <- - runIdeActionE - "signatureHelp.getDoc" - (shakeExtras ideState) - (lift (getAtPoint nfp position)) - let (_mRange, contents) = case mRangeAndDoc of - Just (mRange, contents) -> (mRange, contents) - Nothing -> (Nothing, []) - - pure $ - InL $ - SignatureHelp - ( case mkSignatureHelpLabel names contents of - Just label -> - [ SignatureInformation - label - Nothing - (Just [ParameterInformation (InR (5, 8)) Nothing]) - Nothing - ] - Nothing -> [] - ) - (Just 0) - (Just $ InL 0) + 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 - mkSignatureHelpLabel names types = - case (chooseName $ printName <$> names, chooseType types >>= showType) of - (Just name, Just typ) -> Just $ T.pack name <> " :: " <> typ - _ -> Nothing - chooseName names = case names of - [] -> Nothing - name : names' -> Just $ NL.last (name NL.:| names') - chooseType types = case types of - [] -> Nothing - [t] -> Just t - _ -> Just $ types !! (length types - 2) - showType typ = getMatchedType $ typ =~ ("\n```haskell\n(.*) :: (.*)\n```\n" :: T.Text) - getMatchedType :: (T.Text, T.Text, T.Text, [T.Text]) -> Maybe T.Text - getMatchedType (_, _, _, [_, t]) = Just t - getMatchedType _ = Nothing + 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 hieFile -> ppr $ hieTypeToIface $ recoverFullType t (hie_types hieFile) + +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` From 4d7fa57a80c7873bbf9c17d2ef374f6646eaf61f Mon Sep 17 00:00:00 2001 From: Lin Jian Date: Wed, 16 Jul 2025 12:13:14 +0800 Subject: [PATCH 03/20] WIP: remove unused dependencies --- haskell-language-server.cabal | 7 ------- 1 file changed, 7 deletions(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index c441289b01..b31b02f8c8 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -863,16 +863,9 @@ library hls-signature-help-plugin , 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 From 622c8ec65f3bccacf37338a3ccf096abae0b57b7 Mon Sep 17 00:00:00 2001 From: Lin Jian Date: Wed, 16 Jul 2025 13:49:40 +0800 Subject: [PATCH 04/20] WIP: fix func-tests --- test/testdata/schema/ghc910/default-config.golden.json | 3 +++ .../schema/ghc910/vscode-extension-schema.golden.json | 6 ++++++ test/testdata/schema/ghc912/default-config.golden.json | 3 +++ .../schema/ghc912/vscode-extension-schema.golden.json | 6 ++++++ test/testdata/schema/ghc96/default-config.golden.json | 3 +++ .../schema/ghc96/vscode-extension-schema.golden.json | 6 ++++++ test/testdata/schema/ghc98/default-config.golden.json | 3 +++ .../schema/ghc98/vscode-extension-schema.golden.json | 6 ++++++ 8 files changed, 36 insertions(+) diff --git a/test/testdata/schema/ghc910/default-config.golden.json b/test/testdata/schema/ghc910/default-config.golden.json index 3b4e687ef9..81b63dc6e4 100644 --- a/test/testdata/schema/ghc910/default-config.golden.json +++ b/test/testdata/schema/ghc910/default-config.golden.json @@ -150,6 +150,9 @@ }, "globalOn": false }, + "signatureHelp": { + "globalOn": true + }, "stan": { "globalOn": false } diff --git a/test/testdata/schema/ghc910/vscode-extension-schema.golden.json b/test/testdata/schema/ghc910/vscode-extension-schema.golden.json index 4ca08f296c..ba79ee22c7 100644 --- a/test/testdata/schema/ghc910/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc910/vscode-extension-schema.golden.json @@ -1037,6 +1037,12 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.signatureHelp.globalOn": { + "default": true, + "description": "Enables signatureHelp plugin", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.stan.globalOn": { "default": false, "description": "Enables stan plugin", diff --git a/test/testdata/schema/ghc912/default-config.golden.json b/test/testdata/schema/ghc912/default-config.golden.json index 0dfbd39df2..598e3a4f2e 100644 --- a/test/testdata/schema/ghc912/default-config.golden.json +++ b/test/testdata/schema/ghc912/default-config.golden.json @@ -149,6 +149,9 @@ "variableToken": "variable" }, "globalOn": false + }, + "signatureHelp": { + "globalOn": true } }, "sessionLoading": "singleComponent" diff --git a/test/testdata/schema/ghc912/vscode-extension-schema.golden.json b/test/testdata/schema/ghc912/vscode-extension-schema.golden.json index 77d398438e..68f1b4f800 100644 --- a/test/testdata/schema/ghc912/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc912/vscode-extension-schema.golden.json @@ -1036,5 +1036,11 @@ "description": "Enables semanticTokens plugin", "scope": "resource", "type": "boolean" + }, + "haskell.plugin.signatureHelp.globalOn": { + "default": true, + "description": "Enables signatureHelp plugin", + "scope": "resource", + "type": "boolean" } } diff --git a/test/testdata/schema/ghc96/default-config.golden.json b/test/testdata/schema/ghc96/default-config.golden.json index 8467b451f1..efe24df3ae 100644 --- a/test/testdata/schema/ghc96/default-config.golden.json +++ b/test/testdata/schema/ghc96/default-config.golden.json @@ -153,6 +153,9 @@ }, "globalOn": false }, + "signatureHelp": { + "globalOn": true + }, "splice": { "globalOn": true }, diff --git a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json index 1c0b19eb27..50ed005112 100644 --- a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json @@ -1043,6 +1043,12 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.signatureHelp.globalOn": { + "default": true, + "description": "Enables signatureHelp plugin", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.splice.globalOn": { "default": true, "description": "Enables splice plugin", diff --git a/test/testdata/schema/ghc98/default-config.golden.json b/test/testdata/schema/ghc98/default-config.golden.json index 8467b451f1..efe24df3ae 100644 --- a/test/testdata/schema/ghc98/default-config.golden.json +++ b/test/testdata/schema/ghc98/default-config.golden.json @@ -153,6 +153,9 @@ }, "globalOn": false }, + "signatureHelp": { + "globalOn": true + }, "splice": { "globalOn": true }, diff --git a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json index 1c0b19eb27..50ed005112 100644 --- a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json @@ -1043,6 +1043,12 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.signatureHelp.globalOn": { + "default": true, + "description": "Enables signatureHelp plugin", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.splice.globalOn": { "default": true, "description": "Enables splice plugin", From 62fbccf409c01e79ba96dd1dc853cf6d02ca5606 Mon Sep 17 00:00:00 2001 From: Lin Jian Date: Wed, 16 Jul 2025 12:14:27 +0800 Subject: [PATCH 05/20] WIP: add basic tests --- .github/workflows/test.yml | 4 + haskell-language-server.cabal | 27 ++- .../hls-signature-help-plugin/test/Main.hs | 209 ++++++++++++++++++ 3 files changed, 229 insertions(+), 11 deletions(-) create mode 100644 plugins/hls-signature-help-plugin/test/Main.hs diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 984758a310..b2870d3076 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -261,6 +261,10 @@ jobs: name: Compile the plugin-tutorial run: cabal build plugin-tutorial + - if: matrix.test + name: Test hls-signature-help-plugin test suite + run: cabal test hls-signature-help-plugin-tests || cabal test hls-signature-help-plugin-tests + test_post_job: if: always() runs-on: ubuntu-latest diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index b31b02f8c8..eb655a37cc 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -868,17 +868,22 @@ library hls-signature-help-plugin , text --- 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 +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: + , ghcide + , haskell-language-server:hls-signature-help-plugin + , hls-test-utils == 2.11.0.0 + , lens + , lsp-types + , text + default-extensions: + OverloadedStrings ----------------------------- -- module name plugin diff --git a/plugins/hls-signature-help-plugin/test/Main.hs b/plugins/hls-signature-help-plugin/test/Main.hs new file mode 100644 index 0000000000..4d7ecc2ee4 --- /dev/null +++ b/plugins/hls-signature-help-plugin/test/Main.hs @@ -0,0 +1,209 @@ +{-# LANGUAGE QuasiQuotes #-} + +import Control.Exception (throw) +import Control.Lens ((^.)) +import Data.Maybe (fromJust) +import Data.Text (Text) +import qualified Data.Text as T +import Development.IDE.Plugin.Completions.Types (PosPrefixInfo (PosPrefixInfo)) +import Ide.Plugin.SignatureHelp (descriptor) +import qualified Language.LSP.Protocol.Lens as L +import Test.Hls +import Test.Hls.FileSystem (VirtualFileTree, + directCradle, file, + mkVirtualFileTree, + text) + + +main :: IO () +main = + defaultTestRunner $ + testGroup + "signatureHelp" + [ mkTest + "1 parameter" + [trimming| + f :: Int -> Int + f = _ + x = f 1 + ^^^^^^^^ + |] + [ Nothing, + Nothing, + Nothing, + Nothing, + Nothing, + Just $ SignatureHelp [SignatureInformation "f :: Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), -- TODO(@linj) or Nothing? + Just $ SignatureHelp [SignatureInformation "f :: Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), + Nothing -- TODO(@linj) or highlight the last parameter? + ], + mkTest + "2 parameters" + [trimming| + f :: Int -> Int -> Int + f = _ + x = f 1 2 + ^ ^^^ + |] + [ Nothing, + Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), + Nothing, -- TODO(@linj) or highligt the first/second parameter? + Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1)) + ], + mkTest + "3 parameters" + [trimming| + f :: Int -> Int -> Int -> Int + f = _ + x = f 1 2 3 + ^ ^ ^ ^ + |] + [ Nothing, + Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing, ParameterInformation (InR (19,22)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), + Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing, ParameterInformation (InR (19,22)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1)), + Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing, ParameterInformation (InR (19,22)) Nothing]) (Just (InL 2))] (Just 0) (Just (InL 2)) + ], + mkTest + "parentheses" + [trimming| + f :: Int -> Int -> Int + f = _ + x = (f 1) 2 + ^^ ^^^^ + |] + [ Nothing, + Nothing, + Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), + Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), + Nothing, -- TODO(@linj) or the first/second parameter of f + Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1)) + ], + mkTest + "newline" + [trimming| + f :: Int -> Int -> Int + f = _ + x = + ( + ^ + f + ^ + 1 + ^ + ) + ^ + 2 + ^ + + ^ + |] + [ Nothing, + Nothing, + Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), + Nothing, + Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1)), + Nothing + ], + mkTest + "nested" + [trimming| + f :: Int -> Int -> Int + f = _ + g :: Int -> Int + g = _ + x = f (g 1) 2 + ^^^^ ^^^^ + |] + [ Nothing, + Nothing, + Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), + Nothing, + Just $ SignatureHelp [SignatureInformation "g :: Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), + Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), + Nothing, -- TODO(@linj) or the first/second parameter of f + Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1)) + ], + mkTest + "type constraint" + [trimming| + f :: (Num a) => a -> a -> a + f = _ + x = f 1 2 + ^ ^ ^ + |] + [ Nothing, + Just $ SignatureHelp [SignatureInformation "f :: forall a. Num a => a -> a -> a" Nothing (Just [ParameterInformation (InR (24,25)) Nothing, ParameterInformation (InR (29,30)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), + Just $ SignatureHelp [SignatureInformation "f :: forall a. Num a => a -> a -> a" Nothing (Just [ParameterInformation (InR (24,25)) Nothing, ParameterInformation (InR (29,30)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1)) + ], + mkTest + "dynamic function" + [trimming| + f :: Int -> Int -> Int + f = _ + g :: Int -> Int -> Int + g = _ + x = (if _ then f else g) 1 2 + ^^ ^^^ ^ ^^^ ^ ^^^^^^^^ + |] + (replicate 18 Nothing), + mkTest + "multi-line type" + [trimming| + f :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int + f = _ + x = f 1 + ^ ^ + |] + [ Nothing, + Just $ SignatureHelp [SignatureInformation "f :: Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int" Nothing Nothing (Just (InL 0))] (Just 0) (Just (InL 0)) -- TODO(@linj) write the correct ParameterInformation after figuring out how to calculate ranges when newline exists + ], + mkTest + "multi-line type with type constraint" + [trimming| + f :: Num abcdefghijklmn => abcdefghijklmn -> abcdefghijklmn -> abcdefghijklmn -> abcdefghijklmn -> abcdefghijklmn + f = _ + x = f 1 + ^ ^ + |] + [ Nothing, + Just $ SignatureHelp [SignatureInformation "f :: forall abcdefghijklmn.\nNum abcdefghijklmn =>\nabcdefghijklmn\n-> abcdefghijklmn\n-> abcdefghijklmn\n-> abcdefghijklmn\n-> abcdefghijklmn" Nothing Nothing (Just (InL 0))] (Just 0) (Just (InL 0)) -- TODO(@linj) write the correct ParameterInformation after figuring out how to calculate ranges when newline exists + ] + ] + +mkTest :: TestName -> Text -> [Maybe SignatureHelp] -> TestTree +mkTest name sourceCode expectedSignatureHelps = + parameterisedCursorTest + name + sourceCode + expectedSignatureHelps + getSignatureHelpFromSession + +getSignatureHelpFromSession :: Text -> PosPrefixInfo -> IO (Maybe SignatureHelp) +getSignatureHelpFromSession sourceCode (PosPrefixInfo _ _ _ position) = + let fileName = "A.hs" + plugin = mkPluginTestDescriptor descriptor "signatureHelp" + virtualFileTree = mkVirtualFileTreeWithSingleFile fileName sourceCode + in runSessionWithServerInTmpDir def plugin virtualFileTree $ do + doc <- openDoc fileName "haskell" + getSignatureHelp doc position + +mkVirtualFileTreeWithSingleFile :: FilePath -> Text -> VirtualFileTree +mkVirtualFileTreeWithSingleFile fileName sourceCode = + let testDataDir = "/not-used-dir" + in mkVirtualFileTree + testDataDir + [ directCradle [T.pack fileName], + file fileName (text sourceCode) + ] + +-- TODO(@linj) upstream it to lsp-test +-- | Returns the signature help at the specified position. +getSignatureHelp :: TextDocumentIdentifier -> Position -> Session (Maybe SignatureHelp) +getSignatureHelp doc pos = + let params = SignatureHelpParams doc pos Nothing Nothing + in nullToMaybe . getResponseResult <$> request SMethod_TextDocumentSignatureHelp params + where + getResponseResult rsp = + case rsp ^. L.result of + Right x -> x + Left err -> throw $ UnexpectedResponseError (fromJust $ rsp ^. L.id) err From a6635caca8328fa3b7e523e9e1a97a1241f57b86 Mon Sep 17 00:00:00 2001 From: Lin Jian Date: Fri, 25 Jul 2025 06:56:43 +0800 Subject: [PATCH 06/20] Change expected test results considering the cursor shape This is discussed with @fendor. --- plugins/hls-signature-help-plugin/test/Main.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/plugins/hls-signature-help-plugin/test/Main.hs b/plugins/hls-signature-help-plugin/test/Main.hs index 4d7ecc2ee4..2d1cae9a02 100644 --- a/plugins/hls-signature-help-plugin/test/Main.hs +++ b/plugins/hls-signature-help-plugin/test/Main.hs @@ -33,9 +33,9 @@ main = Nothing, Nothing, Nothing, - Just $ SignatureHelp [SignatureInformation "f :: Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), -- TODO(@linj) or Nothing? + Nothing, Just $ SignatureHelp [SignatureInformation "f :: Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), - Nothing -- TODO(@linj) or highlight the last parameter? + Just $ SignatureHelp [SignatureInformation "f :: Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) ], mkTest "2 parameters" @@ -47,7 +47,7 @@ main = |] [ Nothing, Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), - Nothing, -- TODO(@linj) or highligt the first/second parameter? + Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1)) ], mkTest @@ -75,7 +75,7 @@ main = Nothing, Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), - Nothing, -- TODO(@linj) or the first/second parameter of f + Nothing, Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1)) ], mkTest @@ -119,8 +119,8 @@ main = Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), Nothing, Just $ SignatureHelp [SignatureInformation "g :: Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), + Just $ SignatureHelp [SignatureInformation "g :: Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), - Nothing, -- TODO(@linj) or the first/second parameter of f Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1)) ], mkTest From bf0b4d529e9e4e616ed03255bf90b7a43bb636ab Mon Sep 17 00:00:00 2001 From: Lin Jian Date: Fri, 25 Jul 2025 07:17:41 +0800 Subject: [PATCH 07/20] Replace maybe with case for better readability --- .../hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs b/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs index 78219950ad..62c3728d4b 100644 --- a/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs +++ b/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs @@ -148,7 +148,9 @@ extractInfoFromSmallestContainingFunctionApplicationAst position hieAsts extract type Annotation = (FastStringCompat, FastStringCompat) nodeHasAnnotation :: Annotation -> HieAST a -> Bool -nodeHasAnnotation annotation = sourceNodeInfo >>> maybe False (isAnnotationInNodeInfo annotation) +nodeHasAnnotation annotation hieAst = case sourceNodeInfo hieAst of + Nothing -> False + Just nodeInfo -> isAnnotationInNodeInfo annotation nodeInfo -- 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 From c95d6e4cf364afd087c7672f077634ce8145e5c6 Mon Sep 17 00:00:00 2001 From: Lin Jian Date: Fri, 25 Jul 2025 08:34:34 +0800 Subject: [PATCH 08/20] Call extractInfoFromSmallestContainingFunctionApplicationAst once This improves performance. It also improves correctness because functionName, functionType and argumentNumber are extracted from the same AST. --- .../src/Ide/Plugin/SignatureHelp.hs | 37 ++++++++----------- 1 file changed, 16 insertions(+), 21 deletions(-) diff --git a/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs b/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs index 62c3728d4b..c3f643043f 100644 --- a/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs +++ b/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs @@ -74,31 +74,26 @@ descriptor _recorder pluginId = signatureHelpProvider :: PluginMethodHandler IdeState Method_TextDocumentSignatureHelp signatureHelpProvider ideState _pluginId (SignatureHelpParams (TextDocumentIdentifier uri) position _mProgreeToken _mContext) = do nfp <- getNormalizedFilePathE uri - mResult <- runIdeActionE "signatureHelp" (shakeExtras ideState) $ do + results <- 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 + Nothing -> pure [] 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 $ + extractInfoFromSmallestContainingFunctionApplicationAst + oldPosition + hieAst + ( \span hieAst -> do + let functionNode = getLeftMostNode hieAst + functionName <- getNodeName span functionNode + functionType <- getNodeType hieKind span functionNode + argumentNumber <- getArgumentNumber span hieAst + Just (functionName, functionType, argumentNumber) + ) + case results of + -- TODO(@linj) what does non-singleton list mean? + [(functionName, functionType, argumentNumber)] -> pure $ InL $ mkSignatureHelp functionName functionType (fromIntegral argumentNumber - 1) _ -> pure $ InR Null From 3dc1ec8d022960be28466efecf4a655d6454b587 Mon Sep 17 00:00:00 2001 From: Lin Jian Date: Sun, 3 Aug 2025 22:01:25 +0800 Subject: [PATCH 09/20] Add missing ParameterInformation for multi-line tests Vscode and Emacs(eglot) seems to treat newline as a normal char. --- plugins/hls-signature-help-plugin/test/Main.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/plugins/hls-signature-help-plugin/test/Main.hs b/plugins/hls-signature-help-plugin/test/Main.hs index 2d1cae9a02..121321b1a9 100644 --- a/plugins/hls-signature-help-plugin/test/Main.hs +++ b/plugins/hls-signature-help-plugin/test/Main.hs @@ -155,7 +155,7 @@ main = ^ ^ |] [ Nothing, - Just $ SignatureHelp [SignatureInformation "f :: Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int" Nothing Nothing (Just (InL 0))] (Just 0) (Just (InL 0)) -- TODO(@linj) write the correct ParameterInformation after figuring out how to calculate ranges when newline exists + Just $ SignatureHelp [SignatureInformation "f :: Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (13,16)) Nothing, ParameterInformation (InR (21,24)) Nothing, ParameterInformation (InR (29,32)) Nothing, ParameterInformation (InR (37,40)) Nothing, ParameterInformation (InR (45,48)) Nothing, ParameterInformation (InR (53,56)) Nothing, ParameterInformation (InR (61,64)) Nothing, ParameterInformation (InR (69,72)) Nothing, ParameterInformation (InR (77,80)) Nothing, ParameterInformation (InR (85,88)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) ], mkTest "multi-line type with type constraint" @@ -166,7 +166,7 @@ main = ^ ^ |] [ Nothing, - Just $ SignatureHelp [SignatureInformation "f :: forall abcdefghijklmn.\nNum abcdefghijklmn =>\nabcdefghijklmn\n-> abcdefghijklmn\n-> abcdefghijklmn\n-> abcdefghijklmn\n-> abcdefghijklmn" Nothing Nothing (Just (InL 0))] (Just 0) (Just (InL 0)) -- TODO(@linj) write the correct ParameterInformation after figuring out how to calculate ranges when newline exists + Just $ SignatureHelp [SignatureInformation "f :: forall abcdefghijklmn.\nNum abcdefghijklmn =>\nabcdefghijklmn\n-> abcdefghijklmn\n-> abcdefghijklmn\n-> abcdefghijklmn\n-> abcdefghijklmn" Nothing (Just [ParameterInformation (InR (52,66)) Nothing, ParameterInformation (InR (71,85)) Nothing, ParameterInformation (InR (90,104)) Nothing, ParameterInformation (InR (109,123)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Integer -> Integer -> Integer -> Integer -> Integer" Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR (16,23)) Nothing, ParameterInformation (InR (27,34)) Nothing, ParameterInformation (InR (38,45)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) ] ] From dca1311cf345d7ba9d79bc499fe906f0afad0a89 Mon Sep 17 00:00:00 2001 From: Lin Jian Date: Sat, 2 Aug 2025 22:32:46 +0800 Subject: [PATCH 10/20] Add a signature help test for type constraint with kind signatures --- plugins/hls-signature-help-plugin/test/Main.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/plugins/hls-signature-help-plugin/test/Main.hs b/plugins/hls-signature-help-plugin/test/Main.hs index 121321b1a9..0008051caa 100644 --- a/plugins/hls-signature-help-plugin/test/Main.hs +++ b/plugins/hls-signature-help-plugin/test/Main.hs @@ -135,6 +135,16 @@ main = Just $ SignatureHelp [SignatureInformation "f :: forall a. Num a => a -> a -> a" Nothing (Just [ParameterInformation (InR (24,25)) Nothing, ParameterInformation (InR (29,30)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), Just $ SignatureHelp [SignatureInformation "f :: forall a. Num a => a -> a -> a" Nothing (Just [ParameterInformation (InR (24,25)) Nothing, ParameterInformation (InR (29,30)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1)) ], + mkTest + "type constraint with kind signatures" + [trimming| + x :: IO Bool + x = pure True + ^ ^ + |] + [ Nothing, + Just $ SignatureHelp [SignatureInformation "pure :: forall (f :: Type -> Type) a. Applicative f => a -> f a" Nothing (Just [ParameterInformation (InR (55,56)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) + ], mkTest "dynamic function" [trimming| From 471958ffe18d278e9c76117cf32c4da6f3e2b6f3 Mon Sep 17 00:00:00 2001 From: Lin Jian Date: Sun, 3 Aug 2025 06:59:17 +0800 Subject: [PATCH 11/20] Add a signature help test for higher-order function --- plugins/hls-signature-help-plugin/test/Main.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/plugins/hls-signature-help-plugin/test/Main.hs b/plugins/hls-signature-help-plugin/test/Main.hs index 0008051caa..2136ce19a2 100644 --- a/plugins/hls-signature-help-plugin/test/Main.hs +++ b/plugins/hls-signature-help-plugin/test/Main.hs @@ -123,6 +123,17 @@ main = Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1)) ], + mkTest + "higher-order function" + [trimming| + f :: (Int -> Int) -> Int -> Int + f = _ + x = f (+ 1) 2 + ^ ^ + |] + [ Nothing, + Just $ SignatureHelp [SignatureInformation "f :: (Int -> Int) -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,17)) Nothing, ParameterInformation (InR (21,24)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) + ], mkTest "type constraint" [trimming| From d603ec4a3008983bf5f70e6ff63a30d9d8387c06 Mon Sep 17 00:00:00 2001 From: Lin Jian Date: Sun, 3 Aug 2025 21:15:35 +0800 Subject: [PATCH 12/20] Show more types: each type as one signature help --- .../src/Ide/Plugin/SignatureHelp.hs | 76 +++++++++++-------- .../hls-signature-help-plugin/test/Main.hs | 6 +- 2 files changed, 46 insertions(+), 36 deletions(-) diff --git a/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs b/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs index c3f643043f..0f522ca393 100644 --- a/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs +++ b/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs @@ -5,8 +5,8 @@ module Ide.Plugin.SignatureHelp (descriptor) where import Control.Arrow ((>>>)) import Data.Bifunctor (bimap) +import Data.Function ((&)) 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 @@ -34,10 +34,12 @@ import Development.IDE.GHC.Compat (ContextInfo (Use), mkRealSrcLoc, mkRealSrcSpan, nodeChildren, nodeSpan, - ppr, recoverFullType, + nodeType, ppr, + recoverFullType, smallestContainingSatisfying, sourceNodeInfo) import Development.IDE.GHC.Compat.Util (LexicalFastString (LexicalFastString)) +import GHC.Core.Map.Type (deBruijnize) import GHC.Data.Maybe (rightToMaybe) import GHC.Types.SrcLoc (isRealSubspanOf) import Ide.Plugin.Error (getNormalizedFilePathE) @@ -86,28 +88,30 @@ signatureHelpProvider ideState _pluginId (SignatureHelpParams (TextDocumentIdent hieAst ( \span hieAst -> do let functionNode = getLeftMostNode hieAst - functionName <- getNodeName span functionNode - functionType <- getNodeType hieKind span functionNode + (functionName, functionTypes) <- getNodeNameAndTypes hieKind functionNode argumentNumber <- getArgumentNumber span hieAst - Just (functionName, functionType, argumentNumber) + Just (functionName, functionTypes, argumentNumber) ) case results of -- TODO(@linj) what does non-singleton list mean? - [(functionName, functionType, argumentNumber)] -> - pure $ InL $ mkSignatureHelp functionName functionType (fromIntegral argumentNumber - 1) + [(functionName, functionTypes, argumentNumber)] -> + pure $ InL $ mkSignatureHelp (fromIntegral argumentNumber - 1) functionName functionTypes _ -> pure $ InR Null -mkSignatureHelp :: Name -> Text -> UInt -> SignatureHelp -mkSignatureHelp functionName functionType argumentNumber = +mkSignatureHelp :: UInt -> Name -> [Text] -> SignatureHelp +mkSignatureHelp argumentNumber functionName functionTypes = + SignatureHelp + (mkSignatureInformation argumentNumber functionName <$> functionTypes) + (Just 0) + (Just $ InL argumentNumber) + +mkSignatureInformation :: UInt -> Name -> Text -> SignatureInformation +mkSignatureInformation argumentNumber functionName functionType = let functionNameLabelPrefix = printOutputable (ppr functionName) <> " :: " - in SignatureHelp - [ SignatureInformation - (functionNameLabelPrefix <> functionType) - Nothing - (Just $ mkArguments (fromIntegral $ T.length functionNameLabelPrefix) functionType) - (Just $ InL argumentNumber) - ] - (Just 0) + in SignatureInformation + (functionNameLabelPrefix <> functionType) + Nothing + (Just $ mkArguments (fromIntegral $ T.length functionNameLabelPrefix) functionType) (Just $ InL argumentNumber) -- TODO(@linj) can type string be a multi-line string? @@ -154,27 +158,33 @@ getLeftMostNode thisNode = [] -> thisNode leftChild: _ -> getLeftMostNode leftChild -getNodeName :: RealSrcSpan -> HieAST a -> Maybe Name -getNodeName _span hieAst = +getNodeNameAndTypes :: forall a. HieKind a -> HieAST a -> Maybe (Name, [Text]) +getNodeNameAndTypes hieKind 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 + then case hieAst & getSourceNodeIds & M.filter isUse & M.assocs of + [(identifier, identifierDetails)] -> + case extractName identifier of + Nothing -> Nothing + Just name -> + let mTypeOfName = identType identifierDetails + typesOfNode = case sourceNodeInfo hieAst of + Nothing -> [] + Just nodeInfo -> nodeType nodeInfo + allTypes = case mTypeOfName of + Nothing -> typesOfNode + Just typeOfName -> typeOfName : filter (isDifferentType typeOfName) typesOfNode + in Just (name, prettyType <$> allTypes) + [] -> Nothing + _ -> Nothing -- seems impossible 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 + isDifferentType :: a -> a -> Bool + isDifferentType type1 type2 = case hieKind of + HieFresh -> deBruijnize type1 /= deBruijnize type2 + HieFromDisk _hieFile -> type1 /= type2 + -- modified from Development.IDE.Spans.AtPoint.atPoint prettyType :: a -> Text prettyType = expandType >>> printOutputable diff --git a/plugins/hls-signature-help-plugin/test/Main.hs b/plugins/hls-signature-help-plugin/test/Main.hs index 2136ce19a2..b18d43b66f 100644 --- a/plugins/hls-signature-help-plugin/test/Main.hs +++ b/plugins/hls-signature-help-plugin/test/Main.hs @@ -143,8 +143,8 @@ main = ^ ^ ^ |] [ Nothing, - Just $ SignatureHelp [SignatureInformation "f :: forall a. Num a => a -> a -> a" Nothing (Just [ParameterInformation (InR (24,25)) Nothing, ParameterInformation (InR (29,30)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), - Just $ SignatureHelp [SignatureInformation "f :: forall a. Num a => a -> a -> a" Nothing (Just [ParameterInformation (InR (24,25)) Nothing, ParameterInformation (InR (29,30)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1)) + Just $ SignatureHelp [SignatureInformation "f :: forall a. Num a => a -> a -> a" Nothing (Just [ParameterInformation (InR (24,25)) Nothing, ParameterInformation (InR (29,30)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Integer -> Integer -> Integer" Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR (16,23)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), + Just $ SignatureHelp [SignatureInformation "f :: forall a. Num a => a -> a -> a" Nothing (Just [ParameterInformation (InR (24,25)) Nothing, ParameterInformation (InR (29,30)) Nothing]) (Just (InL 1)), SignatureInformation "f :: Integer -> Integer -> Integer" Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR (16,23)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1)) ], mkTest "type constraint with kind signatures" @@ -154,7 +154,7 @@ main = ^ ^ |] [ Nothing, - Just $ SignatureHelp [SignatureInformation "pure :: forall (f :: Type -> Type) a. Applicative f => a -> f a" Nothing (Just [ParameterInformation (InR (55,56)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) + Just $ SignatureHelp [SignatureInformation "pure :: forall (f :: Type -> Type) a. Applicative f => a -> f a" Nothing (Just [ParameterInformation (InR (55,56)) Nothing]) (Just (InL 0)), SignatureInformation "pure :: Bool -> IO Bool" Nothing (Just [ParameterInformation (InR (8,12)) Nothing]) (Just (InL 0)), SignatureInformation "pure :: forall a. a -> IO a" Nothing (Just [ParameterInformation (InR (18,19)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) ], mkTest "dynamic function" From faa4e48107328b3355c3e0c62b11c6f978136334 Mon Sep 17 00:00:00 2001 From: Lin Jian Date: Mon, 4 Aug 2025 00:08:28 +0800 Subject: [PATCH 13/20] Adjust import for the removal of hie-compat (#4613) --- .../src/Ide/Plugin/SignatureHelp.hs | 24 +++++++++---------- 1 file changed, 11 insertions(+), 13 deletions(-) diff --git a/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs b/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs index 0f522ca393..8164859392 100644 --- a/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs +++ b/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs @@ -20,27 +20,25 @@ import Development.IDE (GetHieAst (GetHieAst), 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, +import Development.IDE.GHC.Compat (FastStringCompat, Name, RealSrcSpan, SDoc, - getAsts, getSourceNodeIds, - hieTypeToIface, - hie_types, identInfo, - identType, + hie_types, isAnnotationInNodeInfo, mkRealSrcLoc, - mkRealSrcSpan, - nodeChildren, nodeSpan, - nodeType, ppr, - recoverFullType, - smallestContainingSatisfying, + mkRealSrcSpan, ppr, sourceNodeInfo) import Development.IDE.GHC.Compat.Util (LexicalFastString (LexicalFastString)) import GHC.Core.Map.Type (deBruijnize) import GHC.Data.Maybe (rightToMaybe) +import GHC.Iface.Ext.Types (ContextInfo (Use), + HieAST (nodeChildren, nodeSpan), + HieASTs (getAsts), + IdentifierDetails (identInfo, identType), + nodeType) +import GHC.Iface.Ext.Utils (hieTypeToIface, + recoverFullType, + smallestContainingSatisfying) import GHC.Types.SrcLoc (isRealSubspanOf) import Ide.Plugin.Error (getNormalizedFilePathE) import Ide.Types (PluginDescriptor (pluginHandlers), From 9bea0e37a7a32c091d1f49a926ab65c69bee64f8 Mon Sep 17 00:00:00 2001 From: Lin Jian Date: Thu, 7 Aug 2025 16:01:51 +0800 Subject: [PATCH 14/20] Use structured type and type string to generate signature help See comment for a comparison with alternative methods. --- .../Development/IDE/GHC/Compat/Outputable.hs | 12 +- ghcide/src/Development/IDE/GHC/Util.hs | 11 +- .../src/Ide/Plugin/SignatureHelp.hs | 130 ++++++++++++------ .../hls-signature-help-plugin/test/Main.hs | 10 +- 4 files changed, 114 insertions(+), 49 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index ccec23c9c3..8414a7c8c3 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -9,6 +9,7 @@ module Development.IDE.GHC.Compat.Outputable ( ppr, pprPanic, text, vcat, (<+>), ($$), empty, hang, nest, punctuate, printSDocQualifiedUnsafe, printWithoutUniques, + printWithoutUniquesOneLine, mkPrintUnqualifiedDefault, PrintUnqualified, defaultUserStyle, @@ -27,6 +28,7 @@ module Development.IDE.GHC.Compat.Outputable ( pprMsgEnvelopeBagWithLoc, Error.getMessages, renderWithContext, + showSDocOneLine, defaultSDocContext, errMsgDiagnostic, unDecorated, @@ -76,8 +78,14 @@ type PrintUnqualified = NamePprCtx -- -- It print with a user-friendly style like: `a_a4ME` as `a`. printWithoutUniques :: Outputable a => a -> String -printWithoutUniques = - renderWithContext (defaultSDocContext +printWithoutUniques = printWithoutUniques' renderWithContext + +printWithoutUniquesOneLine :: Outputable a => a -> String +printWithoutUniquesOneLine = printWithoutUniques' showSDocOneLine + +printWithoutUniques' :: Outputable a => (SDocContext -> SDoc -> String) -> a -> String +printWithoutUniques' showSDoc = + showSDoc (defaultSDocContext { sdocStyle = defaultUserStyle , sdocSuppressUniques = True diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index fb051bda5a..9f1303c7cf 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Util.hs @@ -27,6 +27,7 @@ module Development.IDE.GHC.Util( dontWriteHieFiles, disableWarningsAsErrors, printOutputable, + printOutputableOneLine, getExtensions, stripOccNamePrefix, ) where @@ -264,11 +265,17 @@ ioe_dupHandlesNotCompatible h = -- 1. print with a user-friendly style: `a_a4ME` as `a`. -- 2. unescape escape sequences of printable unicode characters within a pair of double quotes printOutputable :: Outputable a => a -> T.Text -printOutputable = +printOutputable = printOutputable' printWithoutUniques + +printOutputableOneLine :: Outputable a => a -> T.Text +printOutputableOneLine = printOutputable' printWithoutUniquesOneLine + +printOutputable' :: Outputable a => (a -> String) -> a -> T.Text +printOutputable' print = -- IfaceTyLit from GHC.Iface.Type implements Outputable with 'show'. -- Showing a String escapes non-ascii printable characters. We unescape it here. -- More discussion at https://github.com/haskell/haskell-language-server/issues/3115. - unescape . T.pack . printWithoutUniques + unescape . T.pack . print {-# INLINE printOutputable #-} getExtensions :: ParsedModule -> [Extension] diff --git a/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs b/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs index 8164859392..87b7db0405 100644 --- a/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs +++ b/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs @@ -16,29 +16,29 @@ import Development.IDE (GetHieAst (GetHieAst), IdeState (shakeExtras), Pretty (pretty), Recorder, WithPriority, - printOutputable) + printOutputableOneLine) import Development.IDE.Core.PluginUtils (runIdeActionE, useWithStaleFastE) import Development.IDE.Core.PositionMapping (fromCurrentPosition) import Development.IDE.GHC.Compat (FastStringCompat, Name, - RealSrcSpan, SDoc, + RealSrcSpan, getSourceNodeIds, - hie_types, isAnnotationInNodeInfo, mkRealSrcLoc, mkRealSrcSpan, ppr, sourceNodeInfo) import Development.IDE.GHC.Compat.Util (LexicalFastString (LexicalFastString)) import GHC.Core.Map.Type (deBruijnize) +import GHC.Core.Type (FunTyFlag (FTF_T_T), + Type, dropForAlls, + splitFunTy_maybe) import GHC.Data.Maybe (rightToMaybe) import GHC.Iface.Ext.Types (ContextInfo (Use), HieAST (nodeChildren, nodeSpan), HieASTs (getAsts), IdentifierDetails (identInfo, identType), nodeType) -import GHC.Iface.Ext.Utils (hieTypeToIface, - recoverFullType, - smallestContainingSatisfying) +import GHC.Iface.Ext.Utils (smallestContainingSatisfying) import GHC.Types.SrcLoc (isRealSubspanOf) import Ide.Plugin.Error (getNormalizedFilePathE) import Ide.Types (PluginDescriptor (pluginHandlers), @@ -91,44 +91,99 @@ signatureHelpProvider ideState _pluginId (SignatureHelpParams (TextDocumentIdent Just (functionName, functionTypes, argumentNumber) ) case results of - -- TODO(@linj) what does non-singleton list mean? + [(_functionName, [], _argumentNumber)] -> pure $ InR Null [(functionName, functionTypes, argumentNumber)] -> pure $ InL $ mkSignatureHelp (fromIntegral argumentNumber - 1) functionName functionTypes + -- TODO(@linj) what does non-singleton list mean? _ -> pure $ InR Null -mkSignatureHelp :: UInt -> Name -> [Text] -> SignatureHelp +mkSignatureHelp :: UInt -> Name -> [Type] -> SignatureHelp mkSignatureHelp argumentNumber functionName functionTypes = SignatureHelp (mkSignatureInformation argumentNumber functionName <$> functionTypes) (Just 0) (Just $ InL argumentNumber) -mkSignatureInformation :: UInt -> Name -> Text -> SignatureInformation +mkSignatureInformation :: UInt -> Name -> Type -> SignatureInformation mkSignatureInformation argumentNumber functionName functionType = - let functionNameLabelPrefix = printOutputable (ppr functionName) <> " :: " + let functionNameLabelPrefix = printOutputableOneLine (ppr functionName) <> " :: " in SignatureInformation - (functionNameLabelPrefix <> functionType) + (functionNameLabelPrefix <> printOutputableOneLine functionType) Nothing (Just $ mkArguments (fromIntegral $ T.length functionNameLabelPrefix) functionType) (Just $ InL argumentNumber) --- TODO(@linj) can type string be a multi-line string? -mkArguments :: UInt -> Text -> [ParameterInformation] +mkArguments :: UInt -> Type -> [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 - ] + [ ParameterInformation (InR range) Nothing + | range <- bimap (+offset) (+offset) <$> findArgumentRanges functionType + ] + +findArgumentRanges :: Type -> [(UInt, UInt)] +findArgumentRanges functionType = + let functionTypeString = printOutputableOneLine functionType + functionTypeStringLength = fromIntegral $ T.length functionTypeString + splitFunctionTypes = filter notTypeConstraint $ splitFunTysIgnoringForAll functionType + splitFunctionTypeStrings = printOutputableOneLine . fst <$> splitFunctionTypes + -- reverse to avoid matching "a" of "forall a" in "forall a. a -> a" + reversedRanges = + drop 1 $ -- do not need the range of the result (last) type + findArgumentStringRanges + 0 + (T.reverse functionTypeString) + (T.reverse <$> reverse splitFunctionTypeStrings) + in reverse $ modifyRange functionTypeStringLength <$> reversedRanges + where + modifyRange functionTypeStringLength (start, end) = + (functionTypeStringLength - end, functionTypeStringLength - start) + +{- +The implemented method uses both structured type and unstructured type string. +It provides good enough results and is easier to implement than alternative +method 1 or 2. + +Alternative method 1: use only structured type +This method is hard to implement because we need to duplicate some logic of 'ppr' for 'Type'. +Some tricky cases are as follows: +- 'Eq a => Num b -> c' is shown as '(Eq a, Numb) => c' +- 'forall' can appear anywhere in a type when RankNTypes is enabled + f :: forall a. Maybe a -> forall b. (a, b) -> b +- '=>' can appear anywhere in a type + g :: forall a b. Eq a => a -> Num b => b -> b +- ppr the first argument type of '(a -> b) -> a -> b' is 'a -> b' (no parentheses) +- 'forall' is not always shown + +Alternative method 2: use only unstructured type string +This method is hard to implement because we need to parse the type string. +Some tricky cases are as follows: +- h :: forall a (m :: Type -> Type). Monad m => a -> m a +-} +findArgumentStringRanges :: UInt -> Text -> [Text] -> [(UInt, UInt)] +findArgumentStringRanges _totalPrefixLength _functionTypeString [] = [] +findArgumentStringRanges totalPrefixLength functionTypeString (argumentTypeString:restArgumentTypeStrings) = + let (prefix, match) = T.breakOn argumentTypeString functionTypeString + prefixLength = fromIntegral $ T.length prefix + argumentTypeStringLength = fromIntegral $ T.length argumentTypeString + start = totalPrefixLength + prefixLength + in (start, start + argumentTypeStringLength) + : findArgumentStringRanges + (totalPrefixLength + prefixLength + argumentTypeStringLength) + (T.drop (fromIntegral argumentTypeStringLength) match) + restArgumentTypeStrings + +-- similar to 'splitFunTys' but +-- 1) the result (last) type is included and +-- 2) toplevel foralls are ignored +splitFunTysIgnoringForAll :: Type -> [(Type, Maybe FunTyFlag)] +splitFunTysIgnoringForAll ty = case ty & dropForAlls & splitFunTy_maybe of + Just (funTyFlag, _mult, argumentType, resultType) -> + (argumentType, Just funTyFlag) : splitFunTysIgnoringForAll resultType + Nothing -> [(ty, Nothing)] + +notTypeConstraint :: (Type, Maybe FunTyFlag) -> Bool +notTypeConstraint (_type, Just FTF_T_T) = True +notTypeConstraint (_type, Nothing) = True +notTypeConstraint _ = False extractInfoFromSmallestContainingFunctionApplicationAst :: Position -> HieASTs a -> (RealSrcSpan -> HieAST a -> Maybe b) -> [b] @@ -156,7 +211,7 @@ getLeftMostNode thisNode = [] -> thisNode leftChild: _ -> getLeftMostNode leftChild -getNodeNameAndTypes :: forall a. HieKind a -> HieAST a -> Maybe (Name, [Text]) +getNodeNameAndTypes :: HieKind a -> HieAST a -> Maybe (Name, [Type]) getNodeNameAndTypes hieKind hieAst = if nodeHasAnnotation ("HsVar", "HsExpr") hieAst then case hieAst & getSourceNodeIds & M.filter isUse & M.assocs of @@ -171,26 +226,21 @@ getNodeNameAndTypes hieKind hieAst = allTypes = case mTypeOfName of Nothing -> typesOfNode Just typeOfName -> typeOfName : filter (isDifferentType typeOfName) typesOfNode - in Just (name, prettyType <$> allTypes) + in Just (name, filterCoreTypes allTypes) [] -> Nothing _ -> Nothing -- seems impossible else Nothing -- TODO(@linj) must function node be HsVar? where extractName = rightToMaybe - isDifferentType :: a -> a -> Bool isDifferentType type1 type2 = case hieKind of - HieFresh -> deBruijnize type1 /= deBruijnize type2 - HieFromDisk _hieFile -> type1 /= type2 - - -- modified from Development.IDE.Spans.AtPoint.atPoint - prettyType :: a -> Text - prettyType = expandType >>> printOutputable + HieFresh -> deBruijnize type1 /= deBruijnize type2 + HieFromDisk {} -> type1 /= type2 - expandType :: a -> SDoc - expandType t = case hieKind of - HieFresh -> ppr t - HieFromDisk hieFile -> ppr $ hieTypeToIface $ recoverFullType t (hie_types hieFile) + filterCoreTypes types = case hieKind of + HieFresh -> types + -- ignore this case since this only happens before we finish startup + HieFromDisk {} -> [] isUse :: IdentifierDetails a -> Bool isUse = identInfo >>> S.member Use diff --git a/plugins/hls-signature-help-plugin/test/Main.hs b/plugins/hls-signature-help-plugin/test/Main.hs index b18d43b66f..af2c667a48 100644 --- a/plugins/hls-signature-help-plugin/test/Main.hs +++ b/plugins/hls-signature-help-plugin/test/Main.hs @@ -132,7 +132,7 @@ main = ^ ^ |] [ Nothing, - Just $ SignatureHelp [SignatureInformation "f :: (Int -> Int) -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,17)) Nothing, ParameterInformation (InR (21,24)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) + Just $ SignatureHelp [SignatureInformation "f :: (Int -> Int) -> Int -> Int" Nothing (Just [ParameterInformation (InR (6,16)) Nothing, ParameterInformation (InR (21,24)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) ], mkTest "type constraint" @@ -168,7 +168,7 @@ main = |] (replicate 18 Nothing), mkTest - "multi-line type" + "very long type" [trimming| f :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int f = _ @@ -176,10 +176,10 @@ main = ^ ^ |] [ Nothing, - Just $ SignatureHelp [SignatureInformation "f :: Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int\n-> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (13,16)) Nothing, ParameterInformation (InR (21,24)) Nothing, ParameterInformation (InR (29,32)) Nothing, ParameterInformation (InR (37,40)) Nothing, ParameterInformation (InR (45,48)) Nothing, ParameterInformation (InR (53,56)) Nothing, ParameterInformation (InR (61,64)) Nothing, ParameterInformation (InR (69,72)) Nothing, ParameterInformation (InR (77,80)) Nothing, ParameterInformation (InR (85,88)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) + Just $ SignatureHelp [SignatureInformation "f :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing, ParameterInformation (InR (12,15)) Nothing, ParameterInformation (InR (19,22)) Nothing, ParameterInformation (InR (26,29)) Nothing, ParameterInformation (InR (33,36)) Nothing, ParameterInformation (InR (40,43)) Nothing, ParameterInformation (InR (47,50)) Nothing, ParameterInformation (InR (54,57)) Nothing, ParameterInformation (InR (61,64)) Nothing, ParameterInformation (InR (68,71)) Nothing, ParameterInformation (InR (75,78)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) ], mkTest - "multi-line type with type constraint" + "very long type with type constraint" [trimming| f :: Num abcdefghijklmn => abcdefghijklmn -> abcdefghijklmn -> abcdefghijklmn -> abcdefghijklmn -> abcdefghijklmn f = _ @@ -187,7 +187,7 @@ main = ^ ^ |] [ Nothing, - Just $ SignatureHelp [SignatureInformation "f :: forall abcdefghijklmn.\nNum abcdefghijklmn =>\nabcdefghijklmn\n-> abcdefghijklmn\n-> abcdefghijklmn\n-> abcdefghijklmn\n-> abcdefghijklmn" Nothing (Just [ParameterInformation (InR (52,66)) Nothing, ParameterInformation (InR (71,85)) Nothing, ParameterInformation (InR (90,104)) Nothing, ParameterInformation (InR (109,123)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Integer -> Integer -> Integer -> Integer -> Integer" Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR (16,23)) Nothing, ParameterInformation (InR (27,34)) Nothing, ParameterInformation (InR (38,45)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) + Just $ SignatureHelp [SignatureInformation "f :: forall abcdefghijklmn. Num abcdefghijklmn => abcdefghijklmn -> abcdefghijklmn -> abcdefghijklmn -> abcdefghijklmn -> abcdefghijklmn" Nothing (Just [ParameterInformation (InR (50,64)) Nothing, ParameterInformation (InR (68,82)) Nothing, ParameterInformation (InR (86,100)) Nothing, ParameterInformation (InR (104,118)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Integer -> Integer -> Integer -> Integer -> Integer" Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR (16,23)) Nothing, ParameterInformation (InR (27,34)) Nothing, ParameterInformation (InR (38,45)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) ] ] From db5e59ef8612af829c00b2df44bbfff24218ff0c Mon Sep 17 00:00:00 2001 From: Lin Jian Date: Thu, 7 Aug 2025 19:17:16 +0800 Subject: [PATCH 15/20] Add signature help test: 2 type constraints --- plugins/hls-signature-help-plugin/test/Main.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/plugins/hls-signature-help-plugin/test/Main.hs b/plugins/hls-signature-help-plugin/test/Main.hs index af2c667a48..4c12646d97 100644 --- a/plugins/hls-signature-help-plugin/test/Main.hs +++ b/plugins/hls-signature-help-plugin/test/Main.hs @@ -156,6 +156,17 @@ main = [ Nothing, Just $ SignatureHelp [SignatureInformation "pure :: forall (f :: Type -> Type) a. Applicative f => a -> f a" Nothing (Just [ParameterInformation (InR (55,56)) Nothing]) (Just (InL 0)), SignatureInformation "pure :: Bool -> IO Bool" Nothing (Just [ParameterInformation (InR (8,12)) Nothing]) (Just (InL 0)), SignatureInformation "pure :: forall a. a -> IO a" Nothing (Just [ParameterInformation (InR (18,19)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) ], + mkTest + "2 type constraints" + [trimming| + f :: forall a. (Eq a, Num a) => a -> a -> a + f = _ + x = f True + ^ ^ + |] + [ Nothing, + Just $ SignatureHelp [SignatureInformation "f :: forall a. (Eq a, Num a) => a -> a -> a" Nothing (Just [ParameterInformation (InR (32,33)) Nothing, ParameterInformation (InR (37,38)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Bool -> Bool -> Bool" Nothing (Just [ParameterInformation (InR (5,9)) Nothing, ParameterInformation (InR (13,17)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) + ], mkTest "dynamic function" [trimming| From fdd5acd4c1e28dfb29c7bfea0f356548c7e7a118 Mon Sep 17 00:00:00 2001 From: Lin Jian Date: Thu, 7 Aug 2025 19:38:49 +0800 Subject: [PATCH 16/20] Add signature help test: middle => Test 5 does not pass. --- plugins/hls-signature-help-plugin/test/Main.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/plugins/hls-signature-help-plugin/test/Main.hs b/plugins/hls-signature-help-plugin/test/Main.hs index 4c12646d97..b417755542 100644 --- a/plugins/hls-signature-help-plugin/test/Main.hs +++ b/plugins/hls-signature-help-plugin/test/Main.hs @@ -199,6 +199,24 @@ main = |] [ Nothing, Just $ SignatureHelp [SignatureInformation "f :: forall abcdefghijklmn. Num abcdefghijklmn => abcdefghijklmn -> abcdefghijklmn -> abcdefghijklmn -> abcdefghijklmn -> abcdefghijklmn" Nothing (Just [ParameterInformation (InR (50,64)) Nothing, ParameterInformation (InR (68,82)) Nothing, ParameterInformation (InR (86,100)) Nothing, ParameterInformation (InR (104,118)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Integer -> Integer -> Integer -> Integer -> Integer" Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR (16,23)) Nothing, ParameterInformation (InR (27,34)) Nothing, ParameterInformation (InR (38,45)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) + ], + mkTest + "middle =>" + [trimming| + f :: Eq a => a -> Num b => b -> b + f = _ + x = f 1 True + ^ ^ ^ + y = f True + ^ + z = f 1 + ^ + |] + [ Nothing, + Just $ SignatureHelp [SignatureInformation "f :: forall a b. Eq a => a -> Num b => b -> b" Nothing (Just [ParameterInformation (InR (25,26)) Nothing, ParameterInformation (InR (39,40)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Integer -> Num Bool => Bool -> Bool" Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR (28,32)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), + Just $ SignatureHelp [SignatureInformation "f :: forall a b. Eq a => a -> Num b => b -> b" Nothing (Just [ParameterInformation (InR (25,26)) Nothing, ParameterInformation (InR (39,40)) Nothing]) (Just (InL 1)), SignatureInformation "f :: Integer -> Num Bool => Bool -> Bool" Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR (28,32)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1)), + Just $ SignatureHelp [SignatureInformation "f :: forall a b. Eq a => a -> Num b => b -> b" Nothing (Just [ParameterInformation (InR (25,26)) Nothing, ParameterInformation (InR (39,40)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Bool -> Num Integer => Integer -> Integer" Nothing (Just [ParameterInformation (InR (5,9)) Nothing, ParameterInformation (InR (28,35)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), + Just $ SignatureHelp [SignatureInformation "f :: forall a b. Eq a => a -> Num b => b -> b" Nothing (Just [ParameterInformation (InR (25,26)) Nothing, ParameterInformation (InR (39,40)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Integer -> Num Integer => Integer -> Integer" Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR (31,38)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) ] ] From c6ece42acc555eeba7fcd000684e51bca8852821 Mon Sep 17 00:00:00 2001 From: Lin Jian Date: Thu, 7 Aug 2025 19:49:27 +0800 Subject: [PATCH 17/20] Add signature help test: => in argument --- plugins/hls-signature-help-plugin/test/Main.hs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/plugins/hls-signature-help-plugin/test/Main.hs b/plugins/hls-signature-help-plugin/test/Main.hs index b417755542..63ee87e770 100644 --- a/plugins/hls-signature-help-plugin/test/Main.hs +++ b/plugins/hls-signature-help-plugin/test/Main.hs @@ -217,6 +217,21 @@ main = Just $ SignatureHelp [SignatureInformation "f :: forall a b. Eq a => a -> Num b => b -> b" Nothing (Just [ParameterInformation (InR (25,26)) Nothing, ParameterInformation (InR (39,40)) Nothing]) (Just (InL 1)), SignatureInformation "f :: Integer -> Num Bool => Bool -> Bool" Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR (28,32)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1)), Just $ SignatureHelp [SignatureInformation "f :: forall a b. Eq a => a -> Num b => b -> b" Nothing (Just [ParameterInformation (InR (25,26)) Nothing, ParameterInformation (InR (39,40)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Bool -> Num Integer => Integer -> Integer" Nothing (Just [ParameterInformation (InR (5,9)) Nothing, ParameterInformation (InR (28,35)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), Just $ SignatureHelp [SignatureInformation "f :: forall a b. Eq a => a -> Num b => b -> b" Nothing (Just [ParameterInformation (InR (25,26)) Nothing, ParameterInformation (InR (39,40)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Integer -> Num Integer => Integer -> Integer" Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR (31,38)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) + ], + mkTest + "=> in argument" + [trimming| + f :: Eq a => a -> (Num b => b -> b) -> a + f = _ + x = f 1 + ^ ^ + y = f 1 negate + ^ ^ + |] + [ Nothing, + Just $ SignatureHelp [SignatureInformation "f :: forall a b. Eq a => a -> (Num b => b -> b) -> a" Nothing (Just [ParameterInformation (InR (25,26)) Nothing, ParameterInformation (InR (31,46)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Integer -> (Num b => b -> b) -> Integer" Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR (17,32)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), + Just $ SignatureHelp [SignatureInformation "f :: forall a b. Eq a => a -> (Num b => b -> b) -> a" Nothing (Just [ParameterInformation (InR (25,26)) Nothing, ParameterInformation (InR (31,46)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Integer -> (Num Any => Any -> Any) -> Integer" Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR (17,38)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), + Just $ SignatureHelp [SignatureInformation "f :: forall a b. Eq a => a -> (Num b => b -> b) -> a" Nothing (Just [ParameterInformation (InR (25,26)) Nothing, ParameterInformation (InR (31,46)) Nothing]) (Just (InL 1)), SignatureInformation "f :: Integer -> (Num Any => Any -> Any) -> Integer" Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR (17,38)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1)) ] ] From fe2d61822df27e364e86374c228fc5c75c0e6147 Mon Sep 17 00:00:00 2001 From: Lin Jian Date: Fri, 8 Aug 2025 02:00:00 +0800 Subject: [PATCH 18/20] Add 2 signature help tests: RankNTypes(forall in middle) --- .../hls-signature-help-plugin/test/Main.hs | 28 +++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/plugins/hls-signature-help-plugin/test/Main.hs b/plugins/hls-signature-help-plugin/test/Main.hs index 63ee87e770..52917bf433 100644 --- a/plugins/hls-signature-help-plugin/test/Main.hs +++ b/plugins/hls-signature-help-plugin/test/Main.hs @@ -232,6 +232,34 @@ main = Just $ SignatureHelp [SignatureInformation "f :: forall a b. Eq a => a -> (Num b => b -> b) -> a" Nothing (Just [ParameterInformation (InR (25,26)) Nothing, ParameterInformation (InR (31,46)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Integer -> (Num b => b -> b) -> Integer" Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR (17,32)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), Just $ SignatureHelp [SignatureInformation "f :: forall a b. Eq a => a -> (Num b => b -> b) -> a" Nothing (Just [ParameterInformation (InR (25,26)) Nothing, ParameterInformation (InR (31,46)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Integer -> (Num Any => Any -> Any) -> Integer" Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR (17,38)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), Just $ SignatureHelp [SignatureInformation "f :: forall a b. Eq a => a -> (Num b => b -> b) -> a" Nothing (Just [ParameterInformation (InR (25,26)) Nothing, ParameterInformation (InR (31,46)) Nothing]) (Just (InL 1)), SignatureInformation "f :: Integer -> (Num Any => Any -> Any) -> Integer" Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR (17,38)) Nothing]) (Just (InL 1))] (Just 0) (Just (InL 1)) + ], + mkTest + "RankNTypes(forall in middle)" + [trimming| + f :: Maybe a -> forall b. (a, b) -> b + f = _ + x1 = f Nothing + ^ ^ + x2 = f (Just True) + ^ + x3 = f Nothing (1, True) + ^ + |] + [ Nothing, + Just $ SignatureHelp [SignatureInformation "f :: forall a. Maybe a -> forall b. (a, b) -> b" Nothing (Just [ParameterInformation (InR (15,22)) Nothing, ParameterInformation (InR (36,42)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Maybe a -> forall b. (a, b) -> b" Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR (26,32)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), + Just $ SignatureHelp [SignatureInformation "f :: forall a. Maybe a -> forall b. (a, b) -> b" Nothing (Just [ParameterInformation (InR (15,22)) Nothing, ParameterInformation (InR (36,42)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Maybe Bool -> forall b. (Bool, b) -> b" Nothing (Just [ParameterInformation (InR (5,15)) Nothing, ParameterInformation (InR (29,38)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), + Just $ SignatureHelp [SignatureInformation "f :: forall a. Maybe a -> forall b. (a, b) -> b" Nothing (Just [ParameterInformation (InR (15,22)) Nothing, ParameterInformation (InR (36,42)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Maybe Integer -> forall b. (Integer, b) -> b" Nothing (Just [ParameterInformation (InR (5,18)) Nothing, ParameterInformation (InR (32,44)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) + ], + mkTest + "RankNTypes(forall in middle), again" + [trimming| + f :: a -> forall a. a -> a + f = _ + x = f 1 + ^ ^ + |] + [ Nothing, + Just $ SignatureHelp [SignatureInformation "f :: forall a. a -> forall a1. a1 -> a1" Nothing (Just [ParameterInformation (InR (15,16)) Nothing, ParameterInformation (InR (31,33)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Integer -> forall a. a -> a" Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR (26,27)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) ] ] From c3224d7b644ca54cb4e9ae532dbdda97d4cfe72f Mon Sep 17 00:00:00 2001 From: Lin Jian Date: Fri, 8 Aug 2025 02:09:43 +0800 Subject: [PATCH 19/20] Add signature help test: LinearTypes --- plugins/hls-signature-help-plugin/test/Main.hs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/plugins/hls-signature-help-plugin/test/Main.hs b/plugins/hls-signature-help-plugin/test/Main.hs index 52917bf433..fa12282137 100644 --- a/plugins/hls-signature-help-plugin/test/Main.hs +++ b/plugins/hls-signature-help-plugin/test/Main.hs @@ -260,6 +260,21 @@ main = |] [ Nothing, Just $ SignatureHelp [SignatureInformation "f :: forall a. a -> forall a1. a1 -> a1" Nothing (Just [ParameterInformation (InR (15,16)) Nothing, ParameterInformation (InR (31,33)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Integer -> forall a. a -> a" Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR (26,27)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) + ], + mkTest + "LinearTypes" + [trimming| + {-# LANGUAGE LinearTypes #-} + f :: (a -> b) %1 -> a -> b + f = _ + x1 = f negate + ^ ^ + x2 = f _ 1 + ^ + |] + [ Nothing, + Just $ SignatureHelp [SignatureInformation "f :: forall a b. (a -> b) %1 -> a -> b" Nothing (Just [ParameterInformation (InR (18,24)) Nothing, ParameterInformation (InR (32,33)) Nothing]) (Just (InL 0)), SignatureInformation "f :: (Integer -> Integer) %1 -> Integer -> Integer" Nothing (Just [ParameterInformation (InR (6,24)) Nothing, ParameterInformation (InR (32,39)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), + Just $ SignatureHelp [SignatureInformation "f :: forall a b. (a -> b) %1 -> a -> b" Nothing (Just [ParameterInformation (InR (18,24)) Nothing, ParameterInformation (InR (32,33)) Nothing]) (Just (InL 0)), SignatureInformation "f :: (Integer -> b) %1 -> Integer -> b" Nothing (Just [ParameterInformation (InR (6,18)) Nothing, ParameterInformation (InR (26,33)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) ] ] From 081ea8fb4c0dc5f40d415eae6ad033c1bc8bdaee Mon Sep 17 00:00:00 2001 From: Lin Jian Date: Fri, 8 Aug 2025 05:51:04 +0800 Subject: [PATCH 20/20] Add another signature help tests: RankNTypes(forall in middle) --- plugins/hls-signature-help-plugin/test/Main.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/plugins/hls-signature-help-plugin/test/Main.hs b/plugins/hls-signature-help-plugin/test/Main.hs index fa12282137..0a6860352c 100644 --- a/plugins/hls-signature-help-plugin/test/Main.hs +++ b/plugins/hls-signature-help-plugin/test/Main.hs @@ -250,6 +250,17 @@ main = Just $ SignatureHelp [SignatureInformation "f :: forall a. Maybe a -> forall b. (a, b) -> b" Nothing (Just [ParameterInformation (InR (15,22)) Nothing, ParameterInformation (InR (36,42)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Maybe Bool -> forall b. (Bool, b) -> b" Nothing (Just [ParameterInformation (InR (5,15)) Nothing, ParameterInformation (InR (29,38)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)), Just $ SignatureHelp [SignatureInformation "f :: forall a. Maybe a -> forall b. (a, b) -> b" Nothing (Just [ParameterInformation (InR (15,22)) Nothing, ParameterInformation (InR (36,42)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Maybe Integer -> forall b. (Integer, b) -> b" Nothing (Just [ParameterInformation (InR (5,18)) Nothing, ParameterInformation (InR (32,44)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) ], + mkTest + "RankNTypes(forall in middle), another" + [trimming| + f :: l -> forall a. a -> a + f = _ + x = f 1 + ^ ^ + |] + [ Nothing, + Just $ SignatureHelp [SignatureInformation "f :: forall l. l -> forall a. a -> a" Nothing (Just [ParameterInformation (InR (15,16)) Nothing, ParameterInformation (InR (30,31)) Nothing]) (Just (InL 0)), SignatureInformation "f :: Integer -> forall a. a -> a" Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR (26,27)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) + ], mkTest "RankNTypes(forall in middle), again" [trimming|