Support data-* attributes in DOM JSX

CHANGES.md

@@ -1,5 +1,6 @@
 # 0.17.0
 
+* Support custom `data-*` attributes in DOM JSX, including optional string values (@anmonteiro in https://github.com/reasonml/reason-react/pull/933)
 * Upgrade `ppxlib` lower bound to `0.36` (@anmonteiro in https://github.com/reasonml/reason-react/pull/883)
 * Remove `fomat` from ReactDOM's props (@davesnx in https://github.com/reasonml/reason-react/pull/929)
 * Fix typo on `onEncrypted` (@davesnx in https://github.com/reasonml/reason-react/pull/930)

README.md

@@ -27,6 +27,21 @@ let make = (~name) => <h1> {React.string("Hello " ++ name)} </h1>
 
 See all of our examples [here](https://reasonml.github.io/reason-react/docs/en/simple). For a full application, check out [reason-react-hacker-news](https://github.com/reasonml-community/reason-react-hacker-news).
 
+DOM elements accept custom data attributes in camelCase:
+
+```reason
+<div className="item" dataTestId="item" dataState="ready" />
+```
+
+This produces `data-test-id` and `data-state` attributes. Values are strings;
+optional attributes such as `<div dataState=?state />` are omitted when `state`
+is `None`. Ordinary props retain their existing type checks. Data props on
+user-defined components keep their declared names and types.
+
+Each uppercase ASCII letter adds a hyphen and becomes lowercase; digits and
+underscores are preserved. For example, `dataVersion2` becomes `data-version2`
+and `dataFoo__bar` becomes `data-foo__bar`.
+
 <!-- ## Getting Started -->
 
 ## Using Your Favorite Javascript Libraries

ppx/dom_props.ml

@@ -0,0 +1,185 @@
+open Ppxlib
+open Ast_builder.Default
+
+let attribute ~loc ?(payload = PStr []) name =
+  attribute ~loc ~name:{ txt = name; loc } ~payload
+
+let data_attribute name =
+  if
+    String.length name > 4
+    && String.sub name 0 4 = "data"
+    && name.[4] >= 'A'
+    && name.[4] <= 'Z'
+  then (
+    let buffer = Buffer.create (String.length name + 4) in
+    String.iter
+      (function
+        | 'A' .. 'Z' as c ->
+            Buffer.add_char buffer '-';
+            Buffer.add_char buffer (Char.lowercase_ascii c)
+        | c -> Buffer.add_char buffer c)
+      name;
+    Some (Buffer.contents buffer))
+  else None
+
+(* These are the [mel.as] conventions used by ReactDOM.domProps. Ordinary
+   React prop names, such as className and onClick, keep their spelling. *)
+let js_name name =
+  match name with
+  | "as_" | "begin_" | "end_" | "in_" | "open_" | "to_" | "type_" ->
+      Some (String.sub name 0 (String.length name - 1))
+  | _ when String.length name > 4 && String.sub name 0 4 = "aria" ->
+      Some
+        ("aria-"
+        ^ String.lowercase_ascii (String.sub name 4 (String.length name - 4)))
+  | _ -> None
+
+let label_name = function
+  | Labelled name | Optional name -> name
+  | Nolabel -> ""
+
+let ignored_type ~loc typ =
+  { typ with ptyp_attributes = [ attribute ~loc "mel.ignore" ] }
+
+(* [mel.obj] requires a literal [unit] type for unlabelled arguments. Use an
+   ignored labelled argument so the type can be qualified against shadowing. *)
+let make_label = function Nolabel -> Labelled "__jsx_unit" | label -> label
+
+type prop = {
+  label : arg_label;
+  variable : string;
+  typ : core_type;
+  data_name : string option;
+}
+
+let make ~loc ~dom_props args =
+  if
+    not
+      (List.exists
+         (fun (label, _) -> Option.is_some (data_attribute (label_name label)))
+         args)
+  then dom_props args
+  else
+    let ghost_loc = { loc with loc_ghost = true } in
+    let stdlib_type name =
+      ptyp_constr ~loc:ghost_loc
+        { txt = Ldot (Ldot (Lident "Stdlib", name), "t"); loc = ghost_loc }
+        []
+    in
+    let unit_type = stdlib_type "Unit" in
+    let string_type = stdlib_type "String" in
+    let props_type =
+      ptyp_constr ~loc:ghost_loc
+        { txt = Ldot (Lident "ReactDOM", "domProps"); loc = ghost_loc }
+        []
+    in
+    let data_names = Hashtbl.create 8 in
+    let props =
+      List.mapi
+        (fun index (label, expression) ->
+          let variable = "prop" ^ string_of_int index in
+          let data_name = data_attribute (label_name label) in
+          Option.iter
+            (fun name ->
+              if Hashtbl.mem data_names name then
+                Location.raise_errorf ~loc:expression.pexp_loc
+                  "JSX: duplicate data attribute %S" name;
+              Hashtbl.add data_names name ())
+            data_name;
+          let typ =
+            match (label, data_name) with
+            | Nolabel, _ -> unit_type
+            | _, Some _ -> string_type
+            | _, None -> ptyp_var ~loc:ghost_loc variable
+          in
+          { label; variable; typ; data_name })
+        args
+    in
+    let ordinary_props =
+      List.filter (fun prop -> prop.data_name = None) props
+    in
+    let arrow { label; typ; _ } result =
+      ptyp_arrow ~loc:ghost_loc label typ result
+    in
+    (* The shared type variables connect each supplied prop to the corresponding
+       argument of ReactDOM.domProps. Melange erases this pure callback after
+       OCaml has checked both its labels and its types. *)
+    let check_type =
+      ignored_type ~loc:ghost_loc
+        (List.fold_right arrow ordinary_props props_type)
+    in
+    let check_args =
+      List.map
+        (fun { label; variable; _ } -> (label, evar ~loc:ghost_loc variable))
+        ordinary_props
+    in
+    let check =
+      List.fold_right
+        (fun { label; variable; _ } body ->
+          pexp_fun ~loc:ghost_loc label None (pvar ~loc:ghost_loc variable) body)
+        ordinary_props (dom_props check_args)
+    in
+    let check =
+      {
+        check with
+        pexp_attributes = [ attribute ~loc:ghost_loc "merlin.hide" ];
+      }
+    in
+    let make_type =
+      List.fold_right
+        (fun { label; typ; data_name; _ } result ->
+          let name =
+            match data_name with
+            (* Melange strips the last [__suffix], even in [mel.as]. An empty
+               suffix preserves any double underscores in the attribute. *)
+            | Some name -> Some (name ^ "__")
+            | None -> js_name (label_name label)
+          in
+          let attributes =
+            match (label, name) with
+            | Nolabel, _ -> [ attribute ~loc:ghost_loc "mel.ignore" ]
+            | _, None -> []
+            | _, Some name ->
+                [
+                  attribute ~loc:ghost_loc "mel.as"
+                    ~payload:
+                      (PStr
+                         [
+                           pstr_eval ~loc:ghost_loc
+                             (estring ~loc:ghost_loc name)
+                             [];
+                         ]);
+                ]
+          in
+          ptyp_arrow ~loc:ghost_loc (make_label label)
+            { typ with ptyp_attributes = attributes }
+            result)
+        props props_type
+    in
+    let make_type =
+      ptyp_arrow ~loc:ghost_loc (Labelled "check") check_type make_type
+    in
+    let make =
+      value_description ~loc:ghost_loc
+        ~name:{ txt = "make"; loc = ghost_loc }
+        ~type_:make_type ~prim:[ "" ]
+    in
+    let make =
+      { make with pval_attributes = [ attribute ~loc:ghost_loc "mel.obj" ] }
+    in
+    let module_name = gen_symbol ~prefix:"Jsx_props" () in
+    let module_ =
+      pmod_structure ~loc:ghost_loc [ pstr_primitive ~loc:ghost_loc make ]
+    in
+    let call =
+      pexp_apply ~loc
+        (pexp_ident ~loc:ghost_loc
+           { txt = Ldot (Lident module_name, "make"); loc = ghost_loc })
+        ((Labelled "check", check)
+        :: List.map
+             (fun (label, expression) -> (make_label label, expression))
+             args)
+    in
+    pexp_letmodule ~loc:ghost_loc
+      { txt = Some module_name; loc = ghost_loc }
+      module_ call

ppx/reason_react_ppx.ml

@@ -620,7 +620,10 @@ let jsxMapper =
     let component = (nolabel, componentNameExpr)
     and props =
       ( nolabel,
-        Binding.ReactDOM.domProps ~applyLoc:parentExpLoc ~loc:callerLoc props )
+        Dom_props.make ~loc:parentExpLoc
+          ~dom_props:
+            (Binding.ReactDOM.domProps ~applyLoc:parentExpLoc ~loc:callerLoc)
+          props )
     in
     let loc = parentExpLoc in
     let gloc = { loc with loc_ghost = true } in

test/ReactDOMDataAttributes__test.re

@@ -0,0 +1,141 @@
+open Jest;
+open Jest.Expect;
+
+[@mel.send]
+external getAttribute: (Dom.element, string) => Js.nullable(string) =
+  "getAttribute";
+
+describe("ReactDOM data attributes", () => {
+  test("renders arbitrary camelCase names alongside ordinary props", () => {
+    let html =
+      ReactDOMServer.renderToStaticMarkup(
+        <div className="example" dataTestId="first" dataVersion2="v2">
+          <span dataFooBar="second" />
+        </div>,
+      );
+    expect(html)
+    ->toBe(
+        "<div class=\"example\" data-test-id=\"first\" data-version2=\"v2\"><span data-foo-bar=\"second\"></span></div>",
+      );
+  });
+
+  test("omits absent optional attributes", () => {
+    let render = dataFoo =>
+      ReactDOMServer.renderToStaticMarkup(<div ?dataFoo />);
+    expect(render(None))->toBe("<div></div>");
+    expect(render(Some("value")))->toBe("<div data-foo=\"value\"></div>");
+  });
+
+  test("updates and removes data attributes on the same DOM node", () => {
+    let element = (value, state) =>
+      <button dataValue=value dataState=?state />;
+    let container = ReactTestingLibrary.render(element("first", None));
+    let button =
+      ReactTestingLibrary.getByRole(~matcher=`Str("button"), container);
+    let attribute = name => getAttribute(button, name)->Js.Nullable.toOption;
+
+    expect(attribute("data-value"))->toEqual(Some("first"));
+    expect(attribute("data-state"))->toEqual(None);
+
+    ReactTestingLibrary.rerender(
+      element("second", Some("ready")),
+      container,
+    );
+    expect(attribute("data-value"))->toEqual(Some("second"));
+    expect(attribute("data-state"))->toEqual(Some("ready"));
+
+    ReactTestingLibrary.rerender(element("third", Some("")), container);
+    expect(attribute("data-state"))->toEqual(Some(""));
+
+    ReactTestingLibrary.rerender(element("last", None), container);
+    expect(attribute("data-value"))->toEqual(Some("last"));
+    expect(attribute("data-state"))->toEqual(None);
+    expect(
+      ReactTestingLibrary.getByRole(~matcher=`Str("button"), container),
+    )
+    ->toBe(button);
+  });
+
+  test("supports data attributes on SVG elements", () => {
+    let dataState = Some("ready");
+    let html =
+      ReactDOMServer.renderToStaticMarkup(
+        <svg viewBox="0 0 10 10" ?dataState>
+          <path strokeWidth="2" dataVersion2="v2" />
+        </svg>,
+      );
+    expect(html)
+    ->toBe(
+        "<svg viewBox=\"0 0 10 10\" data-state=\"ready\"><path stroke-width=\"2\" data-version2=\"v2\"></path></svg>",
+      );
+  });
+
+  test("preserves underscores in data attribute names", () => {
+    let html =
+      ReactDOMServer.renderToStaticMarkup(
+        <div dataFoo="plain" dataFoo__bar="double" dataFoo___="trailing" />,
+      );
+    expect(html)
+    ->toBe(
+        "<div data-foo=\"plain\" data-foo__bar=\"double\" data-foo___=\"trailing\"></div>",
+      );
+  });
+
+  test("preserves ordinary property renaming", () => {
+    let container =
+      ReactTestingLibrary.render(
+        <button type_="button" ariaLabel="label" dataFoo="value" />,
+      );
+    let button =
+      ReactTestingLibrary.getByRole(~matcher=`Str("button"), container);
+    let attribute = name => getAttribute(button, name)->Js.Nullable.toOption;
+    expect(attribute("type"))->toEqual(Some("button"));
+    expect(attribute("aria-label"))->toEqual(Some("label"));
+    expect(attribute("data-foo"))->toEqual(Some("value"));
+  });
+
+  test("evaluates each prop expression once", () => {
+    let evaluations = ref(0);
+    let next = value => {
+      incr(evaluations);
+      value;
+    };
+    let element =
+      <div className={next("class")} dataFoo={next("data")}>
+        {next("child")->React.string}
+      </div>;
+    expect(evaluations.contents)->toBe(3);
+    expect(ReactDOMServer.renderToStaticMarkup(element))
+    ->toBe("<div class=\"class\" data-foo=\"data\">child</div>");
+    expect(evaluations.contents)->toBe(3);
+  });
+
+  test("evaluates optional prop expressions once", () => {
+    let render = present => {
+      let evaluations = ref(0);
+      let next = value => {
+        incr(evaluations);
+        present ? Some(value) : None;
+      };
+      let element =
+        <div className=?{next("class")} dataFoo=?{next("data")} />;
+      expect(evaluations.contents)->toBe(2);
+      let html = ReactDOMServer.renderToStaticMarkup(element);
+      expect(evaluations.contents)->toBe(2);
+      html;
+    };
+    expect(render(false))->toBe("<div></div>");
+    expect(render(true))
+    ->toBe("<div class=\"class\" data-foo=\"data\"></div>");
+  });
+
+  test("evaluates the final unit argument once", () => {
+    let evaluations = ref(0);
+    let nextUnit = () => incr(evaluations);
+    let element = [@JSX] div(~dataFoo="value", nextUnit());
+    expect(evaluations.contents)->toBe(1);
+    expect(ReactDOMServer.renderToStaticMarkup(element))
+    ->toBe("<div data-foo=\"value\"></div>");
+    expect(evaluations.contents)->toBe(1);
+  });
+});