From 2b1265aba5f1ba703545421a08f7f2b9235c0ea9 Mon Sep 17 00:00:00 2001 From: xvw Date: Wed, 9 Apr 2025 18:20:23 +0200 Subject: [PATCH 1/3] Add `hintFunctionParams` inlay hints --- ocaml-lsp-server/src/config_data.ml | 33 ++++++++++++++++++-- ocaml-lsp-server/src/inlay_hints.ml | 12 ++++++- ocaml-lsp-server/test/e2e-new/inlay_hints.ml | 16 ++++++++++ 3 files changed, 57 insertions(+), 4 deletions(-) diff --git a/ocaml-lsp-server/src/config_data.ml b/ocaml-lsp-server/src/config_data.ml index eac3cf654..5f138735c 100644 --- a/ocaml-lsp-server/src/config_data.ml +++ b/ocaml-lsp-server/src/config_data.ml @@ -5,6 +5,7 @@ module InlayHints = struct type t = { hint_pattern_variables : bool [@key "hintPatternVariables"] [@default false] ; hint_let_bindings : bool [@key "hintLetBindings"] [@default false] + ; hint_function_params : bool [@key "hintFunctionParams"] [@default false] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -16,6 +17,7 @@ module InlayHints = struct | `Assoc field_yojsons as yojson -> let hint_pattern_variables_field = ref Ppx_yojson_conv_lib.Option.None and hint_let_bindings_field = ref Ppx_yojson_conv_lib.Option.None + and hint_function_params_field = ref Ppx_yojson_conv_lib.Option.None and duplicates = ref [] and extra = ref [] in let rec iter = function @@ -35,6 +37,13 @@ module InlayHints = struct hint_let_bindings_field := Ppx_yojson_conv_lib.Option.Some fvalue | Ppx_yojson_conv_lib.Option.Some _ -> duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates) + | "hintFunctionParams" -> + (match Ppx_yojson_conv_lib.( ! ) hint_function_params_field with + | Ppx_yojson_conv_lib.Option.None -> + let fvalue = bool_of_yojson _field_yojson in + hint_function_params_field := Ppx_yojson_conv_lib.Option.Some fvalue + | Ppx_yojson_conv_lib.Option.Some _ -> + duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates) | _ -> ()); iter tail | [] -> () @@ -54,9 +63,13 @@ module InlayHints = struct (Ppx_yojson_conv_lib.( ! ) extra) yojson | [] -> - let hint_pattern_variables_value, hint_let_bindings_value = + let ( hint_pattern_variables_value + , hint_let_bindings_value + , hint_function_params_value ) + = ( Ppx_yojson_conv_lib.( ! ) hint_pattern_variables_field - , Ppx_yojson_conv_lib.( ! ) hint_let_bindings_field ) + , Ppx_yojson_conv_lib.( ! ) hint_let_bindings_field + , Ppx_yojson_conv_lib.( ! ) hint_function_params_field ) in { hint_pattern_variables = (match hint_pattern_variables_value with @@ -66,6 +79,10 @@ module InlayHints = struct (match hint_let_bindings_value with | Ppx_yojson_conv_lib.Option.None -> false | Ppx_yojson_conv_lib.Option.Some v -> v) + ; hint_function_params = + (match hint_function_params_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 @@ -78,8 +95,13 @@ module InlayHints = struct (function | { hint_pattern_variables = v_hint_pattern_variables ; hint_let_bindings = v_hint_let_bindings + ; hint_function_params = v_hint_function_params } -> let bnds : (string * Ppx_yojson_conv_lib.Yojson.Safe.t) list = [] in + let bnds = + let arg = yojson_of_bool v_hint_function_params in + ("hintFunctionParams", arg) :: bnds + in let bnds = let arg = yojson_of_bool v_hint_let_bindings in ("hintLetBindings", arg) :: bnds @@ -798,7 +820,12 @@ let default = { codelens = Some { enable = false } ; extended_hover = Some { enable = false } ; standard_hover = Some { enable = true } - ; inlay_hints = Some { hint_pattern_variables = false; hint_let_bindings = false } + ; inlay_hints = + Some + { hint_pattern_variables = false + ; hint_let_bindings = false + ; hint_function_params = false + } ; dune_diagnostics = Some { enable = true } ; syntax_documentation = Some { enable = false } ; merlin_jump_code_actions = Some { enable = false } diff --git a/ocaml-lsp-server/src/inlay_hints.ml b/ocaml-lsp-server/src/inlay_hints.ml index 8e87a309d..daf085a39 100644 --- a/ocaml-lsp-server/src/inlay_hints.ml +++ b/ocaml-lsp-server/src/inlay_hints.ml @@ -29,12 +29,22 @@ let compute (state : State.t) { InlayHintParams.range; textDocument = { uri }; _ c.hint_pattern_variables) |> Option.value ~default:false in + let hint_function_params = + Option.map state.configuration.data.inlay_hints ~f:(fun c -> + c.hint_function_params) + |> Option.value ~default:false + in Document.Merlin.with_pipeline_exn ~name:"inlay-hints" doc (fun pipeline -> let start = range.start |> Position.logical and stop = range.end_ |> Position.logical in let command = Query_protocol.Inlay_hints - (start, stop, hint_let_bindings, hint_pattern_variables, not inside_test) + ( start + , stop + , hint_let_bindings + , hint_pattern_variables + , hint_function_params + , not inside_test ) in let hints = Query_commands.dispatch pipeline command in List.filter_map diff --git a/ocaml-lsp-server/test/e2e-new/inlay_hints.ml b/ocaml-lsp-server/test/e2e-new/inlay_hints.ml index efaea9efb..703a9e735 100644 --- a/ocaml-lsp-server/test/e2e-new/inlay_hints.ml +++ b/ocaml-lsp-server/test/e2e-new/inlay_hints.ml @@ -5,6 +5,7 @@ let apply_inlay_hints ?range ?(hint_pattern_variables = false) ?(hint_let_bindings = false) + ?(hint_function_params = true) ~source () = @@ -33,6 +34,7 @@ let apply_inlay_hints , `Assoc [ "hintPatternVariables", `Bool hint_pattern_variables ; "hintLetBindings", `Bool hint_let_bindings + ; "hintFunctionParams", `Bool hint_function_params ] ) ]) (InlayHint request) @@ -99,3 +101,17 @@ let%expect_test "let bindings" = apply_inlay_hints ~hint_let_bindings:true ~source (); [%expect {| let f () = let y$: int$ = 0 in y |}] ;; + +let%expect_test "function params" = + let source = "let f a b c d = (a + b, c ^ string_of_bool d)" in + apply_inlay_hints ~source (); + [%expect + {| let f a$: int$ b$: int$ c$: string$ d$: bool$ = (a + b, c ^ string_of_bool d) |}] +;; + +let%expect_test "function params (deactivated)" = + let source = "let f a b c d = (a + b, c ^ string_of_bool d)" in + apply_inlay_hints ~hint_function_params:false ~source (); + [%expect + {| let f a b c d = (a + b, c ^ string_of_bool d) |}] +;; From de725cfa23a2e7d268cdab233db94e824256d541 Mon Sep 17 00:00:00 2001 From: xvw Date: Wed, 9 Apr 2025 18:23:31 +0200 Subject: [PATCH 2/3] Add CHANGES entry --- CHANGES.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 09bad540b..17f3a550b 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,8 +1,13 @@ # unreleased +## Features + +- Make `inlay-hint` for function parameters configurable (#1515) + ## Fixes - Support for `class`, `class type`, `method` and `property` for `DocumentSymbol` query (#1487 fixes #1449) +- Fix `inlay-hint` for function parameters (#1515) # 1.22.0 From 1690c1d7d4e5cf5c021a5f0a8574853afedeb8fd Mon Sep 17 00:00:00 2001 From: xvw Date: Thu, 10 Apr 2025 21:33:08 +0200 Subject: [PATCH 3/3] Format code --- ocaml-lsp-server/test/e2e-new/inlay_hints.ml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/ocaml-lsp-server/test/e2e-new/inlay_hints.ml b/ocaml-lsp-server/test/e2e-new/inlay_hints.ml index 703a9e735..443d67512 100644 --- a/ocaml-lsp-server/test/e2e-new/inlay_hints.ml +++ b/ocaml-lsp-server/test/e2e-new/inlay_hints.ml @@ -112,6 +112,5 @@ let%expect_test "function params" = let%expect_test "function params (deactivated)" = let source = "let f a b c d = (a + b, c ^ string_of_bool d)" in apply_inlay_hints ~hint_function_params:false ~source (); - [%expect - {| let f a b c d = (a + b, c ^ string_of_bool d) |}] + [%expect {| let f a b c d = (a + b, c ^ string_of_bool d) |}] ;;