pax_global_header00006660000000000000000000000064125724112710014514gustar00rootroot0000000000000052 comment=aea0fdb76374e6496fe0856b94185113d8dcf9e8 yojson-1.2.3/000077500000000000000000000000001257241127100130405ustar00rootroot00000000000000yojson-1.2.3/.gitignore000066400000000000000000000001441257241127100150270ustar00rootroot00000000000000*.cmi *.cmo *.cmx *.cmxs *.o *.a *.annot META basic.mli out.html read.ml ydump yojson.ml yojson.mli yojson-1.2.3/Changes000066400000000000000000000041271257241127100143370ustar00rootroot00000000000000Releases of yojson ================== !!! = some incompatibilities opt = optimizations +ui = additions in the user interface -ui = restrictions in the user interface bug = bug or security fix doc = major changes in the documentation pkg = changes in the structure of the package or in the installation procedure trunk: [bug] fix off-by-2 error in column error start location 2014-12-26 1.2.0: [+ui] new function Yojson.Safe.buffer_json for saving a raw JSON string while parsing in order to parse later 2014-01-19 1.1.8: [pkg] cmxs is now generated for supported platforms 2013-05-24 1.1.7: [bug] tolerate double quoted boolean "true" and "false" when a boolean is expected 2013-05-16 1.1.6: [bug] fix a bug in float printing. now print number of significant figures rather than decimal places for write_float_prec and write_std_float_prec 2013-03-19 1.1.5: [+ui] new function Yojson.sort to sort fields in objects, and corresponding cmdline option. 2012-12-31 1.1.4: [bug] proper support for escaped code points above U+FFFF 2012-03-19 1.1.3: [+ui] new function Yojson.to_output for writing to an OO channel; requires biniou >= 1.0.2 2012-02-27 1.1.2: [+ui] various enhancements 2012-02-07 1.1.1: [!!!] ydump now implies -s i.e. multiple whitespace-separated records are accepted. 2012-01-26 1.1.0: [!!!] Yojson.Biniou becomes Yojson_biniou, package yojson.biniou 2011-04-27 1.0.2: [+ui] improved error messages showing several lookahead bytes [+ui] factored out lexer_state and init_lexer definitions [+ui] added read_null_if_possible function (used by atdgen) 2011-01-22 1.0.1: [bug] fixed serialization of negative ints using the write_int function (affects atdgen) 2010-12-04 1.0.0: [!!!] now requires biniou version 1.0.0 or higher 2010-09-13 0.8.1: [doc] added INSTALL file 2010-08-04 0.8.0: first release yojson-1.2.3/INSTALL000066400000000000000000000012531257241127100140720ustar00rootroot00000000000000 Installation instructions for yojson Requirements: - Objective Caml (>= 3.11 is fine, earlier versions are probably fine too) - GNU make - Findlib (`ocamlfind' command) - easy-format - biniou - cppo GODI makes the installation process straightforward, although other package managers can be equally convenient. Manual installation is done using: make # or `make all' for the bytecode-only version make install # or `make BINDIR=/foo/bin install' for installing executables # in a place other than the guessed default. Uninstallation: make uninstall Bugs and feedback should be sent to Martin Jambon . yojson-1.2.3/LICENSE000066400000000000000000000025651257241127100140550ustar00rootroot00000000000000Copyright (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. yojson-1.2.3/META.in000066400000000000000000000007451257241127100141240ustar00rootroot00000000000000name = "yojson" version = "@@VERSION@@" description = "JSON parsing and printing (successor of json-wheel)" requires = "easy-format,biniou" archive(byte) = "yojson.cmo" archive(native) = "yojson.cmx" archive(native,plugin) = "yojson.cmxs" package "biniou" ( version = "@@VERSION@@" description = "JSON <=> Biniou conversion" requires = "easy-format,biniou" archive(byte) = "yojson_biniou.cmo" archive(native) = "yojson_biniou.cmx" archive(native,plugin) = "yojson_biniou.cmxs" ) yojson-1.2.3/Makefile000077500000000000000000000062341257241127100145100ustar00rootroot00000000000000VERSION = 1.2.3 ifeq "$(shell ocamlfind ocamlc -config |grep os_type)" "os_type: Win32" EXE=.exe else EXE= endif NATDYNLINK := $(shell if [ -f `ocamlfind ocamlc -where`/dynlink.cmxa ]; \ then echo YES; else echo NO; fi) FLAGS = -dtypes -g CMO = yojson.cmo yojson_biniou.cmo CMX = yojson.cmx yojson_biniou.cmx ifeq "${NATDYNLINK}" "YES" CMXS = yojson.cmxs yojson_biniou.cmxs endif PACKS = easy-format,biniou .PHONY: default all opt install uninstall install-lib uninstall-lib \ reinstall doc install-doc default: META all opt all: $(CMO) opt: $(CMX) $(CMXS) ydump$(EXE) ifndef PREFIX PREFIX = $(shell dirname $$(dirname $$(which ocamlfind))) export PREFIX endif ifndef BINDIR BINDIR = $(PREFIX)/bin export BINDIR endif META: META.in Makefile sed -e 's:@@VERSION@@:$(VERSION):' META.in > META install: META install-lib test ! -f ydump || cp ydump $(BINDIR)/ test ! -f ydump.exe || cp ydump.exe $(BINDIR)/ install-lib: ocamlfind install yojson META \ $$(ls yojson.mli yojson_biniou.mli \ yojson.cmi yojson_biniou.cmi \ $(CMO) $(CMX) $(CMXS) \ yojson.o yojson_biniou.o) uninstall: uninstall-lib test ! -f $(BINDIR)/ydump || rm $(BINDIR)/ydump test ! -f $(BINDIR)/ydump.exe || rm $(BINDIR)/ydump.exe uninstall-lib: ocamlfind remove yojson reinstall: $(MAKE) BINDIR=$(BINDIR) uninstall $(MAKE) BINDIR=$(BINDIR) install read.ml: read.mll ocamllex read.mll yojson.mli: yojson.mli.cppo \ common.mli type.ml safe.mli write.mli pretty.mli write2.mli \ read.mli util.mli cppo -n yojson.mli.cppo -o yojson.mli yojson.ml: yojson.ml.cppo \ common.ml type.ml safe.ml write.ml pretty.ml write2.ml \ read.ml util.ml cppo -D "VERSION $(VERSION)" yojson.ml.cppo -o yojson.ml yojson.cmi: yojson.mli ocamlfind ocamlc -c $(FLAGS) -package $(PACKS) yojson.mli yojson.cmo: yojson.cmi yojson.ml ocamlfind ocamlc -c $(FLAGS) -package $(PACKS) yojson.ml yojson.cmx: yojson.cmi yojson.ml ocamlfind ocamlopt -c $(FLAGS) -package $(PACKS) yojson.ml yojson.cmxs: yojson.cmx ocamlfind ocamlopt -shared -linkall -I . -o yojson.cmxs yojson.cmx yojson_biniou.cmi: yojson_biniou.mli ocamlfind ocamlc -c $(FLAGS) -package $(PACKS) yojson_biniou.mli yojson_biniou.cmo: yojson_biniou.cmi yojson_biniou.ml ocamlfind ocamlc -c $(FLAGS) -package $(PACKS) yojson_biniou.ml yojson_biniou.cmx: yojson_biniou.cmi yojson_biniou.ml ocamlfind ocamlopt -c $(FLAGS) -package $(PACKS) yojson_biniou.ml yojson_biniou.cmxs: yojson_biniou.cmx ocamlfind ocamlopt -shared -linkall -I . -o yojson_biniou.cmxs \ yojson_biniou.cmx ydump$(EXE): yojson.cmx yojson_biniou.cmx ydump.ml ocamlfind ocamlopt -o ydump$(EXE) $(FLAGS) -package $(PACKS) -linkpkg \ $(CMX) ydump.ml doc: doc/index.html doc/index.html: yojson.mli yojson_biniou.mli mkdir -p doc ocamlfind ocamldoc -d doc -html -package biniou \ yojson.mli yojson_biniou.mli install-doc: cp doc/* $$WWW/yojson-doc/ bench: bench.ml yojson.cmx META ocamlfind ocamlopt -o bench \ -package unix,yojson,json-wheel -linkpkg bench.ml .PHONY: clean clean: rm -f *.o *.a *.cm* *~ *.annot ydump ydump.exe \ read.ml yojson.mli yojson.ml META rm -rf doc cd examples; $(MAKE) clean yojson-1.2.3/README.md000066400000000000000000000026121257241127100143200ustar00rootroot00000000000000Yojson: JSON library for OCaml ============================== The main project page is http://mjambon.com/yojson.html Yojson supersedes json-wheel. Design goals ------------ * reducing inter-package dependencies by the use of polymorphic variants for the JSON tree type * allowing variants of the JSON tree type to be shipped by the library itself or to be easily created as extensions of the library * allowing type-aware serializers/deserializers such as json-static to read and write directly without going through a JSON tree, for efficiency purposes. This requires making readers and writers of JSON atoms (int, string, etc.) to be exported and composable. * providing a few non-standard, optional extensions of JSON. These extensions will include: * optional quotes around "simple" field/constructor names * a syntax for tuples (at least 2 elements): (x, y) * a syntax for variants (0 or 1 arg only): Other choices already in json-wheel ----------------------------------- * distinction between ints and floats (optional) * Getting rid of the UTF-X encoding constraint that prevents from exchanging binary data: * encoding is ASCII except for the contents of string literals * string literals may represent arbitrary sequence of bytes * \uABCD escapes in string literals expand to UTF-8 Miscellaneous ------------- * no dependency on ocamlnet for UTF-8 yojson-1.2.3/bench.ml000066400000000000000000000022121257241127100144460ustar00rootroot00000000000000open Printf let data = let l = ref [] in try while true do l := input_line stdin :: !l done; assert false with End_of_file -> String.concat "\n" (List.rev !l) let yojson_data = Yojson.Safe.from_string data let jsonwheel_data = Json_io.json_of_string data let n = 10_000 let yojson_rd_loop () = for i = 1 to n do ignore (Yojson.Safe.from_string data) done let yojson_wr_loop () = for i = 1 to n do ignore (Yojson.Safe.to_string yojson_data) done let jsonwheel_rd_loop () = for i = 1 to n do ignore (Json_io.json_of_string data) done let jsonwheel_wr_loop () = for i = 1 to n do ignore (Json_io.string_of_json ~compact:true jsonwheel_data) done let time msg f = let t1 = Unix.gettimeofday () in f (); let t2 = Unix.gettimeofday () in printf "%s: %.3f\n%!" msg (t2 -. t1) let () = time "rd yojson" yojson_rd_loop; time "rd json-wheel" jsonwheel_rd_loop; time "rd yojson" yojson_rd_loop; time "rd json-wheel" jsonwheel_rd_loop; time "wr yojson" yojson_wr_loop; time "wr json-wheel" jsonwheel_wr_loop; time "wr yojson" yojson_wr_loop; time "wr json-wheel" jsonwheel_wr_loop yojson-1.2.3/common.ml000066400000000000000000000063121257241127100146640ustar00rootroot00000000000000let version = STRINGIFY(VERSION) exception Json_error of string let json_error s = raise (Json_error s) exception End_of_array 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 } let utf8_of_code buf x = let add = Bi_outbuf.add_char in (* Straight <= doesn't work with signed 31-bit ints *) let maxbits n x = x lsr n = 0 in 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))) ) 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))) ) 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))); ) 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))); ) else ( assert (maxbits 31 x); (* 1 + 6 + 6 + 6 + 6 + 6 *) add buf (Char.chr (0b11111100 lor ((x lsr 30) land 0b00000001))); 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))); ) let code_of_surrogate_pair i j = let high10 = i - 0xD800 in let low10 = j - 0xDC00 in 0x10000 + ((high10 lsl 10) lor low10) let utf8_of_surrogate_pair buf i j = utf8_of_code buf (code_of_surrogate_pair i j) let is_object_or_array x = match x with `List _ | `Assoc _ -> true | _ -> false type lexer_state = { buf : Bi_outbuf.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 *) } module Lexer_state = struct type t = lexer_state = { buf : Bi_outbuf.t; mutable lnum : int; mutable bol : int; mutable fname : string option; } end let init_lexer ?buf ?fname ?(lnum = 1) () = let buf = match buf with None -> Bi_outbuf.create 256 | Some buf -> buf in { buf = buf; lnum = lnum; bol = 0; fname = fname } yojson-1.2.3/common.mli000066400000000000000000000016711257241127100150400ustar00rootroot00000000000000val version : string exception Json_error of string val json_error : string -> 'a type lexer_state = { buf : Bi_outbuf.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 (counting from 0) *) mutable fname : string option; (** Name referencing the input file in error messages *) } module Lexer_state : sig type t = lexer_state = { buf : Bi_outbuf.t; mutable lnum : int; mutable bol : int; mutable fname : string option; } end val init_lexer : ?buf: Bi_outbuf.t -> ?fname: string -> ?lnum: int -> unit -> lexer_state (** Create a fresh lexer_state record. *) (**/**) (* begin undocumented section *) exception End_of_array exception End_of_object exception End_of_tuple exception End_of_input (* end undocumented section *) (**/**) yojson-1.2.3/examples/000077500000000000000000000000001257241127100146565ustar00rootroot00000000000000yojson-1.2.3/examples/Makefile000066400000000000000000000001361257241127100163160ustar00rootroot00000000000000.PHONY: default default: ./run-examples.sh clean: rm -f *.o *.a *.cm* *~ *.annot filtering yojson-1.2.3/examples/filtering.json000066400000000000000000000007171257241127100175410ustar00rootroot00000000000000{ "id": "398eb027", "name": "John Doe", "pages": [ { "id": 1, "title": "The Art of Flipping Coins", "url": "http://example.com/398eb027/1" }, { "id": 2, "deleted": true }, { "id": 3, "title": "Artichoke Salad", "url": "http://example.com/398eb027/3" }, { "id": 4, "title": "Flying Bananas", "url": "http://example.com/398eb027/4" } ] } yojson-1.2.3/examples/filtering.ml000066400000000000000000000014531257241127100171760ustar00rootroot00000000000000(* ocamlfind ocamlopt -o filtering filtering.ml -package yojson -linkpkg ./filtering < filter_member "pages" |> flatten |> filter_member "title" |> filter_string let main () = let json = Yojson.Basic.from_channel stdin in List.iter print_endline (extract_titles json) let () = main () yojson-1.2.3/examples/run-examples.sh000077500000000000000000000002271257241127100176360ustar00rootroot00000000000000#! /bin/sh echo "----- Example 1: filtering -----" ocamlfind ocamlopt -o filtering filtering.ml -package yojson -linkpkg ./filtering < filtering.json yojson-1.2.3/pretty.ml000066400000000000000000000035351257241127100147270ustar00rootroot00000000000000open Printf open Easy_format let array = list let record = list let tuple = { list with space_after_opening = false; space_before_closing = false; align_closing = false } let variant = { list with space_before_closing = false; } let rec format std (x : json) = match x with `Null -> Atom ("null", atom) | `Bool x -> Atom ((if x then "true" else "false"), atom) | `Int x -> Atom (json_string_of_int x, atom) | `Float x -> let s = if std then std_json_string_of_float x else json_string_of_float x in Atom (s, atom) | `String s -> Atom (json_string_of_string s, atom) | `Intlit s | `Floatlit s | `Stringlit s -> Atom (s, atom) | `List [] -> Atom ("[]", atom) | `List l -> List (("[", ",", "]", array), List.map (format std) l) | `Assoc [] -> Atom ("{}", atom) | `Assoc l -> List (("{", ",", "}", record), List.map (format_field std) l) | `Tuple l -> if std then format std (`List l) else if l = [] then Atom ("()", atom) else List (("(", ",", ")", tuple), List.map (format std) l) | `Variant (s, None) -> if std then format std (`String s) else Atom ("<" ^ json_string_of_string s ^ ">", atom) | `Variant (s, Some x) -> if std then format std (`List [ `String s; x ]) else let op = "<" ^ json_string_of_string s ^ ":" in List ((op, "", ">", variant), [format std x]) and format_field std (name, x) = let s = sprintf "%s:" (json_string_of_string name) in Label ((Atom (s, atom), label), format std x) let format ?(std = false) x = if std && not (is_object_or_array x) then json_error "Root is not an object or array as requested by the JSON standard" else format std (x :> json) let to_string ?std x = Easy_format.Pretty.to_string (format ?std x) let to_channel ?std oc x = Easy_format.Pretty.to_channel oc (format ?std x) yojson-1.2.3/pretty.mli000066400000000000000000000002261257241127100150720ustar00rootroot00000000000000val format : ?std:bool -> json -> Easy_format.t val to_string : ?std:bool -> json -> string val to_channel : ?std:bool -> out_channel -> json -> unit yojson-1.2.3/read.mli000066400000000000000000000201161257241127100144560ustar00rootroot00000000000000val prettify : ?std:bool -> string -> string (** Combined parser and pretty-printer. See [to_string] for the role of the optional [std] argument. *) val compact : ?std:bool -> string -> string (** Combined parser and printer. See [to_string] for the role of the optional [std] argument. *) (** {2 JSON readers} *) val from_string : ?buf:Bi_outbuf.t -> ?fname:string -> ?lnum:int -> string -> json (** 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 not have to be a real file. @param lnum number of the first line of input. Default is 1. *) val from_channel : ?buf:Bi_outbuf.t -> ?fname:string -> ?lnum:int -> in_channel -> json (** Read a JSON value from a channel. See [from_string] for the meaning of the optional arguments. *) val from_file : ?buf:Bi_outbuf.t -> ?fname:string -> ?lnum:int -> string -> json (** Read a JSON value from a file. See [from_string] for the meaning of the optional arguments. *) type lexer_state = Lexer_state.t = { buf : Bi_outbuf.t; mutable lnum : int; mutable bol : int; mutable fname : string option; } (** This alias is provided for backward compatibility. New code should refer to {!Yojson.lexer_state} directly. *) val init_lexer : ?buf: Bi_outbuf.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 -> json (** 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. @param stream indicates whether more data may follow. The default value is false and indicates that only JSON whitespace can be found between the end of the JSON value and the end of the input. *) val stream_from_string : ?buf:Bi_outbuf.t -> ?fname:string -> ?lnum:int -> string -> json Stream.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. *) val stream_from_channel : ?buf:Bi_outbuf.t -> ?fin:(unit -> unit) -> ?fname:string -> ?lnum:int -> in_channel -> json Stream.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 stream is reached either because there is no more input or because the input could not be parsed, raising an exception. See [from_string] for the meaning of the other optional arguments. *) val stream_from_file : ?buf:Bi_outbuf.t -> ?fname:string -> ?lnum:int -> string -> json Stream.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. *) val stream_from_lexbuf : lexer_state -> ?fin:(unit -> unit) -> Lexing.lexbuf -> json Stream.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. See [stream_from_channel] for the meaning of the optional [fin] argument. *) type json_line = [ `Json of json | `Exn of exn ] (** The type of values resulting from a parsing attempt of a JSON value. *) val linestream_from_channel : ?buf:Bi_outbuf.t -> ?fin:(unit -> unit) -> ?fname:string -> ?lnum:int -> in_channel -> json_line Stream.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]. See [stream_from_channel] for the meaning of the optional [fin] argument. See [from_string] for the meaning of the other optional arguments. *) val linestream_from_file : ?buf:Bi_outbuf.t -> ?fname:string -> ?lnum:int -> string -> json_line Stream.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]. See [stream_from_channel] for the meaning of the optional [fin] argument. See [from_string] for the meaning of the other optional arguments. *) (**/**) (* 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 *) val map_ident : lexer_state -> (string -> int -> int -> 'a) -> Lexing.lexbuf -> 'a (* 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 -> json 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 val read_null_if_possible : lexer_state -> Lexing.lexbuf -> bool val read_bool : lexer_state -> Lexing.lexbuf -> bool val read_int : lexer_state -> Lexing.lexbuf -> int val read_int8 : lexer_state -> Lexing.lexbuf -> char val read_int32 : lexer_state -> Lexing.lexbuf -> int32 val read_int64 : lexer_state -> Lexing.lexbuf -> int64 val read_number : lexer_state -> Lexing.lexbuf -> float val skip_ident : lexer_state -> Lexing.lexbuf -> unit val read_sequence : ('a -> lexer_state -> Lexing.lexbuf -> 'a) -> 'a -> lexer_state -> Lexing.lexbuf -> 'a val read_list : (lexer_state -> Lexing.lexbuf -> 'a) -> lexer_state -> Lexing.lexbuf -> 'a list val read_list_rev : (lexer_state -> Lexing.lexbuf -> 'a) -> lexer_state -> Lexing.lexbuf -> 'a list val read_array_end : Lexing.lexbuf -> unit val read_array_sep : lexer_state -> Lexing.lexbuf -> unit val read_array : (lexer_state -> Lexing.lexbuf -> 'a) -> lexer_state -> Lexing.lexbuf -> 'a array val read_tuple : (int -> 'a -> lexer_state -> Lexing.lexbuf -> 'a) -> 'a -> lexer_state -> Lexing.lexbuf -> 'a val start_any_tuple : lexer_state -> Lexing.lexbuf -> bool val read_lpar : lexer_state -> Lexing.lexbuf -> unit val read_rpar : lexer_state -> Lexing.lexbuf -> unit val read_tuple_end : Lexing.lexbuf -> unit val read_tuple_end2 : lexer_state -> bool -> Lexing.lexbuf -> unit val read_tuple_sep : lexer_state -> Lexing.lexbuf -> unit val read_tuple_sep2 : lexer_state -> bool -> Lexing.lexbuf -> unit val read_lbr : lexer_state -> Lexing.lexbuf -> unit val read_rbr : lexer_state -> Lexing.lexbuf -> unit val read_fields : ('acc -> string -> lexer_state -> Lexing.lexbuf -> 'acc) -> 'acc -> lexer_state -> 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 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 -> json val skip_json : lexer_state -> Lexing.lexbuf -> unit val buffer_json : lexer_state -> Lexing.lexbuf -> unit (* end undocumented section *) (**/**) yojson-1.2.3/read.mll000066400000000000000000001110621257241127100144620ustar00rootroot00000000000000{ module Lexing = (* We override Lexing.engine in order to avoid creating a new position record each time a rule is matched. This reduces total parsing time by about 31%. *) struct include Lexing external c_engine : lex_tables -> int -> lexbuf -> int = "caml_lex_engine" let engine tbl state buf = let result = c_engine tbl state buf in (* if result >= 0 then begin buf.lex_start_p <- buf.lex_curr_p; buf.lex_curr_p <- {buf.lex_curr_p with pos_cnum = buf.lex_abs_pos + buf.lex_curr_pos}; end; *) result end open Printf open Lexing (* see description in common.mli *) type lexer_state = Lexer_state.t = { buf : Bi_outbuf.t; mutable lnum : int; mutable bol : int; mutable fname : string option; } let dec c = Char.code c - 48 let hex c = match c with '0'..'9' -> int_of_char c - int_of_char '0' | 'a'..'f' -> int_of_char c - int_of_char 'a' + 10 | 'A'..'F' -> int_of_char c - int_of_char 'A' + 10 | _ -> assert false let custom_error descr v lexbuf = let offs = lexbuf.lex_abs_pos - 1 in let bol = v.bol in let pos1 = offs + lexbuf.lex_start_pos - bol - 1 in let pos2 = max pos1 (offs + lexbuf.lex_curr_pos - bol) in let file_line = match v.fname with None -> "Line" | Some s -> sprintf "File %s, line" s in let bytes = if pos1 = pos2 then sprintf "byte %i" (pos1+1) else sprintf "bytes %i-%i" (pos1+1) (pos2+1) in let msg = sprintf "%s %i, %s:\n%s" file_line v.lnum bytes descr in json_error msg let lexer_error descr v lexbuf = custom_error (sprintf "%s '%s'" descr (Lexing.lexeme lexbuf)) v lexbuf let read_junk = ref (fun _ -> assert false) let long_error descr v lexbuf = let junk = Lexing.lexeme lexbuf in let extra_junk = !read_junk lexbuf in custom_error (sprintf "%s '%s%s'" descr junk extra_junk) v lexbuf let min10 = min_int / 10 - (if min_int mod 10 = 0 then 0 else 1) let max10 = max_int / 10 + (if max_int mod 10 = 0 then 0 else 1) exception Int_overflow let extract_positive_int lexbuf = let start = lexbuf.lex_start_pos in let stop = lexbuf.lex_curr_pos in let s = lexbuf.lex_buffer in let n = ref 0 in for i = start to stop - 1 do if !n >= max10 then raise Int_overflow else n := 10 * !n + dec s.[i] done; if !n < 0 then raise Int_overflow else !n let make_positive_int v lexbuf = #ifdef INT try `Int (extract_positive_int lexbuf) with Int_overflow -> #endif #ifdef INTLIT `Intlit (lexeme lexbuf) #else lexer_error "Int overflow" v lexbuf #endif let extract_negative_int lexbuf = let start = lexbuf.lex_start_pos + 1 in let stop = lexbuf.lex_curr_pos in let s = lexbuf.lex_buffer in let n = ref 0 in for i = start to stop - 1 do if !n <= min10 then raise Int_overflow else n := 10 * !n - dec s.[i] done; if !n > 0 then raise Int_overflow else !n let make_negative_int v lexbuf = #ifdef INT try `Int (extract_negative_int lexbuf) with Int_overflow -> #endif #ifdef INTLIT `Intlit (lexeme lexbuf) #else lexer_error "Int overflow" v lexbuf #endif let set_file_name v fname = v.fname <- fname let newline v lexbuf = v.lnum <- v.lnum + 1; v.bol <- lexbuf.lex_abs_pos + lexbuf.lex_curr_pos let add_lexeme buf lexbuf = let len = lexbuf.lex_curr_pos - lexbuf.lex_start_pos in Bi_outbuf.add_substring buf lexbuf.lex_buffer lexbuf.lex_start_pos len let map_lexeme f lexbuf = let len = lexbuf.lex_curr_pos - lexbuf.lex_start_pos in f lexbuf.lex_buffer lexbuf.lex_start_pos len type variant_kind = [ `Edgy_bracket | `Square_bracket | `Double_quote ] type tuple_kind = [ `Parenthesis | `Square_bracket ] } let space = [' ' '\t' '\r']+ let digit = ['0'-'9'] let nonzero = ['1'-'9'] let digits = digit+ let frac = '.' digits let e = ['e' 'E']['+' '-']? let exp = e digits let positive_int = (digit | nonzero digits) let float = '-'? positive_int (frac | exp | frac exp) let number = '-'? positive_int (frac | exp | frac exp)? let hex = [ '0'-'9' 'a'-'f' 'A'-'F' ] let ident = ['a'-'z' 'A'-'Z' '_']['a'-'z' 'A'-'Z' '_' '0'-'9']* let optjunk4 = (eof | _ (eof | _ (eof | _ (eof | _)))) let optjunk8 = (eof | _ (eof | _ (eof | _ (eof | _ (eof | optjunk4))))) let optjunk12 = (eof | _ (eof | _ (eof | _ (eof | _ (eof | optjunk8))))) let optjunk16 = (eof | _ (eof | _ (eof | _ (eof | _ (eof | optjunk12))))) let optjunk20 = (eof | _ (eof | _ (eof | _ (eof | _ (eof | optjunk16))))) let optjunk24 = (eof | _ (eof | _ (eof | _ (eof | _ (eof | optjunk20))))) let optjunk28 = (eof | _ (eof | _ (eof | _ (eof | _ (eof | optjunk24))))) let optjunk32 = (eof | _ (eof | _ (eof | _ (eof | _ (eof | optjunk28))))) let junk = _ optjunk32 rule read_json v = parse | "true" { `Bool true } | "false" { `Bool false } | "null" { `Null } | "NaN" { #ifdef FLOAT `Float nan #elif defined FLOATLIT `Floatlit "NaN" #endif } | "Infinity" { #ifdef FLOAT `Float infinity #elif defined FLOATLIT `Floatlit "Infinity" #endif } | "-Infinity" { #ifdef FLOAT `Float neg_infinity #elif defined FLOATLIT `Floatlit "-Infinity" #endif } | '"' { #ifdef STRING Bi_outbuf.clear v.buf; `String (finish_string v lexbuf) #elif defined STRINGLIT `Stringlit (finish_stringlit v lexbuf) #endif } | positive_int { make_positive_int v lexbuf } | '-' positive_int { make_negative_int v lexbuf } | float { #ifdef FLOAT `Float (float_of_string (lexeme lexbuf)) #elif defined FLOATLIT `Floatlit (lexeme lexbuf) #endif } | '{' { let acc = ref [] in try read_space v lexbuf; read_object_end lexbuf; let field_name = read_ident v lexbuf in read_space v lexbuf; read_colon v lexbuf; read_space v lexbuf; acc := (field_name, read_json v lexbuf) :: !acc; while true do read_space v lexbuf; read_object_sep v lexbuf; read_space v lexbuf; let field_name = read_ident v lexbuf in read_space v lexbuf; read_colon v lexbuf; read_space v lexbuf; acc := (field_name, read_json v lexbuf) :: !acc; done; assert false with End_of_object -> `Assoc (List.rev !acc) } | '[' { let acc = ref [] in try read_space v lexbuf; read_array_end lexbuf; acc := read_json v lexbuf :: !acc; while true do read_space v lexbuf; read_array_sep v lexbuf; read_space v lexbuf; acc := read_json v lexbuf :: !acc; done; assert false with End_of_array -> `List (List.rev !acc) } | '(' { #ifdef TUPLE let acc = ref [] in try read_space v lexbuf; read_tuple_end lexbuf; acc := read_json v lexbuf :: !acc; while true do read_space v lexbuf; read_tuple_sep v lexbuf; read_space v lexbuf; acc := read_json v lexbuf :: !acc; done; assert false with End_of_tuple -> `Tuple (List.rev !acc) #else long_error "Invalid token" v lexbuf #endif } | '<' { #ifdef VARIANT read_space v lexbuf; let cons = read_ident v lexbuf in read_space v lexbuf; `Variant (cons, finish_variant v lexbuf) #else long_error "Invalid token" v lexbuf #endif } | "//"[^'\n']* { read_json v lexbuf } | "/*" { finish_comment v lexbuf; read_json v lexbuf } | "\n" { newline v lexbuf; read_json v lexbuf } | space { read_json v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } | _ { long_error "Invalid token" v lexbuf } and finish_string v = parse '"' { Bi_outbuf.contents v.buf } | '\\' { finish_escaped_char v lexbuf; finish_string v lexbuf } | [^ '"' '\\']+ { add_lexeme v.buf lexbuf; finish_string v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and map_string v f = parse '"' { let b = v.buf in f b.Bi_outbuf.o_s 0 b.Bi_outbuf.o_len } | '\\' { finish_escaped_char v lexbuf; map_string v f lexbuf } | [^ '"' '\\']+ { add_lexeme v.buf lexbuf; map_string v f lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and finish_escaped_char v = parse '"' | '\\' | '/' as c { Bi_outbuf.add_char v.buf c } | 'b' { Bi_outbuf.add_char v.buf '\b' } | 'f' { Bi_outbuf.add_char v.buf '\012' } | 'n' { Bi_outbuf.add_char v.buf '\n' } | 'r' { Bi_outbuf.add_char v.buf '\r' } | 't' { Bi_outbuf.add_char v.buf '\t' } | 'u' (hex as a) (hex as b) (hex as c) (hex as d) { let x = (hex a lsl 12) lor (hex b lsl 8) lor (hex c lsl 4) lor hex d in if x >= 0xD800 && x <= 0xDBFF then finish_surrogate_pair v x lexbuf else utf8_of_code v.buf x } | _ { long_error "Invalid escape sequence" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and finish_surrogate_pair v x = parse | "\\u" (hex as a) (hex as b) (hex as c) (hex as d) { let y = (hex a lsl 12) lor (hex b lsl 8) lor (hex c lsl 4) lor hex d in if y >= 0xDC00 && y <= 0xDFFF then utf8_of_surrogate_pair v.buf x y else long_error "Invalid low surrogate for code point beyond U+FFFF" v lexbuf } | _ { long_error "Missing escape sequence representing low surrogate \ for code point beyond U+FFFF" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and finish_stringlit v = parse ( '\\' (['"' '\\' '/' 'b' 'f' 'n' 'r' 't'] | 'u' hex hex hex hex) | [^'"' '\\'] )* '"' { let len = lexbuf.lex_curr_pos - lexbuf.lex_start_pos in let s = String.create (len+1) in s.[0] <- '"'; String.blit lexbuf.lex_buffer lexbuf.lex_start_pos s 1 len; s } | _ { long_error "Invalid string literal" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and finish_variant v = parse ':' { let x = read_json v lexbuf in read_space v lexbuf; read_gt v lexbuf; Some x } | '>' { None } | _ { long_error "Expected ':' or '>' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_lt v = parse '<' { () } | _ { long_error "Expected '<' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_gt v = parse '>' { () } | _ { long_error "Expected '>' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_comma v = parse ',' { () } | _ { long_error "Expected ',' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and start_any_variant v = parse '<' { `Edgy_bracket } | '"' { Bi_outbuf.clear v.buf; `Double_quote } | '[' { `Square_bracket } | _ { long_error "Expected '<', '\"' or '[' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and finish_comment v = parse | "*/" { () } | eof { long_error "Unterminated comment" v lexbuf } | '\n' { newline v lexbuf; finish_comment v lexbuf } | _ { finish_comment v lexbuf } (* Readers expecting a particular JSON construct *) and read_eof = parse eof { true } | "" { false } and read_space v = parse | "//"[^'\n']* ('\n'|eof) { newline v lexbuf; read_space v lexbuf } | "/*" { finish_comment v lexbuf; read_space v lexbuf } | '\n' { newline v lexbuf; read_space v lexbuf } | [' ' '\t' '\r']+ { read_space v lexbuf } | "" { () } and read_null v = parse "null" { () } | _ { long_error "Expected 'null' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_null_if_possible v = parse "null" { true } | "" { false } and read_bool v = parse "true" { true } | "false" { false } (* tolerate booleans passed as strings without \u obfuscation *) | "\"true\"" { true } | "\"false\"" { false } | _ { long_error "Expected 'true' or 'false' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_int v = parse positive_int { try extract_positive_int lexbuf with Int_overflow -> lexer_error "Int overflow" v lexbuf } | '-' positive_int { try extract_negative_int lexbuf with Int_overflow -> lexer_error "Int overflow" v lexbuf } | '"' { (* Support for double-quoted "ints" *) Bi_outbuf.clear v.buf; let s = finish_string v lexbuf in try (* Any OCaml-compliant int will pass, including hexadecimal and octal notations, and embedded underscores *) int_of_string s with _ -> custom_error "Expected an integer but found a string that \ doesn't even represent an integer" v lexbuf } | _ { long_error "Expected integer but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_int32 v = parse '-'? positive_int { try Int32.of_string (Lexing.lexeme lexbuf) with _ -> lexer_error "Int32 overflow" v lexbuf } | '"' { (* Support for double-quoted "ints" *) Bi_outbuf.clear v.buf; let s = finish_string v lexbuf in try (* Any OCaml-compliant int will pass, including hexadecimal and octal notations, and embedded underscores *) Int32.of_string s with _ -> custom_error "Expected an int32 but found a string that \ doesn't even represent an integer" v lexbuf } | _ { long_error "Expected int32 but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_int64 v = parse '-'? positive_int { try Int64.of_string (Lexing.lexeme lexbuf) with _ -> lexer_error "Int32 overflow" v lexbuf } | '"' { (* Support for double-quoted "ints" *) Bi_outbuf.clear v.buf; let s = finish_string v lexbuf in try (* Any OCaml-compliant int will pass, including hexadecimal and octal notations, and embedded underscores *) Int64.of_string s with _ -> custom_error "Expected an int64 but found a string that \ doesn't even represent an integer" v lexbuf } | _ { long_error "Expected int64 but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_number v = parse | "NaN" { nan } | "Infinity" { infinity } | "-Infinity" { neg_infinity } | number { float_of_string (lexeme lexbuf) } | '"' { Bi_outbuf.clear v.buf; let s = finish_string v lexbuf in try (* Any OCaml-compliant float will pass, including hexadecimal and octal notations, and embedded underscores. *) float_of_string s with _ -> match s with "NaN" -> nan | "Infinity" -> infinity | "-Infinity" -> neg_infinity | _ -> custom_error "Expected a number but found a string that \ doesn't even represent a number" v lexbuf } | _ { long_error "Expected number but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_string v = parse '"' { Bi_outbuf.clear v.buf; finish_string v lexbuf } | _ { long_error "Expected '\"' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_ident v = parse '"' { Bi_outbuf.clear v.buf; finish_string v lexbuf } | ident as s { s } | _ { long_error "Expected string or identifier but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and map_ident v f = parse '"' { Bi_outbuf.clear v.buf; map_string v f lexbuf } | ident { map_lexeme f lexbuf } | _ { long_error "Expected string or identifier but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_sequence read_cell init_acc v = parse '[' { let acc = ref init_acc in try read_space v lexbuf; read_array_end lexbuf; acc := read_cell !acc v lexbuf; while true do read_space v lexbuf; read_array_sep v lexbuf; read_space v lexbuf; acc := read_cell !acc v lexbuf; done; assert false with End_of_array -> !acc } | _ { long_error "Expected '[' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_list_rev read_cell v = parse '[' { let acc = ref [] in try read_space v lexbuf; read_array_end lexbuf; acc := read_cell v lexbuf :: !acc; while true do read_space v lexbuf; read_array_sep v lexbuf; read_space v lexbuf; acc := read_cell v lexbuf :: !acc; done; assert false with End_of_array -> !acc } | _ { long_error "Expected '[' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_array_end = parse ']' { raise End_of_array } | "" { () } and read_array_sep v = parse ',' { () } | ']' { raise End_of_array } | _ { long_error "Expected ',' or ']' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_tuple read_cell init_acc v = parse '(' { #ifdef TUPLE let pos = ref 0 in let acc = ref init_acc in try read_space v lexbuf; read_tuple_end lexbuf; acc := read_cell !pos !acc v lexbuf; incr pos; while true do read_space v lexbuf; read_tuple_sep v lexbuf; read_space v lexbuf; acc := read_cell !pos !acc v lexbuf; incr pos; done; assert false with End_of_tuple -> !acc #else long_error "Invalid token" v lexbuf #endif } | _ { long_error "Expected ')' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_tuple_end = parse ')' { raise End_of_tuple } | "" { () } and read_tuple_end2 v std = parse ')' { if std then long_error "Expected ')' or '' but found" v lexbuf else raise End_of_tuple } | ']' { if std then raise End_of_tuple else long_error "Expected ']' or '' but found" v lexbuf } | "" { () } and read_tuple_sep v = parse ',' { () } | ')' { raise End_of_tuple } | _ { long_error "Expected ',' or ')' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_tuple_sep2 v std = parse ',' { () } | ')' { if std then long_error "Expected ',' or ']' but found" v lexbuf else raise End_of_tuple } | ']' { if std then raise End_of_tuple else long_error "Expected ',' or ')' but found" v lexbuf } | _ { long_error "Expected ',' or ')' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } (* Read a JSON object, reading the keys using a custom parser *) and read_abstract_fields read_key read_field init_acc v = parse '{' { let acc = ref init_acc in try read_space v lexbuf; read_object_end lexbuf; let field_name = read_key v lexbuf in read_space v lexbuf; read_colon v lexbuf; read_space v lexbuf; acc := read_field !acc field_name v lexbuf; while true do read_space v lexbuf; read_object_sep v lexbuf; read_space v lexbuf; let field_name = read_key v lexbuf in read_space v lexbuf; read_colon v lexbuf; read_space v lexbuf; acc := read_field !acc field_name v lexbuf; done; assert false with End_of_object -> !acc } | _ { long_error "Expected '{' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_lcurl v = parse '{' { () } | _ { long_error "Expected '{' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_object_end = parse '}' { raise End_of_object } | "" { () } and read_object_sep v = parse ',' { () } | '}' { raise End_of_object } | _ { long_error "Expected ',' or '}' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_colon v = parse ':' { () } | _ { long_error "Expected ':' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and start_any_tuple v = parse '(' { false } | '[' { true } | _ { long_error "Expected '(' or '[' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_lpar v = parse '(' { () } | _ { long_error "Expected '(' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_rpar v = parse ')' { () } | _ { long_error "Expected ')' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_lbr v = parse '[' { () } | _ { long_error "Expected '[' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and read_rbr v = parse ']' { () } | _ { long_error "Expected ']' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } (*** And now pretty much the same thing repeated, only for the purpose of skipping ignored field values ***) and skip_json v = parse | "true" { () } | "false" { () } | "null" { () } | "NaN" { () } | "Infinity" { () } | "-Infinity" { () } | '"' { finish_skip_stringlit v lexbuf } | '-'? positive_int { () } | float { () } | '{' { try read_space v lexbuf; read_object_end lexbuf; skip_ident v lexbuf; read_space v lexbuf; read_colon v lexbuf; read_space v lexbuf; skip_json v lexbuf; while true do read_space v lexbuf; read_object_sep v lexbuf; read_space v lexbuf; skip_ident v lexbuf; read_space v lexbuf; read_colon v lexbuf; read_space v lexbuf; skip_json v lexbuf; done; assert false with End_of_object -> () } | '[' { try read_space v lexbuf; read_array_end lexbuf; skip_json v lexbuf; while true do read_space v lexbuf; read_array_sep v lexbuf; read_space v lexbuf; skip_json v lexbuf; done; assert false with End_of_array -> () } | '(' { #ifdef TUPLE try read_space v lexbuf; read_tuple_end lexbuf; skip_json v lexbuf; while true do read_space v lexbuf; read_tuple_sep v lexbuf; read_space v lexbuf; skip_json v lexbuf; done; assert false with End_of_tuple -> () #else long_error "Invalid token" v lexbuf #endif } | '<' { #ifdef VARIANT read_space v lexbuf; skip_ident v lexbuf; read_space v lexbuf; finish_skip_variant v lexbuf #else long_error "Invalid token" v lexbuf #endif } | "//"[^'\n']* { skip_json v lexbuf } | "/*" { finish_comment v lexbuf; skip_json v lexbuf } | "\n" { newline v lexbuf; skip_json v lexbuf } | space { skip_json v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } | _ { long_error "Invalid token" v lexbuf } and finish_skip_stringlit v = parse ( '\\' (['"' '\\' '/' 'b' 'f' 'n' 'r' 't'] | 'u' hex hex hex hex) | [^'"' '\\'] )* '"' { () } | _ { long_error "Invalid string literal" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and finish_skip_variant v = parse ':' { skip_json v lexbuf; read_space v lexbuf; read_gt v lexbuf } | '>' { () } | _ { long_error "Expected ':' or '>' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and skip_ident v = parse '"' { finish_skip_stringlit v lexbuf } | ident { () } | _ { long_error "Expected string or identifier but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } (*** And now pretty much the same thing repeated, only for the purpose of buffering deferred field values ***) and buffer_json v = parse | "true" | "false" | "null" | "NaN" | "Infinity" | "-Infinity" | '-'? positive_int | float { add_lexeme v.buf lexbuf } | '"' { finish_buffer_stringlit v lexbuf } | '{' { try Bi_outbuf.add_char v.buf '{'; buffer_space v lexbuf; buffer_object_end v lexbuf; buffer_ident v lexbuf; buffer_space v lexbuf; buffer_colon v lexbuf; buffer_space v lexbuf; buffer_json v lexbuf; while true do buffer_space v lexbuf; buffer_object_sep v lexbuf; buffer_space v lexbuf; buffer_ident v lexbuf; buffer_space v lexbuf; buffer_colon v lexbuf; buffer_space v lexbuf; buffer_json v lexbuf; done; assert false with End_of_object -> () } | '[' { try Bi_outbuf.add_char v.buf '['; buffer_space v lexbuf; buffer_array_end v lexbuf; buffer_json v lexbuf; while true do buffer_space v lexbuf; buffer_array_sep v lexbuf; buffer_space v lexbuf; buffer_json v lexbuf; done; assert false with End_of_array -> () } | '(' { #ifdef TUPLE try Bi_outbuf.add_char v.buf '('; buffer_space v lexbuf; buffer_tuple_end v lexbuf; buffer_json v lexbuf; while true do buffer_space v lexbuf; buffer_tuple_sep v lexbuf; buffer_space v lexbuf; buffer_json v lexbuf; done; assert false with End_of_tuple -> () #else long_error "Invalid token" v lexbuf #endif } | '<' { #ifdef VARIANT Bi_outbuf.add_char v.buf '<'; buffer_space v lexbuf; buffer_ident v lexbuf; buffer_space v lexbuf; finish_buffer_variant v lexbuf #else long_error "Invalid token" v lexbuf #endif } | "//"[^'\n']* { add_lexeme v.buf lexbuf; buffer_json v lexbuf } | "/*" { Bi_outbuf.add_string v.buf "/*"; finish_buffer_comment v lexbuf; buffer_json v lexbuf } | "\n" { Bi_outbuf.add_char v.buf '\n'; newline v lexbuf; buffer_json v lexbuf } | space { add_lexeme v.buf lexbuf; buffer_json v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } | _ { long_error "Invalid token" v lexbuf } and finish_buffer_stringlit v = parse ( '\\' (['"' '\\' '/' 'b' 'f' 'n' 'r' 't'] | 'u' hex hex hex hex) | [^'"' '\\'] )* '"' { Bi_outbuf.add_char v.buf '"'; add_lexeme v.buf lexbuf } | _ { long_error "Invalid string literal" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and finish_buffer_variant v = parse ':' { Bi_outbuf.add_char v.buf ':'; buffer_json v lexbuf; buffer_space v lexbuf; buffer_gt v lexbuf } | '>' { Bi_outbuf.add_char v.buf '>' } | _ { long_error "Expected ':' or '>' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and buffer_ident v = parse '"' { finish_buffer_stringlit v lexbuf } | ident { add_lexeme v.buf lexbuf } | _ { long_error "Expected string or identifier but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and buffer_space v = parse | "//"[^'\n']* ('\n'|eof) { add_lexeme v.buf lexbuf; newline v lexbuf; buffer_space v lexbuf } | "/*" { Bi_outbuf.add_string v.buf "/*"; finish_buffer_comment v lexbuf; buffer_space v lexbuf } | '\n' { Bi_outbuf.add_char v.buf '\n'; newline v lexbuf; buffer_space v lexbuf } | [' ' '\t' '\r']+ { add_lexeme v.buf lexbuf; buffer_space v lexbuf } | "" { () } and buffer_object_end v = parse '}' { Bi_outbuf.add_char v.buf '}'; raise End_of_object } | "" { () } and buffer_object_sep v = parse ',' { Bi_outbuf.add_char v.buf ',' } | '}' { Bi_outbuf.add_char v.buf '}'; raise End_of_object } | _ { long_error "Expected ',' or '}' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and buffer_array_end v = parse ']' { Bi_outbuf.add_char v.buf ']'; raise End_of_array } | "" { () } and buffer_array_sep v = parse ',' { Bi_outbuf.add_char v.buf ',' } | ']' { Bi_outbuf.add_char v.buf ']'; raise End_of_array } | _ { long_error "Expected ',' or ']' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and buffer_tuple_end v = parse ')' { Bi_outbuf.add_char v.buf ')'; raise End_of_tuple } | "" { () } and buffer_tuple_sep v = parse ',' { Bi_outbuf.add_char v.buf ',' } | ')' { Bi_outbuf.add_char v.buf ')'; raise End_of_tuple } | _ { long_error "Expected ',' or ')' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and buffer_colon v = parse ':' { Bi_outbuf.add_char v.buf ':' } | _ { long_error "Expected ':' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and buffer_gt v = parse '>' { Bi_outbuf.add_char v.buf '>' } | _ { long_error "Expected '>' but found" v lexbuf } | eof { custom_error "Unexpected end of input" v lexbuf } and finish_buffer_comment v = parse | "*/" { Bi_outbuf.add_string v.buf "*/" } | eof { long_error "Unterminated comment" v lexbuf } | '\n' { Bi_outbuf.add_char v.buf '\n'; newline v lexbuf; finish_buffer_comment v lexbuf } | _ { add_lexeme v.buf lexbuf; finish_buffer_comment v lexbuf } and junk = parse junk { Lexing.lexeme lexbuf } { let _ = (read_json : lexer_state -> Lexing.lexbuf -> json) let () = read_junk := junk let read_int8 v lexbuf = let n = read_int v lexbuf in if n < 0 || n > 255 then lexer_error "Int8 overflow" v lexbuf else char_of_int n let read_list read_cell v lexbuf = List.rev (read_list_rev read_cell v lexbuf) let array_of_rev_list l = match l with [] -> [| |] | x :: tl -> let len = List.length l in let a = Array.make len x in let r = ref tl in for i = len - 2 downto 0 do a.(i) <- List.hd !r; r := List.tl !r done; a let read_array read_cell v lexbuf = let l = read_list_rev read_cell v lexbuf in array_of_rev_list l (* Read a JSON object, reading the keys into OCaml strings (provided for backward compatibility) *) let read_fields read_field init_acc v = read_abstract_fields read_ident read_field init_acc v let finish v lexbuf = read_space v lexbuf; if not (read_eof lexbuf) then long_error "Junk after end of JSON value:" v lexbuf let init_lexer = init_lexer let from_lexbuf v ?(stream = false) lexbuf = read_space v lexbuf; let x = if read_eof lexbuf then raise End_of_input else read_json v lexbuf in if not stream then finish v lexbuf; x let from_string ?buf ?fname ?lnum s = try let lexbuf = Lexing.from_string s in let v = init_lexer ?buf ?fname ?lnum () in from_lexbuf v lexbuf with End_of_input -> json_error "Blank input data" let from_channel ?buf ?fname ?lnum ic = try let lexbuf = Lexing.from_channel ic in let v = init_lexer ?buf ?fname ?lnum () in from_lexbuf v lexbuf with End_of_input -> json_error "Blank input data" let from_file ?buf ?fname ?lnum file = let ic = open_in file in try let x = from_channel ?buf ?fname ?lnum ic in close_in ic; x with e -> close_in_noerr ic; raise e let stream_from_lexbuf v ?(fin = fun () -> ()) lexbuf = let stream = Some true in let f i = try Some (from_lexbuf v ?stream lexbuf) with End_of_input -> fin (); None | e -> (try fin () with _ -> ()); raise e in Stream.from f let stream_from_string ?buf ?fname ?lnum s = let v = init_lexer ?buf ?fname ?lnum () in stream_from_lexbuf v (Lexing.from_string s) let stream_from_channel ?buf ?fin ?fname ?lnum ic = let lexbuf = Lexing.from_channel ic in let v = init_lexer ?buf ?fname ?lnum () in stream_from_lexbuf v ?fin lexbuf let stream_from_file ?buf ?fname ?lnum file = let ic = open_in file in let fin () = close_in ic in let fname = match fname with None -> Some file | x -> x in let lexbuf = Lexing.from_channel ic in let v = init_lexer ?buf ?fname ?lnum () in stream_from_lexbuf v ~fin lexbuf type json_line = [ `Json of json | `Exn of exn ] let linestream_from_channel ?buf ?(fin = fun () -> ()) ?fname ?lnum:(lnum0 = 1) ic = let buf = match buf with None -> Some (Bi_outbuf.create 256) | Some _ -> buf in let f i = try let line = input_line ic in let lnum = lnum0 + i in Some (`Json (from_string ?buf ?fname ~lnum line)) with End_of_file -> fin (); None | e -> Some (`Exn e) in Stream.from f let linestream_from_file ?buf ?fname ?lnum file = let ic = open_in file in let fin () = close_in ic in let fname = match fname with None -> Some file | x -> x in linestream_from_channel ?buf ~fin ?fname ?lnum ic let prettify ?std s = pretty_to_string ?std (from_string s) let compact ?std s = to_string (from_string s) } yojson-1.2.3/safe.ml000066400000000000000000000006301257241127100143070ustar00rootroot00000000000000let rec to_basic : json -> Basic.json = function `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)) | `Assoc l -> `Assoc (List.rev (List.rev_map (fun (k, v) -> (k, to_basic v)) l)) | `Variant (k, None) -> `String k | `Variant (k, Some v) -> `List [ `String k; to_basic v ] yojson-1.2.3/safe.mli000066400000000000000000000010171257241127100144600ustar00rootroot00000000000000val to_basic : json -> Basic.json (** Tuples are converted to JSON arrays, Variants are converted to JSON strings or arrays of a string (constructor) and a json value (argument). Long integers are converted to JSON strings. Examples: {v `Tuple [ `Int 1; `Float 2.3 ] -> `List [ `Int 1; `Float 2.3 ] `Variant ("A", None) -> `String "A" `Variant ("B", Some x) -> `List [ `String "B", x ] `Intlit "12345678901234567890" -> `String "12345678901234567890" v} *) yojson-1.2.3/sample.json000066400000000000000000000021721257241127100152160ustar00rootroot00000000000000{"id":"2581o62fp36dn","name":"JAMES SMITH","display_url":"http://www.42theanswer.com/displayProfile.do?uid=363812639","type":"person","image_url":"http://photo.42theanswer.com/photos/015/867/424M.jpg","gender":"male","age":40,"locations":[{"title":"current","country":"US","adminarea":"wisconsin","locality":"portage","text":"Portage, Wisconsin"}],"bio_field":"about_me","fields":{"geocoded_lat_long":[43.547184000000001,-89.465057999999999],"member_since":{"day":15,"month":8,"year":2006},"has_profile_image":true,"last_name":"SMITH","tatata_id":"363812639","estimated_date_of_birth":{"max_date":{"day":26,"month":2,"year":1970},"mean_date":{"day":26,"month":2,"year":1970},"min_date":{"day":26,"month":2,"year":1970}},"url_list":["http://www.42theanswer.com/displayProfile.do?uid=363812677"],"zip":"53901","city":"Portage","site":["42theanswer.com","www.42theanswer.com"],"state":"WI","source":"tatata","country":"US","user_id":"363812639","publication_timestamp":"1262614598","first_name":"JAMES","tatata_image_id":"15867624","source_info":{"id":"tatata","url":"http://www.42theanswer.com/"},"date_of_birth":{"year":1970,"month":2,"day":26}}} yojson-1.2.3/test.json000066400000000000000000000011611257241127100147110ustar00rootroot00000000000000{ "ab": [ 1, 2, -3 ], cd: (1.2, "zz"), ef : [ , , ], aaaaoooaoaooooooooaoaoaoooaoa: { "big int": 123456789012345678901837292020484756564574 }, "array": [ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ], "'NULL' U+0000": "\u0000", "'VULGAR FRACTION ONE HALF' U+00BD": "\u00BD", "'PILE OF POO' U+1F4A9": "\uD83D\uDCA9", "min_int": "-4611686018427387904" } yojson-1.2.3/type.ml000066400000000000000000000032541257241127100143570ustar00rootroot00000000000000(** {3 Type of the JSON tree} *) type json = [ | `Null | `Bool of bool #ifdef INT | `Int of int #endif #ifdef INTLIT | `Intlit of string #endif #ifdef FLOAT | `Float of float #endif #ifdef FLOATLIT | `Floatlit of string #endif #ifdef STRING | `String of string #endif #ifdef STRINGLIT | `Stringlit of string #endif | `Assoc of (string * json) list | `List of json list #ifdef TUPLE | `Tuple of json list #endif #ifdef VARIANT | `Variant of (string * json option) #endif ] (** All possible cases defined in Yojson: - `Null: JSON null - `Bool of bool: JSON boolean - `Int of int: JSON number without decimal point or exponent. - `Intlit of string: JSON number without decimal point or exponent, preserved as a string. - `Float of float: JSON number, Infinity, -Infinity or NaN. - `Floatlit of string: JSON number, Infinity, -Infinity or NaN, preserved as a string. - `String of string: JSON string. Bytes in the range 128-255 are preserved as-is without encoding validation for both reading and writing. - `Stringlit of string: JSON string literal including the double quotes. - `Assoc of (string * json) list: JSON object. - `List of json list: JSON array. - `Tuple of json list: Tuple (non-standard extension of JSON). Syntax: [("abc", 123)]. - `Variant of (string * json option): Variant (non-standard extension of JSON). Syntax: [<"Foo">] or [<"Bar":123>]. *) (* Note to adventurers: ocamldoc does not support inline comments on each polymorphic variant, and cppo doesn't allow to concatenate comments, so it would be complicated to document only the cases that are preserved by cppo in the type definition. *) yojson-1.2.3/util.ml000066400000000000000000000101241257241127100143450ustar00rootroot00000000000000exception Type_error of string * json let typeof = function | `Assoc _ -> "object" | `Bool _ -> "bool" | `Float _ -> "float" | `Int _ -> "int" | `List _ -> "array" | `Null -> "null" | `String _ -> "string" let typerr msg js = raise (Type_error (msg ^ typeof js, js)) exception Undefined of string * json let ( |> ) x f = f x let assoc name obj = try List.assoc name obj with Not_found -> `Null let member name = function | `Assoc obj -> assoc name obj | js -> typerr ("Can't get member '" ^ name ^ "' of non-object type ") js let index i = function | `List l as js -> let len = List.length l in let wrapped_index = if i < 0 then len + i else i in 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 let map f = function | `List l -> `List (List.map f l) | js -> typerr "Can't map function over non-array type " js 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_bool_option = function | `Bool b -> Some b | `Null -> None | js -> typerr "Expected bool or null, got " js let to_number = function | `Int i -> float i | `Float f -> f | js -> typerr "Expected number, got " js let to_number_option = function | `Int i -> Some (float i) | `Float f -> Some f | `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_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_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_string = function | `String s -> s | js -> typerr "Expected string, got " js let to_string_option = function | `String s -> Some s | `Null -> None | js -> typerr "Expected string or null, got " js 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 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 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 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 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 = let names = to_assoc o in List.map (fun (key, _) -> key) names yojson-1.2.3/util.mli000066400000000000000000000144661257241127100145330ustar00rootroot00000000000000(** This module provides combinators for extracting fields from JSON values. This approach is recommended for reading a few fields from data returned by public APIs. However for more complex applications we recommend {{:https://github.com/MyLifeLabs/atdgen}Atdgen}. Here is some sample JSON data: {v \{ "id": "398eb027", "name": "John Doe", "pages": [ \{ "id": 1, "title": "The Art of Flipping Coins", "url": "http://example.com/398eb027/1" }, \{ "id": 2, "deleted": true }, \{ "id": 3, "title": "Artichoke Salad", "url": "http://example.com/398eb027/3" }, \{ "id": 4, "title": "Flying Bananas", "url": "http://example.com/398eb027/4" } ] } v} In order to extract the "id" field, assuming it is mandatory, we would use the following OCaml code that operates on single JSON nodes: {v open Yojson.Basic.Util ... let id = json |> member "id" |> to_string in ... v} In order to extract all the "title" fields, we would write the following OCaml code that operates on lists of JSON nodes, skipping undefined nodes and nodes of unexpected type: {v open Yojson.Basic.Util let extract_titles (json : Yojson.Basic.json) : string list = [json] |> filter_member "pages" |> flatten |> filter_member "title" |> filter_string v} *) exception Type_error of string * json (** 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 * json (** 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 ( |> ) : 'a -> ('a -> 'b) -> 'b (** Forward pipe operator; useful for composing JSON access functions without too many parentheses *) val keys: json -> string list (** Returns all the key names in the given JSON object *) val member : string -> json -> 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]. *) val index : int -> json -> json (** [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). *) val map : (json -> json) -> json -> json (** [map f arr] calls the function [f] on each element of the JSON array [arr], and returns a JSON array containing the results. *) val to_assoc : json -> (string * json) list (** Extract the items of a JSON object or raise [Type_error]. *) val to_option : (json -> 'a) -> json -> 'a option (** Return [None] if the JSON value is null or map the JSON value to [Some] value using the provided function. *) val to_bool : json -> bool (** Extract a boolean value or raise [Type_error]. *) val to_bool_option : json -> bool option (** Extract [Some] boolean value, return [None] if the value is null, or raise [Type_error] otherwise. *) val to_number : json -> float (** Extract a number or raise [Type_error]. *) val to_number_option : json -> float option (** Extract [Some] number, return [None] if the value is null, or raise [Type_error] otherwise. *) val to_float : json -> float (** Extract a float value or raise [Type_error]. [to_number] is generally preferred as it also works with int literals. *) val to_float_option : json -> float option (** Extract [Some] float value, return [None] if the value is null, or raise [Type_error] otherwise. [to_number_option] is generally preferred as it also works with int literals. *) val to_int : json -> int (** Extract an int from a JSON int or raise [Type_error]. *) val to_int_option : json -> int option (** Extract [Some] int from a JSON int, return [None] if the value is null, or raise [Type_error] otherwise. *) val to_list : json -> json list (** Extract a list from JSON array or raise [Type_error]. *) val to_string : json -> string (** Extract a string from a JSON string or raise [Type_error]. *) val to_string_option : json -> string option (** Extract [Some] string from a JSON string, return [None] if the value is null, or raise [Type_error] otherwise. *) val convert_each : (json -> 'a) -> json -> 'a list (** 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)]. *) (** {3 Exception-free filters} *) (** The following functions operate on lists of JSON nodes. None of them raises an exception when a certain kind of node is expected but no node or the wrong kind of node is found. Instead of raising an exception, nodes that are not as expected are simply ignored. *) 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 using function [f] and unwraps the resulting values. *) val flatten : json list -> json list (** 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 -> json list -> json list (** Expects JSON arrays and returns all their elements existing at the given position. *) val filter_list : json list -> json list list (** Expects JSON arrays and unwraps them. *) val filter_member : string -> json list -> json list (** Expects JSON objects and returns all the fields of the given name (at most one field per object). *) val filter_assoc : json list -> (string * json) list list (** Expects JSON objects and unwraps them. *) val filter_bool : json list -> bool list (** Expects JSON booleans and unwraps them. *) val filter_int : json list -> int list (** Expects JSON integers ([`Int] nodes) and unwraps them. *) val filter_float : json list -> float list (** Expects JSON floats ([`Float] nodes) and unwraps them. *) val filter_number : json list -> float list (** Expects JSON numbers ([`Int] or [`Float]) and unwraps them. Ints are converted to floats. *) val filter_string : json list -> string list (** Expects JSON strings and unwraps them. *) yojson-1.2.3/write.ml000066400000000000000000000302231257241127100145240ustar00rootroot00000000000000(* included: type.ml *) open Bi_outbuf let hex n = Char.chr ( if n < 10 then n + 48 else n + 87 ) let write_special src start stop ob str = Bi_outbuf.add_substring ob src !start (stop - !start); Bi_outbuf.add_string ob str; start := stop + 1 let write_control_char src start stop ob c = Bi_outbuf.add_substring ob src !start (stop - !start); let i = Bi_outbuf.alloc ob 6 in let dst = ob.o_s in String.blit "\\u00" 0 dst i 4; dst.[i+4] <- hex (Char.code c lsr 4); dst.[i+5] <- hex (Char.code c land 0xf); start := stop + 1 let finish_string src start ob = try Bi_outbuf.add_substring ob src !start (String.length src - !start) with _ -> Printf.eprintf "src=%S start=%i len=%i\n%!" src !start (String.length src - !start); failwith "oops" let write_string_body ob s = let start = ref 0 in for i = 0 to String.length s - 1 do match s.[i] with '"' -> write_special s start i ob "\\\"" | '\\' -> write_special s start i ob "\\\\" | '\b' -> write_special s start i ob "\\b" | '\012' -> write_special s start i ob "\\f" | '\n' -> write_special s start i ob "\\n" | '\r' -> write_special s start i ob "\\r" | '\t' -> write_special s start i ob "\\t" | '\x00'..'\x1F' | '\x7F' as c -> write_control_char s start i ob c | _ -> () done; finish_string s start ob let write_string ob s = Bi_outbuf.add_char ob '"'; write_string_body ob s; Bi_outbuf.add_char ob '"' let json_string_of_string s = let ob = Bi_outbuf.create 10 in write_string ob s; Bi_outbuf.contents ob let test_string () = let s = String.create 256 in for i = 0 to 255 do s.[i] <- Char.chr i done; json_string_of_string s let write_null ob () = Bi_outbuf.add_string ob "null" let write_bool ob x = Bi_outbuf.add_string ob (if x then "true" else "false") let max_digits = max (String.length (string_of_int max_int)) (String.length (string_of_int min_int)) let dec n = Char.chr (n + 48) let rec write_digits s pos x = if x = 0 then pos else let d = x mod 10 in let pos = write_digits s pos (x / 10) in s.[pos] <- dec (abs d); pos + 1 let write_int ob x = Bi_outbuf.extend ob max_digits; if x > 0 then ob.o_len <- write_digits ob.o_s ob.o_len x else if x < 0 then ( let s = ob.o_s in let pos = ob.o_len in s.[pos] <- '-'; ob.o_len <- write_digits s (pos + 1) x ) else Bi_outbuf.add_char ob '0' let json_string_of_int i = string_of_int i (* Ensure that the float is not printed as an int. This is not required by JSON, but useful in order to guarantee reversibility. *) let float_needs_period s = try for i = 0 to String.length s - 1 do match s.[i] with '0'..'9' | '-' -> () | _ -> raise Exit done; true with Exit -> false (* Both write_float_fast and write_float guarantee that a sufficient number of digits are printed in order to allow reversibility. The _fast version is faster but often produces unnecessarily long numbers. *) let write_float_fast ob x = match classify_float x with FP_nan -> Bi_outbuf.add_string ob "NaN" | FP_infinite -> Bi_outbuf.add_string ob (if x > 0. then "Infinity" else "-Infinity") | _ -> let s = Printf.sprintf "%.17g" x in Bi_outbuf.add_string ob s; if float_needs_period s then Bi_outbuf.add_string ob ".0" let write_float ob x = match classify_float x with FP_nan -> Bi_outbuf.add_string ob "NaN" | FP_infinite -> Bi_outbuf.add_string ob (if x > 0. then "Infinity" else "-Infinity") | _ -> let s1 = Printf.sprintf "%.16g" x in let s = if float_of_string s1 = x then s1 else Printf.sprintf "%.17g" x in Bi_outbuf.add_string ob s; if float_needs_period s then Bi_outbuf.add_string ob ".0" let write_normal_float_prec significant_figures ob x = let open Printf in let s = match significant_figures with 1 -> sprintf "%.1g" x | 2 -> sprintf "%.2g" x | 3 -> sprintf "%.3g" x | 4 -> sprintf "%.4g" x | 5 -> sprintf "%.5g" x | 6 -> sprintf "%.6g" x | 7 -> sprintf "%.7g" x | 8 -> sprintf "%.8g" x | 9 -> sprintf "%.9g" x | 10 -> sprintf "%.10g" x | 11 -> sprintf "%.11g" x | 12 -> sprintf "%.12g" x | 13 -> sprintf "%.13g" x | 14 -> sprintf "%.14g" x | 15 -> sprintf "%.15g" x | 16 -> sprintf "%.16g" x | _ -> sprintf "%.17g" x in Bi_outbuf.add_string ob s; if float_needs_period s then Bi_outbuf.add_string ob ".0" let write_float_prec significant_figures ob x = match classify_float x with FP_nan -> Bi_outbuf.add_string ob "NaN" | FP_infinite -> Bi_outbuf.add_string ob (if x > 0. then "Infinity" else "-Infinity") | _ -> write_normal_float_prec significant_figures ob x let json_string_of_float x = let ob = Bi_outbuf.create 20 in write_float ob x; Bi_outbuf.contents ob let write_std_float_fast ob x = match classify_float x with FP_nan -> json_error "NaN value not allowed in standard JSON" | FP_infinite -> json_error (if x > 0. then "Infinity value not allowed in standard JSON" else "-Infinity value not allowed in standard JSON") | _ -> let s = Printf.sprintf "%.17g" x in Bi_outbuf.add_string ob s; if float_needs_period s then Bi_outbuf.add_string ob ".0" let write_std_float ob x = match classify_float x with FP_nan -> json_error "NaN value not allowed in standard JSON" | FP_infinite -> json_error (if x > 0. then "Infinity value not allowed in standard JSON" else "-Infinity value not allowed in standard JSON") | _ -> let s1 = Printf.sprintf "%.16g" x in let s = if float_of_string s1 = x then s1 else Printf.sprintf "%.17g" x in Bi_outbuf.add_string ob s; if float_needs_period s then Bi_outbuf.add_string ob ".0" let write_std_float_prec significant_figures ob x = match classify_float x with FP_nan -> json_error "NaN value not allowed in standard JSON" | FP_infinite -> json_error (if x > 0. then "Infinity value not allowed in standard JSON" else "-Infinity value not allowed in standard JSON") | _ -> write_normal_float_prec significant_figures ob x let std_json_string_of_float x = let ob = Bi_outbuf.create 20 in write_std_float ob x; Bi_outbuf.contents ob let test_float () = let l = [ 0.; 1.; -1. ] in let l = l @ List.map (fun x -> 2. *. x +. 1.) l in let l = l @ List.map (fun x -> x /. sqrt 2.) l in let l = l @ List.map (fun x -> x *. sqrt 3.) l in let l = l @ List.map cos l in let l = l @ List.map (fun x -> x *. 1.23e50) l in let l = l @ [ infinity; neg_infinity ] in List.iter ( fun x -> let s = Printf.sprintf "%.17g" x in let y = float_of_string s in Printf.printf "%g %g %S %B\n" x y s (x = y) ) l (* let () = test_float () *) let write_intlit = Bi_outbuf.add_string let write_floatlit = Bi_outbuf.add_string let write_stringlit = Bi_outbuf.add_string let rec iter2_aux f_elt f_sep x = function [] -> () | y :: l -> f_sep x; f_elt x y; iter2_aux f_elt f_sep x l let iter2 f_elt f_sep x = function [] -> () | y :: l -> f_elt x y; iter2_aux f_elt f_sep x l let f_sep ob = Bi_outbuf.add_char ob ',' let rec write_json ob (x : json) = match x with `Null -> write_null ob () | `Bool b -> write_bool ob b #ifdef INT | `Int i -> write_int ob i #endif #ifdef INTLIT | `Intlit s -> Bi_outbuf.add_string ob s #endif #ifdef FLOAT | `Float f -> write_float ob f #endif #ifdef FLOATLIT | `Floatlit s -> Bi_outbuf.add_string ob s #endif #ifdef STRING | `String s -> write_string ob s #endif #ifdef STRINGLIT | `Stringlit s -> Bi_outbuf.add_string ob s #endif | `Assoc l -> write_assoc ob l | `List l -> write_list ob l #ifdef TUPLE | `Tuple l -> write_tuple ob l #endif #ifdef VARIANT | `Variant (s, o) -> write_variant ob s o #endif and write_assoc ob l = let f_elt ob (s, x) = write_string ob s; Bi_outbuf.add_char ob ':'; write_json ob x in Bi_outbuf.add_char ob '{'; iter2 f_elt f_sep ob l; Bi_outbuf.add_char ob '}'; and write_list ob l = Bi_outbuf.add_char ob '['; iter2 write_json f_sep ob l; Bi_outbuf.add_char ob ']' #ifdef TUPLE and write_tuple ob l = Bi_outbuf.add_char ob '('; iter2 write_json f_sep ob l; Bi_outbuf.add_char ob ')' #endif #ifdef VARIANT and write_variant ob s o = Bi_outbuf.add_char ob '<'; write_string ob s; (match o with None -> () | Some x -> Bi_outbuf.add_char ob ':'; write_json ob x ); Bi_outbuf.add_char ob '>' #endif let rec write_std_json ob (x : json) = match x with `Null -> write_null ob () | `Bool b -> write_bool ob b #ifdef INT | `Int i -> write_int ob i #endif #ifdef INTLIT | `Intlit s -> Bi_outbuf.add_string ob s #endif #ifdef FLOAT | `Float f -> write_std_float ob f #endif #ifdef FLOATLIT | `Floatlit s -> Bi_outbuf.add_string ob s #endif #ifdef STRING | `String s -> write_string ob s #endif #ifdef STRINGLIT | `Stringlit s -> Bi_outbuf.add_string ob s #endif | `Assoc l -> write_std_assoc ob l | `List l -> write_std_list ob l #ifdef TUPLE | `Tuple l -> write_std_tuple ob l #endif #ifdef VARIANT | `Variant (s, o) -> write_std_variant ob s o #endif and write_std_assoc ob l = let f_elt ob (s, x) = write_string ob s; Bi_outbuf.add_char ob ':'; write_std_json ob x in Bi_outbuf.add_char ob '{'; iter2 f_elt f_sep ob l; Bi_outbuf.add_char ob '}'; and write_std_list ob l = Bi_outbuf.add_char ob '['; iter2 write_std_json f_sep ob l; Bi_outbuf.add_char ob ']' and write_std_tuple ob l = Bi_outbuf.add_char ob '['; iter2 write_std_json f_sep ob l; Bi_outbuf.add_char ob ']' #ifdef VARIANT and write_std_variant ob s o = match o with None -> write_string ob s | Some x -> Bi_outbuf.add_char ob '['; write_string ob s; Bi_outbuf.add_char ob ','; write_std_json ob x; Bi_outbuf.add_char ob ']' #endif let to_outbuf ?(std = false) ob x = if std then ( if not (is_object_or_array x) then json_error "Root is not an object or array" else write_std_json ob x ) else write_json ob x let to_string ?buf ?(len = 256) ?std x = let ob = match buf with None -> Bi_outbuf.create len | Some ob -> Bi_outbuf.clear ob; ob in to_outbuf ?std ob x; let s = Bi_outbuf.contents ob in Bi_outbuf.clear ob; s let to_channel ?buf ?len ?std oc x = let ob = match buf with None -> Bi_outbuf.create_channel_writer ?len oc | Some ob -> ob in to_outbuf ?std ob x; Bi_outbuf.flush_channel_writer ob let to_output ?buf ?len ?std out x = let ob = match buf with None -> Bi_outbuf.create_output_writer ?len out | Some ob -> ob in to_outbuf ?std ob x; Bi_outbuf.flush_output_writer ob let to_file ?len ?std file x = let oc = open_out file in try to_channel ?len ?std oc x; close_out oc with e -> close_out_noerr oc; raise e let stream_to_outbuf ?std ob st = Stream.iter (to_outbuf ?std ob) st let stream_to_string ?buf ?(len = 256) ?std st = let ob = match buf with None -> Bi_outbuf.create len | Some ob -> Bi_outbuf.clear ob; ob in stream_to_outbuf ?std ob st; let s = Bi_outbuf.contents ob in Bi_outbuf.clear ob; s let stream_to_channel ?buf ?len ?std oc st = let ob = match buf with None -> Bi_outbuf.create_channel_writer ?len oc | Some ob -> ob in stream_to_outbuf ?std ob st; Bi_outbuf.flush_channel_writer ob let stream_to_file ?len ?std file st = let oc = open_out file in try stream_to_channel ?len ?std oc st; close_out oc with e -> close_out_noerr oc; raise e let rec sort = function | `Assoc l -> let l = List.rev (List.rev_map (fun (k, v) -> (k, sort v)) l) in `Assoc (List.stable_sort (fun (a, _) (b, _) -> String.compare a b) l) | `List l -> `List (List.rev (List.rev_map sort l)) #ifdef TUPLE | `Tuple l -> `Tuple (List.rev (List.rev_map sort l)) #endif #ifdef VARIANT | `Variant (k, Some v) as x -> let v' = sort v in if v == v' then x else `Variant (k, Some v') #endif | x -> x yojson-1.2.3/write.mli000066400000000000000000000106471257241127100147050ustar00rootroot00000000000000(** {2 JSON writers} *) val to_string : ?buf:Bi_outbuf.t -> ?len:int -> ?std:bool -> json -> string (** Write a compact JSON value to a string. @param buf allows to reuse an existing buffer created with [Bi_outbuf.create]. The buffer is cleared of all contents before starting and right before returning. @param len initial length of the output buffer. @param std use only standard JSON syntax, i.e. convert tuples and variants into standard JSON (if applicable), refuse to print NaN and infinities, require the root node to be either an object or an array. Default is [false]. *) val to_channel : ?buf:Bi_outbuf.t -> ?len:int -> ?std:bool -> out_channel -> json -> unit (** Write a compact JSON value to a channel. @param buf allows to reuse an existing buffer created with [Bi_outbuf.create_channel_writer] on the same channel. [buf] is flushed right before [to_channel] returns but the [out_channel] is not flushed automatically. See [to_string] for the role of the other optional arguments. *) val to_output : ?buf:Bi_outbuf.t -> ?len:int -> ?std:bool -> < output : string -> int -> int -> int; .. > -> json -> unit (** Write a compact JSON value to an OO channel. @param buf allows to reuse an existing buffer created with [Bi_outbuf.create_output_writer] on the same channel. [buf] is flushed right before [to_output] returns but the channel itself is not flushed automatically. See [to_string] for the role of the other optional arguments. *) val to_file : ?len:int -> ?std:bool -> string -> json -> unit (** Write a compact JSON value to a file. See [to_string] for the role of the optional arguments. *) val to_outbuf : ?std:bool -> Bi_outbuf.t -> json -> unit (** Write a compact JSON value to an existing buffer. See [to_string] for the role of the optional argument. *) val stream_to_string : ?buf:Bi_outbuf.t -> ?len:int -> ?std:bool -> json Stream.t -> string (** Write a newline-separated sequence of compact one-line JSON values to a string. See [to_string] for the role of the optional arguments. *) val stream_to_channel : ?buf:Bi_outbuf.t -> ?len:int -> ?std:bool -> out_channel -> json Stream.t -> unit (** Write a newline-separated sequence of compact one-line JSON values to a channel. See [to_channel] for the role of the optional arguments. *) val stream_to_file : ?len:int -> ?std:bool -> string -> json Stream.t -> unit (** Write a newline-separated sequence of compact one-line JSON values to a file. See [to_string] for the role of the optional arguments. *) val stream_to_outbuf : ?std:bool -> Bi_outbuf.t -> json Stream.t -> unit (** Write a newline-separated sequence of compact one-line JSON values to an existing buffer. See [to_string] for the role of the optional arguments. *) (** {2 Miscellaneous} *) val sort : json -> json (** Sort object fields (stable sort, comparing field names and treating them as byte sequences) *) (**/**) (* begin undocumented section *) val write_null : Bi_outbuf.t -> unit -> unit val write_bool : Bi_outbuf.t -> bool -> unit #ifdef INT val write_int : Bi_outbuf.t -> int -> unit #endif #ifdef FLOAT val write_float : Bi_outbuf.t -> float -> unit val write_std_float : Bi_outbuf.t -> float -> unit val write_float_fast : Bi_outbuf.t -> float -> unit val write_std_float_fast : Bi_outbuf.t -> float -> unit val write_float_prec : int -> Bi_outbuf.t -> float -> unit val write_std_float_prec : int -> Bi_outbuf.t -> float -> unit #endif #ifdef STRING val write_string : Bi_outbuf.t -> string -> unit #endif #ifdef INTLIT val write_intlit : Bi_outbuf.t -> string -> unit #endif #ifdef FLOATLIT val write_floatlit : Bi_outbuf.t -> string -> unit #endif #ifdef STRINGLIT val write_stringlit : Bi_outbuf.t -> string -> unit #endif val write_assoc : Bi_outbuf.t -> (string * json) list -> unit val write_list : Bi_outbuf.t -> json list -> unit #ifdef TUPLE val write_tuple : Bi_outbuf.t -> json list -> unit val write_std_tuple : Bi_outbuf.t -> json list -> unit #endif #ifdef VARIANT val write_variant : Bi_outbuf.t -> string -> json option -> unit val write_std_variant : Bi_outbuf.t -> string -> json option -> unit #endif val write_json : Bi_outbuf.t -> json -> unit val write_std_json : Bi_outbuf.t -> json -> unit (* end undocumented section *) (**/**) yojson-1.2.3/write2.ml000066400000000000000000000003611257241127100146060ustar00rootroot00000000000000let pretty_format ?std (x : json) = Pretty.format ?std (x :> json_max) let pretty_to_string ?std (x : json) = Pretty.to_string ?std (x :> json_max) let pretty_to_channel ?std oc (x : json) = Pretty.to_channel ?std oc (x :> json_max) yojson-1.2.3/write2.mli000066400000000000000000000011351257241127100147570ustar00rootroot00000000000000(** {2 JSON pretty-printing} *) val pretty_format : ?std:bool -> json -> Easy_format.t (** Convert into a pretty-printable tree. See [to_string] for the role of the optional [std] argument. @see Easy-format *) val pretty_to_string : ?std:bool -> json -> string (** Pretty-print into a string. See [to_string] for the role of the optional [std] argument. *) val pretty_to_channel : ?std:bool -> out_channel -> json -> unit (** Pretty-print to a channel. See [to_string] for the role of the optional [std] argument. *) yojson-1.2.3/ydump.ml000066400000000000000000000112751257241127100145360ustar00rootroot00000000000000open 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 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 in let finally () = if oc != stdout then close_out_noerr oc; if ic != stdin then close_in_noerr ic in try if streaming then Stream.iter (write_one oc) (Yojson.Safe.stream_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) ); 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; output_char oc '\n' in polycat write_one streaming in_file out_file else let write_one oc x = output_string oc (Bi_io.string_of_tree (Yojson_biniou.biniou_of_json x)) in polycat write_one streaming in_file out_file let parse_cmdline () = let out = ref None in let std = ref false in let compact = ref false in 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." ] in let files = ref [] 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) 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 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 yojson-1.2.3/yojson.ml.cppo000066400000000000000000000022151257241127100156530ustar00rootroot00000000000000#include "common.ml" #define INT #define INTLIT #define FLOAT #define FLOATLIT #define STRING #define STRINGLIT #define TUPLE #define VARIANT #include "type.ml" type json_max = json #include "write.ml" module Pretty = struct #include "pretty.ml" end #include "write2.ml" #undef INT #undef INTLIT #undef FLOAT #undef FLOATLIT #undef STRING #undef STRINGLIT #undef TUPLE #undef VARIANT module Basic = struct #define INT #define FLOAT #define STRING #include "type.ml" #include "write.ml" #include "write2.ml" #include "read.ml" module Util = struct #include "util.ml" end #undef INT #undef FLOAT #undef STRING end module Safe = struct #define INT #define INTLIT #define FLOAT #define STRING #define TUPLE #define VARIANT #include "type.ml" #include "safe.ml" #include "write.ml" #include "write2.ml" #include "read.ml" #undef INT #undef INTLIT #undef FLOAT #undef STRING #undef TUPLE #undef VARIANT end module Raw = struct #define INTLIT #define FLOATLIT #define STRINGLIT #define TUPLE #define VARIANT #include "type.ml" #include "write.ml" #include "write2.ml" #include "read.ml" #undef INTLIT #undef FLOATLIT #undef STRINGLIT #undef TUPLE #undef VARIANT end yojson-1.2.3/yojson.mli.cppo000066400000000000000000000062471257241127100160350ustar00rootroot00000000000000(** The Yojson library provides runtime functions for reading and writing JSON data from OCaml. It addresses a few shortcomings of its predecessor json-wheel and is about twice as fast (2.7x reading, 1.3x writing; results may vary). The design goals of Yojson are the following: - Reducing inter-package dependencies by the use of polymorphic variants for the JSON tree type. - Allowing type-aware serializers/deserializers to read and write directly without going through a generic JSON tree, for efficiency purposes. Readers and writers of all JSON syntaxic elements are provided but are undocumented and meant to be used by generated OCaml code. - Distinguishing between ints and floats. - Providing optional extensions of the JSON syntax. These extensions include comments, arbitrary strings, optional quotes around field names, tuples and variants. @author Martin Jambon @see JSON specification *) (** {1 Shared types and functions} *) #include "common.mli" (** {1 Basic JSON tree type} *) module Basic : sig (** This module supports standard JSON nodes only, i.e. no special syntax for variants or tuples as supported by {!Yojson.Safe}. Arbitrary integers are not supported as they must all fit within the standard OCaml int type (31 or 63 bits depending on the platform). The main advantage of this module is its simplicity. *) #define INT #define FLOAT #define STRING #include "type.ml" #include "write.mli" #include "write2.mli" #include "read.mli" module Util : sig #include "util.mli" end #undef INT #undef FLOAT #undef STRING end (** {1 Multipurpose JSON tree type} *) module Safe : sig (** This module supports a specific syntax for variants and tuples in addition to the standard JSON nodes. Arbitrary integers are supported and represented as a decimal string using [`Intlit] when they cannot be represented using OCaml's int type. This module is recommended for intensive use or OCaml-friendly use of JSON. *) #define INT #define INTLIT #define FLOAT #define STRING #define TUPLE #define VARIANT #include "type.ml" #include "safe.mli" #include "write.mli" #include "write2.mli" #include "read.mli" #undef INT #undef INTLIT #undef FLOAT #undef STRING #undef TUPLE #undef VARIANT end (** {1 JSON tree type with literal int/float/string leaves} *) module Raw : sig (** Ints, floats and strings literals are systematically preserved using [`Intlit], [`Floatlit] and [`Stringlit]. This module also supports the specific syntax for variants and tuples supported by {!Yojson.Safe}. *) #define INTLIT #define FLOATLIT #define STRINGLIT #define TUPLE #define VARIANT #include "type.ml" #include "write.mli" #include "write2.mli" #include "read.mli" #undef INTLIT #undef FLOATLIT #undef STRINGLIT #undef TUPLE #undef VARIANT end (** {1 Supertype of all JSON tree types} *) #define INT #define INTLIT #define FLOAT #define FLOATLIT #define STRING #define STRINGLIT #define TUPLE #define VARIANT #include "type.ml" type json_max = json #include "write.mli" #include "write2.mli" #undef INT #undef INTLIT #undef FLOAT #undef FLOATLIT #undef STRING #undef STRINGLIT #undef TUPLE #undef VARIANT yojson-1.2.3/yojson_biniou.ml000066400000000000000000000055121257241127100162630ustar00rootroot00000000000000let rec biniou_of_json = function `Null -> `Unit | `Bool b -> `Bool b | `Int i -> `Svint i | `Intlit i -> failwith "Cannot convert big int to biniou" | `Float f -> `Float64 f | `String s -> `String s | `Assoc l -> let a = Array.map ( fun (s, x) -> (Some s, Bi_io.hash_name s, biniou_of_json x) ) (Array.of_list l) in `Record a | `List l -> (match l with [] -> `Array None | l -> let a = Array.map biniou_of_json (Array.of_list l) in let tag = Bi_io.tag_of_tree a.(0) in try for i = 1 to Array.length a - 1 do if Bi_io.tag_of_tree a.(i) <> tag then raise Exit done; `Array (Some (tag, a)) with Exit -> failwith "Cannot convert heterogenous array to biniou" ) | `Tuple l -> `Tuple (Array.map biniou_of_json (Array.of_list l)) | `Variant (s, o) -> let o = match o with None -> None | Some x -> Some (biniou_of_json x) in `Variant (Some s, Bi_io.hash_name s, o) let rec json_of_biniou (x : Bi_io.tree) = match x with `Unit -> `Null | `Bool b -> `Bool b | `Int8 _ -> failwith "Cannot convert int8 to JSON" | `Int16 _ -> failwith "Cannot convert int16 to JSON" | `Int32 _ -> failwith "Cannot convert int32 to JSON" | `Int64 _ -> failwith "Cannot convert int64 to JSON" | `Float32 f | `Float64 f -> `Float f | `Uvint i -> failwith "Cannot convert uvint to JSON" | `Svint i -> `Int i | `String s -> `String s | `Array None -> `List [] | `Array (Some (_, a)) -> `List (Array.to_list (Array.map json_of_biniou a)) | `Tuple a -> `Tuple (Array.to_list (Array.map json_of_biniou a)) | `Record a -> `Assoc ( Array.to_list ( Array.map ( function (Some s, _, x) -> (s, json_of_biniou x) | (None, _, _) -> failwith "Cannot convert hashed field name to JSON" ) a ) ) | `Num_variant _ -> failwith "Cannot convert num_variant to JSON" | `Variant (Some s, _, Some x) -> `Variant (s, Some (json_of_biniou x)) | `Variant (Some s, _, None) -> `Variant (s, None) | `Variant (None, _, _) -> failwith "Cannot convert hashed variant name to JSON" | `Table None -> `List [] (* not reversible *) | `Table (Some (header, rows)) -> (* not reversible *) `List (Array.to_list (Array.map (json_of_row header) rows)) | `Shared _ -> failwith "Cannot convert shared node to JSON" and json_of_row header a = let n = Array.length header in if Array.length a <> n then failwith "Malformed biniou table"; let l = ref [] in for i = n - 1 downto 0 do let o, _, _ = header.(i) in let x = a.(i) in match o with None -> failwith "Cannot convert hashed field name to JSON" | Some s -> l := (s, json_of_biniou x) :: !l done; `Assoc !l yojson-1.2.3/yojson_biniou.mli000066400000000000000000000006441257241127100164350ustar00rootroot00000000000000(** Conversions between JSON and biniou *) val biniou_of_json : Yojson.Safe.json -> Bi_io.tree (** Converts from JSON to biniou. @raise Failure if conversion is not reversible. *) val json_of_biniou : Bi_io.tree -> Yojson.Safe.json (** Converts from biniou to JSON. @raise Failure if conversion is not reversible, except for biniou tables which are considered equivalent to arrays of records. *)