Skip to content

Commit 58f3aa4

Browse files
nojafnojaf
committed
WIP, find cursor in broken case
1 parent c8c6488 commit 58f3aa4

14 files changed

+93
-187
lines changed

‎analysis/src/CompletionBackEndRevamped.ml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -111,3 +111,4 @@ let processCompletable ~debug ~full ~scope ~env ~pos
111111
(dec2, doc, maybeInsertText))
112112
|> List.map mkDecorator
113113
| CdecoratorPayload _ -> []
114+
| Ccase _ -> []

‎analysis/src/CompletionFrontEndRevamped.ml

Lines changed: 10 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -404,16 +404,14 @@ let completionWithParser ~currentFile ~debug ~offset ~path ~posCursor text =
404404
if expr.pexp_loc |> Loc.hasPos ~pos:posNoWhite && !result = None then (
405405
setFound ();
406406
match expr.pexp_desc with
407-
| Pexp_match (switchExpr, [{pc_lhs = lhsPat}])
407+
(* | Pexp_match (switchExpr, [{pc_lhs = lhsPat}])
408408
when CompletionPatterns.isPatternHole lhsPat
409409
&& locHasCursor switchExpr.pexp_loc = false ->
410-
setResult (Cpattern {kind = Empty; typeLoc = switchExpr.pexp_loc})
410+
setResult (Cpattern {kind = Empty; typeLoc = switchExpr.pexp_loc}) *)
411411
| Pexp_match (switchExpr, cases) ->
412412
let oldTypeLoc = !currentTypeLoc in
413413
currentTypeLoc := Some switchExpr.pexp_loc;
414-
cases
415-
|> List.iter (fun case ->
416-
Ast_iterator.default_iterator.case iterator case);
414+
cases |> List.iter (fun case -> iterator.case iterator case);
417415
currentTypeLoc := oldTypeLoc;
418416
processed := true
419417
| Pexp_extension ({txt = "obj"}, PStr [str_item]) ->
@@ -599,6 +597,10 @@ let completionWithParser ~currentFile ~debug ~offset ~path ~posCursor text =
599597
| _ -> ());
600598
if not !processed then Ast_iterator.default_iterator.expr iterator expr
601599
in
600+
let case (_iterator : Ast_iterator.iterator) (case : Parsetree.case) =
601+
if case.pc_loc |> Loc.hasPos ~pos:posCursor then
602+
setResult (Ccase case.pc_loc)
603+
in
602604
let typ (iterator : Ast_iterator.iterator) (core_type : Parsetree.core_type) =
603605
if core_type.ptyp_loc |> Loc.hasPos ~pos:posNoWhite then (
604606
found := true;
@@ -765,6 +767,7 @@ let completionWithParser ~currentFile ~debug ~offset ~path ~posCursor text =
765767
Ast_iterator.default_iterator with
766768
attribute;
767769
expr;
770+
case;
768771
location;
769772
module_expr;
770773
module_type;
@@ -784,7 +787,8 @@ let completionWithParser ~currentFile ~debug ~offset ~path ~posCursor text =
784787
Res_driver.parsing_engine.parse_implementation ~for_printer:false
785788
in
786789
let {Res_driver.parsetree = str} = parser ~filename:currentFile in
787-
iterator.structure iterator str |> ignore;
790+
let tree = Res_recovery.map str in
791+
iterator.structure iterator tree |> ignore;
788792
if blankAfterCursor = Some ' ' || blankAfterCursor = Some '\n' then
789793
scope := !lastScopeBeforeCursor
790794
(* TODO(revamp) Complete any value *)

‎analysis/src/SharedTypes.ml

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -793,6 +793,7 @@ module CompletableRevamped = struct
793793
| CextensionNode of string
794794
| Cdecorator of string
795795
| CdecoratorPayload of decoratorPayload
796+
| Ccase of Location.t
796797

797798
let toString (t : t) =
798799
match t with
@@ -802,11 +803,13 @@ module CompletableRevamped = struct
802803
| CextensionNode _ -> "CextensionNode"
803804
| Cdecorator _ -> "Cdecorator"
804805
| CdecoratorPayload _ -> "CdecoratorPayload"
806+
| Ccase _ -> "Ccase"
805807

806808
let try_loc (t : t) =
807809
match t with
808810
| Cexpression {typeLoc; _} -> Some typeLoc
809811
| Cpattern {typeLoc; _} -> Some typeLoc
812+
| Ccase loc -> Some loc
810813
| _ -> None
811814
end
812815

‎compiler/syntax/src/res_driver.ml

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -139,8 +139,9 @@ let parse_implementation ?(ignore_parse_errors = false) sourcefile =
139139
in
140140
if parse_result.invalid then (
141141
Res_diagnostics.print_report parse_result.diagnostics parse_result.source;
142-
if not ignore_parse_errors then exit 1);
143-
parse_result.parsetree
142+
if not ignore_parse_errors then exit 1;
143+
Res_recovery.map parse_result.parsetree)
144+
else parse_result.parsetree
144145
[@@raises exit]
145146

146147
let parse_interface ?(ignore_parse_errors = false) sourcefile =

‎compiler/syntax/src/res_recovery.ml

Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,44 @@
1+
let map_expr (mapper : Ast_mapper.mapper) (expr : Parsetree.expression) =
2+
match expr.pexp_desc with
3+
| Pexp_match (e, cases) ->
4+
let mapped_e = mapper.expr mapper e in
5+
let match_end_loc = expr.pexp_loc.loc_end in
6+
7+
let is_ghost_case case =
8+
let open Parsetree in
9+
case.pc_lhs.ppat_loc.loc_ghost && case.pc_rhs.pexp_loc.loc_ghost
10+
in
11+
12+
let rec process_cases mapped_cases cases =
13+
match cases with
14+
| [] -> mapped_cases
15+
| [last_case] when is_ghost_case last_case ->
16+
prerr_endline "last case";
17+
let mapped =
18+
mapper.case mapper
19+
{
20+
last_case with
21+
pc_loc = {last_case.pc_loc with loc_end = match_end_loc};
22+
}
23+
in
24+
process_cases (mapped :: mapped_cases) []
25+
| current :: (next :: _ as rest) when is_ghost_case current ->
26+
let mapped =
27+
mapper.case mapper
28+
{
29+
current with
30+
pc_loc =
31+
{current.pc_loc with loc_end = next.pc_lhs.ppat_loc.loc_start};
32+
}
33+
in
34+
process_cases (mapped :: mapped_cases) rest
35+
| c :: rest -> process_cases (mapper.case mapper c :: mapped_cases) rest
36+
in
37+
38+
let adjusted_cases = process_cases [] cases in
39+
{expr with pexp_desc = Pexp_match (mapped_e, adjusted_cases)}
40+
| _ -> Ast_mapper.default_mapper.expr mapper expr
41+
42+
let map (tree : Parsetree.structure) =
43+
let mapper = {Ast_mapper.default_mapper with expr = map_expr} in
44+
mapper.structure mapper tree

‎tests/analysis_new_tests/tests/test_files/__snapshots__/RecordFieldCompletions.res_Record field completion in nested record, another level.snap

Lines changed: 0 additions & 23 deletions
This file was deleted.

‎tests/analysis_new_tests/tests/test_files/__snapshots__/RecordFieldCompletions.res_Record field completion in nested record.snap

Lines changed: 0 additions & 23 deletions
This file was deleted.

‎tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty case, array.snap

Lines changed: 0 additions & 23 deletions
This file was deleted.

‎tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty case, bool.snap

Lines changed: 0 additions & 30 deletions
This file was deleted.

‎tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty case, record.snap

Lines changed: 0 additions & 21 deletions
This file was deleted.

0 commit comments

Comments
 (0)