From 89d3c540d8304a30a74dd1b174dd90a199a11278 Mon Sep 17 00:00:00 2001 From: PizieDust Date: Tue, 9 Jul 2024 15:54:36 +0100 Subject: [PATCH 01/22] add changes.md entry --- CHANGES.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 09e835ed5..d58f13392 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -44,6 +44,8 @@ - Add custom [`ocamllsp/typeEnclosing`](https://github.com/ocaml/ocaml-lsp/blob/109801e56f2060caf4487427bede28b824f4f1fe/ocaml-lsp-server/docs/ocamllsp/typeEnclosing-spec.md) request (#1304) +- Add custom [`ocamllsp/documentation`] request (#) + ## Fixes From 9e42e82cda3bf38dbfe2798e58ad0a81a40b21b4 Mon Sep 17 00:00:00 2001 From: PizieDust Date: Tue, 9 Jul 2024 15:57:17 +0100 Subject: [PATCH 02/22] add documentation spec --- .../docs/ocamllsp/documentation-spec.md | 40 +++++++++++++++++++ 1 file changed, 40 insertions(+) create mode 100644 ocaml-lsp-server/docs/ocamllsp/documentation-spec.md diff --git a/ocaml-lsp-server/docs/ocamllsp/documentation-spec.md b/ocaml-lsp-server/docs/ocamllsp/documentation-spec.md new file mode 100644 index 000000000..ee34e8df1 --- /dev/null +++ b/ocaml-lsp-server/docs/ocamllsp/documentation-spec.md @@ -0,0 +1,40 @@ +# Documentation Request + +## Description + +Merlin has a command `document` that gets `odoc` documentation for symbols based on a cursor position or an optional identifier. This request allows documentation to be gotten using a classic Merlin workflow. + +## Client capability + +```js +export interface GetDocClientCapabilities { + contentFormat?: MarkupKind[]; +} +``` +- `contentFormat`: Client supports the following content formats if the content property refers to a `literal of type MarkupContent`. The order describes the preferred format of the client. + +## Request + +```js +export interface GetDocParams extends TextDocumentPositionParams +{ + identifier?: string; + contentFormat?:MarkupKind; +} +``` +- `position`: The position of the cursor. +- `identifier`: An optional identifier. If provided, documentation for this ident is looked up from the environment at the given position. Else the server will look for the documentation of the identifier under the cursor. +- `contentFormat`: Optionally override the result's format. Could be `Plaintext` or `Markdown`. + +## Response + +```js +result: GetDoc | null +export interface GetDoc { + doc: MarkupContent; +} + +``` +- `doc`: The documentation found +- A response with null result is returned if the identifier doesn't have documentation. +- An error is returned if the identifier is invalid. From c4e746d5694065a205a3bd32066f614581ae55a7 Mon Sep 17 00:00:00 2001 From: PizieDust Date: Tue, 9 Jul 2024 16:01:56 +0100 Subject: [PATCH 03/22] custom documentation query implementation --- .../src/custom_requests/req_documentation.ml | 120 ++++++++++++++++++ .../src/custom_requests/req_documentation.mli | 38 ++++++ 2 files changed, 158 insertions(+) create mode 100644 ocaml-lsp-server/src/custom_requests/req_documentation.ml create mode 100644 ocaml-lsp-server/src/custom_requests/req_documentation.mli diff --git a/ocaml-lsp-server/src/custom_requests/req_documentation.ml b/ocaml-lsp-server/src/custom_requests/req_documentation.ml new file mode 100644 index 000000000..0e5a9e0c2 --- /dev/null +++ b/ocaml-lsp-server/src/custom_requests/req_documentation.ml @@ -0,0 +1,120 @@ +open Import +module TextDocumentPositionParams = Lsp.Types.TextDocumentPositionParams + +let meth = "ocamllsp/documentation" + +let capability = ("handleDocumentation", `Bool true) + +module GetDocClientCapabilities = struct + type t = { contentFormat : MarkupKind.t list option } + + let yojson_of_t { contentFormat } = + `Assoc + (match contentFormat with + | Some formats -> + [ ( "contentFormat" + , `List + (List.map + ~f:(fun format -> MarkupKind.yojson_of_t format) + formats) ) + ] + | None -> []) + + let t_of_yojson json = + let open Yojson.Safe.Util in + let contentFormat = + json |> member "contentFormat" |> to_list + |> List.map ~f:(fun format -> MarkupKind.t_of_yojson format) + |> Option.some + in + { contentFormat } +end + +module GetDocParams = struct + type t = + { text_document : TextDocumentIdentifier.t + ; position : Position.t + ; identifier : string option + ; contentFormat : MarkupKind.t option + } + + let yojson_of_t { text_document; position; identifier; contentFormat } = + let identifier = + match identifier with + | Some ident -> [ ("identifier", `String ident) ] + | None -> [] + in + let contentFormat = + match contentFormat with + | Some format -> [ ("contentFormat", MarkupKind.yojson_of_t format) ] + | None -> [] + in + `Assoc + (("textDocument", TextDocumentIdentifier.yojson_of_t text_document) + :: ("position", Position.yojson_of_t position) + :: identifier + @ contentFormat) + + let t_of_yojson json = + let open Yojson.Safe.Util in + let textDocumentPosition = + Lsp.Types.TextDocumentPositionParams.t_of_yojson json + in + let identifier = json |> member "identifier" |> to_option to_string in + let contentFormat = + json |> member "contentFormat" |> to_option MarkupKind.t_of_yojson + in + { position = textDocumentPosition.position + ; text_document = textDocumentPosition.textDocument + ; identifier + ; contentFormat + } +end + +module GetDoc = struct + type t = { doc : MarkupContent.t } + + let yojson_of_t { doc } = `Assoc [ ("doc", MarkupContent.yojson_of_t doc) ] + + let t_of_yojson json = + let open Yojson.Safe.Util in + let doc = json |> member "doc" |> MarkupContent.t_of_yojson in + { doc } +end + +let make_documentation_command position ~identifier = + Query_protocol.Document (identifier, position) + +let on_request ~params state = + Fiber.of_thunk (fun () -> + let params = + (Option.value ~default:(`Assoc []) params :> Yojson.Safe.t) + in + let GetDocParams.{ text_document; position; identifier; contentFormat } = + GetDocParams.t_of_yojson params + in + let uri = text_document.uri in + let doc = Document_store.get state.State.store uri in + match Document.kind doc with + | `Other -> Fiber.return `Null + | `Merlin merlin -> + Document.Merlin.with_pipeline_exn merlin (fun pipeline -> + let position = Position.logical position in + let query = make_documentation_command position ~identifier in + let result = Query_commands.dispatch pipeline query in + let response = + match result with + | `No_documentation | `Invalid_context | `Not_found _ -> `Null + | `Builtin value + | `File_not_found value + | `Found value + | `Not_in_env value -> + let markup_content = + match contentFormat with + | Some format -> MarkupContent.create ~kind:format ~value + | None -> + MarkupContent.create ~kind:MarkupKind.PlainText ~value + in + GetDoc.yojson_of_t { doc = markup_content } + in + response)) diff --git a/ocaml-lsp-server/src/custom_requests/req_documentation.mli b/ocaml-lsp-server/src/custom_requests/req_documentation.mli new file mode 100644 index 000000000..16e22cf93 --- /dev/null +++ b/ocaml-lsp-server/src/custom_requests/req_documentation.mli @@ -0,0 +1,38 @@ +val meth : string + +val capability : string * [> `Bool of bool ] + +module GetDocClientCapabilities : sig + type t = { contentFormat : Import.MarkupKind.t list option } + + val yojson_of_t : + t -> [> `Assoc of (string * [> `List of Yojson.Safe.t list ]) list ] + + val t_of_yojson : Yojson.Safe.t -> t +end + +module GetDocParams : sig + type t = + { text_document : Import.TextDocumentIdentifier.t + ; position : Position.t + ; identifier : string option + ; contentFormat : Import.MarkupKind.t option + } + + val yojson_of_t : t -> [> `Assoc of (string * Yojson.Safe.t) list ] + + val t_of_yojson : Yojson.Safe.t -> t +end + +module GetDoc : sig + type t = { doc : Import.MarkupContent.t } + + val yojson_of_t : t -> [> `Assoc of (string * Yojson.Safe.t) list ] + + val t_of_yojson : Yojson.Safe.t -> t +end + +val on_request : + params:[< Yojson.Safe.t > `Assoc ] option + -> State.t + -> [> `Assoc of (string * Yojson.Safe.t) list | `Null ] Fiber.t From 5e8fa765535f1dda78efbf5b591064c939f43165 Mon Sep 17 00:00:00 2001 From: PizieDust Date: Tue, 9 Jul 2024 16:02:16 +0100 Subject: [PATCH 04/22] add to server capabilities --- ocaml-lsp-server/src/ocaml_lsp_server.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index 73f664bc6..d747cf049 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml @@ -100,6 +100,7 @@ let initialize_info (client_capabilities : ClientCapabilities.t) : ; Req_hover_extended.capability ; Req_merlin_call_compatible.capability ; Req_type_enclosing.capability + ; Req_documentation.capability ] ) ] in @@ -523,6 +524,7 @@ let on_request : ; (Req_typed_holes.meth, Req_typed_holes.on_request) ; (Req_merlin_call_compatible.meth, Req_merlin_call_compatible.on_request) ; (Req_type_enclosing.meth, Req_type_enclosing.on_request) + ; (Req_documentation.meth, Req_documentation.on_request) ; (Req_wrapping_ast_node.meth, Req_wrapping_ast_node.on_request) ; ( Semantic_highlighting.Debug.meth_request_full , Semantic_highlighting.Debug.on_request_full ) From 3fff022d3ef3866d32a88cde5aca711fa06ca7ac Mon Sep 17 00:00:00 2001 From: PizieDust Date: Tue, 9 Jul 2024 16:02:35 +0100 Subject: [PATCH 05/22] unit tests --- .../test/e2e-new/documentation.ml | 100 ++++++++++++++++++ ocaml-lsp-server/test/e2e-new/dune | 1 + ocaml-lsp-server/test/e2e-new/start_stop.ml | 3 +- 3 files changed, 103 insertions(+), 1 deletion(-) create mode 100644 ocaml-lsp-server/test/e2e-new/documentation.ml diff --git a/ocaml-lsp-server/test/e2e-new/documentation.ml b/ocaml-lsp-server/test/e2e-new/documentation.ml new file mode 100644 index 000000000..5c5e1f22b --- /dev/null +++ b/ocaml-lsp-server/test/e2e-new/documentation.ml @@ -0,0 +1,100 @@ +open Test.Import + +module Util = struct + let call_documentation ~position ?(identifier = None) ?(contentFormat = None) + client = + let uri = DocumentUri.of_path "test.ml" in + let text_document = + TextDocumentIdentifier.yojson_of_t @@ TextDocumentIdentifier.create ~uri + in + let position = Position.yojson_of_t position in + let params = + `Assoc + (("position", position) + :: (match identifier with + | Some ident -> ("identifier", `String ident) + | None -> ("identifier", `Null)) + :: (match contentFormat with + | Some fmt -> ("contentFormat", `String fmt) + | None -> ("contentFormat", `Null)) + :: [ ("textDocument", text_document) ]) + in + let params = Some (Jsonrpc.Structured.t_of_yojson params) in + let req = + Lsp.Client_request.UnknownRequest + { meth = "ocamllsp/documentation"; params } + in + Client.request client req + + let print_documentation result = + result |> Yojson.Safe.pretty_to_string ~std:false |> print_endline + + let test ~line ~character ?identifier ?contentFormat source = + let position = Position.create ~character ~line in + let request client = + let open Fiber.O in + let+ response = + call_documentation ~position ~identifier ~contentFormat client + in + print_documentation response + in + Helpers.test source request +end + +let%expect_test "Documentation of simple type with no contentFormat and no \ + identifier" = + let source = "type tree (** This is a comment *)" in + let line = 0 in + let character = 7 in + Util.test ~line ~character source; + [%expect + {| { "doc": { "kind": "plaintext", "value": "This is a comment" } } |}] + +let%expect_test "Documentation of simple type with contentFormat set to \ + markdown" = + let source = "type tree (** This is another comment *)" in + let line = 0 in + let character = 7 in + let contentFormat = "markdown" in + Util.test ~line ~character ~contentFormat source; + [%expect + {| { "doc": { "kind": "markdown", "value": "This is another comment" } } |}] + +let%expect_test "Documentation of simple type with an identifier and \ + contentFormat" = + let source = + "{|type tree (** This is another comment *)\n\ + \ List.iter ~f:(fun x -> x*x) [2;4]|}" + in + let line = 0 in + let character = 7 in + let identifier = "List" in + let contentFormat = "markdown" in + Util.test ~line ~character ~identifier ~contentFormat source; + [%expect + {| + { + "doc": { + "kind": "markdown", + "value": "List operations.\n\n Some functions are flagged as not tail-recursive. A tail-recursive\n function uses constant stack space, while a non-tail-recursive function\n uses stack space proportional to the length of its list argument, which\n can be a problem with very long lists. When the function takes several\n list arguments, an approximate formula giving stack usage (in some\n unspecified constant unit) is shown in parentheses.\n\n The above considerations can usually be ignored if your lists are not\n longer than about 10000 elements.\n\n The labeled version of this module can be used as described in the\n {!StdLabels} module." + } + } |}] + +let%expect_test "Documentation of simple type with an identifier and no \ + contentFormat" = + let source = + "{|type tree (** This is another comment *)\n\ + \ List.iter ~f:(fun x -> x*x) [2;4]|}" + in + let line = 0 in + let character = 7 in + let identifier = "List" in + Util.test ~line ~character ~identifier source; + [%expect + {| + { + "doc": { + "kind": "plaintext", + "value": "List operations.\n\n Some functions are flagged as not tail-recursive. A tail-recursive\n function uses constant stack space, while a non-tail-recursive function\n uses stack space proportional to the length of its list argument, which\n can be a problem with very long lists. When the function takes several\n list arguments, an approximate formula giving stack usage (in some\n unspecified constant unit) is shown in parentheses.\n\n The above considerations can usually be ignored if your lists are not\n longer than about 10000 elements.\n\n The labeled version of this module can be used as described in the\n {!StdLabels} module." + } + } |}] diff --git a/ocaml-lsp-server/test/e2e-new/dune b/ocaml-lsp-server/test/e2e-new/dune index da23f37d7..05998f862 100644 --- a/ocaml-lsp-server/test/e2e-new/dune +++ b/ocaml-lsp-server/test/e2e-new/dune @@ -61,6 +61,7 @@ syntax_doc_tests test type_enclosing + documentation with_pp with_ppx workspace_change_config)))) diff --git a/ocaml-lsp-server/test/e2e-new/start_stop.ml b/ocaml-lsp-server/test/e2e-new/start_stop.ml index 278f13673..4c74e0e78 100644 --- a/ocaml-lsp-server/test/e2e-new/start_stop.ml +++ b/ocaml-lsp-server/test/e2e-new/start_stop.ml @@ -93,7 +93,8 @@ let%expect_test "start/stop" = "diagnostic_promotions": true, "handleHoverExtended": true, "handleMerlinCallCompatible": true, - "handleTypeEnclosing": true + "handleTypeEnclosing": true, + "handleDocumentation": true } }, "foldingRangeProvider": true, From 18394fe64239617d0a239ca02e0bbb8457952174 Mon Sep 17 00:00:00 2001 From: PizieDust Date: Tue, 9 Jul 2024 16:06:28 +0100 Subject: [PATCH 06/22] add link to documentation and PR id --- CHANGES.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index d58f13392..82f249bd1 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -44,7 +44,7 @@ - Add custom [`ocamllsp/typeEnclosing`](https://github.com/ocaml/ocaml-lsp/blob/109801e56f2060caf4487427bede28b824f4f1fe/ocaml-lsp-server/docs/ocamllsp/typeEnclosing-spec.md) request (#1304) -- Add custom [`ocamllsp/documentation`] request (#) +- Add custom [`ocamllsp/documentation`](/ocaml-lsp-server/docs/ocamllsp/documentation-spec.md) request (#1336) ## Fixes From cc8ac40f9d8ea09abd877e6025820c8f6ea4340f Mon Sep 17 00:00:00 2001 From: PizieDust Date: Mon, 15 Jul 2024 13:19:51 +0100 Subject: [PATCH 07/22] remove unnessary methods --- .../src/custom_requests/req_documentation.mli | 30 +++---------------- 1 file changed, 4 insertions(+), 26 deletions(-) diff --git a/ocaml-lsp-server/src/custom_requests/req_documentation.mli b/ocaml-lsp-server/src/custom_requests/req_documentation.mli index 16e22cf93..90658925f 100644 --- a/ocaml-lsp-server/src/custom_requests/req_documentation.mli +++ b/ocaml-lsp-server/src/custom_requests/req_documentation.mli @@ -1,35 +1,13 @@ +open Import + val meth : string val capability : string * [> `Bool of bool ] module GetDocClientCapabilities : sig - type t = { contentFormat : Import.MarkupKind.t list option } - - val yojson_of_t : - t -> [> `Assoc of (string * [> `List of Yojson.Safe.t list ]) list ] - - val t_of_yojson : Yojson.Safe.t -> t -end - -module GetDocParams : sig - type t = - { text_document : Import.TextDocumentIdentifier.t - ; position : Position.t - ; identifier : string option - ; contentFormat : Import.MarkupKind.t option - } - - val yojson_of_t : t -> [> `Assoc of (string * Yojson.Safe.t) list ] - - val t_of_yojson : Yojson.Safe.t -> t -end - -module GetDoc : sig - type t = { doc : Import.MarkupContent.t } - - val yojson_of_t : t -> [> `Assoc of (string * Yojson.Safe.t) list ] + type t = { contentFormat : MarkupKind.t list } - val t_of_yojson : Yojson.Safe.t -> t + val yojson_of_t : t -> [> `Assoc of [> `List of Json.t list ] ] end val on_request : From 7e43f3998e715e29f3627e3768690995965bea52 Mon Sep 17 00:00:00 2001 From: PizieDust Date: Mon, 15 Jul 2024 13:20:16 +0100 Subject: [PATCH 08/22] make contentFormat non-optional in GetDocClientCapabilities --- ocaml-lsp-server/docs/ocamllsp/documentation-spec.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml-lsp-server/docs/ocamllsp/documentation-spec.md b/ocaml-lsp-server/docs/ocamllsp/documentation-spec.md index ee34e8df1..4f9679edb 100644 --- a/ocaml-lsp-server/docs/ocamllsp/documentation-spec.md +++ b/ocaml-lsp-server/docs/ocamllsp/documentation-spec.md @@ -8,7 +8,7 @@ Merlin has a command `document` that gets `odoc` documentation for symbols based ```js export interface GetDocClientCapabilities { - contentFormat?: MarkupKind[]; + contentFormat: MarkupKind[]; } ``` - `contentFormat`: Client supports the following content formats if the content property refers to a `literal of type MarkupContent`. The order describes the preferred format of the client. From 134a4efa5a29999f60019d5885cc44a6868dd4ae Mon Sep 17 00:00:00 2001 From: PizieDust Date: Mon, 15 Jul 2024 13:20:29 +0100 Subject: [PATCH 09/22] refactor according to code review --- .../src/custom_requests/req_documentation.ml | 87 +++++-------------- 1 file changed, 24 insertions(+), 63 deletions(-) diff --git a/ocaml-lsp-server/src/custom_requests/req_documentation.ml b/ocaml-lsp-server/src/custom_requests/req_documentation.ml index 0e5a9e0c2..f5711bd58 100644 --- a/ocaml-lsp-server/src/custom_requests/req_documentation.ml +++ b/ocaml-lsp-server/src/custom_requests/req_documentation.ml @@ -6,28 +6,14 @@ let meth = "ocamllsp/documentation" let capability = ("handleDocumentation", `Bool true) module GetDocClientCapabilities = struct - type t = { contentFormat : MarkupKind.t list option } + type t = { contentFormat : MarkupKind.t list } let yojson_of_t { contentFormat } = `Assoc - (match contentFormat with - | Some formats -> - [ ( "contentFormat" - , `List - (List.map - ~f:(fun format -> MarkupKind.yojson_of_t format) - formats) ) - ] - | None -> []) - - let t_of_yojson json = - let open Yojson.Safe.Util in - let contentFormat = - json |> member "contentFormat" |> to_list - |> List.map ~f:(fun format -> MarkupKind.t_of_yojson format) - |> Option.some - in - { contentFormat } + (`List + (List.map + ~f:(fun format -> MarkupKind.yojson_of_t format) + contentFormat)) end module GetDocParams = struct @@ -38,23 +24,6 @@ module GetDocParams = struct ; contentFormat : MarkupKind.t option } - let yojson_of_t { text_document; position; identifier; contentFormat } = - let identifier = - match identifier with - | Some ident -> [ ("identifier", `String ident) ] - | None -> [] - in - let contentFormat = - match contentFormat with - | Some format -> [ ("contentFormat", MarkupKind.yojson_of_t format) ] - | None -> [] - in - `Assoc - (("textDocument", TextDocumentIdentifier.yojson_of_t text_document) - :: ("position", Position.yojson_of_t position) - :: identifier - @ contentFormat) - let t_of_yojson json = let open Yojson.Safe.Util in let textDocumentPosition = @@ -76,14 +45,26 @@ module GetDoc = struct let yojson_of_t { doc } = `Assoc [ ("doc", MarkupContent.yojson_of_t doc) ] - let t_of_yojson json = - let open Yojson.Safe.Util in - let doc = json |> member "doc" |> MarkupContent.t_of_yojson in - { doc } + let create ~kind ~value = MarkupContent.create ~kind ~value end -let make_documentation_command position ~identifier = - Query_protocol.Document (identifier, position) +let dispatch ~merlin ~position ~identifier ~contentFormat = + Document.Merlin.with_pipeline_exn merlin (fun pipeline -> + let position = Position.logical position in + let query = Query_protocol.Document (identifier, position) in + let result = Query_commands.dispatch pipeline query in + match result with + | `No_documentation | `Invalid_context | `Not_found _ -> `Null + | `Builtin value + | `File_not_found value + | `Found value + | `Not_in_env value -> + let markup_content = + match contentFormat with + | Some format -> GetDoc.create ~kind:format ~value + | None -> GetDoc.create ~kind:MarkupKind.PlainText ~value + in + GetDoc.yojson_of_t { doc = markup_content }) let on_request ~params state = Fiber.of_thunk (fun () -> @@ -97,24 +78,4 @@ let on_request ~params state = let doc = Document_store.get state.State.store uri in match Document.kind doc with | `Other -> Fiber.return `Null - | `Merlin merlin -> - Document.Merlin.with_pipeline_exn merlin (fun pipeline -> - let position = Position.logical position in - let query = make_documentation_command position ~identifier in - let result = Query_commands.dispatch pipeline query in - let response = - match result with - | `No_documentation | `Invalid_context | `Not_found _ -> `Null - | `Builtin value - | `File_not_found value - | `Found value - | `Not_in_env value -> - let markup_content = - match contentFormat with - | Some format -> MarkupContent.create ~kind:format ~value - | None -> - MarkupContent.create ~kind:MarkupKind.PlainText ~value - in - GetDoc.yojson_of_t { doc = markup_content } - in - response)) + | `Merlin merlin -> dispatch ~merlin ~position ~identifier ~contentFormat) From 27c72dbe4514bc6135de22ba6729ef1f9a92771c Mon Sep 17 00:00:00 2001 From: PizieDust Date: Mon, 15 Jul 2024 13:28:05 +0100 Subject: [PATCH 10/22] shadow list module in test --- .../test/e2e-new/documentation.ml | 24 +++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/ocaml-lsp-server/test/e2e-new/documentation.ml b/ocaml-lsp-server/test/e2e-new/documentation.ml index 5c5e1f22b..d693a507e 100644 --- a/ocaml-lsp-server/test/e2e-new/documentation.ml +++ b/ocaml-lsp-server/test/e2e-new/documentation.ml @@ -98,3 +98,27 @@ let%expect_test "Documentation of simple type with an identifier and no \ "value": "List operations.\n\n Some functions are flagged as not tail-recursive. A tail-recursive\n function uses constant stack space, while a non-tail-recursive function\n uses stack space proportional to the length of its list argument, which\n can be a problem with very long lists. When the function takes several\n list arguments, an approximate formula giving stack usage (in some\n unspecified constant unit) is shown in parentheses.\n\n The above considerations can usually be ignored if your lists are not\n longer than about 10000 elements.\n\n The labeled version of this module can be used as described in the\n {!StdLabels} module." } } |}] + +let%expect_test "Documentation when List module is shadowed" = + let source = + "{|\n\ + module List = struct\n\ + \ (** This is my custom list module *)\n\ + \ let rec iter ~f = function (** This is the custom iter module *)\n\ + \ | [] -> () (** This is when the list is empty *)\n\ + \ | x :: xs -> f x; iter ~f xs\n\ + end\n\ + List.iter ~f:(fun x -> x*x) [2;4]\n\ + |}" + in + let line = 1 in + let character = 8 in + Util.test ~line ~character source; + [%expect + {| + { + "doc": { + "kind": "plaintext", + "value": "List operations.\n\n Some functions are flagged as not tail-recursive. A tail-recursive\n function uses constant stack space, while a non-tail-recursive function\n uses stack space proportional to the length of its list argument, which\n can be a problem with very long lists. When the function takes several\n list arguments, an approximate formula giving stack usage (in some\n unspecified constant unit) is shown in parentheses.\n\n The above considerations can usually be ignored if your lists are not\n longer than about 10000 elements.\n\n The labeled version of this module can be used as described in the\n {!StdLabels} module." + } + } |}] From 9455a96e3760207fa77d091f1587bc02fb97cf05 Mon Sep 17 00:00:00 2001 From: PizieDust Date: Tue, 16 Jul 2024 12:11:31 +0100 Subject: [PATCH 11/22] add type --- ocaml-lsp-server/src/custom_requests/req_documentation.ml | 2 ++ ocaml-lsp-server/src/custom_requests/req_documentation.mli | 7 +++++++ 2 files changed, 9 insertions(+) diff --git a/ocaml-lsp-server/src/custom_requests/req_documentation.ml b/ocaml-lsp-server/src/custom_requests/req_documentation.ml index f5711bd58..3baa94e19 100644 --- a/ocaml-lsp-server/src/custom_requests/req_documentation.ml +++ b/ocaml-lsp-server/src/custom_requests/req_documentation.ml @@ -48,6 +48,8 @@ module GetDoc = struct let create ~kind ~value = MarkupContent.create ~kind ~value end +type t = GetDoc.t + let dispatch ~merlin ~position ~identifier ~contentFormat = Document.Merlin.with_pipeline_exn merlin (fun pipeline -> let position = Position.logical position in diff --git a/ocaml-lsp-server/src/custom_requests/req_documentation.mli b/ocaml-lsp-server/src/custom_requests/req_documentation.mli index 90658925f..fc130afe8 100644 --- a/ocaml-lsp-server/src/custom_requests/req_documentation.mli +++ b/ocaml-lsp-server/src/custom_requests/req_documentation.mli @@ -10,7 +10,14 @@ module GetDocClientCapabilities : sig val yojson_of_t : t -> [> `Assoc of [> `List of Json.t list ] ] end +module GetDoc : sig + type t = { doc : MarkupContent.t } +end + +type t = GetDoc.t + val on_request : params:[< Yojson.Safe.t > `Assoc ] option -> State.t -> [> `Assoc of (string * Yojson.Safe.t) list | `Null ] Fiber.t + From fa30962f391676f8018eee1b3ca23e70bdcd7b0e Mon Sep 17 00:00:00 2001 From: PizieDust Date: Tue, 16 Jul 2024 12:26:32 +0100 Subject: [PATCH 12/22] lint --- ocaml-lsp-server/src/custom_requests/req_documentation.mli | 1 - 1 file changed, 1 deletion(-) diff --git a/ocaml-lsp-server/src/custom_requests/req_documentation.mli b/ocaml-lsp-server/src/custom_requests/req_documentation.mli index fc130afe8..ae29aac88 100644 --- a/ocaml-lsp-server/src/custom_requests/req_documentation.mli +++ b/ocaml-lsp-server/src/custom_requests/req_documentation.mli @@ -20,4 +20,3 @@ val on_request : params:[< Yojson.Safe.t > `Assoc ] option -> State.t -> [> `Assoc of (string * Yojson.Safe.t) list | `Null ] Fiber.t - From 885e0371a836996b6895f1a5057f9bfdbf80e014 Mon Sep 17 00:00:00 2001 From: PizieDust Date: Wed, 17 Jul 2024 10:50:44 +0100 Subject: [PATCH 13/22] more test --- .../test/e2e-new/documentation.ml | 53 ++++++++++++++++++- 1 file changed, 51 insertions(+), 2 deletions(-) diff --git a/ocaml-lsp-server/test/e2e-new/documentation.ml b/ocaml-lsp-server/test/e2e-new/documentation.ml index d693a507e..b7cc87ef5 100644 --- a/ocaml-lsp-server/test/e2e-new/documentation.ml +++ b/ocaml-lsp-server/test/e2e-new/documentation.ml @@ -102,17 +102,66 @@ let%expect_test "Documentation of simple type with an identifier and no \ let%expect_test "Documentation when List module is shadowed" = let source = "{|\n\ + List.iter ~f:(fun x -> x*x) [2;4]\n\ + \ module List = struct\n\ + \ (** This is my custom list module *)\n\ + \ let rec iter ~f = function (** This is the custom iter module *)\n\ + \ | [] -> () (** This is when the list is empty *)\n\ + \ | x :: xs -> f x; iter ~f xs\n\ + end\n\ + List.iter ~f:(fun x -> x*x) [2;4]\n\ + |}" + in + let line = 2 in + let character = 6 in + let identifier = "List.iter" in + Util.test ~line ~character ~identifier source; + [%expect + {| + { + "doc": { + "kind": "plaintext", + "value": "[iter f [a1; ...; an]] applies function [f] in turn to\n [a1; ...; an]. It is equivalent to\n [begin f a1; f a2; ...; f an; () end]." + } + } |}] + +let%expect_test "Documentation when List module is shadowed" = + let source = + "{|\n\ + List.iter ~f:(fun x -> x*x) [2;4]\n\ module List = struct\n\ \ (** This is my custom list module *)\n\ \ let rec iter ~f = function (** This is the custom iter module *)\n\ \ | [] -> () (** This is when the list is empty *)\n\ \ | x :: xs -> f x; iter ~f xs\n\ end\n\ + Base.List.iter ~f:(fun x -> x*x) [2;4]\n\ + |}" + in + let line = 7 in + let character = 12 in + let identifier = "Base.List.iter" in + Util.test ~line ~character ~identifier source; + [%expect + {| + { "doc": { "kind": "plaintext", "value": "Base.List.iter" } } |}] + +(* TODO: Open Issue in Merlin to investigate while this doesnt return documentation of the custom List module*) +let%expect_test "Documentation when List module is shadowed" = + let source = + "{|\n\ List.iter ~f:(fun x -> x*x) [2;4]\n\ + module List = struct\n\ + \ (** This is my custom list module *)\n\ + \ let rec iter ~f = function (** This is the custom iter module *)\n\ + \ | [] -> () (** This is when the list is empty *)\n\ + \ | x :: xs -> f x; iter ~f xs\n\ + end\n\ + Base.List.iter ~f:(fun x -> x*x) [2;4]\n\ |}" in - let line = 1 in - let character = 8 in + let line = 2 in + let character = 9 in Util.test ~line ~character source; [%expect {| From 70f09418a69a4f5fa90ab9cf2a365782c9cef4db Mon Sep 17 00:00:00 2001 From: PizieDust Date: Wed, 17 Jul 2024 11:17:34 +0100 Subject: [PATCH 14/22] expose req_document --- ocaml-lsp-server/src/custom_requests/custom_request.ml | 1 + ocaml-lsp-server/src/custom_requests/custom_request.mli | 1 + 2 files changed, 2 insertions(+) diff --git a/ocaml-lsp-server/src/custom_requests/custom_request.ml b/ocaml-lsp-server/src/custom_requests/custom_request.ml index 1ff29c6ea..932172dd5 100644 --- a/ocaml-lsp-server/src/custom_requests/custom_request.ml +++ b/ocaml-lsp-server/src/custom_requests/custom_request.ml @@ -5,3 +5,4 @@ module Switch_impl_intf = Req_switch_impl_intf module Typed_holes = Req_typed_holes module Type_enclosing = Req_type_enclosing module Wrapping_ast_node = Req_wrapping_ast_node +module Documentation = Req_documentation diff --git a/ocaml-lsp-server/src/custom_requests/custom_request.mli b/ocaml-lsp-server/src/custom_requests/custom_request.mli index b941ee8e1..ff361f7bb 100644 --- a/ocaml-lsp-server/src/custom_requests/custom_request.mli +++ b/ocaml-lsp-server/src/custom_requests/custom_request.mli @@ -7,3 +7,4 @@ module Switch_impl_intf = Req_switch_impl_intf module Typed_holes = Req_typed_holes module Type_enclosing = Req_type_enclosing module Wrapping_ast_node = Req_wrapping_ast_node +module Documentation = Req_documentation From 938163ddc246925f5ea6ee04d7dd8ea07fd8e296 Mon Sep 17 00:00:00 2001 From: PizieDust Date: Thu, 18 Jul 2024 07:25:32 +0100 Subject: [PATCH 15/22] refactor according to code review. expose custom getDoc --- CHANGES.md | 2 +- ...ation-spec.md => getDocumentation-spec.md} | 16 ++- .../src/custom_requests/req_documentation.ml | 101 +++++++++++------- .../src/custom_requests/req_documentation.mli | 27 +++-- ocaml-lsp-server/src/ocaml_lsp_server.ml | 4 +- .../test/e2e-new/documentation.ml | 62 ++++------- 6 files changed, 112 insertions(+), 100 deletions(-) rename ocaml-lsp-server/docs/ocamllsp/{documentation-spec.md => getDocumentation-spec.md} (56%) diff --git a/CHANGES.md b/CHANGES.md index 5707ef044..e27acbbf7 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -51,7 +51,7 @@ - Add custom [`ocamllsp/typeEnclosing`](https://github.com/ocaml/ocaml-lsp/blob/109801e56f2060caf4487427bede28b824f4f1fe/ocaml-lsp-server/docs/ocamllsp/typeEnclosing-spec.md) request (#1304) -- Add custom [`ocamllsp/documentation`](/ocaml-lsp-server/docs/ocamllsp/documentation-spec.md) request (#1336) +- Add custom [`ocamllsp/getDocumentation`](/ocaml-lsp-server/docs/ocamllsp/getDocumentation-spec.md) request (#1336) ## Fixes diff --git a/ocaml-lsp-server/docs/ocamllsp/documentation-spec.md b/ocaml-lsp-server/docs/ocamllsp/getDocumentation-spec.md similarity index 56% rename from ocaml-lsp-server/docs/ocamllsp/documentation-spec.md rename to ocaml-lsp-server/docs/ocamllsp/getDocumentation-spec.md index 4f9679edb..10a6006f8 100644 --- a/ocaml-lsp-server/docs/ocamllsp/documentation-spec.md +++ b/ocaml-lsp-server/docs/ocamllsp/getDocumentation-spec.md @@ -2,7 +2,7 @@ ## Description -Merlin has a command `document` that gets `odoc` documentation for symbols based on a cursor position or an optional identifier. This request allows documentation to be gotten using a classic Merlin workflow. + This custom request allows `odoc` documentation to be gotten without using Hover. ## Client capability @@ -13,6 +13,12 @@ export interface GetDocClientCapabilities { ``` - `contentFormat`: Client supports the following content formats if the content property refers to a `literal of type MarkupContent`. The order describes the preferred format of the client. +## Server capability + +- property name: `handleDocumentation` +- property type: `boolean` + + ## Request ```js @@ -22,9 +28,11 @@ export interface GetDocParams extends TextDocumentPositionParams contentFormat?:MarkupKind; } ``` -- `position`: The position of the cursor. -- `identifier`: An optional identifier. If provided, documentation for this ident is looked up from the environment at the given position. Else the server will look for the documentation of the identifier under the cursor. -- `contentFormat`: Optionally override the result's format. Could be `Plaintext` or `Markdown`. +- method : `ocamllsp/getDocumentation` +- params : + - `position`: The position of the cursor. + - `identifier`: An optional identifier. If provided, documentation for this ident is looked up from the environment at the given position. Else the server will look for the documentation of the identifier under the cursor. + - `contentFormat`: Optionally override the result's format. Could be `Plaintext` or `Markdown`. ## Response diff --git a/ocaml-lsp-server/src/custom_requests/req_documentation.ml b/ocaml-lsp-server/src/custom_requests/req_documentation.ml index 3baa94e19..29776b15a 100644 --- a/ocaml-lsp-server/src/custom_requests/req_documentation.ml +++ b/ocaml-lsp-server/src/custom_requests/req_documentation.ml @@ -1,19 +1,15 @@ open Import module TextDocumentPositionParams = Lsp.Types.TextDocumentPositionParams -let meth = "ocamllsp/documentation" - -let capability = ("handleDocumentation", `Bool true) +let meth = "ocamllsp/getDocumentation" +let capability = "handleDocumentation", `Bool true module GetDocClientCapabilities = struct - type t = { contentFormat : MarkupKind.t list } + type _t = { contentFormat : MarkupKind.t list } - let yojson_of_t { contentFormat } = + let _yojson_of_t { contentFormat } = `Assoc - (`List - (List.map - ~f:(fun format -> MarkupKind.yojson_of_t format) - contentFormat)) + (`List (List.map ~f:(fun format -> MarkupKind.yojson_of_t format) contentFormat)) end module GetDocParams = struct @@ -26,9 +22,7 @@ module GetDocParams = struct let t_of_yojson json = let open Yojson.Safe.Util in - let textDocumentPosition = - Lsp.Types.TextDocumentPositionParams.t_of_yojson json - in + let textDocumentPosition = Lsp.Types.TextDocumentPositionParams.t_of_yojson json in let identifier = json |> member "identifier" |> to_option to_string in let contentFormat = json |> member "contentFormat" |> to_option MarkupKind.t_of_yojson @@ -38,46 +32,75 @@ module GetDocParams = struct ; identifier ; contentFormat } + + let yojson_of_t { text_document; position; identifier; contentFormat } = + let identifier = + match identifier with + | Some ident -> [ ("identifier", `String ident) ] + | None -> [] + in + let contentFormat = + match contentFormat with + | Some format -> [ ("contentFormat", MarkupKind.yojson_of_t format) ] + | None -> [] + in + `Assoc + (("textDocument", TextDocumentIdentifier.yojson_of_t text_document) + :: ("position", Position.yojson_of_t position) + :: identifier + @ contentFormat) end module GetDoc = struct type t = { doc : MarkupContent.t } - let yojson_of_t { doc } = `Assoc [ ("doc", MarkupContent.yojson_of_t doc) ] + let yojson_of_t { doc } = `Assoc [ "doc", MarkupContent.yojson_of_t doc ] + + let t_of_yojson json = + let open Yojson.Safe.Util in + let doc = json |> member "doc" |> MarkupContent.t_of_yojson in + { doc } let create ~kind ~value = MarkupContent.create ~kind ~value end type t = GetDoc.t +let t_of_yojson json = GetDoc.t_of_yojson json + +module Request_params = struct + type t = GetDocParams.t + + let yojson_of_t t = GetDocParams.yojson_of_t t + + let create ~text_document ~position ?(identifier = None) ?(contentFormat = None) () : t = + {text_document; identifier; contentFormat; position} +end let dispatch ~merlin ~position ~identifier ~contentFormat = Document.Merlin.with_pipeline_exn merlin (fun pipeline -> - let position = Position.logical position in - let query = Query_protocol.Document (identifier, position) in - let result = Query_commands.dispatch pipeline query in - match result with - | `No_documentation | `Invalid_context | `Not_found _ -> `Null - | `Builtin value - | `File_not_found value - | `Found value - | `Not_in_env value -> - let markup_content = - match contentFormat with - | Some format -> GetDoc.create ~kind:format ~value - | None -> GetDoc.create ~kind:MarkupKind.PlainText ~value - in - GetDoc.yojson_of_t { doc = markup_content }) + let position = Position.logical position in + let query = Query_protocol.Document (identifier, position) in + let result = Query_commands.dispatch pipeline query in + match result with + | `No_documentation | `Invalid_context | `Not_found _ -> `Null + | `Builtin value | `File_not_found value | `Found value | `Not_in_env value -> + let kind = + match contentFormat with + | Some format -> format + | None -> MarkupKind.PlainText + in + GetDoc.yojson_of_t { doc = GetDoc.create ~kind ~value }) + let on_request ~params state = Fiber.of_thunk (fun () -> - let params = - (Option.value ~default:(`Assoc []) params :> Yojson.Safe.t) - in - let GetDocParams.{ text_document; position; identifier; contentFormat } = - GetDocParams.t_of_yojson params - in - let uri = text_document.uri in - let doc = Document_store.get state.State.store uri in - match Document.kind doc with - | `Other -> Fiber.return `Null - | `Merlin merlin -> dispatch ~merlin ~position ~identifier ~contentFormat) + let params = (Option.value ~default:(`Assoc []) params :> Yojson.Safe.t) in + let GetDocParams.{ text_document; position; identifier; contentFormat } = + GetDocParams.t_of_yojson params + in + let uri = text_document.uri in + let doc = Document_store.get state.State.store uri in + match Document.kind doc with + | `Other -> Fiber.return `Null + | `Merlin merlin -> dispatch ~merlin ~position ~identifier ~contentFormat) + diff --git a/ocaml-lsp-server/src/custom_requests/req_documentation.mli b/ocaml-lsp-server/src/custom_requests/req_documentation.mli index ae29aac88..daa1feb5b 100644 --- a/ocaml-lsp-server/src/custom_requests/req_documentation.mli +++ b/ocaml-lsp-server/src/custom_requests/req_documentation.mli @@ -1,22 +1,21 @@ open Import -val meth : string - -val capability : string * [> `Bool of bool ] +module Request_params : sig + type t -module GetDocClientCapabilities : sig - type t = { contentFormat : MarkupKind.t list } + val yojson_of_t : t -> Json.t - val yojson_of_t : t -> [> `Assoc of [> `List of Json.t list ] ] + val create : + text_document:TextDocumentIdentifier.t -> + position:Position.t -> + ?identifier:string option -> ?contentFormat:MarkupKind.t option -> unit -> t end -module GetDoc : sig - type t = { doc : MarkupContent.t } -end - -type t = GetDoc.t +type t +val t_of_yojson : Json.t -> t +val meth : string +val capability : string * [> `Bool of bool ] val on_request : - params:[< Yojson.Safe.t > `Assoc ] option - -> State.t - -> [> `Assoc of (string * Yojson.Safe.t) list | `Null ] Fiber.t + params:Jsonrpc.Structured.t option -> + State.t -> Json.t Fiber.t diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index 29296822d..de74a0653 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml @@ -508,8 +508,8 @@ let on_request ; Req_typed_holes.meth, Req_typed_holes.on_request ; Req_merlin_call_compatible.meth, Req_merlin_call_compatible.on_request ; Req_type_enclosing.meth, Req_type_enclosing.on_request - ; (Req_documentation.meth, Req_documentation.on_request) - ; Req_wrapping_ast_node.meth, Req_wrapping_ast_node.on_request + ; Req_documentation.meth, Req_documentation.on_request + ; Req_wrapping_ast_node.meth, Req_wrapping_ast_node.on_request ; ( Semantic_highlighting.Debug.meth_request_full , Semantic_highlighting.Debug.on_request_full ) ; ( Req_hover_extended.meth diff --git a/ocaml-lsp-server/test/e2e-new/documentation.ml b/ocaml-lsp-server/test/e2e-new/documentation.ml index b7cc87ef5..83b0ee99c 100644 --- a/ocaml-lsp-server/test/e2e-new/documentation.ml +++ b/ocaml-lsp-server/test/e2e-new/documentation.ml @@ -1,28 +1,17 @@ open Test.Import +module Req = Ocaml_lsp_server.Custom_request.Documentation module Util = struct - let call_documentation ~position ?(identifier = None) ?(contentFormat = None) - client = + let call_documentation ~position ?(identifier = None) ?(contentFormat = None) client = let uri = DocumentUri.of_path "test.ml" in - let text_document = - TextDocumentIdentifier.yojson_of_t @@ TextDocumentIdentifier.create ~uri - in - let position = Position.yojson_of_t position in + let text_document = TextDocumentIdentifier.create ~uri in let params = - `Assoc - (("position", position) - :: (match identifier with - | Some ident -> ("identifier", `String ident) - | None -> ("identifier", `Null)) - :: (match contentFormat with - | Some fmt -> ("contentFormat", `String fmt) - | None -> ("contentFormat", `Null)) - :: [ ("textDocument", text_document) ]) - in - let params = Some (Jsonrpc.Structured.t_of_yojson params) in + Req.Request_params.create ~text_document ~position ~identifier ~contentFormat () + |> Req.Request_params.yojson_of_t + |> Jsonrpc.Structured.t_of_yojson + |> Option.some in let req = - Lsp.Client_request.UnknownRequest - { meth = "ocamllsp/documentation"; params } + Lsp.Client_request.UnknownRequest { meth = "ocamllsp/getDocumentation"; params } in Client.request client req @@ -31,40 +20,36 @@ module Util = struct let test ~line ~character ?identifier ?contentFormat source = let position = Position.create ~character ~line in + let contentFormat = match contentFormat with + | Some "markdown" -> Some MarkupKind.Markdown + | Some "plaintext" | _ -> Some MarkupKind.PlainText + in let request client = let open Fiber.O in - let+ response = - call_documentation ~position ~identifier ~contentFormat client - in + let+ response = call_documentation ~position ~identifier ~contentFormat client in print_documentation response in Helpers.test source request end -let%expect_test "Documentation of simple type with no contentFormat and no \ - identifier" = +let%expect_test "Documentation of simple type with no contentFormat and no identifier" = let source = "type tree (** This is a comment *)" in let line = 0 in let character = 7 in Util.test ~line ~character source; - [%expect - {| { "doc": { "kind": "plaintext", "value": "This is a comment" } } |}] + [%expect {| { "doc": { "kind": "plaintext", "value": "This is a comment" } } |}] -let%expect_test "Documentation of simple type with contentFormat set to \ - markdown" = +let%expect_test "Documentation of simple type with contentFormat set to markdown" = let source = "type tree (** This is another comment *)" in let line = 0 in let character = 7 in let contentFormat = "markdown" in Util.test ~line ~character ~contentFormat source; - [%expect - {| { "doc": { "kind": "markdown", "value": "This is another comment" } } |}] + [%expect {| { "doc": { "kind": "markdown", "value": "This is another comment" } } |}] -let%expect_test "Documentation of simple type with an identifier and \ - contentFormat" = +let%expect_test "Documentation of simple type with an identifier and contentFormat" = let source = - "{|type tree (** This is another comment *)\n\ - \ List.iter ~f:(fun x -> x*x) [2;4]|}" + "{|type tree (** This is another comment *)\n List.iter ~f:(fun x -> x*x) [2;4]|}" in let line = 0 in let character = 7 in @@ -80,11 +65,9 @@ let%expect_test "Documentation of simple type with an identifier and \ } } |}] -let%expect_test "Documentation of simple type with an identifier and no \ - contentFormat" = +let%expect_test "Documentation of simple type with an identifier and no contentFormat" = let source = - "{|type tree (** This is another comment *)\n\ - \ List.iter ~f:(fun x -> x*x) [2;4]|}" + "{|type tree (** This is another comment *)\n List.iter ~f:(fun x -> x*x) [2;4]|}" in let line = 0 in let character = 7 in @@ -142,8 +125,7 @@ let%expect_test "Documentation when List module is shadowed" = let character = 12 in let identifier = "Base.List.iter" in Util.test ~line ~character ~identifier source; - [%expect - {| + [%expect {| { "doc": { "kind": "plaintext", "value": "Base.List.iter" } } |}] (* TODO: Open Issue in Merlin to investigate while this doesnt return documentation of the custom List module*) From b27a97d31ff9dc3fcf5837eff24f347d430c086d Mon Sep 17 00:00:00 2001 From: PizieDust Date: Thu, 18 Jul 2024 07:26:02 +0100 Subject: [PATCH 16/22] linting --- .../src/custom_requests/req_documentation.ml | 44 +++++++++++-------- .../src/custom_requests/req_documentation.mli | 19 ++++---- .../test/e2e-new/documentation.ml | 26 ++++++++--- 3 files changed, 54 insertions(+), 35 deletions(-) diff --git a/ocaml-lsp-server/src/custom_requests/req_documentation.ml b/ocaml-lsp-server/src/custom_requests/req_documentation.ml index 29776b15a..cab2b953f 100644 --- a/ocaml-lsp-server/src/custom_requests/req_documentation.ml +++ b/ocaml-lsp-server/src/custom_requests/req_documentation.ml @@ -10,6 +10,7 @@ module GetDocClientCapabilities = struct let _yojson_of_t { contentFormat } = `Assoc (`List (List.map ~f:(fun format -> MarkupKind.yojson_of_t format) contentFormat)) + ;; end module GetDocParams = struct @@ -32,23 +33,25 @@ module GetDocParams = struct ; identifier ; contentFormat } + ;; - let yojson_of_t { text_document; position; identifier; contentFormat } = - let identifier = - match identifier with - | Some ident -> [ ("identifier", `String ident) ] - | None -> [] - in - let contentFormat = - match contentFormat with - | Some format -> [ ("contentFormat", MarkupKind.yojson_of_t format) ] - | None -> [] - in - `Assoc - (("textDocument", TextDocumentIdentifier.yojson_of_t text_document) - :: ("position", Position.yojson_of_t position) - :: identifier - @ contentFormat) + let yojson_of_t { text_document; position; identifier; contentFormat } = + let identifier = + match identifier with + | Some ident -> [ "identifier", `String ident ] + | None -> [] + in + let contentFormat = + match contentFormat with + | Some format -> [ "contentFormat", MarkupKind.yojson_of_t format ] + | None -> [] + in + `Assoc + ((("textDocument", TextDocumentIdentifier.yojson_of_t text_document) + :: ("position", Position.yojson_of_t position) + :: identifier) + @ contentFormat) + ;; end module GetDoc = struct @@ -60,11 +63,13 @@ module GetDoc = struct let open Yojson.Safe.Util in let doc = json |> member "doc" |> MarkupContent.t_of_yojson in { doc } + ;; let create ~kind ~value = MarkupContent.create ~kind ~value end type t = GetDoc.t + let t_of_yojson json = GetDoc.t_of_yojson json module Request_params = struct @@ -73,7 +78,8 @@ module Request_params = struct let yojson_of_t t = GetDocParams.yojson_of_t t let create ~text_document ~position ?(identifier = None) ?(contentFormat = None) () : t = - {text_document; identifier; contentFormat; position} + { text_document; identifier; contentFormat; position } + ;; end let dispatch ~merlin ~position ~identifier ~contentFormat = @@ -90,7 +96,7 @@ let dispatch ~merlin ~position ~identifier ~contentFormat = | None -> MarkupKind.PlainText in GetDoc.yojson_of_t { doc = GetDoc.create ~kind ~value }) - +;; let on_request ~params state = Fiber.of_thunk (fun () -> @@ -103,4 +109,4 @@ let on_request ~params state = match Document.kind doc with | `Other -> Fiber.return `Null | `Merlin merlin -> dispatch ~merlin ~position ~identifier ~contentFormat) - +;; diff --git a/ocaml-lsp-server/src/custom_requests/req_documentation.mli b/ocaml-lsp-server/src/custom_requests/req_documentation.mli index daa1feb5b..66ad7da8d 100644 --- a/ocaml-lsp-server/src/custom_requests/req_documentation.mli +++ b/ocaml-lsp-server/src/custom_requests/req_documentation.mli @@ -1,14 +1,17 @@ open Import module Request_params : sig - type t + type t - val yojson_of_t : t -> Json.t + val yojson_of_t : t -> Json.t - val create : - text_document:TextDocumentIdentifier.t -> - position:Position.t -> - ?identifier:string option -> ?contentFormat:MarkupKind.t option -> unit -> t + val create + : text_document:TextDocumentIdentifier.t + -> position:Position.t + -> ?identifier:string option + -> ?contentFormat:MarkupKind.t option + -> unit + -> t end type t @@ -16,6 +19,4 @@ type t val t_of_yojson : Json.t -> t val meth : string val capability : string * [> `Bool of bool ] -val on_request : - params:Jsonrpc.Structured.t option -> - State.t -> Json.t Fiber.t +val on_request : params:Jsonrpc.Structured.t option -> State.t -> Json.t Fiber.t diff --git a/ocaml-lsp-server/test/e2e-new/documentation.ml b/ocaml-lsp-server/test/e2e-new/documentation.ml index 83b0ee99c..7aa50021f 100644 --- a/ocaml-lsp-server/test/e2e-new/documentation.ml +++ b/ocaml-lsp-server/test/e2e-new/documentation.ml @@ -7,29 +7,34 @@ module Util = struct let text_document = TextDocumentIdentifier.create ~uri in let params = Req.Request_params.create ~text_document ~position ~identifier ~contentFormat () - |> Req.Request_params.yojson_of_t - |> Jsonrpc.Structured.t_of_yojson - |> Option.some in + |> Req.Request_params.yojson_of_t + |> Jsonrpc.Structured.t_of_yojson + |> Option.some + in let req = Lsp.Client_request.UnknownRequest { meth = "ocamllsp/getDocumentation"; params } in Client.request client req + ;; let print_documentation result = result |> Yojson.Safe.pretty_to_string ~std:false |> print_endline + ;; let test ~line ~character ?identifier ?contentFormat source = let position = Position.create ~character ~line in - let contentFormat = match contentFormat with - | Some "markdown" -> Some MarkupKind.Markdown - | Some "plaintext" | _ -> Some MarkupKind.PlainText - in + let contentFormat = + match contentFormat with + | Some "markdown" -> Some MarkupKind.Markdown + | Some "plaintext" | _ -> Some MarkupKind.PlainText + in let request client = let open Fiber.O in let+ response = call_documentation ~position ~identifier ~contentFormat client in print_documentation response in Helpers.test source request + ;; end let%expect_test "Documentation of simple type with no contentFormat and no identifier" = @@ -38,6 +43,7 @@ let%expect_test "Documentation of simple type with no contentFormat and no ident let character = 7 in Util.test ~line ~character source; [%expect {| { "doc": { "kind": "plaintext", "value": "This is a comment" } } |}] +;; let%expect_test "Documentation of simple type with contentFormat set to markdown" = let source = "type tree (** This is another comment *)" in @@ -46,6 +52,7 @@ let%expect_test "Documentation of simple type with contentFormat set to markdown let contentFormat = "markdown" in Util.test ~line ~character ~contentFormat source; [%expect {| { "doc": { "kind": "markdown", "value": "This is another comment" } } |}] +;; let%expect_test "Documentation of simple type with an identifier and contentFormat" = let source = @@ -64,6 +71,7 @@ let%expect_test "Documentation of simple type with an identifier and contentForm "value": "List operations.\n\n Some functions are flagged as not tail-recursive. A tail-recursive\n function uses constant stack space, while a non-tail-recursive function\n uses stack space proportional to the length of its list argument, which\n can be a problem with very long lists. When the function takes several\n list arguments, an approximate formula giving stack usage (in some\n unspecified constant unit) is shown in parentheses.\n\n The above considerations can usually be ignored if your lists are not\n longer than about 10000 elements.\n\n The labeled version of this module can be used as described in the\n {!StdLabels} module." } } |}] +;; let%expect_test "Documentation of simple type with an identifier and no contentFormat" = let source = @@ -81,6 +89,7 @@ let%expect_test "Documentation of simple type with an identifier and no contentF "value": "List operations.\n\n Some functions are flagged as not tail-recursive. A tail-recursive\n function uses constant stack space, while a non-tail-recursive function\n uses stack space proportional to the length of its list argument, which\n can be a problem with very long lists. When the function takes several\n list arguments, an approximate formula giving stack usage (in some\n unspecified constant unit) is shown in parentheses.\n\n The above considerations can usually be ignored if your lists are not\n longer than about 10000 elements.\n\n The labeled version of this module can be used as described in the\n {!StdLabels} module." } } |}] +;; let%expect_test "Documentation when List module is shadowed" = let source = @@ -107,6 +116,7 @@ let%expect_test "Documentation when List module is shadowed" = "value": "[iter f [a1; ...; an]] applies function [f] in turn to\n [a1; ...; an]. It is equivalent to\n [begin f a1; f a2; ...; f an; () end]." } } |}] +;; let%expect_test "Documentation when List module is shadowed" = let source = @@ -127,6 +137,7 @@ let%expect_test "Documentation when List module is shadowed" = Util.test ~line ~character ~identifier source; [%expect {| { "doc": { "kind": "plaintext", "value": "Base.List.iter" } } |}] +;; (* TODO: Open Issue in Merlin to investigate while this doesnt return documentation of the custom List module*) let%expect_test "Documentation when List module is shadowed" = @@ -153,3 +164,4 @@ let%expect_test "Documentation when List module is shadowed" = "value": "List operations.\n\n Some functions are flagged as not tail-recursive. A tail-recursive\n function uses constant stack space, while a non-tail-recursive function\n uses stack space proportional to the length of its list argument, which\n can be a problem with very long lists. When the function takes several\n list arguments, an approximate formula giving stack usage (in some\n unspecified constant unit) is shown in parentheses.\n\n The above considerations can usually be ignored if your lists are not\n longer than about 10000 elements.\n\n The labeled version of this module can be used as described in the\n {!StdLabels} module." } } |}] +;; From 23501099bb7a26416f81916cdd5d89ab2bfacd9c Mon Sep 17 00:00:00 2001 From: PizieDust Date: Thu, 18 Jul 2024 14:13:00 +0100 Subject: [PATCH 17/22] refactor according to code reveiw --- ocaml-lsp-server/src/custom_requests/custom_request.ml | 2 +- ocaml-lsp-server/src/custom_requests/custom_request.mli | 2 +- .../{req_documentation.ml => req_get_documentation.ml} | 2 +- .../{req_documentation.mli => req_get_documentation.mli} | 0 ocaml-lsp-server/src/ocaml_lsp_server.ml | 4 ++-- ocaml-lsp-server/test/e2e-new/documentation.ml | 4 ++-- ocaml-lsp-server/test/e2e-new/start_stop.ml | 2 +- 7 files changed, 8 insertions(+), 8 deletions(-) rename ocaml-lsp-server/src/custom_requests/{req_documentation.ml => req_get_documentation.ml} (98%) rename ocaml-lsp-server/src/custom_requests/{req_documentation.mli => req_get_documentation.mli} (100%) diff --git a/ocaml-lsp-server/src/custom_requests/custom_request.ml b/ocaml-lsp-server/src/custom_requests/custom_request.ml index 932172dd5..ae76394dd 100644 --- a/ocaml-lsp-server/src/custom_requests/custom_request.ml +++ b/ocaml-lsp-server/src/custom_requests/custom_request.ml @@ -5,4 +5,4 @@ module Switch_impl_intf = Req_switch_impl_intf module Typed_holes = Req_typed_holes module Type_enclosing = Req_type_enclosing module Wrapping_ast_node = Req_wrapping_ast_node -module Documentation = Req_documentation +module Get_documentation = Req_get_documentation diff --git a/ocaml-lsp-server/src/custom_requests/custom_request.mli b/ocaml-lsp-server/src/custom_requests/custom_request.mli index ff361f7bb..1033883bc 100644 --- a/ocaml-lsp-server/src/custom_requests/custom_request.mli +++ b/ocaml-lsp-server/src/custom_requests/custom_request.mli @@ -7,4 +7,4 @@ module Switch_impl_intf = Req_switch_impl_intf module Typed_holes = Req_typed_holes module Type_enclosing = Req_type_enclosing module Wrapping_ast_node = Req_wrapping_ast_node -module Documentation = Req_documentation +module Get_documentation = Req_get_documentation diff --git a/ocaml-lsp-server/src/custom_requests/req_documentation.ml b/ocaml-lsp-server/src/custom_requests/req_get_documentation.ml similarity index 98% rename from ocaml-lsp-server/src/custom_requests/req_documentation.ml rename to ocaml-lsp-server/src/custom_requests/req_get_documentation.ml index cab2b953f..5b86acd77 100644 --- a/ocaml-lsp-server/src/custom_requests/req_documentation.ml +++ b/ocaml-lsp-server/src/custom_requests/req_get_documentation.ml @@ -2,7 +2,7 @@ open Import module TextDocumentPositionParams = Lsp.Types.TextDocumentPositionParams let meth = "ocamllsp/getDocumentation" -let capability = "handleDocumentation", `Bool true +let capability = "handleGetDocumentation", `Bool true module GetDocClientCapabilities = struct type _t = { contentFormat : MarkupKind.t list } diff --git a/ocaml-lsp-server/src/custom_requests/req_documentation.mli b/ocaml-lsp-server/src/custom_requests/req_get_documentation.mli similarity index 100% rename from ocaml-lsp-server/src/custom_requests/req_documentation.mli rename to ocaml-lsp-server/src/custom_requests/req_get_documentation.mli diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index de74a0653..1b85b9ebc 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml @@ -94,7 +94,7 @@ let initialize_info (client_capabilities : ClientCapabilities.t) : InitializeRes ; Req_hover_extended.capability ; Req_merlin_call_compatible.capability ; Req_type_enclosing.capability - ; Req_documentation.capability + ; Req_get_documentation.capability ] ) ] in @@ -508,7 +508,7 @@ let on_request ; Req_typed_holes.meth, Req_typed_holes.on_request ; Req_merlin_call_compatible.meth, Req_merlin_call_compatible.on_request ; Req_type_enclosing.meth, Req_type_enclosing.on_request - ; Req_documentation.meth, Req_documentation.on_request + ; Req_get_documentation.meth, Req_get_documentation.on_request ; Req_wrapping_ast_node.meth, Req_wrapping_ast_node.on_request ; ( Semantic_highlighting.Debug.meth_request_full , Semantic_highlighting.Debug.on_request_full ) diff --git a/ocaml-lsp-server/test/e2e-new/documentation.ml b/ocaml-lsp-server/test/e2e-new/documentation.ml index 7aa50021f..ff73fed59 100644 --- a/ocaml-lsp-server/test/e2e-new/documentation.ml +++ b/ocaml-lsp-server/test/e2e-new/documentation.ml @@ -1,5 +1,5 @@ open Test.Import -module Req = Ocaml_lsp_server.Custom_request.Documentation +module Req = Ocaml_lsp_server.Custom_request.Get_documentation module Util = struct let call_documentation ~position ?(identifier = None) ?(contentFormat = None) client = @@ -18,7 +18,7 @@ module Util = struct ;; let print_documentation result = - result |> Yojson.Safe.pretty_to_string ~std:false |> print_endline + Test.print_result result ;; let test ~line ~character ?identifier ?contentFormat source = diff --git a/ocaml-lsp-server/test/e2e-new/start_stop.ml b/ocaml-lsp-server/test/e2e-new/start_stop.ml index 115daa454..4216a64ea 100644 --- a/ocaml-lsp-server/test/e2e-new/start_stop.ml +++ b/ocaml-lsp-server/test/e2e-new/start_stop.ml @@ -92,7 +92,7 @@ let%expect_test "start/stop" = "handleHoverExtended": true, "handleMerlinCallCompatible": true, "handleTypeEnclosing": true, - "handleDocumentation": true + "handleGetDocumentation": true } }, "foldingRangeProvider": true, From e1afe61b8787db57b789b1f9a9bccfa31ad226a5 Mon Sep 17 00:00:00 2001 From: PizieDust Date: Thu, 18 Jul 2024 14:14:35 +0100 Subject: [PATCH 18/22] lint --- ocaml-lsp-server/test/e2e-new/documentation.ml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/ocaml-lsp-server/test/e2e-new/documentation.ml b/ocaml-lsp-server/test/e2e-new/documentation.ml index ff73fed59..0949d7832 100644 --- a/ocaml-lsp-server/test/e2e-new/documentation.ml +++ b/ocaml-lsp-server/test/e2e-new/documentation.ml @@ -17,9 +17,7 @@ module Util = struct Client.request client req ;; - let print_documentation result = - Test.print_result result - ;; + let print_documentation result = Test.print_result result let test ~line ~character ?identifier ?contentFormat source = let position = Position.create ~character ~line in From efb32a6ecffdb46dfaa99261724bcf2f42d0e9ba Mon Sep 17 00:00:00 2001 From: PizieDust Date: Thu, 18 Jul 2024 14:28:36 +0100 Subject: [PATCH 19/22] remove redundant function --- ocaml-lsp-server/test/e2e-new/documentation.ml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/ocaml-lsp-server/test/e2e-new/documentation.ml b/ocaml-lsp-server/test/e2e-new/documentation.ml index 0949d7832..4ad89140e 100644 --- a/ocaml-lsp-server/test/e2e-new/documentation.ml +++ b/ocaml-lsp-server/test/e2e-new/documentation.ml @@ -17,8 +17,6 @@ module Util = struct Client.request client req ;; - let print_documentation result = Test.print_result result - let test ~line ~character ?identifier ?contentFormat source = let position = Position.create ~character ~line in let contentFormat = @@ -29,7 +27,7 @@ module Util = struct let request client = let open Fiber.O in let+ response = call_documentation ~position ~identifier ~contentFormat client in - print_documentation response + Test.print_result response in Helpers.test source request ;; From 6e6f361408e5884dd80944697da9b8a6eb11242d Mon Sep 17 00:00:00 2001 From: PizieDust Date: Tue, 23 Jul 2024 14:50:06 +0200 Subject: [PATCH 20/22] update doc --- ocaml-lsp-server/docs/ocamllsp/getDocumentation-spec.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml-lsp-server/docs/ocamllsp/getDocumentation-spec.md b/ocaml-lsp-server/docs/ocamllsp/getDocumentation-spec.md index 10a6006f8..fbc7fb9f7 100644 --- a/ocaml-lsp-server/docs/ocamllsp/getDocumentation-spec.md +++ b/ocaml-lsp-server/docs/ocamllsp/getDocumentation-spec.md @@ -30,7 +30,7 @@ export interface GetDocParams extends TextDocumentPositionParams ``` - method : `ocamllsp/getDocumentation` - params : - - `position`: The position of the cursor. + - `TextDocumentPositionParams`: A record which contains the `TextDocumentIdentifier` and `Position`. - `identifier`: An optional identifier. If provided, documentation for this ident is looked up from the environment at the given position. Else the server will look for the documentation of the identifier under the cursor. - `contentFormat`: Optionally override the result's format. Could be `Plaintext` or `Markdown`. From 6947e5beae0a9a337fde2235ab7188986ac0261e Mon Sep 17 00:00:00 2001 From: PizieDust Date: Mon, 29 Jul 2024 09:18:17 +0200 Subject: [PATCH 21/22] better documentation --- .../docs/ocamllsp/getDocumentation-spec.md | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/ocaml-lsp-server/docs/ocamllsp/getDocumentation-spec.md b/ocaml-lsp-server/docs/ocamllsp/getDocumentation-spec.md index fbc7fb9f7..c2789f082 100644 --- a/ocaml-lsp-server/docs/ocamllsp/getDocumentation-spec.md +++ b/ocaml-lsp-server/docs/ocamllsp/getDocumentation-spec.md @@ -28,11 +28,17 @@ export interface GetDocParams extends TextDocumentPositionParams contentFormat?:MarkupKind; } ``` -- method : `ocamllsp/getDocumentation` -- params : - - `TextDocumentPositionParams`: A record which contains the `TextDocumentIdentifier` and `Position`. - - `identifier`: An optional identifier. If provided, documentation for this ident is looked up from the environment at the given position. Else the server will look for the documentation of the identifier under the cursor. - - `contentFormat`: Optionally override the result's format. Could be `Plaintext` or `Markdown`. +- method: `ocamllsp/getDocumentation` +- params: + - `TextDocumentPositionParams`: This is an existing interface that includes: + - `TextDocumentIdentifier`: Specifies the document for which the request is sent. It includes a uri property that points to the document. + - `Position`: Specifies the position in the document for which the documentation is requested. It includes line and character properties. + More details can be found in the [TextDocumentPositionParams - LSP Specification](https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#textDocumentPositionParams). + - `identifier` (Optional): A string representing an identifier for which the documentation is requested. If provided, the documentation lookup will be specifically for this identifier in the context of the position in the document. If omitted, the server will automatically fetch the documentation for the identifier currently under the cursor at the given position. + - `contentFormat` (Optional): This parameter specifies the desired format for the returned documentation content. It can be either: + - `Plaintext`: The documentation will be returned in plain text format. + - `Markdown`: The documentation will be returned in Markdown format. + The type `MarkupKind` typically supports these two formats, as specified in the [MarkupKind - LSP protocol](https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#markupContent). ## Response From 6018e9c70a5336e24a7d7afb9a36777a1588c227 Mon Sep 17 00:00:00 2001 From: PizieDust Date: Mon, 29 Jul 2024 11:51:05 +0200 Subject: [PATCH 22/22] format markdown --- .../src/custom_requests/req_get_documentation.ml | 12 +++++++++++- ocaml-lsp-server/test/e2e-new/documentation.ml | 2 +- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/ocaml-lsp-server/src/custom_requests/req_get_documentation.ml b/ocaml-lsp-server/src/custom_requests/req_get_documentation.ml index 5b86acd77..5000c3a3c 100644 --- a/ocaml-lsp-server/src/custom_requests/req_get_documentation.ml +++ b/ocaml-lsp-server/src/custom_requests/req_get_documentation.ml @@ -65,7 +65,17 @@ module GetDoc = struct { doc } ;; - let create ~kind ~value = MarkupContent.create ~kind ~value + let create ~kind ~value = + let v = + match kind with + | MarkupKind.Markdown -> + (match Doc_to_md.translate value with + | Raw d -> d + | Markdown d -> d) + | MarkupKind.PlainText -> value + in + MarkupContent.create ~kind ~value:v + ;; end type t = GetDoc.t diff --git a/ocaml-lsp-server/test/e2e-new/documentation.ml b/ocaml-lsp-server/test/e2e-new/documentation.ml index 4ad89140e..6255d1aa4 100644 --- a/ocaml-lsp-server/test/e2e-new/documentation.ml +++ b/ocaml-lsp-server/test/e2e-new/documentation.ml @@ -64,7 +64,7 @@ let%expect_test "Documentation of simple type with an identifier and contentForm { "doc": { "kind": "markdown", - "value": "List operations.\n\n Some functions are flagged as not tail-recursive. A tail-recursive\n function uses constant stack space, while a non-tail-recursive function\n uses stack space proportional to the length of its list argument, which\n can be a problem with very long lists. When the function takes several\n list arguments, an approximate formula giving stack usage (in some\n unspecified constant unit) is shown in parentheses.\n\n The above considerations can usually be ignored if your lists are not\n longer than about 10000 elements.\n\n The labeled version of this module can be used as described in the\n {!StdLabels} module." + "value": "List operations.\n\nSome functions are flagged as not tail-recursive. A tail-recursive function uses constant stack space, while a non-tail-recursive function uses stack space proportional to the length of its list argument, which can be a problem with very long lists. When the function takes several list arguments, an approximate formula giving stack usage (in some unspecified constant unit) is shown in parentheses.\n\nThe above considerations can usually be ignored if your lists are not longer than about 10000 elements.\n\nThe labeled version of this module can be used as described in the `StdLabels` module." } } |}] ;;