Make Jsx.component abstract (#8390)

* Make Jsx.component abstract

* Fix shadowing issue

* Clean up

* More recursive binding fixes

* CHANGELOG

* Format

* Simplify

* Fix playground test

* Fix recursive @react.componentWithProps

* Introduce %component_identity

* Fix gentype tests

* Fix LSP hover regression from JSX component coercion

* Improve error message for plain functions used as JSX components

* Another error message improvement

* Improve comment

* Clearer error messages

Author: cknitt

.yarn/patches/@rescript-react-npm-0.14.0-e462ba0c5d.patch

@@ -0,0 +1,13 @@
+diff --git a/src/React.res b/src/React.res
+index 0676012234c8a9cdd93030d732274b5ed3914b11..1ff7a036a06a69e76a680b0396a3f8a67a59c328 100644
+--- a/src/React.res
++++ b/src/React.res
+@@ -13,7 +13,7 @@ type componentLike<'props, 'return> = Jsx.componentLike<'props, 'return>
+ 
+ type component<'props> = Jsx.component<'props>
+ 
+-external component: componentLike<'props, element> => component<'props> = "%identity"
++external component: componentLike<'props, element> => component<'props> = "%component_identity"
+ 
+ @module("react")
+ external createElement: (component<'props>, 'props) => element = "createElement"

CHANGELOG.md

@@ -14,6 +14,8 @@
 
 #### :boom: Breaking Change
 
+- Make Jsx.component abstract. https://github.com/rescript-lang/rescript/pull/8390
+
 #### :eyeglasses: Spec Compliance
 
 #### :rocket: New Feature

compiler/frontend/bs_ast_invariant.ml

@@ -124,10 +124,11 @@ let emit_external_warnings : iterator =
         | ({pval_loc; pval_prim = [byte_name]; pval_type} :
             Parsetree.value_description) -> (
           match byte_name with
-          | "%identity" when not (Ast_core_type.is_arity_one pval_type) ->
+          | ("%identity" | "%component_identity")
+            when not (Ast_core_type.is_arity_one pval_type) ->
             Location.raise_errorf ~loc:pval_loc
-              "%%identity expects a function type of the form 'a => 'b (arity \
-               1)"
+              "%s expects a function type of the form 'a => 'b (arity 1)"
+              byte_name
           | _ ->
             if byte_name <> "" then
               let c = String.unsafe_get byte_name 0 in

compiler/ml/error_message_utils.ml

@@ -107,6 +107,7 @@ type type_clash_context =
       is_constant: string option;
     }
   | FunctionArgument of {optional: bool; name: string option}
+  | JsxComponent
   | BracedIdent
   | Statement of type_clash_statement
   | ForLoopCondition
@@ -127,6 +128,7 @@ let context_to_string = function
   | Some TryReturn -> "TryReturn"
   | Some StringConcat -> "StringConcat"
   | Some (FunctionArgument _) -> "FunctionArgument"
+  | Some JsxComponent -> "JsxComponent"
   | Some ComparisonOperator -> "ComparisonOperator"
   | Some IfReturn -> "IfReturn"
   | Some TernaryReturn -> "TernaryReturn"
@@ -145,6 +147,7 @@ let error_type_text ppf type_clash_context =
     | Some ArrayValue -> "This array item has type:"
     | Some (SetRecordField _) ->
       "You're assigning something to this field that has type:"
+    | Some JsxComponent -> "This JSX tag has type:"
     | _ -> "This has type:"
   in
   fprintf ppf "%s" text
@@ -162,6 +165,7 @@ let error_expected_type_text ppf type_clash_context =
     | None -> ());
 
     fprintf ppf " is expecting:"
+  | Some JsxComponent -> fprintf ppf "But JSX component positions require:"
   | Some ComparisonOperator ->
     fprintf ppf "But it's being compared to something of type:"
   | Some SwitchReturn -> fprintf ppf "But this switch is expected to return:"
@@ -224,6 +228,12 @@ let is_variant_type ~(extract_concrete_typedecl : extract_concrete_typedecl)
     | _ -> false
   with _ -> false
 
+let is_jsx_component_type ~env ty =
+  match Ctype.expand_head env ty with
+  | {desc = Tconstr (Pdot (Pident {name = "Jsx"}, "component", _), _, _)} ->
+    true
+  | _ -> false
+
 let get_variant_constructors
     ~(extract_concrete_typedecl : extract_concrete_typedecl) ~env ty =
   match extract_concrete_typedecl env ty with
@@ -396,6 +406,17 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf
       \  - Remove the @{<info>await@} if this is not expected to be a promise\n\
       \  - Wrap the expression in @{<info>Promise.resolve@} to convert the \
        expression to a promise"
+  | Some JsxComponent, _ ->
+    fprintf ppf
+      "\n\n\
+      \  JSX tags must be React components, not plain functions.\n\n\
+      \  Possible solutions:\n\
+      \  - If this function takes labeled props, annotate it with \
+       @{<info>@react.component@}\n\
+      \  - If this function takes a single props record, annotate it with \
+       @{<info>@react.componentWithProps@}\n\
+      \  - If this is already a valid component-like value, wrap it with \
+       @{<info>React.component(...)@}"
   | Some IfReturn, _ ->
     fprintf ppf
       "\n\n\
@@ -423,6 +444,17 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf
       \  - Use a tuple, if your array is of fixed length. Tuples can mix types \
        freely, and compiles to a JavaScript array. Example of a tuple: `let \
        myTuple = (10, \"hello\", 15.5, true)"
+  | _, Some ({desc = Tarrow _}, expected)
+    when is_jsx_component_type ~env expected ->
+    fprintf ppf
+      "\n\n\
+      \  A React component is expected here, but this expression is a plain \
+       function.\n\n\
+      \  Possible solutions:\n\
+      \  - Extract it to a component annotated with @{<info>@react.component@} \
+       or @{<info>@react.componentWithProps@}\n\
+      \  - If this is already a valid component-like value, wrap it with \
+       @{<info>React.component(...)@}"
   | _, Some (_, {desc = Tconstr (p2, _, _)}) when Path.same Predef.path_dict p2
     ->
     fprintf ppf

compiler/ml/translcore.ml

@@ -236,6 +236,7 @@ let primitives_table =
   create_hashtable
     [|
       ("%identity", Pidentity);
+      ("%component_identity", Pidentity);
       ("%ignore", Pignore);
       ("%revapply", Prevapply);
       ("%apply", Pdirapply);

compiler/ml/typecore.ml

@@ -1808,6 +1808,24 @@ let rec final_subexpression sexp =
 
 (* Generalization criterion for expressions *)
 
+let is_component_identity = function
+  | Texp_ident
+      (_, _, {val_kind = Val_prim {Primitive.prim_name = "%component_identity"}})
+    ->
+    true
+  | _ -> false
+
+let is_identity_coercion = function
+  | Texp_ident
+      ( _,
+        _,
+        {
+          val_kind =
+            Val_prim {Primitive.prim_name = "%identity" | "%component_identity"};
+        } ) ->
+    true
+  | _ -> false
+
 let rec is_nonexpansive exp =
   List.exists
     (function
@@ -1822,6 +1840,26 @@ let rec is_nonexpansive exp =
     List.for_all (fun vb -> is_nonexpansive vb.vb_expr) pat_exp_list
     && is_nonexpansive body
   | Texp_function _ -> true
+  (* `%component_identity` is a typed no-op coercion that lets generated
+     component wrappers keep the same generalization behavior as their
+     underlying function values. This preserves polymorphic props for
+     components such as:
+
+       @react.component
+       let make = (~x) =>
+         switch x {
+         | #a => React.string("A")
+         | #b => React.string("B")
+         | _ => React.string("other")
+         }
+
+     The JSX transform emits a function value and then coerces it through
+     `React.component`, whose implementation is `%component_identity`. Since no
+     runtime computation happens beyond evaluating the argument, the application
+     is non-expansive exactly when all supplied arguments are non-expansive. *)
+  | Texp_apply {funct = {exp_desc}; args; _} when is_component_identity exp_desc
+    ->
+    List.for_all is_nonexpansive_opt (List.map snd args)
   | Texp_apply {partial = true; _} ->
     (* ReScript partial applications (`foo(args, ...)`) lower to wrapper
        functions in codegen, so creating the partial itself is nonexpansive
@@ -2238,12 +2276,6 @@ let is_ignore ~env ~arity funct =
     with Unify _ -> false)
   | _ -> false
 
-let not_identity = function
-  | Texp_ident (_, _, {val_kind = Val_prim {Primitive.prim_name = "%identity"}})
-    ->
-    false
-  | _ -> true
-
 let rec lower_args env seen ty_fun =
   let ty = expand_head env ty_fun in
   if List.memq ty seen then ()
@@ -2494,7 +2526,10 @@ and type_expect_ ?deprecated_context ~context ?in_function ?(recarg = Rejected)
     wrap_trace_gadt_instances env (lower_args env []) ty;
     begin_def ();
     let total_app = not partial in
-    let context = type_clash_context_from_function sexp sfunct in
+    let context =
+      if transformed_jsx then Some JsxComponent
+      else type_clash_context_from_function sexp sfunct
+    in
     let args, ty_res, fully_applied =
       match translate_unified_ops env funct sargs with
       | Some (targs, result_type) -> (targs, result_type, true)
@@ -3828,8 +3863,10 @@ and type_application ~context total_app env funct (sargs : sargs) :
           (* This is a total application when the toplevel type is a polymorphic variable,
           so the function type including arity can be inferred. *)
           let t1 = newvar () and t2 = newvar () in
-          if ty_fun.level >= t1.level && not_identity funct.exp_desc then
-            Location.prerr_warning sarg1.pexp_loc Warnings.Unused_argument;
+          if
+            ty_fun.level >= t1.level
+            && not (is_identity_coercion funct.exp_desc)
+          then Location.prerr_warning sarg1.pexp_loc Warnings.Unused_argument;
           unify env ty_fun
             (newty
                (Tarrow
@@ -3892,15 +3929,19 @@ and type_application ~context total_app env funct (sargs : sargs) :
           if (not optional) && is_optional l' then
             Location.prerr_warning sarg0.pexp_loc
               (Warnings.Nonoptional_label (Printtyp.string_of_label l));
+          let argument_context =
+            match (context, args) with
+            | Some JsxComponent, [] -> Some JsxComponent
+            | Some JsxComponent, _ ->
+              type_clash_context_for_function_argument ~label:l' None sarg0
+            | _ ->
+              type_clash_context_for_function_argument ~label:l' context sarg0
+          in
           ( sargs,
             omitted,
             Some
               (if (not optional) || is_optional l' then fun () ->
-                 type_argument
-                   ~context:
-                     (type_clash_context_for_function_argument ~label:l' context
-                        sarg0)
-                   env sarg0 ty ty0
+                 type_argument ~context:argument_context env sarg0 ty ty0
                else fun () ->
                  option_some
                    (type_argument