Preserve JSX (#7387)

* Add additional node to Pexp_apply

* Try and pass jsx_element from typed_tree to js_call

* Follow Lprim

* Transform initial simple element

* Initial fragment support

* WIP extract, good stuff

* Print props, catch with key functions

* Don't pass untyped ast, simple flag is sufficient.

* Support fragments

* Unwrap children

* Poor man feature flag

* Remove duplicated in

* Older camls

* Revert "Poor man feature flag"

This reverts commit 547dfca.

* Add new  -bs-jsx-preserve flag

* WIP, deal with prop spreading

* Deal with prop spreading

* Clean up Lprim and move the information to the call primitive.

* Add test for spreading children

* Refactor duplicate code

* Support keyed and prop spreading

* Rename test file

* Keep key prop before spreading props. Also ensure test can run.

* Add only spread props case

* Give record a name

* Use config flag in Js_dump instead

* Remove helper code

* Extra call info

* Detect direct Array as well

* Don't run with mocha

* Feedback code review

---------

Co-authored-by: Cristiano Calcagno <[email protected]>

Author: nojaf

analysis/src/CompletionFrontEnd.ml

@@ -267,33 +267,35 @@ let rec exprToContextPathInner ~(inJsxContext : bool) (e : Parsetree.expression)
           };
         args =
           [(_, lhs); (_, {pexp_desc = Pexp_apply {funct = d; args; partial}})];
+        transformed_jsx;
       } ->
     (* Transform away pipe with apply call *)
     exprToContextPath ~inJsxContext
       {
         pexp_desc =
-          Pexp_apply {funct = d; args = (Nolabel, lhs) :: args; partial};
+          Pexp_apply
+            {funct = d; args = (Nolabel, lhs) :: args; partial; transformed_jsx};
         pexp_loc;
         pexp_attributes;
       }
   | Pexp_apply
-      {
-        funct = {pexp_desc = Pexp_ident {txt = Lident "->"}};
-        args =
-          [
-            (_, lhs); (_, {pexp_desc = Pexp_ident id; pexp_loc; pexp_attributes});
-          ];
-        partial;
-      } ->
+      ({
+         funct = {pexp_desc = Pexp_ident {txt = Lident "->"}};
+         args =
+           [
+             (_, lhs);
+             (_, {pexp_desc = Pexp_ident id; pexp_loc; pexp_attributes});
+           ];
+       } as app) ->
     (* Transform away pipe with identifier *)
     exprToContextPath ~inJsxContext
       {
         pexp_desc =
           Pexp_apply
             {
+              app with
               funct = {pexp_desc = Pexp_ident id; pexp_loc; pexp_attributes};
               args = [(Nolabel, lhs)];
-              partial;
             };
         pexp_loc;
         pexp_attributes;

compiler/bsc/rescript_compiler_main.ml

@@ -255,6 +255,7 @@ let buckle_script_flags : (string * Bsc_args.spec * string) array =
     ( "-bs-jsx-mode",
       string_call ignore,
       "*internal* Set jsx mode, this is no longer used and is a no-op." );
+    ("-bs-jsx-preserve", set Js_config.jsx_preserve, "*internal* Preserve jsx");
     ( "-bs-package-output",
       string_call Js_packages_state.update_npm_package_path,
       "*internal* Set npm-output-path: [opt_module]:path, for example: \

compiler/common/js_config.ml

@@ -50,6 +50,7 @@ let force_cmi = ref false
 let force_cmj = ref false
 let jsx_version = ref None
 let jsx_module = ref React
+let jsx_preserve = ref false
 let js_stdout = ref true
 let all_module_aliases = ref false
 let no_stdlib = ref false

compiler/common/js_config.mli

@@ -80,6 +80,8 @@ val jsx_version : jsx_version option ref
 
 val jsx_module : jsx_module ref
 
+val jsx_preserve : bool ref
+
 val js_stdout : bool ref
 
 val all_module_aliases : bool ref

compiler/core/js_call_info.ml

@@ -33,10 +33,15 @@ type call_info =
    {[ fun x y -> (f x y) === f ]} when [f] is an atom
 *)
 
-type t = {call_info: call_info; arity: arity}
+type t = {call_info: call_info; arity: arity; call_transformed_jsx: bool}
 
-let dummy = {arity = NA; call_info = Call_na}
+let dummy = {arity = NA; call_info = Call_na; call_transformed_jsx = false}
 
-let builtin_runtime_call = {arity = Full; call_info = Call_builtin_runtime}
+let builtin_runtime_call =
+  {arity = Full; call_info = Call_builtin_runtime; call_transformed_jsx = false}
 
-let ml_full_call = {arity = Full; call_info = Call_ml}
+let ml_full_call =
+  {arity = Full; call_info = Call_ml; call_transformed_jsx = false}
+
+let na_full_call transformed_jsx =
+  {arity = Full; call_info = Call_na; call_transformed_jsx = transformed_jsx}

compiler/core/js_call_info.mli

@@ -35,10 +35,12 @@ type call_info =
    {[ fun x y -> f x y === f ]} when [f] is an atom
 *)
 
-type t = {call_info: call_info; arity: arity}
+type t = {call_info: call_info; arity: arity; call_transformed_jsx: bool}
 
 val dummy : t
 
 val builtin_runtime_call : t
 
 val ml_full_call : t
+
+val na_full_call : bool -> t

compiler/core/js_dump.ml

@@ -515,7 +515,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
     (* TODO: dump for comments *)
     pp_function ?directive ~is_method ~return_unit ~async
       ~fn_state:default_fn_exp_state cxt f params body env
-    (* TODO:
+  (* TODO:
        when [e] is [Js_raw_code] with arity
        print it in a more precise way
        It seems the optimizer already did work to make sure
@@ -524,6 +524,116 @@ and expression_desc cxt ~(level : int) f x : cxt =
          when Ext_list.length_equal el i
        ]}
     *)
+  (* When -bs-preserve-jsx is enabled, we marked each transformed application node throughout the compilation.
+     Here we print the transformed application node into a JSX syntax.
+     The JSX is slightly different from what a user would write,
+     but it is still valid JSX and is usable by tools like ESBuild.
+  *)
+  | Call
+      ( ({
+           expression_desc =
+             J.Var
+               (J.Qualified
+                  ( _,
+                    Some fnName
+                    (* We care about the function name when it is jsxs,
+                       If this is the case, we need to unpack an array later on *)
+                  ));
+         } as e),
+        el,
+        {call_transformed_jsx = true} )
+    when !Js_config.jsx_preserve -> (
+    (* We match a JsxRuntime.jsx call *)
+    match el with
+    | [
+     tag;
+     {
+       expression_desc =
+         (* This is the props javascript object *)
+         Caml_block (el, _mutable_flag, _, Lambda.Blk_record {fields});
+     };
+    ] ->
+      (* We extract the props from the javascript object *)
+      let fields =
+        Ext_list.array_list_filter_map fields el (fun (f, opt) x ->
+            match x.expression_desc with
+            | Undefined _ when opt -> None
+            | _ -> Some (f, x))
+      in
+      print_jsx cxt ~level f fnName tag fields
+    | [
+     tag;
+     {
+       expression_desc =
+         Caml_block (el, _mutable_flag, _, Lambda.Blk_record {fields});
+     };
+     key;
+    ] ->
+      (* When a component has a key the matching runtime function call will have a third argument being the key *)
+      let fields =
+        Ext_list.array_list_filter_map fields el (fun (f, opt) x ->
+            match x.expression_desc with
+            | Undefined _ when opt -> None
+            | _ -> Some (f, x))
+      in
+      print_jsx cxt ~level ~key f fnName tag fields
+    | [tag; ({expression_desc = J.Seq _} as props)] ->
+      (* In the case of prop spreading, the expression will look like:
+           (props.a = "Hello, world!", props)
+           which is equivalent to
+           <tag {...props} a="Hello, world!" />
+
+           We need to extract the props and the spread object.
+         *)
+      let fields, spread_props =
+        let rec visit acc e =
+          match e.J.expression_desc with
+          | J.Seq
+              ( {
+                  J.expression_desc =
+                    J.Bin
+                      ( Js_op.Eq,
+                        {J.expression_desc = J.Static_index (_, name, _)},
+                        value );
+                },
+                rest ) ->
+            visit ((name, value) :: acc) rest
+          | _ -> (List.rev acc, e)
+        in
+        visit [] props
+      in
+      print_jsx cxt ~level ~spread_props f fnName tag fields
+    | [tag; ({expression_desc = J.Seq _} as props); key] ->
+      (* In the case of props + prop spreading and key argument *)
+      let fields, spread_props =
+        let rec visit acc e =
+          match e.J.expression_desc with
+          | J.Seq
+              ( {
+                  J.expression_desc =
+                    J.Bin
+                      ( Js_op.Eq,
+                        {J.expression_desc = J.Static_index (_, name, _)},
+                        value );
+                },
+                rest ) ->
+            visit ((name, value) :: acc) rest
+          | _ -> (List.rev acc, e)
+        in
+        visit [] props
+      in
+      print_jsx cxt ~level ~spread_props ~key f fnName tag fields
+    | [tag; ({expression_desc = J.Var _} as spread_props)] ->
+      (* All the props are spread *)
+      print_jsx cxt ~level ~spread_props f fnName tag []
+    | _ ->
+      (* This should not happen, we fallback to the general case *)
+      expression_desc cxt ~level f
+        (Call
+           ( e,
+             el,
+             {call_transformed_jsx = false; arity = Full; call_info = Call_ml}
+           )))
   | Call (e, el, info) ->
     P.cond_paren_group f (level > 15) (fun _ ->
         P.group f 0 (fun _ ->
@@ -960,6 +1070,103 @@ and expression_desc cxt ~(level : int) f x : cxt =
         P.string f "...";
         expression ~level:13 cxt f e)
 
+and print_jsx cxt ?(spread_props : J.expression option)
+    ?(key : J.expression option) ~(level : int) f (fnName : string)
+    (tag : J.expression) (fields : (string * J.expression) list) : cxt =
+  let print_tag cxt =
+    match tag.expression_desc with
+    (* "div" or any other primitive tag *)
+    | J.Str {txt} ->
+      P.string f txt;
+      cxt
+    (* fragment *)
+    | J.Var (J.Qualified ({id = {name = "JsxRuntime"}}, Some "Fragment")) -> cxt
+    (* A user defined component or external component *)
+    | _ -> expression ~level cxt f tag
+  in
+  let children_opt =
+    List.find_map
+      (fun (n, e) ->
+        if n = "children" then
+          if fnName = "jsxs" then
+            match e.J.expression_desc with
+            | J.Array (xs, _)
+            | J.Optional_block ({expression_desc = J.Array (xs, _)}, _) ->
+              Some xs
+            | _ -> Some [e]
+          else Some [e]
+        else None)
+      fields
+  in
+  let print_props cxt =
+    (* If a key is present, should be printed before the spread props,
+    This is to ensure tools like ESBuild use the automatic JSX runtime *)
+    let cxt =
+      match key with
+      | None -> cxt
+      | Some key ->
+        P.string f " key={";
+        let cxt = expression ~level:0 cxt f key in
+        P.string f "} ";
+        cxt
+    in
+    let props = List.filter (fun (n, _) -> n <> "children") fields in
+    let cxt =
+      match spread_props with
+      | None -> cxt
+      | Some spread ->
+        P.string f " {...";
+        let cxt = expression ~level:0 cxt f spread in
+        P.string f "} ";
+        cxt
+    in
+    if List.length props = 0 then cxt
+    else
+      (List.fold_left (fun acc (n, x) ->
+           P.space f;
+           P.string f n;
+           P.string f "=";
+           P.string f "{";
+           let next = expression ~level:0 acc f x in
+           P.string f "}";
+           next))
+        cxt props
+  in
+  match children_opt with
+  | None ->
+    P.string f "<";
+    let cxt = cxt |> print_tag |> print_props in
+    P.string f "/>";
+    cxt
+  | Some children ->
+    let child_is_jsx child =
+      match child.J.expression_desc with
+      | J.Call (_, _, {call_transformed_jsx = is_jsx}) -> is_jsx
+      | _ -> false
+    in
+
+    P.string f "<";
+    let cxt = cxt |> print_tag |> print_props in
+
+    P.string f ">";
+    if List.length children > 0 then P.newline f;
+
+    let cxt =
+      List.fold_left
+        (fun acc e ->
+          if not (child_is_jsx e) then P.string f "{";
+          let next = expression ~level acc f e in
+          if not (child_is_jsx e) then P.string f "}";
+          P.newline f;
+          next)
+        cxt children
+    in
+
+    P.string f "</";
+    let cxt = print_tag cxt in
+    P.string f ">";
+    cxt
+
 and property_name_and_value_list cxt f (l : J.property_map) =
   iter_lst cxt f l
     (fun cxt f (pn, e) ->