Jump to cases within a Match statement (#1726)

from PizieDust/jump_case

Author: voodoos

CHANGES.md

@@ -5,9 +5,10 @@ merlin NEXT_VERSION
     - Add a "heap_mbytes" field to Merlin server responses to report heap usage (#1717)
     - Add cache stats to telemetry (#1711)
     - Add new SyntaxDocument command to find information about the node under the cursor (#1706)
-    - Fix `FLG -pp ppx.exe -as-pp/-dump-ast` use of invalid shell redirection when 
+    - Fix `FLG -pp ppx.exe -as-pp/-dump-ast` use of invalid shell redirection when
     direct process launch on Windows. (#1723, fixes #1722)
     - Add a query_num field to the `ocamlmerlin` responses to detect server crashes (#1716)
+    - Jump to cases within a match statement (#1726)
   + editor modes
     - vim: load merlin under the ocamlinterface and ocamllex filetypes (#1340)
     - Fix merlinpp not using binary file open (#1725, fixes #1724)

src/analysis/jump.ml

@@ -32,6 +32,8 @@ open Std
 open Typedtree
 open Browse_raw
 
+type direction = Prev | Next
+
 let is_node_fun = function
   | Expression { exp_desc = Texp_function _; _ } -> true
   | _ -> false
@@ -104,6 +106,8 @@ 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 =
@@ -127,19 +131,50 @@ let rec skip_non_moving pos = function
   | [] -> []
 ;;
 
+let get_cases_from_match node =
+  match node with
+  | Expression { exp_desc = Texp_match (_, cases, _); _ } -> cases
+  | _ -> []
+
+let find_case_pos cases pos direction =
+  let rec find_pos pos cases direction =
+    match cases with
+    | [] -> None
+    | { c_lhs = { pat_loc; _ }; _ } :: tail ->
+        let check =
+          match direction with
+          | Prev ->
+            pos.Lexing.pos_cnum > pat_loc.loc_start.pos_cnum
+          | Next ->
+            pos.Lexing.pos_cnum < pat_loc.loc_start.pos_cnum
+        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)
+
 let get typed_tree pos target =
   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;
     "match", match_pred;
+    "match-next-case", match_pred;
+    "match-prev-case", match_pred;
   ] in
   let targets = Str.split (Str.regexp "[, ]") target in
   try
@@ -152,17 +187,25 @@ let get typed_tree pos target =
     in
     if String.length target = 0 then
       `Error "Specify target"
-    else begin
+    else
       let nodes = skip_non_moving pos enclosings in
       let node = find_node preds nodes in
-      let node_loc = Browse_raw.node_real_loc Location.none node in
-      `Found node_loc.Location.loc_start
-    end
+      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
   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 phrase typed_tree pos target =
   let roots = Mbrowse.of_typedtree typed_tree in

tests/test-dirs/motion/jump_match.t

@@ -0,0 +1,93 @@
+  $ cat > test.ml << EOF
+  > let find_vowel x = 
+  > match x with 
+  > | 'A' -> 
+  >   true
+  > | 'E' -> 
+  >   true
+  > | 'I' -> 
+  >   true
+  > | 'O' -> 
+  >   true 
+  > | 'U' -> 
+  >   true 
+  > | _ -> 
+  >   false
+  > EOF
+
+Test if location of next case is given
+  $ $MERLIN single jump -target match-next-case -position 3:3 -filename test.ml < test.ml
+  {
+    "class": "return",
+    "value": {
+      "pos": {
+        "line": 5,
+        "col": 2
+      }
+    },
+    "notifications": []
+  }
+
+Test if location of prev case is given
+  $ $MERLIN single jump -target match-prev-case -position 5:2 -filename test.ml < test.ml
+  {
+    "class": "return",
+    "value": {
+      "pos": {
+        "line": 3,
+        "col": 2
+      }
+    },
+    "notifications": []
+  }
+
+Test when cursor is not in a match statement
+  $ $MERLIN single jump -target match-prev-case -position 1:2 -filename test.ml < test.ml
+  {
+    "class": "return",
+    "value": "No matching target",
+    "notifications": []
+  }
+
+
+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",
+    "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",
+    "notifications": []
+  }
+
+Test jump from case 'O' to the previous case
+  $ $MERLIN single jump -target match-prev-case -position 9:2 -filename test.ml < test.ml
+  {
+    "class": "return",
+    "value": {
+      "pos": {
+        "line": 7,
+        "col": 2
+      }
+    },
+    "notifications": []
+  }
+
+Test jump from case 'O' to the next case
+  $ $MERLIN single jump -target match-next-case -position 9:2 -filename test.ml < test.ml
+  {
+    "class": "return",
+    "value": {
+      "pos": {
+        "line": 11,
+        "col": 2
+      }
+    },
+    "notifications": []
+  }