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/CODEOWNERS b/CODEOWNERS index 7d66f7805e..51346b4d79 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -38,6 +38,7 @@ /plugins/hls-rename-plugin /plugins/hls-retrie-plugin @wz1000 /plugins/hls-semantic-tokens-plugin @soulomoon +/plugins/hls-signature-help-plugin @jian-lin /plugins/hls-splice-plugin @konn /plugins/hls-stan-plugin @0rphee /plugins/hls-stylish-haskell-plugin @michaelpj diff --git a/docs/features.md b/docs/features.md index 1eab0054b4..2f34f501cc 100644 --- a/docs/features.md +++ b/docs/features.md @@ -7,6 +7,7 @@ Many of these are standard LSP features, but a lot of special features are provi | --------------------------------------------------- | ------------------------------------------------------------------------------------------------- | | [Diagnostics](#diagnostics) | `textDocument/publishDiagnostics` | | [Hovers](#hovers) | `textDocument/hover` | +| [Signature help](#signature-help) | `textDocument/signatureHelp` | | [Jump to definition](#jump-to-definition) | `textDocument/definition` | | [Jump to type definition](#jump-to-type-definition) | `textDocument/typeDefinition` | | [Find references](#find-references) | `textDocument/references` | @@ -63,6 +64,12 @@ Provided by: `hls-explicit-fixity-plugin` Provides fixity information. +## Signature help + +Provided by: `hls-signature-help-plugin` + +Shows and highlights the function signature, the function documentation and the arguments documentation when the cursor is at a function argument. + ## Jump to definition Provided by: `ghcide` @@ -445,7 +452,6 @@ Contributions welcome! | Feature | Status | [LSP method](./what-is-hls.md#lsp-terminology) | | ---------------------- | ----------------- | ---------------------------------------------- | -| Signature help | Unimplemented | `textDocument/signatureHelp` | | Jump to declaration | Unclear if useful | `textDocument/declaration` | | Jump to implementation | Unclear if useful | `textDocument/implementation` | | Linked editing | Unimplemented | `textDocument/linkedEditingRange` | diff --git a/docs/support/plugin-support.md b/docs/support/plugin-support.md index 4263f0d035..724ca99da0 100644 --- a/docs/support/plugin-support.md +++ b/docs/support/plugin-support.md @@ -51,6 +51,7 @@ For example, a plugin to provide a formatter which has itself been abandoned has | `hls-class-plugin` | 2 | | | `hls-change-type-signature-plugin` | 2 | | | `hls-eval-plugin` | 2 | | +| `hls-signature-help-plugin` | 2 | | | `hls-explicit-fixity-plugin` | 2 | | | `hls-explicit-record-fields-plugin` | 2 | | | `hls-fourmolu-plugin` | 2 | | diff --git a/ghcide/src/Development/IDE/Core/Actions.hs b/ghcide/src/Development/IDE/Core/Actions.hs index 0d55a73120..a912e1de5f 100644 --- a/ghcide/src/Development/IDE/Core/Actions.hs +++ b/ghcide/src/Development/IDE/Core/Actions.hs @@ -62,7 +62,7 @@ getAtPoint file pos = runMaybeT $ do (hf, mapping) <- useWithStaleFastMT GetHieAst file env <- hscEnv . fst <$> useWithStaleFastMT GhcSession file - dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> runMaybeT (useWithStaleFastMT GetDocMap file) + dkMap <- lift $ maybe (DKMap mempty mempty mempty) fst <$> runMaybeT (useWithStaleFastMT GetDocMap file) !pos' <- MaybeT (return $ fromCurrentPosition mapping pos) MaybeT $ liftIO $ fmap (first (toCurrentRange mapping =<<)) <$> AtPoint.atPoint opts hf dkMap env pos' diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index 43b80be119..12cd5a38c9 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -249,9 +249,9 @@ type instance RuleResult GetHieAst = HieAstResult -- | A IntervalMap telling us what is in scope at each point type instance RuleResult GetBindings = Bindings -data DocAndTyThingMap = DKMap {getDocMap :: !DocMap, getTyThingMap :: !TyThingMap} +data DocAndTyThingMap = DKMap {getDocMap :: !DocMap, getTyThingMap :: !TyThingMap, getArgDocMap :: !ArgDocMap} instance NFData DocAndTyThingMap where - rnf (DKMap a b) = rwhnf a `seq` rwhnf b + rnf (DKMap a b c) = rwhnf a `seq` rwhnf b `seq` rwhnf c instance Show DocAndTyThingMap where show = const "docmap" diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index f1b11d971b..6f198699f0 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -576,7 +576,7 @@ getDocMapRule recorder = -- | Persistent rule to ensure that hover doesn't block on startup persistentDocMapRule :: Rules () -persistentDocMapRule = addPersistentRule GetDocMap $ \_ -> pure $ Just (DKMap mempty mempty, idDelta, Nothing) +persistentDocMapRule = addPersistentRule GetDocMap $ \_ -> pure $ Just (DKMap mempty mempty mempty, idDelta, Nothing) readHieFileForSrcFromDisk :: Recorder (WithPriority Log) -> NormalizedFilePath -> MaybeT IdeAction Compat.HieFile readHieFileForSrcFromDisk recorder file = do 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/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index d92bf1da85..7278b8a3e1 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -132,11 +132,11 @@ resolveCompletion ide _pid comp@CompletionItem{_detail,_documentation,_data_} ur name <- liftIO $ lookupNameCache nc mod occ mdkm <- liftIO $ runIdeAction "CompletionResolve.GetDocMap" (shakeExtras ide) $ useWithStaleFast GetDocMap file let (dm,km) = case mdkm of - Just (DKMap docMap tyThingMap, _) -> (docMap,tyThingMap) - Nothing -> (mempty, mempty) + Just (DKMap docMap tyThingMap _argDocMap, _) -> (docMap,tyThingMap) + Nothing -> (mempty, mempty) doc <- case lookupNameEnv dm name of Just doc -> pure $ spanDocToMarkdown doc - Nothing -> liftIO $ spanDocToMarkdown <$> getDocumentationTryGhc (hscEnv sess) name + Nothing -> liftIO $ spanDocToMarkdown . fst <$> getDocumentationTryGhc (hscEnv sess) name typ <- case lookupNameEnv km name of _ | not needType -> pure Nothing Just ty -> pure (safeTyThingType ty) diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index a577cae32e..268b6b5790 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -239,7 +239,7 @@ atPoint -> HscEnv -> Position -> IO (Maybe (Maybe Range, [T.Text])) -atPoint IdeOptions{} (HAR _ (hf :: HieASTs a) rf _ (kind :: HieKind hietype)) (DKMap dm km) env pos = +atPoint IdeOptions{} (HAR _ (hf :: HieASTs a) rf _ (kind :: HieKind hietype)) (DKMap dm km _am) env pos = listToMaybe <$> sequence (pointCommand hf pos hoverInfo) where -- Hover info for values/data diff --git a/ghcide/src/Development/IDE/Spans/Common.hs b/ghcide/src/Development/IDE/Spans/Common.hs index f3e86d792d..1ede440edc 100644 --- a/ghcide/src/Development/IDE/Spans/Common.hs +++ b/ghcide/src/Development/IDE/Spans/Common.hs @@ -13,6 +13,7 @@ module Development.IDE.Spans.Common ( , spanDocToMarkdownForTest , DocMap , TyThingMap +, ArgDocMap , srcSpanToMdLink ) where @@ -29,6 +30,7 @@ import GHC.Generics import System.FilePath import Control.Lens +import Data.IntMap (IntMap) import Development.IDE.GHC.Compat import Development.IDE.GHC.Orphans () import qualified Language.LSP.Protocol.Lens as JL @@ -36,6 +38,7 @@ import Language.LSP.Protocol.Types type DocMap = NameEnv SpanDoc type TyThingMap = NameEnv TyThing +type ArgDocMap = NameEnv (IntMap SpanDoc) -- | Shows IEWrappedName, without any modifier, qualifier or unique identifier. unqualIEWrapName :: IEWrappedName GhcPs -> T.Text diff --git a/ghcide/src/Development/IDE/Spans/Documentation.hs b/ghcide/src/Development/IDE/Spans/Documentation.hs index 85f2ef1037..df7c7a5f86 100644 --- a/ghcide/src/Development/IDE/Spans/Documentation.hs +++ b/ghcide/src/Development/IDE/Spans/Documentation.hs @@ -16,6 +16,7 @@ import Control.Monad.Extra (findM) import Control.Monad.IO.Class import Data.Either import Data.Foldable +import Data.IntMap (IntMap) import Data.List.Extra import qualified Data.Map as M import Data.Maybe @@ -41,21 +42,27 @@ mkDocMap -> IO DocAndTyThingMap mkDocMap env rm this_mod = do - (Just Docs{docs_decls = UniqMap this_docs}) <- extractDocs (hsc_dflags env) this_mod + (Just Docs{docs_decls = UniqMap this_docs, docs_args = UniqMap this_arg_docs}) <- extractDocs (hsc_dflags env) this_mod d <- foldrM getDocs (fmap (\(_, x) -> (map hsDocString x) `SpanDocString` SpanDocUris Nothing Nothing) this_docs) names k <- foldrM getType (tcg_type_env this_mod) names - pure $ DKMap d k + a <- foldrM getArgDocs (fmap (\(_, m) -> fmap (\x -> [hsDocString x] `SpanDocString` SpanDocUris Nothing Nothing) m) this_arg_docs) names + pure $ DKMap d k a where getDocs n nameMap | maybe True (mod ==) $ nameModule_maybe n = pure nameMap -- we already have the docs in this_docs, or they do not exist | otherwise = do - doc <- getDocumentationTryGhc env n + (doc, _argDoc) <- getDocumentationTryGhc env n pure $ extendNameEnv nameMap n doc getType n nameMap | Nothing <- lookupNameEnv nameMap n = do kind <- lookupKind env n pure $ maybe nameMap (extendNameEnv nameMap n) kind | otherwise = pure nameMap + getArgDocs n nameMap + | maybe True (mod ==) $ nameModule_maybe n = pure nameMap + | otherwise = do + (_doc, argDoc) <- getDocumentationTryGhc env n + pure $ extendNameEnv nameMap n argDoc names = rights $ S.toList idents idents = M.keysSet rm mod = tcg_mod this_mod @@ -64,23 +71,23 @@ lookupKind :: HscEnv -> Name -> IO (Maybe TyThing) lookupKind env = fmap (fromRight Nothing) . catchSrcErrors (hsc_dflags env) "span" . lookupName env -getDocumentationTryGhc :: HscEnv -> Name -> IO SpanDoc +getDocumentationTryGhc :: HscEnv -> Name -> IO (SpanDoc, IntMap SpanDoc) getDocumentationTryGhc env n = - (fromMaybe emptySpanDoc . listToMaybe <$> getDocumentationsTryGhc env [n]) - `catch` (\(_ :: IOEnvFailure) -> pure emptySpanDoc) + (fromMaybe (emptySpanDoc, mempty) . listToMaybe <$> getDocumentationsTryGhc env [n]) + `catch` (\(_ :: IOEnvFailure) -> pure (emptySpanDoc, mempty)) -getDocumentationsTryGhc :: HscEnv -> [Name] -> IO [SpanDoc] +getDocumentationsTryGhc :: HscEnv -> [Name] -> IO [(SpanDoc, IntMap SpanDoc)] getDocumentationsTryGhc env names = do resOr <- catchSrcErrors (hsc_dflags env) "docs" $ getDocsBatch env names case resOr of Left _ -> return [] Right res -> zipWithM unwrap res names where - unwrap (Right (Just docs, _)) n = SpanDocString (map hsDocString docs) <$> getUris n + unwrap (Right (Just docs, argDocs)) n = (\uris -> (SpanDocString (map hsDocString docs) uris, fmap (\x -> SpanDocString [hsDocString x] uris) argDocs)) <$> getUris n unwrap _ n = mkSpanDocText n mkSpanDocText name = - SpanDocText [] <$> getUris name + (\uris -> (SpanDocText [] uris, mempty)) <$> getUris name -- Get the uris to the documentation and source html pages if they exist getUris name = do diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index bfa4f40185..21907df2cd 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -834,6 +834,59 @@ test-suite hls-stan-plugin-tests default-extensions: OverloadedStrings +----------------------------- +-- signature help plugin +----------------------------- + +flag signatureHelp + description: Enable signature help plugin + default: True + manual: True + +common signatureHelp + if flag(signatureHelp) + build-depends: haskell-language-server:hls-signature-help-plugin + cpp-options: -Dhls_signatureHelp + +-- TODO(@linj) remove unneeded deps +library hls-signature-help-plugin + import: defaults, pedantic, warnings + if !flag(signatureHelp) + buildable: False + exposed-modules: Ide.Plugin.SignatureHelp + hs-source-dirs: plugins/hls-signature-help-plugin/src + default-extensions: + DerivingStrategies + LambdaCase + OverloadedStrings + build-depends: + , containers + , ghc + , ghcide == 2.11.0.0 + , hls-plugin-api == 2.11.0.0 + , lsp-types + , text + , transformers + + +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 + , regex-tdfa + , text + default-extensions: + OverloadedStrings + ----------------------------- -- module name plugin ----------------------------- @@ -1846,6 +1899,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..d1ff57772d --- /dev/null +++ b/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs @@ -0,0 +1,313 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} + +module Ide.Plugin.SignatureHelp (descriptor) where + +import Control.Arrow ((>>>)) +import Control.Monad.Trans.Except (ExceptT (ExceptT)) +import Data.Bifunctor (bimap) +import Data.Function ((&)) +import Data.IntMap (IntMap) +import qualified Data.IntMap as IntMap +import qualified Data.Map.Strict as M +import qualified Data.Set as S +import Data.Text (Text) +import qualified Data.Text as T +import Development.IDE (DocAndTyThingMap (DKMap), + GetDocMap (GetDocMap), + GetHieAst (GetHieAst), + HieAstResult (HAR, hieAst, hieKind), + HieKind (..), + IdeState (shakeExtras), + Pretty (pretty), + Recorder, WithPriority, + printOutputableOneLine, + useWithStaleFast) +import Development.IDE.Core.PluginUtils (runIdeActionE, + useWithStaleFastE) +import Development.IDE.Core.PositionMapping (fromCurrentPosition) +import Development.IDE.GHC.Compat (FastStringCompat, Name, + RealSrcSpan, + getSourceNodeIds, + isAnnotationInNodeInfo, + mkRealSrcLoc, + mkRealSrcSpan, ppr, + sourceNodeInfo) +import Development.IDE.GHC.Compat.Util (LexicalFastString (LexicalFastString)) +import Development.IDE.Spans.Common (ArgDocMap, DocMap, + SpanDoc (..), + SpanDocUris (SpanDocUris), + spanDocToMarkdown) +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 (smallestContainingSatisfying) +import GHC.Types.Name.Env (lookupNameEnv) +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 (MarkupContent (MarkupContent), + MarkupKind (MarkupKind_Markdown), + Null (Null), + ParameterInformation (ParameterInformation), + Position (Position), + SignatureHelp (SignatureHelp), + SignatureHelpContext (SignatureHelpContext), + SignatureHelpParams (SignatureHelpParams), + SignatureInformation (SignatureInformation), + TextDocumentIdentifier (TextDocumentIdentifier), + UInt, + type (|?) (InL, InR)) + +data Log = LogDummy + +instance Pretty Log where + pretty = \case + LogDummy -> "TODO(@linj) remove this dummy log" + +descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState +descriptor _recorder pluginId = + (defaultPluginDescriptor pluginId "Provides signature help of something callable") + { Ide.Types.pluginHandlers = mkPluginHandler SMethod_TextDocumentSignatureHelp signatureHelpProvider + } + +signatureHelpProvider :: PluginMethodHandler IdeState Method_TextDocumentSignatureHelp +signatureHelpProvider ideState _pluginId (SignatureHelpParams (TextDocumentIdentifier uri) position _mProgreeToken mSignatureHelpContext) = do + nfp <- getNormalizedFilePathE uri + results <- runIdeActionE "signatureHelp.ast" (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 [] + Just oldPosition -> do + pure $ + extractInfoFromSmallestContainingFunctionApplicationAst + oldPosition + hieAst + ( \span hieAst -> do + let functionNode = getLeftMostNode hieAst + (functionName, functionTypes) <- getNodeNameAndTypes hieKind functionNode + argumentNumber <- getArgumentNumber span hieAst + Just (functionName, functionTypes, argumentNumber) + ) + (docMap, argDocMap) <- runIdeActionE "signatureHelp.docMap" (shakeExtras ideState) $ do + mResult <- ExceptT $ Right <$> useWithStaleFast GetDocMap nfp + case mResult of + Just (DKMap docMap _tyThingMap argDocMap, _positionMapping) -> pure (docMap, argDocMap) + Nothing -> pure (mempty, mempty) + case results of + [(_functionName, [], _argumentNumber)] -> pure $ InR Null + [(functionName, functionTypes, argumentNumber)] -> + pure $ InL $ mkSignatureHelp mSignatureHelpContext docMap argDocMap (fromIntegral argumentNumber - 1) functionName functionTypes + -- TODO(@linj) what does non-singleton list mean? + _ -> pure $ InR Null + +mkSignatureHelp :: Maybe SignatureHelpContext -> DocMap -> ArgDocMap -> UInt -> Name -> [Type] -> SignatureHelp +mkSignatureHelp mSignatureHelpContext docMap argDocMap argumentNumber functionName functionTypes = + SignatureHelp + (mkSignatureInformation docMap argDocMap argumentNumber functionName <$> functionTypes) + activeSignature + (Just $ InL argumentNumber) + where + activeSignature = case mSignatureHelpContext of + Just + ( SignatureHelpContext + _triggerKind + _triggerCharacter + True + (Just (SignatureHelp _signatures oldActivateSignature _activeParameter)) + ) -> oldActivateSignature + _ -> Just 0 + +mkSignatureInformation :: DocMap -> ArgDocMap -> UInt -> Name -> Type -> SignatureInformation +mkSignatureInformation docMap argDocMap argumentNumber functionName functionType = + let functionNameLabelPrefix = printOutputableOneLine (ppr functionName) <> " :: " + mFunctionDoc = case lookupNameEnv docMap functionName of + Nothing -> Nothing + Just spanDoc -> Just $ InR $ mkMarkdownDoc spanDoc + thisArgDocMap = case lookupNameEnv argDocMap functionName of + Nothing -> mempty + Just thisArgDocMap' -> thisArgDocMap' + in SignatureInformation + (functionNameLabelPrefix <> printOutputableOneLine functionType) + mFunctionDoc + (Just $ mkArguments thisArgDocMap (fromIntegral $ T.length functionNameLabelPrefix) functionType) + (Just $ InL argumentNumber) + +mkArguments :: IntMap SpanDoc -> UInt -> Type -> [ParameterInformation] +mkArguments thisArgDocMap offset functionType = + [ ParameterInformation (InR range) mArgDoc + | (argIndex, range) <- zip [0..] (bimap (+offset) (+offset) <$> findArgumentRanges functionType) + , let mArgDoc = case IntMap.lookup argIndex thisArgDocMap of + Nothing -> Nothing + Just spanDoc -> Just $ InR $ mkMarkdownDoc $ removeUris spanDoc + ] + where + -- we already show uris in the function doc, no need to duplicate them in the arg doc + removeUris (SpanDocString docs _uris) = SpanDocString docs emptyUris + removeUris (SpanDocText docs _uris) = SpanDocText docs emptyUris + + emptyUris = SpanDocUris Nothing Nothing + +mkMarkdownDoc :: SpanDoc -> MarkupContent +mkMarkdownDoc = spanDocToMarkdown >>> T.unlines >>> MarkupContent MarkupKind_Markdown + +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] +extractInfoFromSmallestContainingFunctionApplicationAst position hieAsts extractInfo = + M.elems $ flip M.mapMaybeWithKey (getAsts hieAsts) $ \hiePath hieAst -> + smallestContainingSatisfying (positionToSpan hiePath position) (nodeHasAnnotation ("HsApp", "HsExpr")) hieAst + >>= extractInfo (positionToSpan hiePath position) + where + positionToSpan hiePath position = + let loc = mkLoc hiePath position in mkRealSrcSpan loc loc + mkLoc (LexicalFastString hiePath) (Position line character) = + mkRealSrcLoc hiePath (fromIntegral line + 1) (fromIntegral character + 1) + +type Annotation = (FastStringCompat, FastStringCompat) + +nodeHasAnnotation :: Annotation -> HieAST a -> Bool +nodeHasAnnotation annotation 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 +getLeftMostNode thisNode = + case nodeChildren thisNode of + [] -> thisNode + leftChild: _ -> getLeftMostNode leftChild + +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 + [(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, filterCoreTypes allTypes) + [] -> Nothing + _ -> Nothing -- seems impossible + else Nothing -- TODO(@linj) must function node be HsVar? + where + extractName = rightToMaybe + + isDifferentType type1 type2 = case hieKind of + HieFresh -> deBruijnize type1 /= deBruijnize type2 + HieFromDisk {} -> type1 /= type2 + + 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 + +-- TODO(@linj) handle more cases +-- Just 1 means the first argument +getArgumentNumber :: RealSrcSpan -> HieAST a -> Maybe Integer +getArgumentNumber span hieAst + | nodeHasAnnotation ("HsApp", "HsExpr") hieAst = + case nodeChildren hieAst of + [leftChild, _] -> + if span `isRealSubspanOf` nodeSpan leftChild + then Nothing + else getArgumentNumber span leftChild >>= \argumentNumber -> Just (argumentNumber + 1) + _ -> Nothing -- impossible + | nodeHasAnnotation ("HsAppType", "HsExpr") hieAst = + case nodeChildren hieAst of + [leftChild, _] -> getArgumentNumber span leftChild + _ -> Nothing -- impossible + | otherwise = + case nodeChildren hieAst of + [] -> Just 0 -- the function is found + [child] -> getArgumentNumber span child -- ignore irrelevant nodes + _ -> Nothing 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..2d641aee4e --- /dev/null +++ b/plugins/hls-signature-help-plugin/test/Main.hs @@ -0,0 +1,422 @@ +{-# 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) +import Text.Regex.TDFA ((=~)) + + +main :: IO () +main = + defaultTestRunner $ + testGroup + "signatureHelp" + [ mkTest + "1 parameter" + [trimming| + f :: Int -> Int + f = _ + x = f 1 + ^^^^^^^^ + |] + [ Nothing, + 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)), + Just $ SignatureHelp [SignatureInformation "f :: Int -> Int" Nothing (Just [ParameterInformation (InR (5,8)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) + ], + 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)), + 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 + "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, + 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 "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)), + 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 (6,16)) Nothing, ParameterInformation (InR (21,24)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) + ], + 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)), 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" + [trimming| + x :: IO Bool + x = pure True + ^ ^ + |] + [ Nothing, + let doc = + if ghcVersion <= GHC98 + then "\n\nLift a value.\n\n\\[Documentation\\]\\(file://.*\\)\n\n\\[Source\\]\\(file://.*\\)\n\n" + else "\n\nLift a value into the Structure. #### **Examples** \n```haskell\n>>> pure 1 :: Maybe Int\nJust 1\n\n\n```\n \n```haskell\n>>> pure 'z' :: [Char]\n\"z\"\n\n\n```\n \n```haskell\n>>> pure (pure \":D\") :: Maybe [String]\nJust [\":D\"]\n\n\n```\n\n\\[Documentation\\]\\(file://.*\\)\n\n\\[Source\\]\\(file://.*\\)\n\n" + in Just $ SignatureHelp [SignatureInformation "pure :: forall (f :: Type -> Type) a. Applicative f => a -> f a" (Just $ InR $ MarkupContent MarkupKind_Markdown doc) (Just [ParameterInformation (InR (55,56)) Nothing]) (Just (InL 0)), SignatureInformation "pure :: Bool -> IO Bool" (Just $ InR $ MarkupContent MarkupKind_Markdown doc) (Just [ParameterInformation (InR (8,12)) Nothing]) (Just (InL 0)), SignatureInformation "pure :: forall a. a -> IO a" (Just $ InR $ MarkupContent MarkupKind_Markdown doc) (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| + f :: Int -> Int -> Int + f = _ + g :: Int -> Int -> Int + g = _ + x = (if _ then f else g) 1 2 + ^^ ^^^ ^ ^^^ ^ ^^^^^^^^ + |] + (replicate 18 Nothing), + mkTest + "very long 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 -> 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 + "very long type with type constraint" + [trimming| + f :: Num abcdefghijklmn => abcdefghijklmn -> abcdefghijklmn -> abcdefghijklmn -> abcdefghijklmn -> abcdefghijklmn + f = _ + x = f 1 + ^ ^ + |] + [ 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)) + ], + mkTest + "=> in argument" + [trimming| + f :: Eq a => a -> (Num b => b -> b) -> a + f = _ + x = f 1 + ^ ^ + y = f 1 negate + ^ ^ + |] + ( let typ = + if ghcVersion <= GHC98 + then "f :: Integer -> (Num Any => Any -> Any) -> Integer" + else "f :: Integer -> (Num (ZonkAny 0) => ZonkAny 0 -> ZonkAny 0) -> Integer" + range = if ghcVersion <= GHC98 then (17,38) else (17,58) + in [ 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 typ Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR range) 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 typ Nothing (Just [ParameterInformation (InR (5,12)) Nothing, ParameterInformation (InR range) 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), 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| + 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)) + ], + 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)) + ], + mkTest + "function documentation" + [trimming| + -- |The 'f' function does something to a bool value. + f :: Bool -> Bool + f = _ + x = f True + ^ ^ + |] + [ Nothing, + Just $ SignatureHelp [SignatureInformation "f :: Bool -> Bool" (Just $ InR $ MarkupContent MarkupKind_Markdown "\n\nThe `f` function does something to a bool value.\n\n") (Just [ParameterInformation (InR (5,9)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) + ], + mkTest + "function and arguments documentation" + [trimming| + -- |Doc for function 'f'. + f :: + -- | The first 'Bool' argument + Bool -> + -- | The second 'Int' argument + Int -> + -- | The return value + Bool + f = _ + x = f True 1 + ^ ^ + |] + [ Nothing, + Just $ SignatureHelp [SignatureInformation "f :: Bool -> Int -> Bool" (Just $ InR $ MarkupContent MarkupKind_Markdown "\n\nDoc for function `f` .\n\n") (Just [ParameterInformation (InR (5,9)) (Just $ InR $ MarkupContent MarkupKind_Markdown "\n\nThe first `Bool` argument\n\n"), ParameterInformation (InR (13,16)) (Just $ InR $ MarkupContent MarkupKind_Markdown "\n\nThe second `Int` argument\n\n")]) (Just (InL 0))] (Just 0) (Just (InL 0)) + ], + mkTest + "imported function with no documentation" + [trimming| + x = even 1 + ^ ^ + |] + [ Nothing, + Just $ SignatureHelp [SignatureInformation "even :: forall a. Integral a => a -> Bool" (Just $ InR $ MarkupContent MarkupKind_Markdown "\\[Documentation\\]\\(file://.*\\)\n\n\\[Source\\]\\(file://.*\\)\n\n") (Just [ParameterInformation (InR (32,33)) Nothing]) (Just (InL 0)), SignatureInformation "even :: Integer -> Bool" (Just $ InR $ MarkupContent MarkupKind_Markdown "\\[Documentation\\]\\(file://.*\\)\n\n\\[Source\\]\\(file://.*\\)\n\n") (Just [ParameterInformation (InR (8,15)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) + ], + mkTest + "imported function with argument documentation" + [trimming| + import Language.Haskell.TH.Lib (mkBytes) + x = mkBytes _ + ^ ^ + |] + [ Nothing, + Just $ SignatureHelp [SignatureInformation "mkBytes :: ForeignPtr Word8 -> Word -> Word -> Bytes" (Just $ InR $ MarkupContent MarkupKind_Markdown "\n\nCreate a Bytes datatype representing raw bytes to be embedded into the\n program/library binary.\n\n\\[Documentation\\]\\(file://.*\\)\n\n\\[Source\\]\\(file://.*\\)\n\n") (Just [ParameterInformation (InR (11,27)) (Just $ InR $ MarkupContent MarkupKind_Markdown "\n\nPointer to the data\n\n"), ParameterInformation (InR (31,35)) (Just $ InR $ MarkupContent MarkupKind_Markdown "\n\nOffset from the pointer\n\n"), ParameterInformation (InR (39,43)) (Just $ InR $ MarkupContent MarkupKind_Markdown "\n\nNumber of bytes\n\n")]) (Just (InL 0))] (Just 0) (Just (InL 0)) + ], + mkTest + "TypeApplications" + [trimming| + f :: a -> b -> c + f = _ + x = f @Int @_ 1 True + ^ ^ ^ ^ + |] + [ Nothing, + Nothing, + Nothing, + Just $ SignatureHelp [SignatureInformation "f :: forall a b c. a -> b -> c" Nothing (Just [ParameterInformation (InR (19,20)) Nothing, ParameterInformation (InR (24,25)) Nothing]) (Just (InL 0))] (Just 0) (Just (InL 0)) + ] + ] + +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" + (fmap . fmap) mkReproducibleSignatureHelp (getSignatureHelp doc position) + +mkReproducibleSignatureHelp :: SignatureHelp -> SignatureHelp +mkReproducibleSignatureHelp = L.signatures . traverse . L.documentation %~ unifyLocalFilePath + where + unifyLocalFilePath (Just (InR (MarkupContent MarkupKind_Markdown doc))) = + let (prefix, match, suffix) = doc =~ documentationRegex :: (Text, Text, Text) + (prefix', match', suffix') = suffix =~ sourceRegex :: (Text, Text, Text) + reproducibleDoc = + if T.null match + then prefix + else + prefix + <> documentationRegex + <> ( if T.null match' + then prefix' + else prefix' <> sourceRegex <> suffix' + ) + in Just $ InR $ MarkupContent MarkupKind_Markdown reproducibleDoc + unifyLocalFilePath mDoc = mDoc + documentationRegex = "\\[Documentation\\]\\(file://.*\\)\n\n" + sourceRegex = "\\[Source\\]\\(file://.*\\)\n\n" + +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) use the one from lsp-test when we have https://github.com/haskell/lsp/pull/621 +-- | 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 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") - 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",