Merge pull request #2969 from chenglou/refmt

Upstream refmt and jsx ppx 193cec5eb39b23009fe2697abbc81e943039b833

Author: bobzhang

jscomp/bin/jsoo_reactjs_jsx_ppx_v2.ml

@@ -12,13 +12,19 @@
 (*
   The actual transform:
 
-  transform `div props1::a props2::b children::[foo, bar] () [@JSX]` into
-  `ReactDOMRe.createElement "div" props::[%bs.obj {props1: 1, props2: b}] [|foo,
-  bar|]`.
+  transform `[@JSX] div(~props1=a, ~props2=b, ~children=[foo, bar], ())` into
+  `ReactDOMRe.createElement("div", ~props={"props1": 1, "props2": b}, [|foo,
+  bar|])`.
+
+  transform `[@JSX] div(~props1=a, ~props2=b, ~children=foo, ())` into
+  `ReactDOMRe.createElementVariadic("div", ~props={"props1": 1, "props2": b}, foo)`.
 
   transform the upper-cased case
-  `Foo.createElement key::a ref::b foo::bar children::[] () [@JSX]` into
-  `ReasonReact.element key::a ref::b (Foo.make foo::bar [||] [@JSX])`
+  `[@JSX] Foo.createElement(~key=a, ~ref=b, ~foo=bar, ~children=[], ())` into
+  `ReasonReact.element(~key=a, ~ref=b, Foo.make(~foo=bar, [||]))`
+
+  transform `[@JSX] [foo]` into
+  `ReactDOMRe.createElement(ReasonReact.fragment, [|foo|])`
 *)
 
 (*
@@ -51,8 +57,8 @@ open Parsetree
 open Longident
 
 (* if children is a list, convert it to an array while mapping each element. If not, just map over it, as usual *)
-let transformChildren ~loc ~mapper theList =
-  let rec transformChildren' theList accum =
+let transformChildrenIfList ~loc ~mapper theList =
+  let rec transformChildren_ theList accum =
     (* not in the sense of converting a list to an array; convert the AST
        reprensentation of a list to the AST reprensentation of an array *)
     match theList with
@@ -62,12 +68,12 @@ let transformChildren ~loc ~mapper theList =
         {txt = Lident "::"},
         Some {pexp_desc = Pexp_tuple (v::acc::[])}
       )} ->
-      transformChildren' acc ((mapper.expr mapper v)::accum)
+      transformChildren_ acc ((mapper.expr mapper v)::accum)
     | notAList -> mapper.expr mapper notAList
   in
-  transformChildren' theList []
+  transformChildren_ theList []
 
-let extractChildrenForDOMElements ?(removeLastPositionUnit=false) ~loc propsAndChildren =
+let extractChildren ?(removeLastPositionUnit=false) ~loc propsAndChildren =
   let rec allButLast_ lst acc = match lst with
     | [] -> []
 
@@ -78,56 +84,25 @@ let extractChildrenForDOMElements ?(removeLastPositionUnit=false) ~loc propsAndC
   in
   let allButLast lst = allButLast_ lst [] |> List.rev in
   match (List.partition (fun (label, expr) -> label = labelled "children") propsAndChildren) with
-  | ((label, childrenExpr)::[], props) ->
-    (childrenExpr, if removeLastPositionUnit then allButLast props else props)
   | ([], props) ->
-    (* no children provided? Place a placeholder list (don't forgot we're talking about DOM element conversion here only) *)
+    (* no children provided? Place a placeholder list *)
     (Exp.construct ~loc {loc; txt = Lident "[]"} None, if removeLastPositionUnit then allButLast props else props)
+  | ([(label, childrenExpr)], props) ->
+    (childrenExpr, if removeLastPositionUnit then allButLast props else props)
   | (moreThanOneChild, props) -> raise (Invalid_argument "JSX: somehow there's more than one `children` label")
 
 (* TODO: some line number might still be wrong *)
 let jsxMapper () =
 
-  let jsxTransformV3 modulePath mapper loc attrs callExpression callArguments =
-    let (children, argsWithLabels) =
-      extractChildrenForDOMElements ~loc ~removeLastPositionUnit:true callArguments in
-    let (argsKeyRef, argsForMake) = List.partition argIsKeyRef argsWithLabels in
-    let childrenExpr = match children with
-    (* if it's a single, non-jsx item, keep it so (remove the list wrapper, don't add the array wrapper) *)
-    | {pexp_desc = Pexp_construct (
-        {txt = Lident "::"; loc},
-        Some {pexp_desc = Pexp_tuple [
-          ({pexp_attributes} as singleItem);
-          {pexp_desc = Pexp_construct ({txt = Lident "[]"}, None)}
-        ]}
-      )} when List.for_all (fun (attribute, _) -> attribute.txt <> "JSX") pexp_attributes ->
-      mapper.expr mapper singleItem
-    (* if it's a single jsx item, or multiple items, turn list into an array *)
-    | nonEmptyChildren -> transformChildren ~loc ~mapper nonEmptyChildren
-    in
-    let recursivelyTransformedArgsForMake = argsForMake |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression)) in
-    let args = recursivelyTransformedArgsForMake @ [ (nolabel, childrenExpr) ] in
-    let wrapWithReasonReactElement e = (* ReasonReact.element ::key ::ref (...) *)
-      Exp.apply
-        ~loc
-        (Exp.ident ~loc {loc; txt = Ldot (Lident "ReasonReact", "element")})
-        (argsKeyRef @ [(nolabel, e)]) in
-    Exp.apply
-      ~loc
-      ~attrs
-      (* Foo.make *)
-      (Exp.ident ~loc {loc; txt = Ldot (modulePath, "make")})
-      args
-    |> wrapWithReasonReactElement in
+  let jsxVersion = ref None in
 
-  let jsxTransformV2 modulePath mapper loc attrs callExpression callArguments =
-    let (children, argsWithLabels) =
-      extractChildrenForDOMElements ~loc ~removeLastPositionUnit:true callArguments in
+  let transformUppercaseCall modulePath mapper loc attrs callExpression callArguments =
+    let (children, argsWithLabels) = extractChildren ~loc ~removeLastPositionUnit:true callArguments in
     let (argsKeyRef, argsForMake) = List.partition argIsKeyRef argsWithLabels in
-    let childrenExpr = transformChildren ~loc ~mapper children in
+    let childrenExpr = transformChildrenIfList ~loc ~mapper children in
     let recursivelyTransformedArgsForMake = argsForMake |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression)) in
     let args = recursivelyTransformedArgsForMake @ [ (nolabel, childrenExpr) ] in
-    let wrapWithReasonReactElement e = (* ReasonReact.element ::key ::ref (...) *)
+    let wrapWithReasonReactElement e = (* ReasonReact.element(~key, ~ref, ...) *)
       Exp.apply
         ~loc
         (Exp.ident ~loc {loc; txt = Ldot (Lident "ReasonReact", "element")})
@@ -140,13 +115,36 @@ let jsxMapper () =
       args
     |> wrapWithReasonReactElement in
 
-  let lowercaseCaller mapper loc attrs callArguments id  =
-    let (children, propsWithLabels) =
-      extractChildrenForDOMElements ~loc callArguments in
+  let transformLowercaseCall mapper loc attrs callArguments id =
+    let (children, nonChildrenProps) = extractChildren ~loc callArguments in
     let componentNameExpr = constantString ~loc id in
-    let childrenExpr = transformChildren ~loc ~mapper children in
-    let args = match propsWithLabels with
-      | [theUnitArgumentAtEnd] ->
+    let childrenExpr = transformChildrenIfList ~loc ~mapper children in
+    let createElementCall = match children with
+      (* [@JSX] div(~children=[a]), coming from <div> a </div> *)
+      | {
+          pexp_desc =
+           Pexp_construct ({txt = Lident "::"; loc}, Some {pexp_desc = Pexp_tuple _ })
+           | Pexp_construct ({txt = Lident "[]"; loc}, None);
+          pexp_attributes
+        } -> "createElement"
+      (* [@JSX] div(~children=[|a|]), coming from <div> ...[|a|] </div> *)
+      | {
+          pexp_desc = (Pexp_array _);
+          pexp_attributes
+        } ->
+        raise (Invalid_argument "A spread + an array literal as a DOM element's \
+          children would cancel each other out, and thus don't make sense written \
+          together. You can simply remove the spread and the array literal.")
+      (* [@JSX] div(~children= <div />), coming from <div> ...<div/> </div> *)
+      | {
+          pexp_attributes
+        } when pexp_attributes |> List.exists (fun (attribute, _) -> attribute.txt = "JSX") ->
+        raise (Invalid_argument "A spread + a JSX literal as a DOM element's \
+          children don't make sense written together. You can simply remove the spread.")
+      | notAList -> "createElementVariadic"
+    in
+    let args = match nonChildrenProps with
+      | [_justTheUnitArgumentAtEnd] ->
         [
           (* "div" *)
           (nolabel, componentNameExpr);
@@ -163,7 +161,7 @@ let jsxMapper () =
         [
           (* "div" *)
           (nolabel, componentNameExpr);
-          (* ReactDOMRe.props className:blabla foo::bar () *)
+          (* ReactDOMRe.props(~className=blabla, ~foo=bar, ()) *)
           (labelled "props", propsCall);
           (* [|moreCreateElementCallsHere|] *)
           (nolabel, childrenExpr)
@@ -172,82 +170,31 @@ let jsxMapper () =
       ~loc
       (* throw away the [@JSX] attribute and keep the others, if any *)
       ~attrs
-      (* ReactDOMRe.createDOMElement *)
-      (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", "createElement")})
-      args in
-
-  let jsxVersion = ref None in
-
-  let structure =
-    (fun mapper structure -> match structure with
-      (*
-        match against [@@@bs.config {foo, jsx: ...}] at the file-level. This
-        indicates which version of JSX we're using. This code stays here because
-        we used to have 2 versions of JSX PPX (and likely will again in the
-        future when JSX PPX changes). So the architecture for switching between
-        JSX behavior stayed here. To create a new JSX ppx, copy paste this
-        entire file and change the relevant parts.
-
-        Description of architecture: in bucklescript's bsconfig.json, you can
-        specify a project-wide JSX version. You can also specify a file-level
-        JSX version. This degree of freedom allows a person to convert a project
-        one file at time onto the new JSX, when it was released. It also enabled
-        a project to depend on a third-party which is still using an old version
-        of JSX
-      *)
-      | {
-            pstr_loc;
-            pstr_desc = Pstr_attribute (
-              ({txt = "bs.config"} as bsConfigLabel),
-              PStr [{pstr_desc = Pstr_eval ({pexp_desc = Pexp_record (recordFields, b)} as innerConfigRecord, a)} as configRecord]
-            )
-          }::restOfStructure -> begin
-            let (jsxField, recordFieldsWithoutJsx) = recordFields |> List.partition (fun ({txt}, _) -> txt = Lident "jsx") in
-            match (jsxField, recordFieldsWithoutJsx) with
-            (* no file-level jsx config found *)
-            | ([], _) -> default_mapper.structure mapper structure
-            (* {jsx: 2 | 3} *)
-
-            | ((_, {pexp_desc = Pexp_constant (Const_int version)})::rest, recordFieldsWithoutJsx) -> begin
-                (match version with
-                | 2 -> jsxVersion := Some 2
-                | 3 -> jsxVersion := Some 3
-                | _ -> raise (Invalid_argument "JSX: the file-level bs.config's jsx version must be either 2 or 3"));
-
-                match recordFieldsWithoutJsx with
-                (* record empty now, remove the whole bs.config attribute *)
-                | [] -> default_mapper.structure mapper restOfStructure
-                | fields -> default_mapper.structure mapper ({
-                  pstr_loc;
-                  pstr_desc = Pstr_attribute (
-                    bsConfigLabel,
-                    PStr [{configRecord with pstr_desc = Pstr_eval ({innerConfigRecord with pexp_desc = Pexp_record (fields, b)}, a)}]
-                  )
-                }::restOfStructure)
-              end
-          | (_, recordFieldsWithoutJsx) -> raise (Invalid_argument "JSX: the file-level bs.config's {jsx: ...} config accepts only a version number")
-        end
-      | _ -> default_mapper.structure mapper structure
-    ) in
+      (* ReactDOMRe.createElement *)
+      (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", createElementCall)})
+      args
+  in
 
   let transformJsxCall mapper callExpression callArguments attrs =
     (match callExpression.pexp_desc with
      | Pexp_ident caller ->
        (match caller with
         | {txt = Lident "createElement"} ->
           raise (Invalid_argument "JSX: `createElement` should be preceeded by a module name.")
-        (* Foo.createElement prop1::foo prop2:bar children::[] () *)
+
+        (* Foo.createElement(~prop1=foo, ~prop2=bar, ~children=[], ()) *)
         | {loc; txt = Ldot (modulePath, ("createElement" | "make"))} ->
-          let f = match !jsxVersion with
-            | Some 2 -> jsxTransformV2 modulePath
-            | Some 3 -> jsxTransformV3 modulePath
-            | Some _ -> raise (Invalid_argument "JSX: the JSX version must be either 2 or 3")
-            | None -> jsxTransformV2 modulePath
-          in f mapper loc attrs callExpression callArguments
-        (* div prop1::foo prop2:bar children::[bla] () *)
-        (* turn that into ReactDOMRe.createElement props::(ReactDOMRe.props props1::foo props2::bar ()) [|bla|] *)
+          (match !jsxVersion with
+          | None
+          | Some 2 -> transformUppercaseCall modulePath mapper loc attrs callExpression callArguments
+          | Some _ -> raise (Invalid_argument "JSX: the JSX version must be 2"))
+
+        (* div(~prop1=foo, ~prop2=bar, ~children=[bla], ()) *)
+        (* turn that into
+          ReactDOMRe.createElement(~props=ReactDOMRe.props(~props1=foo, ~props2=bar, ()), [|bla|]) *)
         | {loc; txt = Lident id} ->
-          lowercaseCaller mapper loc attrs callArguments id
+          transformLowercaseCall mapper loc attrs callArguments id
+
         | {txt = Ldot (_, anythingNotCreateElementOrMake)} ->
           raise (
             Invalid_argument
@@ -256,6 +203,7 @@ let jsxMapper () =
                ^ "` instead"
               )
           )
+
         | {txt = Lapply _} ->
           (* don't think there's ever a case where this is reached *)
           raise (
@@ -268,11 +216,61 @@ let jsxMapper () =
        )
     ) in
 
+  let structure =
+    (fun mapper structure -> match structure with
+      (*
+        match against [@bs.config {foo, jsx: ...}] at the file-level. This
+        indicates which version of JSX we're using. This code stays here because
+        we used to have 2 versions of JSX PPX (and likely will again in the
+        future when JSX PPX changes). So the architecture for switching between
+        JSX behavior stayed here. To create a new JSX ppx, copy paste this
+        entire file and change the relevant parts.
+
+        Description of architecture: in bucklescript's bsconfig.json, you can
+        specify a project-wide JSX version. You can also specify a file-level
+        JSX version. This degree of freedom allows a person to convert a project
+        one file at time onto the new JSX, when it was released. It also enabled
+        a project to depend on a third-party which is still using an old version
+        of JSX
+      *)
+      | {
+          pstr_loc;
+          pstr_desc = Pstr_attribute (
+            ({txt = "bs.config"} as bsConfigLabel),
+            PStr [{pstr_desc = Pstr_eval ({pexp_desc = Pexp_record (recordFields, b)} as innerConfigRecord, a)} as configRecord]
+          )
+        }::restOfStructure -> begin
+          let (jsxField, recordFieldsWithoutJsx) = recordFields |> List.partition (fun ({txt}, _) -> txt = Lident "jsx") in
+          match (jsxField, recordFieldsWithoutJsx) with
+          (* no file-level jsx config found *)
+          | ([], _) -> default_mapper.structure mapper structure
+          (* {jsx: 2} *)
+
+          | ((_, {pexp_desc = Pexp_constant (Const_int version)})::rest, recordFieldsWithoutJsx) -> begin
+              (match version with
+              | 2 -> jsxVersion := Some 2
+              | _ -> raise (Invalid_argument "JSX: the file-level bs.config's jsx version must be 2"));
+
+              match recordFieldsWithoutJsx with
+              (* record empty now, remove the whole bs.config attribute *)
+              | [] -> default_mapper.structure mapper restOfStructure
+              | fields -> default_mapper.structure mapper ({
+                pstr_loc;
+                pstr_desc = Pstr_attribute (
+                  bsConfigLabel,
+                  PStr [{configRecord with pstr_desc = Pstr_eval ({innerConfigRecord with pexp_desc = Pexp_record (fields, b)}, a)}]
+                )
+              }::restOfStructure)
+            end
+        | (_, recordFieldsWithoutJsx) -> raise (Invalid_argument "JSX: the file-level bs.config's {jsx: ...} config accepts only a version number")
+      end
+      | _ -> default_mapper.structure mapper structure
+    ) in
+
   let expr =
     (fun mapper expression -> match expression with
        (* Does the function application have the @JSX attribute? *)
-       |
-         {
+       | {
            pexp_desc = Pexp_apply (callExpression, callArguments);
            pexp_attributes
          } ->
@@ -281,6 +279,35 @@ let jsxMapper () =
          (* no JSX attribute *)
          | ([], _) -> default_mapper.expr mapper expression
          | (_, nonJSXAttributes) -> transformJsxCall mapper callExpression callArguments nonJSXAttributes)
+
+       (* 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 listItems ->
+          let (jsxAttribute, nonJSXAttributes) = List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes in
+          (match (jsxAttribute, nonJSXAttributes) with
+          (* no JSX attribute *)
+          | ([], _) -> default_mapper.expr mapper expression
+          | (_, nonJSXAttributes) ->
+            let fragment = Exp.ident ~loc {loc; txt = Ldot (Lident "ReasonReact", "fragment")} in
+            let childrenExpr = transformChildrenIfList ~loc ~mapper listItems in
+            let args = [
+              (* "div" *)
+              (nolabel, fragment);
+              (* [|moreCreateElementCallsHere|] *)
+              (nolabel, childrenExpr)
+            ] in
+            Exp.apply
+              ~loc
+              (* throw away the [@JSX] attribute and keep the others, if any *)
+              ~attrs:nonJSXAttributes
+              (* ReactDOMRe.createElement *)
+              (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", "createElement")})
+              args
+         )
        (* Delegate to the default mapper, a deep identity traversal *)
        | e -> default_mapper.expr mapper e) in
 
@@ -357,3 +384,4 @@ let make_ppx name =
 
 let () = make_ppx "jsxv2"
 
+