Jsx ast

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_from0.ml

@@ -358,6 +358,10 @@ module E = struct
       match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)
     | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)
     | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el)
+    | Pexp_construct ({txt = Longident.Lident "[]"}, None)
+      when attrs |> List.exists (fun ({txt}, _) -> txt == "JSX") ->
+      let attrs = attrs |> List.filter (fun ({txt}, _) -> txt != "JSX") in
+      jsx_fragment ~loc ~attrs loc.loc_start [] loc.loc_end
     | Pexp_construct (lid, arg) -> (
       let lid1 = map_loc sub lid in
       let arg1 = map_opt (sub.expr sub) arg in

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]