basic setup of some sort of structure, and complete tuple patterns

zth · zth · commit 59e555dd0bc2 · 2023-01-05T21:24:43.000+01:00
diff --git a/analysis/src/CompletionBackEnd.ml b/analysis/src/CompletionBackEnd.ml
@@ -1731,6 +1731,17 @@ let getJsxLabels ~componentPath ~findTypeOfValue ~package =
     typ |> getLabels
   | None -> []
 
+let rec resolveNestedPattern typ ~env ~package ~nested =
+  match nested with
+  | [] -> Some (typ, env)
+  | patternPath :: nested -> (
+    match (patternPath, typ |> extractType ~env ~package) with
+    | Completable.PTupleItem {itemNum}, Some (Tuple (env, tupleItems, _)) -> (
+      match List.nth_opt tupleItems itemNum with
+      | None -> None
+      | Some typ -> typ |> resolveNestedPattern ~env ~package ~nested)
+    | _ -> None)
+
 let processCompletable ~debug ~full ~scope ~env ~pos ~forHover
     (completable : Completable.t) =
   let package = full.package in
@@ -2093,3 +2104,32 @@ 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 = None} -> (
+    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
+    | None -> [])
+  | Cpattern {typ; prefix; nested = Some nested} -> (
+    let envWhereCompletionStarted = env in
+    match
+      typ
+      |> getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
+           ~exact:true ~scope
+      |> completionsGetTypeEnv
+    with
+    | Some (typ, env) -> (
+      match typ |> resolveNestedPattern ~env ~package:full.package ~nested with
+      | None -> []
+      | Some (typ, env) ->
+        typ
+        |> completeTypedValue ~env ~envWhereCompletionStarted ~full ~prefix
+             ~expandOption:false)
+    | None -> [])
diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml
@@ -13,6 +13,11 @@ let isExprHole exp =
   | Pexp_extension ({txt = "rescript.exprhole"}, _) -> true
   | _ -> false
 
+let isPatternHole pat =
+  match pat.Parsetree.ppat_desc with
+  | Ppat_extension ({txt = "rescript.patternhole"}, _) -> true
+  | _ -> false
+
 type prop = {
   name: string;
   posStart: int * int;
@@ -403,6 +408,96 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
       !scope |> Scope.addModule ~name:md.pmd_name.txt ~loc:md.pmd_name.loc
   in
 
+  let lookingForPat = ref None in
+
+  let setLookingForPat ctxPath =
+    lookingForPat :=
+      Some (Completable.Cpattern {typ = ctxPath; prefix = ""; nested = None});
+    Printf.printf "looking for: %s \n" (Completable.toString (Cpath ctxPath))
+  in
+  let appendNestedPat patternPat =
+    match !lookingForPat with
+    | Some (Completable.Cpattern ({nested = None} as p)) ->
+      lookingForPat := Some (Cpattern {p with nested = Some [patternPat]})
+    | Some (Completable.Cpattern ({nested = Some nested} as p)) ->
+      lookingForPat :=
+        Some (Cpattern {p with nested = Some (nested @ [patternPat])})
+    | _ -> ()
+  in
+  let commitFoundPat ?prefix () =
+    match !lookingForPat with
+    | Some (Completable.Cpattern p as cpattern) ->
+      let cpattern =
+        match prefix with
+        | None -> cpattern
+        | Some prefix -> Cpattern {p with prefix}
+      in
+      setResult cpattern
+    | _ -> ()
+  in
+
+  let rec typedCompletionExpr (exp : Parsetree.expression) =
+    if
+      exp.pexp_loc
+      |> CursorPosition.classifyLoc ~pos:posBeforeCursor
+      = HasCursor
+    then
+      match exp.pexp_desc with
+      | Pexp_match (_exp, []) ->
+        (* No cases means there's no `|` yet in the switch *) ()
+      | Pexp_match
+          ( exp,
+            [
+              {
+                pc_lhs =
+                  {
+                    ppat_desc =
+                      Ppat_extension ({txt = "rescript.patternhole"}, _);
+                  };
+              };
+            ] ) -> (
+        (* A single case that's a pattern hole typically means `switch x { | }`. Complete as the pattern itself with nothing nested. *)
+        match exprToContextPath exp with
+        | None -> ()
+        | Some ctxPath ->
+          setResult
+            (Completable.Cpattern {typ = ctxPath; nested = None; prefix = ""}))
+      | Pexp_match (exp, _cases) -> (
+        (* If there's more than one case, or the case isn't a pattern hole, set that we're looking for this path currently. *)
+        match exp |> exprToContextPath with
+        | None -> ()
+        | Some ctxPath -> setLookingForPat ctxPath)
+      | _ -> ()
+  in
+
+  let rec typedCompletionPat (pat : Parsetree.pattern) =
+    if
+      pat.ppat_loc
+      |> CursorPosition.classifyLoc ~pos:posBeforeCursor
+      = HasCursor
+    then
+      match pat.ppat_desc with
+      | Ppat_var {txt} -> commitFoundPat ~prefix:txt ()
+      | Ppat_tuple patterns -> (
+        let patCount = ref (-1) in
+        let patCountWithPatHole = ref None in
+        patterns
+        |> List.iteri (fun index p ->
+               match
+                 p.Parsetree.ppat_loc
+                 |> CursorPosition.classifyLoc ~pos:posBeforeCursor
+               with
+               | HasCursor -> patCount := index
+               | EmptyLoc -> patCountWithPatHole := Some index
+               | _ -> ());
+        match (!patCount, !patCountWithPatHole) with
+        | patCount, _ when patCount > -1 ->
+          appendNestedPat (Completable.PTupleItem {itemNum = patCount})
+        | _, Some patHoleCount ->
+          appendNestedPat (Completable.PTupleItem {itemNum = patHoleCount})
+        | _ -> ())
+      | _ -> ()
+  in
   let case (iterator : Ast_iterator.iterator) (case : Parsetree.case) =
     let oldScope = !scope in
     scopePattern case.pc_lhs;
@@ -541,6 +636,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
         setResult (Cpath (CPPipe {contextPath = pipe; id; lhsLoc}));
         true
     in
+    typedCompletionExpr expr;
     match expr.pexp_desc with
     | Pexp_apply
         ( {pexp_desc = Pexp_ident {txt = Lident "|."; loc = opLoc}},
@@ -800,7 +896,10 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
             (Loc.toString lid.loc);
         setResult (Cpath (CPId (lidPath, Value)))
       | _ -> ());
-      Ast_iterator.default_iterator.pat iterator pat)
+      let oldLookingForPat = !lookingForPat in
+      typedCompletionPat pat;
+      Ast_iterator.default_iterator.pat iterator pat;
+      lookingForPat := oldLookingForPat)
   in
   let module_expr (iterator : Ast_iterator.iterator)
       (me : Parsetree.module_expr) =
diff --git a/analysis/src/SharedTypes.ml b/analysis/src/SharedTypes.ml
@@ -550,6 +550,12 @@ module Completable = struct
             (** The loc item for the left hand side of the pipe. *)
       }
 
+  type patternPath = PTupleItem of {itemNum: int}
+
+  let patternPathToString p =
+    match p with
+    | PTupleItem {itemNum} -> "tuple($" ^ string_of_int itemNum ^ ")"
+
   type t =
     | Cdecorator of string  (** e.g. @module *)
     | CnamedArg of contextPath * string * string list
@@ -569,6 +575,11 @@ module Completable = struct
         propName: string;
         prefix: string;
       }
+    | Cpattern of {
+        typ: contextPath;
+        nested: patternPath list option;
+        prefix: string;
+      }
 
   (** An extracted type from a type expr *)
   type extractedType =
@@ -614,6 +625,7 @@ module Completable = struct
       | CPObj (cp, s) -> contextPathToString cp ^ "[\"" ^ s ^ "\"]"
       | CPPipe {contextPath; id} -> contextPathToString contextPath ^ "->" ^ id
     in
+
     function
     | Cpath cp -> "Cpath " ^ contextPathToString cp
     | Cdecorator s -> "Cdecorator(" ^ str s ^ ")"
@@ -637,6 +649,17 @@ module Completable = struct
     | CjsxPropValue {prefix; pathToComponent; propName} ->
       "CjsxPropValue " ^ (pathToComponent |> list) ^ " " ^ propName ^ "="
       ^ prefix
+    | Cpattern {typ; nested; prefix} -> (
+      "Cpattern " ^ contextPathToString typ
+      ^ (if prefix = "" then "" else "=" ^ prefix)
+      ^
+      match nested with
+      | None -> ""
+      | Some patternPaths ->
+        "->"
+        ^ (patternPaths
+          |> List.map (fun patternPath -> patternPathToString patternPath)
+          |> String.concat ", "))
 end
 
 module CursorPosition = struct
diff --git a/analysis/tests/src/CompletionPattern.res b/analysis/tests/src/CompletionPattern.res
@@ -0,0 +1,18 @@
+let v = (true, Some(false))
+
+// switch v {
+//           ^com
+
+// switch v { | }
+//             ^com
+
+// switch v { | (t, _) }
+//                ^com
+
+let x = true
+
+// switch x { |
+//              ^com
+
+// switch x { | t
+//               ^com
diff --git a/analysis/tests/src/expected/Completion.res.txt b/analysis/tests/src/expected/Completion.res.txt
@@ -965,6 +965,7 @@ Resolved opens 2 Completion.res Completion.res
 []
 
 Complete src/Completion.res 243:8
+looking for: Cpath Value[someR] 
 posCursor:[243:8] posNoWhite:[243:7] Found expr:[241:8->246:1]
 posCursor:[243:8] posNoWhite:[243:7] Found expr:[242:14->243:8]
 Pexp_apply ...[243:3->243:4] (...[242:14->242:15], ...[243:5->243:8])
@@ -1442,6 +1443,7 @@ posCursor:[355:23] posNoWhite:[355:22] Found expr:[355:12->355:23]
 
 Complete src/Completion.res 362:8
 posCursor:[362:8] posNoWhite:[362:7] Found expr:[360:8->365:3]
+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]
@@ -1477,6 +1479,7 @@ Resolved opens 2 Completion.res Completion.res
 
 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]
diff --git a/analysis/tests/src/expected/CompletionPattern.res.txt b/analysis/tests/src/expected/CompletionPattern.res.txt
@@ -0,0 +1,48 @@
+Complete src/CompletionPattern.res 2:13
+posCursor:[2:13] posNoWhite:[2:12] Found expr:[2:3->2:13]
+[]
+
+Complete src/CompletionPattern.res 5:15
+XXX Not found!
+Completable: Cpattern Value[v]
+[{
+    "label": "(_, _)",
+    "kind": 12,
+    "tags": [],
+    "detail": "(bool, option<bool>)",
+    "documentation": null,
+    "insertText": "(${1:_}, ${2:_})",
+    "insertTextFormat": 2
+  }]
+
+Complete src/CompletionPattern.res 8:18
+looking for: Cpath Value[v] 
+posCursor:[8:18] posNoWhite:[8:17] Found expr:[8:3->8:24]
+posCursor:[8:18] posNoWhite:[8:17] Found pattern:[8:16->8:22]
+posCursor:[8:18] posNoWhite:[8:17] Found pattern:[8:17->8:18]
+Completable: Cpattern Value[v]=t->tuple($0)
+[{
+    "label": "true",
+    "kind": 4,
+    "tags": [],
+    "detail": "bool",
+    "documentation": null
+  }]
+
+Complete src/CompletionPattern.res 13:16
+posCursor:[13:16] posNoWhite:[13:14] Found expr:[13:3->13:15]
+[]
+
+Complete src/CompletionPattern.res 16:17
+looking for: Cpath Value[x] 
+posCursor:[16:17] posNoWhite:[16:16] Found expr:[16:3->16:17]
+posCursor:[16:17] posNoWhite:[16:16] Found pattern:[16:16->16:17]
+Completable: Cpattern Value[x]=t
+[{
+    "label": "true",
+    "kind": 4,
+    "tags": [],
+    "detail": "bool",
+    "documentation": null
+  }]
+
