Skip to content

Commit ea9e76c

Browse files
mjambonclaude
mjambon
and
claude
authored
Add OCaml-to-jsonlike serializers and jsonlike-to-YAML converter (#504)
## Summary - Implements #502: atdml now generates `jsonlike_of_foo` and `Foo.to_jsonlike` functions for every ATD type, enabling serialization from OCaml values to `Atd_jsonlike.AST.t` - Implements #503: atd-yamlx gains `to_yamlx_value : Atd_jsonlike.AST.t -> YAMLx.value`, the reverse of the existing `of_yamlx_value` - Adds `Pos.zero` and `Loc.zero` to atd-jsonlike for constructing nodes programmatically without source location information ## Generated API (per ATD type `foo`) ```ocaml val jsonlike_of_foo : foo -> Atd_jsonlike.AST.t module Foo : sig type nonrec t = foo val of_jsonlike : Atd_jsonlike.AST.t -> t val to_jsonlike : t -> Atd_jsonlike.AST.t ... end ``` Generated nodes carry `Atd_jsonlike.Loc.zero` (no source location). ## Design notes - Adapter support: module-based adapters with `M.restore` are extended to call `M.restore_jsonlike` in the jsonlike writer path, mirroring how `M.normalize_jsonlike` extends `M.normalize` for the reader - The test for the `adapter` case now includes a `restore_jsonlike` function in `My_adapter.ml` - The `imports e2e` test's `Long.ml` now includes `jsonlike_of_tag` alongside `tag_of_jsonlike` - End-to-end tests verify the full writer round-trip: OCaml → jsonlike → OCaml → yojson must match the direct OCaml → yojson path ## Test plan - [x] `dune build` passes - [x] `cd atdml && ./test` — all 47 tests pass (44 pass, 3 xfail) - [x] `dune runtest atd-yamlx/` — all 5 tests pass (3 original + 2 new) - [x] `dune runtest atd-jsonlike/` — passes 🤖 Generated with [Claude Code](https://claude.com/claude-code) --------- Co-authored-by: Claude Sonnet 4.6 <noreply@anthropic.com>
1 parent 7008fea commit ea9e76c

36 files changed

Lines changed: 1590 additions & 371 deletions

‎CHANGES.md‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,19 @@
99
and a public `value` field of type `ArrayList<T>`. List aliases used as
1010
record fields or sum-variant payloads are also handled correctly.
1111

12+
* atdml: Generate `jsonlike_of_foo` serializer functions and `Foo.to_jsonlike`
13+
submodule bindings, completing the OCaml ↔ `Atd_jsonlike.AST.t` round-trip.
14+
JSON adapters are also supported: if the adapter module `M` provides
15+
`restore_jsonlike`, it is called after serialization by `jsonlike_of_foo`.
16+
17+
* atd-jsonlike: Add `Pos.zero` and `Loc.zero` — zero-position / zero-location
18+
constants useful for constructing `AST.t` nodes programmatically when source
19+
location information is not available.
20+
21+
* atd-yamlx: Add `to_yamlx_value : Atd_jsonlike.AST.t -> YAMLx.value`, the
22+
reverse of `of_yamlx_value`. Enables programmatic construction of YAML
23+
documents from ATD-typed OCaml values via `jsonlike_of_foo`.
24+
1225
4.1.0 (2026-04-11)
1326
------------------
1427

‎atd-jsonlike/src/Loc.ml‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,8 @@ type t = {
44
file: string option;
55
}
66

7+
let zero = { start = Pos.zero; end_ = Pos.zero; file = None }
8+
79
let equal a b =
810
Pos.equal a.start b.start
911
&& Pos.equal a.end_ b.end_

‎atd-jsonlike/src/Loc.mli‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,5 +14,8 @@ type t = {
1414
system. *)
1515
}
1616

17+
val zero : t
18+
(** A zero-length location at the beginning of the input with no file. *)
19+
1720
val equal : t -> t -> bool
1821
val compare : t -> t -> int

‎atd-jsonlike/src/Pos.ml‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,8 @@ type t = {
33
column: int;
44
}
55

6+
let zero = { row = 0; column = 0 }
7+
68
let equal a b = a.row = b.row && a.column = b.column
79

810
let compare a b =

‎atd-jsonlike/src/Pos.mli‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,5 +14,8 @@ type t = {
1414
(** position within the line, starting from 0 *)
1515
}
1616

17+
val zero : t
18+
(** Position at the start of an input: row 0, column 0. *)
19+
1720
val equal : t -> t -> bool
1821
val compare : t -> t -> int

‎atd-yamlx.opam‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -93,7 +93,7 @@ depends: [
9393
"dune" {>= "3.18"}
9494
"ocaml" {>= "4.14"}
9595
"atd-jsonlike" {= version}
96-
"yamlx" {>= "0.1.0"}
96+
"yamlx" {>= "0.2.0"}
9797
"testo" {>= "0.3.0" & with-test}
9898
"odoc" {with-doc}
9999
]

‎atd-yamlx/src/Atd_yamlx.ml‎

Lines changed: 26 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -30,7 +30,7 @@ let key_to_string ?file (key : YAMLx.value) : string =
3030
| String (_, s) -> s
3131
| Null loc | Bool (loc, _) | Int (loc, _) | Float (loc, _)
3232
| Seq (loc, _) | Map (loc, _) ->
33-
let loc_str = YAMLx.default_format_loc ?file loc in
33+
let loc_str = YAMLx.format_loc ?file loc in
3434
invalid_arg
3535
(loc_str ^ "map key must be a string; \
3636
pre-process the YAML document to convert non-string keys if needed")
@@ -60,3 +60,28 @@ let of_yamlx_value ?file v =
6060
match of_yamlx_value_exn ?file v with
6161
| result -> Ok result
6262
| exception Invalid_argument msg -> Error ("invalid argument: " ^ msg)
63+
64+
(* ===== Jsonlike → YAML conversion ===== *)
65+
66+
let rec to_yamlx_value (node : AST.t) : YAMLx.value =
67+
let loc = YAMLx.zero_loc in
68+
match node with
69+
| AST.Null _ -> YAMLx.Null loc
70+
| AST.Bool (_, b) -> YAMLx.Bool (loc, b)
71+
| AST.Number (_, n) ->
72+
(match n.Number.int with
73+
| Some i -> YAMLx.Int (loc, Int64.of_int i)
74+
| None ->
75+
match n.Number.float with
76+
| Some f -> YAMLx.Float (loc, f)
77+
| None ->
78+
match n.Number.literal with
79+
| Some s -> YAMLx.String (loc, s)
80+
| None -> YAMLx.Int (loc, 0L))
81+
| AST.String (_, s) -> YAMLx.String (loc, s)
82+
| AST.Array (_, items) -> YAMLx.Seq (loc, List.map to_yamlx_value items)
83+
| AST.Object (_, pairs) ->
84+
YAMLx.Map (loc,
85+
List.map (fun (_, k, v) ->
86+
(loc, YAMLx.String (loc, k), to_yamlx_value v))
87+
pairs)

‎atd-yamlx/src/Atd_yamlx.mli‎

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -57,3 +57,24 @@ val of_yamlx_value :
5757
[Error] when a YAML map has a non-string key. The error message includes
5858
the source location of the offending key. *)
5959
val of_yamlx_value_exn : ?file:string -> YAMLx.value -> Atd_jsonlike.AST.t
60+
61+
(** Convert an [Atd_jsonlike.AST.t] to a [YAMLx.value].
62+
63+
This is the reverse of {!of_yamlx_value_exn}. Source locations in the
64+
input are ignored; the resulting [YAMLx.value] nodes all carry
65+
{!YAMLx.zero_loc}.
66+
67+
{1 Jsonlike–YAML type correspondence}
68+
69+
| Jsonlike (atd-jsonlike) | YAML (yamlx) |
70+
|---------------------------|-----------------------------------|
71+
| [Null] | [Null] |
72+
| [Bool] | [Bool] |
73+
| [Number] (int available) | [Int] (int64) |
74+
| [Number] (float only) | [Float] |
75+
| [Number] (literal only) | [String] (verbatim literal) |
76+
| [String] | [String] |
77+
| [Array] | [Seq] |
78+
| [Object] | [Map] (string keys) |
79+
*)
80+
val to_yamlx_value : Atd_jsonlike.AST.t -> YAMLx.value

‎atd-yamlx/tests/test.ml‎

Lines changed: 54 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -74,6 +74,58 @@ tags: []
7474
in
7575
Testo.check ast_t expected result
7676

77+
(* Round-trip: parse YAML → jsonlike → YAMLx.value → compare against original. *)
78+
let test_to_yamlx_value () =
79+
let yaml_str = {|
80+
answer: 42
81+
flag: true
82+
greeting: "hello"
83+
nothing: null
84+
scores:
85+
- 1
86+
- 2
87+
- 3
88+
|} in
89+
match YAMLx.Values.of_yaml yaml_str with
90+
| Error msg -> failwith ("YAMLx parse error: " ^ msg)
91+
| Ok [orig_val] ->
92+
let jsonlike = Atd_yamlx.of_yamlx_value_exn orig_val in
93+
let round_tripped = Atd_yamlx.to_yamlx_value jsonlike in
94+
(* Re-convert back to jsonlike and compare (ignoring locations) *)
95+
let jsonlike2 = Atd_yamlx.of_yamlx_value_exn round_tripped in
96+
if not (AST.equal jsonlike jsonlike2) then
97+
failwith (Printf.sprintf
98+
"Round-trip mismatch!\nOriginal:\n%s\nRound-tripped:\n%s\n"
99+
(AST.show jsonlike) (AST.show jsonlike2))
100+
| Ok _ -> failwith "expected exactly one YAML document"
101+
102+
(* to_yamlx_value handles all scalar types correctly. *)
103+
let test_to_yamlx_value_scalars () =
104+
let no_loc = Loc.{ start = Pos.{row=0;column=0}; end_ = Pos.{row=0;column=0}; file=None } in
105+
let check node expected_yaml_str =
106+
let yaml_val = Atd_yamlx.to_yamlx_value node in
107+
let yaml_str = YAMLx.Values.to_yaml [yaml_val] in
108+
let reparsed =
109+
match YAMLx.Values.of_yaml yaml_str with
110+
| Ok [v] -> v
111+
| _ -> failwith ("Could not reparse: " ^ yaml_str)
112+
in
113+
let jsonlike2 = Atd_yamlx.of_yamlx_value_exn reparsed in
114+
if not (AST.equal node jsonlike2) then
115+
failwith (Printf.sprintf "Expected YAML %s but round-trip gave: %s"
116+
expected_yaml_str (AST.show jsonlike2))
117+
in
118+
check (AST.Null no_loc) "null";
119+
check (AST.Bool (no_loc, true)) "true";
120+
check (AST.Bool (no_loc, false)) "false";
121+
check (AST.Number (no_loc, Number.of_int 42)) "42";
122+
check (AST.Number (no_loc, Number.of_float 3.14)) "3.14";
123+
check (AST.String (no_loc, "hello")) "\"hello\"";
124+
check (AST.Array (no_loc, [
125+
AST.Number (no_loc, Number.of_int 1);
126+
AST.Number (no_loc, Number.of_int 2);
127+
])) "[1, 2]"
128+
77129
(* A non-string map key should return an Error. *)
78130
let test_non_string_key_error () =
79131
let yaml_str = {|
@@ -95,6 +147,8 @@ let tests _env = [
95147
Testo.create "basic document: scalars, bool, null, sequence" test_basic_document;
96148
Testo.create "nested maps, float, empty sequence" test_nested;
97149
Testo.create "non-string map key returns Error" test_non_string_key_error;
150+
Testo.create "to_yamlx_value: round-trip via YAML" test_to_yamlx_value;
151+
Testo.create "to_yamlx_value: scalar types" test_to_yamlx_value_scalars;
98152
]
99153

100154
let () =

0 commit comments

Comments
 (0)