Initial pattern completion

CHANGELOG.md

@@ -18,6 +18,7 @@
 - Add autocomplete for JSX prop values. https://github.com/rescript-lang/rescript-vscode/pull/667
 - Add snippet support in completion items. https://github.com/rescript-lang/rescript-vscode/pull/668
 - Add support from completing polyvariants as values. https://github.com/rescript-lang/rescript-vscode/pull/669
+- Add support for completion in patterns. https://github.com/rescript-lang/rescript-vscode/pull/670
 
 #### :nail_care: Polish
 

analysis/src/CompletionBackEnd.ml

@@ -1519,6 +1519,8 @@ let rec extractType ~env ~package (t : Types.type_expr) =
   | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractType ~env ~package t1
   | Tconstr (Path.Pident {name = "option"}, [payloadTypeExpr], _) ->
     Some (Completable.Toption (env, payloadTypeExpr))
+  | Tconstr (Path.Pident {name = "array"}, [payloadTypeExpr], _) ->
+    Some (Tarray (env, payloadTypeExpr))
   | Tconstr (Path.Pident {name = "bool"}, [], _) -> Some (Tbool env)
   | Tconstr (path, _, _) -> (
     match References.digConstructor ~env ~package path with
@@ -1528,6 +1530,8 @@ let rec extractType ~env ~package (t : Types.type_expr) =
       Some
         (Tvariant
            {env; constructors; variantName = name.txt; variantDecl = decl})
+    | Some (env, {item = {kind = Record fields}}) ->
+      Some (Trecord {env; fields; typeExpr = t})
     | _ -> None)
   | Ttuple expressions -> Some (Tuple (env, expressions, t))
   | Tvariant {row_fields} ->
@@ -1566,7 +1570,7 @@ let printConstructorArgs argsLen ~asSnippet =
   else ""
 
 let completeTypedValue ~env ~envWhereCompletionStarted ~full ~prefix
-    ~expandOption =
+    ~expandOption ~includeLocalValues ~completionContext =
   let namesUsed = Hashtbl.create 10 in
   let rec completeTypedValueInner t ~env ~full ~prefix ~expandOption =
     let items =
@@ -1641,10 +1645,36 @@ let completeTypedValue ~env ~envWhereCompletionStarted ~full ~prefix
             ~insertText:(printConstructorArgs numExprs ~asSnippet:true)
             ~kind:(Value typ) ~env ();
         ]
+      | Some (Trecord {env; fields; typeExpr}) -> (
+        (* As we're completing for a record, we'll need a hint (completionContext)
+           here to figure out whether we should complete for a record field, or
+           the record body itself. *)
+        match completionContext with
+        | Some (Completable.RecordField {seenFields}) ->
+          fields
+          |> List.filter (fun (field : field) ->
+                 List.mem field.fname.txt seenFields = false)
+          |> List.map (fun (field : field) ->
+                 Completion.create ~name:field.fname.txt
+                   ~kind:(Field (field, typeExpr |> Shared.typeToString))
+                   ~env)
+          |> filterItems ~prefix
+        | None ->
+          [
+            Completion.createWithSnippet ~name:"{}"
+              ~insertText:(if !Cfg.supportsSnippets then "{$0}" else "{}")
+              ~sortText:"a" ~kind:(Value typeExpr) ~env ();
+          ])
+      | Some (Tarray (env, typeExpr)) ->
+        [
+          Completion.createWithSnippet ~name:"[]"
+            ~insertText:(if !Cfg.supportsSnippets then "[$0]" else "[]")
+            ~sortText:"a" ~kind:(Value typeExpr) ~env ();
+        ]
       | _ -> []
     in
     (* Include all values and modules in completion if there's a prefix, not otherwise *)
-    if prefix = "" then items
+    if prefix = "" || includeLocalValues = false then items
     else
       items
       @ completionForExportedValues ~env:envWhereCompletionStarted ~prefix
@@ -1729,7 +1759,57 @@ let getJsxLabels ~componentPath ~findTypeOfValue ~package =
     typ |> getLabels
   | None -> []
 
-let processCompletable ~debug ~full ~scope ~env ~pos ~forHover
+(** This moves through a pattern via a set of instructions, trying to resolve the type at the end of the pattern. *)
+let rec resolveNestedPattern typ ~env ~package ~nested =
+  match nested with
+  | [] -> Some (typ, env, None)
+  | 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)
+    | PFollowRecordField {fieldName}, Some (Trecord {env; fields}) -> (
+      match
+        fields
+        |> List.find_opt (fun (field : field) -> field.fname.txt = fieldName)
+      with
+      | None -> None
+      | Some {typ} -> typ |> resolveNestedPattern ~env ~package ~nested)
+    | PRecordBody {seenFields}, Some (Trecord {env; typeExpr}) ->
+      Some (typeExpr, env, Some (Completable.RecordField {seenFields}))
+    | ( PVariantPayload {constructorName = "Some"; itemNum = 0},
+        Some (Toption (env, typ)) ) ->
+      typ |> resolveNestedPattern ~env ~package ~nested
+    | ( PVariantPayload {constructorName; itemNum},
+        Some (Tvariant {env; constructors}) ) -> (
+      match
+        constructors
+        |> List.find_opt (fun (c : Constructor.t) ->
+               c.cname.txt = constructorName)
+      with
+      | None -> None
+      | Some constructor -> (
+        match List.nth_opt constructor.args itemNum with
+        | None -> None
+        | Some (typ, _) -> typ |> resolveNestedPattern ~env ~package ~nested))
+    | ( PPolyvariantPayload {constructorName; itemNum},
+        Some (Tpolyvariant {env; constructors}) ) -> (
+      match
+        constructors
+        |> List.find_opt (fun (c : polyVariantConstructor) ->
+               c.name = constructorName)
+      with
+      | None -> None
+      | Some constructor -> (
+        match List.nth_opt constructor.args itemNum with
+        | None -> None
+        | Some typ -> typ |> resolveNestedPattern ~env ~package ~nested))
+    | PArray, Some (Tarray (env, typ)) ->
+      typ |> resolveNestedPattern ~env ~package ~nested
+    | _ -> None)
+
+let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover
     (completable : Completable.t) =
   let package = full.package in
   let rawOpens = Scope.getRawOpens scope in
@@ -1792,7 +1872,7 @@ let processCompletable ~debug ~full ~scope ~env ~pos ~forHover
     | Some (_, typ, env) ->
       typ
       |> completeTypedValue ~env ~envWhereCompletionStarted ~full ~prefix
-           ~expandOption:true)
+           ~expandOption:true ~includeLocalValues:true ~completionContext:None)
   | Cdecorator prefix ->
     let mkDecorator (name, docstring) =
       {(Completion.create ~name ~kind:(Label "") ~env) with docstring}
@@ -2057,11 +2137,11 @@ Note: The `@react.component` decorator requires the react-jsx config to be set i
     | Some (Optional _, typ) ->
       typ
       |> completeTypedValue ~env ~envWhereCompletionStarted ~full ~prefix
-           ~expandOption:true
+           ~expandOption:true ~includeLocalValues:true ~completionContext:None
     | Some ((Unlabelled _ | Labelled _), typ) ->
       typ
       |> completeTypedValue ~env ~envWhereCompletionStarted ~full ~prefix
-           ~expandOption:false)
+           ~expandOption:false ~includeLocalValues:true ~completionContext:None)
   | CnamedArg (cp, prefix, identsSeen) ->
     let labels =
       match
@@ -2091,3 +2171,29 @@ 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; fallback} -> (
+    let fallbackOrEmpty ?items () =
+      match (fallback, items) with
+      | Some fallback, (None | Some []) ->
+        fallback |> processCompletable ~debug ~full ~scope ~env ~pos ~forHover
+      | _, Some items -> items
+      | None, None -> []
+    in
+    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 -> fallbackOrEmpty ()
+      | Some (typ, env, completionContext) ->
+        let items =
+          typ
+          |> completeTypedValue ~env ~envWhereCompletionStarted ~full ~prefix
+               ~expandOption:false ~includeLocalValues:false ~completionContext
+        in
+        fallbackOrEmpty ~items ())
+    | None -> fallbackOrEmpty ())