ocaml-json: collapse stringy/primed API splits per spec · gazagnaire.org/ocaml-json@e5aed6e

+5 -5

bench/bench.ml

··· 34 34 members / array elements are skipped (parsed for structure, not 35 35 built into a value). *) 36 36 let field_codec name = 37 - let open Json in 37 + let open Json.Codec in 38 38 match name with 39 39 | "github_events.json" | "numbers.json" -> 40 40 (* root array: each element ignored; map to unit for uniform type. *) ··· 62 62 (match decode content with 63 63 | Ok _ -> () 64 64 | Error e -> 65 - Fmt.epr "decode error: %s\n%!" e; 65 + Fmt.epr "decode error: %a\n%!" Json.Error.pp e; 66 66 exit 2); 67 67 Gc.compact (); 68 68 let times = ref [] in ··· 79 79 (match r with 80 80 | Ok _ -> () 81 81 | Error e -> 82 - Fmt.epr "decode error: %s\n%!" e; 82 + Fmt.epr "decode error: %a\n%!" Json.Error.pp e; 83 83 exit 2); 84 84 times := (t1 -. t0) :: !times; 85 85 let lw = (Gc.stat ()).Gc.live_words in ··· 114 114 let content = read_file path in 115 115 let size_bytes = String.length content in 116 116 let size_mb = float_of_int size_bytes /. 1_048_576.0 in 117 - let dom_decode s = Json_bytesrw.decode_string Json.json s in 117 + let dom_decode s = Json_bytesrw.of_string Json.Codec.Value.t s in 118 118 let field_decode = 119 119 let codec = field_codec name in 120 - fun s -> Json_bytesrw.decode_string codec s 120 + fun s -> Json_bytesrw.of_string codec s 121 121 in 122 122 let dom = run_mode ~content ~decode:dom_decode in 123 123 let fld = run_mode ~content ~decode:field_decode in

+22 -20

fuzz/fuzz_json.ml

··· 5 5 6 6 (** Fuzz tests for JSON parsing. 7 7 8 - Key properties tested: 1. Parser crash safety: [Json.ignore] and [Json.json] 9 - must not raise uncaught exceptions on arbitrary byte strings. 2. Skip-parse 10 - implication: if [Json.json] accepts the input, then [Json.ignore] must also 11 - accept it (the converse does not hold -- [Json.ignore] is documented to be 12 - more permissive at content level). 3. Roundtrip: [decode . encode = id] on 13 - accepted inputs. *) 8 + Key properties tested: 1. Parser crash safety: [Json.Codec.ignore] and 9 + [Json.Codec.Value.t] must not raise uncaught exceptions on arbitrary byte 10 + strings. 2. Skip-parse implication: if [Json.Codec.Value.t] accepts the 11 + input, then [Json.Codec.ignore] must also accept it (the converse does not 12 + hold -- [Json.Codec.ignore] is documented to be more permissive at content 13 + level). 3. Roundtrip: [decode . encode = id] on accepted inputs. *) 14 14 15 15 open Alcobar 16 16 17 17 let truncate ?(max_len = 16384) buf = 18 18 if String.length buf > max_len then String.sub buf 0 max_len else buf 19 19 20 - (** [Json.ignore] - must not crash on arbitrary input. *) 20 + (** [Json.Codec.ignore] - must not crash on arbitrary input. *) 21 21 let test_ignore_crash buf = 22 22 let buf = truncate buf in 23 - match Json_bytesrw.decode_string Json.ignore buf with Ok _ | Error _ -> () 23 + match Json_bytesrw.of_string Json.Codec.ignore buf with Ok _ | Error _ -> () 24 24 25 - (** [Json.json] - must not crash on arbitrary input. *) 25 + (** [Json.Codec.Value.t] - must not crash on arbitrary input. *) 26 26 let test_json_crash buf = 27 27 let buf = truncate buf in 28 - match Json_bytesrw.decode_string Json.json buf with Ok _ | Error _ -> () 28 + match Json_bytesrw.of_string Json.Codec.Value.t buf with 29 + | Ok _ | Error _ -> () 29 30 30 - (** Skip-parse implication: if [Json.json] accepts, [Json.ignore] must accept. 31 - *) 31 + (** Skip-parse implication: if [Json.Codec.Value.t] accepts, [Json.Codec.ignore] 32 + must accept. *) 32 33 let test_skip_implication buf = 33 34 let buf = truncate buf in 34 - match Json_bytesrw.decode_string Json.json buf with 35 + match Json_bytesrw.of_string Json.Codec.Value.t buf with 35 36 | Error _ -> () 36 37 | Ok _ -> ( 37 - match Json_bytesrw.decode_string Json.ignore buf with 38 + match Json_bytesrw.of_string Json.Codec.ignore buf with 38 39 | Ok () -> () 39 40 | Error e -> 40 - failf "Json.json accepted but Json.ignore rejected %S: %s" buf e) 41 + failf 42 + "Json.Codec.Value.t accepted but Json.Codec.ignore rejected %S: %a" 43 + buf Json.Error.pp e) 41 44 42 45 (** Roundtrip: decode valid input, re-encode, decode again, and check the result 43 46 matches. *) 44 47 let test_roundtrip buf = 45 48 let buf = truncate ~max_len:4096 buf in 46 - match Json_bytesrw.decode_string Json.json buf with 49 + match Json_bytesrw.of_string Json.Codec.Value.t buf with 47 50 | Error _ -> () 48 51 | Ok v -> ( 49 - match Json_bytesrw.encode_string Json.json v with 52 + match Json_bytesrw.to_string Json.Codec.Value.t v with 50 53 | Error _ -> () 51 54 | Ok s -> ( 52 - match Json_bytesrw.decode_string Json.json s with 55 + match Json_bytesrw.of_string Json.Codec.Value.t s with 53 56 | Error e -> failf "roundtrip: re-decode failed on %S: %s" s e 54 57 | Ok v' -> 55 - if not (Json.Value.equal v v') then 56 - failf "roundtrip: value changed")) 58 + if not (Json.equal v v') then failf "roundtrip: value changed")) 57 59 58 60 let suite = 59 61 ( "json",

+69 -73

lib/bytesrw/json_bytesrw.ml

··· 23 23 let[@inline] is_digit u = 0x0030 (* 0 *) <= u && u <= 0x0039 (* 9 *) 24 24 let[@inline] is_number_start u = is_digit u || u = 0x002D (* - *) 25 25 let[@inline] is_surrogate u = 0xD800 <= u && u <= 0xDFFF 26 - let[@inline] is_hi_surrogate u = 0xD800 <= u && u <= 0xDBFF 26 + let[@inline] _is_hi_surrogate u = 0xD800 <= u && u <= 0xDBFF 27 27 let[@inline] is_lo_surrogate u = 0xDC00 <= u && u <= 0xDFFF 28 28 29 29 let[@inline] is_control u = ··· 108 108 mutable i : Stdlib.Bytes.t; (* Current input slice. *) 109 109 mutable i_max : int; (* Maximum byte index in [i]. *) 110 110 mutable i_next : int; (* Next byte index to read in [i]. *) 111 - mutable overlap : Stdlib.Bytes.t; (* Buffer for overlapping decodes. *) 111 + overlap : Stdlib.Bytes.t; (* Buffer for overlapping decodes. *) 112 112 mutable u : int; (* Current Unicode scalar value or sot or eot. *) 113 113 mutable byte_count : int; (* Global byte count. *) 114 114 mutable line : int; (* Current line number. *) ··· 431 431 let false_uchars = [| 0x0066; 0x0061; 0x006C; 0x0073; 0x0065 |] 432 432 let true_uchars = [| 0x0074; 0x0072; 0x0075; 0x0065 |] 433 433 let null_uchars = [| 0x006E; 0x0075; 0x006C; 0x006C |] 434 - let ascii_str us = String.init (Stdlib.Array.length us) (fun i -> Char.chr us.(i)) 434 + 435 + let ascii_str us = 436 + String.init (Stdlib.Array.length us) (fun i -> 437 + Char.chr (Stdlib.Array.get us i)) 435 438 436 439 let[@inline] is_ws u = 437 440 if u > 0x20 then false ··· 449 452 let ws_before = ws_pop d in 450 453 let first_byte = last_byte_of d in 451 454 let first_line_num = d.line and first_line_byte = d.line_start in 452 - for i = 1 to Array.length const - 1 do 455 + for i = 1 to Stdlib.Array.length const - 1 do 453 456 nextc d; 454 - if not (Int.equal d.u const.(i)) then 455 - err_exp_in_const ~first_byte ~first_line_num ~first_line_byte d 456 - ~exp:const.(i) ~fnd:d.u ~const:(ascii_str const) 457 + let c = Stdlib.Array.get const i in 458 + if not (Int.equal d.u c) then 459 + err_exp_in_const ~first_byte ~first_line_num ~first_line_byte d ~exp:c 460 + ~fnd:d.u ~const:(ascii_str const) 457 461 done; 458 462 let textloc = 459 463 textloc_to_current d ~first_byte ~first_line_num ~first_line_byte ··· 482 486 | u when is_digit u -> 483 487 accept d; 484 488 read_digits d 485 - | u -> err_exp_digit d 489 + | _ -> err_exp_digit d 486 490 in 487 491 let[@inline] read_opt_frac d = 488 492 match d.u with ··· 537 541 | u when 0x0061 <= u && u <= 0x0066 -> 538 542 nextc d; 539 543 read_uescape d hi ((uc * 16) + u - 0x57) (count - 1) 540 - | u -> err_exp_hex_digit d 544 + | _ -> err_exp_hex_digit d 541 545 else 542 546 match hi with 543 547 | Some hi -> ··· 591 595 err_unclosed_string ~first_byte ~first_line_num ~first_line_byte d 592 596 | u when 0x0000 <= u && u <= 0x001F -> 593 597 err_illegal_ctrl_char ~first_byte ~first_line_num ~first_line_byte d 594 - | u -> 598 + | _ -> 595 599 accept d; 596 600 loop d 597 601 in ··· 646 650 is enforced; content (escape correctness, exact hex digits after 647 651 [\u]) is NOT validated. Consumers needing strict content 648 652 validation should decode with [Json.json] and then discard rather 649 - than [Json.ignore]. *) 653 + than [Json.Codec.ignore]. *) 650 654 let done_ = ref false in 651 655 while not !done_ do 652 656 if d.i_next > d.i_max then ··· 806 810 let first_byte = last_byte_of d in 807 811 let first_line_num = d.line and first_line_byte = d.line_start in 808 812 try 809 - if map.dec_skip !i !b then decode d Json.ignore 813 + if map.dec_skip !i !b then decode d Json.Codec.ignore 810 814 else b := map.dec_add !i (decode d map.elt) !b 811 815 with Json.Error e -> 812 816 let imeta = ··· 889 893 fun d map mem_miss mem_decs delay dict -> 890 894 let rec loop d map mem_miss mem_decs rem_delay dict = function 891 895 | [] -> (mem_miss, rem_delay, dict) 892 - | ((((name, meta) as nm), v) as mem) :: delay -> ( 896 + | ((((name, _meta) as nm), v) as mem) :: delay -> ( 893 897 match String_map.find_opt name mem_decs with 894 898 | None -> loop d map mem_miss mem_decs (mem :: rem_delay) dict delay 895 899 | Some (Mem_dec m) -> ··· 897 901 try 898 902 let t = m.type' in 899 903 let v = 900 - match Json.Value.decode' t v with 904 + match Json.decode t v with 901 905 | Ok v -> v 902 906 | Error e -> raise_notrace (Json.Error e) 903 907 in ··· 920 924 Dict.t -> 921 925 Dict.t = 922 926 fun d map umems mem_miss mem_decs delay dict -> 923 - let u n _ _ = assert false in 927 + let u _ _ _ = assert false in 924 928 let mem_miss = String_map.union u mem_miss map.mem_decs in 925 929 let mem_decs = String_map.union u mem_decs map.mem_decs in 926 930 match map.shape with ··· 952 956 try 953 957 let t = umap.mems_type in 954 958 let v = 955 - match Json.Value.decode' t v with 959 + match Json.decode t v with 956 960 | Ok v -> v 957 961 | Error e -> raise_notrace (Json.Error e) 958 962 in ··· 1003 1007 (* The name is never read, so we don't need to allocate it. *) 1004 1008 token_clear d; 1005 1009 let () = 1006 - try decode d Json.ignore 1010 + try decode d Json.Codec.ignore 1007 1011 with Json.Error e -> 1008 1012 Json.Codec.error_push_object (error_meta d) map 1009 1013 (token_pop d, meta) ··· 1026 1030 decode_object_basic d map u umap mem_miss mem_decs dict) 1027 1031 end 1028 1032 | u when u = eot -> err_unclosed_object d map 1029 - | fnd -> err_exp_mem_or_eoo d 1033 + | _ -> err_exp_mem_or_eoo d 1030 1034 1031 1035 and decode_object_case : type o cases tag. 1032 1036 decoder -> ··· 1090 1094 (* Because JSON can be out of order we don't know how to decode 1091 1095 this yet. Generic decode *) 1092 1096 let v = 1093 - try decode d Json.codec 1097 + try decode d Json.Codec.Value.t 1094 1098 with Json.Error e -> 1095 1099 Json.Codec.error_push_object (error_meta d) map (name, meta) e 1096 1100 in ··· 1099 1103 decode_object_case d map umems cases mem_miss mem_decs delay dict 1100 1104 end 1101 1105 | u when u = eot -> err_unclosed_object d map 1102 - | fnd -> err_exp_mem_or_eoo d 1106 + | _ -> err_exp_mem_or_eoo d 1103 1107 1104 1108 and decode_any : type a. decoder -> a t -> a any_map -> a = 1105 1109 fun d t map -> ··· 1115 1119 | u when is_number_start u -> case d t map.dec_number 1116 1120 | _ -> err_not_json_value d 1117 1121 1118 - let decode' ?layout ?locs ?file t reader = 1119 - try 1120 - let d = decoder ?layout ?locs ?file reader in 1121 - let v = 1122 - nextc d; 1123 - decode d t 1124 - in 1125 - if d.u <> eot then err_exp_eot d else Ok v 1122 + let of_reader_exn ?layout ?locs ?file t reader = 1123 + let d = decoder ?layout ?locs ?file reader in 1124 + let v = 1125 + nextc d; 1126 + decode d t 1127 + in 1128 + if d.u <> eot then err_exp_eot d else v 1129 + 1130 + let of_reader ?layout ?locs ?file t reader = 1131 + try Ok (of_reader_exn ?layout ?locs ?file t reader) 1126 1132 with Json.Error e -> Error e 1127 1133 1128 - let decode ?layout ?locs ?file t reader = 1129 - Result.map_error Json.Error.to_string (decode' ?layout ?locs ?file t reader) 1130 - 1131 - let decode_string' ?layout ?locs ?file t s = 1132 - decode' ?layout ?locs ?file t (Bytes.Reader.of_string s) 1134 + let of_string_exn ?layout ?locs ?file t s = 1135 + of_reader_exn ?layout ?locs ?file t (Bytes.Reader.of_string s) 1133 1136 1134 - let decode_string ?layout ?locs ?file t s = 1135 - decode ?layout ?locs ?file t (Bytes.Reader.of_string s) 1137 + let of_string ?layout ?locs ?file t s = 1138 + of_reader ?layout ?locs ?file t (Bytes.Reader.of_string s) 1136 1139 1137 1140 (* Encoding *) 1138 1141 ··· 1189 1192 let write_sep e = write_char e ',' 1190 1193 1191 1194 let write_indent e ~nest = 1192 - for i = 1 to nest do 1195 + for _i = 1 to nest do 1193 1196 write_char e ' '; 1194 1197 write_char e ' ' 1195 1198 done ··· 1244 1247 write_bytes e "\\u"; 1245 1248 write_bytes e (Fmt.str "%04X" (Char.code c)); 1246 1249 loop next next max 1247 - | c -> loop start next max 1250 + | _ -> loop start next max 1248 1251 in 1249 1252 write_char e '"'; 1250 1253 loop 0 0 (len - 1); ··· 1366 1369 write_indent e ~nest); 1367 1370 write_char e ']' 1368 1371 1369 - and encode_object : type o enc. 1372 + and encode_object : type o. 1370 1373 nest:int -> (o, o) Json.Codec.object_map -> encoder -> o -> unit = 1371 1374 fun ~nest map e o -> 1372 1375 match e.format with 1373 1376 | Json.Minify -> 1374 1377 write_char e '{'; 1375 - ignore 1376 - @@ encode_object_map ~nest:(nest + 1) map ~do_unknown:true e ~start:true o; 1378 + Stdlib.ignore 1379 + (encode_object_map ~nest:(nest + 1) map ~do_unknown:true e ~start:true o); 1377 1380 write_char e '}' 1378 1381 | Json.Layout -> 1379 1382 let meta = map.enc_meta o in 1380 1383 write_ws_before e meta; 1381 1384 write_char e '{'; 1382 - ignore 1383 - @@ encode_object_map ~nest:(nest + 1) map ~do_unknown:true e ~start:true o; 1385 + Stdlib.ignore 1386 + (encode_object_map ~nest:(nest + 1) map ~do_unknown:true e ~start:true o); 1384 1387 write_char e '}'; 1385 1388 write_ws_after e meta 1386 1389 | Json.Indent -> ··· 1393 1396 write_indent e ~nest); 1394 1397 write_char e '}' 1395 1398 1396 - and encode_object_map : type o enc. 1399 + and encode_object_map : type o. 1397 1400 nest:int -> 1398 1401 (o, o) Json.Codec.object_map -> 1399 1402 do_unknown:bool -> ··· 1449 1452 encode_unknown_mems ~nest map umap e ~start (enc o) 1450 1453 | _ -> encode_object_map ~nest case.object_map ~do_unknown e ~start c) 1451 1454 1452 - and encode_unknown_mems : type o dec mems a builder. 1455 + and encode_unknown_mems : type o mems a builder. 1453 1456 nest:int -> 1454 1457 (o, o) object_map -> 1455 1458 (mems, a, builder) mems_map -> ··· 1470 1473 in 1471 1474 umap.enc (encode_unknown_mem ~nest map umap e) mems start 1472 1475 1473 - let encode' ?buf ?format ?number_format t v ~eod w = 1476 + let to_writer_exn ?buf ?format ?number_format t v ~eod w = 1474 1477 let e = encoder ?buf ?format ?number_format w in 1475 - let t = t in 1476 - try 1477 - Ok 1478 - (encode ~nest:0 t e v; 1479 - write_eot ~eod e) 1478 + encode ~nest:0 t e v; 1479 + write_eot ~eod e 1480 + 1481 + let to_writer ?buf ?format ?number_format t v ~eod w = 1482 + try Ok (to_writer_exn ?buf ?format ?number_format t v ~eod w) 1480 1483 with Json.Error e -> Error e 1481 1484 1482 - let encode ?buf ?format ?number_format t v ~eod w = 1483 - Result.map_error Json.Error.to_string 1484 - @@ encode' ?buf ?format ?number_format ~eod t v w 1485 - 1486 - let encode_string' ?buf ?format ?number_format t v = 1485 + let to_string_exn ?buf ?format ?number_format t v = 1487 1486 let b = Buffer.create 255 in 1488 1487 let w = Bytes.Writer.of_buffer b in 1489 - match encode' ?buf ?format ?number_format ~eod:true t v w with 1490 - | Ok () -> Ok (Buffer.contents b) 1491 - | Error _ as e -> e 1488 + to_writer_exn ?buf ?format ?number_format ~eod:true t v w; 1489 + Buffer.contents b 1492 1490 1493 - let encode_string ?buf ?format ?number_format t v = 1494 - Result.map_error Json.Error.to_string 1495 - @@ encode_string' ?buf ?format ?number_format t v 1491 + let to_string ?buf ?format ?number_format t v = 1492 + try Ok (to_string_exn ?buf ?format ?number_format t v) 1493 + with Json.Error e -> Error e 1496 1494 1497 1495 (* Recode *) 1498 1496 ··· 1502 1500 | None, (Some Json.Layout as l) -> (Some true, l) 1503 1501 | l, f -> (l, f) 1504 1502 1505 - let recode' ?layout ?locs ?file ?buf ?format ?number_format t r w ~eod = 1503 + let recode_exn ?layout ?locs ?file ?buf ?format ?number_format t r w ~eod = 1506 1504 let layout, format = unsurprising_defaults layout format in 1507 - match decode' ?layout ?locs ?file t r with 1508 - | Error _ as e -> e 1509 - | Ok v -> encode' ?buf ?format ?number_format t v ~eod w 1505 + let v = of_reader_exn ?layout ?locs ?file t r in 1506 + to_writer_exn ?buf ?format ?number_format t v ~eod w 1510 1507 1511 1508 let recode ?layout ?locs ?file ?buf ?format ?number_format t r w ~eod = 1512 - Result.map_error Json.Error.to_string 1513 - @@ recode' ?layout ?locs ?file ?buf ?format ?number_format t r w ~eod 1509 + try Ok (recode_exn ?layout ?locs ?file ?buf ?format ?number_format t r w ~eod) 1510 + with Json.Error e -> Error e 1514 1511 1515 - let recode_string' ?layout ?locs ?file ?buf ?format ?number_format t s = 1512 + let recode_string_exn ?layout ?locs ?file ?buf ?format ?number_format t s = 1516 1513 let layout, format = unsurprising_defaults layout format in 1517 - match decode_string' ?layout ?locs ?file t s with 1518 - | Error _ as e -> e 1519 - | Ok v -> encode_string' ?buf ?format ?number_format t v 1514 + let v = of_string_exn ?layout ?locs ?file t s in 1515 + to_string_exn ?buf ?format ?number_format t v 1520 1516 1521 1517 let recode_string ?layout ?locs ?file ?buf ?format ?number_format t s = 1522 - Result.map_error Json.Error.to_string 1523 - @@ recode_string' ?layout ?locs ?file ?buf ?format ?number_format t s 1518 + try Ok (recode_string_exn ?layout ?locs ?file ?buf ?format ?number_format t s) 1519 + with Json.Error e -> Error e

+41 -43

lib/bytesrw/json_bytesrw.mli

··· 11 11 {{!duplicate}duplicate members}. 12 12 13 13 {b Tip.} For maximal performance decode with [~layout:false] and 14 - [~locs:false], this is the default. Howver using [~locs:true] improves some 14 + [~locs:false], this is the default. However using [~locs:true] improves some 15 15 error reports. *) 16 16 17 17 open Bytesrw 18 18 19 19 (** {1:decode Decode} *) 20 20 21 - val decode : 21 + val of_reader : 22 22 ?layout:bool -> 23 23 ?locs:bool -> 24 24 ?file:Loc.fpath -> 25 25 'a Json.codec -> 26 26 Bytes.Reader.t -> 27 - ('a, string) result 28 - (** [decode t r] decodes a value from [r] according to [t]. 27 + ('a, Json.Error.t) result 28 + (** [of_reader t r] decodes a value from [r] according to [t]. 29 29 - If [layout] is [true] whitespace is preserved in {!Json.Meta.t} values. 30 30 Defaults to [false]. 31 31 - If [locs] is [true] locations are preserved in {!Json.Meta.t} values and ··· 33 33 - [file] is the file path from which [r] is assumed to read. Defaults to 34 34 {!Loc.file_none}. *) 35 35 36 - val decode' : 36 + val of_reader_exn : 37 37 ?layout:bool -> 38 38 ?locs:bool -> 39 39 ?file:Loc.fpath -> 40 40 'a Json.codec -> 41 41 Bytes.Reader.t -> 42 - ('a, Json.Error.t) result 43 - (** [decode'] is like {!val-decode} but preserves the error structure. *) 44 - 45 - val decode_string : 46 - ?layout:bool -> 47 - ?locs:bool -> 48 - ?file:Loc.fpath -> 49 - 'a Json.codec -> 50 - string -> 51 - ('a, string) result 52 - (** [decode_string] is like {!val-decode} but decodes directly from a string. *) 42 + 'a 43 + (** [of_reader_exn] is like {!val-of_reader} but raises {!Json.exception-Error}. 44 + *) 53 45 54 - val decode_string' : 46 + val of_string : 55 47 ?layout:bool -> 56 48 ?locs:bool -> 57 49 ?file:Loc.fpath -> 58 50 'a Json.codec -> 59 51 string -> 60 52 ('a, Json.Error.t) result 61 - (** [decode_string'] is like {!val-decode'} but decodes directly from a string. 53 + (** [of_string] is like {!val-of_reader} but decodes directly from a string. *) 54 + 55 + val of_string_exn : 56 + ?layout:bool -> ?locs:bool -> ?file:Loc.fpath -> 'a Json.codec -> string -> 'a 57 + (** [of_string_exn] is like {!val-of_string} but raises {!Json.exception-Error}. 62 58 *) 63 59 64 60 (** {1:encode Encode} *) 65 61 66 - val encode : 62 + val to_writer : 67 63 ?buf:Bytes.t -> 68 64 ?format:Json.format -> 69 65 ?number_format:Json.number_format -> ··· 71 67 'a -> 72 68 eod:bool -> 73 69 Bytes.Writer.t -> 74 - (unit, string) result 75 - (** [encode t v ~eod w] encodes value [v] according to [t] on [w]. 70 + (unit, Json.Error.t) result 71 + (** [to_writer t v ~eod w] encodes value [v] according to [t] on [w]. 76 72 - If [buf] is specified it is used as a buffer for the slices written on 77 73 [w]. Defaults to a buffer of length {!Bytes.Writer.slice_length}[ w]. 78 74 - [format] specifies how the JSON should be formatted. Defaults to ··· 82 78 - [eod] indicates whether {!Bytesrw.Bytes.Slice.eod} should be written on 83 79 [w]. *) 84 80 85 - val encode' : 81 + val to_writer_exn : 86 82 ?buf:Bytes.t -> 87 83 ?format:Json.format -> 88 84 ?number_format:Json.number_format -> ··· 90 86 'a -> 91 87 eod:bool -> 92 88 Bytes.Writer.t -> 93 - (unit, Json.Error.t) result 94 - (** [encode'] is like {!val-encode} but preserves the error structure. *) 89 + unit 90 + (** [to_writer_exn] is like {!val-to_writer} but raises {!Json.exception-Error}. 91 + *) 95 92 96 - val encode_string : 93 + val to_string : 97 94 ?buf:Bytes.t -> 98 95 ?format:Json.format -> 99 96 ?number_format:Json.number_format -> 100 97 'a Json.codec -> 101 98 'a -> 102 - (string, string) result 103 - (** [encode_string] is like {!val-encode} but writes to a string. *) 99 + (string, Json.Error.t) result 100 + (** [to_string] is like {!val-to_writer} but writes to a string. *) 104 101 105 - val encode_string' : 102 + val to_string_exn : 106 103 ?buf:Bytes.t -> 107 104 ?format:Json.format -> 108 105 ?number_format:Json.number_format -> 109 106 'a Json.codec -> 110 107 'a -> 111 - (string, Json.Error.t) result 112 - (** [encode_string'] is like {!val-encode'} but writes to a string. *) 108 + string 109 + (** [to_string_exn] is like {!val-to_string} but raises {!Json.exception-Error}. 110 + *) 113 111 114 112 (** {1:recode Recode} 115 113 116 - The defaults in these functions are those of {!val-decode} and 117 - {!val-encode}, except if [layout] is [true], [format] defaults to 114 + The defaults in these functions are those of {!val-of_reader} and 115 + {!val-to_writer}, except if [layout] is [true], [format] defaults to 118 116 [Json.Layout] and vice-versa. *) 119 117 120 118 val recode : ··· 128 126 Bytes.Reader.t -> 129 127 Bytes.Writer.t -> 130 128 eod:bool -> 131 - (unit, string) result 132 - (** [recode] is {!val-decode} followed by {!val-recode}. *) 129 + (unit, Json.Error.t) result 130 + (** [recode] is {!val-of_reader} followed by {!val-to_writer}. *) 133 131 134 - val recode' : 132 + val recode_exn : 135 133 ?layout:bool -> 136 134 ?locs:bool -> 137 135 ?file:Loc.fpath -> ··· 142 140 Bytes.Reader.t -> 143 141 Bytes.Writer.t -> 144 142 eod:bool -> 145 - (unit, Json.Error.t) result 146 - (** [recode'] is like {!val-recode} but preserves the error structure. *) 143 + unit 144 + (** [recode_exn] is like {!val-recode} but raises {!Json.exception-Error}. *) 147 145 148 146 val recode_string : 149 147 ?layout:bool -> ··· 154 152 ?number_format:Json.number_format -> 155 153 'a Json.codec -> 156 154 string -> 157 - (string, string) result 158 - (** [recode_string] is {!decode_string} followed by {!encode_string}. *) 155 + (string, Json.Error.t) result 156 + (** [recode_string] is {!of_string} followed by {!to_string}. *) 159 157 160 - val recode_string' : 158 + val recode_string_exn : 161 159 ?layout:bool -> 162 160 ?locs:bool -> 163 161 ?file:Loc.fpath -> ··· 166 164 ?number_format:Json.number_format -> 167 165 'a Json.codec -> 168 166 string -> 169 - (string, Json.Error.t) result 170 - (** [recode_string'] is like {!val-recode_string} but preserves the error 171 - structure. *) 167 + string 168 + (** [recode_string_exn] is like {!val-recode_string} but raises 169 + {!Json.exception-Error}. *) 172 170 173 171 (** {1:layout Layout preservation} 174 172

+163 -183

lib/json.ml

··· 5 5 6 6 module Fmt = Core.Fmt 7 7 8 - let pp_kind = Fmt.code 9 8 let pp_int ppf i = Fmt.code ppf (Int.to_string i) 10 9 11 10 module Meta = Loc.Meta ··· 102 101 103 102 module Codec = struct 104 103 include Codec 104 + 105 + (* Keep an alias to the internal [Value] module so we can still reach 106 + [Value.meta] / [Value.sort] etc. after defining a [Value] submodule of 107 + AST-preserving codecs (which shadows the library-level [Value]). *) 108 + module Ast = Value 105 109 106 110 let enc_meta_none _v = Meta.none 107 111 ··· 443 447 | None -> 444 448 let kind = Sort.kinded ~kind String in 445 449 let pp_kind ppf () = Fmt.pf ppf "%a value" pp_code kind in 446 - Error.msgf meta "%a" (Fmt.out_of_dom ~pp_kind ()) (s, List.map fst assoc) 450 + Error.msgf meta "%a" 451 + (Fmt.out_of_dom ~pp_kind ()) 452 + (s, List.map fst assoc) 447 453 in 448 454 let enc v = 449 455 match enc_map v with 450 456 | Some s -> s 451 - | None -> Error.msgf Meta.none "Encode %a: unknown enum value" pp_code kind 457 + | None -> 458 + Error.msgf Meta.none "Encode %a: unknown enum value" pp_code kind 452 459 in 453 460 Base.string (Base.map ~kind ?doc ~dec ~enc ()) 454 461 ··· 1004 1011 let t, array, mems, object' = 1005 1012 let rec elt = Rec any 1006 1013 and array_map = 1007 - lazy 1008 - begin 1009 - let dec_empty () = [] in 1010 - let dec_add _i v a = v :: a in 1011 - let dec_finish meta _len a = Value.list ~meta (List.rev a) in 1012 - let enc f acc = function 1013 - | (Value.Array (a, _) : Value.t) -> Array.list_enc f acc a 1014 - | j -> 1015 - Error.sort (Value.meta j) ~exp:Sort.Array 1016 - ~fnd:(Value.sort j) 1017 - in 1018 - let enc = { Array.enc } in 1019 - Array.map ~dec_empty ~dec_add ~dec_finish ~enc ~enc_meta:Value.meta 1020 - elt 1021 - end 1014 + lazy begin 1015 + let dec_empty () = [] in 1016 + let dec_add _i v a = v :: a in 1017 + let dec_finish meta _len a = Value.list ~meta (List.rev a) in 1018 + let enc f acc = function 1019 + | (Value.Array (a, _) : Value.t) -> Array.list_enc f acc a 1020 + | j -> Error.sort (Value.meta j) ~exp:Sort.Array ~fnd:(Value.sort j) 1021 + in 1022 + let enc = { Array.enc } in 1023 + Array.map ~dec_empty ~dec_add ~dec_finish ~enc ~enc_meta:Value.meta 1024 + elt 1025 + end 1022 1026 and array = lazy (Array.array (Lazy.force array_map)) 1023 1027 and mems = 1024 - lazy 1025 - begin 1026 - let dec_empty () = [] in 1027 - let dec_add meta n v mems = ((n, meta), v) :: mems in 1028 - let dec_finish _meta mems = List.rev mems in 1029 - let enc f l a = 1030 - List.fold_left (fun a ((n, m), v) -> f m n v a) a l 1031 - in 1032 - let enc = { Object.Mems.enc } in 1033 - Object.Mems.map ~dec_empty ~dec_add ~dec_finish ~enc elt 1034 - end 1028 + lazy begin 1029 + let dec_empty () = [] in 1030 + let dec_add meta n v mems = ((n, meta), v) :: mems in 1031 + let dec_finish _meta mems = List.rev mems in 1032 + let enc f l a = List.fold_left (fun a ((n, m), v) -> f m n v a) a l in 1033 + let enc = { Object.Mems.enc } in 1034 + Object.Mems.map ~dec_empty ~dec_add ~dec_finish ~enc elt 1035 + end 1035 1036 and object' = 1036 - lazy 1037 - begin 1038 - let enc_meta = function 1039 - | (Value.Object (_, meta) : Value.t) -> meta 1040 - | j -> 1041 - Error.sort (Value.meta j) ~exp:Sort.Object 1042 - ~fnd:(Value.sort j) 1043 - in 1044 - let enc = function 1045 - | (Value.Object (mems, _) : Value.t) -> mems 1046 - | j -> 1047 - Error.sort (Value.meta j) ~exp:Sort.Object 1048 - ~fnd:(Value.sort j) 1049 - in 1050 - let dec meta mems : Value.t = Value.Object (mems, meta) in 1051 - Object.map' dec ~enc_meta 1052 - |> Object.keep_unknown (Lazy.force mems) ~enc 1053 - |> Object.finish 1054 - end 1037 + lazy begin 1038 + let enc_meta = function 1039 + | (Value.Object (_, meta) : Value.t) -> meta 1040 + | j -> 1041 + Error.sort (Value.meta j) ~exp:Sort.Object ~fnd:(Value.sort j) 1042 + in 1043 + let enc = function 1044 + | (Value.Object (mems, _) : Value.t) -> mems 1045 + | j -> 1046 + Error.sort (Value.meta j) ~exp:Sort.Object ~fnd:(Value.sort j) 1047 + in 1048 + let dec meta mems : Value.t = Value.Object (mems, meta) in 1049 + Object.map' dec ~enc_meta 1050 + |> Object.keep_unknown (Lazy.force mems) ~enc 1051 + |> Object.finish 1052 + end 1055 1053 and any = 1056 - lazy 1057 - begin 1058 - let value_array = Lazy.force array in 1059 - let value_object = Lazy.force object' in 1060 - let enc (v : Value.t) = 1061 - match v with 1062 - | Value.Null _ -> null 1063 - | Value.Bool _ -> bool 1064 - | Value.Number _ -> number 1065 - | Value.String _ -> string 1066 - | Value.Array _ -> value_array 1067 - | Value.Object _ -> value_object 1068 - in 1069 - Any 1070 - { 1071 - kind = "json"; 1072 - doc = ""; 1073 - dec_null = Some null; 1074 - dec_bool = Some bool; 1075 - dec_number = Some number; 1076 - dec_string = Some string; 1077 - dec_array = Some value_array; 1078 - dec_object = Some value_object; 1079 - enc; 1080 - } 1081 - end 1054 + lazy begin 1055 + let value_array = Lazy.force array in 1056 + let value_object = Lazy.force object' in 1057 + let enc (v : Value.t) = 1058 + match v with 1059 + | Value.Null _ -> null 1060 + | Value.Bool _ -> bool 1061 + | Value.Number _ -> number 1062 + | Value.String _ -> string 1063 + | Value.Array _ -> value_array 1064 + | Value.Object _ -> value_object 1065 + in 1066 + Any 1067 + { 1068 + kind = "json"; 1069 + doc = ""; 1070 + dec_null = Some null; 1071 + dec_bool = Some bool; 1072 + dec_number = Some number; 1073 + dec_string = Some string; 1074 + dec_array = Some value_array; 1075 + dec_object = Some value_object; 1076 + enc; 1077 + } 1078 + end 1082 1079 in 1083 1080 (Lazy.force any, Lazy.force array, Lazy.force mems, Lazy.force object') 1084 1081 ··· 1094 1091 match j with 1095 1092 | (Value.Object (ms, _) : Value.t) -> 1096 1093 List.fold_left (fun acc ((n, m), v) -> f m n v acc) acc ms 1097 - | j -> 1098 - Error.sort (Value.meta j) ~exp:Sort.Object ~fnd:(Value.sort j) 1094 + | j -> Error.sort (Value.meta j) ~exp:Sort.Object ~fnd:(Value.sort j) 1099 1095 in 1100 1096 let enc = { Object.Mems.enc } in 1101 1097 Object.Mems.map ~dec_empty ~dec_add ~dec_finish ~enc t ··· 1104 1100 (* Decode / encode between generic JSON and typed values using a codec. 1105 1101 [decode_exn] / [encode_exn] raise [Error]; thin wrappers return results. *) 1106 1102 1107 - let error_sort ~exp j = 1108 - Error.sort (Value.meta j) ~exp ~fnd:(Value.sort j) 1103 + let error_sort ~exp j = Error.sort (Ast.meta j) ~exp ~fnd:(Ast.sort j) 1109 1104 1110 1105 let error_type t fnd = 1111 - Error.kinded_sort (Value.meta fnd) ~exp:(kinded_sort t) 1112 - ~fnd:(Value.sort fnd) 1106 + Error.kinded_sort (Ast.meta fnd) ~exp:(kinded_sort t) ~fnd:(Ast.sort fnd) 1113 1107 1114 1108 let find_all_unexpected ~mem_decs mems = 1115 1109 let unexpected (((n, _) as nm), _v) = ··· 1119 1113 in 1120 1114 List.filter_map unexpected mems 1121 1115 1122 - let rec decode_exn : type a. a t -> Value.t -> a = 1116 + let rec decode_exn : type a. a t -> Ast.t -> a = 1123 1117 fun t j -> 1124 1118 match t with 1125 1119 | Null map -> ( 1126 - match (j : Value.t) with 1127 - | Value.Null (n, meta) -> map.dec meta n 1120 + match (j : Ast.t) with 1121 + | Ast.Null (n, meta) -> map.dec meta n 1128 1122 | j -> error_type t j) 1129 1123 | Bool map -> ( 1130 - match (j : Value.t) with 1131 - | Value.Bool (b, meta) -> map.dec meta b 1124 + match (j : Ast.t) with 1125 + | Ast.Bool (b, meta) -> map.dec meta b 1132 1126 | j -> error_type t j) 1133 1127 | Number map -> ( 1134 - match (j : Value.t) with 1135 - | Value.Number (n, meta) -> map.dec meta n 1136 - | Value.Null (_, meta) -> map.dec meta Float.nan 1128 + match (j : Ast.t) with 1129 + | Ast.Number (n, meta) -> map.dec meta n 1130 + | Ast.Null (_, meta) -> map.dec meta Float.nan 1137 1131 | j -> error_type t j) 1138 1132 | String map -> ( 1139 - match (j : Value.t) with 1140 - | Value.String (s, meta) -> map.dec meta s 1133 + match (j : Ast.t) with 1134 + | Ast.String (s, meta) -> map.dec meta s 1141 1135 | j -> error_type t j) 1142 1136 | Array map -> ( 1143 - match (j : Value.t) with 1144 - | Value.Array (vs, meta) -> decode_array map meta vs 1137 + match (j : Ast.t) with 1138 + | Ast.Array (vs, meta) -> decode_array map meta vs 1145 1139 | j -> error_type t j) 1146 1140 | Object map -> ( 1147 - match (j : Value.t) with 1148 - | Value.Object (mems, meta) -> decode_object map meta mems 1141 + match (j : Ast.t) with 1142 + | Ast.Object (mems, meta) -> decode_object map meta mems 1149 1143 | j -> error_type t j) 1150 1144 | Map map -> map.dec (decode_exn map.dom j) 1151 1145 | Any map -> decode_any t map j ··· 1153 1147 | Ignore -> () 1154 1148 1155 1149 and decode_array : type a elt b. 1156 - (a, elt, b) array_map -> Meta.t -> Value.t list -> a = 1150 + (a, elt, b) array_map -> Meta.t -> Ast.t list -> a = 1157 1151 fun map meta vs -> 1158 1152 let rec next (map : (a, elt, b) array_map) meta b i = function 1159 1153 | [] -> map.dec_finish meta i b ··· 1162 1156 try 1163 1157 if map.dec_skip i b then b 1164 1158 else map.dec_add i (decode_exn map.elt v) b 1165 - with Error e -> 1166 - error_push_array meta map (i, Value.get_meta v) e 1159 + with Error e -> error_push_array meta map (i, Ast.get_meta v) e 1167 1160 in 1168 1161 next map meta b (i + 1) vs 1169 1162 in 1170 1163 next map meta (map.dec_empty ()) 0 vs 1171 1164 1172 - and decode_object : type o. 1173 - (o, o) object_map -> Meta.t -> Value.object' -> o = 1165 + and decode_object : type o. (o, o) object_map -> Meta.t -> Ast.object' -> o = 1174 1166 fun map meta mems -> 1175 1167 let dict = Dict.empty in 1176 1168 let umems = Unknown_mems None in ··· 1185 1177 mem_dec String_map.t -> 1186 1178 mem_dec String_map.t -> 1187 1179 Dict.t -> 1188 - Value.object' -> 1180 + Ast.object' -> 1189 1181 Dict.t = 1190 1182 fun map meta umems mem_miss mem_decs dict mems -> 1191 1183 let u _ _ _ = assert false in ··· 1217 1209 mem_dec String_map.t -> 1218 1210 mem_dec String_map.t -> 1219 1211 Dict.t -> 1220 - Value.object' -> 1212 + Ast.object' -> 1221 1213 Dict.t = 1222 1214 fun map meta umems umap mem_miss mem_decs dict -> function 1223 1215 | [] -> finish_object_decode map meta umems umap mem_miss dict ··· 1254 1246 mem_dec String_map.t -> 1255 1247 mem_dec String_map.t -> 1256 1248 Dict.t -> 1257 - Value.object' -> 1258 - Value.object' -> 1249 + Ast.object' -> 1250 + Ast.object' -> 1259 1251 Dict.t = 1260 1252 fun map meta umems cases mem_miss mem_decs dict delay mems -> 1261 1253 let decode_case_tag map meta tag delay mems = ··· 1302 1294 decode_object_cases map meta umems cases mem_miss mem_decs dict 1303 1295 delay mems) 1304 1296 1305 - and decode_any : type a. a t -> a any_map -> Value.t -> a = 1297 + and decode_any : type a. a t -> a any_map -> Ast.t -> a = 1306 1298 fun t map j -> 1307 1299 let dec t map j = 1308 1300 match map with Some t -> decode_exn t j | None -> error_type t j 1309 1301 in 1310 - match (j : Value.t) with 1311 - | Value.Null _ -> dec t map.dec_null j 1312 - | Value.Bool _ -> dec t map.dec_bool j 1313 - | Value.Number _ -> dec t map.dec_number j 1314 - | Value.String _ -> dec t map.dec_string j 1315 - | Value.Array _ -> dec t map.dec_array j 1316 - | Value.Object _ -> dec t map.dec_object j 1302 + match (j : Ast.t) with 1303 + | Ast.Null _ -> dec t map.dec_null j 1304 + | Ast.Bool _ -> dec t map.dec_bool j 1305 + | Ast.Number _ -> dec t map.dec_number j 1306 + | Ast.String _ -> dec t map.dec_string j 1307 + | Ast.Array _ -> dec t map.dec_array j 1308 + | Ast.Object _ -> dec t map.dec_object j 1317 1309 1318 - let decode' t j = try Ok (decode_exn t j) with Error e -> Result.Error e 1319 - let decode t j = Result.map_error Error.to_string (decode' t j) 1310 + let decode t j = try Ok (decode_exn t j) with Error e -> Result.Error e 1320 1311 1321 1312 (* Encode *) 1322 1313 1323 - let rec encode_exn : type a. a t -> a -> Value.t = 1314 + let rec encode_exn : type a. a t -> a -> Ast.t = 1324 1315 fun t v -> 1325 1316 match t with 1326 - | Null map -> Value.null ~meta:(map.enc_meta v) (map.enc v) 1327 - | Bool map -> Value.bool ~meta:(map.enc_meta v) (map.enc v) 1328 - | Number map -> Value.number ~meta:(map.enc_meta v) (map.enc v) 1329 - | String map -> Value.string ~meta:(map.enc_meta v) (map.enc v) 1317 + | Null map -> Ast.null ~meta:(map.enc_meta v) (map.enc v) 1318 + | Bool map -> Ast.bool ~meta:(map.enc_meta v) (map.enc v) 1319 + | Number map -> Ast.number ~meta:(map.enc_meta v) (map.enc v) 1320 + | String map -> Ast.string ~meta:(map.enc_meta v) (map.enc v) 1330 1321 | Array map -> 1331 1322 let enc map acc i elt = 1332 1323 try encode_exn map.elt elt :: acc 1333 1324 with Error e -> error_push_array Meta.none map (i, Meta.none) e 1334 1325 in 1335 - Value.list ~meta:(map.enc_meta v) (List.rev (map.enc (enc map) [] v)) 1326 + Ast.list ~meta:(map.enc_meta v) (List.rev (map.enc (enc map) [] v)) 1336 1327 | Object map -> 1337 1328 let mems = encode_object map ~do_unknown:true v [] in 1338 - Value.Object (List.rev mems, map.enc_meta v) 1329 + Ast.Object (List.rev mems, map.enc_meta v) 1339 1330 | Any map -> encode_exn (map.enc v) v 1340 1331 | Map map -> encode_exn map.dom (map.enc v) 1341 1332 | Rec t -> encode_exn (Lazy.force t) v 1342 1333 | Ignore -> Error.no_encoder Meta.none ~kind:"ignore" 1343 1334 1344 1335 and encode_object : type o. 1345 - (o, o) object_map -> 1346 - do_unknown:bool -> 1347 - o -> 1348 - Value.object' -> 1349 - Value.object' = 1336 + (o, o) object_map -> do_unknown:bool -> o -> Ast.object' -> Ast.object' = 1350 1337 fun map ~do_unknown o obj -> 1351 1338 let encode_mem map obj (Mem_enc mmap) = 1352 1339 try ··· 1379 1366 (o, o) object_map -> 1380 1367 (mems, a, builder) mems_map -> 1381 1368 mems -> 1382 - Value.object' -> 1383 - Value.object' = 1369 + Ast.object' -> 1370 + Ast.object' = 1384 1371 fun map umap mems obj -> 1385 1372 let encode_mem map meta name v obj = 1386 1373 let n = (name, meta) in ··· 1392 1379 in 1393 1380 umap.enc (encode_mem map) mems obj 1394 1381 1395 - let encode' t v = try Ok (encode_exn t v) with Error e -> Result.Error e 1396 - let encode t v = Result.map_error Error.to_string (encode' t v) 1382 + let encode t v = try Ok (encode_exn t v) with Error e -> Result.Error e 1383 + 1384 + (* Recode: decode then encode (on values). The [recode] combinator above 1385 + takes labelled [~dec]/[~enc] args; these operate on values. *) 1397 1386 1398 - (* Recode: decode then encode. [update_exn] raises [Error]. *) 1387 + let value_recode_exn t v = encode_exn t (decode_exn t v) 1399 1388 1400 - let update_exn t v = encode_exn t (decode_exn t v) 1401 - let recode' t v = try Ok (update_exn t v) with Error e -> Result.Error e 1402 - let recode t v = Result.map_error Error.to_string (recode' t v) 1403 - let update_of_t t v = update_exn t v 1389 + let value_recode t v = 1390 + try Ok (value_recode_exn t v) with Error e -> Result.Error e 1404 1391 1405 1392 (* Queries and updates *) 1406 1393 ··· 1419 1406 ~dec_object:m ~enc () 1420 1407 1421 1408 let update t = 1422 - let dec v = update_exn t v in 1409 + let dec v = value_recode_exn t v in 1423 1410 Map { kind = ""; doc = ""; dom = Value.t; dec; enc = Fun.id } 1424 1411 1425 1412 (* Array queries *) ··· 1444 1431 Array.array (Array.map ~dec_empty ~dec_skip ~dec_add ~dec_finish ~enc t) 1445 1432 1446 1433 let update_nth ?stub ?absent n t = 1447 - let update_elt n t v = Value.copy_layout v ~dst:(update_exn t v) in 1434 + let update_elt _n t v = Ast.copy_layout v ~dst:(value_recode_exn t v) in 1448 1435 let rec update_array ~seen n t i acc = function 1449 1436 | v :: vs when i = n -> 1450 - let elt = update_elt (i, Value.meta v) t v in 1437 + let elt = update_elt (i, Ast.meta v) t v in 1451 1438 update_array ~seen:true n t (i + 1) (elt :: acc) vs 1452 1439 | v :: vs -> update_array ~seen n t (i + 1) (v :: acc) vs 1453 1440 | [] when seen -> Either.Right (List.rev acc) 1454 1441 | [] -> Either.Left (acc, i) 1455 1442 in 1456 1443 let do_update ?stub ?absent n t j = 1457 - match (j : Value.t) with 1458 - | Value.Array (vs, meta) -> begin 1459 - match update_array ~seen:false n t 0 [] vs with 1460 - | Either.Right elts -> (Value.Array (elts, meta) : Value.t) 1444 + match (j : Ast.t) with 1445 + | Ast.Array (vs, meta) -> 1446 + begin match update_array ~seen:false n t 0 [] vs with 1447 + | Either.Right elts -> (Ast.Array (elts, meta) : Ast.t) 1461 1448 | Either.Left (acc, len) -> ( 1462 1449 match absent with 1463 1450 | None -> Error.index_out_of_range meta ~n ~len 1464 1451 | Some absent -> 1465 1452 let elt = encode_exn t absent in 1466 1453 let stub = 1467 - match stub with None -> Value.zero elt | Some j -> j 1454 + match stub with None -> Ast.zero elt | Some j -> j 1468 1455 in 1469 - Value.Array 1456 + Ast.Array 1470 1457 (List.rev (elt :: list_repeat (n - len) stub acc), meta)) 1471 - end 1458 + end 1472 1459 | j -> error_sort ~exp:Sort.Array j 1473 1460 in 1474 1461 let dec = do_update ?stub ?absent n t in ··· 1483 1470 let dec_empty () = [] in 1484 1471 let dec_add i v a = if i = n then a else v :: a in 1485 1472 let dec_finish meta len a = 1486 - if n < len || allow_absent then Value.list ~meta (List.rev a) 1473 + if n < len || allow_absent then Ast.list ~meta (List.rev a) 1487 1474 else Error.index_out_of_range meta ~n ~len 1488 1475 in 1489 1476 let enc f acc = function 1490 - | (Value.Array (a, _) : Value.t) -> Array.list_enc f acc a 1477 + | (Ast.Array (a, _) : Ast.t) -> Array.list_enc f acc a 1491 1478 | j -> error_sort ~exp:Sort.Array j 1492 1479 in 1493 - let enc_meta j = Value.meta j in 1480 + let enc_meta j = Ast.meta j in 1494 1481 let enc = { Array.enc } in 1495 1482 Array.array 1496 1483 (Array.map ~dec_empty ~dec_add ~dec_finish ~enc ~enc_meta Value.t) ··· 1502 1489 | None -> acc 1503 1490 | Some v' -> encode_exn b v' :: acc 1504 1491 in 1505 - let dec_finish meta _len acc = Value.list ~meta (List.rev acc) in 1492 + let dec_finish meta _len acc = Ast.list ~meta (List.rev acc) in 1506 1493 let enc f acc = function 1507 - | (Value.Array (a, _) : Value.t) -> Array.list_enc f acc a 1494 + | (Ast.Array (a, _) : Ast.t) -> Array.list_enc f acc a 1508 1495 | j -> error_sort ~exp:Sort.Array j 1509 1496 in 1510 1497 let enc = { Array.enc } in 1511 - let enc_meta j = Value.meta j in 1498 + let enc_meta j = Ast.meta j in 1512 1499 Array.array 1513 1500 (Array.map ~dec_empty ~dec_add ~dec_finish ~enc ~enc_meta Value.t) 1514 1501 ··· 1528 1515 |> Object.finish 1529 1516 1530 1517 let update_mem ?absent name t = 1531 - let update_mem n t v = (n, Value.copy_layout v ~dst:(update_exn t v)) in 1518 + let update_mem n t v = (n, Ast.copy_layout v ~dst:(value_recode_exn t v)) in 1532 1519 let rec update_object ~seen name t acc = function 1533 1520 | (((name', _) as n), v) :: mems when String.equal name name' -> 1534 1521 update_object ~seen:true name t (update_mem n t v :: acc) mems ··· 1537 1524 | [] -> Either.Left acc 1538 1525 in 1539 1526 let do_update ?absent name t = function 1540 - | (Value.Object (mems, meta) : Value.t) -> 1527 + | (Ast.Object (mems, meta) : Ast.t) -> 1541 1528 let mems = 1542 1529 match update_object ~seen:false name t [] mems with 1543 1530 | Either.Right mems -> mems 1544 1531 | Either.Left acc -> ( 1545 1532 match absent with 1546 1533 | None -> 1547 - let fnd = Value.object_names mems in 1534 + let fnd = Ast.object_names mems in 1548 1535 Error.missing_mems meta ~kinded_sort:"" ~exp:[ name ] ~fnd 1549 1536 | Some absent -> 1550 1537 let m = ((name, Meta.none), encode_exn t absent) in 1551 1538 List.rev (m :: acc)) 1552 1539 in 1553 - (Value.Object (mems, meta) : Value.t) 1540 + (Ast.Object (mems, meta) : Ast.t) 1554 1541 | j -> error_sort ~exp:Sort.Object j 1555 1542 in 1556 1543 let dec = do_update ?absent name t in ··· 1571 1558 Object.Mems.map ~dec_empty ~dec_add ~dec_finish ~enc Value.t 1572 1559 in 1573 1560 let enc_meta = function 1574 - | (Value.Object (_, meta) : Value.t) -> meta 1561 + | (Ast.Object (_, meta) : Ast.t) -> meta 1575 1562 | j -> error_sort ~exp:Sort.Object j 1576 1563 in 1577 1564 let enc = function 1578 - | (Value.Object (mems, _) : Value.t) -> (false, mems) 1565 + | (Ast.Object (mems, _) : Ast.t) -> (false, mems) 1579 1566 | j -> error_sort ~exp:Sort.Object j 1580 1567 in 1581 - let dec meta (ok, mems) : Value.t = 1582 - let fnd = Value.object_names mems in 1568 + let dec meta (ok, mems) : Ast.t = 1569 + let fnd = Ast.object_names mems in 1583 1570 if not ok then Error.missing_mems meta ~kinded_sort:"" ~exp:[ name ] ~fnd 1584 - else Value.Object (List.rev mems, meta) 1571 + else Ast.Object (List.rev mems, meta) 1585 1572 in 1586 - Object.map' dec ~enc_meta 1587 - |> Object.keep_unknown mems ~enc 1588 - |> Object.finish 1573 + Object.map' dec ~enc_meta |> Object.keep_unknown mems ~enc |> Object.finish 1589 1574 1590 1575 let delete_mem ?(allow_absent = false) name = 1591 1576 let dec_add meta n v (ok, mems) = 1592 1577 if n = name then (true, mems) else (ok, ((n, meta), v) :: mems) 1593 1578 in 1594 - let dec_finish _meta ((ok, ms) as a) = 1579 + let dec_finish _meta ((_ok, ms) as a) = 1595 1580 if allow_absent then (true, ms) else a 1596 1581 in 1597 1582 update_value_object ~name ~dec_add ~dec_finish ··· 1600 1585 let mems = 1601 1586 let dec_empty () = acc and dec_add = f and dec_finish _meta acc = acc in 1602 1587 let enc _f _ acc = acc in 1603 - Object.Mems.map t ~dec_empty ~dec_add ~dec_finish 1604 - ~enc:{ Object.Mems.enc } 1588 + Object.Mems.map t ~dec_empty ~dec_add ~dec_finish ~enc:{ Object.Mems.enc } 1605 1589 in 1606 - Object.map Fun.id 1607 - |> Object.keep_unknown mems ~enc:Fun.id 1608 - |> Object.finish 1590 + Object.map Fun.id |> Object.keep_unknown mems ~enc:Fun.id |> Object.finish 1609 1591 1610 1592 let filter_map_object a b f = 1611 1593 let dec_add meta n v (_, mems) = ··· 1653 1635 | Some absent -> ( 1654 1636 let rec loop absent t = function 1655 1637 | Path.Nth (n, _) :: is -> 1656 - loop Value.empty_array (update_nth ~absent n t) is 1638 + loop Ast.empty_array (update_nth ~absent n t) is 1657 1639 | Path.Mem (n, _) :: is -> 1658 - loop Value.empty_object (update_mem ~absent n t) is 1640 + loop Ast.empty_object (update_mem ~absent n t) is 1659 1641 | [] -> t 1660 1642 in 1661 1643 match i with 1662 1644 | Path.Nth (n, _) -> 1663 - loop Value.empty_array (update_nth ?stub ~absent n t) is 1645 + loop Ast.empty_array (update_nth ?stub ~absent n t) is 1664 1646 | Path.Mem (n, _) -> 1665 - loop Value.empty_object (update_mem ~absent n t) is)) 1647 + loop Ast.empty_object (update_mem ~absent n t) is)) 1666 1648 1667 - let null_value : Value.t = Value.Null ((), Meta.none) 1649 + let null_value : Ast.t = Ast.Null ((), Meta.none) 1668 1650 1669 1651 let delete_path ?allow_absent p = 1670 1652 match Path.rev_indices p with ··· 1675 1657 1676 1658 let set_path ?stub ?(allow_absent = false) t p v = 1677 1659 match Path.rev_indices p with 1678 - | [] -> 1679 - recode ~dec:ignore (fun () -> encode_exn t v) ~enc:Value.t 1680 - | i :: is -> 1660 + | [] -> recode ~dec:ignore (fun () -> encode_exn t v) ~enc:Value.t 1661 + | _ :: _ -> 1681 1662 let absent = if allow_absent then Some v else None in 1682 1663 update_path ?stub ?absent p (const t v) 1683 1664 end 1684 1665 1685 - (* Top-level wrappers over generic-value decode / encode / recode / update. *) 1666 + (* Top-level wrappers over generic-value decode / encode / recode. *) 1686 1667 1687 1668 let decode t j = Codec.decode t j 1688 - let decode' t j = Codec.decode' t j 1669 + let decode_exn t j = Codec.decode_exn t j 1689 1670 let encode t v = Codec.encode t v 1690 - let encode' t v = Codec.encode' t v 1691 - let recode t v = Codec.recode t v 1692 - let recode' t v = Codec.recode' t v 1693 - let update t v = Codec.update_of_t t v 1671 + let encode_exn t v = Codec.encode_exn t v 1672 + let recode t v = Codec.value_recode t v 1673 + let recode_exn t v = Codec.value_recode_exn t v 1694 1674 let error_sort = Codec.error_sort 1695 1675 let error_type = Codec.error_type 1696 1676 ··· 1702 1682 fun ppf v -> 1703 1683 match encode t v with 1704 1684 | Ok j -> pp_json' ?number_format () ppf j 1705 - | Error e -> pp_string ppf e 1685 + | Error e -> pp_string ppf (Error.to_string e) 1706 1686 1707 1687 (* Tape *) 1708 1688

+202 -140

lib/json.mli

··· 16 16 queries and transforms. 17 17 18 18 The combinator vocabulary follows 19 - {{:https://www.rfc-editor.org/rfc/rfc8259}RFC 8259} (STD 90, the JSON 20 - Data Interchange Format) and 19 + {{:https://www.rfc-editor.org/rfc/rfc8259}RFC 8259} (STD 90, the JSON Data 20 + Interchange Format) and 21 21 {{:https://www.ecma-international.org/publications-and-standards/standards/ecma-404/} 22 - ECMA-404}: a JSON {e value} is [null], [true]/[false] (literal names 23 - grouped as booleans here), a {e number}, a {e string}, an {e array} 24 - of values, or an {e object} -- a collection of {e members}, each a 25 - name/value pair. {!Codec.number} decodes to OCaml [float] because 26 - RFC 8259 § 6 identifies IEEE 754 binary64 as the interoperability 27 - baseline for the number grammar. 22 + ECMA-404}: a JSON {e value} is [null], [true]/[false] (literal names 23 + grouped as booleans here), a {e number}, a {e string}, an {e array} of 24 + values, or an {e object} -- a collection of {e members}, each a name/value 25 + pair. {!Codec.number} decodes to OCaml [float] because RFC 8259 § 6 26 + identifies IEEE 754 binary64 as the interoperability baseline for the number 27 + grammar. 28 28 29 29 Read the {{!page-index.quick_start}quick start} and the 30 30 {{!page-cookbook}cookbook}. *) ··· 305 305 (** [get_meta v] is {!meta}. *) 306 306 307 307 val copy_layout : t -> dst:t -> t 308 - (** [copy_layout src ~dst] copies the layout of [src] and sets it on [dst] 309 - using {!Meta.copy_ws}. *) 308 + (** [copy_layout src ~dst] copies the layout of [src] and sets it on [dst] using 309 + {!Meta.copy_ws}. *) 310 310 311 311 val sort : t -> Sort.t 312 312 (** [sort v] is the sort of value [v]. *) ··· 332 332 Convert between generic JSON values {!t} and typed values via a 333 333 {{!codec}codec}. *) 334 334 335 - val decode : 'a codec -> t -> ('a, string) result 335 + val decode : 'a codec -> t -> ('a, Error.t) result 336 336 (** [decode t j] decodes a value from the generic JSON [j] according to codec 337 337 [t]. *) 338 338 339 - val decode' : 'a codec -> t -> ('a, Error.t) result 340 - (** [decode'] is like {!val-decode} but preserves the error structure. *) 339 + val decode_exn : 'a codec -> t -> 'a 340 + (** [decode_exn] is like {!val-decode} but raises {!Json.exception-Error}. *) 341 341 342 - val encode : 'a codec -> 'a -> (t, string) result 342 + val encode : 'a codec -> 'a -> (t, Error.t) result 343 343 (** [encode t v] encodes a generic JSON value for [v] according to codec [t]. *) 344 344 345 - val encode' : 'a codec -> 'a -> (t, Error.t) result 346 - (** [encode'] is like {!val-encode} but preserves the error structure. *) 345 + val encode_exn : 'a codec -> 'a -> t 346 + (** [encode_exn] is like {!val-encode} but raises {!Json.exception-Error}. *) 347 347 348 - val recode : 'a codec -> t -> (t, string) result 348 + val recode : 'a codec -> t -> (t, Error.t) result 349 349 (** [recode t v] decodes [v] with [t] and encodes it with [t]. *) 350 350 351 - val recode' : 'a codec -> t -> (t, Error.t) result 352 - (** [recode'] is like {!val-recode} but preserves the error structure. *) 353 - 354 - val update : 'a codec -> t -> t 355 - (** [update] is like {!val-recode} but raises {!Json.exception-Error}. *) 351 + val recode_exn : 'a codec -> t -> t 352 + (** [recode_exn] is like {!val-recode} but raises {!Json.exception-Error}. *) 356 353 357 354 val error_sort : exp:Sort.t -> t -> 'a 358 355 (** [error_sort ~exp fnd] errors when sort [exp] was expected but generic JSON ··· 408 405 409 406 val pp_value : ?number_format:number_format -> 'a codec -> unit -> 'a Fmt.t 410 407 (** [pp_value t ()] formats the JSON representation of values as described by 411 - [t] by encoding it with {!val-encode} and formatting it with {!pp_json'}. 412 - If the encoding of the value errors a JSON string with the error message is 413 - formatted. This means that {!pp_value} should always format valid JSON 414 - text. *) 408 + [t] by encoding it with {!val-encode} and formatting it with {!pp_json'}. If 409 + the encoding of the value errors a JSON string with the error message is 410 + formatted. This means that {!pp_value} should always format valid JSON text. 411 + *) 415 412 416 413 (** {1:codec Codec combinators} 417 414 418 415 Codec combinators describe how OCaml values map to and from JSON values. 419 416 Most users open {!Codec} to build codecs: 420 - {[ let open Json.Codec in … ]} *) 417 + {[ 418 + let open Json.Codec in … 419 + ]} *) 421 420 422 421 (** Codec combinators and the low-level codec representation. *) 423 422 module Codec : sig ··· 428 427 {!Json.t} AST (so the codec type [t] below can shadow the AST without 429 428 losing access to it). *) 430 429 431 - type 'a t = 'a Codec.t 432 - (** The type for JSON types (codecs). *) 430 + (** The type for JSON types (codecs). Constructors are re-exported below in 431 + the {{!types_group}mutual types block}. *) 432 + type 'a t = 'a Codec.t = 433 + | Null : (unit, 'a) Codec.base_map -> 'a t 434 + | Bool : (bool, 'a) Codec.base_map -> 'a t 435 + | Number : (float, 'a) Codec.base_map -> 'a t 436 + | String : (string, 'a) Codec.base_map -> 'a t 437 + | Array : ('a, 'elt, 'builder) Codec.array_map -> 'a t 438 + | Object : ('o, 'o) Codec.object_map -> 'o t 439 + | Any : 'a Codec.any_map -> 'a t 440 + | Map : ('b, 'a) Codec.map -> 'a t 441 + | Rec : 'a t Lazy.t -> 'a t 442 + | Ignore : unit t (** *) 433 443 434 444 val kinded_sort : 'a t -> string 435 445 (** [kinded_sort t] is a human readable string describing the JSON values ··· 441 451 442 452 val kind : 'a t -> string 443 453 (** [kind t] is the [kind] of the underlying map. If the kind is an empty 444 - string this falls back to mention the {{!Sort}sort}. For example if [t] 445 - is an object map and the kind specified for the {{!Object.val-map}map} is 454 + string this falls back to mention the {{!Sort}sort}. For example if [t] is 455 + an object map and the kind specified for the {{!Object.val-map}map} is 446 456 ["T"] then this is ["T"], if the kind is empty then this is ["object"]. 447 457 See also {!Sort.or_kind}. *) 448 458 ··· 585 595 586 596 val number : float t 587 597 (** [number] maps JSON nulls or numbers to [float] values. On decodes JSON 588 - null is mapped to {!Float.nan}. On encodes any {{!Float.is_finite}non- 589 - finite} float is lossily mapped to JSON null 598 + null is mapped to {!Float.nan}. On encodes any 599 + {{!Float.is_finite}non- finite} float is lossily mapped to JSON null 590 600 ({{!page-cookbook.non_finite_numbers}explanation}). See also 591 601 {!Base.number}, {!any_float} and the integer combinators below. *) 592 602 ··· 596 606 {!Float.to_string}. This contrasts with {!val-number} which maps them to 597 607 JSON null values ({{!page-cookbook.non_finite_numbers}explanation}). Note 598 608 that on decodes this still maps JSON nulls to {!Float.nan} and any 599 - successful string decode of {!Float.of_string_opt} (so numbers can also 600 - be written as strings). See also {!val-number}. 609 + successful string decode of {!Float.of_string_opt} (so numbers can also be 610 + written as strings). See also {!val-number}. 601 611 602 612 {b Warning.} [any_float] should only be used between parties that have 603 613 agreed on such an encoding. To maximize interoperability you should use ··· 640 650 represented on the [int64] range, otherwise the decoder errors. [int64] 641 651 values are encoded as JSON numbers if the integer is in the 642 652 \[-2{^ 53};2{^ 53}\] range. 643 - - JSON strings are decoded using {!int_of_string_opt}, this allows 644 - binary, octal, decimal and hex syntaxes and errors on overflow and 645 - syntax errors. [int64] values are encoded as JSON strings with 646 - {!Int64.to_string} when the integer is outside the 647 - \[-2{^ 53};2{^ 53}\] range. *) 653 + - JSON strings are decoded using {!int_of_string_opt}, this allows binary, 654 + octal, decimal and hex syntaxes and errors on overflow and syntax 655 + errors. [int64] values are encoded as JSON strings with 656 + {!Int64.to_string} when the integer is outside the \[-2{^ 53};2{^ 53}\] 657 + range. *) 648 658 649 659 val int64_as_string : int64 t 650 660 (** [int64_as_string] maps JSON strings to 64-bit integers. On decodes this ··· 658 668 represented on the [int] range, otherwise the decoder errors. [int] 659 669 values are encoded as JSON numbers if the integer is in the 660 670 \[-2{^ 53};2{^ 53}\] range. 661 - - JSON strings are decoded using {!int_of_string_opt}, this allows 662 - binary, octal, decimal and hex syntaxes and errors on overflow and 663 - syntax errors. [int] values are encoded as JSON strings with 664 - {!Int.to_string} when the integer is outside the 665 - \[-2{^ 53};2{^ 53}\] range 671 + - JSON strings are decoded using {!int_of_string_opt}, this allows binary, 672 + octal, decimal and hex syntaxes and errors on overflow and syntax 673 + errors. [int] values are encoded as JSON strings with {!Int.to_string} 674 + when the integer is outside the \[-2{^ 53};2{^ 53}\] range 666 675 667 676 {b Warning.} The behaviour of this function is platform dependent, it 668 677 depends on the value of {!Sys.int_size}. *) ··· 682 691 strings. *) 683 692 684 693 val string : string t 685 - (** [string] maps unescaped JSON strings to UTF-8 encoded [string] values. 686 - See also {!Base.string}. 694 + (** [string] maps unescaped JSON strings to UTF-8 encoded [string] values. See 695 + also {!Base.string}. 687 696 688 697 {b Warning.} Encoders assume OCaml [string]s have been checked for UTF-8 689 698 validity. *) ··· 694 703 ?enc:('a -> string) -> 695 704 (string -> ('a, string) result) -> 696 705 'a t 697 - (** [of_of_string of_string] maps JSON string with a {{!Base.type-map}base 698 - map} using [of_string] for decoding and [enc] for encoding. See the 699 - {{!page-cookbook.transform_strings}cookbook}. *) 706 + (** [of_of_string of_string] maps JSON string with a 707 + {{!Base.type-map}base map} using [of_string] for decoding and [enc] for 708 + encoding. See the {{!page-cookbook.transform_strings}cookbook}. *) 700 709 701 710 val enum : 702 711 ?cmp:('a -> 'a -> int) -> ··· 711 720 712 721 val binary_string : string t 713 722 (** [binary_string] maps JSON strings made of an even number of hexdecimal 714 - US-ASCII upper or lower case digits to the corresponding byte sequence. 715 - On encoding uses only lower case hexadecimal digits to encode the byte 723 + US-ASCII upper or lower case digits to the corresponding byte sequence. On 724 + encoding uses only lower case hexadecimal digits to encode the byte 716 725 sequence. *) 717 726 718 727 (** {1:arrays Arrays and tuples} ··· 813 822 'a Map.Make(String).t t 814 823 (** [array_as_string_map ~key t] maps JSON array elements of type [t] to 815 824 string maps by indexing them with [key]. If two elements have the same 816 - [key] the element with the greatest index takes over. Elements of the 817 - map are encoded to a JSON array in (binary) key order. *) 825 + [key] the element with the greatest index takes over. Elements of the map 826 + are encoded to a JSON array in (binary) key order. *) 818 827 819 828 val bigarray : 820 829 ?kind:string -> ··· 822 831 ('a, 'b) Bigarray.kind -> 823 832 'a t -> 824 833 ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t t 825 - (** [bigarray k t] maps JSON arrays of type [t] to [Bigarray.Array1.t] 826 - values. See also {!Array.bigarray_map}. *) 834 + (** [bigarray k t] maps JSON arrays of type [t] to [Bigarray.Array1.t] values. 835 + See also {!Array.bigarray_map}. *) 827 836 828 837 val t2 : 829 838 ?kind:string -> ··· 874 883 (** [map dec] is an empty JSON object decoded by function [dec]. 875 884 - [kind] names the entities represented by the map and [doc] documents 876 885 them. Both default to [""]. 877 - - [dec] is a constructor eventually returning a value of type ['o] to 878 - be saturated with calls to {!val-mem}, {!val-case_mem} or 886 + - [dec] is a constructor eventually returning a value of type ['o] to be 887 + saturated with calls to {!val-mem}, {!val-case_mem} or 879 888 {!val-keep_unknown}. This is needed for decoding. Use {!enc_only} if 880 889 the result is only used for encoding. *) 881 890 ··· 905 914 (** Member maps. 906 915 907 916 Usually it's better to use {!Json.Codec.Object.mem} or 908 - {!Json.Codec.Object.opt_mem} directly. But this may be useful in 909 - certain abstraction contexts. *) 917 + {!Json.Codec.Object.opt_mem} directly. But this may be useful in certain 918 + abstraction contexts. *) 910 919 module Mem : sig 911 920 type ('o, 'dec) object_map := ('o, 'dec) map 912 921 ··· 924 933 ('o, 'a) map 925 934 (** See {!Json.Codec.Object.mem}. *) 926 935 927 - val app : 928 - ('o, 'a -> 'b) object_map -> ('o, 'a) map -> ('o, 'b) object_map 929 - (** [app map mmap] applies the member map [mmap] to the contructor of 930 - the object map [map]. In turn this adds the [mmap] member definition 931 - to the object described by [map]. *) 936 + val app : ('o, 'a -> 'b) object_map -> ('o, 'a) map -> ('o, 'b) object_map 937 + (** [app map mmap] applies the member map [mmap] to the contructor of the 938 + object map [map]. In turn this adds the [mmap] member definition to 939 + the object described by [map]. *) 932 940 end 933 941 934 942 val mem : ··· 949 957 - [enc] is used to project the member's value from the object 950 958 representation ['o] for encoding to JSON with [t]. It can be omitted 951 959 if the result is only used for decoding. 952 - - [enc_omit] is for the encoding direction. If the member value 953 - returned by [enc] returns [true] on [enc_omit], the member is omited 954 - in the encoded JSON object. Defaults to [Fun.const false]. *) 960 + - [enc_omit] is for the encoding direction. If the member value returned 961 + by [enc] returns [true] on [enc_omit], the member is omited in the 962 + encoded JSON object. Defaults to [Fun.const false]. *) 955 963 956 964 val opt_mem : 957 965 ?doc:string -> ··· 1028 1036 ('o, 'cases -> 'a) map -> 1029 1037 ('o, 'a) map 1030 1038 (** [case_mem name t cases map] is mostly like {!val-mem} except the member 1031 - [name] selects an object representation according to the member value 1032 - of type [t]. See {!Json.Codec.Object.case_mem} for details. *) 1039 + [name] selects an object representation according to the member value of 1040 + type [t]. See {!Json.Codec.Object.case_mem} for details. *) 1033 1041 1034 1042 (** {1:unknown_members Unknown members} 1035 1043 ··· 1101 1109 1102 1110 (** {1:any Any value} 1103 1111 1104 - Per {{:https://www.rfc-editor.org/rfc/rfc8259#section-3}RFC 8259 § 3}, 1105 - a JSON {e value} is one of [null], [true]/[false], a number, a string, 1106 - an array, or an object. *) 1112 + Per {{:https://www.rfc-editor.org/rfc/rfc8259#section-3}RFC 8259 § 3}, a 1113 + JSON {e value} is one of [null], [true]/[false], a number, a string, an 1114 + array, or an object. *) 1107 1115 1108 1116 val any : 1109 1117 ?kind:string -> ··· 1176 1184 (** [bool] decodes JSON booleans to {!Bool} and encodes {!Bool} values. *) 1177 1185 1178 1186 val number : value t 1179 - (** [number] decodes JSON numbers to {!Number} and encodes {!Number} 1180 - values. *) 1187 + (** [number] decodes JSON numbers to {!Number} and encodes {!Number} values. 1188 + *) 1181 1189 1182 1190 val string : value t 1183 - (** [string] decodes JSON strings to {!String} and encodes {!String} 1184 - values. *) 1191 + (** [string] decodes JSON strings to {!String} and encodes {!String} values. 1192 + *) 1185 1193 1186 1194 val array : value t 1187 1195 (** [array] decodes JSON arrays to {!Array} and encodes {!Array} values. *) ··· 1202 1210 module String_map : module type of Map.Make (String) 1203 1211 (** A [Map.Make(String)] instance used by the low-level representation. *) 1204 1212 1213 + (** The type for decoding functions. *) 1205 1214 type ('ret, 'f) dec_fun = ('ret, 'f) Codec.dec_fun = 1206 1215 | Dec_fun : 'f -> ('ret, 'f) dec_fun 1207 - | Dec_app : 1208 - ('ret, 'a -> 'b) dec_fun * 'a Type.Id.t 1209 - -> ('ret, 'b) dec_fun (** *) 1210 - (** The type for decoding functions. *) 1216 + | Dec_app : ('ret, 'a -> 'b) dec_fun * 'a Type.Id.t -> ('ret, 'b) dec_fun 1217 + (** *) 1211 1218 1212 1219 type ('a, 'b) base_map = ('a, 'b) Codec.base_map = { 1213 1220 kind : string; ··· 1218 1225 } 1219 1226 (** The type for mapping JSON base values. *) 1220 1227 1221 - type ('array, 'elt, 'builder) array_map = 1222 - ('array, 'elt, 'builder) Codec.array_map 1223 - (** The type for mapping JSON arrays. *) 1228 + (** {1:types_group Codec record field types} 1224 1229 1225 - type ('o, 'dec) object_map = ('o, 'dec) Codec.object_map 1226 - (** The type for mapping JSON objects. *) 1230 + The low-level record types form a mutually-recursive group in 1231 + {!Codec.Codec}; they are re-exported here as equi-recursive aliases so 1232 + constructors and fields are accessible by consumers. *) 1227 1233 1228 - type mem_dec = Codec.mem_dec 1229 - (** The type for member maps in decoding position. *) 1234 + type ('array, 'elt, 'builder) array_map = 1235 + ('array, 'elt, 'builder) Codec.array_map = { 1236 + kind : string; 1237 + doc : string; 1238 + elt : 'elt t; 1239 + dec_empty : unit -> 'builder; 1240 + dec_skip : int -> 'builder -> bool; 1241 + dec_add : int -> 'elt -> 'builder -> 'builder; 1242 + dec_finish : Meta.t -> int -> 'builder -> 'array; 1243 + enc : 'acc. ('acc -> int -> 'elt -> 'acc) -> 'acc -> 'array -> 'acc; 1244 + enc_meta : 'array -> Meta.t; 1245 + } 1230 1246 1231 - type 'o mem_enc = 'o Codec.mem_enc 1232 - (** The type for member maps in encoding position. *) 1247 + and ('o, 'dec) object_map = ('o, 'dec) Codec.object_map = { 1248 + kind : string; 1249 + doc : string; 1250 + dec : ('o, 'dec) dec_fun; 1251 + mem_decs : mem_dec Codec.String_map.t; 1252 + mem_encs : 'o mem_enc list; 1253 + enc_meta : 'o -> Meta.t; 1254 + shape : 'o object_shape; 1255 + } 1233 1256 1234 - type ('o, 'a) mem_map = ('o, 'a) Codec.mem_map 1235 - (** The type for mapping a JSON member. *) 1257 + and mem_dec = Codec.mem_dec = Mem_dec : ('o, 'a) mem_map -> mem_dec 1258 + and 'o mem_enc = 'o Codec.mem_enc = Mem_enc : ('o, 'a) mem_map -> 'o mem_enc 1236 1259 1237 - type 'o object_shape = 'o Codec.object_shape 1238 - (** The type for object shapes. *) 1260 + and ('o, 'a) mem_map = ('o, 'a) Codec.mem_map = { 1261 + name : string; 1262 + doc : string; 1263 + type' : 'a t; 1264 + id : 'a Type.Id.t; 1265 + dec_absent : 'a option; 1266 + enc : 'o -> 'a; 1267 + enc_omit : 'a -> bool; 1268 + } 1239 1269 1240 - type ('o, 'mems, 'builder) unknown_mems = 1241 - ('o, 'mems, 'builder) Codec.unknown_mems = 1270 + and 'o object_shape = 'o Codec.object_shape = 1271 + | Object_basic : ('o, 'mems, 'builder) unknown_mems -> 'o object_shape 1272 + | Object_cases : 1273 + ('o, 'mems, 'builder) unknown_mems option 1274 + * ('o, 'cases, 'tag) object_cases 1275 + -> 'o object_shape 1276 + 1277 + and ('o, 'mems, 'builder) unknown_mems = 1278 + ('o, 'mems, 'builder) Codec.unknown_mems = 1242 1279 | Unknown_skip : ('o, unit, unit) unknown_mems 1243 1280 | Unknown_error : ('o, unit, unit) unknown_mems 1244 1281 | Unknown_keep : 1245 - ('mems, 'a, 'builder) Codec.mems_map * ('o -> 'mems) 1282 + ('mems, 'a, 'builder) mems_map * ('o -> 'mems) 1246 1283 -> ('o, 'mems, 'builder) unknown_mems 1247 - (** The type for specifying decoding behaviour on unknown JSON object 1248 - members. *) 1249 1284 1250 - type ('mems, 'a, 'builder) mems_map = ('mems, 'a, 'builder) Codec.mems_map 1251 - (** The type for gathering unknown JSON members. *) 1285 + and ('mems, 'a, 'builder) mems_map = ('mems, 'a, 'builder) Codec.mems_map = { 1286 + kind : string; 1287 + doc : string; 1288 + mems_type : 'a t; 1289 + id : 'mems Type.Id.t; 1290 + dec_empty : unit -> 'builder; 1291 + dec_add : Meta.t -> string -> 'a -> 'builder -> 'builder; 1292 + dec_finish : Meta.t -> 'builder -> 'mems; 1293 + enc : 1294 + 'acc. (Meta.t -> string -> 'a -> 'acc -> 'acc) -> 'mems -> 'acc -> 'acc; 1295 + } 1252 1296 1253 - type ('o, 'cases, 'tag) object_cases = ('o, 'cases, 'tag) Codec.object_cases 1254 - (** The type for object cases. *) 1297 + and ('o, 'cases, 'tag) object_cases = 1298 + ('o, 'cases, 'tag) Codec.object_cases = { 1299 + tag : ('tag, 'tag) mem_map; 1300 + tag_compare : 'tag -> 'tag -> int; 1301 + tag_to_string : ('tag -> string) option; 1302 + id : 'cases Type.Id.t; 1303 + cases : ('cases, 'tag) case list; 1304 + enc : 'o -> 'cases; 1305 + enc_case : 'cases -> ('cases, 'tag) case_value; 1306 + } 1255 1307 1256 - type ('cases, 'case, 'tag) case_map = ('cases, 'case, 'tag) Codec.case_map 1257 - (** The type for an object case. *) 1308 + and ('cases, 'case, 'tag) case_map = ('cases, 'case, 'tag) Codec.case_map = { 1309 + tag : 'tag; 1310 + object_map : ('case, 'case) object_map; 1311 + dec : 'case -> 'cases; 1312 + } 1258 1313 1259 - type ('cases, 'tag) case_value = ('cases, 'tag) Codec.case_value 1260 - (** The type for case values. *) 1314 + and ('cases, 'tag) case = ('cases, 'tag) Codec.case = 1315 + | Case : ('cases, 'case, 'tag) case_map -> ('cases, 'tag) case 1316 + (** The type for hiding the concrete type of a case. *) 1261 1317 1262 - type ('cases, 'tag) case = ('cases, 'tag) Codec.case 1263 - (** The type for hiding the concrete type of a case. *) 1318 + and ('cases, 'tag) case_value = ('cases, 'tag) Codec.case_value = 1319 + | Case_value : 1320 + ('cases, 'case, 'tag) case_map * 'case 1321 + -> ('cases, 'tag) case_value (** The type for case values. *) 1264 1322 1265 - type 'a any_map = 'a Codec.any_map 1266 - (** The type for mapping JSON values with multiple sorts. *) 1323 + and 'a any_map = 'a Codec.any_map = { 1324 + kind : string; 1325 + doc : string; 1326 + dec_null : 'a t option; 1327 + dec_bool : 'a t option; 1328 + dec_number : 'a t option; 1329 + dec_string : 'a t option; 1330 + dec_array : 'a t option; 1331 + dec_object : 'a t option; 1332 + enc : 'a -> 'a t; 1333 + } 1267 1334 1268 - type ('a, 'b) map = ('a, 'b) Codec.map 1269 - (** The type for mapping JSON types of type ['a] to a JSON type of type ['b]. 1270 - *) 1335 + and ('a, 'b) map = ('a, 'b) Codec.map = { 1336 + kind : string; 1337 + doc : string; 1338 + dom : 'a t; 1339 + dec : 'a -> 'b; 1340 + enc : 'b -> 'a; 1341 + } 1271 1342 1272 1343 val array_kinded_sort : ('a, 'elt, 'builder) array_map -> string 1273 1344 (** [array_kinded_sort map] is like {!kinded_sort} but acts directly on the ··· 1314 1385 1315 1386 (** Heterogeneous dictionaries. *) 1316 1387 module Dict : sig 1317 - type binding = Codec.Dict.binding = 1318 - | B : 'a Type.Id.t * 'a -> binding 1319 - 1388 + type binding = Codec.Dict.binding = B : 'a Type.Id.t * 'a -> binding 1320 1389 type t = Codec.Dict.t 1321 1390 1322 1391 val empty : t ··· 1356 1425 1357 1426 (** {1:queries Queries and updates} 1358 1427 1359 - Queries are lossy or aggregating decodes. Updates yield codecs that 1360 - decode to generic {!value} values but transform the data along the way. 1361 - They allow to process JSON data without having to fully model it. *) 1428 + Queries are lossy or aggregating decodes. Updates yield codecs that decode 1429 + to generic {!value} values but transform the data along the way. They 1430 + allow to process JSON data without having to fully model it. *) 1362 1431 1363 1432 val const : 'a t -> 'a -> 'a t 1364 1433 (** [const t v] maps any JSON value to [v] on decodes and unconditionally ··· 1369 1438 on encodes uses [enc]. *) 1370 1439 1371 1440 val update : 'a t -> value t 1372 - (** [update t] decodes any JSON with [t] and directly encodes it back with 1373 - [t] to yield the decode result. *) 1441 + (** [update t] decodes any JSON with [t] and directly encodes it back with [t] 1442 + to yield the decode result. *) 1374 1443 1375 1444 (** {2:array_queries Arrays} *) 1376 1445 ··· 1387 1456 val delete_nth : ?allow_absent:bool -> int -> value t 1388 1457 (** [delete_nth n] drops the [n]th index of a JSON array. *) 1389 1458 1390 - val filter_map_array : 1391 - 'a t -> 'b t -> (int -> 'a -> 'b option) -> value t 1392 - (** [filter_map_array a b f] maps the [a] elements with [f] to [b] elements 1393 - or deletes them on [None]. *) 1459 + val filter_map_array : 'a t -> 'b t -> (int -> 'a -> 'b option) -> value t 1460 + (** [filter_map_array a b f] maps the [a] elements with [f] to [b] elements or 1461 + deletes them on [None]. *) 1394 1462 1395 1463 val fold_array : 'a t -> (int -> 'a -> 'b -> 'b) -> 'b -> 'b t 1396 1464 (** [fold_array t f acc] folds [f] over the [t] elements of a JSON array. *) ··· 1398 1466 (** {2:object_queries Objects} *) 1399 1467 1400 1468 val mem : ?absent:'a -> string -> 'a t -> 'a t 1401 - (** [mem name t] decodes the member named [name] of a JSON object with [t]. 1402 - *) 1469 + (** [mem name t] decodes the member named [name] of a JSON object with [t]. *) 1403 1470 1404 1471 val set_mem : ?allow_absent:bool -> 'a t -> string -> 'a -> value t 1405 - (** [set_mem t name v] sets the member value of [name] to an encoding of 1406 - [v]. *) 1472 + (** [set_mem t name v] sets the member value of [name] to an encoding of [v]. 1473 + *) 1407 1474 1408 1475 val update_mem : ?absent:'a -> string -> 'a t -> value t 1409 1476 (** [update_mem name t] recodes the member value of [name]. *) ··· 1416 1483 (** [filter_map_object a b f] maps the [a] members with [f] to [(n, b)] 1417 1484 members or deletes them on [None]. *) 1418 1485 1419 - val fold_object : 1420 - 'a t -> (Meta.t -> string -> 'a -> 'b -> 'b) -> 'b -> 'b t 1421 - (** [fold_object t f acc] folds [f] over the [t] members of a JSON object. 1422 - *) 1486 + val fold_object : 'a t -> (Meta.t -> string -> 'a -> 'b -> 'b) -> 'b -> 'b t 1487 + (** [fold_object t f acc] folds [f] over the [t] members of a JSON object. *) 1423 1488 1424 1489 (** {2:index_queries Indices} *) 1425 1490 1426 1491 val index : ?absent:'a -> Path.index -> 'a t -> 'a t 1427 1492 (** [index] uses {!val-nth} or {!val-mem} on the given index. *) 1428 1493 1429 - val set_index : 1430 - ?allow_absent:bool -> 'a t -> Path.index -> 'a -> value t 1494 + val set_index : ?allow_absent:bool -> 'a t -> Path.index -> 'a -> value t 1431 1495 (** [set_index] uses {!set_nth} or {!set_mem} on the given index. *) 1432 1496 1433 - val update_index : 1434 - ?stub:value -> ?absent:'a -> Path.index -> 'a t -> value t 1497 + val update_index : ?stub:value -> ?absent:'a -> Path.index -> 'a t -> value t 1435 1498 (** [update_index] uses {!update_nth} or {!update_mem}. *) 1436 1499 1437 1500 val delete_index : ?allow_absent:bool -> Path.index -> value t ··· 1446 1509 ?stub:value -> ?allow_absent:bool -> 'a t -> Path.t -> 'a -> value t 1447 1510 (** [set_path t p v] sets the last index of [p]. *) 1448 1511 1449 - val update_path : 1450 - ?stub:value -> ?absent:'a -> Path.t -> 'a t -> value t 1512 + val update_path : ?stub:value -> ?absent:'a -> Path.t -> 'a t -> value t 1451 1513 (** [update_path p t] updates the last index of [p] with [t]. *) 1452 1514 1453 1515 val delete_path : ?allow_absent:bool -> Path.t -> value t

+10 -10

test/bytesrw/test_json_bytesrw.ml

··· 2 2 streaming I/O surface. *) 3 3 4 4 let test_decode_primitive () = 5 - match Json_bytesrw.decode_string Json.int "42" with 6 - | Error e -> Alcotest.failf "decode failed: %s" e 5 + match Json_bytesrw.of_string Json.Codec.int "42" with 6 + | Error e -> Alcotest.failf "decode failed: %a" Json.Error.pp e 7 7 | Ok n -> Alcotest.(check int) "42 round-trip" 42 n 8 8 9 9 let test_encode_primitive () = 10 - match Json_bytesrw.encode_string Json.int 7 with 11 - | Error e -> Alcotest.failf "encode failed: %s" e 10 + match Json_bytesrw.to_string Json.Codec.int 7 with 11 + | Error e -> Alcotest.failf "encode failed: %a" Json.Error.pp e 12 12 | Ok s -> Alcotest.(check string) "7 encoded" "7" s 13 13 14 14 let test_roundtrip_object () = 15 15 let pair_codec = 16 - let open Json.Object in 16 + let open Json.Codec.Object in 17 17 map ~kind:"pair" (fun a b -> (a, b)) 18 - |> mem "a" Json.int ~enc:fst 19 - |> mem "b" Json.string ~enc:snd 18 + |> mem "a" Json.Codec.int ~enc:fst 19 + |> mem "b" Json.Codec.string ~enc:snd 20 20 |> finish 21 21 in 22 22 let input = {|{"a": 7, "b": "hi"}|} in 23 - match Json_bytesrw.decode_string pair_codec input with 24 - | Error e -> Alcotest.failf "decode failed: %s" e 23 + match Json_bytesrw.of_string pair_codec input with 24 + | Error e -> Alcotest.failf "decode failed: %a" Json.Error.pp e 25 25 | Ok (a, b) -> 26 26 Alcotest.(check int) "a" 7 a; 27 27 Alcotest.(check string) "b" "hi" b 28 28 29 29 let test_decode_error () = 30 - match Json_bytesrw.decode_string Json.int "not json" with 30 + match Json_bytesrw.of_string Json.Codec.int "not json" with 31 31 | Ok _ -> Alcotest.fail "expected decode error" 32 32 | Error _ -> () 33 33

+27 -23

test/test_json.ml

··· 1 - (* Tests for [Json.ignore]'s skip-parse fast path. 1 + (* Tests for [Json.Codec.ignore]'s skip-parse fast path. 2 2 3 3 Two angles: 4 4 5 5 1. Hand-written positive/negative cases covering the shape grammar 6 6 (string escapes, number formats, nested structures, truncation). 7 - 2. Differential property: on any string, [Json.ignore] and 8 - [Json.json] agree on Ok/Error status. [Json.ignore] is allowed 9 - to be more permissive (accept where [Json.json] errors) only at 7 + 2. Differential property: on any string, [Json.Codec.ignore] and 8 + [Json.Codec.Value.t] agree on Ok/Error status. [Json.Codec.ignore] is allowed 9 + to be more permissive (accept where [Json.Codec.Value.t] errors) only at 10 10 content level -- never at structural level. Crowbar generates 11 11 random inputs and asserts the invariant. *) 12 12 13 - let decode_ignore s = Json_bytesrw.decode_string Json.ignore s 14 - let decode_dom s = Json_bytesrw.decode_string Json.json s 13 + let decode_ignore s = Json_bytesrw.of_string Json.Codec.ignore s 14 + let decode_dom s = Json_bytesrw.of_string Json.Codec.Value.t s 15 15 let is_ok = function Ok _ -> true | Error _ -> false 16 16 17 - (* -- Positive cases: Json.ignore must accept all valid JSON -- *) 17 + (* -- Positive cases: Json.Codec.ignore must accept all valid JSON -- *) 18 18 19 19 let test_ignore_accepts_valid name s () = 20 20 match decode_ignore s with 21 21 | Ok () -> () 22 - | Error e -> Alcotest.failf "Json.ignore rejected valid input %s: %s" name e 22 + | Error e -> 23 + Alcotest.failf "Json.Codec.ignore rejected valid input %s: %a" name 24 + Json.Error.pp e 23 25 24 26 let positive_cases = 25 27 [ ··· 55 57 ("unicode escape pair", {|"\uD83D\uDE00"|}); 56 58 ] 57 59 58 - (* -- Negative cases: Json.ignore must reject structurally broken input. 60 + (* -- Negative cases: Json.Codec.ignore must reject structurally broken input. 59 61 60 62 "Structurally broken" means: mismatched brackets, unclosed strings, 61 63 unclosed containers, or complete absence of a value. The skip path 62 64 is explicitly more permissive on content (numbers, escapes) and may 63 - accept things Json.json rejects. *) 65 + accept things Json.Codec.Value.t rejects. *) 64 66 65 67 let test_ignore_rejects_malformed name s () = 66 68 match decode_ignore s with 67 - | Ok () -> Alcotest.failf "Json.ignore accepted malformed input %s" name 69 + | Ok () -> Alcotest.failf "Json.Codec.ignore accepted malformed input %s" name 68 70 | Error _ -> () 69 71 70 72 let structural_negatives = ··· 83 85 ("just close bracket", "]"); 84 86 ] 85 87 86 - (* -- Differential: Json.ignore and Json.json on the same input -- 88 + (* -- Differential: Json.Codec.ignore and Json.Codec.Value.t on the same input -- 87 89 88 90 Expected: on all corpus files (known valid), both decode to Ok. 89 91 On a set of synthetic malformed inputs, both return Error -- or at 90 - worst, Json.ignore accepts something Json.json rejects (content 92 + worst, Json.Codec.ignore accepts something Json.Codec.Value.t rejects (content 91 93 permissiveness, documented). The strict structural contract says 92 - Json.ignore MUST reject what Json.json rejects at the structural 94 + Json.Codec.ignore MUST reject what Json.Codec.Value.t rejects at the structural 93 95 level. *) 94 96 95 97 let test_diff_valid_both_accept name s () = ··· 97 99 match (ri, rj) with 98 100 | Ok _, Ok _ -> () 99 101 | Error e, Ok _ -> 100 - Alcotest.failf "Json.ignore rejected but Json.json accepted %s: %s" name e 102 + Alcotest.failf 103 + "Json.Codec.ignore rejected but Json.Codec.Value.t accepted %s: %s" name 104 + e 101 105 | Ok _, Error e -> 102 106 Alcotest.failf 103 - "Json.ignore accepted but Json.json rejected %s (content \ 104 - permissiveness): %s" 107 + "Json.Codec.ignore accepted but Json.Codec.Value.t rejected %s \ 108 + (content permissiveness): %s" 105 109 name e 106 110 | Error _, Error _ -> () 107 111 ··· 117 121 ("unicode in key", {|{"caf\u00e9":1}|}); 118 122 ] 119 123 120 - (* -- Content-permissiveness: Json.ignore matches simdjson On-Demand 124 + (* -- Content-permissiveness: Json.Codec.ignore matches simdjson On-Demand 121 125 semantics. Structural contract (bracket nesting, string quote 122 126 matching) is enforced; content validity (number shape, escape 123 127 correctness) is NOT. Callers needing strict content validation 124 - should decode with Json.json and discard. These cases document 128 + should decode with Json.Codec.Value.t and discard. These cases document 125 129 the boundary. -- *) 126 130 127 131 let permissive_cases = ··· 136 140 let test_permissive_ignore name s () = 137 141 let ri = decode_ignore s and rj = decode_dom s in 138 142 Alcotest.(check bool) (Fmt.str "json rejects %s" name) false (is_ok rj); 139 - (* Json.ignore accepts this -- document the behaviour. *) 143 + (* Json.Codec.ignore accepts this -- document the behaviour. *) 140 144 match ri with 141 145 | Ok _ -> () (* Expected permissive acceptance. *) 142 146 | Error _ -> 143 147 (* If ignore also rejects, we have tighter validation than 144 148 expected. Note and continue. *) 145 - Fmt.epr "(info: Json.ignore also rejected %s)\n" name 149 + Fmt.epr "(info: Json.Codec.ignore also rejected %s)\n" name 146 150 147 151 (* -- Corpus torture test -- 148 152 149 153 If the simdjson corpus is present at [/tmp/jsont_corpus/*.json], 150 - run Json.ignore over each file and assert acceptance. Also check 151 - that Json.ignore and Json.json agree (both Ok) on every file. 154 + run Json.Codec.ignore over each file and assert acceptance. Also check 155 + that Json.Codec.ignore and Json.Codec.Value.t agree (both Ok) on every file. 152 156 Skipped silently if the corpus isn't available. *) 153 157 154 158 let read_file path =

Configure Feed

Configure Feed