add parsing and jsx ppx for spread props

Author: mununki

cli/reactjs_jsx_ppx_v3.ml

@@ -33,6 +33,115 @@ type 'a children = ListLiteral of 'a | Exact of 'a
 
 type componentConfig = { propsName : string }
 
+(* structure ref in order to avoid too many arg drilling *)
+let impl: Parsetree.structure ref = ref []
+
+(* signature ref in order to avoid too many arg drilling *)
+let intf: Parsetree.signature ref = ref []
+
+(* List.filter_map in 4.08.0 *)
+let filterMap f =
+  let rec aux accu = function
+    | [] -> List.rev accu
+    | x :: l ->
+        match f x with
+        | None -> aux accu l
+        | Some v -> aux (v :: accu) l
+  in
+  aux []
+
+(* fold the Longident.t to string for record fields to be spread. Maybe Lident is needed. *)
+let stringOfLid lid = Longident.flatten lid.txt |> List.fold_left (fun acc x -> acc ^ x) ""
+
+(* Look up the record to be spread and extract the fields *)
+let findRecordFields { pexp_desc } =
+  let rec findRecordFieldsAux structure labels =
+    match labels with
+    | [] -> raise (Invalid_argument "JSX: spread props missing")
+    (* foo *)
+    | [ label ] ->
+      structure
+        |> filterMap (fun { pstr_desc } ->
+            match pstr_desc with
+            | Pstr_value (_, vbs) -> (
+              let matched_vbs =
+                vbs
+                |> List.filter (fun { pvb_pat = { ppat_desc } } ->
+                  match ppat_desc with
+                  | Ppat_var { Location.txt } -> txt = label
+                  | _ -> false)
+              in
+              match matched_vbs with
+              | [] -> None
+              | [ { pvb_expr = { pexp_desc } } ] | { pvb_expr = { pexp_desc } } :: _ ->
+                begin
+                  match pexp_desc with
+                  | Pexp_record (fields, _) -> Some fields
+                  | _ -> None
+                end)
+            | _ -> None)
+    (* Foo.name *)
+    | label :: labels ->
+      structure
+      |> filterMap (fun { pstr_desc } ->
+          match pstr_desc with
+          (* module Foo = ... *)
+          | Pstr_module
+              {
+                pmb_name;
+                pmb_expr = { pmod_desc = Pmod_structure structure };
+              } ->
+              if pmb_name.txt = label then
+                Some (findRecordFieldsAux structure labels)
+              else None
+          (* module Foo: Foo = ... *)
+          | Pstr_module
+              {
+                pmb_name;
+                pmb_expr =
+                  {
+                    pmod_desc =
+                      Pmod_constraint
+                        ({ pmod_desc = Pmod_structure structure }, _);
+                  };
+              } ->
+              if pmb_name.txt = label then
+                Some (findRecordFieldsAux structure labels)
+              else None
+          | _ -> None)
+      |> List.concat
+  in
+  (* foo, foo.name, Foo.name *)
+  match pexp_desc with
+  | Pexp_ident lid
+  | Pexp_field (_, lid) ->
+    begin
+      let labels = Longident.flatten lid.txt in
+      let recordFields = findRecordFieldsAux !impl labels in
+      (* last record fields of list is the closest one *)
+      try recordFields |> List.rev |> List.hd with _ -> raise (Invalid_argument "JSX: can't find the spread prop record")
+    end
+  | _ -> raise (Invalid_argument "JSX: can't find the spread prop record")
+
+(* spread props if exists *)
+let propsWithSpreadProps callArguments =
+  let unitRef = ref None in
+  let rec removeLastPositionUnitAux props acc =
+    match props with
+    | [] -> []
+    | [ (Nolabel, { pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) }) as u ] -> unitRef := Some u; acc
+    | (Nolabel, _) :: _rest -> raise (Invalid_argument "JSX: found non-labelled argument before the last position")
+    | prop :: rest -> removeLastPositionUnitAux rest (prop :: acc)
+  in
+  let props, propsToSpread = removeLastPositionUnitAux callArguments [] |> List.rev |> List.partition (fun (label, _) -> label <> labelled "spreadProps") in
+  let spreadProps = propsToSpread
+                    |> List.map (fun (_, expression) -> expression)
+                    |> List.map findRecordFields
+                    |> List.concat
+                    |> List.map (fun (lid, expression) -> (labelled @@ stringOfLid lid, expression))
+  in
+  match !unitRef with Some u -> props @ spreadProps @ [ u ] | None -> props @ spreadProps
+
 (* if children is a list, convert it to an array while mapping each element. If not, just map over it, as usual *)
 let transformChildrenIfListUpper ~loc ~mapper theList =
   let rec transformChildren_ theList accum =
@@ -809,6 +918,7 @@ let jsxMapper () =
   in
 
   let transformJsxCall mapper callExpression callArguments attrs =
+    let callArguments = propsWithSpreadProps callArguments in
     match callExpression.pexp_desc with
     | Pexp_ident caller -> (
         match caller with
@@ -898,11 +1008,13 @@ let jsxMapper () =
   [@@raises Invalid_argument, Failure]
 
 let rewrite_implementation (code : Parsetree.structure) : Parsetree.structure =
+  impl := code;
   let mapper = jsxMapper () in
   mapper.structure mapper code
   [@@raises Invalid_argument, Failure]
 
 let rewrite_signature (code : Parsetree.signature) : Parsetree.signature =
+  intf := code;
   let mapper = jsxMapper () in
   mapper.signature mapper code
   [@@raises Invalid_argument, Failure]

cli/reactjs_jsx_ppx_v3.mli

@@ -22,14 +22,14 @@
   transform `[@JSX] [foo]` into
   `ReactDOMRe.createElement(ReasonReact.fragment, [|foo|])`
   v3:
-  transform `[@JSX] div(~props1=a, ~props2=b, ~children=[foo, bar], ())` into
-  `ReactDOMRe.createDOMElementVariadic("div", ReactDOMRe.domProps(~props1=1, ~props2=b), [|foo, bar|])`.
+  transform `[@JSX] div(~props1=a, ~props2=b, ~spreadProps=props3 ~children=[foo, bar], ())` into
+  `ReactDOMRe.createDOMElementVariadic("div", ReactDOMRe.domProps(~props1=1, ~props2=b, ~props31=c1, ~props32=c2), [|foo, bar|])`.
   transform the upper-cased case
-  `[@JSX] Foo.createElement(~key=a, ~ref=b, ~foo=bar, ~children=[], ())` into
-  `React.createElement(Foo.make, Foo.makeProps(~key=a, ~ref=b, ~foo=bar, ()))`
+  `[@JSX] Foo.createElement(~key=a, ~ref=b, ~foo=bar, ~spreadProps=baz ~children=[], ())` into
+  `React.createElement(Foo.make, Foo.makeProps(~key=a, ~ref=b, ~foo=bar, ~baz1=c, ~baz2=d,  ()))`
   transform the upper-cased case
-  `[@JSX] Foo.createElement(~foo=bar, ~children=[foo, bar], ())` into
-  `React.createElementVariadic(Foo.make, Foo.makeProps(~foo=bar, ~children=React.null, ()), [|foo, bar|])`
+  `[@JSX] Foo.createElement(~foo=bar, ~spreadProps=baz, ~children=[foo, bar], ())` into
+  `React.createElementVariadic(Foo.make, Foo.makeProps(~foo=bar, ~baz1=a, ~baz2=b ~children=React.null, ()), [|foo, bar|])`
   transform `[@JSX] [foo]` into
   `ReactDOMRe.createElement(ReasonReact.fragment, [|foo|])`
 *)

src/res_core.ml

@@ -2657,6 +2657,7 @@ and parseJsxFragment p =
  *   | ?lident
  *   |  lident =  jsx_expr
  *   |  lident = ?jsx_expr
+ *   |  {...jsx_expr}
  *)
 and parseJsxProp p =
   match p.Parser.token with
@@ -2694,6 +2695,30 @@ and parseJsxProp p =
         in
         Some (label, attrExpr)
     end
+  (* {...props} *)
+  | Lbrace ->
+    begin
+      Parser.next p;
+      match p.Parser.token with
+      | DotDotDot ->
+        begin
+          Parser.next p;
+          let loc = mkLoc p.Parser.startPos p.prevEndPos in
+          let propLocAttr = (Location.mkloc "ns.namedArgLoc" loc, Parsetree.PStr []) in
+          let attrExpr =
+            let e = parsePrimaryExpr ~operand:(parseAtomicExpr p) p in
+            {e with pexp_attributes = propLocAttr::e.pexp_attributes}
+          in
+          (* using label "spreadProps" to distinguish from others *)
+          let label = Asttypes.Labelled "spreadProps" in
+          match p.Parser.token with
+          | Rbrace ->
+            Parser.next p;
+            Some (label, attrExpr)
+          |_ -> None
+        end
+      | _ -> None
+    end
   | _ ->
     None
 

src/res_grammar.ml

@@ -176,7 +176,7 @@ let isExprStart = function
   | _ -> false
 
 let isJsxAttributeStart = function
-  | Token.Lident _ | Question -> true
+  | Token.Lident _ | Question | Lbrace -> true
   | _ -> false
 
 let isStructureItemStart = function