atdml: support <ocaml attr=...> on record fields, variant constructors, and payloads

CHANGES.md

@@ -1,4 +1,5 @@
 4.1.1 (unreleased)
+
 ------------------
 
 * atdj: Top-level list aliases such as `type items = item list` are now
@@ -8,6 +9,9 @@
   package-private constructor from `JSONArray`, `toJsonBuffer`, `toJson`,
   and a public `value` field of type `ArrayList<T>`. List aliases used as
   record fields or sum-variant payloads are also handled correctly.
+* atdml: Add support for `<ocaml attr="...">` on record fields, variant constructors,
+  and variant payload types to attach ppx attributes (e.g. `[@deriving.ord.ignore]`)
+
 
 4.1.0 (2026-04-11)
 ------------------

atdgen/src/ocaml.ml

@@ -167,11 +167,14 @@ let annot_schema_ocaml : Atd.Annot.schema_section =
       Type_expr, "validator";
       Type_expr, "wrap";
       Variant, "name";
+      Variant, "attr";
+      Type_expr, "attr";
       Cell, "default";
       Field, "default";
       Field, "mutable";
       Field, "name";
       Field, "repr";
+      Field, "attr";
     ]
   }
 
@@ -398,6 +401,27 @@ let get_type_attrs an =
     ~field:"attr"
     an
 
+let get_field_attrs an =
+  Atd.Annot.get_fields
+    ~parse:(fun s -> Some s)
+    ~sections:["ocaml"]
+    ~field:"attr"
+    an
+
+let get_variant_attrs an =
+  Atd.Annot.get_fields
+    ~parse:(fun s -> Some s)
+    ~sections:["ocaml"]
+    ~field:"attr"
+    an
+
+let get_payload_attrs e =
+  Atd.Annot.get_fields
+    ~parse:(fun s -> Some s)
+    ~sections:["ocaml"]
+    ~field:"attr"
+    (Atd.Ast.annot_of_type_expr e)
+
 (*
   OCaml syntax tree
 *)
@@ -413,9 +437,11 @@ type ocaml_expr =
 
 and ocaml_variant =
     string * ocaml_expr option * Atd.Doc.doc option
+    * string list (* cons attrs *) * string list (* payload attrs *)
 
 and ocaml_field =
     (string * bool (* is mutable? *)) * ocaml_expr * Atd.Doc.doc option
+    * string list (* attrs *)
 
 (*
    OCaml type definition:
@@ -499,7 +525,13 @@ and map_variant ~kind target (x : variant) : ocaml_variant =
         "Inline records are not allowed in polymorphic variants (not valid in OCaml)"
   | _, Variant (loc, (s, an), o) ->
       let s = get_ocaml_cons target s an in
-      (s, Option.map (map_expr target []) o, Atd.Doc.get_doc loc an)
+      let cons_attrs = get_variant_attrs an in
+      let payload_attrs = match o with
+        | None -> []
+        | Some e -> get_payload_attrs e
+      in
+      (s, Option.map (map_expr target []) o, Atd.Doc.get_doc loc an,
+       cons_attrs, payload_attrs)
 
 and map_field target ocaml_field_prefix (x : field) : ocaml_field =
   match x with
@@ -516,7 +548,9 @@ and map_field target ocaml_field_prefix (x : field) : ocaml_field =
         else sprintf "%s (*atd %s *)" ocaml_fname atd_fname
       in
       let is_mutable = get_ocaml_mutable target an in
-      ((fname, is_mutable), map_expr target [] x, Atd.Doc.get_doc loc an)
+      let field_attrs = get_field_attrs an in
+      ((fname, is_mutable), map_expr target [] x, Atd.Doc.get_doc loc an,
+       field_attrs)
 
 
 (* hack to deal with legacy behavior *)
@@ -683,7 +717,7 @@ and ocaml_of_variant_mapping x =
         Variant o -> o
       | _ -> assert false
   in
-  (o.ocaml_cons, Option.map ocaml_of_expr_mapping x.var_arg, o.ocaml_vdoc)
+  (o.ocaml_cons, Option.map ocaml_of_expr_mapping x.var_arg, o.ocaml_vdoc, [], [])
 
 and ocaml_of_field_mapping x =
   let o =
@@ -692,7 +726,7 @@ and ocaml_of_field_mapping x =
       | _ -> assert false
   in
   let v = ocaml_of_expr_mapping x.f_value in
-  ((o.ocaml_fname, o.ocaml_mutable), v, o.ocaml_fdoc)
+  ((o.ocaml_fname, o.ocaml_mutable), v, o.ocaml_fdoc, [])
 
 
 (*
@@ -960,7 +994,7 @@ and format_type_expr x =
 and format_type_name name args =
   horizontal_sequence (prepend_type_args args [ make_atom name ])
 
-and format_field ((s, is_mutable), t, doc) =
+and format_field ((s, is_mutable), t, doc, attrs) =
   let l =
     let l = [make_atom (s ^ ":")] in
     if is_mutable then
@@ -973,22 +1007,49 @@ and format_field ((s, is_mutable), t, doc) =
       format_type_expr t
     )
   in
-  append_ocamldoc_comment field doc
+  let field_with_attrs =
+    match attrs with
+    | [] -> field
+    | _ ->
+        let attrs_str =
+          List.map (fun a -> sprintf "[@%s]" a) attrs |> String.concat ""
+        in
+        Label ((field, label), make_atom attrs_str)
+  in
+  append_ocamldoc_comment field_with_attrs doc
 
-and format_variant kind (s, o, doc) =
+and format_variant kind (s, o, doc, cons_attrs, payload_attrs) =
   let s = tick kind ^ s in
   let cons = make_atom s in
+  let attrs_str attrs =
+    List.map (fun a -> sprintf "[@%s]" a) attrs |> String.concat ""
+  in
+  let format_payload t =
+    match payload_attrs with
+    | [] -> format_type_expr t
+    | _ ->
+        Easy_format.List (
+          ("(", "", ")", shlist),
+          [format_type_expr t; make_atom (attrs_str payload_attrs)]
+        )
+  in
   let variant =
     match o with
-        None -> cons
-      | Some t ->
+    | None ->
+        if cons_attrs = [] then cons
+        else Label ((cons, label), make_atom (attrs_str cons_attrs))
+    | Some t ->
+        let with_payload =
           Label (
             (cons, label),
             Label (
               (make_atom "of", label),
-              format_type_expr t
+              format_payload t
             )
           )
+        in
+        if cons_attrs = [] then with_payload
+        else Label ((with_payload, label), make_atom (attrs_str cons_attrs))
   in
   append_ocamldoc_comment variant doc
 

atdgen/test/test_ppx.atd

@@ -1,3 +1,16 @@
 type t <ocaml attr="deriving show,eq" attr="ocamlformat \"disable\""> = {
   v: int;
+  w: string <ocaml attr="compare.ignore">;
 }
+
+type status = [
+  | Active <ocaml attr="deriving.ord.ignore">
+  | Pending of int <ocaml attr="deriving.ord.ignore">
+  | Inactive
+]
+
+type poly_status = [
+  | Active <ocaml attr="deriving.ord.ignore">
+  | Pending of int <ocaml attr="deriving.ord.ignore">
+  | Inactive
+] <ocaml repr="poly">

atdml/src/lib/Codegen.ml

@@ -55,6 +55,9 @@ let annot_schema_ocaml : Atd.Annot.schema_section = {
     Import, "name";            (* <ocaml name="..."> on an import: override OCaml alias *)
     Imported_type, "name";    (* <ocaml name="..."> on an imported type: override type name *)
     Variant, "name";      (* <ocaml name="..."> on a variant constructor *)
+    Variant, "attr";      (* <ocaml attr="..."> on a variant constructor: append [@...] *)
+    Type_expr, "attr";    (* <ocaml attr="..."> on a variant payload type: append [@...] *)
+    Field, "attr";        (* <ocaml attr="..."> on a field: append [@...] *)
     Field, "default";     (* <ocaml default="..."> on a with-default field *)
     Field, "name";        (* <ocaml name="..."> on a field: not supported, warns *)
   ]
@@ -210,6 +213,30 @@ let get_ocaml_attr an =
     ~field:"attr"
     an
 
+(* Get <ocaml attr="..."> for a field; value is placed inside [@...] *)
+let get_ocaml_field_attr an =
+  Atd.Annot.get_opt_field
+    ~parse:(fun s -> Some s)
+    ~sections:["ocaml"]
+    ~field:"attr"
+    an
+
+(* Get <ocaml attr="..."> for a variant constructor; value is placed inside [@...] *)
+let get_ocaml_variant_attr an =
+  Atd.Annot.get_opt_field
+    ~parse:(fun s -> Some s)
+    ~sections:["ocaml"]
+    ~field:"attr"
+    an
+
+(* Get <ocaml attr="..."> for a variant payload type expression; value is placed inside [@...] *)
+let get_ocaml_payload_attr e =
+  Atd.Annot.get_opt_field
+    ~parse:(fun s -> Some s)
+    ~sections:["ocaml"]
+    ~field:"attr"
+    (Atd.Ast.annot_of_type_expr e)
+
 (* Get wrap-related annotations for a 'wrap' type expression.
    Supports:
      <ocaml module="M">              → uses M.t, M.wrap, M.unwrap
@@ -875,12 +902,21 @@ let gen_type_def ~is_mli env ({A.loc; name; param=params; annot=an; value=e; _}
       in
       let gen_case (loc, orig_name, an, opt_e) =
         let cons_name = vtr (get_ocaml_name orig_name an) in
+        let cons_attr = match get_ocaml_variant_attr an with
+          | None -> ""
+          | Some attr -> sprintf " [@%s]" attr
+        in
         match opt_e with
         | None ->
-            with_inline_doc (sprintf "| %s%s" tick cons_name) loc an
+            with_inline_doc (sprintf "| %s%s%s" tick cons_name cons_attr) loc an
         | Some e ->
+            let payload_str =
+              match get_ocaml_payload_attr e with
+              | None -> type_expr_str env e
+              | Some attr -> sprintf "(%s [@%s])" (type_expr_str env e) attr
+            in
             with_inline_doc
-              (sprintf "| %s%s of %s" tick cons_name (type_expr_str env e))
+              (sprintf "| %s%s of %s%s" tick cons_name payload_str cons_attr)
               loc an
       in
       let hd =
@@ -917,8 +953,12 @@ let gen_type_def ~is_mli env ({A.loc; name; param=params; annot=an; value=e; _}
         B.Block
           (concat_map
              (fun (loc, (fname, _, an), e) ->
+               let field_attr = match get_ocaml_field_attr an with
+                 | None -> ""
+                 | Some attr -> sprintf " [@%s]" attr
+               in
                with_inline_doc
-                 (sprintf "%s: %s;" (pftr fname) (type_expr_str env e))
+                 (sprintf "%s: %s%s;" (pftr fname) (type_expr_str env e) field_attr)
                  loc an)
              fields);
         B.Line "}";

atdml/tests/named-snapshots/attr

@@ -2,7 +2,7 @@
 
 type point = {
   x: float;
-  y: float;
+  y: float option [@option];
 }
 [@@deriving show]
 
@@ -191,7 +191,7 @@ end
 
 type point = {
   x: float;
-  y: float;
+  y: float option [@option];
 }
 [@@deriving show]