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 bfa4f40185..eb655a37cc 100644 --- a/haskell-language-server.cabal +++ b/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 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..c3f643043f --- /dev/null +++ b/plugins/hls-signature-help-plugin/src/Ide/Plugin/SignatureHelp.hs @@ -0,0 +1,205 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} + +module Ide.Plugin.SignatureHelp (descriptor) where + +import Control.Arrow ((>>>)) +import Data.Bifunctor (bimap) +import qualified Data.Map.Strict as M +import Data.Maybe (mapMaybe) +import qualified Data.Set as S +import Data.Text (Text) +import qualified Data.Text as T +import Development.IDE (GetHieAst (GetHieAst), + HieAstResult (HAR, hieAst, hieKind), + HieKind (..), + IdeState (shakeExtras), + Pretty (pretty), + Recorder, WithPriority, + printOutputable) +import Development.IDE.Core.PluginUtils (runIdeActionE, + useWithStaleFastE) +import Development.IDE.Core.PositionMapping (fromCurrentPosition) +import Development.IDE.GHC.Compat (ContextInfo (Use), + FastStringCompat, HieAST, + HieASTs, + IdentifierDetails, Name, + RealSrcSpan, SDoc, + getAsts, + getSourceNodeIds, + hieTypeToIface, + hie_types, identInfo, + identType, + isAnnotationInNodeInfo, + mkRealSrcLoc, + mkRealSrcSpan, + nodeChildren, nodeSpan, + ppr, recoverFullType, + smallestContainingSatisfying, + sourceNodeInfo) +import Development.IDE.GHC.Compat.Util (LexicalFastString (LexicalFastString)) +import GHC.Data.Maybe (rightToMaybe) +import GHC.Types.SrcLoc (isRealSubspanOf) +import Ide.Plugin.Error (getNormalizedFilePathE) +import Ide.Types (PluginDescriptor (pluginHandlers), + PluginId, + PluginMethodHandler, + defaultPluginDescriptor, + mkPluginHandler) +import Language.LSP.Protocol.Message (Method (Method_TextDocumentSignatureHelp), + SMethod (SMethod_TextDocumentSignatureHelp)) +import Language.LSP.Protocol.Types (Null (Null), + ParameterInformation (ParameterInformation), + Position (Position), + SignatureHelp (SignatureHelp), + SignatureHelpParams (SignatureHelpParams), + SignatureInformation (SignatureInformation), + TextDocumentIdentifier (TextDocumentIdentifier), + UInt, + type (|?) (InL, InR)) + +data Log = LogDummy + +instance Pretty Log where + pretty = \case + LogDummy -> "TODO(@linj) remove this dummy log" + +descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState +descriptor _recorder pluginId = + (defaultPluginDescriptor pluginId "Provides signature help of something callable") + { Ide.Types.pluginHandlers = mkPluginHandler SMethod_TextDocumentSignatureHelp signatureHelpProvider + } + +-- TODO(@linj) get doc +signatureHelpProvider :: PluginMethodHandler IdeState Method_TextDocumentSignatureHelp +signatureHelpProvider ideState _pluginId (SignatureHelpParams (TextDocumentIdentifier uri) position _mProgreeToken _mContext) = do + nfp <- getNormalizedFilePathE uri + 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 [] + Just oldPosition -> 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 + +mkSignatureHelp :: Name -> Text -> UInt -> SignatureHelp +mkSignatureHelp functionName functionType argumentNumber = + let functionNameLabelPrefix = printOutputable (ppr functionName) <> " :: " + in SignatureHelp + [ SignatureInformation + (functionNameLabelPrefix <> functionType) + Nothing + (Just $ mkArguments (fromIntegral $ T.length functionNameLabelPrefix) functionType) + (Just $ InL argumentNumber) + ] + (Just 0) + (Just $ InL argumentNumber) + +-- TODO(@linj) can type string be a multi-line string? +mkArguments :: UInt -> Text -> [ParameterInformation] +mkArguments offset functionType = + let separator = " -> " + separatorLength = fromIntegral $ T.length separator + splits = T.breakOnAll separator functionType + prefixes = fst <$> splits + prefixLengths = fmap (T.length >>> fromIntegral) prefixes + ranges = + [ ( if previousPrefixLength == 0 then 0 else previousPrefixLength + separatorLength, + currentPrefixLength + ) + | (previousPrefixLength, currentPrefixLength) <- zip (0: prefixLengths) prefixLengths + ] + in [ ParameterInformation (InR range) Nothing + | range <- bimap (+offset) (+offset) <$> ranges + ] + +extractInfoFromSmallestContainingFunctionApplicationAst :: + Position -> HieASTs a -> (RealSrcSpan -> HieAST a -> Maybe b) -> [b] +extractInfoFromSmallestContainingFunctionApplicationAst position hieAsts extractInfo = + M.elems $ flip M.mapMaybeWithKey (getAsts hieAsts) $ \hiePath hieAst -> + smallestContainingSatisfying (positionToSpan hiePath position) (nodeHasAnnotation ("HsApp", "HsExpr")) hieAst + >>= extractInfo (positionToSpan hiePath position) + where + positionToSpan hiePath position = + let loc = mkLoc hiePath position in mkRealSrcSpan loc loc + mkLoc (LexicalFastString hiePath) (Position line character) = + mkRealSrcLoc hiePath (fromIntegral line + 1) (fromIntegral character + 1) + +type Annotation = (FastStringCompat, FastStringCompat) + +nodeHasAnnotation :: Annotation -> HieAST a -> Bool +nodeHasAnnotation annotation 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 + +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` 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..2d1cae9a02 --- /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, + 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 + "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 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",