diff --git a/cabal.project b/cabal.project index c6b74a36a..e56cd6fdf 100644 --- a/cabal.project +++ b/cabal.project @@ -10,3 +10,8 @@ tests: True benchmarks: True test-show-details: direct haddock-quickjump: True + +constraints: some == 1.0.1, + dependent-sum == 0.7.1.0 + +max-backjumps: 10000 \ No newline at end of file diff --git a/lsp-test/src/Language/LSP/Test.hs b/lsp-test/src/Language/LSP/Test.hs index 50b2ae0c2..fb3cd66b4 100644 --- a/lsp-test/src/Language/LSP/Test.hs +++ b/lsp-test/src/Language/LSP/Test.hs @@ -94,6 +94,9 @@ module Language.LSP.Test , getCodeLenses -- ** Capabilities , getRegisteredCapabilities + , prepareCallHierarchy + , incomingCalls + , outgoingCalls ) where import Control.Applicative.Combinators @@ -163,7 +166,7 @@ runSessionWithConfig config' serverExe caps rootDir session = do -- -- > (hinRead, hinWrite) <- createPipe -- > (houtRead, houtWrite) <- createPipe --- > +-- > -- > forkIO $ void $ runServerWithHandles hinRead houtWrite serverDefinition -- > runSessionWithHandles hinWrite houtRead defaultConfig fullCaps "." $ do -- > -- ... @@ -656,7 +659,7 @@ getDefinitions = getDeclarationyRequest STextDocumentDefinition DefinitionParams getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in. -> Position -- ^ The position the term is at. -> Session ([Location] |? [LocationLink]) -getTypeDefinitions = getDeclarationyRequest STextDocumentTypeDefinition TypeDefinitionParams +getTypeDefinitions = getDeclarationyRequest STextDocumentTypeDefinition TypeDefinitionParams -- | Returns the type definition(s) for the term at the specified position. getImplementations :: TextDocumentIdentifier -- ^ The document the term is in. @@ -746,3 +749,22 @@ getCodeLenses tId = do -- @since 0.11.0.0 getRegisteredCapabilities :: Session [SomeRegistration] getRegisteredCapabilities = Map.elems . curDynCaps <$> get + +-- | Pass a param and return the response from `prepareCallHierarchy` +prepareCallHierarchy :: CallHierarchyPrepareParams -> Session [CallHierarchyItem] +prepareCallHierarchy = resolveRequestWithListResp STextDocumentPrepareCallHierarchy + +incomingCalls :: CallHierarchyIncomingCallsParams -> Session [CallHierarchyIncomingCall] +incomingCalls = resolveRequestWithListResp SCallHierarchyIncomingCalls + +outgoingCalls :: CallHierarchyOutgoingCallsParams -> Session [CallHierarchyOutgoingCall] +outgoingCalls = resolveRequestWithListResp SCallHierarchyOutgoingCalls + +-- | Send a request and receive a response with list. +resolveRequestWithListResp :: (ResponseResult m ~ Maybe (List a)) + => SClientMethod m -> MessageParams m -> Session [a] +resolveRequestWithListResp method params = do + rsp <- request method params + case getResponseResult rsp of + Nothing -> pure [] + Just (List x) -> pure x diff --git a/lsp-test/test/DummyServer.hs b/lsp-test/test/DummyServer.hs index 2635927eb..2066ac571 100644 --- a/lsp-test/test/DummyServer.hs +++ b/lsp-test/test/DummyServer.hs @@ -16,12 +16,12 @@ import System.Directory import System.FilePath import System.Process import Language.LSP.Types - + withDummyServer :: ((Handle, Handle) -> IO ()) -> IO () withDummyServer f = do (hinRead, hinWrite) <- createPipe (houtRead, houtWrite) <- createPipe - + handlerEnv <- HandlerEnv <$> newEmptyMVar <*> newEmptyMVar let definition = ServerDefinition { doInitialize = \env _req -> pure $ Right env @@ -185,4 +185,31 @@ handlers = Nothing Nothing resp $ Right $ InR res + , requestHandler STextDocumentPrepareCallHierarchy $ \req resp -> do + let RequestMessage _ _ _ params = req + CallHierarchyPrepareParams _ pos _ = params + Position x y = pos + item = + CallHierarchyItem + "foo" + SkMethod + Nothing + Nothing + (Uri "") + (Range (Position 2 3) (Position 4 5)) + (Range (Position 2 3) (Position 4 5)) + Nothing + if x == 0 && y == 0 + then resp $ Right Nothing + else resp $ Right $ Just $ List [item] + , requestHandler SCallHierarchyIncomingCalls $ \req resp -> do + let RequestMessage _ _ _ params = req + CallHierarchyIncomingCallsParams _ _ item = params + resp $ Right $ Just $ + List [CallHierarchyIncomingCall item (List [Range (Position 2 3) (Position 4 5)])] + , requestHandler SCallHierarchyOutgoingCalls $ \req resp -> do + let RequestMessage _ _ _ params = req + CallHierarchyOutgoingCallsParams _ _ item = params + resp $ Right $ Just $ + List [CallHierarchyOutgoingCall item (List [Range (Position 4 5) (Position 2 3)])] ] diff --git a/lsp-test/test/Test.hs b/lsp-test/test/Test.hs index 6cbb0a133..30ff7f08a 100644 --- a/lsp-test/test/Test.hs +++ b/lsp-test/test/Test.hs @@ -321,10 +321,10 @@ main = hspec $ around withDummyServer $ do it "works" $ \(hin, hout) -> runSessionWithHandles hin hout (def { ignoreLogNotifications = True }) fullCaps "." $ do openDoc "test/data/Format.hs" "haskell" - void publishDiagnosticsNotification + void publishDiagnosticsNotification describe "dynamic capabilities" $ do - + it "keeps track" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do loggingNotification -- initialized log message @@ -373,6 +373,27 @@ main = hspec $ around withDummyServer $ do count 0 $ loggingNotification void $ anyResponse + describe "call hierarchy" $ do + let workPos = Position 1 0 + notWorkPos = Position 0 0 + params pos = CallHierarchyPrepareParams (TextDocumentIdentifier (Uri "")) pos Nothing + item = CallHierarchyItem "foo" SkFunction Nothing Nothing (Uri "") + (Range (Position 1 2) (Position 3 4)) + (Range (Position 1 2) (Position 3 4)) + Nothing + it "prepare works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + rsp <- prepareCallHierarchy (params workPos) + liftIO $ head rsp ^. range `shouldBe` Range (Position 2 3) (Position 4 5) + it "prepare not works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + rsp <- prepareCallHierarchy (params notWorkPos) + liftIO $ rsp `shouldBe` [] + it "incoming calls" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + [CallHierarchyIncomingCall _ (List fromRanges)] <- incomingCalls (CallHierarchyIncomingCallsParams Nothing Nothing item) + liftIO $ head fromRanges `shouldBe` Range (Position 2 3) (Position 4 5) + it "outgoing calls" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + [CallHierarchyOutgoingCall _ (List fromRanges)] <- outgoingCalls (CallHierarchyOutgoingCallsParams Nothing Nothing item) + liftIO $ head fromRanges `shouldBe` Range (Position 4 5) (Position 2 3) + didChangeCaps :: ClientCapabilities didChangeCaps = def { _workspace = Just workspaceCaps } diff --git a/lsp-test/test/data/documentSymbolFail/example/Main.hs b/lsp-test/test/data/documentSymbolFail/example/Main.hs index ca9f84938..fdfe8d301 100644 --- a/lsp-test/test/data/documentSymbolFail/example/Main.hs +++ b/lsp-test/test/data/documentSymbolFail/example/Main.hs @@ -68,6 +68,7 @@ main = do (Just (LSP.CodeLensClientCapabilities (Just False))) (Just (LSP.DocumentLinkClientCapabilities (Just False))) (Just (LSP.RenameClientCapabilities (Just False))) + (Just (LSP.CallHierarchyClientCapabilities (Just False))) initializeParams :: LSP.InitializeParams initializeParams = LSP.InitializeParams (Just pid) Nothing Nothing Nothing caps Nothing diff --git a/lsp-types/lsp-types.cabal b/lsp-types/lsp-types.cabal index 849334107..36a383c3e 100644 --- a/lsp-types/lsp-types.cabal +++ b/lsp-types/lsp-types.cabal @@ -22,7 +22,8 @@ library , Language.LSP.Types.Lens , Language.LSP.VFS , Data.IxMap - other-modules: Language.LSP.Types.Cancellation + other-modules: Language.LSP.Types.CallHierarchy + , Language.LSP.Types.Cancellation , Language.LSP.Types.ClientCapabilities , Language.LSP.Types.CodeAction , Language.LSP.Types.CodeLens diff --git a/lsp-types/src/Language/LSP/Types.hs b/lsp-types/src/Language/LSP/Types.hs index 987c9c810..d6b4c97fe 100644 --- a/lsp-types/src/Language/LSP/Types.hs +++ b/lsp-types/src/Language/LSP/Types.hs @@ -1,5 +1,6 @@ module Language.LSP.Types - ( module Language.LSP.Types.Cancellation + ( module Language.LSP.Types.CallHierarchy + , module Language.LSP.Types.Cancellation , module Language.LSP.Types.CodeAction , module Language.LSP.Types.CodeLens , module Language.LSP.Types.Command @@ -43,6 +44,7 @@ module Language.LSP.Types ) where +import Language.LSP.Types.CallHierarchy import Language.LSP.Types.Cancellation import Language.LSP.Types.CodeAction import Language.LSP.Types.CodeLens diff --git a/lsp-types/src/Language/LSP/Types/CallHierarchy.hs b/lsp-types/src/Language/LSP/Types/CallHierarchy.hs new file mode 100644 index 000000000..051d0fdf9 --- /dev/null +++ b/lsp-types/src/Language/LSP/Types/CallHierarchy.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE TemplateHaskell #-} + +{- | Since LSP 3.16.0 -} +module Language.LSP.Types.CallHierarchy where + +import Data.Aeson.TH +import Data.Aeson.Types ( Value ) +import Data.Text ( Text ) + +import Language.LSP.Types.Common +import Language.LSP.Types.DocumentSymbol +import Language.LSP.Types.Location +import Language.LSP.Types.Progress +import Language.LSP.Types.StaticRegistrationOptions +import Language.LSP.Types.TextDocument +import Language.LSP.Types.Uri +import Language.LSP.Types.Utils + + +data CallHierarchyClientCapabilities = + CallHierarchyClientCapabilities + { _dynamicRegistration :: Maybe Bool } + deriving (Show, Read, Eq) +deriveJSON lspOptions ''CallHierarchyClientCapabilities + +makeExtendingDatatype "CallHierarchyOptions" [''WorkDoneProgressOptions] [] +deriveJSON lspOptions ''CallHierarchyOptions + +makeExtendingDatatype "CallHierarchyRegistrationOptions" + [ ''TextDocumentRegistrationOptions + , ''CallHierarchyOptions + , ''StaticRegistrationOptions + ] + [] +deriveJSON lspOptions ''CallHierarchyRegistrationOptions + +makeExtendingDatatype "CallHierarchyPrepareParams" + [''TextDocumentPositionParams, ''WorkDoneProgressParams] [] +deriveJSON lspOptions ''CallHierarchyPrepareParams + +data CallHierarchyItem = + CallHierarchyItem + { _name :: Text + , _kind :: SymbolKind + , _tags :: Maybe (List SymbolTag) + -- | More detail for this item, e.g. the signature of a function. + , _detail :: Maybe Text + , _uri :: Uri + , _range :: Range + -- | The range that should be selected and revealed when this symbol + -- is being picked, e.g. the name of a function. Must be contained by + -- the @_range@. + , _selectionRange :: Range + -- | A data entry field that is preserved between a call hierarchy + -- prepare and incoming calls or outgoing calls requests. + , _xdata :: Maybe Value + } + deriving (Show, Read, Eq) +deriveJSON lspOptions ''CallHierarchyItem + +-- ------------------------------------- + +makeExtendingDatatype "CallHierarchyIncomingCallsParams" + [ ''WorkDoneProgressParams + , ''PartialResultParams + ] + [("_item", [t| CallHierarchyItem |])] +deriveJSON lspOptions ''CallHierarchyIncomingCallsParams + +data CallHierarchyIncomingCall = + CallHierarchyIncomingCall + { -- | The item that makes the call. + _from :: CallHierarchyItem + -- | The ranges at which the calls appear. This is relative to the caller + -- denoted by @_from@. + , _fromRanges :: List Range + } + deriving (Show, Read, Eq) +deriveJSON lspOptions ''CallHierarchyIncomingCall + +-- ------------------------------------- + +makeExtendingDatatype "CallHierarchyOutgoingCallsParams" + [ ''WorkDoneProgressParams + , ''PartialResultParams + ] + [("_item", [t| CallHierarchyItem |])] +deriveJSON lspOptions ''CallHierarchyOutgoingCallsParams + +data CallHierarchyOutgoingCall = + CallHierarchyOutgoingCall + { -- | The item that is called. + _to :: CallHierarchyItem + -- | The range at which this item is called. THis is the range relative to + -- the caller, e.g the item passed to `callHierarchy/outgoingCalls` request. + , _fromRanges :: List Range + } + deriving (Show, Read, Eq) +deriveJSON lspOptions ''CallHierarchyOutgoingCall diff --git a/lsp-types/src/Language/LSP/Types/Capabilities.hs b/lsp-types/src/Language/LSP/Types/Capabilities.hs index 6ea59a324..6a61c4895 100644 --- a/lsp-types/src/Language/LSP/Types/Capabilities.hs +++ b/lsp-types/src/Language/LSP/Types/Capabilities.hs @@ -51,7 +51,7 @@ capsForVersion (LSPVersion maj min) = ClientCapabilities (Just w) (Just td) (Jus (Just (ExecuteCommandClientCapabilities dynamicReg)) (since 3 6 True) (since 3 6 True) - + resourceOperations = List [ ResourceOperationCreate , ResourceOperationDelete @@ -126,6 +126,7 @@ capsForVersion (LSPVersion maj min) = ClientCapabilities (Just w) (Just td) (Jus (Just publishDiagnosticsCapabilities) (since 3 10 foldingRangeCapability) (since 3 5 (SelectionRangeClientCapabilities dynamicReg)) + (since 3 16 (CallHierarchyClientCapabilities dynamicReg)) sync = TextDocumentSyncClientCapabilities dynamicReg @@ -266,5 +267,5 @@ capsForVersion (LSPVersion maj min) = ClientCapabilities (Just w) (Just td) (Jus since x y a | maj >= x && min >= y = Just a | otherwise = Nothing - + window = WindowClientCapabilities (since 3 15 True) diff --git a/lsp-types/src/Language/LSP/Types/ClientCapabilities.hs b/lsp-types/src/Language/LSP/Types/ClientCapabilities.hs index ced06b373..78fcb5a19 100644 --- a/lsp-types/src/Language/LSP/Types/ClientCapabilities.hs +++ b/lsp-types/src/Language/LSP/Types/ClientCapabilities.hs @@ -6,6 +6,7 @@ module Language.LSP.Types.ClientCapabilities where import Data.Aeson.TH import qualified Data.Aeson as A import Data.Default +import Language.LSP.Types.CallHierarchy import Language.LSP.Types.CodeAction import Language.LSP.Types.CodeLens import Language.LSP.Types.Command @@ -101,7 +102,7 @@ data TextDocumentClientCapabilities = , _onTypeFormatting :: Maybe DocumentOnTypeFormattingClientCapabilities -- | Capabilities specific to the `textDocument/declaration` request. - -- + -- -- Since LSP 3.14.0 , _declaration :: Maybe DeclarationClientCapabilities @@ -142,6 +143,10 @@ data TextDocumentClientCapabilities = -- | Capabilities specific to the `textDocument/selectionRange` request. -- Since LSP 3.15.0 , _selectionRange :: Maybe SelectionRangeClientCapabilities + + -- | Call hierarchy specific to the `textDocument/prepareCallHierarchy` request. + -- Since LSP 3.16.0 + , _callHierarchy :: Maybe CallHierarchyClientCapabilities } deriving (Show, Read, Eq) deriveJSON lspOptions ''TextDocumentClientCapabilities @@ -149,7 +154,7 @@ deriveJSON lspOptions ''TextDocumentClientCapabilities instance Default TextDocumentClientCapabilities where def = TextDocumentClientCapabilities def def def def def def def def def def def def def def def def - def def def def def def + def def def def def def def -- --------------------------------------------------------------------- diff --git a/lsp-types/src/Language/LSP/Types/Lens.hs b/lsp-types/src/Language/LSP/Types/Lens.hs index 3f4e80283..4d156146f 100644 --- a/lsp-types/src/Language/LSP/Types/Lens.hs +++ b/lsp-types/src/Language/LSP/Types/Lens.hs @@ -12,6 +12,7 @@ module Language.LSP.Types.Lens where +import Language.LSP.Types.CallHierarchy import Language.LSP.Types.Cancellation import Language.LSP.Types.ClientCapabilities import Language.LSP.Types.CodeAction @@ -354,3 +355,14 @@ makeFieldsNoPrefix ''SignatureHelp -- Static registration makeFieldsNoPrefix ''StaticRegistrationOptions + +-- Call hierarchy +makeFieldsNoPrefix ''CallHierarchyClientCapabilities +makeFieldsNoPrefix ''CallHierarchyOptions +makeFieldsNoPrefix ''CallHierarchyRegistrationOptions +makeFieldsNoPrefix ''CallHierarchyPrepareParams +makeFieldsNoPrefix ''CallHierarchyIncomingCallsParams +makeFieldsNoPrefix ''CallHierarchyIncomingCall +makeFieldsNoPrefix ''CallHierarchyOutgoingCallsParams +makeFieldsNoPrefix ''CallHierarchyOutgoingCall +makeFieldsNoPrefix ''CallHierarchyItem diff --git a/lsp-types/src/Language/LSP/Types/Message.hs b/lsp-types/src/Language/LSP/Types/Message.hs index 179ca619e..3bea7ab0c 100644 --- a/lsp-types/src/Language/LSP/Types/Message.hs +++ b/lsp-types/src/Language/LSP/Types/Message.hs @@ -17,6 +17,7 @@ module Language.LSP.Types.Message where +import Language.LSP.Types.CallHierarchy import Language.LSP.Types.Cancellation import Language.LSP.Types.CodeAction import Language.LSP.Types.CodeLens @@ -120,6 +121,10 @@ type family MessageParams (m :: Method f t) :: Type where MessageParams TextDocumentFoldingRange = FoldingRangeParams -- Selection Range MessageParams TextDocumentSelectionRange = SelectionRangeParams + -- Call hierarchy + MessageParams TextDocumentPrepareCallHierarchy = CallHierarchyPrepareParams + MessageParams CallHierarchyIncomingCalls = CallHierarchyIncomingCallsParams + MessageParams CallHierarchyOutgoingCalls = CallHierarchyOutgoingCallsParams -- Server -- Window MessageParams WindowShowMessage = ShowMessageParams @@ -193,6 +198,10 @@ type family ResponseResult (m :: Method f Request) :: Type where -- FoldingRange ResponseResult TextDocumentFoldingRange = List FoldingRange ResponseResult TextDocumentSelectionRange = List SelectionRange + -- Call hierarchy + ResponseResult TextDocumentPrepareCallHierarchy = Maybe (List CallHierarchyItem) + ResponseResult CallHierarchyIncomingCalls = Maybe (List CallHierarchyIncomingCall) + ResponseResult CallHierarchyOutgoingCalls = Maybe (List CallHierarchyOutgoingCall) -- Custom can be either a notification or a message -- Server -- Window diff --git a/lsp-types/src/Language/LSP/Types/Method.hs b/lsp-types/src/Language/LSP/Types/Method.hs index bffe6bd71..89462f5a4 100644 --- a/lsp-types/src/Language/LSP/Types/Method.hs +++ b/lsp-types/src/Language/LSP/Types/Method.hs @@ -75,6 +75,10 @@ data Method (f :: From) (t :: MethodType) where -- FoldingRange TextDocumentFoldingRange :: Method FromClient Request TextDocumentSelectionRange :: Method FromClient Request + -- Call hierarchy + TextDocumentPrepareCallHierarchy :: Method FromClient Request + CallHierarchyIncomingCalls :: Method FromClient Request + CallHierarchyOutgoingCalls :: Method FromClient Request -- ServerMethods -- Window @@ -145,6 +149,9 @@ data SMethod (m :: Method f t) where STextDocumentPrepareRename :: SMethod TextDocumentPrepareRename STextDocumentFoldingRange :: SMethod TextDocumentFoldingRange STextDocumentSelectionRange :: SMethod TextDocumentSelectionRange + STextDocumentPrepareCallHierarchy :: SMethod TextDocumentPrepareCallHierarchy + SCallHierarchyIncomingCalls :: SMethod CallHierarchyIncomingCalls + SCallHierarchyOutgoingCalls :: SMethod CallHierarchyOutgoingCalls SWindowShowMessage :: SMethod WindowShowMessage SWindowShowMessageRequest :: SMethod WindowShowMessageRequest @@ -268,6 +275,9 @@ instance FromJSON SomeClientMethod where parseJSON (A.String "textDocument/prepareRename") = pure $ SomeClientMethod STextDocumentPrepareRename parseJSON (A.String "textDocument/foldingRange") = pure $ SomeClientMethod STextDocumentFoldingRange parseJSON (A.String "textDocument/selectionRange") = pure $ SomeClientMethod STextDocumentFoldingRange + parseJSON (A.String "textDocument/prepareCallHierarchy") = pure $ SomeClientMethod STextDocumentPrepareCallHierarchy + parseJSON (A.String "callHierarchy/incomingCalls") = pure $ SomeClientMethod SCallHierarchyIncomingCalls + parseJSON (A.String "callHierarchy/outgoingCalls") = pure $ SomeClientMethod SCallHierarchyOutgoingCalls parseJSON (A.String "window/workDoneProgress/cancel") = pure $ SomeClientMethod SWindowWorkDoneProgressCancel -- Cancelling parseJSON (A.String "$/cancelRequest") = pure $ SomeClientMethod SCancelRequest @@ -359,6 +369,9 @@ instance A.ToJSON (SMethod m) where toJSON STextDocumentPrepareRename = A.String "textDocument/prepareRename" toJSON STextDocumentFoldingRange = A.String "textDocument/foldingRange" toJSON STextDocumentSelectionRange = A.String "textDocument/selectionRange" + toJSON STextDocumentPrepareCallHierarchy = A.String "textDocument/prepareCallHierarchy" + toJSON SCallHierarchyIncomingCalls = A.String "callHierarchy/incomingCalls" + toJSON SCallHierarchyOutgoingCalls = A.String "callHierarchy/outgoingCalls" toJSON STextDocumentDocumentLink = A.String "textDocument/documentLink" toJSON SDocumentLinkResolve = A.String "documentLink/resolve" toJSON SWindowWorkDoneProgressCancel = A.String "window/workDoneProgress/cancel" diff --git a/lsp-types/src/Language/LSP/Types/Parsing.hs b/lsp-types/src/Language/LSP/Types/Parsing.hs index 2c39b7bec..08f756dec 100644 --- a/lsp-types/src/Language/LSP/Types/Parsing.hs +++ b/lsp-types/src/Language/LSP/Types/Parsing.hs @@ -250,6 +250,9 @@ splitClientMethod STextDocumentRename = IsClientReq splitClientMethod STextDocumentPrepareRename = IsClientReq splitClientMethod STextDocumentFoldingRange = IsClientReq splitClientMethod STextDocumentSelectionRange = IsClientReq +splitClientMethod STextDocumentPrepareCallHierarchy = IsClientReq +splitClientMethod SCallHierarchyIncomingCalls = IsClientReq +splitClientMethod SCallHierarchyOutgoingCalls = IsClientReq splitClientMethod SCancelRequest = IsClientNot splitClientMethod SCustomMethod{} = IsClientEither diff --git a/lsp-types/src/Language/LSP/Types/Registration.hs b/lsp-types/src/Language/LSP/Types/Registration.hs index 34c74984e..1499460ac 100644 --- a/lsp-types/src/Language/LSP/Types/Registration.hs +++ b/lsp-types/src/Language/LSP/Types/Registration.hs @@ -29,6 +29,7 @@ import Data.Function (on) import Data.Kind import Data.Void (Void) import GHC.Generics +import Language.LSP.Types.CallHierarchy import Language.LSP.Types.CodeAction import Language.LSP.Types.CodeLens import Language.LSP.Types.Command @@ -96,6 +97,7 @@ type family RegistrationOptions (m :: Method FromClient t) :: Type where RegistrationOptions TextDocumentRename = RenameRegistrationOptions RegistrationOptions TextDocumentFoldingRange = FoldingRangeRegistrationOptions RegistrationOptions TextDocumentSelectionRange = SelectionRangeRegistrationOptions + RegistrationOptions TextDocumentPrepareCallHierarchy = CallHierarchyRegistrationOptions RegistrationOptions m = Void data Registration (m :: Method FromClient t) = diff --git a/lsp-types/src/Language/LSP/Types/ServerCapabilities.hs b/lsp-types/src/Language/LSP/Types/ServerCapabilities.hs index 2c7120a71..6d8e2cd57 100644 --- a/lsp-types/src/Language/LSP/Types/ServerCapabilities.hs +++ b/lsp-types/src/Language/LSP/Types/ServerCapabilities.hs @@ -7,6 +7,7 @@ module Language.LSP.Types.ServerCapabilities where import Data.Aeson import Data.Aeson.TH import Data.Text (Text) +import Language.LSP.Types.CallHierarchy import Language.LSP.Types.CodeAction import Language.LSP.Types.CodeLens import Language.LSP.Types.Command @@ -72,7 +73,7 @@ data ServerCapabilities = -- | The server provides signature help support. , _signatureHelpProvider :: Maybe SignatureHelpOptions -- | The server provides go to declaration support. - -- + -- -- Since LSP 3.14.0 , _declarationProvider :: Maybe (Bool |? DeclarationOptions |? DeclarationRegistrationOptions) -- | The server provides goto definition support. @@ -117,6 +118,8 @@ data ServerCapabilities = , _executeCommandProvider :: Maybe ExecuteCommandOptions -- | The server provides selection range support. Since LSP 3.15 , _selectionRangeProvider :: Maybe (Bool |? SelectionRangeOptions |? SelectionRangeRegistrationOptions) + -- | The server provides call hierarchy support. + , _callHierarchyProvider :: Maybe (Bool |? CallHierarchyOptions |? CallHierarchyRegistrationOptions) -- | The server provides workspace symbol support. , _workspaceSymbolProvider :: Maybe Bool -- | Workspace specific server capabilities diff --git a/lsp/src/Language/LSP/Server/Core.hs b/lsp/src/Language/LSP/Server/Core.hs index f3a353ffc..ceb7de6d6 100644 --- a/lsp/src/Language/LSP/Server/Core.hs +++ b/lsp/src/Language/LSP/Server/Core.hs @@ -535,35 +535,36 @@ registerCapability method regOpts f = do -- | Checks if client capabilities declares that the method supports dynamic registration dynamicSupported clientCaps = case method of - SWorkspaceDidChangeConfiguration -> capDyn $ clientCaps ^? J.workspace . _Just . J.didChangeConfiguration . _Just - SWorkspaceDidChangeWatchedFiles -> capDyn $ clientCaps ^? J.workspace . _Just . J.didChangeWatchedFiles . _Just - SWorkspaceSymbol -> capDyn $ clientCaps ^? J.workspace . _Just . J.symbol . _Just - SWorkspaceExecuteCommand -> capDyn $ clientCaps ^? J.workspace . _Just . J.executeCommand . _Just - STextDocumentDidOpen -> capDyn $ clientCaps ^? J.textDocument . _Just . J.synchronization . _Just - STextDocumentDidChange -> capDyn $ clientCaps ^? J.textDocument . _Just . J.synchronization . _Just - STextDocumentDidClose -> capDyn $ clientCaps ^? J.textDocument . _Just . J.synchronization . _Just - STextDocumentCompletion -> capDyn $ clientCaps ^? J.textDocument . _Just . J.completion . _Just - STextDocumentHover -> capDyn $ clientCaps ^? J.textDocument . _Just . J.hover . _Just - STextDocumentSignatureHelp -> capDyn $ clientCaps ^? J.textDocument . _Just . J.signatureHelp . _Just - STextDocumentDeclaration -> capDyn $ clientCaps ^? J.textDocument . _Just . J.declaration . _Just - STextDocumentDefinition -> capDyn $ clientCaps ^? J.textDocument . _Just . J.definition . _Just - STextDocumentTypeDefinition -> capDyn $ clientCaps ^? J.textDocument . _Just . J.typeDefinition . _Just - STextDocumentImplementation -> capDyn $ clientCaps ^? J.textDocument . _Just . J.implementation . _Just - STextDocumentReferences -> capDyn $ clientCaps ^? J.textDocument . _Just . J.references . _Just - STextDocumentDocumentHighlight -> capDyn $ clientCaps ^? J.textDocument . _Just . J.documentHighlight . _Just - STextDocumentDocumentSymbol -> capDyn $ clientCaps ^? J.textDocument . _Just . J.documentSymbol . _Just - STextDocumentCodeAction -> capDyn $ clientCaps ^? J.textDocument . _Just . J.codeAction . _Just - STextDocumentCodeLens -> capDyn $ clientCaps ^? J.textDocument . _Just . J.codeLens . _Just - STextDocumentDocumentLink -> capDyn $ clientCaps ^? J.textDocument . _Just . J.documentLink . _Just - STextDocumentDocumentColor -> capDyn $ clientCaps ^? J.textDocument . _Just . J.colorProvider . _Just - STextDocumentColorPresentation -> capDyn $ clientCaps ^? J.textDocument . _Just . J.colorProvider . _Just - STextDocumentFormatting -> capDyn $ clientCaps ^? J.textDocument . _Just . J.formatting . _Just - STextDocumentRangeFormatting -> capDyn $ clientCaps ^? J.textDocument . _Just . J.rangeFormatting . _Just - STextDocumentOnTypeFormatting -> capDyn $ clientCaps ^? J.textDocument . _Just . J.onTypeFormatting . _Just - STextDocumentRename -> capDyn $ clientCaps ^? J.textDocument . _Just . J.rename . _Just - STextDocumentFoldingRange -> capDyn $ clientCaps ^? J.textDocument . _Just . J.foldingRange . _Just - STextDocumentSelectionRange -> capDyn $ clientCaps ^? J.textDocument . _Just . J.selectionRange . _Just - _ -> False + SWorkspaceDidChangeConfiguration -> capDyn $ clientCaps ^? J.workspace . _Just . J.didChangeConfiguration . _Just + SWorkspaceDidChangeWatchedFiles -> capDyn $ clientCaps ^? J.workspace . _Just . J.didChangeWatchedFiles . _Just + SWorkspaceSymbol -> capDyn $ clientCaps ^? J.workspace . _Just . J.symbol . _Just + SWorkspaceExecuteCommand -> capDyn $ clientCaps ^? J.workspace . _Just . J.executeCommand . _Just + STextDocumentDidOpen -> capDyn $ clientCaps ^? J.textDocument . _Just . J.synchronization . _Just + STextDocumentDidChange -> capDyn $ clientCaps ^? J.textDocument . _Just . J.synchronization . _Just + STextDocumentDidClose -> capDyn $ clientCaps ^? J.textDocument . _Just . J.synchronization . _Just + STextDocumentCompletion -> capDyn $ clientCaps ^? J.textDocument . _Just . J.completion . _Just + STextDocumentHover -> capDyn $ clientCaps ^? J.textDocument . _Just . J.hover . _Just + STextDocumentSignatureHelp -> capDyn $ clientCaps ^? J.textDocument . _Just . J.signatureHelp . _Just + STextDocumentDeclaration -> capDyn $ clientCaps ^? J.textDocument . _Just . J.declaration . _Just + STextDocumentDefinition -> capDyn $ clientCaps ^? J.textDocument . _Just . J.definition . _Just + STextDocumentTypeDefinition -> capDyn $ clientCaps ^? J.textDocument . _Just . J.typeDefinition . _Just + STextDocumentImplementation -> capDyn $ clientCaps ^? J.textDocument . _Just . J.implementation . _Just + STextDocumentReferences -> capDyn $ clientCaps ^? J.textDocument . _Just . J.references . _Just + STextDocumentDocumentHighlight -> capDyn $ clientCaps ^? J.textDocument . _Just . J.documentHighlight . _Just + STextDocumentDocumentSymbol -> capDyn $ clientCaps ^? J.textDocument . _Just . J.documentSymbol . _Just + STextDocumentCodeAction -> capDyn $ clientCaps ^? J.textDocument . _Just . J.codeAction . _Just + STextDocumentCodeLens -> capDyn $ clientCaps ^? J.textDocument . _Just . J.codeLens . _Just + STextDocumentDocumentLink -> capDyn $ clientCaps ^? J.textDocument . _Just . J.documentLink . _Just + STextDocumentDocumentColor -> capDyn $ clientCaps ^? J.textDocument . _Just . J.colorProvider . _Just + STextDocumentColorPresentation -> capDyn $ clientCaps ^? J.textDocument . _Just . J.colorProvider . _Just + STextDocumentFormatting -> capDyn $ clientCaps ^? J.textDocument . _Just . J.formatting . _Just + STextDocumentRangeFormatting -> capDyn $ clientCaps ^? J.textDocument . _Just . J.rangeFormatting . _Just + STextDocumentOnTypeFormatting -> capDyn $ clientCaps ^? J.textDocument . _Just . J.onTypeFormatting . _Just + STextDocumentRename -> capDyn $ clientCaps ^? J.textDocument . _Just . J.rename . _Just + STextDocumentFoldingRange -> capDyn $ clientCaps ^? J.textDocument . _Just . J.foldingRange . _Just + STextDocumentSelectionRange -> capDyn $ clientCaps ^? J.textDocument . _Just . J.selectionRange . _Just + STextDocumentPrepareCallHierarchy -> capDyn $ clientCaps ^? J.textDocument . _Just . J.callHierarchy . _Just + _ -> False -- | Sends a @client/unregisterCapability@ request and removes the handler -- for that associated registration. diff --git a/lsp/src/Language/LSP/Server/Processing.hs b/lsp/src/Language/LSP/Server/Processing.hs index bbddbd81d..c50ca5b30 100644 --- a/lsp/src/Language/LSP/Server/Processing.hs +++ b/lsp/src/Language/LSP/Server/Processing.hs @@ -163,6 +163,7 @@ inferServerCapabilities clientCaps o h = , _foldingRangeProvider = supportedBool STextDocumentFoldingRange , _executeCommandProvider = executeCommandProvider , _selectionRangeProvider = supportedBool STextDocumentSelectionRange + , _callHierarchyProvider = supportedBool STextDocumentPrepareCallHierarchy , _workspaceSymbolProvider = supported SWorkspaceSymbol , _workspace = Just workspace -- TODO: Add something for experimental diff --git a/lsp/test/MethodSpec.hs b/lsp/test/MethodSpec.hs index 49225fe83..354df8701 100644 --- a/lsp/test/MethodSpec.hs +++ b/lsp/test/MethodSpec.hs @@ -56,6 +56,9 @@ clientMethods = [ ,"documentLink/resolve" ,"textDocument/rename" ,"textDocument/prepareRename" + ,"textDocument/prepareCallHierarchy" + ,"callHierarchy/incomingCalls" + ,"callHierarchy/outgoingCalls" ] serverMethods :: [T.Text]