Merge pull request #311 from ahrefs/mj-yojson2

Adapt to use Yojson 2.0 API (retry #299)

Author: mjambon

CHANGES.md

@@ -1,10 +1,10 @@
 Master
 ------------------
 
-* atdpy: Support recursive definitions
+* atdgen: use Yojson 2.0 API (#299)
+* atdpy: Support recursive definitions (#315)
 * atdts: fix nullable object field writer (#312)
 
-
 2.9.1 (2022-06-10)
 ------------------
 

atdcat/test/schema-draft-2019-09.expected.json

@@ -1,17 +1,15 @@
 {
   "$schema": "https://json-schema.org/draft/2019-09/schema",
   "title": "root",
-  "description":
-    "Translated by atdcat from 'schema.atd'.\n\nThis is the title. Here's a code block:\n\n{{{\nthis is line 1\nthis is line 2\n}}}\n\nThis is the root object. For example, the empty object {{ {} }} is invalid.",
+  "description": "Translated by atdcat from 'schema.atd'.\n\nThis is the title. Here's a code block:\n\n{{{\nthis is line 1\nthis is line 2\n}}}\n\nThis is the root object. For example, the empty object {{ {} }} is invalid.",
   "type": "object",
   "required": [
     "ID", "items", "aliased", "point", "kinds", "assoc1", "assoc2"
   ],
   "properties": {
     "ID": { "description": "This is the 'id' field.", "type": "string" },
     "items": {
-      "description":
-        "An example of JSON value is {{[[1, 2], [3], [4, 5, 6]]}}",
+      "description": "An example of JSON value is {{[[1, 2], [3], [4, 5, 6]]}}",
       "type": "array",
       "items": { "type": "array", "items": { "type": "integer" } }
     },

atdcat/test/schema-no-xprop.expected.json

@@ -1,8 +1,7 @@
 {
   "$schema": "https://json-schema.org/draft/2020-12/schema",
   "title": "root",
-  "description":
-    "Translated by atdcat from 'schema.atd'.\n\nThis is the title. Here's a code block:\n\n{{{\nthis is line 1\nthis is line 2\n}}}\n\nThis is the root object. For example, the empty object {{ {} }} is invalid.",
+  "description": "Translated by atdcat from 'schema.atd'.\n\nThis is the title. Here's a code block:\n\n{{{\nthis is line 1\nthis is line 2\n}}}\n\nThis is the root object. For example, the empty object {{ {} }} is invalid.",
   "type": "object",
   "required": [
     "ID", "items", "aliased", "point", "kinds", "assoc1", "assoc2"
@@ -11,8 +10,7 @@
   "properties": {
     "ID": { "description": "This is the 'id' field.", "type": "string" },
     "items": {
-      "description":
-        "An example of JSON value is {{[[1, 2], [3], [4, 5, 6]]}}",
+      "description": "An example of JSON value is {{[[1, 2], [3], [4, 5, 6]]}}",
       "type": "array",
       "items": { "type": "array", "items": { "type": "integer" } }
     },

atdcat/test/schema.expected.json

@@ -1,17 +1,15 @@
 {
   "$schema": "https://json-schema.org/draft/2020-12/schema",
   "title": "root",
-  "description":
-    "Translated by atdcat from 'schema.atd'.\n\nThis is the title. Here's a code block:\n\n{{{\nthis is line 1\nthis is line 2\n}}}\n\nThis is the root object. For example, the empty object {{ {} }} is invalid.",
+  "description": "Translated by atdcat from 'schema.atd'.\n\nThis is the title. Here's a code block:\n\n{{{\nthis is line 1\nthis is line 2\n}}}\n\nThis is the root object. For example, the empty object {{ {} }} is invalid.",
   "type": "object",
   "required": [
     "ID", "items", "aliased", "point", "kinds", "assoc1", "assoc2"
   ],
   "properties": {
     "ID": { "description": "This is the 'id' field.", "type": "string" },
     "items": {
-      "description":
-        "An example of JSON value is {{[[1, 2], [3], [4, 5, 6]]}}",
+      "description": "An example of JSON value is {{[[1, 2], [3], [4, 5, 6]]}}",
       "type": "array",
       "items": { "type": "array", "items": { "type": "integer" } }
     },

atdgen-runtime.opam

@@ -65,9 +65,8 @@ bug-reports: "https://github.com/ahrefs/atd/issues"
 depends: [
   "dune" {>= "2.8"}
   "ocaml" {>= "4.08"}
-  "yojson" {>= "1.7.0" & < "2.0.0"}
+  "yojson" {>= "2.0.2"}
   "biniou" {>= "1.0.6"}
-  "camlp-streams"
   "odoc" {with-doc}
 ]
 dev-repo: "git+https://github.com/ahrefs/atd.git"

atdgen-runtime/src/dune

@@ -1,4 +1,4 @@
 (library
  (name atdgen_runtime)
  (public_name atdgen-runtime)
- (libraries biniou yojson camlp-streams))
+ (libraries biniou yojson))

atdgen-runtime/src/oj_run.ml

@@ -4,7 +4,7 @@
 
 open Printf
 
-type 'a write = Bi_outbuf.t -> 'a -> unit
+type 'a write = Buffer.t -> 'a -> unit
 
 exception Error of string
 
@@ -47,67 +47,67 @@ let array_iter f sep x a =
   )
 
 let write_comma ob =
-  Bi_outbuf.add_char ob ','
+  Buffer.add_char ob ','
 
 let write_list write_item ob l =
-  Bi_outbuf.add_char ob '[';
+  Buffer.add_char ob '[';
   list_iter write_item write_comma ob l;
-  Bi_outbuf.add_char ob ']'
+  Buffer.add_char ob ']'
 
 let write_array write_item ob a =
-  Bi_outbuf.add_char ob '[';
+  Buffer.add_char ob '[';
   array_iter write_item write_comma ob a;
-  Bi_outbuf.add_char ob ']'
+  Buffer.add_char ob ']'
 
 let write_assoc_list write_key write_item ob l =
-  Bi_outbuf.add_char ob '{';
+  Buffer.add_char ob '{';
   list_iter (
     fun ob (k, v) ->
       write_key ob k;
-      Bi_outbuf.add_char ob ':';
+      Buffer.add_char ob ':';
       write_item ob v
   ) write_comma ob l;
-  Bi_outbuf.add_char ob '}'
+  Buffer.add_char ob '}'
 
 let write_assoc_array write_key write_item ob l =
-  Bi_outbuf.add_char ob '{';
+  Buffer.add_char ob '{';
   array_iter (
     fun ob (k, v) ->
       write_key ob k;
-      Bi_outbuf.add_char ob ':';
+      Buffer.add_char ob ':';
       write_item ob v
   ) write_comma ob l;
-  Bi_outbuf.add_char ob '}'
+  Buffer.add_char ob '}'
 
 
 let write_option write_item ob = function
-    None -> Bi_outbuf.add_string ob "<\"None\">"
+    None -> Buffer.add_string ob "<\"None\">"
   | Some x ->
-      Bi_outbuf.add_string ob "<\"Some\":";
+      Buffer.add_string ob "<\"Some\":";
       write_item ob x;
-      Bi_outbuf.add_string ob ">"
+      Buffer.add_string ob ">"
 
 let write_std_option write_item ob = function
-    None -> Bi_outbuf.add_string ob "\"None\""
+    None -> Buffer.add_string ob "\"None\""
   | Some x ->
-      Bi_outbuf.add_string ob "[\"Some\",";
+      Buffer.add_string ob "[\"Some\",";
       write_item ob x;
-      Bi_outbuf.add_string ob "]"
+      Buffer.add_string ob "]"
 
 let write_nullable write_item ob = function
-    None -> Bi_outbuf.add_string ob "null"
+    None -> Buffer.add_string ob "null"
   | Some x -> write_item ob x
 
 let write_int8 ob x =
   Yojson.Safe.write_int ob (int_of_char x)
 
 let write_int32 ob x =
-  Bi_outbuf.add_string ob (Int32.to_string x)
+  Buffer.add_string ob (Int32.to_string x)
 
 let write_int64 ob x =
-  Bi_outbuf.add_char ob '"';
-  Bi_outbuf.add_string ob (Int64.to_string x);
-  Bi_outbuf.add_char ob '"'
+  Buffer.add_char ob '"';
+  Buffer.add_string ob (Int64.to_string x);
+  Buffer.add_char ob '"'
 
 let min_float = float min_int
 let max_float = float max_int
@@ -120,7 +120,7 @@ let write_float_as_int ob x =
     match classify_float x with
         FP_normal
       | FP_subnormal
-      | FP_zero -> Bi_outbuf.add_string ob (Printf.sprintf "%.0f" x)
+      | FP_zero -> Buffer.add_string ob (Printf.sprintf "%.0f" x)
       | FP_infinite -> error "Cannot convert inf or -inf into a JSON int"
       | FP_nan -> error "Cannot convert NaN into a JSON int"
 
@@ -235,12 +235,12 @@ let read_with_adapter normalize reader p lb =
   reader p lb'
 
 let write_with_adapter restore writer ob x =
-  let ob_tmp = Bi_outbuf.create 1024 in
+  let ob_tmp = Buffer.create 1024 in
   writer ob_tmp x;
-  let s_tmp = Bi_outbuf.contents ob_tmp in
+  let s_tmp = Buffer.contents ob_tmp in
   let ast = Yojson.Safe.from_string s_tmp in
   let ast' = restore ast in
-  Yojson.Safe.to_outbuf ob ast'
+  Yojson.Safe.to_buffer ob ast'
 
 (*
   Checking at runtime that our assumptions on unspecified compiler behavior

atdgen-runtime/src/oj_run.mli

@@ -2,7 +2,7 @@
 
 exception Error of string
 
-type 'a write = Bi_outbuf.t -> 'a -> unit
+type 'a write = Buffer.t -> 'a -> unit
 
 val error : string -> _
 

atdgen-runtime/src/util.ml

@@ -44,7 +44,7 @@ end
 module Json =
 struct
   type 'a reader = Yojson.Safe.lexer_state -> Lexing.lexbuf -> 'a
-  type 'a writer = Bi_outbuf.t -> 'a -> unit
+  type 'a writer = Buffer.t -> 'a -> unit
 
   let finish ls lexbuf =
     Yojson.Safe.read_space ls lexbuf;
@@ -84,10 +84,17 @@ struct
     in
     input_file fname (fun ic -> from_channel ?buf ~fname:fname0 ?lnum read ic)
 
-  let stream_from_lexbuf ?(fin = fun () -> ()) read ls lexbuf =
-    let stream = Some true in
-    let f _ =
-      try Some (from_lexbuf ?stream read ls lexbuf)
+  (* seq_unfold is Seq.unfold, needed for ocaml < 4.11 *)
+  let rec seq_unfold f u () =
+    match f u with
+    | None -> Seq.Nil
+    | Some (x, u') -> Seq.Cons (x, seq_unfold f u')
+
+  let seq_from_lexbuf ?(fin = fun () -> ()) read ls lexbuf =
+    let f () =
+      try
+        let v = from_lexbuf ~stream:true read ls lexbuf in
+        Some (v, ())
       with
           Yojson.End_of_input ->
             fin ();
@@ -96,39 +103,36 @@ struct
             (try fin () with _ -> ());
             raise e
     in
-    Stream.from f
+    (* Seq.unfold is only available from ocaml 4.11 *)
+    seq_unfold f ()
 
-  let stream_from_string ?buf ?fin ?fname ?lnum read ic =
+  let seq_from_string ?buf ?fin ?fname ?lnum read ic =
     let lexbuf = Lexing.from_string ic in
     let ls = Yojson.Safe.init_lexer ?buf ?fname ?lnum () in
-    stream_from_lexbuf ?fin read ls lexbuf
+    seq_from_lexbuf ?fin read ls lexbuf
 
-  let stream_from_channel ?buf ?fin ?fname ?lnum read ic =
+  let seq_from_channel ?buf ?fin ?fname ?lnum read ic =
     let lexbuf = Lexing.from_channel ic in
     let ls = Yojson.Safe.init_lexer ?buf ?fname ?lnum () in
-    stream_from_lexbuf ?fin read ls lexbuf
+    seq_from_lexbuf ?fin read ls lexbuf
 
-  let stream_from_file ?buf ?(fin = fun () -> ()) ?fname:src ?lnum read fname =
+  let seq_from_file ?buf ?(fin = fun () -> ()) ?fname:src ?lnum read fname =
     let fname0 =
       match src with
           None -> fname
         | Some s -> s
     in
     let ic = open_in_bin fname in
     let fin () = close_in_noerr ic; fin () in
-    stream_from_channel ?buf ~fin ~fname:fname0 ?lnum read ic
+    seq_from_channel ?buf ~fin ~fname:fname0 ?lnum read ic
 
   let list_from_string ?buf ?fin ?fname ?lnum read ic =
-    let stream = stream_from_string ?buf ?fin ?fname ?lnum read ic in
-    let acc = ref [] in
-    Stream.iter (fun x -> acc := x :: !acc) stream;
-    List.rev !acc
+    let seq = seq_from_string ?buf ?fin ?fname ?lnum read ic in
+    List.of_seq seq
 
   let list_from_channel ?buf ?fin ?fname ?lnum read ic =
-    let stream = stream_from_channel ?buf ?fin ?fname ?lnum read ic in
-    let acc = ref [] in
-    Stream.iter (fun x -> acc := x :: !acc) stream;
-    List.rev !acc
+    let seq = seq_from_channel ?buf ?fin ?fname ?lnum read ic in
+    List.of_seq seq
 
   let list_from_file ?buf ?fname:src ?lnum read fname =
     let fname0 =
@@ -141,34 +145,39 @@ struct
     list_from_channel ?buf ~fin ~fname:fname0 ?lnum read ic
 
   let to_string ?(len = 1024) write x =
-    let ob = Bi_outbuf.create len in
+    let ob = Buffer.create len in
+    write ob x;
+    Buffer.contents ob
+
+  let to_channel ?(len = 1024) write oc x =
+    let ob = Buffer.create len in
     write ob x;
-    Bi_outbuf.contents ob
+    Buffer.output_buffer oc ob
 
-  let to_channel ?len write oc x = Biniou.to_channel ?len ~shrlen:0 write oc x
-  let to_file ?len write fname x = Biniou.to_file ?len ~shrlen:0 write fname x
+  let to_file ?len write fname x =
+    output_file fname (fun oc -> to_channel ?len write oc x)
 
-  let stream_to_string ?(len = 1024) ?(lf = "\n") write stream =
-    let ob = Bi_outbuf.create len in
-    Stream.iter (fun x -> write ob x; Bi_outbuf.add_string ob lf) stream;
-    Bi_outbuf.contents ob
+  let seq_to_string ?(len = 1024) ?(lf = "\n") write seq =
+    let ob = Buffer.create len in
+    Seq.iter (fun x -> write ob x; Buffer.add_string ob lf) seq;
+    Buffer.contents ob
 
-  let stream_to_channel ?len ?(lf = "\n") write oc stream =
-    let ob = Bi_outbuf.create_channel_writer ?len ~shrlen:0 oc in
-    Stream.iter (fun x -> write ob x; Bi_outbuf.add_string ob lf) stream;
-    Bi_outbuf.flush_channel_writer ob
+  let seq_to_channel ?(len = 1024) ?(lf = "\n") write oc seq =
+    let ob = Buffer.create len in
+    Seq.iter (fun x -> write ob x; Buffer.add_string ob lf) seq;
+    Buffer.output_buffer oc ob
 
-  let stream_to_file ?len ?lf write fname stream =
-    output_file fname (fun oc -> stream_to_channel ?len ?lf write oc stream)
+  let seq_to_file ?len ?lf write fname seq =
+    output_file fname (fun oc -> seq_to_channel ?len ?lf write oc seq)
 
   let list_to_string ?len ?lf write l =
-    stream_to_string ?len ?lf write (Stream.of_list l)
+    seq_to_string ?len ?lf write (List.to_seq l)
 
   let list_to_channel ?len ?lf write oc l =
-    stream_to_channel ?len ?lf write oc (Stream.of_list l)
+    seq_to_channel ?len ?lf write oc (List.to_seq l)
 
   let list_to_file ?len ?lf write fname  l =
-    stream_to_file ?len ?lf write fname (Stream.of_list l)
+    seq_to_file ?len ?lf write fname (List.to_seq l)
 
   let preset_unknown_field_handler loc name =
     let msg =