Intial exploration of JSX ast

Map child expressions

Initial mapping of Pexp_jsx_fragment to 0

Correct location in mapping

Update analysis for jsx_fragment

Remove unused code

Print something for ml print

Commit invalid test results for reference

Try improve printing

Correct fragment range, try and print comments

Indent jsx

Process comments from children inside fragment

Attach comments to fragment tags

Fix comment

Improve comment formatting

Print single element on same line

Update comment

WIP: Debug

More debugging

Works

Fix some jsx printing

Fix the test

Clean up

Update tests with location changes

Author: nojaf

analysis/src/CompletionFrontEnd.ml

@@ -1232,7 +1232,8 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
                          then ValueOrField
                          else Value);
                     }))
-        | Pexp_construct ({txt = Lident ("::" | "()")}, _) ->
+        | Pexp_construct ({txt = Lident ("::" | "()")}, _) | Pexp_jsx_fragment _
+          ->
           (* Ignore list expressions, used in JSX, unit, and more *) ()
         | Pexp_construct (lid, eOpt) -> (
           let lidPath = flattenLidCheckDot lid in

analysis/src/Utils.ml

@@ -111,6 +111,7 @@ let identifyPexp pexp =
   | Pexp_pack _ -> "Pexp_pack"
   | Pexp_extension _ -> "Pexp_extension"
   | Pexp_open _ -> "Pexp_open"
+  | Pexp_jsx_fragment _ -> "Pexp_jsx_fragment"
 
 let identifyPpat pat =
   match pat with
@@ -154,6 +155,10 @@ let isJsxComponent (vb : Parsetree.value_binding) =
   |> List.exists (function
        | {Location.txt = "react.component" | "jsx.component"}, _payload -> true
        | _ -> false)
+  ||
+  match vb.pvb_expr.pexp_desc with
+  | Parsetree.Pexp_jsx_fragment _ -> true
+  | _ -> false
 
 let checkName name ~prefix ~exact =
   if exact then name = prefix else startsWith name prefix

compiler/frontend/bs_ast_mapper.ml

@@ -366,6 +366,8 @@ module E = struct
     | Pexp_open (ovf, lid, e) ->
       open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e)
     | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x)
+    | Pexp_jsx_fragment (o, xs, c) ->
+      jsx_fragment o (List.map (sub.expr sub) xs) c
 end
 
 module P = struct

compiler/ml/ast_helper.ml

@@ -180,8 +180,35 @@ module Exp = struct
   let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a)
   let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c))
   let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a)
+  let jsx_fragment ?loc ?attrs a b c =
+    mk ?loc ?attrs (Pexp_jsx_fragment (a, b, c))
 
   let case lhs ?guard rhs = {pc_lhs = lhs; pc_guard = guard; pc_rhs = rhs}
+
+  let make_list_expression loc seq ext_opt =
+    let rec handle_seq = function
+      | [] -> (
+        match ext_opt with
+        | Some ext -> ext
+        | None ->
+          let loc = {loc with Location.loc_ghost = true} in
+          let nil = Location.mkloc (Longident.Lident "[]") loc in
+          construct ~loc nil None)
+      | e1 :: el ->
+        let exp_el = handle_seq el in
+        let loc =
+          Location.
+            {
+              loc_start = e1.Parsetree.pexp_loc.Location.loc_start;
+              loc_end = exp_el.pexp_loc.loc_end;
+              loc_ghost = false;
+            }
+        in
+        let arg = tuple ~loc [e1; exp_el] in
+        construct ~loc (Location.mkloc (Longident.Lident "::") loc) (Some arg)
+    in
+    let expr = handle_seq seq in
+    {expr with pexp_loc = loc}
 end
 
 module Mty = struct

compiler/ml/ast_helper.mli

@@ -208,8 +208,18 @@ module Exp : sig
   val open_ :
     ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression -> expression
   val extension : ?loc:loc -> ?attrs:attrs -> extension -> expression
+  val jsx_fragment :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    Lexing.position ->
+    expression list ->
+    Lexing.position ->
+    expression
 
   val case : pattern -> ?guard:expression -> expression -> case
+
+  val make_list_expression :
+    Location.t -> expression list -> expression option -> expression
 end
 
 (** Value declarations *)

compiler/ml/ast_iterator.ml

@@ -344,6 +344,7 @@ module E = struct
       iter_loc sub lid;
       sub.expr sub e
     | Pexp_extension x -> sub.extension sub x
+    | Pexp_jsx_fragment (_, xs, _) -> List.iter (sub.expr sub) xs
 end
 
 module P = struct

compiler/ml/ast_mapper.ml

@@ -329,6 +329,8 @@ module E = struct
     | Pexp_open (ovf, lid, e) ->
       open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e)
     | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x)
+    | Pexp_jsx_fragment (o, xs, c) ->
+      jsx_fragment ~loc ~attrs o (List.map (sub.expr sub) xs) c
 end
 
 module P = struct

compiler/ml/ast_mapper_to0.ml

@@ -407,6 +407,18 @@ module E = struct
     | Pexp_open (ovf, lid, e) ->
       open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e)
     | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x)
+    | Pexp_jsx_fragment (o, xs, c) ->
+      (*
+         The location of  Pexp_jsx_fragment is from the start of < till the end of />.
+         This is not the case in the old AST. There it is from >...</
+      *)
+      let loc = {loc with loc_start = o; loc_end = c} in
+      let list_expr = Ast_helper.Exp.make_list_expression loc xs None in
+      let mapped = sub.expr sub list_expr in
+      let jsx_attr =
+        sub.attribute sub (Location.mknoloc "JSX", Parsetree.PStr [])
+      in
+      {mapped with pexp_attributes = jsx_attr :: attrs}
 end
 
 module P = struct

compiler/ml/depend.ml

@@ -289,6 +289,7 @@ let rec add_expr bv exp =
     | Pstr_eval ({pexp_desc = Pexp_construct (c, None)}, _) -> add bv c
     | _ -> handle_extension e)
   | Pexp_extension e -> handle_extension e
+  | Pexp_jsx_fragment (_, xs, _) -> List.iter (add_expr bv) xs
 
 and add_cases bv cases = List.iter (add_case bv) cases
 

compiler/ml/parsetree.ml

@@ -313,8 +313,14 @@ and expression_desc =
        let open M in E
        let! open M in E *)
   | Pexp_extension of extension
-(* [%id] *)
-(* . *)
+  (* [%id] *)
+  (* . *)
+  (* represents <> foo </> , the entire range is stored in the expression , we keep track of >, children and </ *)
+  | Pexp_jsx_fragment of
+      (* > *) Lexing.position
+      * (* children *)
+      expression list
+      * (* </ *) Lexing.position
 
 and case = {
   (* (P -> E) or (P when E0 -> E) *)

compiler/ml/pprintast.ml

@@ -794,6 +794,8 @@ and simple_expr ctxt f x =
       let expression = expression ctxt in
       pp f fmt (pattern ctxt) s expression e1 direction_flag df expression e2
         expression e3
+    | Pexp_jsx_fragment (_, xs, _) ->
+      pp f "<>%a</>" (list (simple_expr ctxt)) xs
     | _ -> paren true (expression ctxt) f x
 
 and attributes ctxt f l = List.iter (attribute ctxt f) l

compiler/ml/printast.ml

@@ -345,6 +345,9 @@ and expression i ppf x =
   | Pexp_extension (s, arg) ->
     line i ppf "Pexp_extension \"%s\"\n" s.txt;
     payload i ppf arg
+  | Pexp_jsx_fragment (_, xs, _) ->
+    line i ppf "Pexp_jsx_fragment";
+    list i expression ppf xs
 
 and value_description i ppf x =
   line i ppf "value_description %a %a\n" fmt_string_loc x.pval_name fmt_location

compiler/ml/typecore.ml

@@ -148,7 +148,8 @@ let iter_expression f e =
     | Pexp_match (e, pel) | Pexp_try (e, pel) ->
       expr e;
       List.iter case pel
-    | Pexp_array el | Pexp_tuple el -> List.iter expr el
+    | Pexp_array el | Pexp_tuple el | Pexp_jsx_fragment (_, el, _) ->
+      List.iter expr el
     | Pexp_construct (_, eo) | Pexp_variant (_, eo) -> may expr eo
     | Pexp_record (iel, eo) ->
       may expr eo;
@@ -3208,6 +3209,8 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg = Rejected) env sexp
     | _ -> raise (Error (loc, env, Invalid_extension_constructor_payload)))
   | Pexp_extension ext ->
     raise (Error_forward (Builtin_attributes.error_of_extension ext))
+  | Pexp_jsx_fragment _ ->
+    failwith "Pexp_jsx_fragment is expected to be transformed at this point"
 
 and type_function ?in_function ~arity ~async loc attrs env ty_expected_ l
     caselist =

compiler/syntax/src/jsx_v4.ml

@@ -1530,8 +1530,62 @@ let transform_jsx_call ~config mapper call_expression call_arguments
       "JSX: `createElement` should be preceeded by a simple, direct module \
        name."
 
-let expr ~config mapper expression =
+let expr ~(config : Jsx_common.jsx_config) mapper expression =
   match expression with
+  | {
+   pexp_desc = Pexp_jsx_fragment (_, xs, _);
+   pexp_loc = loc;
+   pexp_attributes = attrs;
+  } ->
+    let loc = {loc with loc_ghost = true} in
+    let fragment =
+      match config.mode with
+      | "automatic" ->
+        Exp.ident ~loc {loc; txt = module_access_name config "jsxFragment"}
+      | "classic" | _ ->
+        Exp.ident ~loc {loc; txt = Ldot (Lident "React", "fragment")}
+    in
+    let record_of_children children =
+      Exp.record [(Location.mknoloc (Lident "children"), children, false)] None
+    in
+    let apply_jsx_array expr =
+      Exp.apply
+        (Exp.ident
+           {txt = module_access_name config "array"; loc = Location.none})
+        [(Nolabel, expr)]
+    in
+    let children_props =
+      match xs with
+      | [] -> empty_record ~loc:Location.none
+      | [child] -> record_of_children (mapper.expr mapper child)
+      | _ -> (
+        match config.mode with
+        | "automatic" ->
+          record_of_children
+          @@ apply_jsx_array (Exp.array (List.map (mapper.expr mapper) xs))
+        | "classic" | _ -> empty_record ~loc:Location.none)
+    in
+    let args =
+      (nolabel, fragment) :: (nolabel, children_props)
+      ::
+      (match config.mode with
+      | "classic" when List.length xs > 1 ->
+        [(nolabel, Exp.array (List.map (mapper.expr mapper) xs))]
+      | _ -> [])
+    in
+    Exp.apply ~loc ~attrs
+      (* ReactDOM.createElement *)
+      (match config.mode with
+      | "automatic" ->
+        if List.length xs > 1 then
+          Exp.ident ~loc {loc; txt = module_access_name config "jsxs"}
+        else Exp.ident ~loc {loc; txt = module_access_name config "jsx"}
+      | "classic" | _ ->
+        if List.length xs > 1 then
+          Exp.ident ~loc
+            {loc; txt = Ldot (Lident "React", "createElementVariadic")}
+        else Exp.ident ~loc {loc; txt = Ldot (Lident "React", "createElement")})
+      args
   (* Does the function application have the @JSX attribute? *)
   | {
    pexp_desc = Pexp_apply {funct = call_expression; args = call_arguments};
@@ -1549,87 +1603,6 @@ let expr ~config mapper expression =
     | _, non_jsx_attributes ->
       transform_jsx_call ~config mapper call_expression call_arguments pexp_loc
         non_jsx_attributes)
-  (* is it a list with jsx attribute? Reason <>foo</> desugars to [@JSX][foo]*)
-  | {
-      pexp_desc =
-        ( Pexp_construct
-            ({txt = Lident "::"; loc}, Some {pexp_desc = Pexp_tuple _})
-        | Pexp_construct ({txt = Lident "[]"; loc}, None) );
-      pexp_attributes;
-    } as list_items -> (
-    let jsx_attribute, non_jsx_attributes =
-      List.partition
-        (fun (attribute, _) -> attribute.txt = "JSX")
-        pexp_attributes
-    in
-    match (jsx_attribute, non_jsx_attributes) with
-    (* no JSX attribute *)
-    | [], _ -> default_mapper.expr mapper expression
-    | _, non_jsx_attributes ->
-      let loc = {loc with loc_ghost = true} in
-      let fragment =
-        match config.mode with
-        | "automatic" ->
-          Exp.ident ~loc {loc; txt = module_access_name config "jsxFragment"}
-        | "classic" | _ ->
-          Exp.ident ~loc {loc; txt = Ldot (Lident "React", "fragment")}
-      in
-      let children_expr = transform_children_if_list ~mapper list_items in
-      let record_of_children children =
-        Exp.record
-          [(Location.mknoloc (Lident "children"), children, false)]
-          None
-      in
-      let apply_jsx_array expr =
-        Exp.apply
-          (Exp.ident
-             {txt = module_access_name config "array"; loc = Location.none})
-          [(Nolabel, expr)]
-      in
-      let count_of_children = function
-        | {pexp_desc = Pexp_array children} -> List.length children
-        | _ -> 0
-      in
-      let transform_children_to_props children_expr =
-        match children_expr with
-        | {pexp_desc = Pexp_array children} -> (
-          match children with
-          | [] -> empty_record ~loc:Location.none
-          | [child] -> record_of_children child
-          | _ -> (
-            match config.mode with
-            | "automatic" -> record_of_children @@ apply_jsx_array children_expr
-            | "classic" | _ -> empty_record ~loc:Location.none))
-        | _ -> (
-          match config.mode with
-          | "automatic" -> record_of_children @@ apply_jsx_array children_expr
-          | "classic" | _ -> empty_record ~loc:Location.none)
-      in
-      let args =
-        (nolabel, fragment)
-        :: (nolabel, transform_children_to_props children_expr)
-        ::
-        (match config.mode with
-        | "classic" when count_of_children children_expr > 1 ->
-          [(nolabel, children_expr)]
-        | _ -> [])
-      in
-      Exp.apply
-        ~loc (* throw away the [@JSX] attribute and keep the others, if any *)
-        ~attrs:non_jsx_attributes
-        (* ReactDOM.createElement *)
-        (match config.mode with
-        | "automatic" ->
-          if count_of_children children_expr > 1 then
-            Exp.ident ~loc {loc; txt = module_access_name config "jsxs"}
-          else Exp.ident ~loc {loc; txt = module_access_name config "jsx"}
-        | "classic" | _ ->
-          if count_of_children children_expr > 1 then
-            Exp.ident ~loc
-              {loc; txt = Ldot (Lident "React", "createElementVariadic")}
-          else
-            Exp.ident ~loc {loc; txt = Ldot (Lident "React", "createElement")})
-        args)
   (* Delegate to the default mapper, a deep identity traversal *)
   | e -> default_mapper.expr mapper e
 

compiler/syntax/src/res_ast_debugger.ml

@@ -707,6 +707,11 @@ module SexpAst = struct
           ]
       | Pexp_extension ext ->
         Sexp.list [Sexp.atom "Pexp_extension"; extension ext]
+      | Pexp_jsx_fragment (_, xs, _) ->
+        Sexp.list
+          [
+            Sexp.atom "Pexp_jsx_fragment"; Sexp.list (map_empty ~f:expression xs);
+          ]
     in
     Sexp.list [Sexp.atom "expression"; desc]