From 797832a4b19359af652eb2e0e5579a8b014d558b Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 18 Aug 2023 19:27:46 +0200 Subject: [PATCH 1/3] code actions for inserting exhaustive switches for selected expressions, single identifiers, and switch cases being written --- analysis/src/Cli.ml | 6 +- analysis/src/Codemod.ml | 7 +- analysis/src/Commands.ml | 27 ++- analysis/src/CompletionFrontEnd.ml | 22 ++- analysis/src/Loc.ml | 4 + analysis/src/TypeUtils.ml | 55 ++++++ analysis/src/Xform.ml | 161 +++++++++++++++++- analysis/tests/src/ExhaustiveSwitch.res | 19 +++ .../src/expected/ExhaustiveSwitch.res.txt | 53 ++++++ analysis/tests/src/expected/Xform.res.txt | 16 ++ server/src/server.ts | 2 + 11 files changed, 353 insertions(+), 19 deletions(-) diff --git a/analysis/src/Cli.ml b/analysis/src/Cli.ml index 2dcf3a4bc..87765c755 100644 --- a/analysis/src/Cli.ml +++ b/analysis/src/Cli.ml @@ -120,9 +120,11 @@ let main () = ~pos:(int_of_string line_start, int_of_string line_end) ~maxLength ~debug:false | [_; "codeLens"; path] -> Commands.codeLens ~path ~debug:false - | [_; "codeAction"; path; line; col; currentFile] -> + | [_; "codeAction"; path; startLine; startCol; endLine; endCol; currentFile] + -> Commands.codeAction ~path - ~pos:(int_of_string line, int_of_string col) + ~startPos:(int_of_string startLine, int_of_string startCol) + ~endPos:(int_of_string endLine, int_of_string endCol) ~currentFile ~debug:false | [_; "codemod"; path; line; col; typ; hint] -> let typ = diff --git a/analysis/src/Codemod.ml b/analysis/src/Codemod.ml index 7c0c87dbd..5204f4825 100644 --- a/analysis/src/Codemod.ml +++ b/analysis/src/Codemod.ml @@ -5,11 +5,6 @@ let rec collectPatterns p = | Ppat_or (p1, p2) -> collectPatterns p1 @ [p2] | _ -> [p] -let mkFailWithExp () = - Ast_helper.Exp.apply - (Ast_helper.Exp.ident {txt = Lident "failwith"; loc = Location.none}) - [(Nolabel, Ast_helper.Exp.constant (Pconst_string ("TODO", None)))] - let transform ~path ~pos ~debug ~typ ~hint = let structure, printExpr, _ = Xform.parseImplementation ~filename:path in match typ with @@ -24,7 +19,7 @@ let transform ~path ~pos ~debug ~typ ~hint = let cases = collectPatterns pattern |> List.map (fun (p : Parsetree.pattern) -> - Ast_helper.Exp.case p (mkFailWithExp ())) + Ast_helper.Exp.case p (TypeUtils.Codegen.mkFailWithExp ())) in let result = ref None in let mkIterator ~pos ~result = diff --git a/analysis/src/Commands.ml b/analysis/src/Commands.ml index 53fb895e4..c46225fa0 100644 --- a/analysis/src/Commands.ml +++ b/analysis/src/Commands.ml @@ -80,8 +80,8 @@ let signatureHelp ~path ~pos ~currentFile ~debug = in print_endline (Protocol.stringifySignatureHelp result) -let codeAction ~path ~pos ~currentFile ~debug = - Xform.extractCodeActions ~path ~pos ~currentFile ~debug +let codeAction ~path ~startPos ~endPos ~currentFile ~debug = + Xform.extractCodeActions ~path ~startPos ~endPos ~currentFile ~debug |> CodeActions.stringifyCodeActions |> print_endline let definition ~path ~pos ~debug = @@ -268,7 +268,9 @@ let test ~path = let lines = text |> String.split_on_char '\n' in let processLine i line = let createCurrentFile () = - let currentFile, cout = Filename.open_temp_file "def" "txt" in + let currentFile, cout = + Filename.open_temp_file "def" ("txt." ^ Filename.extension path) + in let removeLineComment l = let len = String.length l in let rec loop i = @@ -372,13 +374,24 @@ let test ~path = ^ string_of_int col); typeDefinition ~path ~pos:(line, col) ~debug:true | "xfm" -> - print_endline - ("Xform " ^ path ^ " " ^ string_of_int line ^ ":" - ^ string_of_int col); + let currentFile = createCurrentFile () in + (* +2 is to ensure that the character ^ points to is what's considered the end of the selection. *) + let endCol = col + try String.index rest '^' + 2 with _ -> 0 in + let endPos = (line, endCol) in + let startPos = (line, col) in + if startPos = endPos then + print_endline + ("Xform " ^ path ^ " " ^ string_of_int line ^ ":" + ^ string_of_int col) + else + print_endline + ("Xform " ^ path ^ " start: " ^ Pos.toString startPos + ^ ", end: " ^ Pos.toString endPos); let codeActions = - Xform.extractCodeActions ~path ~pos:(line, col) ~currentFile:path + Xform.extractCodeActions ~path ~startPos ~endPos ~currentFile ~debug:true in + Sys.remove currentFile; codeActions |> List.iter (fun {Protocol.title; edit = {documentChanges}} -> Printf.printf "Hit: %s\n" title; diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml index dd3d933eb..261ac735a 100644 --- a/analysis/src/CompletionFrontEnd.ml +++ b/analysis/src/CompletionFrontEnd.ml @@ -222,7 +222,8 @@ let completePipeChain (exp : Parsetree.expression) = exprToContextPath exp |> Option.map (fun ctxPath -> (ctxPath, pexp_loc)) | _ -> None -let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text = +let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor + ?findThisExprLoc text = let offsetNoWhite = Utils.skipWhite text (offset - 1) in let posNoWhite = let line, col = posCursor in @@ -777,6 +778,12 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text = (Pos.toString posCursor) (Pos.toString posNoWhite) (Loc.toString expr.pexp_loc) in + (match findThisExprLoc with + | Some loc when expr.pexp_loc = loc -> ( + match exprToContextPath expr with + | None -> () + | Some ctxPath -> setResult (Cpath ctxPath)) + | _ -> ()); let setPipeResult ~(lhs : Parsetree.expression) ~id = match completePipeChain lhs with | None -> ( @@ -1228,5 +1235,16 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text = let completionWithParser ~debug ~path ~posCursor ~currentFile ~text = match Pos.positionToOffset text posCursor with | Some offset -> - completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text + completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor text | None -> None + +let findTypeOfExpressionAtLoc ~debug ~path ~posCursor ~currentFile loc = + let textOpt = Files.readFile currentFile in + match textOpt with + | None | Some "" -> None + | Some text -> ( + match Pos.positionToOffset text posCursor with + | Some offset -> + completionWithParser1 ~findThisExprLoc:loc ~currentFile ~debug ~offset + ~path ~posCursor text + | None -> None) diff --git a/analysis/src/Loc.ml b/analysis/src/Loc.ml index 8e0c72bd6..a9e42979c 100644 --- a/analysis/src/Loc.ml +++ b/analysis/src/Loc.ml @@ -8,3 +8,7 @@ let toString (loc : t) = (if loc.loc_ghost then "__ghost__" else "") ^ (loc |> range |> Range.toString) let hasPos ~pos loc = start loc <= pos && pos < end_ loc + +(** Allows the character after the end to be included. Ie when the cursor is at the + end of the word, like `someIdentifier`. Useful in some scenarios. *) +let hasPosInclusiveEnd ~pos loc = start loc <= pos && pos <= end_ loc diff --git a/analysis/src/TypeUtils.ml b/analysis/src/TypeUtils.ml index 369630775..f3aaa6cf8 100644 --- a/analysis/src/TypeUtils.ml +++ b/analysis/src/TypeUtils.ml @@ -606,3 +606,58 @@ let unwrapCompletionTypeIfOption (t : SharedTypes.completionType) = match t with | Toption (_, ExtractedType unwrapped) -> unwrapped | _ -> t + +module Codegen = struct + let mkFailWithExp () = + Ast_helper.Exp.apply + (Ast_helper.Exp.ident {txt = Lident "failwith"; loc = Location.none}) + [(Nolabel, Ast_helper.Exp.constant (Pconst_string ("TODO", None)))] + + let mkConstructPat ?payload name = + Ast_helper.Pat.construct + {Asttypes.txt = Longident.Lident name; loc = Location.none} + payload + + let mkConstructCase ?(withPayload = false) name = + Ast_helper.Exp.case + (mkConstructPat + ?payload:(if withPayload then Some (Ast_helper.Pat.any ()) else None) + name) + (mkFailWithExp ()) + + let mkTagPat ?payload name = Ast_helper.Pat.variant name payload + + let mkTagCase ?(withPayload = false) name = + Ast_helper.Exp.case + (mkTagPat + ?payload:(if withPayload then Some (Ast_helper.Pat.any ()) else None) + name) + (mkFailWithExp ()) + + let extractedTypeToExhaustiveCases extractedType = + match extractedType with + | Tvariant v -> + Some + (v.constructors + |> List.map (fun (c : SharedTypes.Constructor.t) -> + mkConstructCase + ~withPayload: + (match c.args with + | Args [] -> false + | _ -> true) + c.cname.txt)) + | Tpolyvariant v -> + Some + (v.constructors + |> List.map (fun (c : SharedTypes.polyVariantConstructor) -> + mkTagCase + ~withPayload: + (match c.args with + | [] -> false + | _ -> true) + c.name)) + | Toption _ -> + Some [mkConstructCase "None"; mkConstructCase ~withPayload:true "Some"] + | Tbool _ -> Some [mkConstructCase "true"; mkConstructCase "false"] + | _ -> None +end diff --git a/analysis/src/Xform.ml b/analysis/src/Xform.ml index 87166cad4..4bc3e512b 100644 --- a/analysis/src/Xform.ml +++ b/analysis/src/Xform.ml @@ -255,6 +255,157 @@ module AddTypeAnnotation = struct | _ -> ())) end +module ExhaustiveSwitch = struct + (* Expand expression to be an exhaustive switch of the underlying value *) + type posType = Single of Pos.t | Range of Pos.t * Pos.t + + type completionType = + | Switch of { + pos: Pos.t; + switchExpr: Parsetree.expression; + completionExpr: Parsetree.expression; + } + | Selection of {expr: Parsetree.expression} + + module C = struct + let extractTypeFromExpr expr ~debug ~path ~currentFile ~full ~pos = + match + expr.Parsetree.pexp_loc + |> CompletionFrontEnd.findTypeOfExpressionAtLoc ~debug ~path + ~currentFile + ~posCursor:(Pos.ofLexing expr.Parsetree.pexp_loc.loc_start) + with + | Some (completable, scope) -> ( + let env = SharedTypes.QueryEnv.fromFile full.SharedTypes.file in + let completions = + completable + |> CompletionBackEnd.processCompletable ~debug ~full ~pos ~scope ~env + ~forHover:true + in + let rawOpens = Scope.getRawOpens scope in + match completions with + | {env} :: _ -> ( + let opens = + CompletionBackEnd.getOpens ~debug ~rawOpens ~package:full.package + ~env + in + match + CompletionBackEnd.completionsGetCompletionType2 ~debug ~full + ~rawOpens ~opens ~pos ~scope completions + with + | Some (typ, _env) -> + let extractedType = + match typ with + | ExtractedType t -> Some t + | TypeExpr t -> TypeUtils.extractType t ~env ~package:full.package + in + extractedType + | None -> None) + | _ -> None) + | _ -> None + end + + let mkIteratorSingle ~pos ~result = + let expr (iterator : Ast_iterator.iterator) (exp : Parsetree.expression) = + (match exp.pexp_desc with + | Pexp_ident _ when Loc.hasPosInclusiveEnd ~pos exp.pexp_loc -> + (* Exhaustive switch for having the cursor on an identifier. *) + result := Some (Selection {expr = exp}) + | Pexp_match (completionExpr, []) + when Loc.hasPosInclusiveEnd ~pos exp.pexp_loc -> + (* No cases means there's no `|` yet in the switch, so `switch someExpr` *) + result := Some (Switch {pos; switchExpr = exp; completionExpr}) + | _ -> ()); + Ast_iterator.default_iterator.expr iterator exp + in + {Ast_iterator.default_iterator with expr} + + let mkIteratorRange ~startPos ~endPos ~foundSelection = + let expr (iterator : Ast_iterator.iterator) (exp : Parsetree.expression) = + let expStartPos = Pos.ofLexing exp.pexp_loc.loc_start in + let expEndPos = Pos.ofLexing exp.pexp_loc.loc_end in + + (if expStartPos = startPos then + match !foundSelection with + | None, endExpr -> foundSelection := (Some exp, endExpr) + | _ -> ()); + + (if expEndPos = endPos then + match !foundSelection with + | startExp, _ -> foundSelection := (startExp, Some exp)); + + Ast_iterator.default_iterator.expr iterator exp + in + {Ast_iterator.default_iterator with expr} + + let xform ~printExpr ~path ~currentFile ~pos ~full ~structure ~codeActions + ~debug = + (* TODO: Adapt to '(' as leading/trailing character (skip one col, it's not included in the AST) *) + let result = ref None in + let foundSelection = ref (None, None) in + let iterator = + match pos with + | Single pos -> mkIteratorSingle ~pos ~result + | Range (startPos, endPos) -> + mkIteratorRange ~startPos ~endPos ~foundSelection + in + iterator.structure iterator structure; + (match !foundSelection with + | Some startExp, Some endExp -> + if debug then + Printf.printf "found selection: %s -> %s\n" + (Loc.toString startExp.pexp_loc) + (Loc.toString endExp.pexp_loc); + result := Some (Selection {expr = startExp}) + | _ -> ()); + match !result with + | None -> () + | Some (Selection {expr}) -> ( + match + expr + |> C.extractTypeFromExpr ~debug ~path ~currentFile ~full + ~pos:(Pos.ofLexing expr.pexp_loc.loc_start) + with + | None -> () + | Some extractedType -> ( + let open TypeUtils.Codegen in + let exhaustiveSwitch = extractedTypeToExhaustiveCases extractedType in + match exhaustiveSwitch with + | None -> () + | Some cases -> + let range = rangeOfLoc expr.pexp_loc in + let newText = + printExpr ~range {expr with pexp_desc = Pexp_match (expr, cases)} + in + let codeAction = + CodeActions.make ~title:"Exhaustive switch" ~kind:RefactorRewrite + ~uri:path ~newText ~range + in + codeActions := codeAction :: !codeActions)) + | Some (Switch {switchExpr; completionExpr; pos}) -> ( + match + completionExpr + |> C.extractTypeFromExpr ~debug ~path ~currentFile ~full ~pos + with + | None -> () + | Some extractedType -> ( + let open TypeUtils.Codegen in + let exhaustiveSwitch = extractedTypeToExhaustiveCases extractedType in + match exhaustiveSwitch with + | None -> () + | Some cases -> + let range = rangeOfLoc switchExpr.pexp_loc in + let newText = + printExpr ~range + {switchExpr with pexp_desc = Pexp_match (completionExpr, cases)} + in + let codeAction = + CodeActions.make ~title:"Exhaustive switch" ~kind:RefactorRewrite + ~uri:path ~newText ~range + in + codeActions := codeAction :: !codeActions)) +end + module AddDocTemplate = struct let createTemplate () = let docContent = ["\n"; "\n"] in @@ -488,7 +639,8 @@ let parseInterface ~filename = in (structure, printSignatureItem) -let extractCodeActions ~path ~pos ~currentFile ~debug = +let extractCodeActions ~path ~startPos ~endPos ~currentFile ~debug = + let pos = startPos in let codeActions = ref [] in match Files.classifySourceFile currentFile with | Res -> @@ -504,7 +656,12 @@ let extractCodeActions ~path ~pos ~currentFile ~debug = let () = match Cmt.loadFullCmtFromPath ~path with | Some full -> - AddTypeAnnotation.xform ~path ~pos ~full ~structure ~codeActions ~debug + AddTypeAnnotation.xform ~path ~pos ~full ~structure ~codeActions ~debug; + ExhaustiveSwitch.xform ~printExpr ~path + ~pos: + (if startPos = endPos then Single startPos + else Range (startPos, endPos)) + ~full ~structure ~codeActions ~debug ~currentFile | None -> () in diff --git a/analysis/tests/src/ExhaustiveSwitch.res b/analysis/tests/src/ExhaustiveSwitch.res index eb23a1aff..a62495585 100644 --- a/analysis/tests/src/ExhaustiveSwitch.res +++ b/analysis/tests/src/ExhaustiveSwitch.res @@ -17,3 +17,22 @@ let someOpt = Some(true) // switch someOp // ^com + +type rcrd = {someVariant: someVariant} + +let getV = r => r.someVariant + +let x: rcrd = { + someVariant: One, +} + +let vvv = x->getV + +// switch x->getV +// ^xfm + +// x->getV +// ^xfm ^ + +// vvv +// ^xfm diff --git a/analysis/tests/src/expected/ExhaustiveSwitch.res.txt b/analysis/tests/src/expected/ExhaustiveSwitch.res.txt index 96d3bc612..3c6fe495e 100644 --- a/analysis/tests/src/expected/ExhaustiveSwitch.res.txt +++ b/analysis/tests/src/expected/ExhaustiveSwitch.res.txt @@ -94,3 +94,56 @@ Path someOp "insertTextFormat": 2 }] +Xform src/ExhaustiveSwitch.res 30:13 +posCursor:[30:13] posNoWhite:[30:12] Found expr:[30:3->30:17] +posCursor:[30:13] posNoWhite:[30:12] Found expr:[30:10->30:17] +Completable: Cpath Value[x]-> +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +ContextPath Value[x]-> +ContextPath Value[x] +Path x +CPPipe env:ExhaustiveSwitch +CPPipe type path:rcrd +CPPipe pathFromEnv: found:true + +Xform src/ExhaustiveSwitch.res start: 33:3, end: 33:10 +found selection: [33:3->33:10] -> [33:6->33:10] +XXX Not found! +Completable: Cpath Value[getV](Nolabel) +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +ContextPath Value[getV](Nolabel) +ContextPath Value[getV] +Path getV +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Hit: Exhaustive switch +{"start": {"line": 33, "character": 3}, "end": {"line": 33, "character": 10}} +newText: + <--here + switch x->getV { + | One => failwith("TODO") + | Two => failwith("TODO") + | Three(_) => failwith("TODO") + } + +Xform src/ExhaustiveSwitch.res 36:4 +XXX Not found! +Completable: Cpath Value[vvv] +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +ContextPath Value[vvv] +Path vvv +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Hit: Exhaustive switch +{"start": {"line": 36, "character": 3}, "end": {"line": 36, "character": 6}} +newText: + <--here + switch vvv { + | One => failwith("TODO") + | Two => failwith("TODO") + | Three(_) => failwith("TODO") + } + diff --git a/analysis/tests/src/expected/Xform.res.txt b/analysis/tests/src/expected/Xform.res.txt index 9de1f9f2d..0af705bff 100644 --- a/analysis/tests/src/expected/Xform.res.txt +++ b/analysis/tests/src/expected/Xform.res.txt @@ -1,4 +1,12 @@ Xform src/Xform.res 6:5 +posCursor:[6:3] posNoWhite:[6:1] Found expr:[6:0->11:1] +Completable: Cpath Value[kind] +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +ContextPath Value[kind] +Path kind +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives Hit: Replace with switch {"start": {"line": 6, "character": 0}, "end": {"line": 11, "character": 1}} newText: @@ -92,6 +100,14 @@ newText: : int Xform src/Xform.res 48:21 +posCursor:[48:21] posNoWhite:[48:19] Found expr:[48:15->48:25] +Completable: Cpath Value[name] +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +ContextPath Value[name] +Path name +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives Hit: Add braces to function {"start": {"line": 48, "character": 0}, "end": {"line": 48, "character": 25}} newText: diff --git a/server/src/server.ts b/server/src/server.ts index 98ec1779f..ca4564902 100644 --- a/server/src/server.ts +++ b/server/src/server.ts @@ -714,6 +714,8 @@ function codeAction(msg: p.RequestMessage): p.ResponseMessage { filePath, params.range.start.line, params.range.start.character, + params.range.end.line, + params.range.end.character, tmpname, ], msg From 2b5dff8d3dbf90f9dbf0349364c02e8152226a1e Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 18 Aug 2023 20:04:51 +0200 Subject: [PATCH 2/3] expand options automatically --- analysis/src/TypeUtils.ml | 69 ++++++++++++------- analysis/src/Xform.ml | 12 +++- analysis/tests/src/ExhaustiveSwitch.res | 2 +- .../src/expected/ExhaustiveSwitch.res.txt | 8 ++- 4 files changed, 60 insertions(+), 31 deletions(-) diff --git a/analysis/src/TypeUtils.ml b/analysis/src/TypeUtils.ml index f3aaa6cf8..b0455e4da 100644 --- a/analysis/src/TypeUtils.ml +++ b/analysis/src/TypeUtils.ml @@ -618,46 +618,65 @@ module Codegen = struct {Asttypes.txt = Longident.Lident name; loc = Location.none} payload - let mkConstructCase ?(withPayload = false) name = - Ast_helper.Exp.case - (mkConstructPat - ?payload:(if withPayload then Some (Ast_helper.Pat.any ()) else None) - name) - (mkFailWithExp ()) - let mkTagPat ?payload name = Ast_helper.Pat.variant name payload - let mkTagCase ?(withPayload = false) name = - Ast_helper.Exp.case - (mkTagPat - ?payload:(if withPayload then Some (Ast_helper.Pat.any ()) else None) - name) - (mkFailWithExp ()) + let any () = Ast_helper.Pat.any () - let extractedTypeToExhaustiveCases extractedType = + let rec extractedTypeToExhaustivePatterns ~env ~full extractedType = match extractedType with | Tvariant v -> Some (v.constructors |> List.map (fun (c : SharedTypes.Constructor.t) -> - mkConstructCase - ~withPayload: + mkConstructPat + ?payload: (match c.args with - | Args [] -> false - | _ -> true) + | Args [] -> None + | _ -> Some (any ())) c.cname.txt)) | Tpolyvariant v -> Some (v.constructors |> List.map (fun (c : SharedTypes.polyVariantConstructor) -> - mkTagCase - ~withPayload: + mkTagPat + ?payload: (match c.args with - | [] -> false - | _ -> true) + | [] -> None + | _ -> Some (any ())) c.name)) - | Toption _ -> - Some [mkConstructCase "None"; mkConstructCase ~withPayload:true "Some"] - | Tbool _ -> Some [mkConstructCase "true"; mkConstructCase "false"] + | Toption (_, innerType) -> + let extractedType = + match innerType with + | ExtractedType t -> Some t + | TypeExpr t -> extractType t ~env ~package:full.package + in + let expandedBranches = + match extractedType with + | None -> [] + | Some extractedType -> ( + match extractedTypeToExhaustivePatterns ~env ~full extractedType with + | None -> [] + | Some patterns -> patterns) + in + Some + ([ + mkConstructPat "None"; + mkConstructPat ~payload:(Ast_helper.Pat.any ()) "Some"; + ] + @ (expandedBranches + |> List.map (fun (pat : Parsetree.pattern) -> + mkConstructPat ~payload:pat "Some"))) + | Tbool _ -> Some [mkConstructPat "true"; mkConstructPat "false"] | _ -> None + + let extractedTypeToExhaustiveCases ~env ~full extractedType = + let patterns = extractedTypeToExhaustivePatterns ~env ~full extractedType in + + match patterns with + | None -> None + | Some patterns -> + Some + (patterns + |> List.map (fun (pat : Parsetree.pattern) -> + Ast_helper.Exp.case pat (mkFailWithExp ()))) end diff --git a/analysis/src/Xform.ml b/analysis/src/Xform.ml index 4bc3e512b..725418429 100644 --- a/analysis/src/Xform.ml +++ b/analysis/src/Xform.ml @@ -369,7 +369,11 @@ module ExhaustiveSwitch = struct | None -> () | Some extractedType -> ( let open TypeUtils.Codegen in - let exhaustiveSwitch = extractedTypeToExhaustiveCases extractedType in + let exhaustiveSwitch = + extractedTypeToExhaustiveCases2 + ~env:(SharedTypes.QueryEnv.fromFile full.file) + ~full extractedType + in match exhaustiveSwitch with | None -> () | Some cases -> @@ -390,7 +394,11 @@ module ExhaustiveSwitch = struct | None -> () | Some extractedType -> ( let open TypeUtils.Codegen in - let exhaustiveSwitch = extractedTypeToExhaustiveCases extractedType in + let exhaustiveSwitch = + extractedTypeToExhaustiveCases2 + ~env:(SharedTypes.QueryEnv.fromFile full.file) + ~full extractedType + in match exhaustiveSwitch with | None -> () | Some cases -> diff --git a/analysis/tests/src/ExhaustiveSwitch.res b/analysis/tests/src/ExhaustiveSwitch.res index a62495585..4167f1201 100644 --- a/analysis/tests/src/ExhaustiveSwitch.res +++ b/analysis/tests/src/ExhaustiveSwitch.res @@ -26,7 +26,7 @@ let x: rcrd = { someVariant: One, } -let vvv = x->getV +let vvv = Some(x->getV) // switch x->getV // ^xfm diff --git a/analysis/tests/src/expected/ExhaustiveSwitch.res.txt b/analysis/tests/src/expected/ExhaustiveSwitch.res.txt index 3c6fe495e..eaf737534 100644 --- a/analysis/tests/src/expected/ExhaustiveSwitch.res.txt +++ b/analysis/tests/src/expected/ExhaustiveSwitch.res.txt @@ -142,8 +142,10 @@ Hit: Exhaustive switch newText: <--here switch vvv { - | One => failwith("TODO") - | Two => failwith("TODO") - | Three(_) => failwith("TODO") + | None => failwith("TODO") + | Some(_) => failwith("TODO") + | Some(One) => failwith("TODO") + | Some(Two) => failwith("TODO") + | Some(Three(_)) => failwith("TODO") } From 37cb5580c6db7db0e55339fe0a52ac1c2953634f Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 18 Aug 2023 20:17:17 +0200 Subject: [PATCH 3/3] fix --- analysis/src/Xform.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/analysis/src/Xform.ml b/analysis/src/Xform.ml index 725418429..74de3fe3e 100644 --- a/analysis/src/Xform.ml +++ b/analysis/src/Xform.ml @@ -370,7 +370,7 @@ module ExhaustiveSwitch = struct | Some extractedType -> ( let open TypeUtils.Codegen in let exhaustiveSwitch = - extractedTypeToExhaustiveCases2 + extractedTypeToExhaustiveCases ~env:(SharedTypes.QueryEnv.fromFile full.file) ~full extractedType in @@ -395,7 +395,7 @@ module ExhaustiveSwitch = struct | Some extractedType -> ( let open TypeUtils.Codegen in let exhaustiveSwitch = - extractedTypeToExhaustiveCases2 + extractedTypeToExhaustiveCases ~env:(SharedTypes.QueryEnv.fromFile full.file) ~full extractedType in