From 11936589d8b16b611b7ce80bdc0dfc6fca5e4763 Mon Sep 17 00:00:00 2001
From: Antonio Nuno Monteiro <anmonteiro@gmail.com>
Date: Sun, 27 Sep 2026 22:17:39 -0700
Subject: [PATCH] Support data-* attributes in DOM JSX

---
 ppx/dom_props.ml                              | 176 ++++++++++++++
 ppx/reason_react_ppx.ml                       |   5 +-
 test/ReactDOM__test.re                        |  50 ++++
 .../data-attributes.t/input.re.in             |  43 ++++
 test/blackbox-tests/data-attributes.t/run.t   | 217 ++++++++++++++++++
 test/blackbox-tests/dune                      |   3 +-
 test/dune                                     |   1 +
 7 files changed, 493 insertions(+), 2 deletions(-)
 create mode 100644 ppx/dom_props.ml
 create mode 100644 test/blackbox-tests/data-attributes.t/input.re.in
 create mode 100644 test/blackbox-tests/data-attributes.t/run.t

diff --git a/ppx/dom_props.ml b/ppx/dom_props.ml
new file mode 100644
index 000000000..ec00b4b67
--- /dev/null
+++ b/ppx/dom_props.ml
@@ -0,0 +1,176 @@
+open Ppxlib
+open Ast_builder.Default
+
+let attribute ~loc name payload =
+  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 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 unit_type =
+      ptyp_constr ~loc:ghost_loc { txt = Lident "unit"; loc } []
+    in
+    let props_type =
+      ptyp_constr ~loc:ghost_loc
+        { txt = Ldot (Lident "ReactDOM", "domProps"); loc }
+        []
+    in
+    let props =
+      List.mapi
+        (fun index (label, expression) ->
+          let name = "prop" ^ string_of_int index in
+          let data_name = data_attribute (label_name label) in
+          let type_ =
+            match (label, data_name) with
+            | Nolabel, _ -> unit_type
+            | _, Some _ ->
+                ptyp_constr ~loc:ghost_loc { txt = Lident "string"; loc } []
+            | _, None -> ptyp_var ~loc:ghost_loc name
+          in
+          (label, expression, name, type_, data_name))
+        args
+    in
+    let ordinary_props =
+      List.filter (fun (_, _, _, _, data_name) -> data_name = None) props
+    in
+    let arrow (label, _, _, type_, _) result =
+      ptyp_arrow ~loc:ghost_loc label type_ 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 = List.fold_right arrow ordinary_props props_type in
+    let check_type =
+      {
+        check_type with
+        ptyp_attributes = [ attribute ~loc:ghost_loc "mel.ignore" (PStr []) ];
+      }
+    in
+    let check_args =
+      List.map
+        (fun (label, expression, name, _, _) ->
+          let loc = { expression.pexp_loc with loc_ghost = true } in
+          let arg =
+            match label with
+            | Nolabel -> pexp_construct ~loc { txt = Lident "()"; loc } None
+            | Labelled _ | Optional _ ->
+                pexp_ident ~loc { txt = Lident name; loc }
+          in
+          (label, arg))
+        ordinary_props
+    in
+    let check =
+      List.fold_right
+        (fun (label, _, name, _, _) body ->
+          let pattern =
+            match label with
+            | Nolabel ->
+                ppat_construct ~loc:ghost_loc { txt = Lident "()"; loc } None
+            | Labelled _ | Optional _ ->
+                ppat_var ~loc:ghost_loc { txt = name; loc = ghost_loc }
+          in
+          pexp_fun ~loc:ghost_loc label None pattern body)
+        ordinary_props (dom_props check_args)
+    in
+    let check =
+      {
+        check with
+        pexp_attributes = [ attribute ~loc:ghost_loc "merlin.hide" (PStr []) ];
+      }
+    in
+    let make_type =
+      List.fold_right
+        (fun (label, _, _, type_, data_name) result ->
+          let name =
+            match data_name with
+            | Some _ -> data_name
+            | None -> js_name (label_name label)
+          in
+          let type_ =
+            match name with
+            | None -> type_
+            | Some name ->
+                {
+                  type_ with
+                  ptyp_attributes =
+                    [
+                      attribute ~loc:ghost_loc "mel.as"
+                        (PStr
+                           [
+                             pstr_eval ~loc:ghost_loc
+                               (estring ~loc:ghost_loc name)
+                               [];
+                           ]);
+                    ];
+                }
+          in
+          ptyp_arrow ~loc:ghost_loc label type_ 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" (PStr []) ];
+      }
+    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) :: args)
+    in
+    pexp_letmodule ~loc:ghost_loc
+      { txt = Some module_name; loc = ghost_loc }
+      module_ call
diff --git a/ppx/reason_react_ppx.ml b/ppx/reason_react_ppx.ml
index 1f5f4d24e..0167052a9 100644
--- a/ppx/reason_react_ppx.ml
+++ b/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
diff --git a/test/ReactDOM__test.re b/test/ReactDOM__test.re
index 7d82ad6eb..fbd6b684c 100644
--- a/test/ReactDOM__test.re
+++ b/test/ReactDOM__test.re
@@ -13,6 +13,56 @@ module Stream = {
 };
 
 describe("ReactDOM", () => {
+  describe("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("preserves ordinary property renaming", () => {
+      let html =
+        ReactDOMServer.renderToStaticMarkup(
+          <button type_="button" ariaLabel="label" dataFoo="value" />,
+        );
+      expect(html)
+      ->toBe(
+          "<button type=\"button\" aria-label=\"label\" data-foo=\"value\"></button>",
+        );
+    });
+
+    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);
+    });
+  });
+
   describe("ReactDOM.Server", () => {
     test("renderToString", () => {
       let string =
diff --git a/test/blackbox-tests/data-attributes.t/input.re.in b/test/blackbox-tests/data-attributes.t/input.re.in
new file mode 100644
index 000000000..075717df9
--- /dev/null
+++ b/test/blackbox-tests/data-attributes.t/input.re.in
@@ -0,0 +1,43 @@
+let first = <div className="first" dataFoo="one" />;
+let second = <div id="second" dataBar="two" dataTestId="three" />;
+let onlyData = <div dataFoo="one" />;
+let ordinaryData = <object data="file" datatype="text" dataTestId="object" />;
+
+let optional = (~className=?, ~dataFoo=?, ()) => <div ?className ?dataFoo />;
+
+let renamed =
+  <div
+    dataTestId="aliases"
+    ariaLabel="label"
+    ariaActivedescendant="descendant"
+    as_="button"
+    begin_="0"
+    end_="1"
+    in_="source"
+    open_=true
+    to_="target"
+    type_="button"
+  />;
+
+let withChildren =
+  <div key="parent" dataTestId="parent">
+    <span dataFoo="child" />
+    <span />
+  </div>;
+
+let withRefAndEvent = (elementRef, handleClick) =>
+  <button ref=elementRef onClick=handleClick dataTestId="button" />;
+
+let optionalKey = (~key=?, ()) => <div ?key dataFoo="keyed" />;
+
+module Component = {
+  [@react.component]
+  let make = (~dataFoo) => <div dataFoo />;
+};
+
+let component = <Component dataFoo="component" />;
+
+external next: string => string = "next";
+let effects = <div className={next("class")} dataFoo={next("data")} />;
+
+let ordinary = <div className="unchanged" />;
diff --git a/test/blackbox-tests/data-attributes.t/run.t b/test/blackbox-tests/data-attributes.t/run.t
new file mode 100644
index 000000000..87c62c5a6
--- /dev/null
+++ b/test/blackbox-tests/data-attributes.t/run.t
@@ -0,0 +1,217 @@
+DOM data attributes use a constructor for each JSX occurrence, with ordinary
+props checked against ReactDOM.domProps and no runtime validation callback.
+
+  $ cat > dune-project <<EOF
+  > (lang dune 3.8)
+  > (using melange 0.1)
+  > EOF
+
+  $ cat > dune <<EOF
+  > (melange.emit
+  >  (target output)
+  >  (alias mel)
+  >  (emit_stdlib false)
+  >  (libraries reason-react)
+  >  (preprocess (pps melange.ppx reason-react-ppx)))
+  > EOF
+
+  $ cp input.re.in input.re
+  $ chmod u+w input.re
+  $ dune build @mel
+
+  $ cat _build/default/output/input.js
+  // Generated by Melange
+  'use strict';
+  
+  const Caml_option = require("melange.js/caml_option.js");
+  const JsxRuntime = require("react/jsx-runtime");
+  
+  const first = JsxRuntime.jsx("div", {
+    className: "first",
+    "data-foo": "one"
+  });
+  
+  const second = JsxRuntime.jsx("div", {
+    id: "second",
+    "data-bar": "two",
+    "data-test-id": "three"
+  });
+  
+  const onlyData = JsxRuntime.jsx("div", {
+    "data-foo": "one"
+  });
+  
+  const ordinaryData = JsxRuntime.jsx("object", {
+    data: "file",
+    datatype: "text",
+    "data-test-id": "object"
+  });
+  
+  function optional(className, dataFoo, param) {
+    let tmp = {};
+    if (className !== undefined) {
+      tmp.className = Caml_option.valFromOption(className);
+    }
+    if (dataFoo !== undefined) {
+      tmp["data-foo"] = Caml_option.valFromOption(dataFoo);
+    }
+    return JsxRuntime.jsx("div", tmp);
+  }
+  
+  const renamed = JsxRuntime.jsx("div", {
+    "data-test-id": "aliases",
+    "aria-label": "label",
+    "aria-activedescendant": "descendant",
+    as: "button",
+    begin: "0",
+    end: "1",
+    in: "source",
+    open: true,
+    to: "target",
+    type: "button"
+  });
+  
+  const withChildren = JsxRuntime.jsxs("div", {
+    children: [
+      JsxRuntime.jsx("span", {
+        "data-foo": "child"
+      }),
+      JsxRuntime.jsx("span", {})
+    ],
+    "data-test-id": "parent"
+  }, "parent");
+  
+  function withRefAndEvent(elementRef, handleClick) {
+    return JsxRuntime.jsx("button", {
+      ref: elementRef,
+      onClick: handleClick,
+      "data-test-id": "button"
+    });
+  }
+  
+  function optionalKey(key, param) {
+    return JsxRuntime.jsx("div", {
+      "data-foo": "keyed"
+    }, key !== undefined ? Caml_option.valFromOption(key) : undefined);
+  }
+  
+  function Input$Component(Props) {
+    let dataFoo = Props.dataFoo;
+    return JsxRuntime.jsx("div", {
+      "data-foo": dataFoo
+    });
+  }
+  
+  const Component = {
+    make: Input$Component
+  };
+  
+  const component = JsxRuntime.jsx(Input$Component, {
+    dataFoo: "component"
+  });
+  
+  const effects = JsxRuntime.jsx("div", {
+    className: next("class"),
+    "data-foo": next("data")
+  });
+  
+  const ordinary = JsxRuntime.jsx("div", {
+    className: "unchanged"
+  });
+  
+  module.exports = {
+    first,
+    second,
+    onlyData,
+    ordinaryData,
+    optional,
+    renamed,
+    withChildren,
+    withRefAndEvent,
+    optionalKey,
+    Component,
+    component,
+    effects,
+    ordinary,
+  }
+  /* first Not a pure module */
+
+Ordinary prop types are still checked.
+
+  $ cat > input.re <<EOF
+  > let element = <div className=42 dataFoo="x" />;
+  > EOF
+  $ dune build @mel
+  File "input.re", line 1, characters 29-31:
+  1 | let element = <div className=42 dataFoo="x" />;
+                                   ^^
+  Error: The constant 42 has type int but an expression was expected of type
+           string
+  [1]
+
+Data attribute values must be strings.
+
+  $ cat > input.re <<EOF
+  > let element = <div dataFoo=42 />;
+  > EOF
+  $ dune build @mel
+  File "input.re", line 1, characters 27-29:
+  1 | let element = <div dataFoo=42 />;
+                                 ^^
+  Error: The constant 42 has type int but an expression was expected of type
+           string
+  [1]
+
+Optional data attribute values are checked too.
+
+  $ cat > input.re <<EOF
+  > let element = <div dataFoo=?Some(42) />;
+  > EOF
+  $ dune build @mel
+  File "input.re", line 1, characters 33-35:
+  1 | let element = <div dataFoo=?Some(42) />;
+                                       ^^
+  Error: The constant 42 has type int but an expression was expected of type
+           string
+  [1]
+
+Renamed ordinary props retain their original types.
+
+  $ cat > input.re <<EOF
+  > let element = <div open_="yes" dataFoo="x" />;
+  > EOF
+  $ dune build @mel
+  File "input.re", line 1, characters 25-30:
+  1 | let element = <div open_="yes" dataFoo="x" />;
+                               ^^^^^
+  Error: This constant has type string but an expression was expected of type
+           bool
+  [1]
+
+Unknown ordinary props still fail. Only show the final diagnostic, since the
+constructor's list of valid props is long.
+
+  $ cat > input.re <<EOF
+  > let element = <div clasName="typo" dataFoo="x" />;
+  > EOF
+  $ dune build @mel 2>&1 | tail -n 2
+           ?suppressHydrationWarning:bool -> ReactDOM.domProps
+  This argument cannot be applied with label ~clasName
+
+Component props do not acquire special data attribute handling.
+
+  $ cat > input.re <<EOF
+  > module Component = {
+  >   [@react.component]
+  >   let make = () => React.null;
+  > };
+  > let element = <Component dataFoo="x" />;
+  > EOF
+  $ dune build @mel
+  File "input.re", line 5, characters 33-36:
+  5 | let element = <Component dataFoo="x" />;
+                                       ^^^
+  Error: The function applied to this argument has type
+           ?key:string -> <  > Js.t
+  This argument cannot be applied with label ~dataFoo
+  [1]
diff --git a/test/blackbox-tests/dune b/test/blackbox-tests/dune
index 83224c3c1..8840bbc51 100644
--- a/test/blackbox-tests/dune
+++ b/test/blackbox-tests/dune
@@ -1,4 +1,5 @@
 (cram
  (package reason-react)
  (deps
-  (package reason-react)))
+  (package reason-react)
+  (package reason-react-ppx)))
diff --git a/test/dune b/test/dune
index 0dde05c81..be549402e 100644
--- a/test/dune
+++ b/test/dune
@@ -1,6 +1,7 @@
 (melange.emit
  (alias runtest)
  (target test)
+ (package reason-react)
  (module_systems
   (commonjs bs.js))
  (libraries