diff --git a/lsp/src/client_request.ml b/lsp/src/client_request.ml index 67cf74e9f..cbab139e5 100644 --- a/lsp/src/client_request.ml +++ b/lsp/src/client_request.ml @@ -2,14 +2,29 @@ open! Import open Types open Extension +type definition_result = + [ `Definition of Definition.t + | `DefinitionLink of DefinitionLink.t list + ] + +type declaration_result = + [ `Declaration of Declaration.t + | `DeclarationLink of DeclarationLink.t list + ] + +type workspace_symbol_result = + [ `SymbolInformation of SymbolInformation.t list + | `WorkspaceSymbol of WorkspaceSymbol.t list + ] + type _ t = | Shutdown : unit t | Initialize : InitializeParams.t -> InitializeResult.t t | TextDocumentHover : HoverParams.t -> Hover.t option t - | TextDocumentDefinition : DefinitionParams.t -> Locations.t option t - | TextDocumentDeclaration : DeclarationParams.t -> Locations.t option t - | TextDocumentTypeDefinition : TypeDefinitionParams.t -> Locations.t option t - | TextDocumentImplementation : ImplementationParams.t -> Locations.t option t + | TextDocumentDefinition : DefinitionParams.t -> definition_result option t + | TextDocumentDeclaration : DeclarationParams.t -> declaration_result option t + | TextDocumentTypeDefinition : TypeDefinitionParams.t -> definition_result option t + | TextDocumentImplementation : ImplementationParams.t -> definition_result option t | TextDocumentCompletion : CompletionParams.t -> [ `CompletionList of CompletionList.t | `List of CompletionItem.t list ] option t @@ -39,7 +54,7 @@ type _ t = | TextDocumentRangesFormatting : DocumentRangesFormattingParams.t -> TextEdit.t list option t - | TextDocumentRename : RenameParams.t -> WorkspaceEdit.t t + | TextDocumentRename : RenameParams.t -> WorkspaceEdit.t option t | TextDocumentLink : DocumentLinkParams.t -> DocumentLink.t list option t | TextDocumentLinkResolve : DocumentLink.t -> DocumentLink.t t | TextDocumentMoniker : MonikerParams.t -> Moniker.t list option t @@ -50,7 +65,7 @@ type _ t = ] option t - | WorkspaceSymbol : WorkspaceSymbolParams.t -> SymbolInformation.t list option t + | WorkspaceSymbol : WorkspaceSymbolParams.t -> workspace_symbol_result option t | WorkspaceSymbolResolve : WorkspaceSymbol.t -> WorkspaceSymbol.t t | DebugEcho : DebugEcho.Params.t -> DebugEcho.Result.t t | DebugTextDocumentGet : @@ -59,7 +74,7 @@ type _ t = | TextDocumentReferences : ReferenceParams.t -> Location.t list option t | TextDocumentHighlight : DocumentHighlightParams.t -> DocumentHighlight.t list option t | TextDocumentFoldingRange : FoldingRangeParams.t -> FoldingRange.t list option t - | SignatureHelp : SignatureHelpParams.t -> SignatureHelp.t t + | SignatureHelp : SignatureHelpParams.t -> SignatureHelp.t option t | CodeAction : CodeActionParams.t -> CodeActionResult.t t | CodeActionResolve : CodeAction.t -> CodeAction.t t | CompletionItemResolve : CompletionItem.t -> CompletionItem.t t @@ -74,7 +89,7 @@ type _ t = ColorPresentationParams.t -> ColorPresentation.t list t | TextDocumentColor : DocumentColorParams.t -> ColorInformation.t list t - | SelectionRange : SelectionRangeParams.t -> SelectionRange.t list t + | SelectionRange : SelectionRangeParams.t -> SelectionRange.t list option t | ExecuteCommand : ExecuteCommandParams.t -> Json.t t | SemanticTokensFull : SemanticTokensParams.t -> SemanticTokens.t option t | SemanticTokensDelta : @@ -111,6 +126,58 @@ type _ t = } -> Json.t t +let yojson_of_definition_result (result : definition_result) : Json.t = + match result with + | `Definition definition -> Definition.yojson_of_t definition + | `DefinitionLink links -> Json.To.list DefinitionLink.yojson_of_t links +;; + +let definition_result_of_yojson json : definition_result = + Json.Of.untagged_union + "definition result" + [ (fun json -> `Definition (Definition.t_of_yojson json)) + ; (fun json -> `DefinitionLink (Json.Of.list DefinitionLink.t_of_yojson json)) + ] + json +;; + +let yojson_of_declaration_result (result : declaration_result) : Json.t = + match result with + | `Declaration declaration -> Declaration.yojson_of_t declaration + | `DeclarationLink links -> Json.To.list DeclarationLink.yojson_of_t links +;; + +let declaration_result_of_yojson json : declaration_result = + Json.Of.untagged_union + "declaration result" + [ (fun json -> `Declaration (Declaration.t_of_yojson json)) + ; (fun json -> `DeclarationLink (Json.Of.list DeclarationLink.t_of_yojson json)) + ] + json +;; + +let yojson_of_workspace_symbol_result (result : workspace_symbol_result) : Json.t = + match result with + | `SymbolInformation symbols -> Json.To.list SymbolInformation.yojson_of_t symbols + | `WorkspaceSymbol symbols -> Json.To.list WorkspaceSymbol.yojson_of_t symbols +;; + +let workspace_symbol_result_of_yojson json : workspace_symbol_result = + let is_workspace_symbol = function + | `Assoc fields -> + Option.is_some (List.assoc_opt "data" fields) + || + (match List.assoc_opt "location" fields with + | Some (`Assoc location) -> Option.is_none (List.assoc_opt "range" location) + | _ -> false) + | _ -> false + in + match json with + | `List symbols when List.exists symbols ~f:is_workspace_symbol -> + `WorkspaceSymbol (Json.Of.list WorkspaceSymbol.t_of_yojson json) + | _ -> `SymbolInformation (Json.Of.list SymbolInformation.t_of_yojson json) +;; + let yojson_of_DocumentSymbol ds : Json.t = Json.Option.yojson_of_t (function @@ -148,14 +215,14 @@ let yojson_of_result (type a) (req : a t) (result : a) = | Shutdown, () -> `Null | Initialize _, result -> InitializeResult.yojson_of_t result | TextDocumentDeclaration _, result -> - Json.Conv.yojson_of_option Locations.yojson_of_t result + Json.Option.yojson_of_t yojson_of_declaration_result result | TextDocumentHover _, result -> Json.Option.yojson_of_t Hover.yojson_of_t result | TextDocumentDefinition _, result -> - Json.Option.yojson_of_t Locations.yojson_of_t result + Json.Option.yojson_of_t yojson_of_definition_result result | TextDocumentTypeDefinition _, result -> - Json.Option.yojson_of_t Locations.yojson_of_t result + Json.Option.yojson_of_t yojson_of_definition_result result | TextDocumentImplementation _, result -> - Json.Option.yojson_of_t Locations.yojson_of_t result + Json.Option.yojson_of_t yojson_of_definition_result result | TextDocumentCompletion _, result -> yojson_of_Completion result | TextDocumentCodeLens _, result -> Json.To.list CodeLens.yojson_of_t result | TextDocumentCodeLensResolve _, result -> CodeLens.yojson_of_t result @@ -169,7 +236,8 @@ let yojson_of_result (type a) (req : a t) (result : a) = Json.Option.yojson_of_t (Json.To.list TextEdit.yojson_of_t) result | TextDocumentRangesFormatting _, result -> Json.Option.yojson_of_t (Json.To.list TextEdit.yojson_of_t) result - | TextDocumentRename _, result -> WorkspaceEdit.yojson_of_t result + | TextDocumentRename _, result -> + Json.Option.yojson_of_t WorkspaceEdit.yojson_of_t result | DocumentSymbol _, result -> yojson_of_DocumentSymbol result | DebugEcho _, result -> DebugEcho.Result.yojson_of_t result | DebugTextDocumentGet _, result -> DebugTextDocumentGet.Result.yojson_of_t result @@ -181,7 +249,7 @@ let yojson_of_result (type a) (req : a t) (result : a) = Json.Option.yojson_of_t (Json.To.list FoldingRange.yojson_of_t) result | TextDocumentMoniker _, result -> Json.Option.yojson_of_t (Json.To.list Moniker.yojson_of_t) result - | SignatureHelp _, result -> SignatureHelp.yojson_of_t result + | SignatureHelp _, result -> Json.Option.yojson_of_t SignatureHelp.yojson_of_t result | CodeAction _, result -> CodeActionResult.yojson_of_t result | CodeActionResolve _, result -> CodeAction.yojson_of_t result | CompletionItemResolve _, result -> CompletionItem.yojson_of_t result @@ -195,11 +263,12 @@ let yojson_of_result (type a) (req : a t) (result : a) = Json.Option.yojson_of_t (Json.To.list DocumentLink.yojson_of_t) result | TextDocumentLinkResolve _, result -> DocumentLink.yojson_of_t result | WorkspaceSymbol _, result -> - Json.Option.yojson_of_t (Json.To.list SymbolInformation.yojson_of_t) result + Json.Option.yojson_of_t yojson_of_workspace_symbol_result result | TextDocumentColorPresentation _, result -> Json.To.list ColorPresentation.yojson_of_t result | TextDocumentColor _, result -> Json.To.list ColorInformation.yojson_of_t result - | SelectionRange _, result -> Json.yojson_of_list SelectionRange.yojson_of_t result + | SelectionRange _, result -> + Json.Option.yojson_of_t (Json.To.list SelectionRange.yojson_of_t) result | SemanticTokensFull _, result -> Json.Option.yojson_of_t SemanticTokens.yojson_of_t result | SemanticTokensDelta _, result -> yojson_of_SemanticTokensDelta result @@ -556,10 +625,10 @@ let response_of_json (type a) (t : a t) (json : Json.t) : a = | Shutdown -> unit_of_yojson json | Initialize _ -> InitializeResult.t_of_yojson json | TextDocumentHover _ -> option_of_yojson Hover.t_of_yojson json - | TextDocumentDefinition _ -> option_of_yojson Locations.t_of_yojson json - | TextDocumentDeclaration _ -> option_of_yojson Locations.t_of_yojson json - | TextDocumentTypeDefinition _ -> option_of_yojson Locations.t_of_yojson json - | TextDocumentImplementation _ -> option_of_yojson Locations.t_of_yojson json + | TextDocumentDefinition _ -> option_of_yojson definition_result_of_yojson json + | TextDocumentDeclaration _ -> option_of_yojson declaration_result_of_yojson json + | TextDocumentTypeDefinition _ -> option_of_yojson definition_result_of_yojson json + | TextDocumentImplementation _ -> option_of_yojson definition_result_of_yojson json | TextDocumentCompletion _ -> option_of_yojson (Json.Of.untagged_union @@ -577,7 +646,7 @@ let response_of_json (type a) (t : a t) (json : Json.t) : a = option_of_yojson (list_of_yojson TextEdit.t_of_yojson) json | TextDocumentRangesFormatting _ -> option_of_yojson (list_of_yojson TextEdit.t_of_yojson) json - | TextDocumentRename _ -> WorkspaceEdit.t_of_yojson json + | TextDocumentRename _ -> option_of_yojson WorkspaceEdit.t_of_yojson json | TextDocumentLink _ -> option_of_yojson (list_of_yojson DocumentLink.t_of_yojson) json | TextDocumentLinkResolve _ -> DocumentLink.t_of_yojson json | TextDocumentMoniker _ -> option_of_yojson (list_of_yojson Moniker.t_of_yojson) json @@ -590,8 +659,7 @@ let response_of_json (type a) (t : a t) (json : Json.t) : a = `SymbolInformation (list_of_yojson SymbolInformation.t_of_yojson json)) ]) json - | WorkspaceSymbol _ -> - option_of_yojson (list_of_yojson SymbolInformation.t_of_yojson) json + | WorkspaceSymbol _ -> option_of_yojson workspace_symbol_result_of_yojson json | DebugEcho _ -> DebugEcho.Result.t_of_yojson json | DebugTextDocumentGet _ -> DebugTextDocumentGet.Result.t_of_yojson json | TextDocumentReferences _ -> @@ -600,7 +668,7 @@ let response_of_json (type a) (t : a t) (json : Json.t) : a = option_of_yojson (list_of_yojson DocumentHighlight.t_of_yojson) json | TextDocumentFoldingRange _ -> option_of_yojson (list_of_yojson FoldingRange.t_of_yojson) json - | SignatureHelp _ -> SignatureHelp.t_of_yojson json + | SignatureHelp _ -> option_of_yojson SignatureHelp.t_of_yojson json | CodeAction _ -> CodeActionResult.t_of_yojson json | CodeActionResolve _ -> CodeAction.t_of_yojson json | CompletionItemResolve _ -> CompletionItem.t_of_yojson json @@ -612,7 +680,7 @@ let response_of_json (type a) (t : a t) (json : Json.t) : a = option_of_yojson (list_of_yojson TextEdit.t_of_yojson) json | TextDocumentColorPresentation _ -> list_of_yojson ColorPresentation.t_of_yojson json | TextDocumentColor _ -> list_of_yojson ColorInformation.t_of_yojson json - | SelectionRange _ -> list_of_yojson SelectionRange.t_of_yojson json + | SelectionRange _ -> option_of_yojson (list_of_yojson SelectionRange.t_of_yojson) json | ExecuteCommand _ -> json | SemanticTokensFull _ -> option_of_yojson SemanticTokens.t_of_yojson json | SemanticTokensDelta _ -> diff --git a/lsp/src/client_request.mli b/lsp/src/client_request.mli index 16cea2317..e76db2e78 100644 --- a/lsp/src/client_request.mli +++ b/lsp/src/client_request.mli @@ -2,14 +2,29 @@ open! Import open Types open Extension +type definition_result = + [ `Definition of Definition.t + | `DefinitionLink of DefinitionLink.t list + ] + +type declaration_result = + [ `Declaration of Declaration.t + | `DeclarationLink of DeclarationLink.t list + ] + +type workspace_symbol_result = + [ `SymbolInformation of SymbolInformation.t list + | `WorkspaceSymbol of WorkspaceSymbol.t list + ] + type _ t = | Shutdown : unit t | Initialize : InitializeParams.t -> InitializeResult.t t | TextDocumentHover : HoverParams.t -> Hover.t option t - | TextDocumentDefinition : DefinitionParams.t -> Locations.t option t - | TextDocumentDeclaration : DeclarationParams.t -> Locations.t option t - | TextDocumentTypeDefinition : TypeDefinitionParams.t -> Locations.t option t - | TextDocumentImplementation : ImplementationParams.t -> Locations.t option t + | TextDocumentDefinition : DefinitionParams.t -> definition_result option t + | TextDocumentDeclaration : DeclarationParams.t -> declaration_result option t + | TextDocumentTypeDefinition : TypeDefinitionParams.t -> definition_result option t + | TextDocumentImplementation : ImplementationParams.t -> definition_result option t | TextDocumentCompletion : CompletionParams.t -> [ `CompletionList of CompletionList.t | `List of CompletionItem.t list ] option t @@ -39,7 +54,7 @@ type _ t = | TextDocumentRangesFormatting : DocumentRangesFormattingParams.t -> TextEdit.t list option t - | TextDocumentRename : RenameParams.t -> WorkspaceEdit.t t + | TextDocumentRename : RenameParams.t -> WorkspaceEdit.t option t | TextDocumentLink : DocumentLinkParams.t -> DocumentLink.t list option t | TextDocumentLinkResolve : DocumentLink.t -> DocumentLink.t t | TextDocumentMoniker : MonikerParams.t -> Moniker.t list option t @@ -50,7 +65,7 @@ type _ t = ] option t - | WorkspaceSymbol : WorkspaceSymbolParams.t -> SymbolInformation.t list option t + | WorkspaceSymbol : WorkspaceSymbolParams.t -> workspace_symbol_result option t | WorkspaceSymbolResolve : WorkspaceSymbol.t -> WorkspaceSymbol.t t | DebugEcho : DebugEcho.Params.t -> DebugEcho.Result.t t | DebugTextDocumentGet : @@ -59,7 +74,7 @@ type _ t = | TextDocumentReferences : ReferenceParams.t -> Location.t list option t | TextDocumentHighlight : DocumentHighlightParams.t -> DocumentHighlight.t list option t | TextDocumentFoldingRange : FoldingRangeParams.t -> FoldingRange.t list option t - | SignatureHelp : SignatureHelpParams.t -> SignatureHelp.t t + | SignatureHelp : SignatureHelpParams.t -> SignatureHelp.t option t | CodeAction : CodeActionParams.t -> CodeActionResult.t t | CodeActionResolve : CodeAction.t -> CodeAction.t t | CompletionItemResolve : CompletionItem.t -> CompletionItem.t t @@ -74,7 +89,7 @@ type _ t = ColorPresentationParams.t -> ColorPresentation.t list t | TextDocumentColor : DocumentColorParams.t -> ColorInformation.t list t - | SelectionRange : SelectionRangeParams.t -> SelectionRange.t list t + | SelectionRange : SelectionRangeParams.t -> SelectionRange.t list option t | ExecuteCommand : ExecuteCommandParams.t -> Json.t t | SemanticTokensFull : SemanticTokensParams.t -> SemanticTokens.t option t | SemanticTokensDelta : diff --git a/lsp/src/types.ml b/lsp/src/types.ml index b7fd75b3c..0bed34d78 100644 --- a/lsp/src/types.ml +++ b/lsp/src/types.ml @@ -57487,28 +57487,3 @@ module CodeActionResult = struct | _ -> Json.error "CodeActionResult" json ;; end - -module Locations = struct - type t = - [ `Location of Location.t list - | `LocationLink of LocationLink.t list - ] - - let yojson_of_t (t : t) : Json.t = - match t with - | `Location xs -> `List (List.map ~f:Location.yojson_of_t xs) - | `LocationLink l -> `List (List.map ~f:LocationLink.yojson_of_t l) - ;; - - let t_of_yojson (json : Json.t) : t = - match json with - | `Assoc _ -> `Location [ Location.t_of_yojson json ] - | `List [] -> `Location [] - | `List (x :: xs) -> - (match Location.t_of_yojson x with - | loc -> `Location (loc :: List.map ~f:Location.t_of_yojson xs) - | exception Of_yojson_error (_, _) -> - `LocationLink (List.map ~f:LocationLink.t_of_yojson (x :: xs))) - | _ -> Json.error "Locations.t" json - ;; -end diff --git a/lsp/src/types.mli b/lsp/src/types.mli index 8554402b3..0a8b6d035 100644 --- a/lsp/src/types.mli +++ b/lsp/src/types.mli @@ -6274,12 +6274,3 @@ module CodeActionResult : sig include Json.Jsonable.S with type t := t end - -module Locations : sig - type t = - [ `Location of Location.t list - | `LocationLink of LocationLink.t list - ] - - include Json.Jsonable.S with type t := t -end diff --git a/lsp/test/request_result_contract_tests.ml b/lsp/test/request_result_contract_tests.ml index ba405a9ec..5e1c57612 100644 --- a/lsp/test/request_result_contract_tests.ml +++ b/lsp/test/request_result_contract_tests.ml @@ -65,45 +65,37 @@ let%expect_test "definition-like result wire shapes" = [%expect {| definition: - [ - { - "range": { - "end": { "character": 4, "line": 2 }, - "start": { "character": 4, "line": 2 } - }, - "uri": "file:///workspace/test.ml" - } - ] + { + "range": { + "end": { "character": 4, "line": 2 }, + "start": { "character": 4, "line": 2 } + }, + "uri": "file:///workspace/test.ml" + } declaration: - [ - { - "range": { - "end": { "character": 4, "line": 2 }, - "start": { "character": 4, "line": 2 } - }, - "uri": "file:///workspace/test.ml" - } - ] + { + "range": { + "end": { "character": 4, "line": 2 }, + "start": { "character": 4, "line": 2 } + }, + "uri": "file:///workspace/test.ml" + } type definition: - [ - { - "range": { - "end": { "character": 4, "line": 2 }, - "start": { "character": 4, "line": 2 } - }, - "uri": "file:///workspace/test.ml" - } - ] + { + "range": { + "end": { "character": 4, "line": 2 }, + "start": { "character": 4, "line": 2 } + }, + "uri": "file:///workspace/test.ml" + } implementation: - [ - { - "range": { - "end": { "character": 4, "line": 2 }, - "start": { "character": 4, "line": 2 } - }, - "uri": "file:///workspace/test.ml" - } - ] + { + "range": { + "end": { "character": 4, "line": 2 }, + "start": { "character": 4, "line": 2 } + }, + "uri": "file:///workspace/test.ml" + } |}] ;; @@ -153,10 +145,10 @@ let%expect_test "workspace symbol and nullable results" = `Null; [%expect {| - workspace symbol: rejected - signature help null: rejected - selection range null: rejected - rename null: rejected + workspace symbol: accepted + signature help null: accepted + selection range null: accepted + rename null: accepted |}] ;; @@ -181,5 +173,5 @@ let%expect_test "workspace symbol decoding inspects every result" = (Client_request.E (Client_request.WorkspaceSymbol (WorkspaceSymbolParams.create ~query:"value" ()))) workspace_symbols; - [%expect {| workspace symbols: rejected |}] + [%expect {| workspace symbols: accepted |}] ;; diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index ee25b4ba3..2fd008304 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml @@ -630,7 +630,12 @@ let on_request | Some doc -> now (Some (Msource.text (Document.source doc)))) | DebugEcho params -> now params | Shutdown -> Fiber.return (Reply.now (), state) - | WorkspaceSymbol req -> later (fun state () -> Workspace_symbol.run state req) () + | WorkspaceSymbol req -> + later + (fun state () -> + let+ result = Workspace_symbol.run state req in + Option.map result ~f:(fun symbols -> `SymbolInformation symbols)) + () | CodeActionResolve ca -> later (fun state () -> Code_actions.resolve state ca) () | ExecuteCommand command -> if String.equal command.command Merlin_config_command.command_name @@ -714,11 +719,24 @@ let on_request | TextDocumentHighlight req -> later highlight req | DocumentSymbol { textDocument = { uri }; _ } -> later document_symbol uri | TextDocumentDeclaration { textDocument = { uri }; position; _ } -> - later (fun state () -> Definition_query.run `Declaration state uri position) () + later + (fun state () -> + let+ result = Definition_query.run `Declaration state uri position in + Option.map result ~f:(fun (`Location locations) -> + `Declaration (`List locations))) + () | TextDocumentDefinition { textDocument = { uri }; position; _ } -> - later (fun state () -> Definition_query.run `Definition state uri position) () + later + (fun state () -> + let+ result = Definition_query.run `Definition state uri position in + Option.map result ~f:(fun (`Location locations) -> `Definition (`List locations))) + () | TextDocumentTypeDefinition { textDocument = { uri }; position; _ } -> - later (fun state () -> Definition_query.run `Type_definition state uri position) () + later + (fun state () -> + let+ result = Definition_query.run `Type_definition state uri position in + Option.map result ~f:(fun (`Location locations) -> `Definition (`List locations))) + () | TextDocumentCompletion params -> later (fun _ () -> Compl.complete state params) () | TextDocumentPrepareRename req -> later @@ -726,9 +744,19 @@ let on_request let+ result = Rename.prepare state req in Option.map result ~f:(fun range -> `Range range)) req - | TextDocumentRename req -> later Rename.rename req + | TextDocumentRename req -> + later + (fun state req -> + let+ result = Rename.rename state req in + Some result) + req | TextDocumentFoldingRange req -> later Folding_range.compute req - | SignatureHelp req -> later Signature_help.run req + | SignatureHelp req -> + later + (fun state req -> + let+ result = Signature_help.run state req in + Some result) + req | TextDocumentLinkResolve l -> now l | TextDocumentLink _ -> now None | WillSaveWaitUntilTextDocument _ -> now None @@ -753,7 +781,12 @@ let on_request Ocp_indent.format_on_type state.ocp_indent doc position) () | _ -> now (Some [])) - | SelectionRange req -> later selection_range req + | SelectionRange req -> + later + (fun state req -> + let+ result = selection_range state req in + Some result) + req | TextDocumentImplementation _ -> Server.not_supported () | SemanticTokensFull p -> later Semantic_highlighting.on_request_full p | SemanticTokensDelta p -> later Semantic_highlighting.on_request_full_delta p diff --git a/ocaml-lsp-server/test/e2e-new/declaration.ml b/ocaml-lsp-server/test/e2e-new/declaration.ml index 7f8739654..5ee482290 100644 --- a/ocaml-lsp-server/test/e2e-new/declaration.ml +++ b/ocaml-lsp-server/test/e2e-new/declaration.ml @@ -11,15 +11,26 @@ let setup_workspace () = dir ;; +let print_location (location : Location.t) = + print_endline (DocumentUri.to_path location.uri |> Filename.basename); + Range.yojson_of_t location.range + |> Yojson.Safe.pretty_to_string ~std:false + |> print_endline +;; + let print_locations = function | None -> print_endline "[]" - | Some (`Location locations) -> - List.iter locations ~f:(fun (location : Location.t) -> - print_endline (DocumentUri.to_path location.uri |> Filename.basename); - Range.yojson_of_t location.range + | Some (`Definition (`Location location)) -> print_location location + | Some (`Definition (`List locations)) -> List.iter locations ~f:print_location + | Some (`DefinitionLink links) -> + List.iter links ~f:(fun (location : LocationLink.t) -> + print_endline (DocumentUri.to_path location.targetUri |> Filename.basename); + Range.yojson_of_t location.targetRange |> Yojson.Safe.pretty_to_string ~std:false |> print_endline) - | Some (`LocationLink links) -> + | Some (`Declaration (`Location location)) -> print_location location + | Some (`Declaration (`List locations)) -> List.iter locations ~f:print_location + | Some (`DeclarationLink links) -> List.iter links ~f:(fun (location : LocationLink.t) -> print_endline (DocumentUri.to_path location.targetUri |> Filename.basename); Range.yojson_of_t location.targetRange diff --git a/ocaml-lsp-server/test/e2e-new/definition.ml b/ocaml-lsp-server/test/e2e-new/definition.ml index 46985461b..4adf73a6a 100644 --- a/ocaml-lsp-server/test/e2e-new/definition.ml +++ b/ocaml-lsp-server/test/e2e-new/definition.ml @@ -1,6 +1,10 @@ open Test.Import -let print_locations = Test.print_option Locations.yojson_of_t +let print_locations = + Test.print_option (function + | `Definition definition -> Definition.yojson_of_t definition + | `DefinitionLink links -> `List (List.map links ~f:DefinitionLink.yojson_of_t)) +;; let definition client position = let textDocument = TextDocumentIdentifier.create ~uri:Helpers.uri in diff --git a/ocaml-lsp-server/test/e2e-new/rename.ml b/ocaml-lsp-server/test/e2e-new/rename.ml index d893ce31b..6510e19a2 100644 --- a/ocaml-lsp-server/test/e2e-new/rename.ml +++ b/ocaml-lsp-server/test/e2e-new/rename.ml @@ -25,7 +25,10 @@ let print_prepare_rename = function | Some result -> PrepareRenameResult.yojson_of_t result |> Test.print_result ;; -let print_workspace_edit edit = WorkspaceEdit.yojson_of_t edit |> Test.print_result +let print_workspace_edit = function + | None -> print_endline "null" + | Some edit -> WorkspaceEdit.yojson_of_t edit |> Test.print_result +;; let rec censor_backtraces = function | `Assoc fields -> @@ -377,23 +380,25 @@ let open_project_document client ~uri ~version ~text = (TextDocumentDidOpen (DidOpenTextDocumentParams.create ~textDocument)) ;; -let print_document_changes (edit : WorkspaceEdit.t) = - match edit.documentChanges with - | None -> print_endline "missing documentChanges" - | Some changes -> - List.iter changes ~f:(function - | `TextDocumentEdit { textDocument = { uri; version }; edits } -> - let version = Option.value_map version ~default:"null" ~f:Int.to_string in - Printf.printf - "%s (version %s)\n" - (DocumentUri.to_path uri |> Filename.basename) - version; - List.iter edits ~f:(function - | `TextEdit edit -> TextEdit.yojson_of_t edit |> Test.print_result - | `AnnotatedTextEdit _ | `SnippetTextEdit _ -> - failwith "unexpected annotated or snippet edit") - | `CreateFile _ | `RenameFile _ | `DeleteFile _ -> - failwith "unexpected resource operation") +let print_document_changes = function + | None -> print_endline "null" + | Some (edit : WorkspaceEdit.t) -> + (match edit.documentChanges with + | None -> print_endline "missing documentChanges" + | Some changes -> + List.iter changes ~f:(function + | `TextDocumentEdit { textDocument = { uri; version }; edits } -> + let version = Option.value_map version ~default:"null" ~f:Int.to_string in + Printf.printf + "%s (version %s)\n" + (DocumentUri.to_path uri |> Filename.basename) + version; + List.iter edits ~f:(function + | `TextEdit edit -> TextEdit.yojson_of_t edit |> Test.print_result + | `AnnotatedTextEdit _ | `SnippetTextEdit _ -> + failwith "unexpected annotated or snippet edit") + | `CreateFile _ | `RenameFile _ | `DeleteFile _ -> + failwith "unexpected resource operation")) ;; let%expect_test "rename a symbol across open and closed files" = diff --git a/ocaml-lsp-server/test/e2e-new/selection_range.ml b/ocaml-lsp-server/test/e2e-new/selection_range.ml index 350754292..098a7a118 100644 --- a/ocaml-lsp-server/test/e2e-new/selection_range.ml +++ b/ocaml-lsp-server/test/e2e-new/selection_range.ml @@ -7,18 +7,20 @@ let selection_range client positions = (SelectionRange (SelectionRangeParams.create ~textDocument ~positions ())) ;; -let print_selection_ranges ranges = - let rec chain (selection_range : SelectionRange.t) = - let rest = - match selection_range.parent with - | None -> [] - | Some parent -> chain parent +let print_selection_ranges = function + | None -> print_endline "null" + | Some ranges -> + let rec chain (selection_range : SelectionRange.t) = + let rest = + match selection_range.parent with + | None -> [] + | Some parent -> chain parent + in + Range.yojson_of_t selection_range.range :: rest in - Range.yojson_of_t selection_range.range :: rest - in - `List (List.map ranges ~f:(fun range -> `List (chain range))) - |> Yojson.Safe.pretty_to_string ~std:false - |> print_endline + `List (List.map ranges ~f:(fun range -> `List (chain range))) + |> Yojson.Safe.pretty_to_string ~std:false + |> print_endline ;; let test source positions = diff --git a/ocaml-lsp-server/test/e2e-new/signature_help.ml b/ocaml-lsp-server/test/e2e-new/signature_help.ml index 0fb50cdee..68f9ebe1c 100644 --- a/ocaml-lsp-server/test/e2e-new/signature_help.ml +++ b/ocaml-lsp-server/test/e2e-new/signature_help.ml @@ -31,50 +31,57 @@ let make_capabilities let capabilities = make_capabilities ~labelOffsetSupport:true () -let signature_help ?context client position = +let signature_help_nullable ?context client position = let textDocument = TextDocumentIdentifier.create ~uri:Helpers.uri in Client.request client (SignatureHelp (SignatureHelpParams.create ?context ~textDocument ~position ())) ;; -let print_signature_help signature_help = - let json = SignatureHelp.yojson_of_t signature_help in - let documentation = - List.find_map - signature_help.signatures - ~f:(fun (signature : SignatureInformation.t) -> - match signature.documentation with - | None -> None - | Some (`String value | `MarkupContent { value; _ }) -> Some value) - in - let output = - match documentation with - | None -> Yojson.Safe.pretty_to_string ~std:false json - | Some documentation -> - let placeholder = "__SIGNATURE_HELP_DOCUMENTATION__" in - let rec replace_documentation = function - | `String value when String.equal value documentation -> `String placeholder - | `Assoc fields -> - `Assoc - (List.map fields ~f:(fun (name, value) -> name, replace_documentation value)) - | `List values -> `List (List.map values ~f:replace_documentation) - | json -> json - in - let output = - replace_documentation json |> Yojson.Safe.pretty_to_string ~std:false - in - Re.replace_string - (Re.compile (Re.str ("\"" ^ placeholder ^ "\""))) - ~by:("\"" ^ documentation ^ "\"") - output - in - print_endline output +let signature_help ?context client position = + let+ help = signature_help_nullable ?context client position in + Option.value_exn help +;; + +let print_signature_help = function + | None -> print_endline "null" + | Some signature_help -> + let json = SignatureHelp.yojson_of_t signature_help in + let documentation = + List.find_map + signature_help.signatures + ~f:(fun (signature : SignatureInformation.t) -> + match signature.documentation with + | None -> None + | Some (`String value | `MarkupContent { value; _ }) -> Some value) + in + let output = + match documentation with + | None -> Yojson.Safe.pretty_to_string ~std:false json + | Some documentation -> + let placeholder = "__SIGNATURE_HELP_DOCUMENTATION__" in + let rec replace_documentation = function + | `String value when String.equal value documentation -> `String placeholder + | `Assoc fields -> + `Assoc + (List.map fields ~f:(fun (name, value) -> name, replace_documentation value)) + | `List values -> `List (List.map values ~f:replace_documentation) + | json -> json + in + let output = + replace_documentation json |> Yojson.Safe.pretty_to_string ~std:false + in + Re.replace_string + (Re.compile (Re.str ("\"" ^ placeholder ^ "\""))) + ~by:("\"" ^ documentation ^ "\"") + output + in + print_endline output ;; let test ?(capabilities = capabilities) source position = Helpers.test ~capabilities source (fun client -> - let* response = signature_help client position in + let* response = signature_help_nullable client position in print_signature_help response; Fiber.return ()) ;; @@ -745,7 +752,7 @@ let%expect_test "malformed Unicode application returns no signature help" = Helpers.test "a>😀" (fun client -> let* result = Fiber.collect_errors (fun () -> - signature_help client (Position.create ~line:0 ~character:1)) + signature_help_nullable client (Position.create ~line:0 ~character:1)) in match result with | Error [ { Exn_with_backtrace.exn = Jsonrpc.Response.Error.E error; backtrace = _ } ] diff --git a/ocaml-lsp-server/test/e2e-new/type_definition.ml b/ocaml-lsp-server/test/e2e-new/type_definition.ml index 83074e122..06cde24bc 100644 --- a/ocaml-lsp-server/test/e2e-new/type_definition.ml +++ b/ocaml-lsp-server/test/e2e-new/type_definition.ml @@ -1,6 +1,10 @@ open Test.Import -let print_locations = Test.print_option Locations.yojson_of_t +let print_locations = + Test.print_option (function + | `Definition definition -> Definition.yojson_of_t definition + | `DefinitionLink links -> `List (List.map links ~f:DefinitionLink.yojson_of_t)) +;; let iter_type_definition source position k = let makeRequest textDocument = diff --git a/ocaml-lsp-server/test/e2e-new/workspace_symbol.ml b/ocaml-lsp-server/test/e2e-new/workspace_symbol.ml index a96084571..b1a5760c2 100644 --- a/ocaml-lsp-server/test/e2e-new/workspace_symbol.ml +++ b/ocaml-lsp-server/test/e2e-new/workspace_symbol.ml @@ -60,7 +60,7 @@ let%expect_test "reports deprecated workspace symbols" = run [ workspace_a ] (fun client -> let* symbols = workspace_symbol client "deprecated_value" in (match symbols with - | Some [ symbol ] -> + | Some (`SymbolInformation [ symbol ]) -> let deprecated = Option.value_map symbol.deprecated ~default:"missing" ~f:Bool.to_string in @@ -93,7 +93,7 @@ let%expect_test "uses deprecated workspace symbol tags when supported" = run ~capabilities [ workspace_a ] (fun client -> let* symbols = workspace_symbol client "deprecated_value" in (match symbols with - | Some [ symbol ] -> + | Some (`SymbolInformation [ symbol ]) -> let deprecated = Option.value_map symbol.deprecated ~default:"missing" ~f:Bool.to_string in diff --git a/ocaml-lsp-server/test/e2e-new/workspace_symbol_partial_build.ml b/ocaml-lsp-server/test/e2e-new/workspace_symbol_partial_build.ml index 43cef8890..5478d9b97 100644 --- a/ocaml-lsp-server/test/e2e-new/workspace_symbol_partial_build.ml +++ b/ocaml-lsp-server/test/e2e-new/workspace_symbol_partial_build.ml @@ -15,7 +15,8 @@ let%expect_test "missing build directories return empty results without notifica let workspaces = [ workspace_a; workspace_b ] in let print_response label = function | None -> Printf.printf "%s: null\n" label - | Some symbols -> + | Some (`WorkspaceSymbol _) -> failwith "unexpected resolvable workspace symbols" + | Some (`SymbolInformation symbols) -> Printf.printf "%s: " label; symbols |> List.map ~f:(fun symbol -> `String (to_test_result workspaces symbol)) @@ -99,8 +100,13 @@ let relative_path ~root path = let%expect_test "generated source has an existing workspace-symbol location" = let workspace = setup_generated_workspace () in run [ workspace ] (fun client -> - let* symbols = workspace_symbol client "generated_workspace_symbol" in - let symbols = Option.value symbols ~default:[] in + let* result = workspace_symbol client "generated_workspace_symbol" in + let symbols = + match result with + | None -> [] + | Some (`SymbolInformation symbols) -> symbols + | Some (`WorkspaceSymbol _) -> failwith "unexpected resolvable workspace symbols" + in (match List.find symbols ~f:(fun (symbol : SymbolInformation.t) -> String.equal symbol.name "generated_workspace_symbol") diff --git a/ocaml-lsp-server/test/e2e-new/workspace_symbol_test_helpers.ml b/ocaml-lsp-server/test/e2e-new/workspace_symbol_test_helpers.ml index 2c17cd642..e7784d129 100644 --- a/ocaml-lsp-server/test/e2e-new/workspace_symbol_test_helpers.ml +++ b/ocaml-lsp-server/test/e2e-new/workspace_symbol_test_helpers.ml @@ -240,7 +240,12 @@ let to_test_result workspaces (symbol : SymbolInformation.t) = ;; let print_symbols workspaces symbols = - let symbols = Option.value symbols ~default:[] in + let symbols = + match symbols with + | None -> [] + | Some (`SymbolInformation symbols) -> symbols + | Some (`WorkspaceSymbol _) -> failwith "unexpected resolvable workspace symbols" + in List.iter symbols ~f:(fun symbol -> print_endline (to_test_result workspaces symbol)) ;;