From b462e3bd302f14ebb4481921d5751b2ee0ec2205 Mon Sep 17 00:00:00 2001 From: PizieDust Date: Mon, 11 Dec 2023 11:43:34 +0100 Subject: [PATCH 1/4] Add syntax doc command add syntax doc command change syntax_doc output from string to record type parse record to extract and display different fields correctly lint code refactor code add formatting functions and check if syn_doc is activated check if syntax_doc is activated in ocamllsp env variables refactor for proper types include syntax documentation in configuation data check if feature is activated from ocaml.server remove redundant code lint add version refactor code and lint refactor code and lint let merlin work only if syntax doc is activated lint change from italics to code pill lint update changelog update documentation remove configuration via environment variables update docs syntax highlighting for code block make syntax highlighter required add constraint for most recent version of merlin-lib upgrade merlin-lib to latest version add syntax doc to ppx expect Write tests for syntax doc command linting helper function for positions Update README.md Co-authored-by: Ulysse <5031221+voodoos@users.noreply.github.com> Update README.md Co-authored-by: Ulysse <5031221+voodoos@users.noreply.github.com> Update ocaml-lsp-server/src/document.ml Co-authored-by: Ulysse <5031221+voodoos@users.noreply.github.com> Update ocaml-lsp-server/src/document.ml Co-authored-by: Ulysse <5031221+voodoos@users.noreply.github.com> 80 char per line limit use better descriptive function name adjust formatting fix bug fix bug --- CHANGES.md | 4 + README.md | 30 ++++ dune-project | 2 +- ocaml-lsp-server.opam | 2 +- ocaml-lsp-server/docs/ocamllsp/config.md | 7 + ocaml-lsp-server/src/config_data.ml | 116 ++++++++++++- ocaml-lsp-server/src/document.ml | 19 ++- ocaml-lsp-server/src/document.mli | 5 + ocaml-lsp-server/src/hover_req.ml | 53 ++++-- ocaml-lsp-server/test/e2e-new/dune | 1 + .../test/e2e-new/syntax_doc_tests.ml | 152 ++++++++++++++++++ 11 files changed, 367 insertions(+), 24 deletions(-) create mode 100644 ocaml-lsp-server/test/e2e-new/syntax_doc_tests.ml diff --git a/CHANGES.md b/CHANGES.md index 6777c1a59..8bd5f0abd 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -8,6 +8,10 @@ - Support folding of `ifthenelse` expressions (#1031) +- Includes a new optional/configurable option to toggle syntax documentation. If + toggled on, allows display of sytax documentation on hover tooltips. Can be + controlled via environment variables and by GUI for VS code. (#1218) + # 1.17.0 ## Fixes diff --git a/README.md b/README.md index 9b469fa35..9c6c077ca 100644 --- a/README.md +++ b/README.md @@ -304,6 +304,36 @@ of the value needs to be non-polymorphic to construct a meaningful value. Tip (for VS Code OCaml Platform users): You can construct a value using a keybinding Alt+C or on MacOS Option+C +#### Syntax Documentation + +> since OCaml-LSP 1.18.0 + +OCaml-LSP can display documentation about the node under the cursor when +the user hovers over some OCaml code. For example, hovering over the code +snippet below will display some information about what the syntax +is: + +```ocaml +type point = {x: int; y: int} +``` +Hovering over the above will +display: +``` +ocaml type point = { x : int; y : int } +syntax Record type: +Allows you to define variants with a fixed set of fields, and all of the +constructors for a record variant type must have the same fields. See +Manual +``` +The documentation is gotten from the Merlin engine which receives +the nodes under the cursor and infers what the syntax may be about, and +displays the required information along with links to the manual for further +reading. + +Syntax Documentation is an optional feature and can be activated by +using the LSP config system with the key called `syntaxDocumentation` and can +be enabled via setting it to `{ enable: true }`. + ## Debugging If you use Visual Studio Code, please see OCaml Platform extension diff --git a/dune-project b/dune-project index 34c04542f..cc9179860 100644 --- a/dune-project +++ b/dune-project @@ -67,7 +67,7 @@ possible and does not make any assumptions about IO. (ocamlformat-rpc-lib (>= 0.21.0)) (odoc :with-doc) (ocaml (and (>= 4.14) (< 5.2))) - (merlin-lib (and (>= 4.9) (< 5.0))))) + (merlin-lib (and (>= 4.14) (< 5.0))))) (package (name jsonrpc) diff --git a/ocaml-lsp-server.opam b/ocaml-lsp-server.opam index 411352105..66db50284 100644 --- a/ocaml-lsp-server.opam +++ b/ocaml-lsp-server.opam @@ -43,7 +43,7 @@ depends: [ "ocamlformat-rpc-lib" {>= "0.21.0"} "odoc" {with-doc} "ocaml" {>= "4.14" & < "5.2"} - "merlin-lib" {>= "4.9" & < "5.0"} + "merlin-lib" {>= "4.14" & < "5.0"} ] dev-repo: "git+https://github.com/ocaml/ocaml-lsp.git" build: [ diff --git a/ocaml-lsp-server/docs/ocamllsp/config.md b/ocaml-lsp-server/docs/ocamllsp/config.md index 1fa4398a1..e857874ae 100644 --- a/ocaml-lsp-server/docs/ocamllsp/config.md +++ b/ocaml-lsp-server/docs/ocamllsp/config.md @@ -28,5 +28,12 @@ interface config { * @since 1.18 */ duneDiagnostics: { enable : boolean } + + /** + * Enable/Disable Syntax Documentation + * @default false + * @since 1.18 + */ + syntaxDocumentation: { enable : boolean } } ``` diff --git a/ocaml-lsp-server/src/config_data.ml b/ocaml-lsp-server/src/config_data.ml index 1098fc679..e6d22de32 100644 --- a/ocaml-lsp-server/src/config_data.ml +++ b/ocaml-lsp-server/src/config_data.ml @@ -315,6 +315,80 @@ module DuneDiagnostics = struct [@@@end] end +module SyntaxDocumentation = struct + type t = { enable : bool [@default false] } + [@@deriving_inline yojson] [@@yojson.allow_extra_fields] + + let _ = fun (_ : t) -> () + + let t_of_yojson = + (let _tp_loc = + "ocaml-lsp-server/src/config_data.ml.SyntaxDocumentation.t" + in + function + | `Assoc field_yojsons as yojson -> ( + let enable_field = ref Ppx_yojson_conv_lib.Option.None + and duplicates = ref [] + and extra = ref [] in + let rec iter = function + | (field_name, _field_yojson) :: tail -> + (match field_name with + | "enable" -> ( + match Ppx_yojson_conv_lib.( ! ) enable_field with + | Ppx_yojson_conv_lib.Option.None -> + let fvalue = bool_of_yojson _field_yojson in + enable_field := Ppx_yojson_conv_lib.Option.Some fvalue + | Ppx_yojson_conv_lib.Option.Some _ -> + duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates) + | _ -> ()); + iter tail + | [] -> () + in + iter field_yojsons; + match Ppx_yojson_conv_lib.( ! ) duplicates with + | _ :: _ -> + Ppx_yojson_conv_lib.Yojson_conv_error.record_duplicate_fields + _tp_loc + (Ppx_yojson_conv_lib.( ! ) duplicates) + yojson + | [] -> ( + match Ppx_yojson_conv_lib.( ! ) extra with + | _ :: _ -> + Ppx_yojson_conv_lib.Yojson_conv_error.record_extra_fields + _tp_loc + (Ppx_yojson_conv_lib.( ! ) extra) + yojson + | [] -> + let enable_value = Ppx_yojson_conv_lib.( ! ) enable_field in + { enable = + (match enable_value with + | Ppx_yojson_conv_lib.Option.None -> false + | Ppx_yojson_conv_lib.Option.Some v -> v) + })) + | _ as yojson -> + Ppx_yojson_conv_lib.Yojson_conv_error.record_list_instead_atom + _tp_loc + yojson + : Ppx_yojson_conv_lib.Yojson.Safe.t -> t) + + let _ = t_of_yojson + + let yojson_of_t = + (function + | { enable = v_enable } -> + let bnds : (string * Ppx_yojson_conv_lib.Yojson.Safe.t) list = [] in + let bnds = + let arg = yojson_of_bool v_enable in + ("enable", arg) :: bnds + in + `Assoc bnds + : t -> Ppx_yojson_conv_lib.Yojson.Safe.t) + + let _ = yojson_of_t + + [@@@end] +end + type t = { codelens : Lens.t Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] @@ -324,6 +398,10 @@ type t = [@key "inlayHints"] [@default None] [@yojson_drop_default ( = )] ; dune_diagnostics : DuneDiagnostics.t Json.Nullable_option.t [@key "duneDiagnostics"] [@default None] [@yojson_drop_default ( = )] + ; syntax_documentation : SyntaxDocumentation.t Json.Nullable_option.t + [@key "syntaxDocumentation"] + [@default None] + [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -337,6 +415,7 @@ let t_of_yojson = and extended_hover_field = ref Ppx_yojson_conv_lib.Option.None and inlay_hints_field = ref Ppx_yojson_conv_lib.Option.None and dune_diagnostics_field = ref Ppx_yojson_conv_lib.Option.None + and syntax_documentation_field = ref Ppx_yojson_conv_lib.Option.None and duplicates = ref [] and extra = ref [] in let rec iter = function @@ -362,6 +441,17 @@ let t_of_yojson = extended_hover_field := Ppx_yojson_conv_lib.Option.Some fvalue | Ppx_yojson_conv_lib.Option.Some _ -> duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates) + | "syntaxDocumentation" -> ( + match Ppx_yojson_conv_lib.( ! ) syntax_documentation_field with + | Ppx_yojson_conv_lib.Option.None -> + let fvalue = + Json.Nullable_option.t_of_yojson + SyntaxDocumentation.t_of_yojson + _field_yojson + in + syntax_documentation_field := Ppx_yojson_conv_lib.Option.Some fvalue + | Ppx_yojson_conv_lib.Option.Some _ -> + duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates) | "inlayHints" -> ( match Ppx_yojson_conv_lib.( ! ) inlay_hints_field with | Ppx_yojson_conv_lib.Option.None -> @@ -384,7 +474,7 @@ let t_of_yojson = dune_diagnostics_field := Ppx_yojson_conv_lib.Option.Some fvalue | Ppx_yojson_conv_lib.Option.Some _ -> duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates) - | _ -> ()); + | _ -> ()); iter tail | [] -> () in @@ -406,11 +496,13 @@ let t_of_yojson = let ( codelens_value , extended_hover_value , inlay_hints_value - , dune_diagnostics_value ) = + , dune_diagnostics_value + , syntax_documentation_value ) = ( Ppx_yojson_conv_lib.( ! ) codelens_field , Ppx_yojson_conv_lib.( ! ) extended_hover_field , Ppx_yojson_conv_lib.( ! ) inlay_hints_field - , Ppx_yojson_conv_lib.( ! ) dune_diagnostics_field ) + , Ppx_yojson_conv_lib.( ! ) dune_diagnostics_field + , Ppx_yojson_conv_lib.( ! ) syntax_documentation_field ) in { codelens = (match codelens_value with @@ -428,6 +520,10 @@ let t_of_yojson = (match dune_diagnostics_value with | Ppx_yojson_conv_lib.Option.None -> None | Ppx_yojson_conv_lib.Option.Some v -> v) + ; syntax_documentation = + (match syntax_documentation_value with + | Ppx_yojson_conv_lib.Option.None -> None + | Ppx_yojson_conv_lib.Option.Some v -> v) })) | _ as yojson -> Ppx_yojson_conv_lib.Yojson_conv_error.record_list_instead_atom @@ -443,7 +539,8 @@ let yojson_of_t = ; extended_hover = v_extended_hover ; inlay_hints = v_inlay_hints ; dune_diagnostics = v_dune_diagnostics - } -> + ; syntax_documentation = + v_syntax_documentation } -> let bnds : (string * Ppx_yojson_conv_lib.Yojson.Safe.t) list = [] in let bnds = if None = v_dune_diagnostics then bnds @@ -465,6 +562,16 @@ let yojson_of_t = let bnd = ("inlayHints", arg) in bnd :: bnds in + let bnds = + if None = v_syntax_documentation then bnds + else + let arg = + (Json.Nullable_option.yojson_of_t SyntaxDocumentation.yojson_of_t) + v_syntax_documentation + in + let bnd = ("syntaxDocumentation", arg) in + bnd :: bnds + in let bnds = if None = v_extended_hover then bnds else @@ -497,4 +604,5 @@ let default = ; inlay_hints = Some { hint_pattern_variables = false; hint_let_bindings = false } ; dune_diagnostics = Some { enable = true } + ; syntax_documentation = Some { enable = false } } diff --git a/ocaml-lsp-server/src/document.ml b/ocaml-lsp-server/src/document.ml index 4bbcf81e5..4d2064899 100644 --- a/ocaml-lsp-server/src/document.ml +++ b/ocaml-lsp-server/src/document.ml @@ -281,13 +281,23 @@ module Merlin = struct | `Found s | `Builtin s -> Some s | _ -> None + let syntax_doc pipeline pos = + let res = + let command = Query_protocol.Syntax_document pos in + Query_commands.dispatch pipeline command + in + match res with + | `Found s -> Some s + | `No_documentation -> None + type type_enclosing = { loc : Loc.t ; typ : string ; doc : string option + ; syntax_doc : Query_protocol.syntax_doc_result option } - let type_enclosing doc pos verbosity = + let type_enclosing doc pos verbosity ~with_syntax_doc = with_pipeline_exn doc (fun pipeline -> let command = Query_protocol.Type_enclosing (None, pos, Some 0) in let pipeline = @@ -308,7 +318,12 @@ module Merlin = struct | [] | (_, `Index _, _) :: _ -> None | (loc, `String typ, _) :: _ -> let doc = doc_comment pipeline pos in - Some { loc; typ; doc }) + let syntax_doc = + match with_syntax_doc with + | true -> syntax_doc pipeline pos + | false -> None + in + Some { loc; typ; doc; syntax_doc }) let doc_comment doc pos = with_pipeline_exn doc (fun pipeline -> doc_comment pipeline pos) diff --git a/ocaml-lsp-server/src/document.mli b/ocaml-lsp-server/src/document.mli index eb5e65f02..d6a9aeaa8 100644 --- a/ocaml-lsp-server/src/document.mli +++ b/ocaml-lsp-server/src/document.mli @@ -63,16 +63,21 @@ module Merlin : sig val doc_comment : t -> Msource.position -> (* doc string *) string option Fiber.t + val syntax_doc : + Mpipeline.t -> Msource.position -> Query_protocol.syntax_doc_result option + type type_enclosing = { loc : Loc.t ; typ : string ; doc : string option + ; syntax_doc : Query_protocol.syntax_doc_result option } val type_enclosing : t -> Msource.position -> (* verbosity *) int + -> with_syntax_doc:bool -> type_enclosing option Fiber.t val kind : t -> Kind.t diff --git a/ocaml-lsp-server/src/hover_req.ml b/ocaml-lsp-server/src/hover_req.ml index dcbc48405..4a399f4a2 100644 --- a/ocaml-lsp-server/src/hover_req.ml +++ b/ocaml-lsp-server/src/hover_req.ml @@ -12,29 +12,40 @@ let environment_mode = | Some true -> Extended_variable | Some false | None -> Default -let format_contents ~syntax ~markdown ~typ ~doc = +let print_dividers sections = String.concat ~sep:"\n---\n" sections + +let format_as_code_block ~highlighter strings = + sprintf "```%s\n%s\n```" highlighter (String.concat ~sep:" " strings) + +let format_contents ~syntax ~markdown ~typ ~doc + ~(syntax_doc : Query_protocol.syntax_doc_result option) = (* TODO for vscode, we should just use the language id. But that will not work for all editors *) + let syntax_doc = + Option.map syntax_doc ~f:(fun syntax_doc -> + sprintf + "`syntax` %s: %s. See [Manual](%s)" + syntax_doc.name + syntax_doc.description + syntax_doc.documentation) + in `MarkupContent (if markdown then let value = let markdown_name = Document.Syntax.markdown_name syntax in - match doc with - | None -> sprintf "```%s\n%s\n```" markdown_name typ - | Some s -> - let doc = - match Doc_to_md.translate s with - | Raw d -> sprintf "(** %s *)" d - | Markdown d -> d - in - sprintf "```%s\n%s\n```\n---\n%s" markdown_name typ doc + let type_info = Some (format_as_code_block ~highlighter:markdown_name [ typ ]) in + let doc = + Option.map doc ~f:(fun doc -> + match Doc_to_md.translate doc with + | Raw d -> d + | Markdown d -> d) + in + print_dividers (List.filter_opt [ type_info; syntax_doc; doc ]) in { MarkupContent.value; kind = MarkupKind.Markdown } else let value = - match doc with - | None -> sprintf "%s" typ - | Some d -> sprintf "%s\n%s" typ d + print_dividers (List.filter_opt [ Some typ; syntax_doc; doc ]) in { MarkupContent.value; kind = MarkupKind.PlainText }) @@ -74,12 +85,17 @@ let handle server { HoverParams.textDocument = { uri }; position; _ } mode = v in let pos = Position.logical position in + let with_syntax_doc = + match state.configuration.data.syntax_documentation with + | Some { enable = true } -> true + | Some _ | None -> false + in let* type_enclosing = - Document.Merlin.type_enclosing merlin pos verbosity + Document.Merlin.type_enclosing merlin pos verbosity ~with_syntax_doc in match type_enclosing with | None -> Fiber.return None - | Some { Document.Merlin.loc; typ; doc = documentation } -> + | Some { Document.Merlin.loc; typ; doc = documentation; syntax_doc } -> let syntax = Document.syntax doc in let+ typ = (* We ask Ocamlformat to format this type *) @@ -115,7 +131,12 @@ let handle server { HoverParams.textDocument = { uri }; position; _ } mode = ~field:(fun td -> Option.map td.hover ~f:(fun h -> h.contentFormat)) in - format_contents ~syntax ~markdown ~typ ~doc:documentation + format_contents + ~syntax + ~markdown + ~typ + ~doc:documentation + ~syntax_doc in let range = Range.of_loc loc in Some (Hover.create ~contents ~range ()))) diff --git a/ocaml-lsp-server/test/e2e-new/dune b/ocaml-lsp-server/test/e2e-new/dune index 4ce8ca390..ccb05501c 100644 --- a/ocaml-lsp-server/test/e2e-new/dune +++ b/ocaml-lsp-server/test/e2e-new/dune @@ -58,6 +58,7 @@ semantic_hl_helpers semantic_hl_tests start_stop + syntax_doc_tests test with_pp with_ppx diff --git a/ocaml-lsp-server/test/e2e-new/syntax_doc_tests.ml b/ocaml-lsp-server/test/e2e-new/syntax_doc_tests.ml new file mode 100644 index 000000000..0cabe5b8c --- /dev/null +++ b/ocaml-lsp-server/test/e2e-new/syntax_doc_tests.ml @@ -0,0 +1,152 @@ +open! Test.Import + +let change_config client params = + Client.notification client (ChangeConfiguration params) + +let uri = DocumentUri.of_path "test.ml" + +let create_postion line character = Position.create ~line ~character + +let activate_syntax_doc = + DidChangeConfigurationParams.create + ~settings: + (`Assoc [ ("syntaxDocumentation", `Assoc [ ("enable", `Bool true) ]) ]) + +let deactivate_syntax_doc = + DidChangeConfigurationParams.create + ~settings: + (`Assoc [ ("syntaxDocumentation", `Assoc [ ("enable", `Bool false) ]) ]) + +let print_hover hover = + match hover with + | None -> print_endline "no hover response" + | Some hover -> + hover |> Hover.yojson_of_t + |> Yojson.Safe.pretty_to_string ~std:false + |> print_endline + +let hover_req client position = + Client.request + client + (TextDocumentHover + { HoverParams.position + ; textDocument = TextDocumentIdentifier.create ~uri + ; workDoneToken = None + }) + +let run_test text req = + let handler = + Client.Handler.make + ~on_notification:(fun client _notification -> + Client.state client; + Fiber.return ()) + () + in + Test.run ~handler (fun client -> + let run_client () = + let capabilities = ClientCapabilities.create () in + Client.start client (InitializeParams.create ~capabilities ()) + in + let run () = + let* (_ : InitializeResult.t) = Client.initialized client in + let textDocument = + TextDocumentItem.create ~uri ~languageId:"ocaml" ~version:0 ~text + in + let* () = + Client.notification + client + (TextDocumentDidOpen + (DidOpenTextDocumentParams.create ~textDocument)) + in + let* () = req client in + let* () = Client.request client Shutdown in + Client.stop client + in + Fiber.fork_and_join_unit run_client run) + +let%expect_test "syntax doc should display" = + let source = {ocaml| +type color = Red|Blue +|ocaml} in + let position = create_postion 1 9 in + let req client = + let* () = change_config client activate_syntax_doc in + let* resp = hover_req client position in + let () = print_hover resp in + Fiber.return () + in + let (_ : string) = [%expect.output] in + run_test source req; + [%expect + {| + { + "contents": { + "kind": "plaintext", + "value": "type color = Red | Blue\n---\n`syntax` Variant Type: Represent's data that may take on multiple different forms.. See [Manual](https://v2.ocaml.org/releases/4.14/htmlman/typedecl.html#ss:typedefs)" + }, + "range": { + "end": { "character": 21, "line": 1 }, + "start": { "character": 0, "line": 1 } + } + } |}] + +let%expect_test "syntax doc should not display" = + let source = {ocaml| +type color = Red|Blue +|ocaml} in + let position = create_postion 1 9 in + let req client = + let* () = change_config client deactivate_syntax_doc in + let* resp = hover_req client position in + let () = print_hover resp in + Fiber.return () + in + run_test source req; + [%expect + {| + { + "contents": { "kind": "plaintext", "value": "type color = Red | Blue" }, + "range": { + "end": { "character": 21, "line": 1 }, + "start": { "character": 0, "line": 1 } + } + } |}] + +let%expect_test "syntax doc should print" = + let source = {ocaml| +type t = .. +|ocaml} in + let position = create_postion 1 9 in + let req client = + let* () = change_config client activate_syntax_doc in + let* resp = hover_req client position in + let () = print_hover resp in + Fiber.return () + in + run_test source req; + [%expect + {| + { + "contents": { + "kind": "plaintext", + "value": "type t = ..\n---\n`syntax` Extensible Variant Type: Can be extended with new variant constructors using `+=`.. See [Manual](https://v2.ocaml.org/releases/4.14/htmlman/extensiblevariants.html)" + }, + "range": { + "end": { "character": 11, "line": 1 }, + "start": { "character": 0, "line": 1 } + } + } |}] + +let%expect_test "should receive no hover response" = + let source = {ocaml| + let a = 1 + |ocaml} in + let position = create_postion 1 5 in + let req client = + let* () = change_config client activate_syntax_doc in + let* resp = hover_req client position in + let () = print_hover resp in + Fiber.return () + in + run_test source req; + [%expect {| no hover response |}] From 24a324490fe44f50d8a9525aba2aa0cbe62692ec Mon Sep 17 00:00:00 2001 From: PizieDust Date: Tue, 27 Feb 2024 14:25:51 +0100 Subject: [PATCH 2/4] Write tests for syntax doc command From e6f223e5c487702a0d0f5c169a83da4730ac2846 Mon Sep 17 00:00:00 2001 From: PizieDust Date: Mon, 13 May 2024 10:12:53 +0100 Subject: [PATCH 3/4] add syndoc command --- ocaml-lsp-server/src/hover_req.ml | 61 +++++++++++-------- .../test/e2e-new/syntax_doc_tests.ml | 2 +- 2 files changed, 37 insertions(+), 26 deletions(-) diff --git a/ocaml-lsp-server/src/hover_req.ml b/ocaml-lsp-server/src/hover_req.ml index b20eb5c62..528e1b67f 100644 --- a/ocaml-lsp-server/src/hover_req.ml +++ b/ocaml-lsp-server/src/hover_req.ml @@ -193,9 +193,15 @@ let hover_at_cursor parsetree (`Logical (cursor_line, cursor_col)) = in !result -let format_type_enclosing ~syntax ~markdown ~typ ~doc = +let print_dividers sections = String.concat ~sep:"\n---\n" sections + +let format_as_code_block ~highlighter strings = + sprintf "```%s\n%s\n```" highlighter (String.concat ~sep:" " strings) + +let format_type_enclosing ~syntax ~markdown ~typ ~doc + ~(syntax_doc : Query_protocol.syntax_doc_result option) = (* TODO for vscode, we should just use the language id. But that will not work - for all editors *) + for all editors *) let syntax_doc = Option.map syntax_doc ~f:(fun syntax_doc -> sprintf @@ -206,29 +212,29 @@ let format_type_enclosing ~syntax ~markdown ~typ ~doc = in `MarkupContent (if markdown then - let value = - let markdown_name = Document.Syntax.markdown_name syntax in - let type_info = Some (format_as_code_block ~highlighter:markdown_name [ typ ]) in - let doc = - Option.map doc ~f:(fun doc -> - match Doc_to_md.translate doc with - | Raw d -> d - | Markdown d -> d) - in - print_dividers (List.filter_opt [ type_info; syntax_doc; doc ]) - in - { MarkupContent.value; kind = MarkupKind.Markdown } - else - let value = - print_dividers (List.filter_opt [ Some typ; syntax_doc; doc ]) - in - { MarkupContent.value; kind = MarkupKind.PlainText }) + let value = + let markdown_name = Document.Syntax.markdown_name syntax in + let type_info = Some (format_as_code_block ~highlighter:markdown_name [ typ ]) in + let doc = + Option.map doc ~f:(fun doc -> + match Doc_to_md.translate doc with + | Raw d -> d + | Markdown d -> d) + in + print_dividers (List.filter_opt [ type_info; syntax_doc; doc ]) + in + { MarkupContent.value; kind = MarkupKind.Markdown } + else + let value = + print_dividers (List.filter_opt [ Some typ; syntax_doc; doc ]) + in + { MarkupContent.value; kind = MarkupKind.PlainText }) let format_ppx_expansion ~ppx ~expansion = let value = sprintf "(* ppx %s expansion *)\n%s" ppx expansion in `MarkedString { Lsp.Types.MarkedString.value; language = Some "ocaml" } -let type_enclosing_hover ~(server : State.t Server.t) ~(doc : Document.t) +let type_enclosing_hover ~(server : State.t Server.t) ~(doc : Document.t) ~with_syntax_doc ~merlin ~mode ~uri ~position = let state = Server.state server in let verbosity = @@ -257,11 +263,11 @@ let type_enclosing_hover ~(server : State.t Server.t) ~(doc : Document.t) v in let* type_enclosing = - Document.Merlin.type_enclosing merlin (Position.logical position) verbosity + Document.Merlin.type_enclosing merlin (Position.logical position) verbosity ~with_syntax_doc in match type_enclosing with | None -> Fiber.return None - | Some { Document.Merlin.loc; typ; doc = documentation } -> + | Some { Document.Merlin.loc; typ; doc = documentation; syntax_doc } -> let syntax = Document.syntax doc in let* typ = (* We ask Ocamlformat to format this type *) @@ -293,7 +299,7 @@ let type_enclosing_hover ~(server : State.t Server.t) ~(doc : Document.t) client_capabilities ~field:(fun td -> Option.map td.hover ~f:(fun h -> h.contentFormat)) in - format_type_enclosing ~syntax ~markdown ~typ ~doc:documentation + format_type_enclosing ~syntax ~markdown ~typ ~doc:documentation ~syntax_doc in let range = Range.of_loc loc in let hover = Hover.create ~contents ~range () in @@ -416,7 +422,12 @@ let handle server { HoverParams.textDocument = { uri }; position; _ } mode = match hover_at_cursor parsetree (Position.logical position) with | None -> Fiber.return None | Some `Type_enclosing -> - type_enclosing_hover ~server ~doc ~merlin ~mode ~uri ~position + let with_syntax_doc = + match state.configuration.data.syntax_documentation with + | Some { enable = true } -> true + | Some _ | None -> false + in + type_enclosing_hover ~server ~doc ~merlin ~mode ~uri ~position ~with_syntax_doc | Some ((`Ppx_expr _ | `Ppx_typedef_attr _) as ppx_kind) -> ( let+ ppx_parsetree = Document.Merlin.with_pipeline_exn @@ -428,4 +439,4 @@ let handle server { HoverParams.textDocument = { uri }; position; _ } mode = | `Ppx_expr (expr, ppx) -> ppx_expression_hover ~ppx_parsetree ~expr ~ppx | `Ppx_typedef_attr (decl, attr) -> - typedef_attribute_hover ~ppx_parsetree ~decl ~attr))) + typedef_attribute_hover ~ppx_parsetree ~decl ~attr))) \ No newline at end of file diff --git a/ocaml-lsp-server/test/e2e-new/syntax_doc_tests.ml b/ocaml-lsp-server/test/e2e-new/syntax_doc_tests.ml index 0cabe5b8c..116a0e22f 100644 --- a/ocaml-lsp-server/test/e2e-new/syntax_doc_tests.ml +++ b/ocaml-lsp-server/test/e2e-new/syntax_doc_tests.ml @@ -116,7 +116,7 @@ let%expect_test "syntax doc should print" = let source = {ocaml| type t = .. |ocaml} in - let position = create_postion 1 9 in + let position = create_postion 1 5 in let req client = let* () = change_config client activate_syntax_doc in let* resp = hover_req client position in From 1392cb300cd5792191d33406647f2e3f48323a03 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Tue, 14 May 2024 13:47:33 +0200 Subject: [PATCH 4/4] Format changes --- ocaml-lsp-server/src/config_data.ml | 29 +++++++------ ocaml-lsp-server/src/hover_req.ml | 66 ++++++++++++++++++----------- 2 files changed, 57 insertions(+), 38 deletions(-) diff --git a/ocaml-lsp-server/src/config_data.ml b/ocaml-lsp-server/src/config_data.ml index e6d22de32..465f74507 100644 --- a/ocaml-lsp-server/src/config_data.ml +++ b/ocaml-lsp-server/src/config_data.ml @@ -441,17 +441,18 @@ let t_of_yojson = extended_hover_field := Ppx_yojson_conv_lib.Option.Some fvalue | Ppx_yojson_conv_lib.Option.Some _ -> duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates) - | "syntaxDocumentation" -> ( - match Ppx_yojson_conv_lib.( ! ) syntax_documentation_field with - | Ppx_yojson_conv_lib.Option.None -> - let fvalue = - Json.Nullable_option.t_of_yojson - SyntaxDocumentation.t_of_yojson - _field_yojson - in - syntax_documentation_field := Ppx_yojson_conv_lib.Option.Some fvalue - | Ppx_yojson_conv_lib.Option.Some _ -> - duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates) + | "syntaxDocumentation" -> ( + match Ppx_yojson_conv_lib.( ! ) syntax_documentation_field with + | Ppx_yojson_conv_lib.Option.None -> + let fvalue = + Json.Nullable_option.t_of_yojson + SyntaxDocumentation.t_of_yojson + _field_yojson + in + syntax_documentation_field := + Ppx_yojson_conv_lib.Option.Some fvalue + | Ppx_yojson_conv_lib.Option.Some _ -> + duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates) | "inlayHints" -> ( match Ppx_yojson_conv_lib.( ! ) inlay_hints_field with | Ppx_yojson_conv_lib.Option.None -> @@ -474,7 +475,7 @@ let t_of_yojson = dune_diagnostics_field := Ppx_yojson_conv_lib.Option.Some fvalue | Ppx_yojson_conv_lib.Option.Some _ -> duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates) - | _ -> ()); + | _ -> ()); iter tail | [] -> () in @@ -539,8 +540,8 @@ let yojson_of_t = ; extended_hover = v_extended_hover ; inlay_hints = v_inlay_hints ; dune_diagnostics = v_dune_diagnostics - ; syntax_documentation = - v_syntax_documentation } -> + ; syntax_documentation = v_syntax_documentation + } -> let bnds : (string * Ppx_yojson_conv_lib.Yojson.Safe.t) list = [] in let bnds = if None = v_dune_diagnostics then bnds diff --git a/ocaml-lsp-server/src/hover_req.ml b/ocaml-lsp-server/src/hover_req.ml index 528e1b67f..763582b31 100644 --- a/ocaml-lsp-server/src/hover_req.ml +++ b/ocaml-lsp-server/src/hover_req.ml @@ -201,7 +201,7 @@ let format_as_code_block ~highlighter strings = let format_type_enclosing ~syntax ~markdown ~typ ~doc ~(syntax_doc : Query_protocol.syntax_doc_result option) = (* TODO for vscode, we should just use the language id. But that will not work - for all editors *) + for all editors *) let syntax_doc = Option.map syntax_doc ~f:(fun syntax_doc -> sprintf @@ -212,30 +212,32 @@ let format_type_enclosing ~syntax ~markdown ~typ ~doc in `MarkupContent (if markdown then - let value = - let markdown_name = Document.Syntax.markdown_name syntax in - let type_info = Some (format_as_code_block ~highlighter:markdown_name [ typ ]) in - let doc = - Option.map doc ~f:(fun doc -> - match Doc_to_md.translate doc with - | Raw d -> d - | Markdown d -> d) - in - print_dividers (List.filter_opt [ type_info; syntax_doc; doc ]) - in - { MarkupContent.value; kind = MarkupKind.Markdown } - else - let value = - print_dividers (List.filter_opt [ Some typ; syntax_doc; doc ]) - in - { MarkupContent.value; kind = MarkupKind.PlainText }) + let value = + let markdown_name = Document.Syntax.markdown_name syntax in + let type_info = + Some (format_as_code_block ~highlighter:markdown_name [ typ ]) + in + let doc = + Option.map doc ~f:(fun doc -> + match Doc_to_md.translate doc with + | Raw d -> d + | Markdown d -> d) + in + print_dividers (List.filter_opt [ type_info; syntax_doc; doc ]) + in + { MarkupContent.value; kind = MarkupKind.Markdown } + else + let value = + print_dividers (List.filter_opt [ Some typ; syntax_doc; doc ]) + in + { MarkupContent.value; kind = MarkupKind.PlainText }) let format_ppx_expansion ~ppx ~expansion = let value = sprintf "(* ppx %s expansion *)\n%s" ppx expansion in `MarkedString { Lsp.Types.MarkedString.value; language = Some "ocaml" } -let type_enclosing_hover ~(server : State.t Server.t) ~(doc : Document.t) ~with_syntax_doc - ~merlin ~mode ~uri ~position = +let type_enclosing_hover ~(server : State.t Server.t) ~(doc : Document.t) + ~with_syntax_doc ~merlin ~mode ~uri ~position = let state = Server.state server in let verbosity = let mode = @@ -263,7 +265,11 @@ let type_enclosing_hover ~(server : State.t Server.t) ~(doc : Document.t) ~with_ v in let* type_enclosing = - Document.Merlin.type_enclosing merlin (Position.logical position) verbosity ~with_syntax_doc + Document.Merlin.type_enclosing + merlin + (Position.logical position) + verbosity + ~with_syntax_doc in match type_enclosing with | None -> Fiber.return None @@ -299,7 +305,12 @@ let type_enclosing_hover ~(server : State.t Server.t) ~(doc : Document.t) ~with_ client_capabilities ~field:(fun td -> Option.map td.hover ~f:(fun h -> h.contentFormat)) in - format_type_enclosing ~syntax ~markdown ~typ ~doc:documentation ~syntax_doc + format_type_enclosing + ~syntax + ~markdown + ~typ + ~doc:documentation + ~syntax_doc in let range = Range.of_loc loc in let hover = Hover.create ~contents ~range () in @@ -427,7 +438,14 @@ let handle server { HoverParams.textDocument = { uri }; position; _ } mode = | Some { enable = true } -> true | Some _ | None -> false in - type_enclosing_hover ~server ~doc ~merlin ~mode ~uri ~position ~with_syntax_doc + type_enclosing_hover + ~server + ~doc + ~merlin + ~mode + ~uri + ~position + ~with_syntax_doc | Some ((`Ppx_expr _ | `Ppx_typedef_attr _) as ppx_kind) -> ( let+ ppx_parsetree = Document.Merlin.with_pipeline_exn @@ -439,4 +457,4 @@ let handle server { HoverParams.textDocument = { uri }; position; _ } mode = | `Ppx_expr (expr, ppx) -> ppx_expression_hover ~ppx_parsetree ~expr ~ppx | `Ppx_typedef_attr (decl, attr) -> - typedef_attribute_hover ~ppx_parsetree ~decl ~attr))) \ No newline at end of file + typedef_attribute_hover ~ppx_parsetree ~decl ~attr)))