WIP, find cursor in broken case

Author: nojaf

analysis/src/CompletionBackEndRevamped.ml

@@ -111,3 +111,4 @@ let processCompletable ~debug ~full ~scope ~env ~pos
            (dec2, doc, maybeInsertText))
     |> List.map mkDecorator
   | CdecoratorPayload _ -> []
+  | Ccase _ -> []

analysis/src/CompletionFrontEndRevamped.ml

@@ -404,16 +404,14 @@ let completionWithParser ~currentFile ~debug ~offset ~path ~posCursor text =
       if expr.pexp_loc |> Loc.hasPos ~pos:posNoWhite && !result = None then (
         setFound ();
         match expr.pexp_desc with
-        | Pexp_match (switchExpr, [{pc_lhs = lhsPat}])
+        (* | Pexp_match (switchExpr, [{pc_lhs = lhsPat}])
           when CompletionPatterns.isPatternHole lhsPat
                && locHasCursor switchExpr.pexp_loc = false ->
-          setResult (Cpattern {kind = Empty; typeLoc = switchExpr.pexp_loc})
+          setResult (Cpattern {kind = Empty; typeLoc = switchExpr.pexp_loc}) *)
         | Pexp_match (switchExpr, cases) ->
           let oldTypeLoc = !currentTypeLoc in
           currentTypeLoc := Some switchExpr.pexp_loc;
-          cases
-          |> List.iter (fun case ->
-                 Ast_iterator.default_iterator.case iterator case);
+          cases |> List.iter (fun case -> iterator.case iterator case);
           currentTypeLoc := oldTypeLoc;
           processed := true
         | Pexp_extension ({txt = "obj"}, PStr [str_item]) ->
@@ -599,6 +597,10 @@ let completionWithParser ~currentFile ~debug ~offset ~path ~posCursor text =
         | _ -> ());
       if not !processed then Ast_iterator.default_iterator.expr iterator expr
   in
+  let case (_iterator : Ast_iterator.iterator) (case : Parsetree.case) =
+    if case.pc_loc |> Loc.hasPos ~pos:posCursor then
+      setResult (Ccase case.pc_loc)
+  in
   let typ (iterator : Ast_iterator.iterator) (core_type : Parsetree.core_type) =
     if core_type.ptyp_loc |> Loc.hasPos ~pos:posNoWhite then (
       found := true;
@@ -765,6 +767,7 @@ let completionWithParser ~currentFile ~debug ~offset ~path ~posCursor text =
       Ast_iterator.default_iterator with
       attribute;
       expr;
+      case;
       location;
       module_expr;
       module_type;
@@ -784,7 +787,8 @@ let completionWithParser ~currentFile ~debug ~offset ~path ~posCursor text =
       Res_driver.parsing_engine.parse_implementation ~for_printer:false
     in
     let {Res_driver.parsetree = str} = parser ~filename:currentFile in
-    iterator.structure iterator str |> ignore;
+    let tree = Res_recovery.map str in
+    iterator.structure iterator tree |> ignore;
     if blankAfterCursor = Some ' ' || blankAfterCursor = Some '\n' then
       scope := !lastScopeBeforeCursor
       (* TODO(revamp) Complete any value *)

analysis/src/SharedTypes.ml

@@ -793,6 +793,7 @@ module CompletableRevamped = struct
     | CextensionNode of string
     | Cdecorator of string
     | CdecoratorPayload of decoratorPayload
+    | Ccase of Location.t
 
   let toString (t : t) =
     match t with
@@ -802,11 +803,13 @@ module CompletableRevamped = struct
     | CextensionNode _ -> "CextensionNode"
     | Cdecorator _ -> "Cdecorator"
     | CdecoratorPayload _ -> "CdecoratorPayload"
+    | Ccase _ -> "Ccase"
 
   let try_loc (t : t) =
     match t with
     | Cexpression {typeLoc; _} -> Some typeLoc
     | Cpattern {typeLoc; _} -> Some typeLoc
+    | Ccase loc -> Some loc
     | _ -> None
 end
 

compiler/syntax/src/res_driver.ml

@@ -139,8 +139,9 @@ let parse_implementation ?(ignore_parse_errors = false) sourcefile =
   in
   if parse_result.invalid then (
     Res_diagnostics.print_report parse_result.diagnostics parse_result.source;
-    if not ignore_parse_errors then exit 1);
-  parse_result.parsetree
+    if not ignore_parse_errors then exit 1;
+    Res_recovery.map parse_result.parsetree)
+  else parse_result.parsetree
 [@@raises exit]
 
 let parse_interface ?(ignore_parse_errors = false) sourcefile =

compiler/syntax/src/res_recovery.ml

@@ -0,0 +1,44 @@
+let map_expr (mapper : Ast_mapper.mapper) (expr : Parsetree.expression) =
+  match expr.pexp_desc with
+  | Pexp_match (e, cases) ->
+    let mapped_e = mapper.expr mapper e in
+    let match_end_loc = expr.pexp_loc.loc_end in
+
+    let is_ghost_case case =
+      let open Parsetree in
+      case.pc_lhs.ppat_loc.loc_ghost && case.pc_rhs.pexp_loc.loc_ghost
+    in
+
+    let rec process_cases mapped_cases cases =
+      match cases with
+      | [] -> mapped_cases
+      | [last_case] when is_ghost_case last_case ->
+        prerr_endline "last case";
+        let mapped =
+          mapper.case mapper
+            {
+              last_case with
+              pc_loc = {last_case.pc_loc with loc_end = match_end_loc};
+            }
+        in
+        process_cases (mapped :: mapped_cases) []
+      | current :: (next :: _ as rest) when is_ghost_case current ->
+        let mapped =
+          mapper.case mapper
+            {
+              current with
+              pc_loc =
+                {current.pc_loc with loc_end = next.pc_lhs.ppat_loc.loc_start};
+            }
+        in
+        process_cases (mapped :: mapped_cases) rest
+      | c :: rest -> process_cases (mapper.case mapper c :: mapped_cases) rest
+    in
+
+    let adjusted_cases = process_cases [] cases in
+    {expr with pexp_desc = Pexp_match (mapped_e, adjusted_cases)}
+  | _ -> Ast_mapper.default_mapper.expr mapper expr
+
+let map (tree : Parsetree.structure) =
+  let mapper = {Ast_mapper.default_mapper with expr = map_expr} in
+  mapper.structure mapper tree