add way to use fallbacks when completing patterns, restoring old behavior that was broken by pattern completion

Author: zth

analysis/src/CompletionBackEnd.ml

@@ -1811,7 +1811,7 @@ let rec resolveNestedPattern typ ~env ~package ~nested =
       typ |> resolveNestedPattern ~env ~package ~nested
     | _ -> None)
 
-let processCompletable ~debug ~full ~scope ~env ~pos ~forHover
+let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover
     (completable : Completable.t) =
   let package = full.package in
   let rawOpens = Scope.getRawOpens scope in
@@ -2173,20 +2173,27 @@ Note: The `@react.component` decorator requires the react-jsx config to be set i
            Utils.startsWith name prefix
            && (forHover || not (List.mem name identsSeen)))
     |> List.map mkLabel
-  | Cpattern {typ; prefix; nested = []} -> (
+  | Cpattern {typ; prefix; nested = []; fallback} -> (
     let envWhereCompletionStarted = env in
     match
       typ
       |> getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
            ~exact:true ~scope
       |> completionsGetTypeEnv
     with
-    | Some (typ, env) ->
-      typ
-      |> completeTypedValue ~env ~envWhereCompletionStarted ~full ~prefix
-           ~expandOption:false ~includeLocalValues:false ~completionContext:None
+    | Some (typ, env) -> (
+      let items =
+        typ
+        |> completeTypedValue ~env ~envWhereCompletionStarted ~full ~prefix
+             ~expandOption:false ~includeLocalValues:false
+             ~completionContext:None
+      in
+      match (items, fallback) with
+      | [], Some fallback ->
+        fallback |> processCompletable ~debug ~full ~scope ~env ~pos ~forHover
+      | items, _ -> items)
     | None -> [])
-  | Cpattern {typ; prefix; nested} -> (
+  | Cpattern {typ; prefix; nested; fallback} -> (
     let envWhereCompletionStarted = env in
     match
       typ
@@ -2197,8 +2204,14 @@ Note: The `@react.component` decorator requires the react-jsx config to be set i
     | Some (typ, env) -> (
       match typ |> resolveNestedPattern ~env ~package:full.package ~nested with
       | None -> []
-      | Some (typ, env, completionContext) ->
-        typ
-        |> completeTypedValue ~env ~envWhereCompletionStarted ~full ~prefix
-             ~expandOption:false ~includeLocalValues:false ~completionContext)
+      | Some (typ, env, completionContext) -> (
+        let items =
+          typ
+          |> completeTypedValue ~env ~envWhereCompletionStarted ~full ~prefix
+               ~expandOption:false ~includeLocalValues:false ~completionContext
+        in
+        match (items, fallback) with
+        | [], Some fallback ->
+          fallback |> processCompletable ~debug ~full ~scope ~env ~pos ~forHover
+        | items, _ -> items))
     | None -> [])

analysis/src/CompletionFrontEnd.ml

@@ -617,7 +617,12 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
     | Some (prefix, nestedPattern), Some ctxPath ->
       setResult
         (Completable.Cpattern
-           {typ = ctxPath; prefix; nested = List.rev nestedPattern})
+           {
+             typ = ctxPath;
+             prefix;
+             nested = List.rev nestedPattern;
+             fallback = None;
+           })
     | _ -> ()
   in
   let scopeValueBinding (vb : Parsetree.value_binding) =
@@ -684,7 +689,8 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
         | None -> ()
         | Some ctxPath ->
           setResult
-            (Completable.Cpattern {typ = ctxPath; nested = []; prefix = ""}))
+            (Completable.Cpattern
+               {typ = ctxPath; nested = []; prefix = ""; fallback = None}))
       | Pexp_match (exp, cases) -> (
         (* If there's more than one case, or the case isn't a pattern hole, figure out if we're completing another
            broken parser case (`switch x { | true => () | <com> }` for example). *)
@@ -710,7 +716,8 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
           | true, false ->
             (* If there's no case with the cursor, but a broken parser case, complete for the top level. *)
             setResult
-              (Completable.Cpattern {typ = ctxPath; nested = []; prefix = ""})
+              (Completable.Cpattern
+                 {typ = ctxPath; nested = []; prefix = ""; fallback = None})
           | false, false -> ()))
       | _ -> unsetLookingForPat ()
   in
@@ -1114,19 +1121,18 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
         Printf.printf "posCursor:[%s] posNoWhite:[%s] Found pattern:%s\n"
           (Pos.toString posCursor) (Pos.toString posNoWhite)
           (Loc.toString pat.ppat_loc);
-      (* TODO:
-          This change breaks old behavior of completing constructors in scope.
-          Either be fine with it, fix it somehow, or incorporate completing
-          constructors in scope when regular completion for variants can't
-          be done. *)
-      (match (!lookingForPat, pat.ppat_desc) with
-      | None, Ppat_construct (lid, _) ->
+      (match pat.ppat_desc with
+      | Ppat_construct (lid, _) -> (
         let lidPath = flattenLidCheckDot lid in
         if debug then
           Printf.printf "Ppat_construct %s:%s\n"
             (lidPath |> String.concat ".")
             (Loc.toString lid.loc);
-        setResult (Cpath (CPId (lidPath, Value)))
+        let completion = Completable.Cpath (CPId (lidPath, Value)) in
+        match !result with
+        | Some (Completable.Cpattern p, scope) ->
+          result := Some (Cpattern {p with fallback = Some completion}, scope)
+        | _ -> setResult completion)
       | _ -> ());
       Ast_iterator.default_iterator.pat iterator pat)
   in

analysis/src/SharedTypes.ml

@@ -592,7 +592,12 @@ module Completable = struct
         propName: string;
         prefix: string;
       }
-    | Cpattern of {typ: contextPath; nested: patternPath list; prefix: string}
+    | Cpattern of {
+        typ: contextPath;
+        nested: patternPath list;
+        prefix: string;
+        fallback: t option;
+      }
 
   (** An extracted type from a type expr *)
   type extractedType =

analysis/tests/src/expected/Completion.res.txt

@@ -1446,18 +1446,55 @@ looking for: Cpath Value[x]
 posCursor:[362:8] posNoWhite:[362:7] Found expr:[361:2->365:3]
 posCursor:[362:8] posNoWhite:[362:7] Found pattern:[362:7->364:5]
 posCursor:[362:8] posNoWhite:[362:7] Found pattern:[362:7->362:8]
+Ppat_construct T:[362:7->362:8]
 Completable: Cpattern Value[x]=T
 Raw opens: 2 Shadow.B.place holder ... Shadow.A.place holder
 Resolved opens 2 Completion.res Completion.res
-[]
+Raw opens: 2 Shadow.B.place holder ... Shadow.A.place holder
+Resolved opens 2 Completion.res Completion.res
+[{
+    "label": "That",
+    "kind": 4,
+    "tags": [],
+    "detail": "That\n\ntype v = This | That",
+    "documentation": null
+  }, {
+    "label": "This",
+    "kind": 4,
+    "tags": [],
+    "detail": "This\n\ntype v = This | That",
+    "documentation": null
+  }, {
+    "label": "TableclothMap",
+    "kind": 9,
+    "tags": [],
+    "detail": "file module",
+    "documentation": null
+  }, {
+    "label": "TypeDefinition",
+    "kind": 9,
+    "tags": [],
+    "detail": "file module",
+    "documentation": null
+  }]
 
 Complete src/Completion.res 373:21
 posCursor:[373:21] posNoWhite:[373:20] Found expr:[371:8->376:3]
 looking for: Cpath Value[x] 
 posCursor:[373:21] posNoWhite:[373:20] Found expr:[372:2->376:3]
 posCursor:[373:21] posNoWhite:[373:20] Found pattern:[373:7->375:5]
 posCursor:[373:21] posNoWhite:[373:20] Found pattern:[373:7->373:21]
-[]
+Ppat_construct AndThatOther.T:[373:7->373:21]
+Completable: Cpath Value[AndThatOther, T]
+Raw opens: 2 Shadow.B.place holder ... Shadow.A.place holder
+Resolved opens 2 Completion.res Completion.res
+[{
+    "label": "ThatOther",
+    "kind": 4,
+    "tags": [],
+    "detail": "ThatOther\n\ntype v = And | ThatOther",
+    "documentation": null
+  }]
 
 Complete src/Completion.res 378:24
 posCursor:[378:24] posNoWhite:[378:23] Found expr:[378:12->378:26]

analysis/tests/src/expected/CompletionPattern.res.txt

@@ -261,7 +261,9 @@ Complete src/CompletionPattern.res 87:20
 looking for: Cpath Value[z] 
 posCursor:[87:20] posNoWhite:[87:19] Found expr:[87:3->87:22]
 posCursor:[87:20] posNoWhite:[87:19] Found pattern:[87:16->87:21]
+Ppat_construct Two:[87:16->87:19]
 posCursor:[87:20] posNoWhite:[87:19] Found pattern:[87:19->87:21]
+Ppat_construct ():[87:19->87:21]
 Completable: Cpattern Value[z]->variantPayload::Two($0)
 [{
     "label": "true",
@@ -281,6 +283,7 @@ Complete src/CompletionPattern.res 90:21
 looking for: Cpath Value[z] 
 posCursor:[90:21] posNoWhite:[90:20] Found expr:[90:3->90:23]
 posCursor:[90:21] posNoWhite:[90:20] Found pattern:[90:16->90:22]
+Ppat_construct Two:[90:16->90:19]
 posCursor:[90:21] posNoWhite:[90:20] Found pattern:[90:20->90:21]
 Completable: Cpattern Value[z]=t->variantPayload::Two($0)
 [{
@@ -295,6 +298,7 @@ Complete src/CompletionPattern.res 93:23
 looking for: Cpath Value[z] 
 posCursor:[93:23] posNoWhite:[93:22] Found expr:[93:3->93:26]
 posCursor:[93:23] posNoWhite:[93:22] Found pattern:[93:16->93:25]
+Ppat_construct Three:[93:16->93:21]
 posCursor:[93:23] posNoWhite:[93:22] Found pattern:[93:22->93:24]
 Completable: Cpattern Value[z]->variantPayload::Three($0), recordBody
 [{
@@ -327,6 +331,7 @@ Complete src/CompletionPattern.res 96:27
 looking for: Cpath Value[z] 
 posCursor:[96:27] posNoWhite:[96:26] Found expr:[96:3->96:29]
 posCursor:[96:27] posNoWhite:[96:26] Found pattern:[96:16->96:28]
+Ppat_construct Three:[96:16->96:21]
 posCursor:[96:27] posNoWhite:[96:26] Found pattern:[96:21->96:29]
 posCursor:[96:27] posNoWhite:[96:26] Found pattern:[96:26->96:27]
 Completable: Cpattern Value[z]=t->variantPayload::Three($1)
@@ -343,6 +348,7 @@ looking for: Cpath Value[b]
 posCursor:[103:21] posNoWhite:[103:20] Found expr:[103:3->103:23]
 posCursor:[103:21] posNoWhite:[103:20] Found pattern:[103:16->103:22]
 posCursor:[103:21] posNoWhite:[103:20] Found pattern:[103:20->103:21]
+Ppat_construct ():[103:20->103:21]
 Completable: Cpattern Value[b]->polyvariantPayload::two($0)
 [{
     "label": "true",
@@ -456,7 +462,9 @@ Complete src/CompletionPattern.res 127:21
 looking for: Cpath Value[o] 
 posCursor:[127:21] posNoWhite:[127:20] Found expr:[127:3->127:24]
 posCursor:[127:21] posNoWhite:[127:20] Found pattern:[127:16->127:22]
+Ppat_construct Some:[127:16->127:20]
 posCursor:[127:21] posNoWhite:[127:20] Found pattern:[127:20->127:22]
+Ppat_construct ():[127:20->127:22]
 Completable: Cpattern Value[o]->variantPayload::Some($0)
 [{
     "label": "true",
@@ -476,6 +484,7 @@ Complete src/CompletionPattern.res 134:23
 looking for: Cpath Value[p] 
 posCursor:[134:23] posNoWhite:[134:22] Found expr:[134:3->134:26]
 posCursor:[134:23] posNoWhite:[134:22] Found pattern:[134:16->134:25]
+Ppat_construct Test:[134:16->134:20]
 Completable: Cpattern Value[p]->variantPayload::Test($1)
 [{
     "label": "true",
@@ -495,6 +504,7 @@ Complete src/CompletionPattern.res 137:29
 looking for: Cpath Value[p] 
 posCursor:[137:29] posNoWhite:[137:28] Found expr:[137:3->137:32]
 posCursor:[137:29] posNoWhite:[137:28] Found pattern:[137:16->137:31]
+Ppat_construct Test:[137:16->137:20]
 posCursor:[137:29] posNoWhite:[137:28] Found pattern:[137:20->137:32]
 Completable: Cpattern Value[p]->variantPayload::Test($2)
 [{
@@ -517,6 +527,7 @@ Complete src/CompletionPattern.res 140:23
 looking for: Cpath Value[p] 
 posCursor:[140:23] posNoWhite:[140:22] Found expr:[140:3->140:32]
 posCursor:[140:23] posNoWhite:[140:22] Found pattern:[140:16->140:31]
+Ppat_construct Test:[140:16->140:20]
 posCursor:[140:23] posNoWhite:[140:22] Found pattern:[140:20->140:32]
 Completable: Cpattern Value[p]->variantPayload::Test($1)
 [{
@@ -537,6 +548,7 @@ Complete src/CompletionPattern.res 143:35
 looking for: Cpath Value[p] 
 posCursor:[143:35] posNoWhite:[143:34] Found expr:[143:3->143:38]
 posCursor:[143:35] posNoWhite:[143:34] Found pattern:[143:16->143:37]
+Ppat_construct Test:[143:16->143:20]
 posCursor:[143:35] posNoWhite:[143:34] Found pattern:[143:20->143:38]
 Completable: Cpattern Value[p]->variantPayload::Test($3)
 [{
@@ -632,6 +644,7 @@ Complete src/CompletionPattern.res 164:17
 looking for: Cpath Value[s] 
 posCursor:[164:17] posNoWhite:[164:16] Found expr:[164:3->164:20]
 posCursor:[164:17] posNoWhite:[164:16] Found pattern:[164:16->164:18]
+Ppat_construct ():[164:16->164:18]
 Completable: Cpattern Value[s]->tuple($0)
 [{
     "label": "true",
@@ -757,6 +770,7 @@ looking for: Cpath Value[z]
 posCursor:[182:32] posNoWhite:[182:31] Found expr:[182:3->182:37]
 posCursor:[182:32] posNoWhite:[182:31] Found pattern:[182:16->182:34]
 posCursor:[182:32] posNoWhite:[182:31] Found pattern:[182:22->182:34]
+Ppat_construct Two:[182:22->182:25]
 Completable: Cpattern Value[z]->variantPayload::Two($0)
 [{
     "label": "true",
@@ -777,6 +791,7 @@ looking for: Cpath Value[z]
 posCursor:[185:48] posNoWhite:[185:47] Found expr:[185:3->185:53]
 posCursor:[185:48] posNoWhite:[185:47] Found pattern:[185:16->185:50]
 posCursor:[185:48] posNoWhite:[185:47] Found pattern:[185:22->185:50]
+Ppat_construct Three:[185:22->185:27]
 posCursor:[185:48] posNoWhite:[185:47] Found pattern:[185:27->185:53]
 Completable: Cpattern Value[z]->variantPayload::Three($1)
 [{