Skip to content

Commit

Permalink
Merge pull request #299 from Leonidas-from-XIV/yojson-2-api
Browse files Browse the repository at this point in the history
Adapt to use Yojson 2.0 API
  • Loading branch information
mjambon authored Jul 20, 2022
2 parents 31799bf + faac29e commit 87ec5c7
Show file tree
Hide file tree
Showing 24 changed files with 1,276 additions and 1,274 deletions.
2 changes: 2 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
* atdgen: use Yojson 2.0 API (#299)

2.9.1 (2022-06-10)
------------------

Expand Down
3 changes: 1 addition & 2 deletions atdgen-runtime.opam
Original file line number Diff line number Diff line change
Expand Up @@ -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.1"}
"biniou" {>= "1.0.6"}
"camlp-streams"
"odoc" {with-doc}
]
dev-repo: "git+https://github.com/ahrefs/atd.git"
Expand Down
2 changes: 1 addition & 1 deletion atdgen-runtime/src/dune
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
(library
(name atdgen_runtime)
(public_name atdgen-runtime)
(libraries biniou yojson camlp-streams))
(libraries biniou yojson))
54 changes: 27 additions & 27 deletions atdgen-runtime/src/oj_run.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand All @@ -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"

Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion atdgen-runtime/src/oj_run.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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 -> _

Expand Down
76 changes: 39 additions & 37 deletions atdgen-runtime/src/util.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down Expand Up @@ -84,10 +84,11 @@ 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)
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 ();
Expand All @@ -96,39 +97,35 @@ struct
(try fin () with _ -> ());
raise e
in
Stream.from f
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 =
Expand All @@ -141,34 +138,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 =
Expand Down
Loading

0 comments on commit 87ec5c7

Please sign in to comment.