├── .gitignore ├── .merlin ├── .ocp-indent ├── B0.ml ├── BRZO ├── CHANGES.md ├── LICENSE.md ├── README.md ├── TODO.md ├── _tags ├── doc └── index.mld ├── opam ├── pkg ├── META └── pkg.ml ├── src ├── jsonm.ml ├── jsonm.mli └── jsonm.mllib └── test ├── examples.ml ├── jsontrip.ml ├── jtree.ml └── test.ml /.gitignore: -------------------------------------------------------------------------------- 1 | _b0 2 | _build 3 | tmp 4 | dist 5 | *~ 6 | \.\#* 7 | \#*# 8 | *.native 9 | *.install 10 | *.byte 11 | CLOCK.org -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | PKG uutf b0.kit 2 | S src 3 | S test 4 | B _b0/** 5 | -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | strict_with=always,match_clause=4,strict_else=never -------------------------------------------------------------------------------- /B0.ml: -------------------------------------------------------------------------------- 1 | open B0_kit.V000 2 | open Result.Syntax 3 | 4 | (* OCaml library names *) 5 | 6 | let unix = B0_ocaml.libname "unix" 7 | let uutf = B0_ocaml.libname "uutf" 8 | let jsonm = B0_ocaml.libname "jsonm" 9 | 10 | (* Libraries *) 11 | 12 | let jsonm_lib = 13 | let srcs = Fpath.[`Dir (v "src") ] in 14 | let requires = [uutf] in 15 | B0_ocaml.lib jsonm ~doc:"The jsonm library" ~srcs ~requires 16 | 17 | (* Tests *) 18 | 19 | let jsontrip = 20 | let srcs = Fpath.[`File (v "test/jsontrip.ml")] in 21 | let meta = B0_meta.(empty |> tag test) in 22 | let requires = [ unix; uutf; jsonm ] in 23 | B0_ocaml.exe "jsontrip" ~srcs ~meta ~requires 24 | 25 | let test = 26 | let srcs = Fpath.[`File (v "test/test.ml")] in 27 | let meta = B0_meta.(empty |> tag test) in 28 | let requires = [ uutf; jsonm ] in 29 | B0_ocaml.exe "test" ~srcs ~meta ~requires 30 | 31 | let jtree = 32 | let srcs = Fpath.[`File (v "test/jtree.ml")] in 33 | let meta = B0_meta.(empty |> tag test) in 34 | let requires = [ jsonm ] in 35 | B0_ocaml.exe "jtree" ~srcs ~meta ~requires 36 | 37 | (* Packs *) 38 | 39 | let default = 40 | let meta = 41 | let open B0_meta in 42 | empty 43 | |> tag B0_opam.tag 44 | |> add authors ["The jsonm programmers"] 45 | |> add maintainers ["Daniel Bünzli "] 46 | |> add homepage "https://erratique.ch/software/jsonm" 47 | |> add online_doc "https://erratique.ch/software/jsonm/doc/" 48 | |> add licenses ["ISC"] 49 | |> add repo "git+https://erratique.ch/repos/jsonm.git" 50 | |> add issues "https://github.com/dbuenzli/jsonm/issues" 51 | |> add description_tags 52 | ["json"; "codec"; "org:erratique"] 53 | |> add B0_opam.Meta.depends 54 | [ "ocaml", {|>= "4.05.0"|}; 55 | "ocamlfind", {|build|}; 56 | "ocamlbuild", {|build|}; 57 | "topkg", {|build & >= "1.0.3"|}; 58 | "uutf", {|> "1.0.0" |}; 59 | ] 60 | |> add B0_opam.Meta.build 61 | {|[["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%"]]|} 62 | in 63 | B0_pack.v "default" ~doc:"jsonm package" ~meta ~locked:true @@ 64 | B0_unit.list () 65 | -------------------------------------------------------------------------------- /BRZO: -------------------------------------------------------------------------------- 1 | (srcs-x test pkg) -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | v1.0.2 2023-03-07 La Forclaz (VS) 2 | --------------------------------- 3 | 4 | - Require OCaml 4.05. 5 | - Drop dependency on `uchar` and `bytes` compatibility 6 | modules. 7 | 8 | v1.0.1 2016-03-07 La Forclaz (VS) 9 | --------------------------------- 10 | 11 | - OCaml 4.05.0 compatibility (removal of `Uchar.dump`). 12 | 13 | v1.0.0 2016-11-23 Zagreb 14 | ------------------------ 15 | 16 | - Support for RFC 7195/ECMA-404. This means that any JSON value can 17 | now be codec as JSON text, in RFC 4627 (obsoleted by 7195) this 18 | could only be an array or an object. If your code was relying on the 19 | fact the first decoded lexeme was either a `Os` or `As`, 20 | you will need to review that. 21 | - Fix `Jsonm.decode` not eventually returning `End` on toplevel 22 | decode error. 23 | - OCaml standard library `Uchar.t` support. At the API level only 24 | some cases of `Jsonm.error` change. 25 | - Uutf 1.0.0 support. 26 | - Safe string support. 27 | - Build depend on topkg. 28 | - Relicensed from BSD3 to ISC. 29 | 30 | 31 | v0.9.1 2012-08-05 Lausanne 32 | -------------------------- 33 | 34 | - OASIS 0.3.0 support. 35 | 36 | 37 | v0.9.0 2012-05-05 La Forclaz (VS) 38 | --------------------------------- 39 | 40 | First release. 41 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2012 The jsonm programmers 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any 4 | purpose with or without fee is hereby granted, provided that the above 5 | copyright notice and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 8 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 9 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 10 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 11 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 12 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 13 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Jsonm — Non-blocking streaming JSON codec for OCaml 2 | ------------------------------------------------------------------------------- 3 | %%VERSION%% 4 | 5 | **WARNING** Jsonm is **deprecated** and in maintenance mode. You are encouraged 6 | to switch to [`jsont`](https://erratique.ch/software/jsont) instead. 7 | 8 | Jsonm is a non-blocking streaming codec to decode and encode the JSON 9 | data format. It can process JSON text without blocking on IO and 10 | without a complete in-memory representation of the data. 11 | 12 | The alternative "uncut" codec also processes whitespace and 13 | (non-standard) JSON with JavaScript comments. 14 | 15 | Jsonm is made of a single module and depends on [Uutf][uutf]. It is distributed 16 | under the ISC license. 17 | 18 | [uutf]: http://erratique.ch/software/uutf 19 | 20 | Home page: http://erratique.ch/software/jsonm 21 | Contact: Daniel Bünzli `` 22 | 23 | 24 | ## Installation 25 | 26 | Jsonm can be installed with `opam`: 27 | 28 | opam install jsonm 29 | 30 | If you don't use `opam` consult the [`opam`](opam) file for build 31 | instructions. 32 | 33 | 34 | ## Documentation 35 | 36 | The documentation and API reference is automatically generated by 37 | `ocamldoc` from the interfaces. It can be consulted [online][doc] 38 | and there is a generated version in the `doc` directory of the 39 | distribution. 40 | 41 | [doc]: http://erratique.ch/software/jsonm/doc/Jsonm 42 | 43 | 44 | ## Sample programs 45 | 46 | If you installed jsonm with `opam`, it installed the `jsontrip` binary 47 | which, among other things, reads JSON on `stdin` and rewrites it on 48 | `stdout`; invoke with `-help` for more information. Sample code is 49 | located in the directory `opam config var jsonm:doc`. 50 | 51 | In the distribution sample programs are located in the `test` 52 | directory of the distribution. They can be built with: 53 | 54 | ocamlbuild -use-ocamlfind test/tests.otarget 55 | 56 | The resulting binaries are in `_build/test`. 57 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | val skip : decoder -> [ `A | `O | `Element | `Member ] -> unit 2 | (** [skip d construct] skips lexemes depending on [construct]: 3 | {ul 4 | {- [`A] skips {e past} the [`A_end] matching the last decoded [`A_start].} 5 | {- [`O] skips {e past} the [`O_end] matching the last decoded [`O_start].} 6 | {- [`Element] skips {e to} the next element of the last decoded 7 | [`A_start] or {e to} [`A_end] if there is none.} 8 | {- [`Member] skips {e to} the next [`Name] of the last decoded 9 | [`O_start] or {e to} [`O_end] if there is none.}} 10 | 11 | {b Raises} [Invalid_argument] if [d] is not in the right 12 | state to skip [construct]. *) 13 | -------------------------------------------------------------------------------- /_tags: -------------------------------------------------------------------------------- 1 | true : bin_annot, safe_string, package(uutf) 2 | <_b0> : -traverse 3 | : include 4 | : include 5 | : package(unix) 6 | : package(unix) -------------------------------------------------------------------------------- /doc/index.mld: -------------------------------------------------------------------------------- 1 | {0 Jsonm {%html: %%VERSION%%%}} 2 | 3 | {b Warning.} Jsonm is deprecated and in maintenance mode. 4 | 5 | Jsonm is a non-blocking streaming codec to decode and encode the JSON 6 | data format. It can process JSON text without blocking on IO and 7 | without a complete in-memory representation of the data. 8 | 9 | {1:lib Library [jsonm]} 10 | 11 | {!modules: 12 | Jsonm 13 | } 14 | -------------------------------------------------------------------------------- /opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "jsonm" 3 | synopsis: "Non-blocking streaming JSON codec for OCaml" 4 | description: """\ 5 | Jsonm is a non-blocking streaming codec to decode and encode the JSON 6 | data format. It can process JSON text without blocking on IO and 7 | without a complete in-memory representation of the data. 8 | 9 | The alternative "uncut" codec also processes whitespace and 10 | (non-standard) JSON with JavaScript comments. 11 | 12 | Jsonm is made of a single module and depends on [Uutf][uutf]. It is distributed 13 | under the ISC license. 14 | 15 | [uutf]: http://erratique.ch/software/uutf 16 | 17 | Home page: http://erratique.ch/software/jsonm 18 | Contact: Daniel Bünzli ``""" 19 | maintainer: "Daniel Bünzli " 20 | authors: "The jsonm programmers" 21 | license: "ISC" 22 | tags: ["json" "codec" "org:erratique"] 23 | homepage: "https://erratique.ch/software/jsonm" 24 | doc: "https://erratique.ch/software/jsonm/doc/" 25 | bug-reports: "https://github.com/dbuenzli/jsonm/issues" 26 | depends: [ 27 | "ocaml" {>= "4.05.0"} 28 | "ocamlfind" {build} 29 | "ocamlbuild" {build} 30 | "topkg" {build & >= "1.0.3"} 31 | "uutf" {> "1.0.0"} 32 | ] 33 | build: ["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%"] 34 | dev-repo: "git+https://erratique.ch/repos/jsonm.git" 35 | -------------------------------------------------------------------------------- /pkg/META: -------------------------------------------------------------------------------- 1 | description = "Non-blocking streaming JSON codec" 2 | version = "%%VERSION_NUM%%" 3 | requires = "uutf" 4 | archive(byte) = "jsonm.cma" 5 | archive(native) = "jsonm.cmxa" 6 | plugin(byte) = "jsonm.cma" 7 | plugin(native) = "jsonm.cmxs" 8 | -------------------------------------------------------------------------------- /pkg/pkg.ml: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | #use "topfind" 3 | #require "topkg" 4 | open Topkg 5 | 6 | let () = 7 | Pkg.describe "jsonm" @@ fun c -> 8 | Ok [ Pkg.mllib "src/jsonm.mllib"; 9 | Pkg.bin "test/jsontrip"; 10 | Pkg.doc "test/examples.ml"; 11 | Pkg.doc "test/jtree.ml"; 12 | Pkg.doc "doc/index.mld" ~dst:"odoc-pages/index.mld"; 13 | Pkg.test "test/test"; 14 | Pkg.test ~run:false "test/examples"; 15 | Pkg.test ~run:false "test/jtree"; ] 16 | -------------------------------------------------------------------------------- /src/jsonm.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2012 The jsonm programmers. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | ---------------------------------------------------------------------------*) 5 | 6 | (* Braced non-terminals in comments refer to RFC 4627 non-terminals. *) 7 | 8 | let io_buffer_size = 65536 (* IO_BUFFER_SIZE 4.0.0 *) 9 | let pp = Format.fprintf 10 | 11 | (* Unsafe string and bytes manipulations. If you don't believe the authors's 12 | invariants, replacing with safe versions makes everything safe in the 13 | module. He won't be upset. *) 14 | 15 | let unsafe_byte s j = Char.code (String.unsafe_get s j) 16 | 17 | let unsafe_blit s soff d doff = 18 | Bytes.unsafe_blit (Bytes.unsafe_of_string s) soff d doff 19 | 20 | let unsafe_set_byte s j byte = Bytes.unsafe_set s j (Char.unsafe_chr byte) 21 | 22 | (* Characters and their classes *) 23 | 24 | let ux_eoi = max_int (* End of input, outside unicode range. *) 25 | let ux_soi = max_int - 1 (* Start of input, outside unicode range. *) 26 | let u_nl = 0x0A (* \n *) 27 | let u_sp = 0x20 (* *) 28 | let u_quot = 0x22 (* '' *) 29 | let u_lbrack = 0x5B (* [ *) 30 | let u_rbrack = 0x5D (* ] *) 31 | let u_lbrace = 0x7B (* { *) 32 | let u_rbrace = 0x7D (* } *) 33 | let u_colon = 0x3A (* : *) 34 | let u_dot = 0x2E (* . *) 35 | let u_comma = 0x2C (* , *) 36 | let u_minus = 0x2D (* - *) 37 | let u_slash = 0x2F (* / *) 38 | let u_bslash = 0x5C (* \ *) 39 | let u_times = 0x2A (* * *) 40 | let u_rep = Uchar.to_int Uutf.u_rep 41 | 42 | let must_escape u = u <= 0x1F || u = 0x22 || u = 0x5C 43 | let is_digit u = 0x30 <= u && u <= 0x39 44 | let is_hex_digit u = 45 | 0x30 <= u && u <= 0x39 || 0x41 <= u && u <= 0x46 || 0x61 <= u && u <= 0x66 46 | 47 | let is_white = function (* N.B. Uutf normalizes U+000D to U+000A. *) 48 | | 0x20 | 0x09 | 0x0A -> true | _ -> false 49 | 50 | let is_val_sep = function (* N.B. Uutf normalizes U+000D to U+000A. *) 51 | | 0x20 | 0x09 | 0x0A | 0x2C | 0x5D | 0x7D -> true | _ -> false 52 | 53 | (* Data model *) 54 | 55 | type lexeme = [ 56 | | `Null | `Bool of bool | `String of string | `Float of float 57 | | `Name of string | `As | `Ae | `Os | `Oe ] 58 | 59 | let pp_lexeme ppf = function 60 | | `Null -> pp ppf "`Null" 61 | | `Bool b -> pp ppf "@[`Bool %b@]" b 62 | | `String s -> pp ppf "@[`String %S@]" s 63 | | `Name s -> pp ppf "@[`Name %S@]" s 64 | | `Float f -> pp ppf "@[`Float %s@]" (string_of_float f) 65 | | `As -> pp ppf "`As" 66 | | `Ae -> pp ppf "`Ae" 67 | | `Os -> pp ppf "`Os" 68 | | `Oe -> pp ppf "`Oe" 69 | 70 | (* Decode *) 71 | 72 | type error = [ 73 | | `Illegal_BOM 74 | | `Illegal_escape of 75 | [ `Not_hex_uchar of Uchar.t 76 | | `Not_esc_uchar of Uchar.t 77 | | `Not_lo_surrogate of int 78 | | `Lone_lo_surrogate of int 79 | | `Lone_hi_surrogate of int ] 80 | | `Illegal_string_uchar of Uchar.t 81 | | `Illegal_bytes of string 82 | | `Illegal_literal of string 83 | | `Illegal_number of string 84 | | `Unclosed of [ `As | `Os | `String | `Comment ] 85 | | `Expected of 86 | [ `Comment | `Value | `Name | `Name_sep | `Json | `Eoi 87 | | `Aval of bool (* [true] if first array value *) 88 | | `Omem of bool (* [true] if first object member *) ]] 89 | 90 | let err_bom = `Error (`Illegal_BOM) 91 | let err_not_hex u = `Error (`Illegal_escape (`Not_hex_uchar (Uchar.of_int u))) 92 | let err_not_esc u = `Error (`Illegal_escape (`Not_esc_uchar (Uchar.of_int u))) 93 | let err_not_lo p = `Error (`Illegal_escape (`Not_lo_surrogate p)) 94 | let err_lone_lo p = `Error (`Illegal_escape (`Lone_lo_surrogate p)) 95 | let err_lone_hi p = `Error (`Illegal_escape (`Lone_hi_surrogate p)) 96 | let err_str_char u = `Error (`Illegal_string_uchar (Uchar.of_int u)) 97 | let err_bytes bs = `Error (`Illegal_bytes bs) 98 | let err_unclosed_comment = `Error (`Unclosed `Comment) 99 | let err_unclosed_string = `Error (`Unclosed `String) 100 | let err_unclosed_arr = `Error (`Unclosed `As) 101 | let err_unclosed_obj = `Error (`Unclosed `Os) 102 | let err_number s = `Error (`Illegal_number s) 103 | let err_literal s = `Error (`Illegal_literal s) 104 | let err_exp_comment = `Error (`Expected `Comment) 105 | let err_exp_value = `Error (`Expected `Value) 106 | let err_exp_name = `Error (`Expected `Name) 107 | let err_exp_nsep = `Error (`Expected `Name_sep) 108 | let err_exp_arr_fst = `Error (`Expected (`Aval true)) 109 | let err_exp_arr_nxt = `Error (`Expected (`Aval false)) 110 | let err_exp_obj_fst = `Error (`Expected (`Omem true)) 111 | let err_exp_obj_nxt = `Error (`Expected (`Omem false)) 112 | let err_exp_json = `Error (`Expected `Json) 113 | let err_exp_eoi = `Error (`Expected `Eoi) 114 | 115 | let pp_cp ppf u = pp ppf "U+%04X" u 116 | let pp_uchar ppf u = 117 | if Uchar.to_int u <= 0x1F (* most control chars *) then pp_cp ppf (Uchar.to_int u) else 118 | let b = Buffer.create 4 in 119 | Uutf.Buffer.add_utf_8 b u; 120 | pp ppf "'%s' (%a)" (Buffer.contents b) pp_cp (Uchar.to_int u) 121 | 122 | let pp_error ppf = function 123 | | `Illegal_BOM -> pp ppf "@[illegal@ initial@ BOM@ in@ character@ stream@]" 124 | | `Illegal_escape r -> 125 | pp ppf "@[illegal@ escape,@ "; 126 | begin match r with 127 | | `Not_hex_uchar u -> pp ppf "%a@ not@ a@ hex@ digit@]" pp_uchar u 128 | | `Not_esc_uchar u -> pp ppf "%a@ not@ an@ escaped@ character@]" pp_uchar u 129 | | `Lone_lo_surrogate p -> pp ppf "%a@ lone@ low@ surrogate@]" pp_cp p 130 | | `Lone_hi_surrogate p -> pp ppf "%a@ lone@ high@ surrogate@]" pp_cp p 131 | | `Not_lo_surrogate p -> pp ppf "%a@ not@ a@ low@ surrogate@]" pp_cp p 132 | end 133 | | `Illegal_string_uchar u -> 134 | pp ppf "@[illegal@ character@ in@ JSON@ string@ (%a)@]" pp_uchar u 135 | | `Illegal_bytes bs -> 136 | let l = String.length bs in 137 | pp ppf "@[illegal@ bytes@ in@ character@ stream@ ("; 138 | if l > 0 then pp ppf "%02X" (Char.code (bs.[0])); 139 | for i = 1 to l - 1 do pp ppf " %02X" (Char.code (bs.[i])) done; 140 | pp ppf ")@]" 141 | | `Illegal_number n -> pp ppf "@[illegal@ number@ (%s)@]" n 142 | | `Illegal_literal l -> pp ppf "@[illegal@ literal@ (%s)@]" l 143 | | `Unclosed r -> 144 | pp ppf "@[unclosed@ "; 145 | begin match r with 146 | | `As -> pp ppf "array@]"; 147 | | `Os -> pp ppf "object@]"; 148 | | `String -> pp ppf "string@]"; 149 | | `Comment -> pp ppf "comment@]" 150 | end 151 | | `Expected r -> 152 | pp ppf "@[expected@ "; 153 | begin match r with 154 | | `Comment -> pp ppf "JavaScript@ comment@]" 155 | | `Value -> pp ppf "JSON@ value@]" 156 | | `Name -> pp ppf "member@ name@]" 157 | | `Name_sep -> pp ppf "name@ separator@ (':')@]" 158 | | `Aval true -> pp ppf "value@ or@ array@ end@ (value@ or@ ']')@]" 159 | | `Aval false -> pp ppf "value@ separator@ or@ array@ end@ (','@ or@ ']')@]" 160 | | `Omem true -> pp ppf "member@ name@ or@ object@ end@ ('\"'@ or@ '}')@]" 161 | | `Omem false ->pp ppf "value@ separator@ or@ object@ end@ (','@ or@ '}')@]" 162 | | `Json -> pp ppf "JSON@ text (JSON value)@]" 163 | | `Eoi -> pp ppf "end@ of@ input@]" 164 | end 165 | 166 | type pos = int * int 167 | type encoding = [ `UTF_8 | `UTF_16 | `UTF_16BE | `UTF_16LE ] 168 | type src = [ `Channel of in_channel | `String of string | `Manual ] 169 | type decode = [ `Await | `End | `Lexeme of lexeme | `Error of error ] 170 | type uncut = [ `Comment of [ `M | `S ] * string | `White of string ] 171 | 172 | let pp_decode ppf = function 173 | | `Lexeme l -> pp ppf "@[`Lexeme @[(%a)@]@]" pp_lexeme l 174 | | `Await -> pp ppf "`Await" 175 | | `End -> pp ppf "`End" 176 | | `Error e -> pp ppf "@[`Error @[(%a)@]@]" pp_error e 177 | | `White s -> pp ppf "@[`White @[%S@]@]" s 178 | | `Comment (style, s) -> 179 | let pr_style ppf = function `M -> pp ppf "`M" | `S -> pp ppf "`S" in 180 | pp ppf "@[`Comment @[(%a, %S)@]@]" pr_style style s 181 | 182 | type decoder = 183 | { u : Uutf.decoder; (* Unicode character decoder. *) 184 | buf : Buffer.t; (* string accumulation buffer. *) 185 | mutable uncut : bool; (* [true] to bufferize comments and white space. *) 186 | mutable s_line : int; (* last saved start line. *) 187 | mutable s_col : int; (* last saved start column. *) 188 | mutable e_line : int; (* last saved end line. *) 189 | mutable e_col : int; (* last saved end column. *) 190 | mutable c : int; (* character lookahead. *) 191 | mutable stack : (* stack of open arrays and objects. *) 192 | [ `As of pos | `Os of pos ] list; 193 | mutable next_name : bool; (* [true] if next decode should be [`Name]. *) 194 | mutable last_start : bool; (* [true] if last lexeme was `As or `Os. *) 195 | mutable k : (* decoder continuation. *) 196 | decoder -> [ decode | uncut ] } 197 | 198 | let baddc d c = Uutf.Buffer.add_utf_8 d.buf (Uchar.unsafe_of_int c) 199 | let badd d = Uutf.Buffer.add_utf_8 d.buf (Uchar.unsafe_of_int d.c) 200 | let buf d = let t = Buffer.contents d.buf in (Buffer.clear d.buf; t) 201 | let dpos d = Uutf.decoder_line d.u, Uutf.decoder_col d.u 202 | let spos d = d.s_line <- Uutf.decoder_line d.u; d.s_col <- Uutf.decoder_col d.u 203 | let epos d = d.e_line <- Uutf.decoder_line d.u; d.e_col <- Uutf.decoder_col d.u 204 | let stack_range d = match d.stack with [] -> assert false 205 | | `As (l,c) :: _ | `Os (l,c) :: _ -> d.s_line <- l; d.s_col <- c; epos d 206 | 207 | let dpop d = match (spos d; epos d; d.stack) with 208 | | _ :: (`Os _ :: _ as ss) -> d.next_name <- true; d.stack <- ss 209 | | _ :: (`As _ :: _ as ss) -> d.next_name <- false; d.stack <- ss 210 | | _ :: [] -> d.next_name <- false; d.stack <- [] 211 | | [] -> assert false 212 | 213 | let ret_eoi d = `End 214 | let ret (v : [< decode | uncut]) k d = d.k <- k; v 215 | let rec readc k d = match Uutf.decode d.u with 216 | | `Uchar u -> d.c <- (Uchar.to_int u); k d 217 | | `End -> d.c <- ux_eoi; k d 218 | | `Await -> ret `Await (readc k) d 219 | | `Malformed bs -> d.c <- u_rep; epos d; ret (err_bytes bs) k d 220 | 221 | let rec r_scomment k d = (* single line comment. // was eaten. *) 222 | if (d.c <> u_nl && d.c <> ux_eoi) then (badd d; readc (r_scomment k) d) else 223 | (epos d; ret (`Comment (`S, buf d)) (readc k) d) 224 | 225 | let rec r_mcomment closing k d = (* multiline comment. /* was eaten. *) 226 | if (d.c = ux_eoi) then (epos d; ret err_unclosed_comment ret_eoi d) else 227 | if closing then begin 228 | if (d.c = u_slash) then (epos d; ret (`Comment (`M, buf d)) (readc k) d)else 229 | if (d.c = u_times) then (badd d; readc (r_mcomment true k) d) else 230 | (baddc d u_times; badd d; readc (r_mcomment false k) d) 231 | end else begin 232 | if (d.c = u_times) then readc (r_mcomment true k) d else 233 | (badd d; readc (r_mcomment false k) d) 234 | end 235 | 236 | let r_comment k d = (* comment, / was eaten. *) 237 | if d.c = u_slash then readc (r_scomment k) d else 238 | if d.c = u_times then readc (r_mcomment false k) d else 239 | (epos d; ret err_exp_comment k d) 240 | 241 | let rec r_ws_uncut k d = 242 | if (is_white d.c) then (epos d; badd d; readc (r_ws_uncut k) d) else 243 | ret (`White (buf d)) k d 244 | 245 | let rec r_white_uncut k d = (* {ws} / comment *) 246 | if (is_white d.c) then (spos d; r_ws_uncut (r_white_uncut k) d) else 247 | if (d.c = u_slash) then (spos d; readc (r_comment (r_white_uncut k)) d) else 248 | k d 249 | 250 | let rec r_ws k d = if (is_white d.c) then readc (r_ws k) d else k d (* {ws} *) 251 | let r_white k d = if d.uncut then r_white_uncut k d else r_ws k d 252 | 253 | let rec r_u_escape hi u count k d = (* unicode escapes. *) 254 | let error err k d = baddc d u_rep; ret err k d in 255 | if count > 0 then 256 | if not (is_hex_digit d.c) then (epos d; error (err_not_hex d.c) (readc k) d) 257 | else 258 | let u = u * 16 + (if d.c <= 0x39 (* 9 *) then d.c - 0x30 else 259 | if d.c <= 0x46 (* F *) then d.c - 0x37 else d.c - 0x57) 260 | in 261 | (epos d; readc (r_u_escape hi u (count - 1) k) d) 262 | else match hi with 263 | | Some hi -> (* combine high and low surrogate into scalar value. *) 264 | if u < 0xDC00 || u > 0xDFFF then error (err_not_lo u) k d else 265 | let u = ((((hi land 0x3FF) lsl 10) lor (u land 0x3FF)) + 0x10000) in 266 | (baddc d u; k d) 267 | | None -> 268 | if u < 0xD800 || u > 0xDFFF then (baddc d u; k d) else 269 | if u > 0xDBFF then error (err_lone_lo u) k d else 270 | if d.c <> u_bslash then error (err_lone_hi u) k d else 271 | readc (fun d -> 272 | if d.c <> 0x75 (* u *) then error (err_lone_hi u) (r_escape k) d else 273 | readc (r_u_escape (Some u) 0 4 k) d) d 274 | 275 | and r_escape k d = match d.c with 276 | | 0x22 (* '' *)-> baddc d u_quot; readc k d 277 | | 0x5C (* \ *) -> baddc d u_bslash; readc k d 278 | | 0x2F (* / *) -> baddc d u_slash; readc k d 279 | | 0x62 (* b *) -> baddc d 0x08; readc k d 280 | | 0x66 (* f *) -> baddc d 0x0C; readc k d 281 | | 0x6E (* n *) -> baddc d u_nl; readc k d 282 | | 0x72 (* r *) -> baddc d 0x0D; readc k d 283 | | 0x74 (* t *) -> baddc d 0x09; readc k d 284 | | 0x75 (* u *) -> readc (r_u_escape None 0 4 k) d 285 | | c -> epos d; baddc d u_rep; ret (err_not_esc c) (readc k) d 286 | 287 | let rec r_string k d = (* {string}, '' eaten. *) 288 | if d.c = ux_eoi then (epos d; ret err_unclosed_string ret_eoi d) else 289 | if not (must_escape d.c) then (badd d; readc (r_string k) d) else 290 | if d.c = u_quot then (epos d; readc k d) else 291 | if d.c = u_bslash then readc (r_escape (r_string k)) d else 292 | (epos d; baddc d u_rep; ret (err_str_char d.c) (readc (r_string k)) d) 293 | 294 | let rec r_float k d = (* {number} *) 295 | if not (is_val_sep d.c) && d.c <> ux_eoi 296 | then (epos d; badd d; readc (r_float k) d) else 297 | let s = buf d in 298 | try ret (`Lexeme (`Float (float_of_string s))) k d with 299 | | Failure _ -> ret (err_number s) k d 300 | 301 | let rec r_literal k d = (* {true} / {false} / {null} *) 302 | if not (is_val_sep d.c) && d.c <> ux_eoi 303 | then (epos d; badd d; readc (r_literal k) d) else 304 | match buf d with 305 | | "true" -> ret (`Lexeme (`Bool true)) k d 306 | | "false" -> ret (`Lexeme (`Bool false)) k d 307 | | "null" -> ret (`Lexeme `Null) k d 308 | | s -> ret (err_literal s) k d 309 | 310 | let rec r_value err k d = match d.c with (* {value} *) 311 | | 0x5B (* [ *) -> (* {begin-array} *) 312 | spos d; epos d; d.last_start <- true; 313 | d.stack <- `As (dpos d) :: d.stack; 314 | ret (`Lexeme `As) (readc k) d 315 | | 0x7B (* { *) -> (* {begin-object} *) 316 | spos d; epos d; d.last_start <- true; d.next_name <- true; 317 | d.stack <- `Os (dpos d) :: d.stack; 318 | ret (`Lexeme `Os) (readc k) d 319 | | 0x22 (* '' *) -> 320 | let lstring k d = ret (`Lexeme (`String (buf d))) k d in 321 | spos d; readc (r_string (lstring k)) d 322 | | 0x66 (* f *) | 0x6E (* n *) | 0x74 (* t *) -> 323 | spos d; r_literal k d 324 | | u when is_digit u || u = u_minus -> spos d; r_float k d 325 | | u -> err k d 326 | 327 | let rec discard_to c1 c2 err k d = 328 | if d.c = c1 || d.c = c2 || d.c = ux_eoi then ret err k d else 329 | (epos d; readc (discard_to c1 c2 err k) d) 330 | 331 | let r_arr_val k d = (* [{value-separator}] {value} / {end-array} *) 332 | let nxval err k d = spos d; discard_to u_comma u_rbrack err k d in 333 | let last_start = d.last_start in 334 | d.last_start <- false; 335 | if d.c = ux_eoi then (stack_range d; ret err_unclosed_arr ret_eoi d) else 336 | if d.c = u_rbrack then (dpop d; ret (`Lexeme `Ae) (readc k) d) else 337 | if last_start then r_value (nxval err_exp_arr_fst) k d else 338 | if d.c = u_comma then readc (r_white (r_value (nxval err_exp_value) k)) d 339 | else nxval err_exp_arr_nxt k d 340 | 341 | let nxmem err k d = 342 | spos d; d.next_name <- true; discard_to u_comma u_rbrace err k d 343 | 344 | let r_obj_value k d = (* {name-separator} {value} *) 345 | d.next_name <- true; 346 | if d.c = u_colon then readc (r_white (r_value (nxmem err_exp_value) k)) d 347 | else nxmem err_exp_nsep k d 348 | 349 | let r_obj_name k d = (* [{value-separator}] string / end-object *) 350 | let r_name err k d = 351 | let ln k d = ret (`Lexeme (`Name (buf d))) k d in 352 | if d.c <> u_quot then nxmem err k d else (spos d; readc (r_string (ln k)) d) 353 | in 354 | let last_start = d.last_start in 355 | d.last_start <- false; d.next_name <- false; 356 | if d.c = ux_eoi then (stack_range d; ret err_unclosed_obj ret_eoi d) else 357 | if d.c = u_rbrace then (dpop d; ret (`Lexeme `Oe) (readc k) d) else 358 | if last_start then r_name err_exp_obj_fst k d else 359 | if d.c = u_comma then readc (r_white (r_name err_exp_name k)) d else 360 | nxmem err_exp_obj_nxt k d 361 | 362 | let r_end k d = (* end of input *) 363 | if d.c = ux_eoi then ret `End ret_eoi d else 364 | let drain k d = spos d; discard_to ux_eoi ux_eoi err_exp_eoi k d in 365 | drain ret_eoi d 366 | 367 | let rec r_lexeme d = match d.stack with 368 | | `As _ :: _ -> r_white (r_arr_val r_lexeme) d 369 | | `Os _ :: _ -> 370 | if d.next_name then r_white (r_obj_name r_lexeme) d else 371 | r_white (r_obj_value r_lexeme) d 372 | | [] -> r_white (r_end r_lexeme) d 373 | 374 | let rec discard_to_white err k d = 375 | if is_white d.c || d.c = ux_eoi then ret err k d else 376 | (epos d; readc (discard_to_white err k) d) 377 | 378 | let rec r_json k d = (* {value} *) 379 | let err k d = spos d; discard_to_white err_exp_json (r_white (r_json k)) d in 380 | if d.c <> ux_eoi then r_value err k d else ret err_exp_json k d 381 | 382 | let r_start d = (* start of input *) 383 | let bom k d = if Uutf.decoder_removed_bom d.u then ret err_bom k d else k d in 384 | readc (bom (r_white (r_json r_lexeme))) d 385 | 386 | let nln = `ASCII (Uchar.unsafe_of_int 0x000A) 387 | let decoder ?encoding src = 388 | let u = Uutf.decoder ?encoding ~nln src in 389 | { u; buf = Buffer.create 1024; uncut = false; 390 | s_line = 1; s_col = 0; e_line = 1; e_col = 0; 391 | c = ux_soi; next_name = false; last_start = false; stack = []; 392 | k = r_start } 393 | 394 | let decode_uncut d = d.uncut <- true; d.k d 395 | let rec decode d = match (d.uncut <- false; d.k d) with 396 | | #decode as v -> (v :> [> decode]) 397 | | `Comment _ | `White _ -> assert false 398 | 399 | let decoder_src d = Uutf.decoder_src d.u 400 | let decoded_range d = (d.s_line, d.s_col), (d.e_line, d.e_col) 401 | let decoder_encoding d = match Uutf.decoder_encoding d.u with 402 | | #encoding as enc -> enc 403 | | `US_ASCII | `ISO_8859_1 -> assert false 404 | 405 | (* Encode *) 406 | 407 | let invalid_arg fmt = 408 | let b = Buffer.create 20 in (* for thread safety. *) 409 | let ppf = Format.formatter_of_buffer b in 410 | let k ppf = Format.pp_print_flush ppf (); invalid_arg (Buffer.contents b) in 411 | Format.kfprintf k ppf fmt 412 | 413 | let invalid_bounds j l = invalid_arg "invalid bounds (index %d, length %d)" j l 414 | let expect e v = invalid_arg "%a encoded but expected %s" pp_decode v e 415 | let expect_await v = expect "`Await" v 416 | let expect_end l = expect "`End" (`Lexeme l) 417 | let expect_mem_value l = expect "any `Lexeme but `Name, `Oe or `Ae" (`Lexeme l) 418 | let expect_arr_value_ae l = expect "any `Lexeme but `Name or `Oe" (`Lexeme l) 419 | let expect_name_or_oe l = expect "`Lexeme (`Name _ | `Oe)" (`Lexeme l) 420 | let expect_json v = 421 | expect "`Lexeme (`Null | `Bool _ | `Float _ | `String _ | `As | `Os)" v 422 | 423 | let expect_lend lstart v = 424 | expect (if lstart = `As then "`Lexeme `Ae" else "`Lexeme `Oe") v 425 | 426 | type dst = [ `Channel of out_channel | `Buffer of Buffer.t | `Manual ] 427 | type encode = [ `Await | `End | `Lexeme of lexeme ] 428 | type encoder = 429 | { dst : dst; (* output destination. *) 430 | minify : bool; (* [true] for compact output. *) 431 | mutable o : Bytes.t; (* current output chunk. *) 432 | mutable o_pos : int; (* next output position to write. *) 433 | mutable o_max : int; (* maximal output position to write. *) 434 | buf : Buffer.t; (* buffer to format floats. *) 435 | mutable stack : [`As | `Os ] list; (* stack of open arrays and objects. *) 436 | mutable nest : int; (* nesting level (String.length stack). *) 437 | mutable next_name : bool; (* [true] if next encode should `Name. *) 438 | mutable last_start : bool; (* [true] if last encode was [`As | `Os]. *) 439 | mutable k : (* decoder continuation. *) 440 | encoder -> [ encode | uncut ] -> [ `Ok | `Partial ] } 441 | 442 | let o_rem e = e.o_max - e.o_pos + 1 (* remaining bytes to write in [e.o]. *) 443 | let dst e s j l = (* set [e.o] with [s]. *) 444 | if (j < 0 || l < 0 || j + l > Bytes.length s) then invalid_bounds j l; 445 | e.o <- s; e.o_pos <- j; e.o_max <- j + l - 1 446 | 447 | let partial k e = function `Await -> k e | v -> expect_await v 448 | let flush k e = match e.dst with (* get free space in [d.o] and [k]ontinue. *) 449 | | `Manual -> e.k <- partial k; `Partial 450 | | `Channel oc -> output oc e.o 0 e.o_pos; e.o_pos <- 0; k e 451 | | `Buffer b -> 452 | let o = Bytes.unsafe_to_string e.o in 453 | Buffer.add_substring b o 0 e.o_pos; e.o_pos <- 0; k e 454 | 455 | 456 | let rec writeb b k e = (* write byte [b] and [k]ontinue. *) 457 | if e.o_pos > e.o_max then flush (writeb b k) e else 458 | (unsafe_set_byte e.o e.o_pos b; e.o_pos <- e.o_pos + 1; k e) 459 | 460 | let rec writes s j l k e = (* write [l] bytes from [s] starting at [j]. *) 461 | let rem = o_rem e in 462 | if rem >= l then (unsafe_blit s j e.o e.o_pos l; e.o_pos <- e.o_pos + l; k e) 463 | else begin 464 | unsafe_blit s j e.o e.o_pos rem; e.o_pos <- e.o_pos + rem; 465 | flush (writes s (j + rem) (l - rem) k) e 466 | end 467 | 468 | let rec writebuf j l k e = (* write [l] bytes from [e.buf] starting at [j]. *) 469 | let rem = o_rem e in 470 | if rem >= l 471 | then (Buffer.blit e.buf j e.o e.o_pos l; e.o_pos <- e.o_pos + l; k e) 472 | else begin 473 | Buffer.blit e.buf j e.o e.o_pos rem; e.o_pos <- e.o_pos + rem; 474 | flush (writebuf (j + rem) (l - rem) k) e 475 | end 476 | 477 | let w_indent k e = 478 | let rec loop indent k e = 479 | let spaces e indent = 480 | let max = e.o_pos + indent - 1 in 481 | for j = e.o_pos to max do unsafe_set_byte e.o j u_sp done; 482 | e.o_pos <- max + 1 483 | in 484 | let rem = o_rem e in 485 | if rem < indent then (spaces e rem; flush (loop (indent - rem) k) e) else 486 | (spaces e indent; k e) 487 | in 488 | loop (e.nest * 2) k e 489 | 490 | let rec w_json_string s k e = (* escapes as mandated by the standard. *) 491 | let rec loop s j pos max k e = 492 | if pos > max then (if j > max then k e else writes s j (pos - j) k e) else 493 | let next = pos + 1 in 494 | let escape esc = (* assert (String.length esc = 2 ). *) 495 | writes s j (pos - j) (writes esc 0 2 (loop s next next max k)) e 496 | in 497 | match unsafe_byte s pos with 498 | | 0x22 -> escape "\\\"" 499 | | 0x5C -> escape "\\\\" 500 | | 0x0A -> escape "\\n" 501 | | c when c <= 0x1F -> 502 | let hex d = (if d < 10 then 0x30 + d else 0x41 + (d - 10)) in 503 | writes s j (pos - j) 504 | (writes "\\u00" 0 4 505 | (writeb (hex (c lsr 4)) 506 | (writeb (hex (c land 0xF)) 507 | (loop s next next max k)))) e 508 | | c -> loop s j next max k e 509 | in 510 | writeb u_quot (loop s 0 0 (String.length s - 1) (writeb u_quot k)) e 511 | 512 | let w_name n k e = 513 | e.last_start <- false; e.next_name <- false; 514 | w_json_string n (writeb u_colon k) e 515 | 516 | let w_value ~in_obj l k e = match l with 517 | | `String s -> 518 | e.last_start <- false; e.next_name <- in_obj; 519 | w_json_string s k e 520 | | `Bool b -> 521 | e.last_start <- false; e.next_name <- in_obj; 522 | if b then writes "true" 0 4 k e else writes "false" 0 5 k e 523 | | `Float f -> 524 | e.last_start <- false; e.next_name <- in_obj; 525 | Buffer.clear e.buf; Printf.bprintf e.buf "%.16g" f; 526 | writebuf 0 (Buffer.length e.buf) k e 527 | | `Os -> 528 | e.last_start <- true; e.next_name <- true; 529 | e.nest <- e.nest + 1; e.stack <- `Os :: e.stack; 530 | writeb u_lbrace k e 531 | | `As -> 532 | e.last_start <- true; e.next_name <- false; 533 | e.nest <- e.nest + 1; e.stack <- `As :: e.stack; 534 | writeb u_lbrack k e 535 | | `Null -> 536 | e.last_start <- false; e.next_name <- in_obj; 537 | writes "null" 0 4 k e 538 | | `Oe | `Ae | `Name _ as l -> 539 | if in_obj then expect_mem_value l else expect_arr_value_ae l 540 | 541 | let w_lexeme k e l = 542 | let epop e = 543 | e.last_start <- false; 544 | e.nest <- e.nest - 1; e.stack <- List.tl e.stack; 545 | match e.stack with 546 | | `Os :: _ -> e.next_name <- true; 547 | | _ -> e.next_name <- false 548 | in 549 | match List.hd e.stack with 550 | | `Os -> (* inside object. *) 551 | if not e.next_name then w_value ~in_obj:true l k e else 552 | begin match l with 553 | | `Name n -> 554 | let name n k e = 555 | if e.minify then w_name n k e else 556 | writeb u_nl (w_indent (w_name n (writeb u_sp k))) e 557 | in 558 | if e.last_start then name n k e else 559 | writeb u_comma (name n k) e 560 | | `Oe -> 561 | if e.minify || e.last_start then (epop e; writeb u_rbrace k e) else 562 | (epop e; writeb u_nl (w_indent (writeb u_rbrace k)) e) 563 | | v -> expect_name_or_oe l 564 | end 565 | | `As -> (* inside array. *) 566 | begin match l with 567 | | `Ae -> 568 | if e.minify || e.last_start then (epop e; writeb u_rbrack k e) else 569 | (epop e; writeb u_nl (w_indent (writeb u_rbrack k)) e) 570 | | l -> 571 | let value l k e = 572 | if e.minify then w_value ~in_obj:false l k e else 573 | writeb u_nl (w_indent (w_value ~in_obj:false l k)) e 574 | in 575 | if e.last_start then value l k e else 576 | writeb u_comma (value l k) e 577 | end 578 | 579 | let rec encode_ k e = function 580 | | `Lexeme l -> 581 | if e.stack = [] then expect_end l else w_lexeme k e l 582 | | `End as v -> 583 | if e.stack = [] then flush k e else expect_lend (List.hd e.stack) v 584 | | `White w -> 585 | writes w 0 (String.length w) k e 586 | | `Comment (`S, c) -> 587 | writes "//" 0 2 (writes c 0 (String.length c) (writeb u_nl k)) e 588 | | `Comment (`M, c) -> 589 | writes "/*" 0 2 (writes c 0 (String.length c) (writes "*/" 0 2 k)) e 590 | | `Await -> `Ok 591 | 592 | let rec encode_loop e = e.k <- encode_ encode_loop; `Ok 593 | let rec encode_json e = function (* first [k] to start with [`Os] or [`As]. *) 594 | | `Lexeme (`Null | `Bool _ | `Float _ | `String _ | `As | `Os as l) -> 595 | w_value ~in_obj:false l encode_loop e 596 | | `End | `Lexeme _ as v -> expect_json v 597 | | `White _ | `Comment _ as v -> encode_ (fun e -> e.k <- encode_json; `Ok) e v 598 | | `Await -> `Ok 599 | 600 | let encoder ?(minify = true) dst = 601 | let o, o_pos, o_max = match dst with 602 | | `Manual -> Bytes.empty, 1, 0 (* implies [o_rem e = 0]. *) 603 | | `Buffer _ 604 | | `Channel _ -> Bytes.create io_buffer_size, 0, io_buffer_size - 1 605 | in 606 | { dst = (dst :> dst); minify; o; o_pos; o_max; buf = Buffer.create 30; 607 | stack = []; nest = 0; next_name = false; last_start = false; 608 | k = encode_json } 609 | 610 | let encode e v = e.k e (v :> [ encode | uncut ]) 611 | let encoder_dst e = e.dst 612 | let encoder_minify e = e.minify 613 | 614 | (* Manual *) 615 | 616 | module Manual = struct 617 | let src d = Uutf.Manual.src d.u 618 | let dst = dst 619 | let dst_rem = o_rem 620 | end 621 | 622 | (* Uncut *) 623 | 624 | module Uncut = struct 625 | let decode = decode_uncut 626 | let pp_decode = pp_decode 627 | let encode e v = e.k e (v :> [ encode | uncut]) 628 | end 629 | 630 | (*--------------------------------------------------------------------------- 631 | Copyright (c) 2012 The jsonm programmers 632 | 633 | Permission to use, copy, modify, and/or distribute this software for any 634 | purpose with or without fee is hereby granted, provided that the above 635 | copyright notice and this permission notice appear in all copies. 636 | 637 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 638 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 639 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 640 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 641 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 642 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 643 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 644 | ---------------------------------------------------------------------------*) 645 | -------------------------------------------------------------------------------- /src/jsonm.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2012 The jsonm programmers. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Non-blocking streaming JSON codec. 7 | 8 | [Jsonm] is a non-blocking streaming codec to 9 | {{!section:decode}decode} and {{!section:encode}encode} the 10 | {{:http://tools.ietf.org/html/rfc7159}JSON} data format. It can 11 | process JSON text without blocking on IO and without a complete 12 | in-memory representation of the data. 13 | 14 | The {{!Uncut}uncut codec} also processes whitespace and 15 | (non-standard) JSON with JavaScript comments. 16 | 17 | Consult the {{!datamodel}data model}, {{!limitations}limitations} 18 | and {{!examples}examples} of use. 19 | 20 | {b References} 21 | {ul 22 | {- T. Bray Ed. 23 | {e {{:http://tools.ietf.org/html/rfc7159}The JavaScript Object Notation 24 | (JSON) Data Interchange Format}, 2014}}} *) 25 | 26 | (** {1:datamodel JSON data model} *) 27 | 28 | type lexeme = [ 29 | | `Null 30 | | `Bool of bool 31 | | `String of string 32 | | `Float of float 33 | | `Name of string 34 | | `As 35 | | `Ae 36 | | `Os 37 | | `Oe ] 38 | (** The type for JSON lexemes. [`As] and [`Ae] 39 | start and end arrays and [`Os] and [`Oe] start 40 | and end objects. [`Name] is for the member names of objects. 41 | 42 | A {e well-formed} sequence of lexemes belongs to the language of 43 | the [json] grammar: 44 | {[ 45 | json = value  46 | object = `Os *member `Oe 47 | member = (`Name s) value 48 | array = `As *value `Ae 49 | value = `Null / `Bool b / `Float f / `String s / object / array 50 | ]} 51 | A {{!section:decode}decoder} returns only well-formed sequences of 52 | lexemes or [`Error]s are returned. The 53 | {{:http://tools.ietf.org/html/rfc3629}UTF-8}, 54 | {{:http://tools.ietf.org/html/rfc2781}UTF-16}, UTF-16LE and 55 | UTF-16BE encoding schemes are supported. The strings of decoded 56 | [`Name] and [`String] lexemes are however always UTF-8 encoded. In 57 | these strings, characters originally escaped in the input are in 58 | their unescaped representation. 59 | 60 | An {{!section:encode}encoder} accepts only well-formed sequences 61 | of lexemes or [Invalid_argument] is raised. Only the UTF-8 62 | encoding scheme is supported. The strings of encoded [`Name] and 63 | [`String] lexemes are assumed to be immutable and must be UTF-8 64 | encoded, this is {b not} checked by the module. In these strings, 65 | the delimiter characters [U+0022] and [U+005C] (['"'], ['\']) 66 | aswell as the control characters [U+0000-U+001F] are automatically 67 | escaped by the encoders, as mandated by the standard. *) 68 | 69 | val pp_lexeme : Format.formatter -> [< lexeme] -> unit 70 | (** [pp_lexeme ppf l] prints a unspecified non-JSON representation of [l] 71 | on [ppf]. *) 72 | 73 | (** {1:decode Decode} *) 74 | 75 | type error = [ 76 | | `Illegal_BOM 77 | | `Illegal_escape of 78 | [ `Not_hex_uchar of Uchar.t 79 | | `Not_esc_uchar of Uchar.t 80 | | `Not_lo_surrogate of int 81 | | `Lone_lo_surrogate of int 82 | | `Lone_hi_surrogate of int ] 83 | | `Illegal_string_uchar of Uchar.t 84 | | `Illegal_bytes of string 85 | | `Illegal_literal of string 86 | | `Illegal_number of string 87 | | `Unclosed of [ `As | `Os | `String | `Comment ] 88 | | `Expected of 89 | [ `Comment | `Value | `Name | `Name_sep | `Json | `Eoi 90 | | `Aval of bool (* [true] if first array value *) 91 | | `Omem of bool (* [true] if first object member *) ]] 92 | 93 | (** The type for decoding errors. *) 94 | 95 | val pp_error : Format.formatter -> [< error] -> unit 96 | (** [pp_error e] prints an unspecified UTF-8 representation of [e] on [ppf]. *) 97 | 98 | type encoding = [ `UTF_8 | `UTF_16 | `UTF_16BE | `UTF_16LE ] 99 | (** The type for Unicode encoding schemes. *) 100 | 101 | type src = [ `Channel of in_channel | `String of string | `Manual ] 102 | (** The type for input sources. With a [`Manual] source the client 103 | must provide input with {!Manual.src}. *) 104 | 105 | type decoder 106 | (** The type for JSON decoders. *) 107 | 108 | val decoder :?encoding:[< encoding] -> [< src] -> decoder 109 | (** [decoder encoding src] is a JSON decoder that inputs from [src]. 110 | [encoding] specifies the character encoding of the data. If unspecified 111 | the encoding is guessed as 112 | {{:http://tools.ietf.org/html/rfc4627#section-3}suggested} by 113 | the old RFC4627 standard. *) 114 | 115 | val decode : decoder -> [> `Await | `Lexeme of lexeme | `End | `Error of error ] 116 | (** [decode d] is: 117 | {ul 118 | {- [`Await] if [d] has a [`Manual] source and awaits for more input. 119 | The client must use {!Manual.src} to provide it.} 120 | {- [`Lexeme l] if a lexeme [l] was decoded.} 121 | {- [`End] if the end of input was reached.} 122 | {- [`Error e] if a decoding error occured. If the client is interested 123 | in a best-effort decoding it can still continue to decode 124 | after an error (see {!errorrecovery}) although the resulting sequence 125 | of [`Lexeme]s is undefined and may not be well-formed.}} 126 | 127 | The {!Uncut.pp_decode} function can be used to inspect decode results. 128 | 129 | {b Note.} Repeated invocation always eventually returns [`End], even 130 | in case of errors. *) 131 | 132 | val decoded_range : decoder -> (int * int) * (int * int) 133 | (** [decoded_range d] is the range of characters spanning the last 134 | [`Lexeme] or [`Error] (or [`White] or [`Comment] for an 135 | {!Uncut.decode}) decoded by [d]. The start and end of this 136 | range are each represented by a pair of line and column numbers 137 | respectively one and zero based: 138 | [((start_line, start_col), (end_line, end_col))]. *) 139 | 140 | val decoder_encoding : decoder -> encoding 141 | (** [decoder_encoding d] is [d]'s encoding. 142 | 143 | {b Warning.} If the decoder guesses the encoding, rely on this 144 | value only after the first [`Lexeme] was decoded. *) 145 | 146 | val decoder_src : decoder -> src 147 | (** [decoder_src d] is [d]'s input source. *) 148 | 149 | (** {1:encode Encode} *) 150 | 151 | type dst = [ `Channel of out_channel | `Buffer of Buffer.t | `Manual ] 152 | (** The type for output destinations. With a [`Manual] destination the 153 | client must provide output storage with {!Manual.dst}. *) 154 | 155 | type encoder 156 | (** The type for JSON encoders. *) 157 | 158 | val encoder : ?minify:bool -> [< dst] -> encoder 159 | (** [encoder minify dst] is an encoder that outputs to [dst]. If 160 | [minify] is [true] (default) the output is made as compact as 161 | possible, otherwise the output is indented. If you want better 162 | control on whitespace use [minify = true] and {!Uncut.val-encode}. *) 163 | 164 | val encode : encoder -> [< `Await | `End | `Lexeme of lexeme ] -> 165 | [`Ok | `Partial] 166 | (** [encode e v] is: 167 | {ul 168 | {- [`Partial] iff [e] has a [`Manual] destination and needs more 169 | output storage. The client must use {!Manual.dst} to provide 170 | a new buffer and then call {!val-encode} with [`Await] until [`Ok] 171 | is returned.} 172 | {- [`Ok] when the encoder is ready to encode a new [`Lexeme] 173 | or [`End].}} 174 | For [`Manual] destinations, encoding [`End] always returns [`Partial], 175 | the client should as usual use {!Manual.dst} and continue with [`Await] 176 | until [`Ok] is returned at which point {!Manual.dst_rem} [e] is guaranteed 177 | to be the size of the last provided buffer (i.e. nothing was written). 178 | 179 | {b Raises.} [Invalid_argument] if a non {{!datamodel}well-formed} 180 | sequence of lexemes is encoded or if [`Lexeme] or [`End] is 181 | encoded after a [`Partial] encode. *) 182 | 183 | val encoder_dst : encoder -> dst 184 | (** [encoder_dst e] is [e]'s output destination. *) 185 | 186 | val encoder_minify : encoder -> bool 187 | (** [encoder_minify e] is [true] if [e]'s output is minified. *) 188 | 189 | (** {1:manual Manual sources and destinations} *) 190 | 191 | (** Manual input sources and output destinations. 192 | 193 | {b Warning.} Use only with [`Manual] decoders and encoders. *) 194 | module Manual : sig 195 | 196 | val src : decoder -> Bytes.t -> int -> int -> unit 197 | (** [src d s j l] provides [d] with [l] bytes to read, starting 198 | at [j] in [s]. This byte range is read by calls to {!val-decode} until 199 | [`Await] is returned. To signal the end of input call the function 200 | with [l = 0]. *) 201 | 202 | val dst : encoder -> Bytes.t -> int -> int -> unit 203 | (** [dst e s j l] provides [e] with [l] bytes to write, starting 204 | at [j] in [s]. This byte range is written by calls to {!val-encode} 205 | with [e] until [`Partial] is returned. Use {!dst_rem} to know the 206 | remaining number of non-written free bytes in [s]. *) 207 | 208 | val dst_rem : encoder -> int 209 | (** [dst_rem e] is the remaining number of non-written, free bytes 210 | in the last buffer provided with {!val-dst}. *) 211 | end 212 | 213 | (** {1:uncut Uncut codec} *) 214 | 215 | (** Codec with comments and whitespace. 216 | 217 | The uncut codec also processes whitespace and JavaScript 218 | comments. The latter is non-standard JSON, fail on [`Comment] 219 | decoding if you want to process whitespace but stick to the standard. 220 | 221 | The uncut codec preserves as much of the original input as 222 | possible. Perfect round-trip with [Jsonm] is however impossible for 223 | the following reasons: 224 | {ul 225 | {- Escapes unescaped by the decoder may not be escaped or escaped 226 | differently by the encoder.} 227 | {- The encoder automatically inserts name separator [':'] and 228 | value separators [","]. If you just reencode the sequence of 229 | decodes, whitespace and comments may (harmlessly, but significantly) 230 | commute with these separators.} 231 | {- Internally the encoder uses [U+000A] (['\n']) for newlines.} 232 | {- [`Float] lexemes may be rewritten differently by the encoder.}} 233 | *) 234 | module Uncut : sig 235 | 236 | (** {1:uncutdatamodel Uncut data model} 237 | 238 | The uncut data model is the same as the regular 239 | {{!datamodel}data model}, except that before or after any lexeme 240 | you may decode/encode one or more: 241 | {ul 242 | {- [`White w], representing JSON whitespace [w]. On input 243 | the sequence CR ([U+000D]) and CRLF (<[U+000A], [U+000A]>) 244 | are normalized to [U+000A]. The string [w] must be 245 | a sequence of [U+0020], [U+0009], [U+000A] or [U+000D] 246 | characters ([' '], ['\t'], ['\n'], ['\r']).} 247 | {- [`Comment (`S, c)], representing a JavaScript single line 248 | comment [c]. [c] is the comment's content without the starting 249 | [//] and the ending newline. The string [c] must not contain any newline. 250 | } 251 | {- [`Comment (`M, c)], representing a JavaScript multi-line 252 | comment [c]. [c] is the comment's content without the starting 253 | [/*] and the ending [*/]. The string [c] must not contain the 254 | sequence [*/]. }} 255 | 256 | {b Warning.} {!Uncut.val-encode} does not check the above constraints on 257 | [w] and [c]. *) 258 | 259 | (** {1 Decode} *) 260 | 261 | val decode : decoder -> 262 | [ `Await | `Lexeme of lexeme | `White of string 263 | | `Comment of [ `S | `M ] * string 264 | | `End | `Error of error ] 265 | (** [decode d] is like {!Jsonm.val-decode} but for the 266 | {{!uncutdatamodel}uncut data model}. *) 267 | 268 | val pp_decode : Format.formatter -> 269 | [< `Await | `Lexeme of lexeme | `White of string 270 | | `Comment of [ `S | `M ] * string 271 | | `End | `Error of error ] -> unit 272 | (** [pp_decode ppf v] prints an unspecified representation of [v] 273 | on [ppf]. *) 274 | 275 | (** {1 Encode} *) 276 | 277 | val encode : encoder -> 278 | [< `Await | `Lexeme of lexeme | `White of string 279 | | `Comment of [`S | `M] * string | `End ] -> [`Ok | `Partial] 280 | (** [encode] is like {!Jsonm.val-encode} but for the {{!uncutdatamodel} 281 | uncut data model}. 282 | 283 | {b IMPORTANT.} Never encode [`Comment] for the web, it is 284 | non-standard and breaks interoperability. *) 285 | end 286 | 287 | (** {1:limitations Limitations} 288 | 289 | {2:decoding_limitations Decode} 290 | 291 | Decoders parse valid JSON with the following limitations: 292 | {ul 293 | {- JSON numbers are represented with OCaml [float] values. 294 | This means that it can only represent integers exactly 295 | in the in the interval \[-2{^53};2{^53}\]. This is equivalent 296 | to the contraints JavaScript has.} 297 | {- A superset of JSON numbers is parsed. After having seen a minus 298 | or a digit, including zero, {!Stdlib.float_of_string}, is 299 | used. In particular this parses number with leading zeros, which are 300 | specifically prohibited by the standard.} 301 | {- Strings returned by [`String], [`Name], [`White] and [`Comment] 302 | are limited by {!Sys.max_string_length}. There is no built-in 303 | protection against the fact that the internal OCaml [Buffer.t] 304 | value may raise [Failure] on {!Jsonm.val-decode}. This should 305 | however only be a problem on 32-bits platforms if your 306 | strings are greater than 16Mo.}} 307 | 308 | Position tracking assumes that each decoded Unicode scalar value 309 | has a column width of 1. The same assumption may not be made by 310 | the display program (e.g. for [emacs]' compilation mode you need 311 | to set [compilation-error-screen-columns] to [nil]). 312 | 313 | The newlines LF ([U+000A]), CR ([U+000D]), and CRLF are all normalized 314 | to LF internally. This may have an impact in some corner [`Error] 315 | cases. For example the invalid escape sequence [] in 316 | a string will be reported as being [`Illegal_escape (`Not_esc_uchar 317 | 0x000A)]. 318 | 319 | {2:encoding_limitations Encode} 320 | 321 | Encoders produce valid JSON provided the {e client} ensures that 322 | the following holds. 323 | {ul 324 | {- All the strings given to the encoder must be valid UTF-8 and immutable. 325 | Characters that need to be escaped are automatically escaped by [Jsonm].} 326 | {- [`Float] lexemes must not be, {!Stdlib.nan}, 327 | {!Stdlib.infinity} or {!Stdlib.neg_infinity}. They 328 | are encoded with the format string ["%.16g"], this allows 329 | to roundtrip all the integers that can be precisely represented 330 | in OCaml [float] values, i.e. the integers in the interval 331 | \[-2{^53};2{^53}\]. This is equivalent to the constraints 332 | JavaScript has.} 333 | {- If the {{!Uncut}uncut} codec is used [`White] must be made 334 | of {{!Uncut.uncutdatamodel}JSON whitespace} and [`Comment] 335 | must never be encoded.}} 336 | *) 337 | 338 | (** {1:errorrecovery Error recovery} 339 | 340 | After a decoding error, if best-effort decoding is performed. The following 341 | happens before continuing: 342 | {ul 343 | {- [`Illegal_BOM], the initial 344 | {{:http://unicode.org/glossary/#byte_order_mark}BOM} is skipped.} 345 | {- [`Illegal_bytes], [`Illegal_escape], [`Illegal_string_uchar], a 346 | Unicode 347 | {{:http://unicode.org/glossary/#replacement_character}replacement 348 | character} ([U+FFFD]) is substituted to the illegal sequence.} 349 | {- [`Illegal_literal], [`Illegal_number] the corresponding 350 | [`Lexeme] is skipped.} 351 | {- [`Expected r], input is discarded until a synchronyzing lexeme 352 | that depends on [r] is found.} 353 | {- [`Unclosed], the end of input is reached, further decodes will be 354 | [`End]}} *) 355 | 356 | (** {1:examples Examples} 357 | 358 | {2:filter Trip} 359 | 360 | The result of [trip src dst] has the JSON from [src] written on [dst]. 361 | {[ 362 | let trip ?encoding ?minify 363 | (src : [`Channel of in_channel | `String of string]) 364 | (dst : [`Channel of out_channel | `Buffer of Buffer.t]) 365 | = 366 | let rec loop d e = match Jsonm.decode d with 367 | | `Lexeme _ as v -> ignore (Jsonm.encode e v); loop d e 368 | | `End -> ignore (Jsonm.encode e `End); `Ok 369 | | `Error err -> `Error (Jsonm.decoded_range d, err) 370 | | `Await -> assert false 371 | in 372 | let d = Jsonm.decoder ?encoding src in 373 | let e = Jsonm.encoder ?minify dst in 374 | loop d e 375 | ]} 376 | Using the [`Manual] interface, [trip_fd] does the same but between Unix 377 | file descriptors. 378 | {[ 379 | let trip_fd ?encoding ?minify 380 | (fdi : Unix.file_descr) 381 | (fdo : Unix.file_descr) 382 | = 383 | let rec encode fd s e v = match Jsonm.encode e v with `Ok -> () 384 | | `Partial -> 385 | let rec unix_write fd s j l = 386 | let rec write fd s j l = try Unix.single_write fd s j l with 387 | | Unix.Unix_error (Unix.EINTR, _, _) -> write fd s j l 388 | in 389 | let wc = write fd s j l in 390 | if wc < l then unix_write fd s (j + wc) (l - wc) else () 391 | in 392 | unix_write fd s 0 (Bytes.length s - Jsonm.Manual.dst_rem e); 393 | Jsonm.Manual.dst e s 0 (Bytes.length s); 394 | encode fd s e `Await 395 | in 396 | let rec loop fdi fdo ds es d e = match Jsonm.decode d with 397 | | `Lexeme _ as v -> encode fdo es e v; loop fdi fdo ds es d e 398 | | `End -> encode fdo es e `End; `Ok 399 | | `Error err -> `Error (Jsonm.decoded_range d, err) 400 | | `Await -> 401 | let rec unix_read fd s j l = try Unix.read fd s j l with 402 | | Unix.Unix_error (Unix.EINTR, _, _) -> unix_read fd s j l 403 | in 404 | let rc = unix_read fdi ds 0 (Bytes.length ds) in 405 | Jsonm.Manual.src d ds 0 rc; loop fdi fdo ds es d e 406 | in 407 | let ds = Bytes.create 65536 (* UNIX_BUFFER_SIZE in 4.0.0 *) in 408 | let es = Bytes.create 65536 (* UNIX_BUFFER_SIZE in 4.0.0 *) in 409 | let d = Jsonm.decoder ?encoding `Manual in 410 | let e = Jsonm.encoder ?minify `Manual in 411 | Jsonm.Manual.dst e es 0 (Bytes.length es); 412 | loop fdi fdo ds es d e 413 | ]} 414 | {2:memsel Member selection} 415 | 416 | The result of [memsel names src] is the list of string values of 417 | members of [src] that have their name in [names]. In this example, 418 | decoding errors are silently ignored. 419 | {[ 420 | let memsel ?encoding names 421 | (src : [`Channel of in_channel | `String of string]) 422 | = 423 | let rec loop acc names d = match Jsonm.decode d with 424 | | `Lexeme (`Name n) when List.mem n names -> 425 | begin match Jsonm.decode d with 426 | | `Lexeme (`String s) -> loop (s :: acc) names d 427 | | _ -> loop acc names d 428 | end 429 | | `Lexeme _ | `Error _ -> loop acc names d 430 | | `End -> List.rev acc 431 | | `Await -> assert false 432 | in 433 | loop [] names (Jsonm.decoder ?encoding src) 434 | ]} 435 | 436 | {2:tree Generic JSON representation} 437 | 438 | A generic OCaml representation of JSON text is the following one. 439 | {[ 440 | type json = 441 | [ `Null | `Bool of bool | `Float of float| `String of string 442 | | `A of json list | `O of (string * json) list ] 443 | ]} 444 | The result of [json_of_src src] is the JSON text from [src] in this 445 | representation. The function is tail recursive. 446 | {[ 447 | exception Escape of ((int * int) * (int * int)) * Jsonm.error 448 | 449 | let json_of_src ?encoding 450 | (src : [`Channel of in_channel | `String of string]) 451 | = 452 | let dec d = match Jsonm.decode d with 453 | | `Lexeme l -> l 454 | | `Error e -> raise (Escape (Jsonm.decoded_range d, e)) 455 | | `End | `Await -> assert false 456 | in 457 | let rec value v k d = match v with 458 | | `Os -> obj [] k d | `As -> arr [] k d 459 | | `Null | `Bool _ | `String _ | `Float _ as v -> k v d 460 | | _ -> assert false 461 | and arr vs k d = match dec d with 462 | | `Ae -> k (`A (List.rev vs)) d 463 | | v -> value v (fun v -> arr (v :: vs) k) d 464 | and obj ms k d = match dec d with 465 | | `Oe -> k (`O (List.rev ms)) d 466 | | `Name n -> value (dec d) (fun v -> obj ((n, v) :: ms) k) d 467 | | _ -> assert false 468 | in 469 | let d = Jsonm.decoder ?encoding src in 470 | try `JSON (value (dec d) (fun v _ -> v) d) with 471 | | Escape (r, e) -> `Error (r, e) 472 | ]} 473 | The result of [json_to_dst dst json] has the JSON text [json] written 474 | on [dst]. The function is tail recursive. 475 | {[ 476 | let json_to_dst ~minify 477 | (dst : [`Channel of out_channel | `Buffer of Buffer.t ]) 478 | (json : json) 479 | = 480 | let enc e l = ignore (Jsonm.encode e (`Lexeme l)) in 481 | let rec value v k e = match v with 482 | | `A vs -> arr vs k e 483 | | `O ms -> obj ms k e 484 | | `Null | `Bool _ | `Float _ | `String _ as v -> enc e v; k e 485 | and arr vs k e = enc e `As; arr_vs vs k e 486 | and arr_vs vs k e = match vs with 487 | | v :: vs' -> value v (arr_vs vs' k) e 488 | | [] -> enc e `Ae; k e 489 | and obj ms k e = enc e `Os; obj_ms ms k e 490 | and obj_ms ms k e = match ms with 491 | | (n, v) :: ms -> enc e (`Name n); value v (obj_ms ms k) e 492 | | [] -> enc e `Oe; k e 493 | in 494 | let e = Jsonm.encoder ~minify dst in 495 | let finish e = ignore (Jsonm.encode e `End) in 496 | value json finish e 497 | ]} 498 | *) 499 | 500 | (*--------------------------------------------------------------------------- 501 | Copyright (c) 2012 The jsonm programmers 502 | 503 | Permission to use, copy, modify, and/or distribute this software for any 504 | purpose with or without fee is hereby granted, provided that the above 505 | copyright notice and this permission notice appear in all copies. 506 | 507 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 508 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 509 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 510 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 511 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 512 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 513 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 514 | ---------------------------------------------------------------------------*) 515 | -------------------------------------------------------------------------------- /src/jsonm.mllib: -------------------------------------------------------------------------------- 1 | Jsonm -------------------------------------------------------------------------------- /test/examples.ml: -------------------------------------------------------------------------------- 1 | (* Examples form the documentation (see also jtree.ml), this code is in public 2 | domain. *) 3 | 4 | (* Trip *) 5 | 6 | let trip ?encoding ?minify 7 | (src : [`Channel of in_channel | `String of string]) 8 | (dst : [`Channel of out_channel | `Buffer of Buffer.t]) 9 | = 10 | let rec loop d e = match Jsonm.decode d with 11 | | `Lexeme _ as v -> ignore (Jsonm.encode e v); loop d e 12 | | `End -> ignore (Jsonm.encode e `End); `Ok 13 | | `Error err -> `Error (Jsonm.decoded_range d, err) 14 | | `Await -> assert false 15 | in 16 | let d = Jsonm.decoder ?encoding src in 17 | let e = Jsonm.encoder ?minify dst in 18 | loop d e 19 | 20 | let trip_fd ?encoding ?minify 21 | (fdi : Unix.file_descr) 22 | (fdo : Unix.file_descr) 23 | = 24 | let rec encode fd s e v = match Jsonm.encode e v with `Ok -> () 25 | | `Partial -> 26 | let rec unix_write fd s j l = 27 | let rec write fd s j l = try Unix.single_write fd s j l with 28 | | Unix.Unix_error (Unix.EINTR, _, _) -> write fd s j l 29 | in 30 | let wc = write fd s j l in 31 | if wc < l then unix_write fd s (j + wc) (l - wc) else () 32 | in 33 | unix_write fd s 0 (Bytes.length s - Jsonm.Manual.dst_rem e); 34 | Jsonm.Manual.dst e s 0 (Bytes.length s); 35 | encode fd s e `Await 36 | in 37 | let rec loop fdi fdo ds es d e = match Jsonm.decode d with 38 | | `Lexeme _ as v -> encode fdo es e v; loop fdi fdo ds es d e 39 | | `End -> encode fdo es e `End; `Ok 40 | | `Error err -> `Error (Jsonm.decoded_range d, err) 41 | | `Await -> 42 | let rec unix_read fd s j l = try Unix.read fd s j l with 43 | | Unix.Unix_error (Unix.EINTR, _, _) -> unix_read fd s j l 44 | in 45 | let rc = unix_read fdi ds 0 (Bytes.length ds) in 46 | Jsonm.Manual.src d ds 0 rc; loop fdi fdo ds es d e 47 | in 48 | let ds = Bytes.create 65536 (* UNIX_BUFFER_SIZE in 4.0.0 *) in 49 | let es = Bytes.create 65536 (* UNIX_BUFFER_SIZE in 4.0.0 *) in 50 | let d = Jsonm.decoder ?encoding `Manual in 51 | let e = Jsonm.encoder ?minify `Manual in 52 | Jsonm.Manual.dst e es 0 (Bytes.length es); 53 | loop fdi fdo ds es d e 54 | 55 | (* Member selection *) 56 | 57 | let memsel ?encoding names 58 | (src : [`Channel of in_channel | `String of string]) 59 | = 60 | let rec loop acc names d = match Jsonm.decode d with 61 | | `Lexeme (`Name n) when List.mem n names -> 62 | begin match Jsonm.decode d with 63 | | `Lexeme (`String s) -> loop (s :: acc) names d 64 | | _ -> loop acc names d 65 | end 66 | | `Lexeme _ | `Error _ -> loop acc names d 67 | | `End -> List.rev acc 68 | | `Await -> assert false 69 | in 70 | loop [] names (Jsonm.decoder ?encoding src) 71 | -------------------------------------------------------------------------------- /test/jsontrip.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2012 The jsonm programmers. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | ---------------------------------------------------------------------------*) 5 | 6 | let pr = Format.fprintf 7 | let pr_range ppf ((l0, c0), (l1, c1)) = pr ppf "%d.%d-%d.%d" l0 c0 l1 c1 8 | let pr_decode ppf inf d v = pr ppf "%s:%a: %a@\n@?" 9 | inf pr_range (Jsonm.decoded_range d) Jsonm.Uncut.pp_decode v 10 | 11 | let exec = Filename.basename Sys.executable_name 12 | let log f = Format.eprintf ("%s: " ^^ f ^^ "@?") exec 13 | let log_error inf d e = Format.eprintf "%s:%a: %a@\n@?" 14 | inf pr_range (Jsonm.decoded_range d) Jsonm.pp_error e 15 | 16 | (* IO tools *) 17 | 18 | let io_buffer_size = 65536 (* IO_BUFFER_SIZE 4.0.0 *) 19 | let unix_buffer_size = 65536 (* UNIX_BUFFER_SIZE 4.0.0 *) 20 | 21 | let rec unix_read fd s j l = try Unix.read fd s j l with 22 | | Unix.Unix_error (Unix.EINTR, _, _) -> unix_read fd s j l 23 | 24 | let rec unix_write fd s j l = 25 | let rec write fd s j l = try Unix.single_write fd s j l with 26 | | Unix.Unix_error (Unix.EINTR, _, _) -> write fd s j l 27 | in 28 | let wc = write fd s j l in 29 | if wc < l then unix_write fd s (j + wc) (l - wc) else () 30 | 31 | let string_of_channel use_unix ic = 32 | let b = Buffer.create unix_buffer_size in 33 | let input, s = 34 | if use_unix 35 | then unix_read (Unix.descr_of_in_channel ic), Bytes.create unix_buffer_size 36 | else input ic, Bytes.create io_buffer_size 37 | in 38 | let rec loop b input s = 39 | let rc = input s 0 (Bytes.length s) in 40 | if rc = 0 then Buffer.contents b else 41 | let us = Bytes.unsafe_to_string s in 42 | (Buffer.add_substring b us 0 rc; loop b input s) 43 | in 44 | loop b input s 45 | 46 | let string_to_channel use_unix oc s = match use_unix with 47 | | false -> output_string oc s 48 | | true -> 49 | let s = Bytes.unsafe_of_string s in 50 | unix_write (Unix.descr_of_out_channel oc) s 0 (Bytes.length s) 51 | 52 | let dst_for sout = if sout then `Buffer (Buffer.create 512) else `Channel stdout 53 | let src_for inf sin use_unix = 54 | try 55 | let ic = if inf = "-" then stdin else open_in inf in 56 | if sin then `String (string_of_channel use_unix ic) else `Channel ic 57 | with Sys_error e -> log "%s\n" e; exit 1 58 | 59 | let close_src src = 60 | try match src with `Channel ic when ic <> stdin -> close_in ic | _ -> () with 61 | | Sys_error e -> log "%s\n" e; exit 1 62 | 63 | let src_for_unix inf = 64 | try if inf = "-" then Unix.stdin else Unix.(openfile inf [O_RDONLY] 0) with 65 | | Unix.Unix_error (e, _, v) -> log "%s: %s\n" (Unix.error_message e) v; exit 1 66 | 67 | let close_src_unix fd = try if fd <> Unix.stdin then Unix.close fd with 68 | | Unix.Unix_error (e, _, v) -> log "%s: %s\n" (Unix.error_message e) v; exit 1 69 | 70 | let rec encode_unix encode fd s e v = match encode e v with `Ok -> () 71 | | `Partial -> 72 | unix_write fd s 0 (Bytes.length s - Jsonm.Manual.dst_rem e); 73 | Jsonm.Manual.dst e s 0 (Bytes.length s); 74 | encode_unix encode fd s e `Await 75 | 76 | (* Dump *) 77 | 78 | let dump_ inf encoding uncut src = 79 | let decode = if uncut then Jsonm.Uncut.decode else Jsonm.decode in 80 | let rec loop decode d = match decode d with `Await -> assert false 81 | | v -> pr_decode Format.std_formatter inf d v; if v <> `End then loop decode d 82 | in 83 | loop decode (Jsonm.decoder ?encoding src); 84 | close_src src 85 | 86 | let dump_unix inf encoding uncut usize fd = 87 | let decode = if uncut then Jsonm.Uncut.decode else Jsonm.decode in 88 | let rec loop decode fd s d = match decode d with 89 | | `Await -> 90 | let rc = unix_read fd s 0 (Bytes.length s) in 91 | Jsonm.Manual.src d s 0 rc; loop decode fd s d 92 | | v -> 93 | pr_decode Format.std_formatter inf d v; 94 | if v <> `End then loop decode fd s d 95 | in 96 | loop decode fd (Bytes.create usize) (Jsonm.decoder ?encoding `Manual); 97 | close_src_unix fd 98 | 99 | let dump inf sin use_unix usize ie uncut = 100 | if sin || not use_unix then dump_ inf ie uncut (src_for inf sin use_unix) 101 | else dump_unix inf ie uncut usize (src_for_unix inf) 102 | 103 | (* Guess encoding *) 104 | 105 | let guess inf = 106 | let d = Jsonm.decoder (src_for inf false false) in 107 | ignore (Jsonm.decode d); 108 | Format.printf "%s@." (Uutf.encoding_to_string (Jsonm.decoder_encoding d)) 109 | 110 | (* Decode only *) 111 | 112 | let decode_ inf encoding uncut src = 113 | let decode = if uncut then Jsonm.Uncut.decode else Jsonm.decode in 114 | let rec loop decode d = match decode d with 115 | | `Lexeme _ -> loop decode d 116 | | `End -> () 117 | | `Comment _ | `White _ -> loop decode d 118 | | `Error e -> log_error inf d e; loop decode d 119 | | `Await -> assert false 120 | in 121 | loop decode (Jsonm.decoder ?encoding src) 122 | 123 | let decode_unix inf encoding uncut usize fd = 124 | let decode = if uncut then Jsonm.Uncut.decode else Jsonm.decode in 125 | let rec loop decode fd s d = match decode d with 126 | | `Lexeme _ -> loop decode fd s d 127 | | `End -> () 128 | | `Comment _ | `White _ -> loop decode fd s d 129 | | `Error e -> log_error inf d e; loop decode fd s d 130 | | `Await -> 131 | let rc = unix_read fd s 0 (Bytes.length s) in 132 | Jsonm.Manual.src d s 0 rc; loop decode fd s d 133 | in 134 | loop decode fd (Bytes.create usize) (Jsonm.decoder ?encoding `Manual) 135 | 136 | let decode inf sin use_unix usize ie uncut = 137 | if sin || not use_unix then decode_ inf ie uncut (src_for inf use_unix sin) 138 | else decode_unix inf ie uncut usize Unix.stdin 139 | 140 | (* Random encode only *) 141 | 142 | let r_ascii_letter () = 143 | Uchar.unsafe_of_int (0x0061 (* a *) + Random.int 26) 144 | 145 | let r_general_scripts () = 146 | Uchar.unsafe_of_int (Random.int 0x2000 (* < U+2000 *)) 147 | 148 | let max_rint = 9007199254740993L (* 2 ^ 53 + 1 *) 149 | let r_int () = (* random integer exactly representable by an OCaml float. *) 150 | let i = Random.int64 max_rint in 151 | Int64.to_float (if Random.bool () then Int64.neg i else i) 152 | 153 | let r_float () = (* generate all string notations. *) 154 | let f = if (Random.bool ()) then Random.float 1e-5 else Random.float 1.5e12 in 155 | if (Random.bool ()) then ~-. f else f 156 | 157 | let r_name buf maxs = 158 | Buffer.clear buf; 159 | for i = 0 to Random.int (maxs + 1) 160 | do Uutf.Buffer.add_utf_8 buf (r_ascii_letter ()) done; 161 | `Name (Buffer.contents buf) 162 | 163 | let r_string buf maxs = 164 | Buffer.clear buf; 165 | for i = 0 to Random.int (maxs + 1) 166 | do Uutf.Buffer.add_utf_8 buf (r_general_scripts ()) done; 167 | `String (Buffer.contents buf) 168 | 169 | let r_comment buf = 170 | Buffer.clear buf; 171 | let style = if Random.bool () then `M else `S in 172 | for i = 0 to Random.int 64 do 173 | let c = r_general_scripts () in 174 | let ci = Uchar.to_int c in 175 | (* avoid any // and */ sequence and control chars *) 176 | if ci != 0x002F (* / *) && ci > 0x001F then Uutf.Buffer.add_utf_8 buf c 177 | done; 178 | `Comment (style, Buffer.contents buf) 179 | 180 | let r_white buf = 181 | Buffer.clear buf; 182 | for i = 0 to Random.int 3 do match Random.int 100 with 183 | | n when n < 90 -> Buffer.add_char buf ' ' 184 | | n when n < 94 -> Buffer.add_char buf '\t' 185 | | n when n < 98 -> Buffer.add_char buf '\n' 186 | | n when n < 100 -> Buffer.add_char buf '\r' 187 | | n -> assert false 188 | done; 189 | `White (Buffer.contents buf) 190 | 191 | let rec r_value k enc buf count ri maxd maxl maxs = 192 | let kontinue () = k enc buf (count - 1) ri maxd maxl maxs in 193 | match (if maxd = 0 then Random.int 4 else Random.int 6) with 194 | | 0 -> enc `Null; kontinue () 195 | | 1 -> enc (`Bool (Random.bool ())); kontinue () 196 | | 2 -> enc (`Float (if ri then r_int () else r_float ())); kontinue () 197 | | 3 -> enc (r_string buf maxs); kontinue () 198 | | 4 | 5 -> 199 | let bound = Random.int maxl + 1 in 200 | r_json bound k enc buf (count - 1) ri maxd maxl maxs 201 | | n -> assert false 202 | 203 | and r_obj_ms bound k enc buf count ri maxd maxl maxs = 204 | if count = 0 || bound = 0 205 | then (enc `Oe; k enc buf count ri (maxd + 1) maxl maxs) else 206 | begin 207 | enc (r_name buf maxs); 208 | r_value (r_obj_ms (bound - 1) k) enc buf count ri maxd maxl maxs 209 | end 210 | 211 | and r_arr_vs bound k enc buf count ri maxd maxl maxs = 212 | if count = 0 || bound = 0 213 | then (enc `Ae; k enc buf count ri (maxd + 1) maxl maxs) 214 | else r_value (r_arr_vs (bound - 1) k) enc buf count ri maxd maxl maxs 215 | 216 | and r_json bound k enc buf count ri maxd maxl maxs = 217 | if Random.bool () 218 | then (enc `Os; r_obj_ms bound k enc buf count ri (maxd - 1) maxl maxs) 219 | else (enc `As; r_arr_vs bound k enc buf count ri (maxd - 1) maxl maxs) 220 | 221 | let r_json_text enc buf vcount ri maxd maxl maxs = 222 | let stop _ _ _ _ _ _ _ = enc `End in 223 | let encl l = enc (`Lexeme l) in 224 | r_json max_int stop encl buf (vcount - 1) ri maxd maxl maxs 225 | 226 | let r_uncut enc buf = match Random.int 100 with 227 | | n when n < 50 -> () 228 | | n when n < 90 -> enc (r_white buf) 229 | | n when n < 100 -> enc (r_comment buf) 230 | | n -> assert false 231 | 232 | let encode_f buf uncut minify dst = 233 | let e = Jsonm.encoder ~minify dst in 234 | if not uncut then (fun v -> ignore (Jsonm.encode e v)) else 235 | let enc v = ignore (Jsonm.Uncut.encode e v) in 236 | fun v -> r_uncut enc buf; enc v; r_uncut enc buf 237 | 238 | let encode_f_unix usize buf uncut minify fd = 239 | let e, s = Jsonm.encoder ~minify `Manual, Bytes.create usize in 240 | Jsonm.Manual.dst e s 0 (Bytes.length s); 241 | if not uncut then (fun v -> encode_unix Jsonm.encode fd s e v) else 242 | let enc v = encode_unix Jsonm.Uncut.encode fd s e v in 243 | fun v -> r_uncut enc buf; enc v; r_uncut enc buf 244 | 245 | let r_encode sout use_unix usize uncut indent rseed rcount ri maxd maxl maxs = 246 | let dst = dst_for sout in 247 | let buf = Buffer.create maxs in 248 | let encode_f = 249 | if sout || not use_unix then encode_f buf uncut indent dst else 250 | encode_f_unix usize buf uncut indent Unix.stdout 251 | in 252 | log "Encoding random JSON text with seed %d\n" rseed; 253 | Random.init rseed; r_json_text encode_f buf rcount ri maxd maxl maxs; 254 | match dst with `Channel _ -> () 255 | | `Buffer b -> string_to_channel use_unix stdout (Buffer.contents b) 256 | 257 | (* Trip *) 258 | 259 | let trip_ inf uncut minify encoding src dst = 260 | let decode = if uncut then Jsonm.Uncut.decode else Jsonm.decode in 261 | let rec loop decode d e = match decode d with 262 | | `Lexeme _ as v -> ignore (Jsonm.encode e v); loop decode d e 263 | | `End -> ignore (Jsonm.encode e `End) 264 | | `Comment _ | `White _ as v -> 265 | if not minify then ignore (Jsonm.Uncut.encode e v); loop decode d e 266 | | `Error err -> log_error inf d err 267 | | `Await -> assert false 268 | in 269 | let d = Jsonm.decoder src in 270 | let e = Jsonm.encoder ~minify:(minify || uncut) dst in 271 | loop decode d e; close_src src 272 | 273 | let trip_unix inf usize uncut minify encoding fdi fdo = 274 | let decode = if uncut then Jsonm.Uncut.decode else Jsonm.decode in 275 | let rec loop decode fdi fdo ds es d e = match decode d with 276 | | `Lexeme _ as v -> 277 | encode_unix Jsonm.encode fdo es e v; loop decode fdi fdo ds es d e 278 | | `End -> encode_unix Jsonm.encode fdo es e `End 279 | | `Comment _ | `White _ as v -> 280 | if not minify then ignore (encode_unix Jsonm.Uncut.encode fdo es e v); 281 | loop decode fdi fdo ds es d e 282 | | `Error err -> log_error inf d err 283 | | `Await -> 284 | let rc = unix_read fdi ds 0 (Bytes.length ds) in 285 | Jsonm.Manual.src d ds 0 rc; loop decode fdi fdo ds es d e 286 | in 287 | let d, ds = Jsonm.decoder ?encoding `Manual, Bytes.create usize in 288 | let e, es = Jsonm.encoder ~minify `Manual, Bytes.create usize in 289 | Jsonm.Manual.dst e es 0 (Bytes.length es); 290 | loop decode fdi fdo ds es d e; close_src_unix fdi 291 | 292 | let trip inf sin sout use_unix usize ie uncut minify = 293 | let src = src_for inf use_unix sin in 294 | let dst = dst_for sout in 295 | if sin || sout || not use_unix then trip_ inf uncut minify ie src dst else 296 | trip_unix inf usize uncut minify ie (src_for_unix inf) Unix.stdout; 297 | match dst with `Channel _ -> () 298 | | `Buffer b -> string_to_channel use_unix stdout (Buffer.contents b) 299 | 300 | let main () = 301 | let usage = Printf.sprintf 302 | "Usage: %s [OPTION]... [INFILE]\n\ 303 | \ Recode JSON from stdin to stdout.\n\ 304 | Options:" exec 305 | in 306 | let cmd = ref `Trip in 307 | let set_cmd v () = cmd := v in 308 | let inf = ref "-" in 309 | let set_inf f = 310 | if !inf <> "-" then raise (Arg.Bad "only one file can be specified") else 311 | inf := f 312 | in 313 | let ie = ref None in 314 | let ie_fun e = match Uutf.encoding_of_string e with 315 | | None | Some (`US_ASCII | `ISO_8859_1) -> 316 | log "unsupported input encoding '%s', using UTF-8\n" e 317 | | (Some #Jsonm.encoding) as enc -> ie := enc 318 | in 319 | let uncut = ref false in 320 | let minify = ref true in 321 | let sin = ref false in 322 | let sout = ref false in 323 | let use_unix = ref false in 324 | let usize = ref unix_buffer_size in 325 | let rseed = ref (Random.self_init (); Random.int (1 lsl 30 - 1)) in 326 | let rcount = ref 560_000 in (* params for ~10Mo of JSON. *) 327 | let rint = ref false in 328 | let maxd = ref 5 in 329 | let maxl = ref 20 in 330 | let maxs = ref 15 in 331 | let nat s r v = if v > 0 then r := v else log "%s must be > 0, ignored\n" s in 332 | let options = [ 333 | "-dump", Arg.Unit (set_cmd `Dump), 334 | " Dump lexemes and their position, one per line"; 335 | "-guess", Arg.Unit (set_cmd `Guess), " Only guess the encoding"; 336 | "-dec", Arg.Unit (set_cmd `Decode), " Decode only, no encoding"; 337 | "-enc", Arg.Unit (set_cmd `Encode), " Encode only (random), no decoding"; 338 | "-ie", Arg.String ie_fun, 339 | " Input encoding: UTF-8, UTF-16, UTF-16BE or UTF-16LE"; 340 | "-uncut", Arg.Set uncut, 341 | " Use the uncut codec (allows comments in the input)"; 342 | "-pp", Arg.Clear minify, " Pretty print output (minified by default)"; 343 | "-sin", Arg.Set sin, " Input as string and decode the string"; 344 | "-sout", Arg.Set sout, " Encode as string and output the string"; 345 | "-unix", Arg.Set use_unix, " Use Unix IO"; 346 | "-usize", Arg.Int (nat "-usize" usize), 347 | " Unix IO buffer sizes in bytes"; 348 | "-rseed", Arg.Int (nat "-rseed" rseed), " Random seed"; 349 | "-rcount", Arg.Int (nat "-rcount" rcount), 350 | " Number of JSON values in random JSON text"; 351 | "-rint", Arg.Set rint, " Generate only integer JSON numbers (no floats)"; 352 | "-maxd", Arg.Int (nat "-maxd" maxd), 353 | " Maximal depth in random JSON text"; 354 | "-maxl", Arg.Int (nat "-maxl" maxl), 355 | " Maximal inner array and object length in random JSON"; 356 | "-maxs", Arg.Int (nat "-maxs" maxs), 357 | " Maximal string length in random JSON text"; ] 358 | in 359 | Arg.parse (Arg.align options) set_inf usage; 360 | match !cmd with 361 | | `Dump -> dump !inf !sin !use_unix !usize !ie !uncut 362 | | `Guess -> guess !inf 363 | | `Trip -> trip !inf !sin !sout !use_unix !usize !ie !uncut !minify 364 | | `Decode -> decode !inf !sin !use_unix !usize !ie !uncut 365 | | `Encode -> 366 | r_encode !sout !use_unix !usize !uncut !minify !rseed !rcount 367 | !rint !maxd !maxl !maxs 368 | 369 | let () = main () 370 | 371 | (*--------------------------------------------------------------------------- 372 | Copyright (c) 2012 The jsonm programmers 373 | 374 | Permission to use, copy, modify, and/or distribute this software for any 375 | purpose with or without fee is hereby granted, provided that the above 376 | copyright notice and this permission notice appear in all copies. 377 | 378 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 379 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 380 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 381 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 382 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 383 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 384 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 385 | ---------------------------------------------------------------------------*) 386 | -------------------------------------------------------------------------------- /test/jtree.ml: -------------------------------------------------------------------------------- 1 | (* This code is in the public domain *) 2 | 3 | (* Generic JSON tree type *) 4 | 5 | type json = 6 | [ `Null | `Bool of bool | `Float of float| `String of string 7 | | `A of json list | `O of (string * json) list ] 8 | 9 | exception Escape of ((int * int) * (int * int)) * Jsonm.error 10 | 11 | let json_of_src ?encoding 12 | (src : [`Channel of in_channel | `String of string]) 13 | = 14 | let dec d = match Jsonm.decode d with 15 | | `Lexeme l -> l 16 | | `Error e -> raise (Escape (Jsonm.decoded_range d, e)) 17 | | `End | `Await -> assert false 18 | in 19 | let rec value v k d = match v with 20 | | `Os -> obj [] k d | `As -> arr [] k d 21 | | `Null | `Bool _ | `String _ | `Float _ as v -> k v d 22 | | _ -> assert false 23 | and arr vs k d = match dec d with 24 | | `Ae -> k (`A (List.rev vs)) d 25 | | v -> value v (fun v -> arr (v :: vs) k) d 26 | and obj ms k d = match dec d with 27 | | `Oe -> k (`O (List.rev ms)) d 28 | | `Name n -> value (dec d) (fun v -> obj ((n, v) :: ms) k) d 29 | | _ -> assert false 30 | in 31 | let d = Jsonm.decoder ?encoding src in 32 | try `JSON (value (dec d) (fun v _ -> v) d) with 33 | | Escape (r, e) -> `Error (r, e) 34 | 35 | let json_to_dst ~minify 36 | (dst : [`Channel of out_channel | `Buffer of Buffer.t ]) 37 | (json : json) 38 | = 39 | let enc e l = ignore (Jsonm.encode e (`Lexeme l)) in 40 | let rec value v k e = match v with 41 | | `A vs -> arr vs k e 42 | | `O ms -> obj ms k e 43 | | `Null | `Bool _ | `Float _ | `String _ as v -> enc e v; k e 44 | and arr vs k e = enc e `As; arr_vs vs k e 45 | and arr_vs vs k e = match vs with 46 | | v :: vs' -> value v (arr_vs vs' k) e 47 | | [] -> enc e `Ae; k e 48 | and obj ms k e = enc e `Os; obj_ms ms k e 49 | and obj_ms ms k e = match ms with 50 | | (n, v) :: ms -> enc e (`Name n); value v (obj_ms ms k) e 51 | | [] -> enc e `Oe; k e 52 | in 53 | let e = Jsonm.encoder ~minify dst in 54 | let finish e = ignore (Jsonm.encode e `End) in 55 | value json finish e 56 | 57 | let main () = 58 | let exec = Filename.basename Sys.executable_name in 59 | let usage = Printf.sprintf 60 | "Usage: %s [OPTION]...\n\ 61 | \ Recode JSON from stdin to stdout via an in-memory tree representation.\n\ 62 | Options:" exec 63 | in 64 | let minify = ref true in 65 | let options = [ "-pp", Arg.Clear minify, " Pretty print output"; ] in 66 | let anon _ = raise (Arg.Bad "illegal argument") in 67 | Arg.parse (Arg.align options) anon usage; 68 | let minify = !minify in 69 | match json_of_src (`Channel stdin) with 70 | | `JSON j -> json_to_dst ~minify (`Channel stdout) j 71 | | `Error (((l1, c1), (l2, c2)), e) -> 72 | Format.eprintf "-:%d.%d-%d.%d: %a\n%!" l1 c1 l2 c2 Jsonm.pp_error e 73 | 74 | let () = main () 75 | -------------------------------------------------------------------------------- /test/test.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2012 The jsonm programmers. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | ---------------------------------------------------------------------------*) 5 | 6 | let str = Format.sprintf 7 | let log f = Format.printf (f ^^ "@?") 8 | let fail fmt = 9 | let fail _ = failwith (Format.flush_str_formatter ()) in 10 | Format.kfprintf fail Format.str_formatter fmt 11 | 12 | let encoder_invalid () = 13 | log "Invalid encodes.\n"; 14 | let rec encode_seq e = function 15 | | v :: vs -> ignore (Jsonm.Uncut.encode e v); encode_seq e vs 16 | | [] -> () 17 | in 18 | let seq ~invalid s = 19 | let test ~minify = 20 | let e = Jsonm.encoder ~minify (`Buffer (Buffer.create 256)) in 21 | try encode_seq e s; assert (not invalid) with 22 | | Invalid_argument _ as e -> if invalid then () else raise e 23 | in 24 | test ~minify:true; test ~minify:false 25 | in 26 | seq ~invalid:false [ `Lexeme `Null]; 27 | seq ~invalid:false [ `Lexeme (`Bool true)]; 28 | seq ~invalid:false [ `Lexeme (`Bool false)]; 29 | seq ~invalid:false [ `Lexeme (`Float 1.0)]; 30 | seq ~invalid:false [ `Lexeme (`String "bla")]; 31 | seq ~invalid:true [ `Lexeme `Ae]; 32 | seq ~invalid:true [ `Lexeme `Oe]; 33 | seq ~invalid:true [ `Lexeme (`Name "b")]; 34 | seq ~invalid:true [ `White " "; `Lexeme `Oe]; 35 | seq ~invalid:true [ `Lexeme `Os; `Lexeme `Ae]; 36 | seq ~invalid:true [ `Comment (`S, "bla"); `Lexeme `Os; `Lexeme `Ae]; 37 | seq ~invalid:true [ `Lexeme `Os; `Lexeme `Null]; 38 | seq ~invalid:true [ `Lexeme `Os; `Lexeme (`Name "b"); `Lexeme (`Name "b")]; 39 | seq ~invalid:true [ `Lexeme `Os; `Lexeme (`Name "b"); `Lexeme `Ae]; 40 | seq ~invalid:true [ `Lexeme `Os; `Lexeme (`Name "b"); `Lexeme `Oe]; 41 | seq ~invalid:true [ `Lexeme `Os; `Lexeme (`Name "b"); `Lexeme `Ae]; 42 | seq ~invalid:true [ `Lexeme `Os; `Lexeme (`Name "b"); `Lexeme `Null; 43 | `Lexeme `Null; ]; 44 | seq ~invalid:true [ `Lexeme `Os; `Lexeme (`Name "b"); `Lexeme `Null; 45 | `Lexeme (`Name "c"); `Lexeme `Ae;]; 46 | seq ~invalid:true [ `Lexeme `As; `Lexeme (`Oe) ]; 47 | seq ~invalid:true [ `Lexeme `As; `Lexeme (`Name "b") ]; 48 | seq ~invalid:true [ `Lexeme `As; `Lexeme `Null; `Lexeme (`Name "b"); ]; 49 | seq ~invalid:true [ `Lexeme `As; `Lexeme `Ae; `Lexeme `As]; 50 | seq ~invalid:true [ `Lexeme `As; `Lexeme `Ae; `Lexeme `Null]; 51 | seq ~invalid:true [ `Lexeme `As; `Lexeme `Ae; `End; `Lexeme `As]; 52 | seq ~invalid:true [ `Lexeme `Os; `Lexeme `Oe; `Lexeme `Os]; 53 | seq ~invalid:true [ `Lexeme `Os; `Lexeme `Oe; `Lexeme `Null]; 54 | seq ~invalid:true [ `Lexeme `Os; `Lexeme `Oe; `End; `Lexeme `Os]; 55 | () 56 | 57 | let encoder_escapes () = 58 | log "Encoder escapes.\n"; 59 | let encode ascii sascii = 60 | let b = Buffer.create 10 in 61 | let e = Jsonm.encoder (`Buffer b) in 62 | let enc v = ignore (Jsonm.encode e (`Lexeme v)) in 63 | List.iter enc [ `As; `String (Printf.sprintf "%c" (Char.chr ascii)); `Ae ]; 64 | ignore (Jsonm.encode e `End); 65 | let json = Buffer.contents b in 66 | let exp = str "[\"%s\"]" sascii in 67 | if json <> exp then fail "found: %s exp: %s" json exp 68 | in 69 | encode 0x22 "\\\""; 70 | encode 0x5C "\\\\"; 71 | for i = 0x00 to 0x1F do 72 | if i = 0x0A then encode i "\\n" else 73 | encode i (str "\\u00%02X" i) 74 | done; 75 | () 76 | 77 | let decoder_encoding_guess () = 78 | log "Decoder encoding guesses.\n"; 79 | let test enc s = 80 | let d = Jsonm.decoder (`String s) in 81 | let enc' = (ignore (Jsonm.decode d); Jsonm.decoder_encoding d) in 82 | if enc' <> enc then 83 | fail "found: %s exp: %s" 84 | (Uutf.encoding_to_string enc') (Uutf.encoding_to_string enc) 85 | in 86 | test `UTF_8 "[]"; 87 | test `UTF_8 "{}"; 88 | test `UTF_16BE "\x00\x5B\x00\x5D"; 89 | test `UTF_16BE "\x00\x7B\x00\x7D"; 90 | test `UTF_16LE "\x5B\x00\x5D\x00"; 91 | test `UTF_16LE "\x7B\x00\x7D\x00"; 92 | () 93 | 94 | let test_decode fnd exp = 95 | if fnd <> exp then fail "found: %a expected: %a" 96 | Jsonm.Uncut.pp_decode fnd Jsonm.Uncut.pp_decode exp 97 | 98 | let test_seq decode src seq = 99 | let d = Jsonm.decoder (`String src) in 100 | let rec loop d = function 101 | | [] -> if decode d <> `End then fail "decoder not at the `End"; () 102 | | v :: vs -> test_decode (decode d) v; loop d vs 103 | in 104 | loop d seq 105 | 106 | let arr seq = [`Lexeme `As] @ seq @ [`Lexeme `Ae; `End; `End; `End ] 107 | 108 | let decoder_comments () = 109 | log "Decoder comments.\n"; 110 | let test (s,c) src = test_seq Jsonm.Uncut.decode src (arr [`Comment (s,c)]) in 111 | let test_eoi v src = test_seq Jsonm.Uncut.decode src 112 | [`Lexeme `As; `Lexeme `Ae; v; `End]; 113 | in 114 | test (`M, "bla") "[/*bla*/]"; 115 | test (`M, "b*") "[/*b**/]"; 116 | test (`M, "b** /") "[/*b** /*/]"; 117 | test (`M, "b** /") "[/*b** /*/]"; 118 | test (`M, "b***\n/") "[/*b***\n/*/]"; 119 | test (`S, "abcd") "[//abcd\n]"; 120 | test_eoi (`Comment (`S, "abcd")) "[]//abcd"; 121 | test_eoi (`Comment (`S, "abcd///* ")) "[]//abcd///* "; 122 | test_eoi (`Comment (`M, " abcd ")) "[]/* abcd */"; 123 | test_eoi (`Comment (`M, " abcd ")) "[]/* abcd */"; 124 | test_eoi (`Error (`Unclosed `Comment)) "[]/* abcd "; 125 | test_eoi (`Error (`Expected `Comment)) "[]/"; 126 | () 127 | 128 | let decoder_escapes () = 129 | log "Decoder escapes.\n"; 130 | let test str src = test_seq Jsonm.decode src (arr [`Lexeme (`String str)]) in 131 | let test_ill ill str src = test_seq Jsonm.decode src 132 | (arr [`Error (`Illegal_escape ill); `Lexeme (`String str)]) 133 | in 134 | let not_esc_uchar u = `Not_esc_uchar (Uchar.of_int u) in 135 | let not_hex_uchar u = `Not_hex_uchar (Uchar.of_int u) in 136 | let s s = Printf.sprintf "[\"%s\"]" s in 137 | test "<\">" (s "<\\\">"); 138 | test "<\\>" (s "<\\\\>"); 139 | test "" (s "<\\/>"); 140 | test "<\b>" (s "<\\b>"); 141 | test "<\x0C>" (s "<\\f>"); 142 | test "<\n>" (s "<\\n>"); 143 | test "<\r>" (s "<\\r>"); 144 | test "<\t>" (s "<\\t>"); 145 | test "<\xF0\x9D\x84\x9E><\xE6\xB0\xB4>" (s "<\\uD834\\uDd1E><\\u6C34>"); 146 | test_ill (not_esc_uchar 0x61) "<\xEF\xBF\xBD>" (s "<\\a>"); 147 | test_ill (not_esc_uchar 0x31) "<\xEF\xBF\xBD>" (s "<\\1>"); 148 | test_ill (not_esc_uchar 0xFFFD) "<\xEF\xBF\xBD>" (s "<\\\xEF\xBF\xBD>"); 149 | test_ill (not_hex_uchar 0x47) "<\xEF\xBF\xBDAF1>" (s "<\\uGAF1>"); 150 | test_ill (not_hex_uchar 0x47) "<\xEF\xBF\xBDF1>" (s "<\\uAGF1>"); 151 | test_ill (not_hex_uchar 0x67) "<\xEF\xBF\xBD1>" (s "<\\uAFg1>"); 152 | test_ill (not_hex_uchar 0x67) "<\xEF\xBF\xBD>" (s "<\\uAF1g>"); 153 | test_ill (`Not_lo_surrogate 0x6C34) "<\xEF\xBF\xBD>" (s "<\\uD834\\u6C34>"); 154 | test_ill (`Lone_hi_surrogate 0xD834) "<\xEF\xBF\xBDbla>" (s "<\\uD834bla>"); 155 | test_ill (`Lone_lo_surrogate 0xDD1E) "<\xEF\xBF\xBDbla>" (s "<\\uDd1Ebla>"); 156 | test_ill (`Lone_hi_surrogate 0xD834) "<\xEF\xBF\xBD\nf>" (s "<\\uD834\\nf>"); 157 | () 158 | 159 | let decoder_strings () = 160 | log "Decoder strings.\n"; 161 | test_seq Jsonm.decode "\"\"" [`Lexeme (`String "")]; 162 | test_seq Jsonm.decode "\"heyho\"" [`Lexeme (`String "heyho")]; 163 | test_seq Jsonm.decode "[\"blibla\"]" (arr [ `Lexeme (`String "blibla") ]); 164 | test_seq Jsonm.decode "[\"bli\nbla\"]" 165 | (arr [`Error (`Illegal_string_uchar (Uchar.of_int 0x0A)); 166 | `Lexeme (`String "bli\xEF\xBF\xBDbla"); ]); 167 | test_seq Jsonm.decode "[\"blabla" 168 | [`Lexeme `As; `Error (`Unclosed `Comment); `End; `End]; 169 | () 170 | 171 | let decoder_literals () = 172 | log "Decoder literals.\n"; 173 | test_seq Jsonm.decode "null" [`Lexeme `Null]; 174 | test_seq Jsonm.decode "true" [`Lexeme (`Bool true)]; 175 | test_seq Jsonm.decode "false" [`Lexeme (`Bool false)]; 176 | test_seq Jsonm.decode "[null]" (arr [ `Lexeme `Null]); 177 | test_seq Jsonm.decode "[true]" (arr [ `Lexeme (`Bool true)]); 178 | test_seq Jsonm.decode "[false]" (arr [ `Lexeme (`Bool false)]); 179 | test_seq Jsonm.decode "[truee]" (arr [ `Error (`Illegal_literal "truee")]); 180 | test_seq Jsonm.decode "[tru" 181 | [ `Lexeme `As; `Error (`Illegal_literal "tru"); `Error (`Unclosed `As); 182 | `End; `End; `End ]; 183 | test_seq Jsonm.decode "{\"\" : tru" 184 | [ `Lexeme `Os; `Lexeme (`Name ""); `Error (`Illegal_literal "tru"); 185 | `Error (`Unclosed `Os); `End; `End; `End ]; 186 | () 187 | 188 | let decoder_numbers () = 189 | log "Decoder numbers.\n"; 190 | test_seq Jsonm.decode "1.0" [`Lexeme (`Float 1.0)]; 191 | test_seq Jsonm.decode "-1.0" [`Lexeme (`Float ~-.1.0)]; 192 | test_seq Jsonm.decode "[1.0]" (arr [ `Lexeme (`Float 1.0)]); 193 | test_seq Jsonm.decode "[1e12]" (arr [ `Lexeme (`Float 1e12)]); 194 | test_seq Jsonm.decode "[-1e12]" (arr [ `Lexeme (`Float ~-.1e12)]); 195 | test_seq Jsonm.decode "[-1eee2]" (arr [ `Error (`Illegal_number "-1eee2")]); 196 | test_seq Jsonm.decode "[-1ee2" 197 | [ `Lexeme `As; `Error (`Illegal_number "-1ee2"); `Error (`Unclosed `As); 198 | `End; `End; `End ]; 199 | test_seq Jsonm.decode "{\"\" : -1ee2" 200 | [ `Lexeme `Os; `Lexeme (`Name ""); `Error (`Illegal_number "-1ee2"); 201 | `Error (`Unclosed `Os); `End; `End; `End ]; 202 | () 203 | 204 | let decoder_arrays () = 205 | log "Decoder arrays.\n"; 206 | test_seq Jsonm.decode "[]" (arr []); 207 | test_seq Jsonm.decode "[" 208 | [`Lexeme `As; `Error (`Unclosed `As); `End; `End; `End]; 209 | test_seq Jsonm.decode "[null" 210 | [`Lexeme `As; `Lexeme `Null; `Error (`Unclosed `As); 211 | `End; `End; `End]; 212 | test_seq Jsonm.decode "[null," 213 | [`Lexeme `As; `Lexeme `Null; `Error (`Expected (`Value)); 214 | `Error (`Unclosed `As); `End; `End; `End]; 215 | test_seq Jsonm.decode "[null { null]" 216 | [`Lexeme `As; `Lexeme `Null; `Error (`Expected (`Aval false)); 217 | `Lexeme `Ae; `End; `End; `End]; 218 | test_seq Jsonm.decode "[null { null,null]" 219 | [`Lexeme `As; `Lexeme `Null; `Error (`Expected (`Aval false)); 220 | `Lexeme `Null; `Lexeme `Ae; `End; `End; `End]; 221 | test_seq Jsonm.decode "[; null]" 222 | [`Lexeme `As; `Error (`Expected (`Aval true)); 223 | `Lexeme `Ae; `End; `End; `End]; 224 | test_seq Jsonm.decode "[; , null]" 225 | [`Lexeme `As; `Error (`Expected (`Aval true)); `Lexeme `Null; 226 | `Lexeme `Ae; `End; `End; `End]; 227 | () 228 | 229 | let decoder_objects () = 230 | log "Decoder objects.\n"; 231 | test_seq Jsonm.decode "{" 232 | [`Lexeme `Os; `Error (`Unclosed `Os); `End; `End; `End]; 233 | test_seq Jsonm.decode "{null" 234 | [`Lexeme `Os; `Error (`Expected (`Omem true)); `Error (`Unclosed `Os); 235 | `End; `End; `End]; 236 | test_seq Jsonm.decode "{ \"b\" " 237 | [`Lexeme `Os; `Lexeme (`Name "b"); `Error (`Expected (`Name_sep)); 238 | `Error (`Unclosed `Os); `End; `End; `End]; 239 | test_seq Jsonm.decode "{ \"b\" : ] null]" 240 | [`Lexeme `Os; `Lexeme (`Name "b"); `Error (`Expected (`Value)); 241 | `Error (`Unclosed `Os); `End; `End; `End]; 242 | test_seq Jsonm.decode "{ \"b\" : null" 243 | [`Lexeme `Os; `Lexeme (`Name "b"); `Lexeme `Null; 244 | `Error (`Unclosed `Os); `End; `End; `End]; 245 | test_seq Jsonm.decode "{; null}" 246 | [`Lexeme `Os; `Error (`Expected (`Omem true)); 247 | `Lexeme `Oe; `End; `End; `End]; 248 | test_seq Jsonm.decode "{ ill : null, \"bli\" : null}" 249 | [`Lexeme `Os; `Error (`Expected (`Omem true)); `Lexeme (`Name "bli"); 250 | `Lexeme `Null; `Lexeme `Oe; `End; `End; `End]; 251 | test_seq Jsonm.decode "{ \"bli\" : null ill : null }" 252 | [`Lexeme `Os; `Lexeme (`Name "bli"); 253 | `Lexeme `Null; `Error (`Expected (`Omem false)); 254 | `Lexeme `Oe; `End; `End; `End]; 255 | test_seq Jsonm.decode "{ \"bli\" : null, ill : null }" 256 | [`Lexeme `Os; `Lexeme (`Name "bli"); 257 | `Lexeme `Null; `Error (`Expected `Name); 258 | `Lexeme `Oe; `End; `End; `End]; 259 | () 260 | 261 | let decoder_json_text () = 262 | log "Decoder JSON text.\n"; 263 | test_seq Jsonm.decode "a" [ `Error (`Expected `Json); 264 | `Error (`Expected `Json); `End ]; 265 | test_seq Jsonm.decode "" [ `Error (`Expected `Json); `End ]; 266 | test_seq Jsonm.decode "a : null {}" 267 | [ `Error (`Expected `Json); 268 | `Error (`Expected `Json); 269 | `Lexeme `Null; 270 | `Error (`Expected `Eoi); `End]; 271 | test_seq Jsonm.decode "a : null []" 272 | [ `Error (`Expected `Json); 273 | `Error (`Expected `Json); 274 | `Lexeme `Null; 275 | `Error (`Expected `Eoi); `End]; 276 | () 277 | 278 | let decoder_bom () = 279 | log "Decoder BOM.\n"; 280 | let seq = [`Error `Illegal_BOM; `Lexeme `Os; `Lexeme `Oe; `End] in 281 | test_seq Jsonm.decode "\xEF\xBB\xBF {}" seq; 282 | test_seq Jsonm.decode "\xFE\xFF\x00\x7B\x00\x7D" seq; 283 | test_seq Jsonm.decode "\xFF\xFE\x7B\x00\x7D\x00" seq; 284 | () 285 | 286 | 287 | let decoder_eoi () = 288 | log "Decoder end of input.\n"; 289 | test_seq Jsonm.decode "" [`Error (`Expected `Json) ]; 290 | test_seq Jsonm.decode "{} a : null" 291 | [ `Lexeme `Os; `Lexeme `Oe; `Error (`Expected `Eoi); ]; 292 | test_seq Jsonm.decode "[] a : null " 293 | [ `Lexeme `As; `Lexeme `Ae; `Error (`Expected `Eoi); ]; 294 | () 295 | 296 | let trip () = 297 | log "Codec round-trips.\n"; 298 | let trip s = 299 | let b = Buffer.create (String.length s) in 300 | let d = Jsonm.decoder (`String s) in 301 | let e = Jsonm.encoder (`Buffer b) in 302 | let rec loop d e = match Jsonm.decode d with 303 | | `Lexeme _ as v -> ignore (Jsonm.encode e v); loop d e 304 | | `End as v -> ignore (Jsonm.encode e v) 305 | | `Error e -> fail "err: %a" Jsonm.pp_error e 306 | | `Await -> assert false 307 | in 308 | loop d e; 309 | let trips = Buffer.contents b in 310 | if trips <> s then 311 | fail "fnd: %s@\nexp: %s@\n" trips s 312 | in 313 | trip "null"; 314 | trip "true"; 315 | trip "false"; 316 | trip "2"; 317 | trip "0.5"; 318 | trip "\"heyho\""; 319 | trip "[null,null,0.5,true,false,[true,false]]"; 320 | trip "{\"a\":[1,2,4,5,[true,false]],\"b\":{}}"; 321 | trip "{\"a\":[1,2,4,5,[true,{\"c\":[null]}]],\"b\":{}}"; 322 | trip "{\"a\":[1,2,4,5,[true,{\"c\":[\"\\nbli\",5,6]}]],\"b\":{}}"; 323 | (* Verify that integers that can be represented exactly by an OCaml float 324 | value [-2^53;2^53] do trip. *) 325 | trip "[9007199254740992,-9007199254740992]"; 326 | () 327 | 328 | let test () = 329 | Printexc.record_backtrace true; 330 | encoder_invalid (); 331 | encoder_escapes (); 332 | decoder_encoding_guess (); 333 | decoder_escapes (); 334 | decoder_comments (); 335 | decoder_literals (); 336 | decoder_numbers (); 337 | decoder_arrays (); 338 | decoder_objects (); 339 | decoder_json_text (); 340 | decoder_bom (); 341 | decoder_eoi (); 342 | trip (); 343 | log "All tests succeeded.\n" 344 | 345 | let () = if not (!Sys.interactive) then test () 346 | 347 | (*--------------------------------------------------------------------------- 348 | Copyright (c) 2012 The jsonm programmers 349 | 350 | Permission to use, copy, modify, and/or distribute this software for any 351 | purpose with or without fee is hereby granted, provided that the above 352 | copyright notice and this permission notice appear in all copies. 353 | 354 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 355 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 356 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 357 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 358 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 359 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 360 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 361 | ---------------------------------------------------------------------------*) 362 | --------------------------------------------------------------------------------