Implement signature help

.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

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

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]

haskell-language-server.cabal

@@ -834,6 +834,57 @@ 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
+
+
+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
 -----------------------------
@@ -1846,6 +1897,7 @@ library
                   , retrie
                   , hlint
                   , stan
+                  , signatureHelp
                   , moduleName
                   , pragmas
                   , splice

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

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]

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]