complete for functions creating React.element when in a JSX context

zth · zth · commit 81a28cd43b93 · 2023-01-11T18:21:46.000+01:00
diff --git a/analysis/src/CompletionBackEnd.ml b/analysis/src/CompletionBackEnd.ml
@@ -1477,7 +1477,7 @@ let rec getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
                else None)
       | None -> [])
     | None -> [])
-  | CPPipe {contextPath = cp; id = funNamePrefix; lhsLoc} -> (
+  | CPPipe {contextPath = cp; id = funNamePrefix; lhsLoc; inJsx} -> (
     match
       cp
       |> getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
@@ -1584,7 +1584,7 @@ let rec getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
         | None -> None
       in
       match completionPath with
-      | Some completionPath ->
+      | Some completionPath -> (
         let completionPathMinusOpens =
           completionPath
           |> removeRawOpens package.opens
@@ -1599,14 +1599,50 @@ let rec getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
           |> getCompletionsForPath ~completionContext:Value ~exact:false
                ~package ~opens ~allFiles ~pos ~env ~scope
         in
-        completions
-        |> List.map (fun (completion : Completion.t) ->
-               {
-                 completion with
-                 name = completionName completion.name;
-                 env
-                 (* Restore original env for the completion after x->foo()... *);
-               })
+        let completions =
+          completions
+          |> List.map (fun (completion : Completion.t) ->
+                 {
+                   completion with
+                   name = completionName completion.name;
+                   env
+                   (* Restore original env for the completion after x->foo()... *);
+                 })
+        in
+        (* We add React element functions to the completion if we're in a JSX context *)
+        let forJsxCompletion =
+          match (inJsx, getTypePath typ) with
+          | true, Some (Path.Pident id) when Ident.name id = "int" -> Some "int"
+          | true, Some (Path.Pident id) when Ident.name id = "float" ->
+            Some "float"
+          | true, Some (Path.Pident id) when Ident.name id = "string" ->
+            Some "string"
+          | true, Some (Path.Pident id) when Ident.name id = "array" ->
+            (* Make sure the array contains React.element *)
+            let isReactElementArray =
+              match typ |> extractType ~env ~package with
+              | Some (Tarray (_env, payload)) -> (
+                match
+                  payload |> getTypePath |> Option.map pathIdentToString
+                with
+                | Some "React.element" -> true
+                | _ -> false)
+              | _ -> false
+            in
+            if isReactElementArray then Some "array" else None
+          | _ -> None
+        in
+        match forJsxCompletion with
+        | Some builtinNameToComplete
+          when checkName builtinNameToComplete ~prefix:funNamePrefix
+                 ~exact:false ->
+          [
+            Completion.create
+              ~name:("React." ^ builtinNameToComplete)
+              ~kind:(Value typ) ~env;
+          ]
+          @ completions
+        | _ -> completions)
       | None -> [])
     | None -> [])
   | CTuple ctxPaths ->
diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml
@@ -914,6 +914,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
       !scope |> Scope.addModule ~name:md.pmd_name.txt ~loc:md.pmd_name.loc
   in
   let setLookingForPat ctxPath = lookingForPat := Some ctxPath in
+  let inJsxContext = ref false in
 
   let unsetLookingForPat () = lookingForPat := None in
   (* Identifies expressions where we can do typed pattern or expr completion. *)
@@ -1035,6 +1036,14 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
     if not !processed then
       Ast_iterator.default_iterator.structure_item iterator item
   in
+  let value_binding (iterator : Ast_iterator.iterator)
+      (value_binding : Parsetree.value_binding) =
+    if
+      locHasCursor value_binding.pvb_expr.pexp_loc
+      && Utils.isReactComponent value_binding
+    then inJsxContext := true;
+    Ast_iterator.default_iterator.value_binding iterator value_binding
+  in
   let signature (iterator : Ast_iterator.iterator)
       (signature : Parsetree.signature) =
     let oldScope = !scope in
@@ -1125,11 +1134,20 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
         match exprToContextPath lhs with
         | Some pipe ->
           setResult
-            (Cpath (CPPipe {contextPath = pipe; id; lhsLoc = lhs.pexp_loc}));
+            (Cpath
+               (CPPipe
+                  {
+                    contextPath = pipe;
+                    id;
+                    lhsLoc = lhs.pexp_loc;
+                    inJsx = !inJsxContext;
+                  }));
           true
         | None -> false)
       | Some (pipe, lhsLoc) ->
-        setResult (Cpath (CPPipe {contextPath = pipe; id; lhsLoc}));
+        setResult
+          (Cpath
+             (CPPipe {contextPath = pipe; id; lhsLoc; inJsx = !inJsxContext}));
         true
     in
     typedCompletionExpr expr;
@@ -1201,6 +1219,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
             | None -> ())
         | Pexp_apply ({pexp_desc = Pexp_ident compName}, args)
           when Res_parsetree_viewer.isJsxExpression expr ->
+          inJsxContext := true;
           let jsxProps = extractJsxProps ~compName ~args in
           let compNamePath = flattenLidCheckDot ~jsx:true compName in
           if debug then
@@ -1468,6 +1487,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
       structure_item;
       typ;
       type_kind;
+      value_binding;
     }
   in
 
diff --git a/analysis/src/SharedTypes.ml b/analysis/src/SharedTypes.ml
@@ -546,6 +546,7 @@ module Completable = struct
     | CPPipe of {
         contextPath: contextPath;
         id: string;
+        inJsx: bool;  (** Whether this pipe was found in a JSX context. *)
         lhsLoc: Location.t;
             (** The loc item for the left hand side of the pipe. *)
       }
@@ -648,7 +649,10 @@ module Completable = struct
         completionContextToString completionContext ^ list sl
       | CPField (cp, s) -> contextPathToString cp ^ "." ^ str s
       | CPObj (cp, s) -> contextPathToString cp ^ "[\"" ^ s ^ "\"]"
-      | CPPipe {contextPath; id} -> contextPathToString contextPath ^ "->" ^ id
+      | CPPipe {contextPath; id; inJsx} ->
+        contextPathToString contextPath
+        ^ "->" ^ id
+        ^ if inJsx then " <<jsx>>" else ""
       | CTuple ctxPaths ->
         "CTuple("
         ^ (ctxPaths |> List.map contextPathToString |> String.concat ", ")
diff --git a/analysis/src/Utils.ml b/analysis/src/Utils.ml
@@ -168,3 +168,8 @@ let rec unwrapIfOption (t : Types.type_expr) =
   | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> unwrapIfOption t1
   | Tconstr (Path.Pident {name = "option"}, [unwrappedType], _) -> unwrappedType
   | _ -> t
+let isReactComponent (vb : Parsetree.value_binding) =
+  vb.pvb_attributes
+  |> List.exists (function
+       | {Location.txt = "react.component"}, _payload -> true
+       | _ -> false)
diff --git a/analysis/src/Xform.ml b/analysis/src/Xform.ml
@@ -212,13 +212,8 @@ module AddTypeAnnotation = struct
       match si.pstr_desc with
       | Pstr_value (_recFlag, bindings) ->
         let processBinding (vb : Parsetree.value_binding) =
-          let isReactComponent =
-            (* Can't add a type annotation to a react component, or the compiler crashes *)
-            vb.pvb_attributes
-            |> List.exists (function
-                 | {Location.txt = "react.component"}, _payload -> true
-                 | _ -> false)
-          in
+          (* Can't add a type annotation to a react component, or the compiler crashes *)
+          let isReactComponent = Utils.isReactComponent vb in
           if not isReactComponent then processPattern vb.pvb_pat;
           processFunction vb.pvb_expr
         in
diff --git a/analysis/tests/src/CompletionJsx.res b/analysis/tests/src/CompletionJsx.res
@@ -0,0 +1,37 @@
+let someString = "hello"
+ignore(someString)
+
+// someString->st
+//               ^com
+
+module SomeComponent = {
+  @react.component
+  let make = (~someProp) => {
+    let someInt = 12
+    let someArr = [React.null]
+    let someInvalidArr = [12]
+    ignore(someInt)
+    ignore(someArr)
+    ignore(someInvalidArr)
+    // someString->st
+    //               ^com
+    <div>
+      {React.string(someProp)}
+      <div> {React.null} </div>
+      // {someString->st}
+      //                ^com
+      // {"Some string"->st}
+      //                   ^com
+      // {"Some string"->Js.String2.trim->st}
+      //                                    ^com
+      // {someInt->}
+      //           ^com
+      // {12->}
+      //      ^com
+      // {someArr->a}
+      //            ^com
+      // {someInvalidArr->a}
+      //                   ^com
+    </div>
+  }
+}
diff --git a/analysis/tests/src/expected/CompletionJsx.res.txt b/analysis/tests/src/expected/CompletionJsx.res.txt
