fix(code-actions): reject malformed destruct-line replies

CHANGES.md

@@ -10,6 +10,8 @@
 
 ## Fixes
 
+- Ignore malformed destruct-line recovery replies instead of raising an
+  internal substring lookup error. (#2043, @rgrinberg)
 - Keep construct-completion text edits on the request line when Merlin recovery
   returns a multiline location. (#2034, @rgrinberg)
 - Advertise Dune promotion code actions using their returned `quickfix` kind.

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

@@ -56,12 +56,12 @@ let run state doc ~(dispatch : dispatch) ~action_kind ~(range : Range.t) ~postpr
   let+ res = dispatch range in
   match res with
   | Ok reply ->
-    let reply = postprocess reply in
-    let supportsJumpToNextHole =
-      State.experimental_client_capabilities state
-      |> Client.Experimental_capabilities.supportsJumpToNextHole
-    in
-    Some (code_action_of_case_analysis ~action_kind ~supportsJumpToNextHole doc reply)
+    Option.map (postprocess reply) ~f:(fun reply ->
+      let supportsJumpToNextHole =
+        State.experimental_client_capabilities state
+        |> Client.Experimental_capabilities.supportsJumpToNextHole
+      in
+      code_action_of_case_analysis ~action_kind ~supportsJumpToNextHole doc reply)
   | Error
       { exn =
           ( Merlin_analysis.Destruct.Wrong_parent _
@@ -80,7 +80,7 @@ let code_action (state : State.t) dispatch doc (params : CodeActionParams.t) =
   | `Other -> Fiber.return None
   | `Merlin m when Document.Merlin.kind m = Intf -> Fiber.return None
   | `Merlin _ ->
-    run state doc ~dispatch ~action_kind ~range:params.range ~postprocess:Fun.id
+    run state doc ~dispatch ~action_kind ~range:params.range ~postprocess:Option.some
 ;;
 
 let t ~dispatch state =

ocaml-lsp-server/src/code_actions/action_destruct.mli

@@ -6,14 +6,15 @@ val kind : CodeActionKind.t
 val cached_dispatch : Document.Merlin.t -> dispatch
 
 (** Run Merlin's case analysis and turn its reply into a code action.
-    [postprocess] may adjust the replacement location and text. *)
+    [postprocess] may adjust the replacement location and text, or reject an
+    unusable recovery result. *)
 val run
   :  State.t
   -> Document.t
   -> dispatch:dispatch
   -> action_kind:string
   -> range:Range.t
-  -> postprocess:(Loc.t * string -> Loc.t * string)
+  -> postprocess:(Loc.t * string -> (Loc.t * string) option)
   -> CodeAction.t option Fiber.t
 
 val t : dispatch:dispatch -> State.t -> Code_action.t

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

@@ -209,10 +209,10 @@ let format_match_cases lines ~indent =
 
 (** Finds the "with" in the Merlin reply and splits after it. *)
 let separate_match_line new_code =
-  let end_of_match = String.substr_index_exn new_code ~pattern:"with" in
-  let match_line = String.prefix new_code (end_of_match + 4) in
-  let rest = String.drop_prefix new_code (end_of_match + 4) in
-  match_line, rest
+  Option.map (String.substr_index new_code ~pattern:"with") ~f:(fun end_of_match ->
+    let match_line = String.prefix new_code (end_of_match + 4) in
+    let rest = String.drop_prefix new_code (end_of_match + 4) in
+    match_line, rest)
 ;;
 
 let format_merlin_reply ~(statement : destructable_statement) (new_code : string) =
@@ -223,21 +223,22 @@ let format_merlin_reply ~(statement : destructable_statement) (new_code : string
   in
   match statement.kind with
   | MatchLine | MatchWithLine ->
-    let match_line, rest = separate_match_line new_code in
-    let rest = String.chop_suffix_if_exists rest ~suffix:")" in
-    let match_line = String.chop_prefix_if_exists match_line ~prefix:"(" in
-    let lines = String.split ~on:'|' rest in
-    match_line ^ format_match_cases lines ~indent
-  | CaseLine -> format_match_cases (String.split ~on:'|' new_code) ~indent
+    Option.map (separate_match_line new_code) ~f:(fun (match_line, rest) ->
+      let rest = String.chop_suffix_if_exists rest ~suffix:")" in
+      let match_line = String.chop_prefix_if_exists match_line ~prefix:"(" in
+      let lines = String.split ~on:'|' rest in
+      match_line ^ format_match_cases lines ~indent)
+  | CaseLine -> Some (format_match_cases (String.split ~on:'|' new_code) ~indent)
   | Hole | OffsetHole _ ->
     let lines = String.split ~on:'|' new_code in
-    (match List.hd lines, List.tl lines with
-     | None, _ | _, None -> new_code
-     | Some first_line, Some other_lines ->
-       let other_lines =
-         List.map other_lines ~f:(fun l -> indent ^ "| " ^ strip_case_line l)
-       in
-       String.concat ~sep:" -> _\n" (String.strip first_line :: other_lines))
+    Some
+      (match List.hd lines, List.tl lines with
+       | None, _ | _, None -> new_code
+       | Some first_line, Some other_lines ->
+         let other_lines =
+           List.map other_lines ~f:(fun l -> indent ^ "| " ^ strip_case_line l)
+         in
+         String.concat ~sep:" -> _\n" (String.strip first_line :: other_lines))
 ;;
 
 let code_action
@@ -259,9 +260,9 @@ let code_action
          ~action_kind
          ~range:statement.query_range
          ~postprocess:(fun (loc, newText) ->
-           let loc = adjust_reply_location ~statement loc in
-           let newText = format_merlin_reply ~statement newText in
-           loc, newText))
+           Option.map (format_merlin_reply ~statement newText) ~f:(fun newText ->
+             let loc = adjust_reply_location ~statement loc in
+             loc, newText)))
 ;;
 
 let t ~dispatch state =

ocaml-lsp-server/test/e2e-new/code_actions_destruct.ml

@@ -88,6 +88,26 @@ let%expect_test "destruct-line returns an edit inside a UTF-8 scalar" =
     |}]
 ;;
 
+let%expect_test "destruct-line ignores a recovered match without with" =
+  let source = "let o_[\nmatch xwith | 0 -> () |" in
+  let range = range ~start_line:1 ~start_character:7 ~end_line:1 ~end_character:23 in
+  let makeRequest textDocument =
+    let only =
+      [ CodeActionKind.Other "destruct-line (enumerate cases, use existing match)" ]
+    in
+    let context = CodeActionContext.create ~diagnostics:[] ~only () in
+    Lsp.Client_request.CodeAction
+      (CodeActionParams.create ~textDocument ~range ~context ())
+  in
+  Lsp_helpers.iter_lsp_response_result ~language_id:"ocaml" ~makeRequest ~source (function
+    | Error error -> Jsonrpc.Response.Error.raise error
+    | Ok response ->
+      print_code_action_result
+        response
+        ~filter:(find_action "Destruct-line (enumerate cases, use existing match)"));
+  [%expect {| No code actions |}]
+;;
+
 let%expect_test "can destruct sum types" =
   let source =
     {ocaml|