Update Jump Code actions

CHANGES.md

@@ -5,6 +5,7 @@
 - Fix fd leak in running external processes for preprocessing (#1349)
 - Fix prefix parsing for completion of object methods (#1363, fixes #1358)
 
+
 # 1.19.0
 
 ## Features
@@ -15,6 +16,8 @@
 
 - Add a code-action for syntactic and semantic movement shortcuts based on Merlin's Jump command (#1364)
 
+- Make MerlinJump code action configurable (#1376)
+
 ## Fixes
 
 - Kill unnecessary ocamlformat processes with sigterm rather than sigint or

ocaml-lsp-server/docs/ocamllsp/config.md

@@ -42,5 +42,12 @@ interface config {
   * @since 1.18
   */
   syntaxDocumentation: { enable : boolean }
+
+  /**
+  * Enable/Disable Merlin Jump code actions
+  * @default true
+  * @since 1.19
+  */
+  merlinJumpCodeActions: { enable : boolean }
 }
 ```

ocaml-lsp-server/src/code_actions.ml

@@ -110,21 +110,16 @@ let compute server (params : CodeActionParams.t) =
   match doc with
   | None -> Fiber.return (Reply.now (actions dune_actions), state)
   | Some doc ->
-    let open_related =
-      let capabilities =
-        let open Option.O in
-        let* window = (State.client_capabilities state).window in
-        window.showDocument
-      in
-      Action_open_related.for_uri capabilities doc
+    let capabilities =
+      let open Option.O in
+      let* window = (State.client_capabilities state).window in
+      window.showDocument
     in
+    let open_related = Action_open_related.for_uri capabilities doc in
     let* merlin_jumps =
-      let capabilities =
-        let open Option.O in
-        let* window = (State.client_capabilities state).window in
-        window.showDocument
-      in
-      Action_jump.code_actions doc params capabilities
+      match state.configuration.data.merlin_jump_code_actions with
+      | Some { enable = true } -> Action_jump.code_actions doc params capabilities
+      | _ -> Fiber.return []
     in
     (match Document.syntax doc with
      | Ocamllex | Menhir | Cram | Dune ->

ocaml-lsp-server/src/code_actions/action_jump.ml

@@ -8,6 +8,12 @@ let targets =
   [ "fun"; "match"; "let"; "module"; "module-type"; "match-next-case"; "match-prev-case" ]
 ;;
 
+let rename_target target =
+  if String.starts_with ~prefix:"match-" target
+  then String.sub target ~pos:6 ~len:(String.length target - 6)
+  else target
+;;
+
 let available (capabilities : ShowDocumentClientCapabilities.t option) =
   match capabilities with
   | Some { support } -> support
@@ -71,12 +77,16 @@ let code_actions
         let+ position = Position.of_lexical_position lexing_pos in
         let uri = Document.uri doc in
         let range = { Range.start = position; end_ = position } in
-        let title = sprintf "Jump to %s" target in
+        let title = sprintf "%s jump" (String.capitalize_ascii (rename_target target)) in
         let command =
           let arguments = [ DocumentUri.yojson_of_t uri; Range.yojson_of_t range ] in
           Command.create ~title ~command:command_name ~arguments ()
         in
-        CodeAction.create ~title ~kind:(CodeActionKind.Other "merlin-jump") ~command ())
+        CodeAction.create
+          ~title
+          ~kind:(CodeActionKind.Other (sprintf "merlin-jump-%s" (rename_target target)))
+          ~command
+          ())
     in
     List.filter_opt actions
   | _ -> Fiber.return []

ocaml-lsp-server/src/config_data.ml

@@ -385,6 +385,78 @@ module SyntaxDocumentation = struct
   [@@@end]
 end
 
+module MerlinJumpCodeActions = 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.MerlinJumpCodeActions.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 ( = )]
   ; extended_hover : ExtendedHover.t Json.Nullable_option.t
@@ -395,6 +467,8 @@ type t =
        [@key "duneDiagnostics"] [@default None] [@yojson_drop_default ( = )]
   ; syntax_documentation : SyntaxDocumentation.t Json.Nullable_option.t
        [@key "syntaxDocumentation"] [@default None] [@yojson_drop_default ( = )]
+  ; merlin_jump_code_actions : MerlinJumpCodeActions.t Json.Nullable_option.t
+       [@key "merlinJumpCodeActions"] [@default None] [@yojson_drop_default ( = )]
   }
 [@@deriving_inline yojson] [@@yojson.allow_extra_fields]
 
@@ -409,6 +483,7 @@ let t_of_yojson =
      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 merlin_jump_code_actions_field = ref Ppx_yojson_conv_lib.Option.None
      and duplicates = ref []
      and extra = ref [] in
      let rec iter = function
@@ -463,6 +538,17 @@ 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)
+          | "merlinJumpCodeActions" ->
+            (match Ppx_yojson_conv_lib.( ! ) merlin_jump_code_actions_field with
+             | Ppx_yojson_conv_lib.Option.None ->
+               let fvalue =
+                 Json.Nullable_option.t_of_yojson
+                   MerlinJumpCodeActions.t_of_yojson
+                   _field_yojson
+               in
+               merlin_jump_code_actions_field := Ppx_yojson_conv_lib.Option.Some fvalue
+             | Ppx_yojson_conv_lib.Option.Some _ ->
+               duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates)
           | _ -> ());
          iter tail
        | [] -> ()
@@ -486,13 +572,15 @@ let t_of_yojson =
                , extended_hover_value
                , inlay_hints_value
                , dune_diagnostics_value
-               , syntax_documentation_value )
+               , syntax_documentation_value
+               , merlin_jump_code_actions_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.( ! ) syntax_documentation_field )
+             , Ppx_yojson_conv_lib.( ! ) syntax_documentation_field
+             , Ppx_yojson_conv_lib.( ! ) merlin_jump_code_actions_field )
            in
            { codelens =
                (match codelens_value with
@@ -514,6 +602,10 @@ let t_of_yojson =
                (match syntax_documentation_value with
                 | Ppx_yojson_conv_lib.Option.None -> None
                 | Ppx_yojson_conv_lib.Option.Some v -> v)
+           ; merlin_jump_code_actions =
+               (match merlin_jump_code_actions_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 _tp_loc yojson
@@ -529,6 +621,7 @@ let yojson_of_t =
      ; inlay_hints = v_inlay_hints
      ; dune_diagnostics = v_dune_diagnostics
      ; syntax_documentation = v_syntax_documentation
+     ; merlin_jump_code_actions = v_merlin_jump_code_actions
      } ->
      let bnds : (string * Ppx_yojson_conv_lib.Yojson.Safe.t) list = [] in
      let bnds =
@@ -581,6 +674,17 @@ let yojson_of_t =
          let bnd = "codelens", arg in
          bnd :: bnds)
      in
+     let bnds =
+       if None = v_merlin_jump_code_actions
+       then bnds
+       else (
+         let arg =
+           (Json.Nullable_option.yojson_of_t MerlinJumpCodeActions.yojson_of_t)
+             v_merlin_jump_code_actions
+         in
+         let bnd = "merlinJumpCodeActions", arg in
+         bnd :: bnds)
+     in
      `Assoc bnds
    : t -> Ppx_yojson_conv_lib.Yojson.Safe.t)
 ;;
@@ -595,5 +699,6 @@ let default =
   ; inlay_hints = Some { hint_pattern_variables = false; hint_let_bindings = false }
   ; dune_diagnostics = Some { enable = true }
   ; syntax_documentation = Some { enable = false }
+  ; merlin_jump_code_actions = Some { enable = true }
   }
 ;;