Implementation to get list of possible jumps

CHANGES.md

@@ -1,3 +1,9 @@
+unrealeased
+===========
+
++ merlin binary
+  - A new `get_all` function in jump module to return all possible targets (#1891)
+
 merlin 5.4.1
 ============
 Mon Jan 13 10:55:42 CET 2025

src/analysis/jump.ml

@@ -95,8 +95,6 @@ let rec find_map ~f = function
 
 exception No_matching_target
 exception No_predicate of string
-exception No_next_match_case
-exception No_prev_match_case
 
 (* Returns first node on the list matching a predicate *)
 let rec find_node preds nodes =
@@ -134,37 +132,42 @@ let find_case_pos cases pos direction =
       in
       if check then Some pat_loc.loc_start else find_pos pos tail direction
   in
-  let case = find_pos pos cases direction in
-  match case with
-  | Some location -> `Found location
-  | None -> (
-    match direction with
-    | Next -> raise No_next_match_case
-    | Prev -> raise No_prev_match_case)
+  find_pos pos cases direction
 
-let get typed_tree pos target =
+let get_enclosings typed_tree pos =
   let roots = Mbrowse.of_typedtree typed_tree in
-  let enclosings =
-    match Mbrowse.enclosing pos [ roots ] with
-    | [] -> []
-    | l -> List.map ~f:snd l
-  in
-  let all_preds =
-    [ ("fun", fun_pred);
-      ("let", let_pred);
-      ("module", module_pred);
-      ("module-type", module_type_pred);
-      ("match", match_pred);
-      ("match-next-case", match_pred);
-      ("match-prev-case", match_pred)
-    ]
-  in
+
+  match Mbrowse.enclosing pos [ roots ] with
+  | [] -> []
+  | l -> List.map ~f:snd l
+
+let get_node_position target pos node =
+  match target with
+  | "match-next-case" -> find_case_pos (get_cases_from_match node) pos Next
+  | "match-prev-case" ->
+    find_case_pos (List.rev (get_cases_from_match node)) pos Prev
+  | _ ->
+    let node_loc = Browse_raw.node_real_loc Location.none node in
+    Some node_loc.Location.loc_start
+
+let predicates =
+  [ ("fun", fun_pred);
+    ("let", let_pred);
+    ("module", module_pred);
+    ("module-type", module_type_pred);
+    ("match", match_pred);
+    ("match-next-case", match_pred);
+    ("match-prev-case", match_pred)
+  ]
+
+let get typed_tree pos target =
+  let enclosings = get_enclosings typed_tree pos in
   let targets = Str.split (Str.regexp "[, ]") target in
   try
     let preds =
       List.map targets ~f:(fun target ->
           match
-            List.find_some all_preds ~f:(fun (name, _) -> name = target)
+            List.find_some predicates ~f:(fun (name, _) -> name = target)
           with
           | Some (_, f) -> f
           | None -> raise (No_predicate target))
@@ -173,18 +176,28 @@ let get typed_tree pos target =
     else
       let nodes = skip_non_moving pos enclosings in
       let node = find_node preds nodes in
-      match target with
-      | "match-next-case" -> find_case_pos (get_cases_from_match node) pos Next
-      | "match-prev-case" ->
-        find_case_pos (List.rev (get_cases_from_match node)) pos Prev
-      | _ ->
-        let node_loc = Browse_raw.node_real_loc Location.none node in
-        `Found node_loc.Location.loc_start
+      match get_node_position target pos node with
+      | Some loc -> `Found loc
+      | None -> `Error ("No matching case found for " ^ target)
   with
   | No_predicate target -> `Error ("No predicate for " ^ target)
   | No_matching_target -> `Error "No matching target"
-  | No_next_match_case -> `Error "No next case found"
-  | No_prev_match_case -> `Error "No previous case found"
+
+let get_all typed_tree pos =
+  let enclosings = get_enclosings typed_tree pos in
+  let nodes = skip_non_moving pos enclosings in
+  let results =
+    List.filter_map
+      ~f:(fun (target, pred) ->
+        match find_node [ pred ] nodes with
+        | exception No_matching_target -> None
+        | node -> (
+          match get_node_position target pos node with
+          | Some position -> Some (target, position)
+          | None -> None))
+      predicates
+  in
+  results
 
 let phrase typed_tree pos target =
   let roots = Mbrowse.of_typedtree typed_tree in

src/analysis/jump.mli

@@ -33,6 +33,9 @@ val get :
   string ->
   [> `Error of string | `Found of Lexing.position ]
 
+val get_all :
+  Mtyper.typedtree -> Std.Lexing.position -> (string * Lexing.position) list
+
 val phrase :
   Mtyper.typedtree ->
   Std.Lexing.position ->

tests/test-dirs/motion/jump_match.t

@@ -54,15 +54,15 @@ Test when there's no next case
   $ $MERLIN single jump -target match-next-case -position 13:2 -filename test.ml < test.ml
   {
     "class": "return",
-    "value": "No next case found",
+    "value": "No matching case found for match-next-case",
     "notifications": []
   }
 
 Test when there's no previous case
   $ $MERLIN single jump -target match-prev-case -position 3:2 -filename test.ml < test.ml
   {
     "class": "return",
-    "value": "No previous case found",
+    "value": "No matching case found for match-prev-case",
     "notifications": []
   }