diff --git a/.git-blame-ignore-revs b/.git-blame-ignore-revs new file mode 100644 index 00000000..49959f4a --- /dev/null +++ b/.git-blame-ignore-revs @@ -0,0 +1,2 @@ +# Introduced ocamlformat +3101ec295fbc791a1e9384f50178846198a607c7 diff --git a/.ocamlformat b/.ocamlformat new file mode 100644 index 00000000..68079ac9 --- /dev/null +++ b/.ocamlformat @@ -0,0 +1,2 @@ +version=0.24.1 +profile=conventional diff --git a/.ocamlformat-ignore b/.ocamlformat-ignore new file mode 100644 index 00000000..8debd5b7 --- /dev/null +++ b/.ocamlformat-ignore @@ -0,0 +1,6 @@ +# disable ocamlformat on files that are processed by CPPO +lib/*.cppo.ml* +lib/monomorphic.ml +lib/write.ml* +lib/pretty.ml +lib/type.ml diff --git a/bench/bench.ml b/bench/bench.ml index 3407947e..cfe786b2 100644 --- a/bench/bench.ml +++ b/bench/bench.ml @@ -1,28 +1,22 @@ open Core open Core_bench -let data = - In_channel.read_all "bench.json" - +let data = In_channel.read_all "bench.json" let yojson_data = Yojson.Safe.from_string data (* chosen by fair dice roll, guaranteed to be large *) let large = 10_000 -let large_int_assoc = - let ints = List.init large ~f:(fun n -> - (string_of_int n, `Int n)) - in +let large_int_assoc = + let ints = List.init large ~f:(fun n -> (string_of_int n, `Int n)) in `Assoc ints -let large_int_list = +let large_int_list = let ints = List.init large ~f:(fun n -> `Int n) in `List ints let large_string_list = - let strings = List.init large ~f:(fun n -> - `String (string_of_int n)) - in + let strings = List.init large ~f:(fun n -> `String (string_of_int n)) in `List strings let streamable_string = @@ -33,53 +27,49 @@ let streamable_string = Buffer.contents buf let generic = - Bench.make_command [ - Bench.Test.create ~name:"JSON reading" (fun () -> - ignore (Yojson.Safe.from_string data)); - Bench.Test.create ~name:"JSON writing" (fun () -> - ignore (Yojson.Safe.to_string yojson_data)); - Bench.Test.create ~name:"JSON writing assoc" (fun () -> - ignore (Yojson.Safe.to_string large_int_assoc)); - Bench.Test.create ~name:"JSON writing int list" (fun () -> - ignore (Yojson.Safe.to_string large_int_list)); - Bench.Test.create ~name:"JSON writing string list" (fun () -> - ignore (Yojson.Safe.to_string large_string_list)); - Bench.Test.create ~name:"JSON writing int list to channel" (fun () -> - Out_channel.with_file "/dev/null" ~f:(fun oc -> - ignore (Yojson.Safe.to_channel oc large_int_list))); - Bench.Test.create ~name:"JSON writing string list to channel" (fun () -> - Out_channel.with_file "/dev/null" ~f:(fun oc -> - ignore (Yojson.Safe.to_channel oc large_string_list))); - Bench.Test.create ~name:"JSON writing assoc to channel" (fun () -> - Out_channel.with_file "/dev/null" ~f:(fun oc -> - ignore (Yojson.Safe.to_channel oc large_int_assoc))); - begin - let buf = Buffer.create 1000 in - Bench.Test.create ~name:"JSON seq roundtrip" (fun () -> - let stream = Yojson.Safe.seq_from_string ~buf streamable_string in - ignore (Yojson.Safe.seq_to_string ~buf stream) - ) - end; - ] + Bench.make_command + [ + Bench.Test.create ~name:"JSON reading" (fun () -> + ignore (Yojson.Safe.from_string data)); + Bench.Test.create ~name:"JSON writing" (fun () -> + ignore (Yojson.Safe.to_string yojson_data)); + Bench.Test.create ~name:"JSON writing assoc" (fun () -> + ignore (Yojson.Safe.to_string large_int_assoc)); + Bench.Test.create ~name:"JSON writing int list" (fun () -> + ignore (Yojson.Safe.to_string large_int_list)); + Bench.Test.create ~name:"JSON writing string list" (fun () -> + ignore (Yojson.Safe.to_string large_string_list)); + Bench.Test.create ~name:"JSON writing int list to channel" (fun () -> + Out_channel.with_file "/dev/null" ~f:(fun oc -> + ignore (Yojson.Safe.to_channel oc large_int_list))); + Bench.Test.create ~name:"JSON writing string list to channel" (fun () -> + Out_channel.with_file "/dev/null" ~f:(fun oc -> + ignore (Yojson.Safe.to_channel oc large_string_list))); + Bench.Test.create ~name:"JSON writing assoc to channel" (fun () -> + Out_channel.with_file "/dev/null" ~f:(fun oc -> + ignore (Yojson.Safe.to_channel oc large_int_assoc))); + (let buf = Buffer.create 1000 in + Bench.Test.create ~name:"JSON seq roundtrip" (fun () -> + let stream = Yojson.Safe.seq_from_string ~buf streamable_string in + ignore (Yojson.Safe.seq_to_string ~buf stream))); + ] let buffer = let buf = Buffer.create 4096 in let data = large_int_assoc in - Bench.make_command [ - Bench.Test.create ~name:"JSON writing with internal buffer" (fun () -> - Out_channel.with_file "/dev/null" ~f:(fun oc -> - ignore (Yojson.Safe.to_channel oc data))); - Bench.Test.create ~name:"JSON writing with provided buffer" (fun () -> - Out_channel.with_file "/dev/null" ~f:(fun oc -> - ignore (Yojson.Safe.to_channel ~buf oc data))); - ] + Bench.make_command + [ + Bench.Test.create ~name:"JSON writing with internal buffer" (fun () -> + Out_channel.with_file "/dev/null" ~f:(fun oc -> + ignore (Yojson.Safe.to_channel oc data))); + Bench.Test.create ~name:"JSON writing with provided buffer" (fun () -> + Out_channel.with_file "/dev/null" ~f:(fun oc -> + ignore (Yojson.Safe.to_channel ~buf oc data))); + ] let main () = - Command.group ~summary:"Benchmark" [ - ("generic", generic); - ("buffer", buffer) - ] + Command.group ~summary:"Benchmark" + [ ("generic", generic); ("buffer", buffer) ] |> Command_unix.run -let () = - main () +let () = main () diff --git a/bin/ydump.ml b/bin/ydump.ml index 1fb02961..95cdc6bf 100644 --- a/bin/ydump.ml +++ b/bin/ydump.ml @@ -1,92 +1,65 @@ open Printf -let license = "\ -Copyright (c) 2010-2012 Martin Jambon -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions -are met: -1. Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. -2. Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. -3. The name of the author may not be used to endorse or promote products - derived from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR -IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES -OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. -IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, -INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT -NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -" +let license = + "Copyright (c) 2010-2012 Martin Jambon\n\ + All rights reserved.\n\n\ + Redistribution and use in source and binary forms, with or without\n\ + modification, are permitted provided that the following conditions\n\ + are met:\n\ + 1. Redistributions of source code must retain the above copyright\n\ + \ notice, this list of conditions and the following disclaimer.\n\ + 2. Redistributions in binary form must reproduce the above copyright\n\ + \ notice, this list of conditions and the following disclaimer in the\n\ + \ documentation and/or other materials provided with the distribution.\n\ + 3. The name of the author may not be used to endorse or promote products\n\ + \ derived from this software without specific prior written permission.\n\n\ + THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR\n\ + IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES\n\ + OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.\n\ + IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,\n\ + INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT\n\ + NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,\n\ + DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY\n\ + THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n\ + (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF\n\ + THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n" let polycat write_one streaming in_file out_file = let ic, fname = - match in_file with - `Stdin -> stdin, "" - | `File s -> open_in s, s - in - let oc = - match out_file with - `Stdout -> stdout - | `File s -> open_out s + match in_file with `Stdin -> (stdin, "") | `File s -> (open_in s, s) in + let oc = match out_file with `Stdout -> stdout | `File s -> open_out s in let finally () = - if oc != stdout then - close_out_noerr oc; - if ic != stdin then - close_in_noerr ic + if oc != stdout then close_out_noerr oc; + if ic != stdin then close_in_noerr ic in try if streaming then Seq.iter (write_one oc) (Yojson.Safe.seq_from_channel ~fname ic) - else - write_one oc (Yojson.Safe.from_channel ~fname ic); + else write_one oc (Yojson.Safe.from_channel ~fname ic); finally (); true with e -> finally (); eprintf "Error:\n"; (match e with - Yojson.Json_error s -> - eprintf "%s\n%!" s - | e -> - eprintf "%s\n%!" (Printexc.to_string e) - ); + | Yojson.Json_error s -> eprintf "%s\n%!" s + | e -> eprintf "%s\n%!" (Printexc.to_string e)); false - let cat sort output_biniou std compact streaming in_file out_file = if not output_biniou then let write_one oc x = - let x = - if sort then - Yojson.Safe.sort x - else x - in - if compact then - Yojson.Safe.to_channel ~std oc x - else - Yojson.Safe.pretty_to_channel ~std oc x; + let x = if sort then Yojson.Safe.sort x else x in + if compact then Yojson.Safe.to_channel ~std oc x + else Yojson.Safe.pretty_to_channel ~std oc x; output_char oc '\n' in polycat write_one streaming in_file out_file - else - let write_one oc x = - output_string oc (Yojson.Safe.to_string x) - in + let write_one oc x = output_string oc (Yojson.Safe.to_string x) in polycat write_one streaming in_file out_file - - let parse_cmdline () = let out = ref None in let std = ref false in @@ -94,83 +67,67 @@ let parse_cmdline () = let streaming = ref true in let sort = ref false in let output_biniou = ref false in - let options = [ - "-o", Arg.String (fun s -> out := Some s), - " - Output file"; - - "-std", Arg.Set std, - " - Convert tuples and variants into standard JSON, - refuse to print NaN and infinities, - require the root node to be either an object or an array."; - - "-c", Arg.Set compact, - " - Compact output (default: pretty-printed)"; - - "-s", Arg.Set streaming, - " - Streaming mode: read and write a sequence of JSON values instead of - just one (default)."; - - "-u", Arg.Clear streaming, - " - A single JSON record is expected. - (no longer the default since 1.1.1)"; - - "-sort", Arg.Set sort, - " - Sort object fields (default: preserve field order)"; - - "-ob", Arg.Set output_biniou, - "\ - Experimental"; - - "-version", - Arg.Unit (fun () -> print_endline Yojson.version; exit 0), - "\ - Print version of yojson and ydump and exit." - ] + let options = + [ + ( "-o", + Arg.String (fun s -> out := Some s), + "\n Output file" ); + ( "-std", + Arg.Set std, + "\n\ + \ Convert tuples and variants into standard JSON,\n\ + \ refuse to print NaN and infinities,\n\ + \ require the root node to be either an object or an array." ); + ( "-c", + Arg.Set compact, + "\n Compact output (default: pretty-printed)" ); + ( "-s", + Arg.Set streaming, + "\n\ + \ Streaming mode: read and write a sequence of JSON values \ + instead of\n\ + \ just one (default)." ); + ( "-u", + Arg.Clear streaming, + "\n\ + \ A single JSON record is expected.\n\ + \ (no longer the default since 1.1.1)" ); + ( "-sort", + Arg.Set sort, + "\n Sort object fields (default: preserve field order)" ); + ("-ob", Arg.Set output_biniou, "Experimental"); + ( "-version", + Arg.Unit + (fun () -> + print_endline Yojson.version; + exit 0), + "Print version of yojson and ydump and exit." ); + ] in let files = ref [] in - let anon_fun s = - files := s :: !files - in + let anon_fun s = files := s :: !files in let msg = - sprintf "\ -JSON pretty-printer based on the Yojson library for OCaml - -%s - -JSON pretty-printer based on the Yojson library for OCaml - -Usage: %s [input file]" - license Sys.argv.(0) + sprintf + "JSON pretty-printer based on the Yojson library for OCaml\n\n\ + %s\n\n\ + JSON pretty-printer based on the Yojson library for OCaml\n\n\ + Usage: %s [input file]" license Sys.argv.(0) in Arg.parse options anon_fun msg; let in_file = match List.rev !files with - [] -> `Stdin - | [x] -> `File x - | _ -> - eprintf "Too many input files\n%!"; - exit 1 - in - let out_file = - match !out with - None -> `Stdout - | Some x -> `File x + | [] -> `Stdin + | [ x ] -> `File x + | _ -> + eprintf "Too many input files\n%!"; + exit 1 in - !sort, !output_biniou, !std, !compact, !streaming, in_file, out_file - + let out_file = match !out with None -> `Stdout | Some x -> `File x in + (!sort, !output_biniou, !std, !compact, !streaming, in_file, out_file) let () = let sort, output_biniou, std, compact, streaming, in_file, out_file = - parse_cmdline () in - let success = - cat sort output_biniou std compact streaming in_file out_file in - if success then - exit 0 - else - exit 1 + parse_cmdline () + in + let success = cat sort output_biniou std compact streaming in_file out_file in + if success then exit 0 else exit 1 diff --git a/dune-project b/dune-project index f6ab4017..242aac15 100644 --- a/dune-project +++ b/dune-project @@ -1,6 +1,5 @@ (lang dune 2.7) (name yojson) -(formatting (enabled_for dune)) (generate_opam_files true) (source (github ocaml-community/yojson)) diff --git a/examples/filtering.ml b/examples/filtering.ml index 3546f9fb..78136bbf 100644 --- a/examples/filtering.ml +++ b/examples/filtering.ml @@ -28,11 +28,8 @@ EOF open Yojson.Basic.Util let extract_titles json = - [json] - |> filter_member "pages" - |> flatten - |> filter_member "title" - |> filter_string + [ json ] |> filter_member "pages" |> flatten |> filter_member "title" + |> filter_string let main () = let json = Yojson.Basic.from_channel stdin in diff --git a/lib/common.ml b/lib/common.ml index d15e651b..2dd4cb13 100644 --- a/lib/common.ml +++ b/lib/common.ml @@ -9,14 +9,9 @@ exception End_of_object exception End_of_tuple exception End_of_input -type in_param = { - string_buf : Buffer.t -} - -let create_in_param ?(len = 256) () = { - string_buf = Buffer.create len -} +type in_param = { string_buf : Buffer.t } +let create_in_param ?(len = 256) () = { string_buf = Buffer.create len } let utf8_of_code buf x = let add = Buffer.add_char in @@ -24,35 +19,30 @@ let utf8_of_code buf x = (* Straight <= doesn't work with signed 31-bit ints *) let maxbits n x = x lsr n = 0 in - if maxbits 7 x then - (* 7 *) + if maxbits 7 x then (* 7 *) add buf (Char.chr x) else if maxbits 11 x then ( (* 5 + 6 *) add buf (Char.chr (0b11000000 lor ((x lsr 6) land 0b00011111))); - add buf (Char.chr (0b10000000 lor (x land 0b00111111))) - ) + add buf (Char.chr (0b10000000 lor (x land 0b00111111)))) else if maxbits 16 x then ( (* 4 + 6 + 6 *) add buf (Char.chr (0b11100000 lor ((x lsr 12) land 0b00001111))); - add buf (Char.chr (0b10000000 lor ((x lsr 6) land 0b00111111))); - add buf (Char.chr (0b10000000 lor (x land 0b00111111))) - ) + add buf (Char.chr (0b10000000 lor ((x lsr 6) land 0b00111111))); + add buf (Char.chr (0b10000000 lor (x land 0b00111111)))) else if maxbits 21 x then ( (* 3 + 6 + 6 + 6 *) add buf (Char.chr (0b11110000 lor ((x lsr 18) land 0b00000111))); add buf (Char.chr (0b10000000 lor ((x lsr 12) land 0b00111111))); - add buf (Char.chr (0b10000000 lor ((x lsr 6) land 0b00111111))); - add buf (Char.chr (0b10000000 lor (x land 0b00111111))); - ) + add buf (Char.chr (0b10000000 lor ((x lsr 6) land 0b00111111))); + add buf (Char.chr (0b10000000 lor (x land 0b00111111)))) else if maxbits 26 x then ( (* 2 + 6 + 6 + 6 + 6 *) add buf (Char.chr (0b11111000 lor ((x lsr 24) land 0b00000011))); add buf (Char.chr (0b10000000 lor ((x lsr 18) land 0b00111111))); add buf (Char.chr (0b10000000 lor ((x lsr 12) land 0b00111111))); - add buf (Char.chr (0b10000000 lor ((x lsr 6) land 0b00111111))); - add buf (Char.chr (0b10000000 lor (x land 0b00111111))); - ) + add buf (Char.chr (0b10000000 lor ((x lsr 6) land 0b00111111))); + add buf (Char.chr (0b10000000 lor (x land 0b00111111)))) else ( assert (maxbits 31 x); (* 1 + 6 + 6 + 6 + 6 + 6 *) @@ -60,9 +50,8 @@ let utf8_of_code buf x = add buf (Char.chr (0b10000000 lor ((x lsr 24) land 0b00111111))); add buf (Char.chr (0b10000000 lor ((x lsr 18) land 0b00111111))); add buf (Char.chr (0b10000000 lor ((x lsr 12) land 0b00111111))); - add buf (Char.chr (0b10000000 lor ((x lsr 6) land 0b00111111))); - add buf (Char.chr (0b10000000 lor (x land 0b00111111))); - ) + add buf (Char.chr (0b10000000 lor ((x lsr 6) land 0b00111111))); + add buf (Char.chr (0b10000000 lor (x land 0b00111111)))) let code_of_surrogate_pair i j = let high10 = i - 0xD800 in @@ -73,22 +62,15 @@ let utf8_of_surrogate_pair buf i j = utf8_of_code buf (code_of_surrogate_pair i j) type lexer_state = { - buf : Buffer.t; - (* Buffer used to accumulate substrings *) - - mutable lnum : int; - (* Current line number (starting from 1) *) - + buf : Buffer.t; (* Buffer used to accumulate substrings *) + mutable lnum : int; (* Current line number (starting from 1) *) mutable bol : int; - (* Absolute position of the first character of the current line - (starting from 0) *) - - mutable fname : string option; - (* Name describing the input file *) + (* Absolute position of the first character of the current line + (starting from 0) *) + mutable fname : string option; (* Name describing the input file *) } -module Lexer_state = -struct +module Lexer_state = struct type t = lexer_state = { buf : Buffer.t; mutable lnum : int; @@ -98,14 +80,5 @@ struct end let init_lexer ?buf ?fname ?(lnum = 1) () = - let buf = - match buf with - None -> Buffer.create 256 - | Some buf -> buf - in - { - buf = buf; - lnum = lnum; - bol = 0; - fname = fname - } + let buf = match buf with None -> Buffer.create 256 | Some buf -> buf in + { buf; lnum; bol = 0; fname } diff --git a/lib/common.mli b/lib/common.mli index 379ab025..1f484e73 100644 --- a/lib/common.mli +++ b/lib/common.mli @@ -9,22 +9,16 @@ val json_error : string -> 'a (** @raise Json_error *) type lexer_state = { - buf : Buffer.t; - (** Buffer used to accumulate substrings *) - - mutable lnum : int; - (** Current line number (counting from 1) *) - + buf : Buffer.t; (** Buffer used to accumulate substrings *) + mutable lnum : int; (** Current line number (counting from 1) *) mutable bol : int; - (** Absolute position of the first character of the current line + (** Absolute position of the first character of the current line (counting from 0) *) - mutable fname : string option; - (** Name referencing the input file in error messages *) + (** Name referencing the input file in error messages *) } -module Lexer_state : -sig +module Lexer_state : sig type t = lexer_state = { buf : Buffer.t; mutable lnum : int; @@ -34,12 +28,8 @@ sig end val init_lexer : - ?buf: Buffer.t -> - ?fname: string -> - ?lnum: int -> - unit -> lexer_state - (** Create a fresh lexer_state record. *) - + ?buf:Buffer.t -> ?fname:string -> ?lnum:int -> unit -> lexer_state +(** Create a fresh lexer_state record. *) (**/**) (* begin undocumented section *) diff --git a/lib/monomorphic.mli b/lib/monomorphic.mli index 2c1a0d8a..1bb233d3 100644 --- a/lib/monomorphic.mli +++ b/lib/monomorphic.mli @@ -1,11 +1,11 @@ val pp : Format.formatter -> t -> unit - (** Pretty printer, useful for debugging *) +(** Pretty printer, useful for debugging *) val show : t -> string - (** Convert value to string, useful for debugging *) +(** Convert value to string, useful for debugging *) val equal : t -> t -> bool - (** [equal a b] is the monomorphic equality. +(** [equal a b] is the monomorphic equality. Determines whether two JSON values are considered equal. In the case of JSON objects, the order of the keys does not matter, except for duplicate keys which will be considered equal as long as they are in the diff --git a/lib/read.mli b/lib/read.mli index b2388b70..f67b0d88 100644 --- a/lib/read.mli +++ b/lib/read.mli @@ -1,9 +1,9 @@ val prettify : ?std:bool -> string -> string - (** Combined parser and pretty-printer. +(** Combined parser and pretty-printer. See [to_string] for the role of the optional [std] argument and raised exceptions. *) val compact : ?std:bool -> string -> string - (** Combined parser and printer. +(** Combined parser and printer. See [to_string] for the role of the optional [std] argument and raised exceptions. *) (** {2 JSON readers} *) @@ -11,12 +11,8 @@ val compact : ?std:bool -> string -> string exception Finally of exn * exn (** Exception describing a failure in both finalizer and parsing. *) -val from_string : - ?buf:Buffer.t -> - ?fname:string -> - ?lnum:int -> - string -> t - (** Read a JSON value from a string. +val from_string : ?buf:Buffer.t -> ?fname:string -> ?lnum:int -> string -> t +(** Read a JSON value from a string. @param buf use this buffer at will during parsing instead of creating a new one. @param fname data file name to be used in error messages. It does @@ -26,45 +22,31 @@ val from_string : *) val from_channel : - ?buf:Buffer.t -> - ?fname:string -> - ?lnum:int -> - in_channel -> t - (** Read a JSON value from a channel. + ?buf:Buffer.t -> ?fname:string -> ?lnum:int -> in_channel -> t +(** Read a JSON value from a channel. See [from_string] for the meaning of the optional arguments and raised exceptions. *) -val from_file : - ?buf:Buffer.t -> - ?fname:string -> - ?lnum:int -> - string -> t - (** Read a JSON value from a file. +val from_file : ?buf:Buffer.t -> ?fname:string -> ?lnum:int -> string -> t +(** Read a JSON value from a file. See [from_string] for the meaning of the optional arguments and raised exceptions. *) - type lexer_state = Lexer_state.t = { buf : Buffer.t; mutable lnum : int; mutable bol : int; mutable fname : string option; } - (** This alias is provided for backward compatibility. +(** This alias is provided for backward compatibility. New code should refer to {!Yojson.lexer_state} directly. *) val init_lexer : - ?buf: Buffer.t -> - ?fname: string -> - ?lnum: int -> - unit -> lexer_state - (** This alias is provided for backward compatibility. + ?buf:Buffer.t -> ?fname:string -> ?lnum:int -> unit -> lexer_state +(** This alias is provided for backward compatibility. New code should use {!Yojson.init_lexer} directly. *) -val from_lexbuf : - lexer_state -> - ?stream:bool -> - Lexing.lexbuf -> t - (** Read a JSON value from a lexbuf. +val from_lexbuf : lexer_state -> ?stream:bool -> Lexing.lexbuf -> t +(** Read a JSON value from a lexbuf. A valid initial [lexer_state] can be created with [init_lexer]. See [from_string] for the meaning of the optional arguments and raised exceptions. @@ -73,11 +55,8 @@ val from_lexbuf : the end of the JSON value and the end of the input. *) val seq_from_string : - ?buf:Buffer.t -> - ?fname:string -> - ?lnum:int -> - string -> t Seq.t - (** Input a sequence of JSON values from a string. + ?buf:Buffer.t -> ?fname:string -> ?lnum:int -> string -> t Seq.t +(** Input a sequence of JSON values from a string. Whitespace between JSON values is fine but not required. See [from_string] for the meaning of the optional arguments and raised exceptions. *) @@ -86,8 +65,9 @@ val seq_from_channel : ?fin:(unit -> unit) -> ?fname:string -> ?lnum:int -> - in_channel -> t Seq.t - (** Input a sequence of JSON values from a channel. + in_channel -> + t Seq.t +(** Input a sequence of JSON values from a channel. Whitespace between JSON values is fine but not required. @param fin finalization function executed once when the end of the sequence is reached either because there is no more input or because @@ -98,20 +78,15 @@ val seq_from_channel : See [from_string] for the meaning of the other optional arguments and other raised exceptions. *) val seq_from_file : - ?buf:Buffer.t -> - ?fname:string -> - ?lnum:int -> - string -> t Seq.t - (** Input a sequence of JSON values from a file. + ?buf:Buffer.t -> ?fname:string -> ?lnum:int -> string -> t Seq.t +(** Input a sequence of JSON values from a file. Whitespace between JSON values is fine but not required. See [from_string] for the meaning of the optional arguments and raised exceptions. *) val seq_from_lexbuf : - lexer_state -> - ?fin:(unit -> unit) -> - Lexing.lexbuf -> t Seq.t - (** Input a sequence of JSON values from a lexbuf. + lexer_state -> ?fin:(unit -> unit) -> Lexing.lexbuf -> t Seq.t +(** Input a sequence of JSON values from a lexbuf. A valid initial [lexer_state] can be created with [init_lexer]. Whitespace between JSON values is fine but not required. @raise Finally When the parsing and the finalizer both raised, [Finally (exn, fin_exn)] @@ -120,17 +95,17 @@ val seq_from_lexbuf : See [seq_from_channel] for the meaning of the optional [fin] argument and other raised exceptions. *) - type json_line = [ `Json of t | `Exn of exn ] - (** The type of values resulting from a parsing attempt of a JSON value. *) +(** The type of values resulting from a parsing attempt of a JSON value. *) val lineseq_from_channel : ?buf:Buffer.t -> ?fin:(unit -> unit) -> ?fname:string -> ?lnum:int -> - in_channel -> json_line Seq.t - (** Input a sequence of JSON values, one per line, from a channel. + in_channel -> + json_line Seq.t +(** Input a sequence of JSON values, one per line, from a channel. Exceptions raised when reading malformed lines are caught and represented using [`Exn]. @@ -139,11 +114,8 @@ val lineseq_from_channel : See [from_string] for the meaning of the other optional arguments and raised exceptions. *) val lineseq_from_file : - ?buf:Buffer.t -> - ?fname:string -> - ?lnum:int -> - string -> json_line Seq.t - (** Input a sequence of JSON values, one per line, from a file. + ?buf:Buffer.t -> ?fname:string -> ?lnum:int -> string -> json_line Seq.t +(** Input a sequence of JSON values, one per line, from a file. Exceptions raised when reading malformed lines are caught and represented using [`Exn]. @@ -156,38 +128,33 @@ val read_t : lexer_state -> Lexing.lexbuf -> t Provided as a reader function for atdgen. *) - (**/**) (* begin undocumented section *) val finish_string : lexer_state -> Lexing.lexbuf -> string - val read_string : lexer_state -> Lexing.lexbuf -> string val read_ident : lexer_state -> Lexing.lexbuf -> string val map_string : lexer_state -> (string -> int -> int -> 'a) -> Lexing.lexbuf -> 'a - (* equivalent to finish_string *) +(* equivalent to finish_string *) val map_ident : lexer_state -> (string -> int -> int -> 'a) -> Lexing.lexbuf -> 'a - (* equivalent to read_ident *) - +(* equivalent to read_ident *) type variant_kind = [ `Edgy_bracket | `Square_bracket | `Double_quote ] + val start_any_variant : lexer_state -> Lexing.lexbuf -> variant_kind val finish_variant : lexer_state -> Lexing.lexbuf -> t option val finish_skip_variant : lexer_state -> Lexing.lexbuf -> unit val read_lt : lexer_state -> Lexing.lexbuf -> unit val read_gt : lexer_state -> Lexing.lexbuf -> unit val read_comma : lexer_state -> Lexing.lexbuf -> unit - val finish_stringlit : lexer_state -> Lexing.lexbuf -> string val finish_skip_stringlit : lexer_state -> Lexing.lexbuf -> unit val finish_escaped_char : lexer_state -> Lexing.lexbuf -> unit val finish_comment : lexer_state -> Lexing.lexbuf -> unit - - val read_space : lexer_state -> Lexing.lexbuf -> unit val read_eof : Lexing.lexbuf -> bool val read_null : lexer_state -> Lexing.lexbuf -> unit @@ -204,17 +171,20 @@ val read_sequence : ('a -> lexer_state -> Lexing.lexbuf -> 'a) -> 'a -> lexer_state -> - Lexing.lexbuf -> 'a + Lexing.lexbuf -> + 'a val read_list : (lexer_state -> Lexing.lexbuf -> 'a) -> lexer_state -> - Lexing.lexbuf -> 'a list + Lexing.lexbuf -> + 'a list val read_list_rev : (lexer_state -> Lexing.lexbuf -> 'a) -> lexer_state -> - Lexing.lexbuf -> 'a list + Lexing.lexbuf -> + 'a list val read_array_end : Lexing.lexbuf -> unit val read_array_sep : lexer_state -> Lexing.lexbuf -> unit @@ -222,13 +192,15 @@ val read_array_sep : lexer_state -> Lexing.lexbuf -> unit val read_array : (lexer_state -> Lexing.lexbuf -> 'a) -> lexer_state -> - Lexing.lexbuf -> 'a array + Lexing.lexbuf -> + 'a array val read_tuple : (int -> 'a -> lexer_state -> Lexing.lexbuf -> 'a) -> 'a -> lexer_state -> - Lexing.lexbuf -> 'a + Lexing.lexbuf -> + 'a val start_any_tuple : lexer_state -> Lexing.lexbuf -> bool val read_lpar : lexer_state -> Lexing.lexbuf -> unit @@ -244,20 +216,21 @@ val read_fields : ('acc -> string -> lexer_state -> Lexing.lexbuf -> 'acc) -> 'acc -> lexer_state -> - Lexing.lexbuf -> 'acc + Lexing.lexbuf -> + 'acc val read_abstract_fields : (lexer_state -> Lexing.lexbuf -> 'key) -> ('acc -> 'key -> lexer_state -> Lexing.lexbuf -> 'acc) -> 'acc -> lexer_state -> - Lexing.lexbuf -> 'acc + Lexing.lexbuf -> + 'acc val read_lcurl : lexer_state -> Lexing.lexbuf -> unit val read_object_end : Lexing.lexbuf -> unit val read_object_sep : lexer_state -> Lexing.lexbuf -> unit val read_colon : lexer_state -> Lexing.lexbuf -> unit - val read_json : lexer_state -> Lexing.lexbuf -> t val skip_json : lexer_state -> Lexing.lexbuf -> unit val buffer_json : lexer_state -> Lexing.lexbuf -> unit diff --git a/lib/safe.ml b/lib/safe.ml index 10828fc9..dabcfefd 100644 --- a/lib/safe.ml +++ b/lib/safe.ml @@ -1,13 +1,7 @@ let rec to_basic : t -> Basic.t = function - `Null - | `Bool _ - | `Int _ - | `Float _ - | `String _ as x -> x + | (`Null | `Bool _ | `Int _ | `Float _ | `String _) as x -> x | `Intlit s -> `String s - | `List l - | `Tuple l -> - `List (List.rev (List.rev_map to_basic l)) + | `List l | `Tuple l -> `List (List.rev (List.rev_map to_basic l)) | `Assoc l -> `Assoc (List.rev (List.rev_map (fun (k, v) -> (k, to_basic v)) l)) | `Variant (k, None) -> `String k diff --git a/lib/safe.mli b/lib/safe.mli index e7d72e72..3f06099a 100644 --- a/lib/safe.mli +++ b/lib/safe.mli @@ -1,5 +1,5 @@ val to_basic : t -> Basic.t - (** +(** Tuples are converted to JSON arrays, Variants are converted to JSON strings or arrays of a string (constructor) and a json value (argument). diff --git a/lib/util.ml b/lib/util.ml index dfed227f..8f787ea5 100644 --- a/lib/util.ml +++ b/lib/util.ml @@ -16,9 +16,7 @@ let typerr msg js = raise (Type_error (msg ^ typeof js, js)) exception Undefined of string * t -let assoc name obj = - try List.assoc name obj - with Not_found -> `Null +let assoc name obj = try List.assoc name obj with Not_found -> `Null let member name = function | `Assoc obj -> assoc name obj @@ -31,8 +29,8 @@ let index i = function if wrapped_index < 0 || wrapped_index >= len then raise (Undefined ("Index " ^ string_of_int i ^ " out of bounds", js)) else List.nth l wrapped_index - | js -> typerr ("Can't get index " ^ string_of_int i - ^ " of non-array type ") js + | js -> + typerr ("Can't get index " ^ string_of_int i ^ " of non-array type ") js let map f = function | `List l -> `List (List.map f l) @@ -42,13 +40,8 @@ let to_assoc = function | `Assoc obj -> obj | js -> typerr "Expected object, got " js -let to_option f = function - | `Null -> None - | x -> Some (f x) - -let to_bool = function - | `Bool b -> b - | js -> typerr "Expected bool, got " js +let to_option f = function `Null -> None | x -> Some (f x) +let to_bool = function `Bool b -> b | js -> typerr "Expected bool, got " js let to_bool_option = function | `Bool b -> Some b @@ -66,27 +59,21 @@ let to_number_option = function | `Null -> None | js -> typerr "Expected number or null, got " js -let to_float = function - | `Float f -> f - | js -> typerr "Expected float, got " js +let to_float = function `Float f -> f | js -> typerr "Expected float, got " js let to_float_option = function | `Float f -> Some f | `Null -> None | js -> typerr "Expected float or null, got " js -let to_int = function - | `Int i -> i - | js -> typerr "Expected int, got " js +let to_int = function `Int i -> i | js -> typerr "Expected int, got " js let to_int_option = function | `Int i -> Some i | `Null -> None | js -> typerr "Expected int or null, got " js -let to_list = function - | `List l -> l - | js -> typerr "Expected array, got " js +let to_list = function `List l -> l | js -> typerr "Expected array, got " js let to_string = function | `String s -> s @@ -101,104 +88,55 @@ let convert_each f = function | `List l -> List.map f l | js -> typerr "Can't convert each element of non-array type " js - let rec rev_filter_map f acc l = match l with - [] -> acc - | x :: tl -> - match f x with - None -> rev_filter_map f acc tl - | Some y -> rev_filter_map f (y :: acc) tl + | [] -> acc + | x :: tl -> ( + match f x with + | None -> rev_filter_map f acc tl + | Some y -> rev_filter_map f (y :: acc) tl) -let filter_map f l = - List.rev (rev_filter_map f [] l) +let filter_map f l = List.rev (rev_filter_map f [] l) let rec rev_flatten acc l = match l with - [] -> acc - | x :: tl -> - match x with - `List l2 -> rev_flatten (List.rev_append l2 acc) tl - | _ -> rev_flatten acc tl + | [] -> acc + | x :: tl -> ( + match x with + | `List l2 -> rev_flatten (List.rev_append l2 acc) tl + | _ -> rev_flatten acc tl) -let flatten l = - List.rev (rev_flatten [] l) +let flatten l = List.rev (rev_flatten [] l) let filter_index i l = - filter_map ( - function - `List l -> - (try Some (List.nth l i) - with _ -> None) - | _ -> None - ) l - -let filter_list l = - filter_map ( - function - `List l -> Some l - | _ -> None - ) l + filter_map + (function + | `List l -> ( try Some (List.nth l i) with _ -> None) | _ -> None) + l + +let filter_list l = filter_map (function `List l -> Some l | _ -> None) l let filter_member k l = - filter_map ( - function - `Assoc l -> - (try Some (List.assoc k l) - with _ -> None) - | _ -> None - ) l - -let filter_assoc l = - filter_map ( - function - `Assoc l -> Some l - | _ -> None - ) l - -let filter_bool l = - filter_map ( - function - `Bool x -> Some x - | _ -> None - ) l - -let filter_int l = - filter_map ( - function - `Int x -> Some x - | _ -> None - ) l - -let filter_float l = - filter_map ( - function - `Float x -> Some x - | _ -> None - ) l + filter_map + (function + | `Assoc l -> ( try Some (List.assoc k l) with _ -> None) | _ -> None) + l + +let filter_assoc l = filter_map (function `Assoc l -> Some l | _ -> None) l +let filter_bool l = filter_map (function `Bool x -> Some x | _ -> None) l +let filter_int l = filter_map (function `Int x -> Some x | _ -> None) l +let filter_float l = filter_map (function `Float x -> Some x | _ -> None) l let filter_number l = - filter_map ( - function - `Int x -> Some (float x) - | `Float x -> Some x - | _ -> None - ) l - -let filter_string l = - filter_map ( - function - `String x -> Some x - | _ -> None - ) l - -let keys o = - to_assoc o |> List.map (fun (key, _) -> key) - -let values o = - to_assoc o |> List.map (fun (_, value) -> value) + filter_map + (function `Int x -> Some (float x) | `Float x -> Some x | _ -> None) + l + +let filter_string l = filter_map (function `String x -> Some x | _ -> None) l +let keys o = to_assoc o |> List.map (fun (key, _) -> key) +let values o = to_assoc o |> List.map (fun (_, value) -> value) let combine (first : t) (second : t) = match (first, second) with - | (`Assoc a, `Assoc b) -> (`Assoc (a @ b) : t) - | (a, b) -> raise (Invalid_argument "Expected two objects, check inputs") + | `Assoc a, `Assoc b -> (`Assoc (a @ b) : t) + | a, b -> raise (Invalid_argument "Expected two objects, check inputs") diff --git a/lib/util.mli b/lib/util.mli index b5fe3ed9..aa72f462 100644 --- a/lib/util.mli +++ b/lib/util.mli @@ -59,111 +59,110 @@ v} *) exception Type_error of string * t - (** Raised when the JSON value is not of the correct type to support an +(** Raised when the JSON value is not of the correct type to support an operation, e.g. [member] on an [`Int]. The string message explains the mismatch. *) exception Undefined of string * t - (** Raised when the equivalent JavaScript operation on the JSON value would +(** Raised when the equivalent JavaScript operation on the JSON value would return undefined. Currently this only happens when an array index is out of bounds. *) val keys : t -> string list - (** Returns all the key names in the given JSON object. +(** Returns all the key names in the given JSON object. @raise Type_error if argument is not a JSON object. *) val values : t -> t list - (** Return all the value in the given JSON object. +(** Return all the value in the given JSON object. @raise Type_error if argument is not a JSON object. *) val combine : t -> t -> t - (** Combine two JSON objects together. +(** Combine two JSON objects together. @raise Invalid_argument if either argument is not a JSON object. *) val member : string -> t -> t - (** [member k obj] returns the value associated with the key [k] in the JSON +(** [member k obj] returns the value associated with the key [k] in the JSON object [obj], or [`Null] if [k] is not present in [obj]. @raise Type_error if [obj] is not a JSON object. *) val index : int -> t -> t - (** [index i arr] returns the value at index [i] in the JSON array [arr]. +(** [index i arr] returns the value at index [i] in the JSON array [arr]. Negative indices count from the end of the list (so -1 is the last element). @raise Type_error if [arr] is not a JSON array. @raise Undefined if index is out of bounds. *) val map : (t -> t) -> t -> t - (** [map f arr] calls the function [f] on each element of the JSON array +(** [map f arr] calls the function [f] on each element of the JSON array [arr], and returns a JSON array containing the results. @raise Type_error if [arr] is not an JSON array. *) val to_assoc : t -> (string * t) list - (** Extract the items of a JSON object. +(** Extract the items of a JSON object. @raise Type_error if argument is not a JSON object. *) val to_option : (t -> 'a) -> t -> 'a option - (** Return [None] if the JSON value is null or map the JSON value +(** Return [None] if the JSON value is null or map the JSON value to [Some] value using the provided function. *) val to_bool : t -> bool - (** Extract a boolean value. +(** Extract a boolean value. @raise Type_error if argument is not a JSON boolean. *) val to_bool_option : t -> bool option - (** Extract [Some] boolean value, +(** Extract [Some] boolean value, return [None] if the value is null. @raise Type_error if argument is neither. *) val to_number : t -> float - (** Extract a number. +(** Extract a number. @raise Type_error if argument is not a JSON number. *) val to_number_option : t -> float option - (** Extract [Some] number, +(** Extract [Some] number, return [None] if the value is null. @raise Type_error if argument is neither. *) val to_float : t -> float - (** Extract a float value. +(** Extract a float value. [to_number] is generally preferred as it also works with int literals. @raise Type_error if argument is not a JSON float. *) val to_float_option : t -> float option - (** Extract [Some] float value, +(** Extract [Some] float value, return [None] if the value is null. [to_number_option] is generally preferred as it also works with int literals. @raise Type_error if argument is neither. *) val to_int : t -> int - (** Extract an int from a JSON int. +(** Extract an int from a JSON int. @raise Type_error if argument is not a JSON int. *) val to_int_option : t -> int option - (** Extract [Some] int from a JSON int, +(** Extract [Some] int from a JSON int, return [None] if the value is null. @raise Type_error if argument is neither. *) val to_list : t -> t list - (** Extract a list from JSON array. +(** Extract a list from JSON array. @raise Type_error if argument is not a JSON array. *) val to_string : t -> string - (** Extract a string from a JSON string. +(** Extract a string from a JSON string. @raise Type_error if argument is not a JSON string. *) val to_string_option : t -> string option - (** Extract [Some] string from a JSON string, +(** Extract [Some] string from a JSON string, return [None] if the value is null. @raise Type_error if argument is neither. *) val convert_each : (t -> 'a) -> t -> 'a list - (** The conversion functions above cannot be used with [map], because they do +(** The conversion functions above cannot be used with [map], because they do not return JSON values. This convenience function [convert_each to_f arr] is equivalent to [List.map to_f (to_list arr)]. @raise Type_error if [arr] is not a JSON array. *) - (** {3 Exception-free filters} *) (** @@ -175,39 +174,39 @@ val convert_each : (t -> 'a) -> t -> 'a list *) val filter_map : ('a -> 'b option) -> 'a list -> 'b list - (** [filter_map f l] maps each element of the list [l] to an optional value +(** [filter_map f l] maps each element of the list [l] to an optional value using function [f] and unwraps the resulting values. *) val flatten : t list -> t list - (** Expects JSON arrays and returns all their elements as a single +(** Expects JSON arrays and returns all their elements as a single list. [flatten l] is equivalent to [List.flatten (filter_list l)]. *) val filter_index : int -> t list -> t list - (** Expects JSON arrays and returns all their elements existing at the given +(** Expects JSON arrays and returns all their elements existing at the given position. *) val filter_list : t list -> t list list - (** Expects JSON arrays and unwraps them. *) +(** Expects JSON arrays and unwraps them. *) val filter_member : string -> t list -> t list - (** Expects JSON objects and returns all the fields of the given name +(** Expects JSON objects and returns all the fields of the given name (at most one field per object). *) val filter_assoc : t list -> (string * t) list list - (** Expects JSON objects and unwraps them. *) +(** Expects JSON objects and unwraps them. *) val filter_bool : t list -> bool list - (** Expects JSON booleans and unwraps them. *) +(** Expects JSON booleans and unwraps them. *) val filter_int : t list -> int list - (** Expects JSON integers ([`Int] nodes) and unwraps them. *) +(** Expects JSON integers ([`Int] nodes) and unwraps them. *) val filter_float : t list -> float list - (** Expects JSON floats ([`Float] nodes) and unwraps them. *) +(** Expects JSON floats ([`Float] nodes) and unwraps them. *) val filter_number : t list -> float list - (** Expects JSON numbers ([`Int] or [`Float]) and unwraps them. +(** Expects JSON numbers ([`Int] or [`Float]) and unwraps them. Ints are converted to floats. *) val filter_string : t list -> string list - (** Expects JSON strings and unwraps them. *) +(** Expects JSON strings and unwraps them. *) diff --git a/lib/write2.ml b/lib/write2.ml index 09062112..184775fb 100644 --- a/lib/write2.ml +++ b/lib/write2.ml @@ -1,9 +1,3 @@ - -let pretty_print ?std out x = - Pretty.pp ?std out x - -let pretty_to_string ?std x = - Pretty.to_string ?std x - -let pretty_to_channel ?std oc x = - Pretty.to_channel ?std oc x +let pretty_print ?std out x = Pretty.pp ?std out x +let pretty_to_string ?std x = Pretty.to_string ?std x +let pretty_to_channel ?std oc x = Pretty.to_channel ?std oc x diff --git a/lib/write2.mli b/lib/write2.mli index 8097f5bc..551f25d8 100644 --- a/lib/write2.mli +++ b/lib/write2.mli @@ -1,20 +1,20 @@ (** {2 JSON pretty-printing} *) val pretty_print : ?std:bool -> Format.formatter -> t -> unit - (** Pretty-print into a {!Format.formatter}. +(** Pretty-print into a {!Format.formatter}. See [to_string] for the role of the optional [std] argument. @raise Json_error if [float] value is not allowed in standard JSON. @since 1.3.1 *) val pretty_to_string : ?std:bool -> t -> string - (** Pretty-print into a string. +(** Pretty-print into a string. See [to_string] for the role of the optional [std] argument. See [pretty_print] for raised exceptions. *) val pretty_to_channel : ?std:bool -> out_channel -> t -> unit - (** Pretty-print to a channel. +(** Pretty-print to a channel. See [to_string] for the role of the optional [std] argument. See [pretty_print] for raised exceptions. *) diff --git a/test/compliance/test.ml b/test/compliance/test.ml index 3b4eb5f4..c3e99a6c 100644 --- a/test/compliance/test.ml +++ b/test/compliance/test.ml @@ -5,28 +5,19 @@ let test ~accepted ~rejected ~dir_name file_name = let json = Yojson.Basic.from_file @@ Filename.concat dir_name file_name in let pped = Yojson.Basic.show json in accepted file_name pped - with - | Yojson.Json_error msg -> - rejected file_name msg - -let pass = fun _ _ -> () + with Yojson.Json_error msg -> rejected file_name msg +let pass _ _ = () let fail fmt filename v = Alcotest.failf fmt filename v let test_parses = - test - ~accepted:pass + test ~accepted:pass ~rejected:(fail "%s is valid JSON but failed with Json_error %s") let test_rejects = - test - ~accepted:(fail "%s is invalid JSON but parsed to %s") - ~rejected:pass + test ~accepted:(fail "%s is invalid JSON but parsed to %s") ~rejected:pass -let test_any = - test - ~accepted:pass - ~rejected:pass +let test_any = test ~accepted:pass ~rejected:pass let test_file ~dir_name file_name = match file_name.[0] with @@ -39,13 +30,8 @@ let basic = let test_files = Array.to_list @@ Sys.readdir test_cases_dir in let sorted = List.sort String.compare test_files in List.rev_map - ( fun base_name -> - (base_name, `Quick, fun () -> test_file ~dir_name:test_cases_dir base_name) - ) + (fun base_name -> + (base_name, `Quick, fun () -> test_file ~dir_name:test_cases_dir base_name)) sorted -let () = - Alcotest.run - "RFC 8259 Compliance" - [ "Yojson.Basic", basic - ] +let () = Alcotest.run "RFC 8259 Compliance" [ ("Yojson.Basic", basic) ] diff --git a/test/fixtures.ml b/test/fixtures.ml index 8ad60876..956bcff9 100644 --- a/test/fixtures.ml +++ b/test/fixtures.ml @@ -1,29 +1,20 @@ let json_value = `Assoc - [ ("null", `Null) - ; ("bool", `Bool true) - ; ("int", `Int 0) - ; ("intlit", `Intlit "10000000000000000000") - ; ("float", `Float 0.) - ; ("string", `String "string") - ; ("list", `List [`Int 0; `Int 1; `Int 2]) + [ + ("null", `Null); + ("bool", `Bool true); + ("int", `Int 0); + ("intlit", `Intlit "10000000000000000000"); + ("float", `Float 0.); + ("string", `String "string"); + ("list", `List [ `Int 0; `Int 1; `Int 2 ]); ] let json_string = - "{" - ^ {|"null":null,|} - ^ {|"bool":true,|} - ^ {|"int":0,|} - ^ {|"intlit":10000000000000000000,|} - ^ {|"float":0.0,|} - ^ {|"string":"string",|} - ^ {|"list":[0,1,2]|} - ^ "}" + "{" ^ {|"null":null,|} ^ {|"bool":true,|} ^ {|"int":0,|} + ^ {|"intlit":10000000000000000000,|} ^ {|"float":0.0,|} + ^ {|"string":"string",|} ^ {|"list":[0,1,2]|} ^ "}" let unquoted_json = {|{foo: null}|} - -let unquoted_value = `Assoc [("foo", `Null)] - -let json_string_newline = - json_string - ^ "\n" +let unquoted_value = `Assoc [ ("foo", `Null) ] +let json_string_newline = json_string ^ "\n" diff --git a/test/fixtures.mli b/test/fixtures.mli index a2cf228c..69e36c91 100644 --- a/test/fixtures.mli +++ b/test/fixtures.mli @@ -1,13 +1,13 @@ (** Shared test fixtures *) -(** A json value to use for testing *) val json_value : Yojson.Safe.t +(** A json value to use for testing *) -(** A JSON string that must parse to [json_value] *) val json_string : string +(** A JSON string that must parse to [json_value] *) -(** The same JSON string terminated with a newline *) val json_string_newline : string +(** The same JSON string terminated with a newline *) val unquoted_json : string val unquoted_value : Yojson.Safe.t diff --git a/test/pretty/atd.ml b/test/pretty/atd.ml index 5079a57c..54675162 100644 --- a/test/pretty/atd.ml +++ b/test/pretty/atd.ml @@ -1,46 +1,52 @@ let massive_json = - `List [ - `Assoc [("r1", `String "testing")]; - `Assoc [("r2", `List [`String "Some"; `Int 2])]; - `Assoc [("r2", `String "None")]; - `Assoc [("r3", `List [`String "Some"; `Int 3])]; - `Assoc []; - `Assoc [("r4", `Bool true) ]; - `Assoc [("r5", `List [`String "Some"; `Int 5])]; - `Assoc []; - `Assoc [("r6", `Int 6)]; - `Assoc []; - `Assoc [("r7", `Int (-1_000))]; - `Assoc [("r8", `List [`Int 1; `Int 2; `Int 3])]; - `List [`String "foo"; `String "bar"]; - `List []; - `Null; - `List [`Int 1; `Int 2; `Int 3]; - `Int 99; - `Assoc [("foo", `Int 7); ("bar", `Int 8); ("baz", `Int 43)]; - `Assoc [("foo2", `Int 5); ("bar2", `Int 6); ("baz2", `Int 41); ("42", `Int 42)]; - `List [`Int 100; `String "foo"]; - `List [`Int 100; `Int 200; `Int 42]; - `List [`Int 100; `Int 200; `Int (-1)]; - `List [ - `String "V1"; - `String "v22"; - `List [`String "V3"; `String "testing"]; - `List [`String "V44"; `Int 255]; - `List [`String "V5"; `String "None"]; - `List [`String "V5"; `List [`String "Some"; `Bool true]] - ]; - `Assoc [("v2", `String "A")]; - `Assoc [("v2", `List [`String "B"; `Int 100])]; - `List [ - `String "C1"; - `List [`String "C2"; `Bool true]; - `List [`String "C2"; `Bool false]]; - `List[`Int 50; `Int 30; `Int (-1); `Int 400]; - ] + `List + [ + `Assoc [ ("r1", `String "testing") ]; + `Assoc [ ("r2", `List [ `String "Some"; `Int 2 ]) ]; + `Assoc [ ("r2", `String "None") ]; + `Assoc [ ("r3", `List [ `String "Some"; `Int 3 ]) ]; + `Assoc []; + `Assoc [ ("r4", `Bool true) ]; + `Assoc [ ("r5", `List [ `String "Some"; `Int 5 ]) ]; + `Assoc []; + `Assoc [ ("r6", `Int 6) ]; + `Assoc []; + `Assoc [ ("r7", `Int (-1_000)) ]; + `Assoc [ ("r8", `List [ `Int 1; `Int 2; `Int 3 ]) ]; + `List [ `String "foo"; `String "bar" ]; + `List []; + `Null; + `List [ `Int 1; `Int 2; `Int 3 ]; + `Int 99; + `Assoc [ ("foo", `Int 7); ("bar", `Int 8); ("baz", `Int 43) ]; + `Assoc + [ + ("foo2", `Int 5); ("bar2", `Int 6); ("baz2", `Int 41); ("42", `Int 42); + ]; + `List [ `Int 100; `String "foo" ]; + `List [ `Int 100; `Int 200; `Int 42 ]; + `List [ `Int 100; `Int 200; `Int (-1) ]; + `List + [ + `String "V1"; + `String "v22"; + `List [ `String "V3"; `String "testing" ]; + `List [ `String "V44"; `Int 255 ]; + `List [ `String "V5"; `String "None" ]; + `List [ `String "V5"; `List [ `String "Some"; `Bool true ] ]; + ]; + `Assoc [ ("v2", `String "A") ]; + `Assoc [ ("v2", `List [ `String "B"; `Int 100 ]) ]; + `List + [ + `String "C1"; + `List [ `String "C2"; `Bool true ]; + `List [ `String "C2"; `Bool false ]; + ]; + `List [ `Int 50; `Int 30; `Int (-1); `Int 400 ]; + ] let pp_json fmt json = Format.pp_print_string fmt (Yojson.Safe.pretty_to_string ~std:true json) -let () = - Format.printf "%a\n" pp_json massive_json +let () = Format.printf "%a\n" pp_json massive_json diff --git a/test/pretty/test.ml b/test/pretty/test.ml index e9101003..61e8f583 100644 --- a/test/pretty/test.ml +++ b/test/pretty/test.ml @@ -4,4 +4,3 @@ let () = let j = J.from_file "sample.json" in Format.printf "%a@." (J.pretty_print ?std:None) j; () - diff --git a/test/test.ml b/test/test.ml index eab1ccb6..501cf8e1 100644 --- a/test/test.ml +++ b/test/test.ml @@ -1,6 +1,7 @@ let () = - Alcotest.run "Yojson" [ - "equality", Test_monomorphic.equality; - "read", Test_read.single_json; - "write", Test_write.single_json; - ] + Alcotest.run "Yojson" + [ + ("equality", Test_monomorphic.equality); + ("read", Test_read.single_json); + ("write", Test_write.single_json); + ] diff --git a/test/test_monomorphic.ml b/test/test_monomorphic.ml index b7741d30..a2d0af9f 100644 --- a/test/test_monomorphic.ml +++ b/test/test_monomorphic.ml @@ -26,8 +26,8 @@ let scalar_equal () = let list_equal () = let open Testable in - let list = `List [int; int; float] in - let other_list = `List [int; other_int; float] in + let list = `List [ int; int; float ] in + let other_list = `List [ int; other_int; float ] in let empty_list = `List [] in Alcotest.(check yojson) "Equal lists" list list; Alcotest.(check (neg yojson)) "Unequal lists" list other_list; @@ -35,28 +35,28 @@ let list_equal () = let assoc_equal () = let open Testable in - let assoc = `Assoc [("a", int); ("b", float)] in - let other_assoc = `Assoc [("a", int); ("c", string)] in + let assoc = `Assoc [ ("a", int); ("b", float) ] in + let other_assoc = `Assoc [ ("a", int); ("c", string) ] in let empty_assoc = `Assoc [] in Alcotest.(check yojson) "Equal assocs" assoc assoc; Alcotest.(check (neg yojson)) "Unequal assocs" assoc other_assoc; Alcotest.(check (neg yojson)) "Empty assoc" assoc empty_assoc; - let simple_key = `Assoc [("a", int)] in - let duplicate_key = `Assoc [("a", int); ("a", int)] in - let different_values_duplicate = `Assoc [("a", int); ("a", float)] in - let flipped_values_duplicate = `Assoc [("a", float); ("a", int)] in - Alcotest.(check (neg yojson)) "Duplicate keys don't unify" simple_key duplicate_key; + let simple_key = `Assoc [ ("a", int) ] in + let duplicate_key = `Assoc [ ("a", int); ("a", int) ] in + let different_values_duplicate = `Assoc [ ("a", int); ("a", float) ] in + let flipped_values_duplicate = `Assoc [ ("a", float); ("a", int) ] in + Alcotest.(check (neg yojson)) + "Duplicate keys don't unify" simple_key duplicate_key; Alcotest.(check yojson) - "Duplicate keys should still be equal" - different_values_duplicate + "Duplicate keys should still be equal" different_values_duplicate different_values_duplicate; Alcotest.(check (neg yojson)) - "Duplicate keys not equal when different order" - different_values_duplicate + "Duplicate keys not equal when different order" different_values_duplicate flipped_values_duplicate -let equality = [ - "Scalar equality", `Quick, scalar_equal; - "List equality", `Quick, list_equal; - "Assoc equality", `Quick, assoc_equal; -] +let equality = + [ + ("Scalar equality", `Quick, scalar_equal); + ("List equality", `Quick, list_equal); + ("Assoc equality", `Quick, assoc_equal); + ] diff --git a/test/test_read.ml b/test/test_read.ml index 83c341cc..76dc1a42 100644 --- a/test/test_read.ml +++ b/test/test_read.ml @@ -1,7 +1,6 @@ let from_string () = Alcotest.(check Testable.yojson) - __LOC__ - Fixtures.json_value + __LOC__ Fixtures.json_value (Yojson.Safe.from_string Fixtures.json_string) let from_file () = @@ -9,13 +8,14 @@ let from_file () = let oc = open_out input_file in output_string oc Fixtures.json_string; close_out oc; - Alcotest.(check Testable.yojson) __LOC__ Fixtures.json_value (Yojson.Safe.from_file input_file); + Alcotest.(check Testable.yojson) + __LOC__ Fixtures.json_value + (Yojson.Safe.from_file input_file); Sys.remove input_file let unquoted_from_string () = Alcotest.(check Testable.yojson) - __LOC__ - Fixtures.unquoted_value + __LOC__ Fixtures.unquoted_value (Yojson.Safe.from_string Fixtures.unquoted_json) let map_ident_and_string () = @@ -25,17 +25,13 @@ let map_ident_and_string () = let ident_expected expectation reference start len = let identifier = String.sub reference start len in Alcotest.(check string) - (Format.asprintf "Reference '%s' start %d len %d matches '%s'" reference start len expectation) - expectation - identifier; + (Format.asprintf "Reference '%s' start %d len %d matches '%s'" reference + start len expectation) + expectation identifier; () in - let skip_over f = - f lexer_state lexbuf - in - let map_f mapper f = - mapper lexer_state f lexbuf - in + let skip_over f = f lexer_state lexbuf in + let map_f mapper f = mapper lexer_state f lexbuf in let map_ident = map_f Yojson.Safe.map_ident in let map_string = map_f Yojson.Safe.map_string in @@ -44,18 +40,18 @@ let map_ident_and_string () = skip_over Yojson.Safe.read_colon; let variant = skip_over Yojson.Safe.start_any_variant in - Alcotest.(check Testable.variant_kind) "String starts with double quote" `Double_quote variant; + Alcotest.(check Testable.variant_kind) + "String starts with double quote" `Double_quote variant; map_string (ident_expected "hello"); - Alcotest.check_raises - "Reading } raises End_of_object" - Yojson.End_of_object + Alcotest.check_raises "Reading } raises End_of_object" Yojson.End_of_object (fun () -> Yojson.Safe.read_object_end lexbuf) -let single_json = [ - "from_string", `Quick, from_string; - "from_file", `Quick, from_file; - "unquoted_from_string", `Quick, unquoted_from_string; - "map_ident/map_string", `Quick, map_ident_and_string; -] +let single_json = + [ + ("from_string", `Quick, from_string); + ("from_file", `Quick, from_file); + ("unquoted_from_string", `Quick, unquoted_from_string); + ("map_ident/map_string", `Quick, map_ident_and_string); + ] diff --git a/test/test_write.ml b/test/test_write.ml index d3b9211a..cffc7d27 100644 --- a/test/test_write.ml +++ b/test/test_write.ml @@ -1,11 +1,19 @@ let to_string_tests = - let test ?suf expected = - Alcotest.(check string) __LOC__ expected (Yojson.Safe.to_string ?suf Fixtures.json_value) + let test ?suf expected = + Alcotest.(check string) + __LOC__ expected + (Yojson.Safe.to_string ?suf Fixtures.json_value) in [ - "to_string with default settings", `Quick, (fun () -> test Fixtures.json_string); - "to_string with newline", `Quick, (fun () -> test ~suf:"\n" Fixtures.json_string_newline); - "to_string without newline", `Quick, (fun () -> test ~suf:"" Fixtures.json_string); + ( "to_string with default settings", + `Quick, + fun () -> test Fixtures.json_string ); + ( "to_string with newline", + `Quick, + fun () -> test ~suf:"\n" Fixtures.json_string_newline ); + ( "to_string without newline", + `Quick, + fun () -> test ~suf:"" Fixtures.json_string ); ] let to_file_tests = @@ -23,20 +31,26 @@ let to_file_tests = Alcotest.(check string) __LOC__ expected file_content in [ - "to_file with default settings", `Quick, (fun () -> test Fixtures.json_string_newline); - "to_file with newline", `Quick, (fun () -> test ~suf:"\n" Fixtures.json_string_newline); - "to_file without newline", `Quick, (fun () -> test ~suf:"" Fixtures.json_string); + ( "to_file with default settings", + `Quick, + fun () -> test Fixtures.json_string_newline ); + ( "to_file with newline", + `Quick, + fun () -> test ~suf:"\n" Fixtures.json_string_newline ); + ( "to_file without newline", + `Quick, + fun () -> test ~suf:"" Fixtures.json_string ); ] (* List.to_seq is not available on old OCaml versions. *) let rec list_to_seq = function - | [] -> (fun () -> Seq.Nil) - | x :: xs -> (fun () -> Seq.Cons (x, list_to_seq xs)) + | [] -> fun () -> Seq.Nil + | x :: xs -> fun () -> Seq.Cons (x, list_to_seq xs) let seq_to_file_tests = let test ?suf () = let output_file = Filename.temp_file "test_yojson_seq_to_file" ".json" in - let data = [`String "foo"; `String "bar"] in + let data = [ `String "foo"; `String "bar" ] in Yojson.Safe.seq_to_file ?suf output_file (list_to_seq data); let read_data = let seq = Yojson.Safe.seq_from_file output_file in @@ -45,17 +59,14 @@ let seq_to_file_tests = List.rev !acc in Sys.remove output_file; - Alcotest.(check (list Testable.yojson)) "seq_{to,from}_file roundtrip" data read_data + Alcotest.(check (list Testable.yojson)) + "seq_{to,from}_file roundtrip" data read_data in [ - "seq_to_file with default settings", `Quick, (fun () -> test ()); - "seq_to_file with newline", `Quick, (fun () -> test ~suf:"\n" ()); - "seq_to_file without newline", `Quick, (fun () -> test ~suf:"" ()); + ("seq_to_file with default settings", `Quick, fun () -> test ()); + ("seq_to_file with newline", `Quick, fun () -> test ~suf:"\n" ()); + ("seq_to_file without newline", `Quick, fun () -> test ~suf:"" ()); ] let single_json = - List.flatten [ - to_file_tests; - to_string_tests; - seq_to_file_tests; - ] + List.flatten [ to_file_tests; to_string_tests; seq_to_file_tests ] diff --git a/test/testable.ml b/test/testable.ml index 3a722154..5729a9e7 100644 --- a/test/testable.ml +++ b/test/testable.ml @@ -6,7 +6,7 @@ let variant_kind_pp fmt = function | `Double_quote -> Format.fprintf fmt "`Double_quote" let variant_kind_equal a b = - match a, b with + match (a, b) with | `Edgy_bracket, `Edgy_bracket -> true | `Square_bracket, `Square_bracket -> true | `Double_quote, `Double_quote -> true