From ebb77391544c47f1c3543255034dce0841173a24 Mon Sep 17 00:00:00 2001
From: Gabriel Nordeborn <gabbe.nord@gmail.com>
Date: Sun, 26 May 2024 12:50:43 +0200
Subject: [PATCH 1/2] handle ppat_or and guards in code action for expanding
catch alls
---
analysis/src/Xform.ml | 54 ++++------
analysis/tests/src/Xform.res | 37 +++++++
analysis/tests/src/expected/Xform.res.txt | 120 ++++++++++++++++++++--
3 files changed, 169 insertions(+), 42 deletions(-)
diff --git a/analysis/src/Xform.ml b/analysis/src/Xform.ml
index 6e1673573..0ac5e89e3 100644
--- a/analysis/src/Xform.ml
+++ b/analysis/src/Xform.ml
@@ -392,15 +392,28 @@ module ExpandCatchAllForVariants = struct
if Debug.verbose () then
print_endline
"[codeAction - ExpandCatchAllForVariants] Found target switch";
- let currentConstructorNames =
+ let rec findAllConstructorNames ?(mode : [`option | `default] = `default)
+ ?(constructorNames = []) (p : Parsetree.pattern) =
+ match p.ppat_desc with
+ | Ppat_construct ({txt = Lident "Some"}, Some payload)
+ when mode = `option ->
+ findAllConstructorNames ~mode ~constructorNames payload
+ | Ppat_construct ({txt}, _) -> Longident.last txt :: constructorNames
+ | Ppat_variant (name, _) -> name :: constructorNames
+ | Ppat_or (a, b) ->
+ findAllConstructorNames ~mode ~constructorNames a
+ @ findAllConstructorNames ~mode ~constructorNames b
+ @ constructorNames
+ | _ -> constructorNames
+ in
+ let getCurrentConstructorNames cases =
cases
- |> List.filter_map (fun (c : Parsetree.case) ->
- match c with
- | {pc_lhs = {ppat_desc = Ppat_construct ({txt}, _)}} ->
- Some (Longident.last txt)
- | {pc_lhs = {ppat_desc = Ppat_variant (name, _)}} -> Some name
- | _ -> None)
+ |> List.map (fun (c : Parsetree.case) ->
+ if Option.is_some c.pc_guard then []
+ else findAllConstructorNames ~mode:`option c.pc_lhs)
+ |> List.flatten
in
+ let currentConstructorNames = getCurrentConstructorNames cases in
match
switchExpr
|> extractTypeFromExpr ~debug ~path ~currentFile ~full
@@ -468,32 +481,7 @@ module ExpandCatchAllForVariants = struct
in
match innerType with
| Some ((Tvariant _ | Tpolyvariant _) as variant) ->
- let currentConstructorNames =
- cases
- |> List.filter_map (fun (c : Parsetree.case) ->
- match c with
- | {
- pc_lhs =
- {
- ppat_desc =
- Ppat_construct
- ( {txt = Lident "Some"},
- Some {ppat_desc = Ppat_construct ({txt}, _)} );
- };
- } ->
- Some (Longident.last txt)
- | {
- pc_lhs =
- {
- ppat_desc =
- Ppat_construct
- ( {txt = Lident "Some"},
- Some {ppat_desc = Ppat_variant (name, _)} );
- };
- } ->
- Some name
- | _ -> None)
- in
+ let currentConstructorNames = getCurrentConstructorNames cases in
let hasNoneCase =
cases
|> List.exists (fun (c : Parsetree.case) ->
diff --git a/analysis/tests/src/Xform.res b/analysis/tests/src/Xform.res
index 89b8ea8e4..fcd287ea0 100644
--- a/analysis/tests/src/Xform.res
+++ b/analysis/tests/src/Xform.res
@@ -82,6 +82,19 @@ let _x = switch variant {
// ^xfm
}
+let _x = switch variant {
+| First | Second => "first"
+| _ => "other"
+// ^xfm
+}
+
+let _x = switch variant {
+| First if 1 > 2 => "first"
+| Second => "second"
+| _ => "other"
+// ^xfm
+}
+
let polyvariant: [#first | #second | #"illegal identifier" | #third(int)] = #first
let _y = switch polyvariant {
@@ -90,6 +103,12 @@ let _y = switch polyvariant {
// ^xfm
}
+let _y = switch polyvariant {
+| #first | #second => "first"
+| _ => "other"
+// ^xfm
+}
+
let variantOpt = Some(variant)
let _x = switch variantOpt {
@@ -98,6 +117,18 @@ let _x = switch variantOpt {
// ^xfm
}
+let _x = switch variantOpt {
+| Some(First) | Some(Second) => "first"
+| _ => "other"
+// ^xfm
+}
+
+let _x = switch variantOpt {
+| Some(First | Second) => "first"
+| _ => "other"
+// ^xfm
+}
+
let polyvariantOpt = Some(polyvariant)
let _x = switch polyvariantOpt {
@@ -106,3 +137,9 @@ let _x = switch polyvariantOpt {
| _ => "other"
// ^xfm
}
+
+let _x = switch polyvariantOpt {
+| Some(#first | #second) => "first"
+| _ => "other"
+// ^xfm
+}
diff --git a/analysis/tests/src/expected/Xform.res.txt b/analysis/tests/src/expected/Xform.res.txt
index 6db9e6286..2b38ddf41 100644
--- a/analysis/tests/src/expected/Xform.res.txt
+++ b/analysis/tests/src/expected/Xform.res.txt
@@ -206,8 +206,42 @@ newText:
<--here
Second | Third | Fourth(_)
-Xform src/Xform.res 88:4
-posCursor:[86:16] posNoWhite:[86:14] Found expr:[86:9->90:1]
+Xform src/Xform.res 86:4
+posCursor:[84:16] posNoWhite:[84:14] Found expr:[84:9->88:1]
+Completable: Cpath Value[variant]
+Package opens Pervasives.JsxModules.place holder
+Resolved opens 1 pervasives
+ContextPath Value[variant]
+Path variant
+Package opens Pervasives.JsxModules.place holder
+Resolved opens 1 pervasives
+Hit: Expand catch-all
+
+TextDocumentEdit: Xform.res
+{"start": {"line": 86, "character": 2}, "end": {"line": 86, "character": 3}}
+newText:
+ <--here
+ Third | Fourth(_)
+
+Xform src/Xform.res 93:4
+posCursor:[90:16] posNoWhite:[90:14] Found expr:[90:9->95:1]
+Completable: Cpath Value[variant]
+Package opens Pervasives.JsxModules.place holder
+Resolved opens 1 pervasives
+ContextPath Value[variant]
+Path variant
+Package opens Pervasives.JsxModules.place holder
+Resolved opens 1 pervasives
+Hit: Expand catch-all
+
+TextDocumentEdit: Xform.res
+{"start": {"line": 93, "character": 2}, "end": {"line": 93, "character": 3}}
+newText:
+ <--here
+ First | Third | Fourth(_)
+
+Xform src/Xform.res 101:4
+posCursor:[99:16] posNoWhite:[99:14] Found expr:[99:9->103:1]
Completable: Cpath Value[polyvariant]
Package opens Pervasives.JsxModules.place holder
Resolved opens 1 pervasives
@@ -218,13 +252,30 @@ Resolved opens 1 pervasives
Hit: Expand catch-all
TextDocumentEdit: Xform.res
-{"start": {"line": 88, "character": 2}, "end": {"line": 88, "character": 3}}
+{"start": {"line": 101, "character": 2}, "end": {"line": 101, "character": 3}}
newText:
<--here
#second | #"illegal identifier" | #third(_)
-Xform src/Xform.res 96:4
-posCursor:[94:16] posNoWhite:[94:14] Found expr:[94:9->98:1]
+Xform src/Xform.res 107:4
+posCursor:[105:16] posNoWhite:[105:14] Found expr:[105:9->109:1]
+Completable: Cpath Value[polyvariant]
+Package opens Pervasives.JsxModules.place holder
+Resolved opens 1 pervasives
+ContextPath Value[polyvariant]
+Path polyvariant
+Package opens Pervasives.JsxModules.place holder
+Resolved opens 1 pervasives
+Hit: Expand catch-all
+
+TextDocumentEdit: Xform.res
+{"start": {"line": 107, "character": 2}, "end": {"line": 107, "character": 3}}
+newText:
+ <--here
+ #"illegal identifier" | #third(_)
+
+Xform src/Xform.res 115:4
+posCursor:[113:16] posNoWhite:[113:14] Found expr:[113:9->117:1]
Completable: Cpath Value[variantOpt]
Package opens Pervasives.JsxModules.place holder
Resolved opens 1 pervasives
@@ -235,13 +286,47 @@ Resolved opens 1 pervasives
Hit: Expand catch-all
TextDocumentEdit: Xform.res
-{"start": {"line": 96, "character": 2}, "end": {"line": 96, "character": 3}}
+{"start": {"line": 115, "character": 2}, "end": {"line": 115, "character": 3}}
newText:
<--here
Some(Second | Third | Fourth(_)) | None
-Xform src/Xform.res 105:4
-posCursor:[102:16] posNoWhite:[102:14] Found expr:[102:9->107:1]
+Xform src/Xform.res 121:4
+posCursor:[119:16] posNoWhite:[119:14] Found expr:[119:9->123:1]
+Completable: Cpath Value[variantOpt]
+Package opens Pervasives.JsxModules.place holder
+Resolved opens 1 pervasives
+ContextPath Value[variantOpt]
+Path variantOpt
+Package opens Pervasives.JsxModules.place holder
+Resolved opens 1 pervasives
+Hit: Expand catch-all
+
+TextDocumentEdit: Xform.res
+{"start": {"line": 121, "character": 2}, "end": {"line": 121, "character": 3}}
+newText:
+ <--here
+ Some(Third | Fourth(_)) | None
+
+Xform src/Xform.res 127:4
+posCursor:[125:16] posNoWhite:[125:14] Found expr:[125:9->129:1]
+Completable: Cpath Value[variantOpt]
+Package opens Pervasives.JsxModules.place holder
+Resolved opens 1 pervasives
+ContextPath Value[variantOpt]
+Path variantOpt
+Package opens Pervasives.JsxModules.place holder
+Resolved opens 1 pervasives
+Hit: Expand catch-all
+
+TextDocumentEdit: Xform.res
+{"start": {"line": 127, "character": 2}, "end": {"line": 127, "character": 3}}
+newText:
+ <--here
+ Some(Third | Fourth(_)) | None
+
+Xform src/Xform.res 136:4
+posCursor:[133:16] posNoWhite:[133:14] Found expr:[133:9->138:1]
Completable: Cpath Value[polyvariantOpt]
Package opens Pervasives.JsxModules.place holder
Resolved opens 1 pervasives
@@ -252,8 +337,25 @@ Resolved opens 1 pervasives
Hit: Expand catch-all
TextDocumentEdit: Xform.res
-{"start": {"line": 105, "character": 2}, "end": {"line": 105, "character": 3}}
+{"start": {"line": 136, "character": 2}, "end": {"line": 136, "character": 3}}
newText:
<--here
Some(#"illegal identifier" | #second | #third(_))
+Xform src/Xform.res 142:4
+posCursor:[140:16] posNoWhite:[140:14] Found expr:[140:9->144:1]
+Completable: Cpath Value[polyvariantOpt]
+Package opens Pervasives.JsxModules.place holder
+Resolved opens 1 pervasives
+ContextPath Value[polyvariantOpt]
+Path polyvariantOpt
+Package opens Pervasives.JsxModules.place holder
+Resolved opens 1 pervasives
+Hit: Expand catch-all
+
+TextDocumentEdit: Xform.res
+{"start": {"line": 142, "character": 2}, "end": {"line": 142, "character": 3}}
+newText:
+ <--here
+ Some(#"illegal identifier" | #third(_)) | None
+
From 1636515f3d91e48d26d1da9670c79bc6e77642cb Mon Sep 17 00:00:00 2001
From: Gabriel Nordeborn <gabbe.nord@gmail.com>
Date: Sun, 26 May 2024 12:53:11 +0200
Subject: [PATCH 2/2] set mode properly
---
analysis/src/Xform.ml | 8 +++++---
1 file changed, 5 insertions(+), 3 deletions(-)
diff --git a/analysis/src/Xform.ml b/analysis/src/Xform.ml
index 0ac5e89e3..cc0cb63fb 100644
--- a/analysis/src/Xform.ml
+++ b/analysis/src/Xform.ml
@@ -406,11 +406,11 @@ module ExpandCatchAllForVariants = struct
@ constructorNames
| _ -> constructorNames
in
- let getCurrentConstructorNames cases =
+ let getCurrentConstructorNames ?mode cases =
cases
|> List.map (fun (c : Parsetree.case) ->
if Option.is_some c.pc_guard then []
- else findAllConstructorNames ~mode:`option c.pc_lhs)
+ else findAllConstructorNames ?mode c.pc_lhs)
|> List.flatten
in
let currentConstructorNames = getCurrentConstructorNames cases in
@@ -481,7 +481,9 @@ module ExpandCatchAllForVariants = struct
in
match innerType with
| Some ((Tvariant _ | Tpolyvariant _) as variant) ->
- let currentConstructorNames = getCurrentConstructorNames cases in
+ let currentConstructorNames =
+ getCurrentConstructorNames ~mode:`option cases
+ in
let hasNoneCase =
cases
|> List.exists (fun (c : Parsetree.case) ->