Declarative JSON data manipulation for OCaml
json: rename mem -> member / finish -> seal across the codec + value API
Object combinators: [Object.mem] -> [Object.member], [Object.opt_mem]
-> [Object.opt_member], [Object.case_mem] -> [Object.case_member]. The
sibling submodules [Object.Mem] / [Object.Mems] become
[Object.Member] / [Object.Members]. RFC 8259 §4 calls these
"name/value pairs, referred to as the members", so mirror the spec
name rather than the shortened [mem].
[Object.finish] -> [Object.seal]. "Seal" reads as "close the map, no
more members added", which is what the operation does.
Value constructors/queries: [Value.mem] (function) -> [Value.member];
[Value.mem_find] -> [Value.member_key]; [Value.mem_names] ->
[Value.member_names]; [Value.mem_keys] -> [Value.member_keys].
[type mem = ...] -> [type member = ...]; [type object'] still points
at [member list].
Downstream (~80 files across slack, sbom, stripe, sigstore, requests,
claude, irmin, freebox) updated via perl-pie. dune build clean,
dune test ocaml-json clean.
+515
-693
+2
-2
bench/bench.ml
+2
-2
bench/bench.ml
+4
-1
dune-project
+4
-1
dune-project
+2
-1
fuzz/fuzz_json.ml
+2
-1
fuzz/fuzz_json.ml
···
52
52
match Json.Value.of_string s with
53
53
| Error e ->
54
54
failf "roundtrip: re-decode failed on %S: %a" s Json.Error.pp e
55
-
| Ok v' -> if not (Json.equal v v') then failf "roundtrip: value changed")
55
+
| Ok v' ->
56
+
if not (Json.Value.equal v v') then failf "roundtrip: value changed")
56
57
57
58
let suite =
58
59
( "json",
+1
-1
lib/core.ml
+1
-1
lib/core.ml
···
297
297
(* cf. ECMAScript's JSON.stringify *)
298
298
if Float.is_finite f then pf ppf fmt f else json_null ppf ()
299
299
300
-
let json_number ppf v = json_number' json_default_number_format ppf v
300
+
let json_number ppf f = json_number' json_default_number_format ppf f
301
301
302
302
let json_string ppf s =
303
303
let is_control = function
+8
-6
lib/core.mli
+8
-6
lib/core.mli
···
126
126
(used in error hints). *)
127
127
128
128
type json_number_format = (float -> unit, Format.formatter, unit) format
129
-
(** The type for number format strings passed to {!json_number'}. *)
129
+
(** The type for number format strings passed to {!json_number}. *)
130
130
131
131
val json_null : unit t
132
132
(** [json_null] formats a literal JSON [null]. *)
···
138
138
(** [json_default_number_format] is [%.17g], which roundtrips any
139
139
{!Stdlib.Float.t} exactly. *)
140
140
141
-
val json_number' : json_number_format -> float t
142
-
(** [json_number' fmt] formats a JSON number using [fmt]. Non-finite floats
143
-
are emitted as [null]. *)
144
-
145
141
val json_number : float t
146
-
(** [json_number] is {!json_number'} with {!json_default_number_format}. *)
142
+
(** [json_number] formats a JSON number using {!json_default_number_format}.
143
+
Non-finite floats are emitted as [null]. *)
144
+
145
+
val json_number' : json_number_format -> float t
146
+
(** [json_number' fmt] is like {!json_number} but with an explicit format. Use
147
+
this when [%a] in a format string needs a concrete formatter (OCaml does
148
+
not erase optional arguments across [%a]). *)
147
149
148
150
val json_string : string t
149
151
(** [json_string s] formats [s] as a JSON string (double-quoted, with control
+1
-4
lib/dune
+1
-4
lib/dune
+1
-1
lib/error.ml
+1
-1
lib/error.ml
···
100
100
let no_encoder meta ~kind = msgf meta "No encoder for %a" pp_kind kind
101
101
let decode_todo meta ~kind_opt:k = msgf meta "TODO: decode%a" pp_kind_opt k
102
102
let encode_todo meta ~kind_opt:k = msgf meta "TODO: encode%a" pp_kind_opt k
103
-
let for' meta ~kind e = msgf meta "%a: %s" pp_kind kind e
103
+
let msg_with_kind meta ~kind e = msgf meta "%a: %s" pp_kind kind e
+3
-3
lib/error.mli
+3
-3
lib/error.mli
···
142
142
val encode_todo : Loc.Meta.t -> kind_opt:string -> 'a
143
143
(** [encode_todo meta ~kind_opt] raises "TODO: encode [kind_opt]". *)
144
144
145
-
val for' : Loc.Meta.t -> kind:string -> string -> 'a
146
-
(** [for' meta ~kind e] raises "[kind]: [e]" (generic wrapper used when callers
147
-
already have a formatted message). *)
145
+
val msg_with_kind : Loc.Meta.t -> kind:string -> string -> 'a
146
+
(** [msg_with_kind meta ~kind e] raises ["[kind]: [e]"] — a generic wrapper when
147
+
callers already have a formatted error message. *)
+72
-117
lib/json.ml
+72
-117
lib/json.ml
···
26
26
(* Generic JSON AST — lifted from the internal Value module. *)
27
27
28
28
type name = Value.name
29
-
type mem = Value.mem
29
+
type member = Value.member
30
30
type object' = Value.object'
31
31
32
32
type t = Value.t =
···
37
37
| Array of t list node
38
38
| Object of object' node
39
39
40
-
type 'a cons = ?meta:Meta.t -> 'a -> t
41
-
42
-
(* Pretty-printers *)
43
-
44
-
let pp_null = Value.pp_null
45
-
let pp_bool = Value.pp_bool
46
-
let pp_string = Value.pp_string
47
-
let pp_number = Value.pp_number
48
-
let pp_number' = Value.pp_number'
49
-
let pp_json = Value.pp_json
50
-
let pp_json' = Value.pp_json'
51
-
let pp = pp_json
52
-
53
40
type number_format = Value.number_format
54
41
55
-
let default_number_format = Value.default_number_format
56
-
57
-
(* Metadata and sort *)
58
-
59
-
let meta = Value.meta
60
-
let set_meta = Value.set_meta
61
-
let copy_layout = Value.copy_layout
62
-
let sort = Value.sort
63
-
64
-
(* Equality and comparison *)
65
-
66
-
let equal = Value.equal
67
-
let compare = Value.compare
68
-
69
-
(* Constructors *)
70
-
71
-
let null = Value.null
72
-
let bool = Value.bool
73
-
let number = Value.number
74
-
let any_float = Value.any_float
75
-
let int32 = Value.int32
76
-
let int64 = Value.int64
77
-
let int64_as_string = Value.int64_as_string
78
-
let int = Value.int
79
-
let int_as_string = Value.int_as_string
80
-
let string = Value.string
81
-
let list = Value.list
82
-
let array = Value.array
83
-
let object' = Value.object'
84
-
let empty_array = Value.empty_array
85
-
let empty_object = Value.empty_object
86
-
let option = Value.option
87
-
let name = Value.name
88
-
let mem = Value.mem
89
-
let zero = Value.zero
90
-
91
-
(* Destructors / queries *)
92
-
93
-
let find_mem = Value.find_mem
94
-
let find_mem' = Value.find_mem'
95
-
let object_names = Value.object_names
96
-
let object_names' = Value.object_names'
42
+
let pp = Value.pp
97
43
98
44
(* Codec combinators and low-level representation. This module re-exports
99
45
everything from [Codec] and adds the public combinator surface,
···
121
67
match dec with
122
68
| Some dec -> dec
123
69
| None ->
124
-
let kind = Sort.kinded' ~kind base_map_sort in
70
+
let kind = Sort.kinded_string ~kind base_map_sort in
125
71
fun meta _v -> Error.no_decoder meta ~kind
126
72
in
127
73
let enc =
128
74
match enc with
129
75
| Some enc -> enc
130
76
| None ->
131
-
let kind = Sort.kinded' ~kind base_map_sort in
77
+
let kind = Sort.kinded_string ~kind base_map_sort in
132
78
fun _v -> Error.no_encoder Meta.none ~kind
133
79
in
134
80
{ kind; doc; dec; enc; enc_meta }
···
141
87
let kind = "ignore" in
142
88
let dec _meta _v = () in
143
89
let enc _v =
144
-
let kind = Sort.kinded' ~kind base_map_sort in
90
+
let kind = Sort.kinded_string ~kind base_map_sort in
145
91
Error.no_encoder Meta.none ~kind
146
92
in
147
93
{ kind; doc = ""; dec; enc; enc_meta = enc_meta_none }
···
153
99
let dec dec = fun _meta v -> dec v
154
100
155
101
let dec_result ?(kind = "") dec =
156
-
let kind = Sort.kinded' ~kind base_map_sort in
102
+
let kind = Sort.kinded_string ~kind base_map_sort in
157
103
fun meta v ->
158
-
match dec v with Ok v -> v | Error e -> Error.for' meta ~kind e
104
+
match dec v with
105
+
| Ok v -> v
106
+
| Error e -> Error.msg_with_kind meta ~kind e
159
107
160
108
let dec_failure ?(kind = "") dec =
161
-
let kind = Sort.kinded' ~kind base_map_sort in
162
-
fun meta v -> try dec v with Failure e -> Error.for' meta ~kind e
109
+
let kind = Sort.kinded_string ~kind base_map_sort in
110
+
fun meta v ->
111
+
try dec v with Failure e -> Error.msg_with_kind meta ~kind e
163
112
164
113
let enc = Fun.id
165
114
166
115
let enc_result ?(kind = "") enc =
167
-
let kind = Sort.kinded' ~kind base_map_sort in
116
+
let kind = Sort.kinded_string ~kind base_map_sort in
168
117
fun v ->
169
-
match enc v with Ok v -> v | Error e -> Error.for' Meta.none ~kind e
118
+
match enc v with
119
+
| Ok v -> v
120
+
| Error e -> Error.msg_with_kind Meta.none ~kind e
170
121
171
122
let enc_failure ?(kind = "") enc =
172
-
let kind = Sort.kinded' ~kind base_map_sort in
173
-
fun v -> try enc v with Failure e -> Error.for' Meta.none ~kind e
123
+
let kind = Sort.kinded_string ~kind base_map_sort in
124
+
fun v ->
125
+
try enc v with Failure e -> Error.msg_with_kind Meta.none ~kind e
174
126
end
175
127
176
128
(* Any JSON value (RFC 8259 s. 3) *)
···
181
133
match enc with
182
134
| Some enc -> enc
183
135
| None ->
184
-
let kind = Sort.kinded' ~kind "value" in
136
+
let kind = Sort.kinded_string ~kind "value" in
185
137
fun _v -> Error.no_encoder Meta.none ~kind
186
138
in
187
139
Any
···
205
157
match dec with
206
158
| Some dec -> dec
207
159
| None ->
208
-
let kind = Sort.kinded' ~kind map_sort in
160
+
let kind = Sort.kinded_string ~kind map_sort in
209
161
fun _v -> Error.no_decoder Meta.none ~kind
210
162
in
211
163
let enc =
212
164
match enc with
213
165
| Some enc -> enc
214
166
| None ->
215
-
let kind = Sort.kinded' ~kind map_sort in
167
+
let kind = Sort.kinded_string ~kind map_sort in
216
168
fun _v -> Error.no_encoder Meta.none ~kind
217
169
in
218
170
Map { kind; doc; dom; dec; enc }
···
236
188
in
237
189
Map { kind; doc; dom; dec; enc }
238
190
239
-
let rec' t = Rec t
191
+
let fix t = Rec t
240
192
241
193
(* Nulls and options *)
242
194
···
425
377
Base.string (Base.map ?kind ?doc ?enc ~dec ())
426
378
427
379
let enum (type a) ?(cmp = Stdlib.compare) ?(kind = "") ?doc assoc =
428
-
let kind = Sort.kinded' ~kind "enum" in
380
+
let kind = Sort.kinded_string ~kind "enum" in
429
381
let dec_map =
430
382
let add m (k, v) = String_map.add k v m in
431
383
let m = List.fold_left add String_map.empty assoc in
···
615
567
Array (Array.bigarray_map ?kind ?doc k Bigarray.c_layout t)
616
568
617
569
let tuple_no_decoder ~kind meta =
618
-
Error.no_decoder meta ~kind:(Sort.kinded' ~kind "tuple")
570
+
Error.no_decoder meta ~kind:(Sort.kinded_string ~kind "tuple")
619
571
620
572
let tuple_no_encoder ~kind =
621
-
Error.no_encoder Meta.none ~kind:(Sort.kinded' ~kind "tuple")
573
+
Error.no_encoder Meta.none ~kind:(Sort.kinded_string ~kind "tuple")
622
574
623
575
let error_tuple_size meta kind ~exp fnd =
624
576
Error.msgf meta "Expected %a elements in %a but found %a" pp_int exp pp_kind
625
-
(Sort.kinded' ~kind "tuple")
577
+
(Sort.kinded_string ~kind "tuple")
626
578
pp_int fnd
627
579
628
580
let t2 ?(kind = "") ?doc ?dec ?enc t =
···
724
676
725
677
let map ?kind ?doc dec = raw_map ?kind ?doc (Dec_fun dec)
726
678
727
-
let map' ?kind ?doc ?enc_meta dec =
679
+
let map_with_meta ?kind ?doc ?enc_meta dec =
728
680
raw_map ?kind ?doc ?enc_meta (Dec_app (Dec_fun dec, object_meta_arg))
729
681
730
682
let enc_only ?(kind = "") ?doc ?enc_meta () =
731
683
let dec meta = Error.no_decoder meta ~kind:(Sort.kinded ~kind Object) in
732
-
map' ~kind ?doc ?enc_meta dec
684
+
map_with_meta ~kind ?doc ?enc_meta dec
733
685
734
686
let check_name_unicity m =
735
687
let add n kind = function
···
758
710
in
759
711
loop String_map.empty m
760
712
761
-
let finish mems =
713
+
let seal mems =
762
714
let () = check_name_unicity mems in
763
715
Object { mems with mem_encs = List.rev mems.mem_encs }
764
716
···
768
720
769
721
(* Members *)
770
722
771
-
module Mem = struct
723
+
module Member = struct
772
724
type ('o, 'a) map = ('o, 'a) mem_map
773
725
774
726
let no_enc name =
···
791
743
{ object_map with dec; mem_decs; mem_encs }
792
744
end
793
745
794
-
let mem ?(doc = "") ?dec_absent ?enc ?enc_omit name type' map =
795
-
let mmap = Mem.map ~doc ?dec_absent ?enc ?enc_omit name type' in
746
+
let member ?(doc = "") ?dec_absent ?enc ?enc_omit name type' map =
747
+
let mmap = Member.map ~doc ?dec_absent ?enc ?enc_omit name type' in
796
748
let mem_decs = String_map.add name (Mem_dec mmap) map.mem_decs in
797
749
let mem_encs = Mem_enc mmap :: map.mem_encs in
798
750
let dec = Dec_app (map.dec, mmap.id) in
799
751
{ map with dec; mem_decs; mem_encs }
800
752
801
-
let opt_mem ?doc ?enc:e name dom map =
753
+
let opt_member ?doc ?enc:e name dom map =
802
754
let dec = Option.some and enc = Option.get in
803
755
let some = Map { kind = ""; doc = ""; dom; dec; enc } in
804
-
mem ?doc ~dec_absent:None ?enc:e ~enc_omit:Option.is_none name some map
756
+
member ?doc ~dec_absent:None ?enc:e ~enc_omit:Option.is_none name some map
805
757
806
758
(* Case objects *)
807
759
···
823
775
824
776
let check_case_mem map cases ~dec_absent ~tag_compare ~tag_to_string =
825
777
match map.shape with
826
-
| Object_cases _ -> invalid_arg "Multiple calls to Json.Object.case_mem"
778
+
| Object_cases _ ->
779
+
invalid_arg "Multiple calls to Json.Object.case_member"
827
780
| _ -> (
828
781
match dec_absent with
829
782
| None -> ()
···
845
798
in
846
799
{ name; doc; type'; id; dec_absent; enc; enc_omit }
847
800
848
-
let case_mem ?doc ?(tag_compare = Stdlib.compare) ?tag_to_string ?dec_absent
849
-
?enc ?enc_omit ?enc_case name type' cases map =
801
+
let case_member ?doc ?(tag_compare = Stdlib.compare) ?tag_to_string
802
+
?dec_absent ?enc ?enc_omit ?enc_case name type' cases map =
850
803
let () =
851
804
check_case_mem map cases ~dec_absent ~tag_compare ~tag_to_string
852
805
in
853
806
let tag = case_tag_mem ?doc name type' ~dec_absent ~enc_omit in
854
-
let enc = match enc with None -> Mem.no_enc name | Some e -> e in
807
+
let enc = match enc with None -> Member.no_enc name | Some e -> e in
855
808
let enc_case =
856
809
match enc_case with
857
810
| Some enc_case -> enc_case
···
868
821
869
822
(* Unknown members *)
870
823
871
-
module Mems = struct
824
+
module Members = struct
872
825
type ('mems, 'a) enc = {
873
826
enc :
874
827
'acc.
···
877
830
878
831
type ('mems, 'a, 'builder) map = ('mems, 'a, 'builder) mems_map
879
832
880
-
let mems_kind kind = Sort.kinded' ~kind "members map"
833
+
let mems_kind kind = Sort.kinded_string ~kind "members map"
881
834
882
835
let map ?(kind = "") ?(doc = "") ?dec_empty ?dec_add ?dec_finish ?enc
883
836
mems_type =
···
931
884
{ map with shape = set_shape_unknown_mems map.shape Unknown_error }
932
885
933
886
let mems_noenc (mems : (_, _, _) mems_map) _o =
934
-
let kind = Sort.kinded' ~kind:mems.kind "members" in
887
+
let kind = Sort.kinded_string ~kind:mems.kind "members" in
935
888
Error.no_encoder Meta.none ~kind
936
889
937
890
let keep_unknown ?enc mems (map : ('o, 'dec) object_map) =
···
940
893
let unknown = Unknown_keep (mems, enc) in
941
894
{ map with dec; shape = set_shape_unknown_mems map.shape unknown }
942
895
943
-
let zero = finish (map ~kind:"zero" ())
896
+
let zero = seal (map ~kind:"zero" ())
944
897
945
898
let as_string_map ?kind ?doc t =
946
899
map ?kind ?doc Fun.id
947
-
|> keep_unknown (Mems.string_map t) ~enc:Fun.id
948
-
|> finish
900
+
|> keep_unknown (Members.string_map t) ~enc:Fun.id
901
+
|> seal
949
902
end
950
903
951
904
(* Ignoring *)
···
1030
983
let dec_add meta n v mems = ((n, meta), v) :: mems in
1031
984
let dec_finish _meta mems = List.rev mems in
1032
985
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
986
+
let enc = { Object.Members.enc } in
987
+
Object.Members.map ~dec_empty ~dec_add ~dec_finish ~enc elt
1035
988
end
1036
989
and object' =
1037
990
lazy begin
···
1046
999
Error.sort (Value.meta j) ~exp:Sort.Object ~fnd:(Value.sort j)
1047
1000
in
1048
1001
let dec meta mems : Value.t = Value.Object (mems, meta) in
1049
-
Object.map' dec ~enc_meta
1002
+
Object.map_with_meta dec ~enc_meta
1050
1003
|> Object.keep_unknown (Lazy.force mems) ~enc
1051
-
|> Object.finish
1004
+
|> Object.seal
1052
1005
end
1053
1006
and any =
1054
1007
lazy begin
···
1093
1046
List.fold_left (fun acc ((n, m), v) -> f m n v acc) acc ms
1094
1047
| j -> Error.sort (Value.meta j) ~exp:Sort.Object ~fnd:(Value.sort j)
1095
1048
in
1096
-
let enc = { Object.Mems.enc } in
1097
-
Object.Mems.map ~dec_empty ~dec_add ~dec_finish ~enc t
1049
+
let enc = { Object.Members.enc } in
1050
+
Object.Members.map ~dec_empty ~dec_add ~dec_finish ~enc t
1098
1051
end
1099
1052
1100
1053
(* Decode / encode between generic JSON and typed values using a codec.
···
1508
1461
1509
1462
let mem ?absent name t =
1510
1463
Object.map Fun.id
1511
-
|> Object.mem name t ~enc:Fun.id ?dec_absent:absent
1512
-
|> Object.finish
1464
+
|> Object.member name t ~enc:Fun.id ?dec_absent:absent
1465
+
|> Object.seal
1513
1466
1514
1467
let update_mem ?absent name t =
1515
1468
let update_mem n t v = (n, Ast.copy_layout v ~dst:(value_recode_exn t v)) in
···
1528
1481
| Either.Left acc -> (
1529
1482
match absent with
1530
1483
| None ->
1531
-
let fnd = Ast.object_names mems in
1484
+
let fnd = Ast.member_keys mems in
1532
1485
Error.missing_mems meta ~kinded_sort:"" ~exp:[ name ] ~fnd
1533
1486
| Some absent ->
1534
1487
let m = ((name, Meta.none), encode_exn t absent) in
···
1551
1504
let enc f (_, l) a =
1552
1505
List.fold_left (fun a ((n, m), v) -> f m n v a) a l
1553
1506
in
1554
-
let enc = { Object.Mems.enc } in
1555
-
Object.Mems.map ~dec_empty ~dec_add ~dec_finish ~enc Value.t
1507
+
let enc = { Object.Members.enc } in
1508
+
Object.Members.map ~dec_empty ~dec_add ~dec_finish ~enc Value.t
1556
1509
in
1557
1510
let enc_meta = function
1558
1511
| (Ast.Object (_, meta) : Ast.t) -> meta
···
1563
1516
| j -> error_sort ~exp:Sort.Object j
1564
1517
in
1565
1518
let dec meta (ok, mems) : Ast.t =
1566
-
let fnd = Ast.object_names mems in
1519
+
let fnd = Ast.member_keys mems in
1567
1520
if not ok then Error.missing_mems meta ~kinded_sort:"" ~exp:[ name ] ~fnd
1568
1521
else Ast.Object (List.rev mems, meta)
1569
1522
in
1570
-
Object.map' dec ~enc_meta |> Object.keep_unknown mems ~enc |> Object.finish
1523
+
Object.map_with_meta dec ~enc_meta
1524
+
|> Object.keep_unknown mems ~enc
1525
+
|> Object.seal
1571
1526
1572
1527
let delete_mem ?(allow_absent = false) name =
1573
1528
let dec_add meta n v (ok, mems) =
···
1582
1537
let mems =
1583
1538
let dec_empty () = acc and dec_add = f and dec_finish _meta acc = acc in
1584
1539
let enc _f _ acc = acc in
1585
-
Object.Mems.map t ~dec_empty ~dec_add ~dec_finish ~enc:{ Object.Mems.enc }
1540
+
Object.Members.map t ~dec_empty ~dec_add ~dec_finish
1541
+
~enc:{ Object.Members.enc }
1586
1542
in
1587
-
Object.map Fun.id |> Object.keep_unknown mems ~enc:Fun.id |> Object.finish
1543
+
Object.map Fun.id |> Object.keep_unknown mems ~enc:Fun.id |> Object.seal
1588
1544
1589
1545
let filter_map_object a b f =
1590
1546
let dec_add meta n v (_, mems) =
···
1684
1640
let decode_exn t j = Codec.decode_exn t j
1685
1641
let encode t v = Codec.encode t v
1686
1642
let encode_exn t v = Codec.encode_exn t v
1687
-
let error_sort = Codec.error_sort
1688
-
let error_type = Codec.error_type
1643
+
1644
+
let pp_value ?(number_format = Value.default_number_format) t () ppf v =
1645
+
match encode t v with
1646
+
| Ok j -> Value.pp' number_format ppf j
1647
+
| Error e -> Value.pp_string ppf (Error.to_string e)
1689
1648
1690
1649
(* Formatting *)
1691
1650
···
1696
1655
let format_of_args ~indent ~preserve =
1697
1656
if preserve then Layout
1698
1657
else match indent with None -> Minify | Some _ -> Indent
1699
-
1700
-
let pp_value ?number_format t () =
1701
-
fun ppf v ->
1702
-
match encode t v with
1703
-
| Ok j -> pp_json' ?number_format () ppf j
1704
-
| Error e -> pp_string ppf (Error.to_string e)
1705
1658
1706
1659
(* Tape *)
1707
1660
···
2839
2792
}
2840
2793
2841
2794
let encoder ?buf ?indent ?(preserve = false)
2842
-
?(number_format = default_number_format) writer =
2795
+
?(number_format = Ast.default_number_format) writer =
2843
2796
let format = format_of_args ~indent ~preserve in
2844
2797
let o =
2845
2798
match buf with
···
3171
3124
Buffer.contents b
3172
3125
3173
3126
module Value = struct
3127
+
include Ast
3128
+
3174
3129
let of_string ?layout ?locs ?file s =
3175
3130
of_string ?layout ?locs ?file Codec.Value.t s
3176
3131
+76
-219
lib/json.mli
+76
-219
lib/json.mli
···
130
130
131
131
(** {1:types Generic JSON values}
132
132
133
-
The AST for JSON values is exposed at the top level of this module. Each
134
-
constructor carries its source metadata as an {{!Meta}[Meta.t]} node. *)
133
+
The AST lives in {!module-Value}. Types are re-exported at the top level so
134
+
callers can write [Json.t] without reaching into [Json.Value]. *)
135
135
136
-
type name = string node
136
+
type name = Value.name
137
137
(** The type for JSON member names. *)
138
138
139
-
type mem = name * t
139
+
type member = Value.member
140
140
(** The type for generic JSON object members. *)
141
141
142
-
and object' = mem list
142
+
type object' = Value.object'
143
143
(** The type for generic JSON objects. *)
144
144
145
145
(** The type for generic JSON values. *)
146
-
and t = Value.t =
146
+
type t = Value.t =
147
147
| Null of unit node
148
148
| Bool of bool node
149
149
| Number of float node
···
153
153
| Array of t list node
154
154
| Object of object' node (** *)
155
155
156
-
type 'a codec = 'a Codec.t
157
-
(** The type for JSON types.
158
-
159
-
A value of this type represents a subset of JSON values mapped to a subset
160
-
of values of type ['a] and vice versa. *)
161
-
162
-
(** {1:constructors Value constructors}
163
-
164
-
Construct generic JSON {!t} values. Each constructor accepts an optional
165
-
[meta] (defaults to {!Meta.none}). *)
166
-
167
-
type 'a cons = ?meta:Meta.t -> 'a -> t
168
-
(** The type for constructing JSON values from an OCaml value of type ['a]. *)
169
-
170
-
val null : unit cons
171
-
(** [null ()] is [Null ((), meta)]. *)
172
-
173
-
val bool : bool cons
174
-
(** [bool b] is [Bool (b, meta)]. *)
175
-
176
-
val number : float cons
177
-
(** [number n] is [Number (n, meta)]. *)
178
-
179
-
val any_float : float cons
180
-
(** [any_float v] is [number v] if {{!Float.is_finite}[Float.is_finite v]} and
181
-
[string (Float.to_string v)] otherwise. See {!Codec.any_float}. *)
182
-
183
-
val int32 : int32 cons
184
-
(** [int32] encodes OCaml's int32 into a JSON number. *)
185
-
186
-
val int64 : int64 cons
187
-
(** [int64] encodes OCaml's int64 into a JSON number, or into a JSON string when
188
-
outside \[-2{^ 53};2{^ 53}\]. See also {!int64_as_string}. *)
189
-
190
-
val int64_as_string : int64 cons
191
-
(** [int64_as_string] encodes OCaml's int64 into a JSON string. See also
192
-
{!int64}. *)
193
-
194
-
val int : int cons
195
-
(** [int] encodes OCaml's int into a JSON number, or into a JSON string when
196
-
outside \[-2{^ 53};2{^ 53}\]. See also {!int_as_string}. *)
197
-
198
-
val int_as_string : int cons
199
-
(** [int_as_string] encodes OCaml's int into a JSON string. See also {!int}. *)
200
-
201
-
val string : string cons
202
-
(** [string s] is [String (s, meta)]. *)
203
-
204
-
val list : t list cons
205
-
(** [list l] is [Array (l, meta)]. *)
206
-
207
-
val array : t array cons
208
-
(** [array a] is [Array (Array.to_list a, meta)]. See also {!list}. *)
209
-
210
-
val object' : mem list cons
211
-
(** [object' mems] is [Object (mems, meta)]. *)
212
-
213
-
val empty_array : t
214
-
(** [empty_array] is an empty JSON array with {!Meta.none}. *)
215
-
216
-
val empty_object : t
217
-
(** [empty_object] is an empty JSON object with {!Meta.none}. *)
218
-
219
-
val option : 'a cons -> 'a option cons
220
-
(** [option c] constructs [Some v] values with [c v] and [None] ones with
221
-
{!val-null}. *)
222
-
223
-
val name : ?meta:Meta.t -> string -> name
224
-
(** [name ?meta n] is [(n, meta)]. [meta] defaults to {!Meta.none}. *)
225
-
226
-
val mem : name -> t -> mem
227
-
(** [mem n v] is [(n, v)]. *)
228
-
229
-
val zero : ?meta:Meta.t -> t -> t
230
-
(** [zero j] is a stub value of the sort value of [j]. The stub value is the
231
-
"natural" zero: null, false, 0, empty string, empty array, empty object. *)
232
-
233
-
(** {1:destructors Value destructors and queries} *)
234
-
235
-
val find_mem : string -> mem list -> mem option
236
-
(** [find_mem n ms] finds the first member whose name matches [n] in [ms]. *)
237
-
238
-
val find_mem' : name -> mem list -> mem option
239
-
(** [find_mem' n ms] is [find_mem (fst n) ms]. *)
240
-
241
-
val object_names : mem list -> string list
242
-
(** [object_names ms] are the names of [ms]. *)
243
-
244
-
val object_names' : mem list -> name list
245
-
(** [object_names' ms] are the names of [ms] as {!name} nodes. *)
246
-
247
-
val meta : t -> Meta.t
248
-
(** [meta v] is the metadata of value [v]. *)
249
-
250
-
val set_meta : Meta.t -> t -> t
251
-
(** [set_meta m v] replaces [v]'s meta with [m]. *)
252
-
253
-
val copy_layout : t -> dst:t -> t
254
-
(** [copy_layout src ~dst] copies the layout of [src] and sets it on [dst] using
255
-
{!Meta.copy_ws}. *)
256
-
257
-
val sort : t -> Sort.t
258
-
(** [sort v] is the sort of value [v]. *)
156
+
type number_format = Value.number_format
157
+
(** The type for JSON number formatters. *)
259
158
260
-
(** {1:compare Equality and ordering} *)
261
-
262
-
val equal : t -> t -> bool
263
-
(** [equal j0 j1] is {!compare}[ j0 j1 = 0]. *)
264
-
265
-
val compare : t -> t -> int
266
-
(** [compare j0 j1] is a total order on JSON values:
267
-
- Floating point values are compared with {!Float.compare}, this means NaN
268
-
values are equal.
269
-
- Strings are compared byte wise.
270
-
- Objects members are sorted before being compared.
271
-
- {!Meta.t} values are ignored. *)
159
+
type 'a codec = 'a Codec.t
160
+
(** The type for JSON codecs: a bidirectional map between JSON values and OCaml
161
+
values. Build codecs with {!module-Codec}. *)
272
162
273
163
val pp : t Fmt.t
274
-
(** [pp] is {!pp_json}. *)
275
-
276
-
(** {1:decode_generic Decode, encode and recode}
277
-
278
-
Convert between generic JSON values {!t} and typed values via a
279
-
{{!codec}codec}. *)
280
-
281
-
val decode : 'a codec -> t -> ('a, Error.t) result
282
-
(** [decode t j] decodes a value from the generic JSON [j] according to codec
283
-
[t]. *)
284
-
285
-
val decode_exn : 'a codec -> t -> 'a
286
-
(** [decode_exn] is like {!val-decode} but raises {!Json.exception-Error}. *)
287
-
288
-
val encode : 'a codec -> 'a -> (t, Error.t) result
289
-
(** [encode t v] encodes a generic JSON value for [v] according to codec [t]. *)
290
-
291
-
val encode_exn : 'a codec -> 'a -> t
292
-
(** [encode_exn] is like {!val-encode} but raises {!Json.exception-Error}. *)
293
-
294
-
val error_sort : exp:Sort.t -> t -> 'a
295
-
(** [error_sort ~exp fnd] errors when sort [exp] was expected but generic JSON
296
-
[fnd] was found. *)
297
-
298
-
val error_type : 'a codec -> t -> 'a
299
-
(** [error_type t fnd] errors when the type expected by [t] does not match
300
-
[fnd]. *)
301
-
302
-
(** {1:formatting Formatting} *)
303
-
304
-
type number_format = (float -> unit, Format.formatter, unit) Stdlib.format
305
-
(** The type for JSON number formatters. *)
306
-
307
-
val default_number_format : number_format
308
-
(** [default_number_format] is ["%.17g"]. This number formats ensures that
309
-
finite floating point values can be interchanged without loss of precision.
310
-
*)
311
-
312
-
val pp_null : unit Fmt.t
313
-
(** [pp_null] formats a JSON null. *)
314
-
315
-
val pp_bool : bool Fmt.t
316
-
(** [pp_bool] formats a JSON bool. *)
317
-
318
-
val pp_number : float Fmt.t
319
-
(** [pp_number] formats a JSON number of a JSON null if the float is not finite.
320
-
Uses the {!default_number_format}. *)
321
-
322
-
val pp_number' : number_format -> float Fmt.t
323
-
(** [pp_number' fmt] is like {!pp_number} but uses [fmt] to format the number.
324
-
*)
325
-
326
-
val pp_string : string Fmt.t
327
-
(** [pp_string] formats a JSON string (quoted and escaped). Assumes the string
328
-
is valid UTF-8. *)
329
-
330
-
val pp_json : t Fmt.t
331
-
(** [pp_json] formats JSON, see {!pp_json'}. *)
332
-
333
-
val pp_json' : ?number_format:number_format -> unit -> t Fmt.t
334
-
(** [pp_json'] formats JSON like {!pp_json} with a configurable [number_format].
335
-
The output is indented but may be more compact than an [Indent] JSON encoder
336
-
does (arrays may be output on one line if they fit, etc). Non-finite numbers
337
-
print as JSON nulls; strings are assumed to be valid UTF-8. *)
164
+
(** [pp] formats JSON values. Alias of {!Value.pp}. *)
338
165
339
166
val pp_value : ?number_format:number_format -> 'a codec -> unit -> 'a Fmt.t
340
-
(** [pp_value t ()] formats the JSON representation of values as described by
341
-
[t] by encoding it with {!val-encode} and formatting it with {!pp_json'}. If
342
-
the encoding of the value errors a JSON string with the error message is
343
-
formatted. This means that {!pp_value} should always format valid JSON text.
344
-
*)
167
+
(** [pp_value c ()] formats values of type ['a] by encoding them with codec [c]
168
+
and pretty-printing the resulting JSON. A codec error is formatted as a JSON
169
+
string carrying the error message, so this function always produces valid
170
+
JSON. *)
345
171
346
172
(** {1:codec Codec combinators}
347
173
···
821
647
{!val-keep_unknown}. This is needed for decoding. Use {!enc_only} if
822
648
the result is only used for encoding. *)
823
649
824
-
val map' :
650
+
val map_with_meta :
825
651
?kind:string ->
826
652
?doc:string ->
827
653
?enc_meta:('o -> Meta.t) ->
828
654
(Meta.t -> 'dec) ->
829
655
('o, 'dec) map
830
-
(** [map' dec] is like {!val-map} except you get the object's decoding
831
-
metdata in [dec] and [enc_meta] is used to recover it on encoding. *)
656
+
(** [map_with_meta dec] is like {!val-map} except [dec] receives the
657
+
object's decoding metadata and [?enc_meta] is used to recover it on
658
+
encoding. *)
832
659
833
660
val enc_only :
834
661
?kind:string ->
···
838
665
('o, 'a) map
839
666
(** [enc_only ()] is like {!val-map'} but can only be used for encoding. *)
840
667
841
-
val finish : ('o, 'o) map -> 'o t
668
+
val seal : ('o, 'o) map -> 'o t
842
669
(** [finish map] is a JSON type for objects mapped by [map]. Raises
843
670
[Invalid_argument] if [map] describes a member name more than once. *)
844
671
···
846
673
847
674
(** Member maps.
848
675
849
-
Usually it's better to use {!Json.Codec.Object.mem} or
850
-
{!Json.Codec.Object.opt_mem} directly. But this may be useful in certain
851
-
abstraction contexts. *)
852
-
module Mem : sig
676
+
Usually it's better to use {!Json.Codec.Object.member} or
677
+
{!Json.Codec.Object.opt_member} directly. But this may be useful in
678
+
certain abstraction contexts. *)
679
+
module Member : sig
853
680
type ('o, 'dec) object_map := ('o, 'dec) map
854
681
855
682
type ('o, 'a) map
···
864
691
string ->
865
692
'a codec ->
866
693
('o, 'a) map
867
-
(** See {!Json.Codec.Object.mem}. *)
694
+
(** See {!Json.Codec.Object.member}. *)
868
695
869
696
val app : ('o, 'a -> 'b) object_map -> ('o, 'a) map -> ('o, 'b) object_map
870
697
(** [app map mmap] applies the member map [mmap] to the contructor of the
···
872
699
the object described by [map]. *)
873
700
end
874
701
875
-
val mem :
702
+
val member :
876
703
?doc:string ->
877
704
?dec_absent:'a ->
878
705
?enc:('o -> 'a) ->
···
881
708
'a codec ->
882
709
('o, 'a -> 'b) map ->
883
710
('o, 'b) map
884
-
(** [mem name t map] is a member named [name] of type [t] for an object of
885
-
type ['o] being constructed by [map].
711
+
(** [member name t map] is a member named [name] of type [t] for an object
712
+
of type ['o] being constructed by [map].
886
713
- [doc] is a documentation string for the member. Defaults to [""].
887
714
- [dec_absent], if specified, is the value used for the decoding
888
715
direction when the member named [name] is missing. If unspecified
···
894
721
by [enc] returns [true] on [enc_omit], the member is omited in the
895
722
encoded JSON object. Defaults to [Fun.const false]. *)
896
723
897
-
val opt_mem :
724
+
val opt_member :
898
725
?doc:string ->
899
726
?enc:('o -> 'a option) ->
900
727
string ->
901
728
'a codec ->
902
729
('o, 'a option -> 'b) map ->
903
730
('o, 'b) map
904
-
(** [opt_mem name t map] is:
731
+
(** [opt_member name t map] is:
905
732
{[
906
733
let dec_absent = None and enc_omit = Option.is_none in
907
-
Json.Codec.Object.mem name (Json.Codec.some t) map ~dec_absent ~enc_omit
734
+
Json.Codec.Object.member name (Json.Codec.some t) map ~dec_absent
735
+
~enc_omit
908
736
]} *)
909
737
910
738
(** {1:cases Case objects}
···
955
783
(** [value map v] is a case value [v] described by [map]. *)
956
784
end
957
785
958
-
val case_mem :
786
+
val case_member :
959
787
?doc:string ->
960
788
?tag_compare:('tag -> 'tag -> int) ->
961
789
?tag_to_string:('tag -> string) ->
···
968
796
('cases, 'tag) Case.t list ->
969
797
('o, 'cases -> 'a) map ->
970
798
('o, 'a) map
971
-
(** [case_mem name t cases map] is mostly like {!val-mem} except the member
972
-
[name] selects an object representation according to the member value of
973
-
type [t]. See {!Json.Codec.Object.case_mem} for details. *)
799
+
(** [case_member name t cases map] is mostly like {!val-member} except the
800
+
member [name] selects an object representation according to the member
801
+
value of type [t]. *)
974
802
975
803
(** {1:unknown_members Unknown members}
976
804
977
805
Read the {{!page-cookbook.unknown_members}cookbook}. *)
978
806
979
807
(** Uniform members. *)
980
-
module Mems : sig
808
+
module Members : sig
981
809
(** {1:maps Maps} *)
982
810
983
811
type 'a codec := 'a codec
···
1022
850
1023
851
val keep_unknown :
1024
852
?enc:('o -> 'mems) ->
1025
-
('mems, _, _) Mems.map ->
853
+
('mems, _, _) Members.map ->
1026
854
('o, 'mems -> 'a) map ->
1027
855
('o, 'a) map
1028
856
(** [keep_unknown mems map] makes [map] keep unknown member with [mems]. *)
···
1084
912
(** [iter ?enc dec t] applies [dec] on decoding and [enc] on encoding but
1085
913
otherwise behaves like [t] does. *)
1086
914
1087
-
val rec' : 'a t Lazy.t -> 'a t
1088
-
(** [rec'] maps recursive JSON values. *)
915
+
val fix : 'a t Lazy.t -> 'a t
916
+
(** [fix] maps recursive JSON values. *)
1089
917
1090
918
(** {1:ignoring Ignoring} *)
1091
919
···
1131
959
(** [object'] decodes JSON objects to {!Object} and encodes {!Object}
1132
960
values. *)
1133
961
1134
-
val mems : (value, value, mem list) Object.Mems.map
1135
-
(** [mems] is a {!Object.Mems.map} for the generic {!mem list} type. *)
962
+
val mems : (value, value, member list) Object.Members.map
963
+
(** [mems] is a {!Object.Members.map} for the generic {!member list} type.
964
+
*)
1136
965
end
1137
966
1138
967
(** {1:low Low-level representation}
···
1481
1310
1482
1311
open Bytesrw
1483
1312
1313
+
(** {1:decode_generic Decode and encode over {!t}}
1314
+
1315
+
Convert between generic JSON values {!t} and typed values via a codec. These
1316
+
are the pure form: the heavy IO (reading from bytes, writing to bytes) is in
1317
+
{{!section:decode}Decode} / {{!section:encode}Encode} below. *)
1318
+
1319
+
val decode : 'a codec -> t -> ('a, Error.t) result
1320
+
(** [decode c j] decodes [j] as a value of type ['a] according to codec [c]. *)
1321
+
1322
+
val decode_exn : 'a codec -> t -> 'a
1323
+
(** [decode_exn] is like {!val-decode} but raises {!Json.exception-Error}. *)
1324
+
1325
+
val encode : 'a codec -> 'a -> (t, Error.t) result
1326
+
(** [encode c v] encodes OCaml value [v] as a generic JSON value according to
1327
+
codec [c]. *)
1328
+
1329
+
val encode_exn : 'a codec -> 'a -> t
1330
+
(** [encode_exn] is like {!val-encode} but raises {!Json.exception-Error}. *)
1331
+
1484
1332
(** {1:decode Decode} *)
1485
1333
1486
1334
val of_reader :
···
1576
1424
{{:https://262.ecma-international.org/6.0/#sec-internalizejsonproperty}
1577
1425
[JSON.parse]} and the last one takes over, however duplicate members all
1578
1426
have to parse with the specified type as we error as soon as possible. Also
1579
-
{{!Json.Object.case_mem}case members} are not allowed to duplicate. *)
1427
+
{{!Json.Object.case_member}case members} are not allowed to duplicate. *)
1580
1428
1581
1429
(** {1:value_api Generic value API}
1582
1430
1583
-
Convenience entry points for the generic JSON AST {!t}: skip the codec
1584
-
argument, use {!Codec.Value.t} implicitly. For typed values use the
1585
-
codec-taking forms at the top level. *)
1431
+
{!module-Value} is the AST layer: constructors, queries, pretty-printers,
1432
+
plus convenience I/O entry points (skip the codec argument, the identity
1433
+
codec is used). For typed values use the codec-taking forms at the top
1434
+
level. *)
1586
1435
1587
1436
module Value : sig
1437
+
include module type of Value with type t = t and type name = name
1438
+
1439
+
(** {1:io_value Byte-level I/O for the AST}
1440
+
1441
+
These are shortcuts over the top-level {!Json.val-of_string},
1442
+
{!Json.val-to_string}, etc., using the identity codec ({!Codec.Value.t}).
1443
+
*)
1444
+
1588
1445
val of_string :
1589
1446
?layout:bool ->
1590
1447
?locs:bool ->
+2
-2
lib/sort.ml
+2
-2
lib/sort.ml
···
15
15
| Array -> "array"
16
16
| Object -> "object"
17
17
18
-
let kinded' ~kind:k s = if k = "" then s else String.concat " " [ k; s ]
19
-
let kinded ~kind sort = kinded' ~kind (to_string sort)
18
+
let kinded_string ~kind:k s = if k = "" then s else String.concat " " [ k; s ]
19
+
let kinded ~kind sort = kinded_string ~kind (to_string sort)
20
20
let or_kind ~kind sort = if kind <> "" then kind else to_string sort
21
21
let pp ppf s = Fmt.code ppf (to_string s)
+4
-4
lib/sort.mli
+4
-4
lib/sort.mli
···
21
21
val to_string : t -> string
22
22
(** [to_string sort] is the lowercase JSON name of [sort]. *)
23
23
24
-
val kinded' : kind:string -> string -> string
25
-
(** [kinded' ~kind s] is [s] when [kind] is empty, [kind] followed by a space
26
-
and [s] otherwise. *)
24
+
val kinded_string : kind:string -> string -> string
25
+
(** [kinded_string ~kind s] is [s] when [kind] is empty, [kind] followed by a
26
+
space and [s] otherwise. *)
27
27
28
28
val kinded : kind:string -> t -> string
29
-
(** [kinded ~kind sort] is {!kinded'} applied to [to_string sort]. *)
29
+
(** [kinded ~kind sort] is {!kinded_string} applied to [to_string sort]. *)
30
30
31
31
val or_kind : kind:string -> t -> string
32
32
(** [or_kind ~kind sort] is [kind] if non-empty, [to_string sort] otherwise. *)
+10
-12
lib/value.ml
+10
-12
lib/value.ml
···
5
5
type 'a node = 'a * Meta.t
6
6
type name = string node
7
7
8
-
type mem = name * t
9
-
and object' = mem list
8
+
type member = name * t
9
+
and object' = member list
10
10
11
11
and t =
12
12
| Null of unit node
···
30
30
31
31
let default_number_format = Core.Fmt.json_default_number_format
32
32
33
-
let pp_json' ?(number_format = default_number_format) () ppf j =
33
+
let pp' number_format ppf j =
34
34
let pp_indent = 2 in
35
35
let pp_sep ppf () =
36
36
Fmt.char ppf ',';
···
68
68
in
69
69
pp_value ppf j
70
70
71
-
let pp_json ppf j = pp_json' () ppf j
72
-
let pp = pp_json
71
+
let pp ppf j = pp' default_number_format ppf j
73
72
74
73
(* Metadata *)
75
74
···
157
156
let array ?(meta = Meta.none) a = Array (Stdlib.Array.to_list a, meta)
158
157
let empty_array = list []
159
158
let name ?(meta = Meta.none) n = (n, meta)
160
-
let mem n v = (n, v)
161
159
let object' ?(meta = Meta.none) mems = Object (mems, meta)
162
160
let empty_object = object' []
161
+
let member n j = (n, j)
163
162
164
-
let rec find_mem n = function
163
+
let rec member_key k = function
165
164
| [] -> None
166
-
| (((n', _), _) as m) :: ms ->
167
-
if String.equal n n' then Some m else find_mem n ms
165
+
| (((k', _), _) as m) :: ms ->
166
+
if String.equal k k' then Some m else member_key k ms
168
167
169
-
let find_mem' (n, _) ms = find_mem n ms
170
-
let object_names mems = List.map (fun ((n, _), _) -> n) mems
171
-
let object_names' mems = List.map fst mems
168
+
let member_names mems = List.map fst mems
169
+
let member_keys mems = List.map (fun ((n, _), _) -> n) mems
172
170
173
171
let zero ?meta j =
174
172
match sort j with
+24
-30
lib/value.mli
+24
-30
lib/value.mli
···
15
15
type name = string node
16
16
(** A JSON member name (string plus its source location). *)
17
17
18
-
type mem = name * t
18
+
type member = name * t
19
19
(** A JSON object member: a name bound to a value. *)
20
20
21
-
and object' = mem list
21
+
and object' = member list
22
22
(** A JSON object: an ordered list of members. *)
23
23
24
24
and t =
···
102
102
val array : t array cons
103
103
(** [array a] is a JSON array. *)
104
104
105
-
val object' : mem list cons
105
+
val object' : member list cons
106
106
(** [object' mems] is a JSON object with the given members in order. *)
107
107
108
108
val empty_array : t
···
114
114
val name : ?meta:Meta.t -> string -> name
115
115
(** [name ?meta s] is a member name node. *)
116
116
117
-
val mem : name -> t -> mem
118
-
(** [mem n v] is the member [(n, v)]. *)
117
+
val member : name -> t -> member
118
+
(** [member n j] is the member [(n, j)]. *)
119
119
120
-
(** {1:object Object operations} *)
120
+
(** {1:members Object-member queries} *)
121
121
122
-
val find_mem : string -> mem list -> mem option
123
-
(** [find_mem n mems] is the first member in [mems] whose name is [n], if any.
124
-
*)
122
+
val member_key : string -> member list -> member option
123
+
(** [member_key k mems] is the first member in [mems] whose name matches the
124
+
bare string [k], if any. Callers holding a {!type-name} node unwrap the
125
+
string with [fst]. *)
125
126
126
-
val find_mem' : name -> mem list -> mem option
127
-
(** [find_mem' n mems] is [find_mem (fst n) mems]. *)
128
-
129
-
val object_names : mem list -> string list
130
-
(** [object_names mems] is the list of member names in order. *)
127
+
val member_names : member list -> name list
128
+
(** [member_names mems] is the list of member names (as {!type-name} nodes) in
129
+
order. *)
131
130
132
-
val object_names' : mem list -> name list
133
-
(** [object_names' mems] is like {!object_names} but preserves the {!name}
134
-
metadata. *)
131
+
val member_keys : member list -> string list
132
+
(** [member_keys mems] is the list of member names as bare strings in order. *)
135
133
136
134
(** {1:zero Zero values} *)
137
135
···
150
148
val pp_string : string Fmt.t
151
149
(** [pp_string] prints a JSON-escaped double-quoted string. *)
152
150
153
-
val pp_number : float Fmt.t
154
-
(** [pp_number] prints a JSON number using {!default_number_format}; a
155
-
non-finite float prints as [null]. *)
156
-
157
151
type number_format = Core.Fmt.json_number_format
158
-
(** The type for number format strings used by {!pp_number'}. *)
152
+
(** The type for number format strings used by {!pp_number'} and {!pp'}. *)
159
153
160
154
val default_number_format : number_format
161
155
(** [default_number_format] is [%.17g] (round-trips any [float] exactly). *)
162
156
157
+
val pp_number : float Fmt.t
158
+
(** [pp_number] prints a JSON number using {!default_number_format}. *)
159
+
163
160
val pp_number' : number_format -> float Fmt.t
164
-
(** [pp_number' fmt] is {!pp_number} using [fmt]. *)
165
-
166
-
val pp_json : t Fmt.t
167
-
(** [pp_json] formats a JSON value with {!default_number_format}. *)
168
-
169
-
val pp_json' : ?number_format:number_format -> unit -> t Fmt.t
170
-
(** [pp_json'] is like {!pp_json} with configurable number formatting. *)
161
+
(** [pp_number' fmt] is like {!pp_number} but with an explicit [fmt]. *)
171
162
172
163
val pp : t Fmt.t
173
-
(** [pp] is {!pp_json}. *)
164
+
(** [pp] formats a JSON value using {!default_number_format}. *)
165
+
166
+
val pp' : number_format -> t Fmt.t
167
+
(** [pp' fmt] is like {!pp} but formats numbers with [fmt]. *)
+3
-3
test/bytesrw/test_json_bytesrw.ml
+3
-3
test/bytesrw/test_json_bytesrw.ml
···
14
14
let pair_codec =
15
15
let open Json.Codec.Object in
16
16
map ~kind:"pair" (fun a b -> (a, b))
17
-
|> mem "a" Json.Codec.int ~enc:fst
18
-
|> mem "b" Json.Codec.string ~enc:snd
19
-
|> finish
17
+
|> member "a" Json.Codec.int ~enc:fst
18
+
|> member "b" Json.Codec.string ~enc:snd
19
+
|> seal
20
20
in
21
21
let input = {|{"a": 7, "b": "hi"}|} in
22
22
match Json.of_string pair_codec input with
+51
-47
test/codecs/cookbook.ml
+51
-47
test/codecs/cookbook.ml
···
6
6
(* Dealing with null values. *)
7
7
8
8
let string_null_is_empty =
9
-
let null = Json.null "" in
10
-
let enc = function "" -> null | _ -> Json.string in
11
-
Json.any ~dec_null:null ~dec_string:Json.string ~enc ()
9
+
let null = Json.Value.null "" in
10
+
let enc = function "" -> null | _ -> Json.Value.string in
11
+
Json.any ~dec_null:null ~dec_string:Json.Value.string ~enc ()
12
12
13
13
(* Base maps *)
14
14
···
44
44
45
45
let jsont =
46
46
Json.Object.map ~kind:"Person" make
47
-
|> Json.Object.mem "name" Json.string ~enc:name
48
-
|> Json.Object.mem "age" Json.int ~enc:age
49
-
|> Json.Object.finish
47
+
|> Json.Object.member "name" Json.Value.string ~enc:name
48
+
|> Json.Object.member "age" Json.Value.int ~enc:age
49
+
|> Json.Object.seal
50
50
end
51
51
52
52
(* Objects as key-value maps *)
···
56
56
let map : ?kind:string -> 'a Json.codec -> 'a String_map.t Json.codec =
57
57
fun ?kind t ->
58
58
Json.Object.map ?kind Fun.id
59
-
|> Json.Object.keep_unknown (Json.Object.Mems.string_map t) ~enc:Fun.id
60
-
|> Json.Object.finish
59
+
|> Json.Object.keep_unknown (Json.Object.Members.string_map t) ~enc:Fun.id
60
+
|> Json.Object.seal
61
61
62
62
(* Optional members *)
63
63
···
70
70
71
71
let jsont =
72
72
Json.Object.map ~kind:"Person" make
73
-
|> Json.Object.mem "name" Json.string ~enc:name
74
-
|> Json.Object.mem "age"
73
+
|> Json.Object.member "name" Json.Value.string ~enc:name
74
+
|> Json.Object.member "age"
75
75
Json.(some int)
76
76
~dec_absent:None ~enc_omit:Option.is_none ~enc:age
77
-
|> Json.Object.finish
77
+
|> Json.Object.seal
78
78
end
79
79
80
80
(* Unknown object members *)
···
88
88
89
89
let jsont =
90
90
Json.Object.map ~kind:"Person" make
91
-
|> Json.Object.mem "name" Json.string ~enc:name
92
-
|> Json.Object.mem "age" Json.int ~enc:age
93
-
|> Json.Object.error_unknown |> Json.Object.finish
91
+
|> Json.Object.member "name" Json.Value.string ~enc:name
92
+
|> Json.Object.member "age" Json.Value.int ~enc:age
93
+
|> Json.Object.error_unknown |> Json.Object.seal
94
94
end
95
95
96
96
module Person_keep = struct
···
103
103
104
104
let jsont =
105
105
Json.Object.map ~kind:"Person" make
106
-
|> Json.Object.mem "name" Json.string ~enc:name
107
-
|> Json.Object.mem "age" Json.int ~enc:age
106
+
|> Json.Object.member "name" Json.Value.string ~enc:name
107
+
|> Json.Object.member "age" Json.Value.int ~enc:age
108
108
|> Json.Object.keep_unknown Json.json_mems ~enc:unknown
109
-
|> Json.Object.finish
109
+
|> Json.Object.seal
110
110
end
111
111
112
112
(* Dealing with recursive JSON *)
···
122
122
let rec t =
123
123
lazy
124
124
(Json.Object.map ~kind:"Tree" make
125
-
|> Json.Object.mem "value" value_type ~enc:value
126
-
|> Json.Object.mem "children" (Json.list (Json.rec' t)) ~enc:children
127
-
|> Json.Object.finish)
125
+
|> Json.Object.member "value" value_type ~enc:value
126
+
|> Json.Object.member "children"
127
+
(Json.Value.list (Json.fix t))
128
+
~enc:children
129
+
|> Json.Object.seal)
128
130
in
129
131
Lazy.force t
130
132
end
···
141
143
142
144
let jsont =
143
145
Json.Object.map ~kind:"Circle" make
144
-
|> Json.Object.mem "name" Json.string ~enc:name
145
-
|> Json.Object.mem "radius" Json.number ~enc:radius
146
-
|> Json.Object.finish
146
+
|> Json.Object.member "name" Json.Value.string ~enc:name
147
+
|> Json.Object.member "radius" Json.Value.number ~enc:radius
148
+
|> Json.Object.seal
147
149
end
148
150
149
151
module Rect = struct
···
156
158
157
159
let jsont =
158
160
Json.Object.map ~kind:"Rect" make
159
-
|> Json.Object.mem "name" Json.string ~enc:name
160
-
|> Json.Object.mem "width" Json.number ~enc:width
161
-
|> Json.Object.mem "height" Json.number ~enc:height
162
-
|> Json.Object.finish
161
+
|> Json.Object.member "name" Json.Value.string ~enc:name
162
+
|> Json.Object.member "width" Json.Value.number ~enc:width
163
+
|> Json.Object.member "height" Json.Value.number ~enc:height
164
+
|> Json.Object.seal
163
165
end
164
166
165
167
type t = Circle of Circle.t | Rect of Rect.t
···
176
178
in
177
179
let cases = Json.Object.Case.[ make circle; make rect ] in
178
180
Json.Object.map ~kind:"Geometry" Fun.id
179
-
|> Json.Object.case_mem "type" Json.string ~enc:Fun.id ~enc_case cases
180
-
|> Json.Object.finish
181
+
|> Json.Object.case_member "type" Json.Value.string ~enc:Fun.id ~enc_case
182
+
cases
183
+
|> Json.Object.seal
181
184
end
182
185
183
186
module Geometry_record = struct
···
189
192
190
193
let jsont =
191
194
Json.Object.map ~kind:"Circle" make
192
-
|> Json.Object.mem "radius" Json.number ~enc:radius
193
-
|> Json.Object.finish
195
+
|> Json.Object.member "radius" Json.Value.number ~enc:radius
196
+
|> Json.Object.seal
194
197
end
195
198
196
199
module Rect = struct
···
202
205
203
206
let jsont =
204
207
Json.Object.map ~kind:"Rect" make
205
-
|> Json.Object.mem "width" Json.number ~enc:width
206
-
|> Json.Object.mem "height" Json.number ~enc:height
207
-
|> Json.Object.finish
208
+
|> Json.Object.member "width" Json.Value.number ~enc:width
209
+
|> Json.Object.member "height" Json.Value.number ~enc:height
210
+
|> Json.Object.seal
208
211
end
209
212
210
213
type type' = Circle of Circle.t | Rect of Rect.t
···
227
230
in
228
231
let cases = Json.Object.Case.[ make circle; make rect ] in
229
232
Json.Object.map ~kind:"Geometry" make
230
-
|> Json.Object.mem "name" Json.string ~enc:name
231
-
|> Json.Object.case_mem "type" Json.string ~enc:type' ~enc_case cases
232
-
|> Json.Object.finish
233
+
|> Json.Object.member "name" Json.Value.string ~enc:name
234
+
|> Json.Object.case_member "type" Json.Value.string ~enc:type' ~enc_case
235
+
cases
236
+
|> Json.Object.seal
233
237
end
234
238
235
239
(* Untagged object types *)
···
254
258
255
259
let jsont =
256
260
Json.Object.map make
257
-
|> Json.Object.mem "id" Json.int ~enc:(fun r -> r.id)
258
-
|> Json.Object.opt_mem "result" Json.json ~enc:result
259
-
|> Json.Object.opt_mem "error" Json.string ~enc:error
260
-
|> Json.Object.finish
261
+
|> Json.Object.member "id" Json.Value.int ~enc:(fun r -> r.id)
262
+
|> Json.Object.opt_member "result" Json.json ~enc:result
263
+
|> Json.Object.opt_member "error" Json.Value.string ~enc:error
264
+
|> Json.Object.seal
261
265
end
262
266
263
267
(* Flattening objects on queries *)
···
269
273
270
274
let info_jsont =
271
275
Json.Object.map make
272
-
|> Json.Object.mem "id" Json.int
273
-
|> Json.Object.mem "name" Json.string
274
-
|> Json.Object.finish
276
+
|> Json.Object.member "id" Json.Value.int
277
+
|> Json.Object.member "name" Json.Value.string
278
+
|> Json.Object.seal
275
279
276
280
let jsont =
277
281
Json.Object.map (fun k persons -> k persons)
278
-
|> Json.Object.mem "info" info_jsont
279
-
|> Json.Object.mem "persons" (Json.list Person.jsont)
280
-
|> Json.Object.finish
282
+
|> Json.Object.member "info" info_jsont
283
+
|> Json.Object.member "persons" (Json.Value.list Person.jsont)
284
+
|> Json.Object.seal
281
285
end
+22
-22
test/codecs/geojson.ml
+22
-22
test/codecs/geojson.ml
···
18
18
19
19
type float_array = float array
20
20
21
-
let float_array_jsont ~kind = Json.array ~kind Json.number
21
+
let float_array_jsont ~kind = Json.Value.array ~kind Json.Value.number
22
22
23
23
type 'a garray = 'a array
24
24
25
-
let garray = Json.array
25
+
let garray = Json.Value.array
26
26
27
27
module Bbox = struct
28
28
type t = float_array
···
46
46
47
47
let finish_jsont map =
48
48
map
49
-
|> Json.Object.opt_mem "bbox" Bbox.jsont ~enc:bbox
49
+
|> Json.Object.opt_member "bbox" Bbox.jsont ~enc:bbox
50
50
|> Json.Object.keep_unknown Json.json_mems ~enc:unknown
51
-
|> Json.Object.finish
51
+
|> Json.Object.seal
52
52
53
53
let geometry ~kind coordinates =
54
54
Json.Object.map ~kind make
55
-
|> Json.Object.mem "coordinates" coordinates ~enc:type'
55
+
|> Json.Object.member "coordinates" coordinates ~enc:type'
56
56
|> finish_jsont
57
57
end
58
58
···
202
202
]
203
203
in
204
204
Json.Object.map ~kind:"Geometry object" Fun.id
205
-
|> Json.Object.case_mem "type" Json.string ~enc:Fun.id ~enc_case cases
206
-
~tag_to_string:Fun.id ~tag_compare:String.compare
207
-
|> Json.Object.finish
205
+
|> Json.Object.case_member "type" Json.Value.string ~enc:Fun.id ~enc_case
206
+
cases ~tag_to_string:Fun.id ~tag_compare:String.compare
207
+
|> Json.Object.seal
208
208
end
209
209
210
210
and feature_jsont : Feature.t object' Json.codec Lazy.t =
···
213
213
let enc_case v = Json.Object.Case.value case_feature v in
214
214
let cases = Json.Object.Case.[ make case_feature ] in
215
215
Json.Object.map ~kind:"Feature" Fun.id
216
-
|> Json.Object.case_mem "type" Json.string ~enc:Fun.id ~enc_case cases
217
-
~tag_to_string:Fun.id ~tag_compare:String.compare
218
-
|> Json.Object.finish
216
+
|> Json.Object.case_member "type" Json.Value.string ~enc:Fun.id ~enc_case
217
+
cases ~tag_to_string:Fun.id ~tag_compare:String.compare
218
+
|> Json.Object.seal
219
219
end
220
220
221
221
and case_feature_jsont : Feature.t object' Json.codec Lazy.t =
222
222
lazy begin
223
223
Json.Object.map ~kind:"Feature" Feature.make_geojson_object
224
-
|> Json.Object.opt_mem "id" feature_id_jsont ~enc:(fun o ->
224
+
|> Json.Object.opt_member "id" feature_id_jsont ~enc:(fun o ->
225
225
Feature.id (Geojson_object.type' o))
226
-
|> Json.Object.mem "geometry"
227
-
(Json.option (Json.rec' geometry_jsont))
226
+
|> Json.Object.member "geometry"
227
+
(Json.Value.option (Json.fix geometry_jsont))
228
228
~enc:(fun o -> Feature.geometry (Geojson_object.type' o))
229
-
|> Json.Object.mem "properties" (Json.option Json.json_object)
229
+
|> Json.Object.member "properties" (Json.Value.option Json.json_object)
230
230
~enc:(fun o -> Feature.properties (Geojson_object.type' o))
231
231
|> Geojson_object.finish_jsont
232
232
end
···
234
234
and geometry_collection_jsont =
235
235
lazy begin
236
236
Json.Object.map ~kind:"GeometryCollection" Geojson_object.make
237
-
|> Json.Object.mem "geometries"
238
-
(Json.list (Json.rec' geometry_jsont))
237
+
|> Json.Object.member "geometries"
238
+
(Json.Value.list (Json.fix geometry_jsont))
239
239
~enc:Geojson_object.type'
240
240
|> Geojson_object.finish_jsont
241
241
end
···
243
243
and feature_collection_json =
244
244
lazy begin
245
245
Json.Object.map ~kind:"FeatureCollection" Geojson_object.make
246
-
|> Json.Object.mem "features"
247
-
Json.(list (Json.rec' feature_jsont))
246
+
|> Json.Object.member "features"
247
+
Json.(list (Json.fix feature_jsont))
248
248
~enc:Geojson_object.type'
249
249
|> Geojson_object.finish_jsont
250
250
end
···
295
295
]
296
296
in
297
297
Json.Object.map ~kind:"GeoJSON" Fun.id
298
-
|> Json.Object.case_mem "type" Json.string ~enc:Fun.id ~enc_case cases
299
-
~tag_to_string:Fun.id ~tag_compare:String.compare
300
-
|> Json.Object.finish
298
+
|> Json.Object.case_member "type" Json.Value.string ~enc:Fun.id ~enc_case
299
+
cases ~tag_to_string:Fun.id ~tag_compare:String.compare
300
+
|> Json.Object.seal
301
301
end
302
302
303
303
let jsont = Lazy.force jsont
+17
-17
test/codecs/json_rpc.ml
+17
-17
test/codecs/json_rpc.ml
···
16
16
type id = [ `String of string | `Number of float | `Null ]
17
17
18
18
let id_jsont : id Json.codec =
19
-
let null = Json.null `Null in
19
+
let null = Json.Value.null `Null in
20
20
let string =
21
21
let dec s = `String s in
22
22
let enc = function `String s -> s | _ -> assert false in
23
-
Json.map ~dec ~enc Json.string
23
+
Json.map ~dec ~enc Json.Value.string
24
24
in
25
25
let number =
26
26
let dec n = `Number n in
27
27
let enc = function `Number n -> n | _ -> assert false in
28
-
Json.map ~dec ~enc Json.number
28
+
Json.map ~dec ~enc Json.Value.number
29
29
in
30
30
let enc = function
31
31
| `Null -> null
···
60
60
61
61
let request_jsont : request Json.codec =
62
62
Json.Object.map request
63
-
|> Json.Object.mem "jsonrpc" jsonrpc_jsont ~enc:(fun r -> r.jsonrpc)
64
-
|> Json.Object.mem "method" Json.string ~enc:(fun r -> r.method')
65
-
|> Json.Object.opt_mem "params" params_jsont ~enc:(fun r -> r.params)
66
-
|> Json.Object.opt_mem "id" id_jsont ~enc:(fun r -> r.id)
67
-
|> Json.Object.finish
63
+
|> Json.Object.member "jsonrpc" jsonrpc_jsont ~enc:(fun r -> r.jsonrpc)
64
+
|> Json.Object.member "method" Json.Value.string ~enc:(fun r -> r.method')
65
+
|> Json.Object.opt_member "params" params_jsont ~enc:(fun r -> r.params)
66
+
|> Json.Object.opt_member "id" id_jsont ~enc:(fun r -> r.id)
67
+
|> Json.Object.seal
68
68
69
69
(* JSON-RPC error objects *)
70
70
···
74
74
75
75
let error_jsont =
76
76
Json.Object.map error
77
-
|> Json.Object.mem "code" Json.int ~enc:(fun e -> e.code)
78
-
|> Json.Object.mem "message" Json.string ~enc:(fun e -> e.message)
79
-
|> Json.Object.opt_mem "data" Json.json ~enc:(fun e -> e.data)
80
-
|> Json.Object.finish
77
+
|> Json.Object.member "code" Json.Value.int ~enc:(fun e -> e.code)
78
+
|> Json.Object.member "message" Json.Value.string ~enc:(fun e -> e.message)
79
+
|> Json.Object.opt_member "data" Json.json ~enc:(fun e -> e.data)
80
+
|> Json.Object.seal
81
81
82
82
(* JSON-RPC response object *)
83
83
···
103
103
104
104
let response_jsont : response Json.codec =
105
105
Json.Object.map response
106
-
|> Json.Object.mem "jsonrpc" jsonrpc_jsont ~enc:(fun r -> r.jsonrpc)
107
-
|> Json.Object.opt_mem "result" Json.json ~enc:response_result
108
-
|> Json.Object.opt_mem "error" error_jsont ~enc:response_error
109
-
|> Json.Object.mem "id" id_jsont ~enc:(fun r -> r.id)
110
-
|> Json.Object.finish
106
+
|> Json.Object.member "jsonrpc" jsonrpc_jsont ~enc:(fun r -> r.jsonrpc)
107
+
|> Json.Object.opt_member "result" Json.json ~enc:response_result
108
+
|> Json.Object.opt_member "error" error_jsont ~enc:response_error
109
+
|> Json.Object.member "id" id_jsont ~enc:(fun r -> r.id)
110
+
|> Json.Object.seal
+16
-10
test/codecs/jsont_tool.ml
+16
-10
test/codecs/jsont_tool.ml
···
90
90
91
91
let output ~format ~number_format j =
92
92
match format with
93
-
| `Pretty -> Ok (Format.printf "@[%a@]@." (Json.pp_json' ~number_format ()) j)
93
+
| `Pretty -> Ok (Format.printf "@[%a@]@." (Json.pp' ~number_format ()) j)
94
94
| `Format format ->
95
95
let w = Bytesrw.Bytes.Writer.of_out_channel stdout in
96
96
Json.to_writer ~format ~number_format ~eod:true Json.json j w
97
97
98
98
let output_string ~format ~number_format j =
99
99
match format with
100
-
| `Pretty -> Ok (Format.asprintf "@[%a@]" (Json.pp_json' ~number_format ()) j)
100
+
| `Pretty -> Ok (Format.asprintf "@[%a@]" (Json.pp' ~number_format ()) j)
101
101
| `Format format -> Json.to_string ~format ~number_format Json.json j
102
102
103
103
let trip_type ?(dec_only = false) ~file ~format ~number_format ~diff:do_diff
···
146
146
in
147
147
let rec value ppf = function
148
148
| Json.Null ((), m) ->
149
-
loc (strf "%a" pp_code (strf "%a" Json.pp_null ())) ppf m
149
+
loc (strf "%a" pp_code (strf "%a" Json.Value.pp_null ())) ppf m
150
150
| Json.Bool (b, m) ->
151
-
loc (strf "Bool %a" pp_code (strf "%a" Json.pp_bool b)) ppf m
151
+
loc (strf "Bool %a" pp_code (strf "%a" Json.Value.pp_bool b)) ppf m
152
152
| Json.Number (n, m) ->
153
-
loc (strf "Number %a" pp_code (strf "%a" Json.pp_number n)) ppf m
153
+
loc
154
+
(strf "Number %a" pp_code (strf "%a" Json.Value.pp_number n))
155
+
ppf m
154
156
| Json.String (s, m) ->
155
-
loc (strf "String %a" pp_code (strf "%a" Json.pp_string s)) ppf m
157
+
loc
158
+
(strf "String %a" pp_code (strf "%a" Json.Value.pp_string s))
159
+
ppf m
156
160
| Json.Array (l, m) ->
157
161
Format.pp_open_vbox ppf indent;
158
162
loc "Array" ppf m;
···
160
164
Format.pp_close_box ppf ()
161
165
| Json.Object (o, m) ->
162
166
let mem ppf ((name, m), v) =
163
-
let l = strf "Member %a" pp_code (strf "%a" Json.pp_string name) in
167
+
let l =
168
+
strf "Member %a" pp_code (strf "%a" Json.Value.pp_string name)
169
+
in
164
170
loc l ppf m;
165
171
value ppf v
166
172
in
···
200
206
201
207
let json_arg =
202
208
let of_string s = Json.of_string ~locs:true ~layout:true Json.json s in
203
-
let pp = Json.pp_json in
209
+
let pp = Json.pp in
204
210
Arg.conv' ~docv:"JSON" (of_string, pp)
205
211
206
212
let format_opt ~default =
···
240
246
let doc = "Use C float format string $(docv) to format JSON numbers." in
241
247
let number_format : Json.number_format Arg.conv =
242
248
let parse s =
243
-
try Ok (Scanf.format_from_string s Json.default_number_format)
249
+
try Ok (Scanf.format_from_string s Json.Value.default_number_format)
244
250
with Scanf.Scan_failure _ ->
245
251
Error (strf "Cannot format a float with %S" s)
246
252
in
···
249
255
in
250
256
Arg.(
251
257
value
252
-
& opt number_format Json.default_number_format
258
+
& opt number_format Json.Value.default_number_format
253
259
& info [ "n"; "number-format" ] ~doc ~docv:"FMT")
254
260
255
261
let diff_flag =
+5
-5
test/codecs/quickstart.ml
+5
-5
test/codecs/quickstart.ml
···
37
37
38
38
let jsont =
39
39
Json.Object.map ~kind:"Item" make
40
-
|> Json.Object.mem "task" Json.string ~enc:task
41
-
|> Json.Object.mem "status" Status.jsont ~enc:status
42
-
|> Json.Object.mem "tags"
40
+
|> Json.Object.member "task" Json.Value.string ~enc:task
41
+
|> Json.Object.member "status" Status.jsont ~enc:status
42
+
|> Json.Object.member "tags"
43
43
Json.(list string)
44
44
~enc:tags ~dec_absent:[] ~enc_omit:(( = ) [])
45
-
|> Json.Object.finish
45
+
|> Json.Object.seal
46
46
end
47
47
48
-
let items = Json.list Item.jsont
48
+
let items = Json.Value.list Item.jsont
49
49
let items_of_json s = Json.of_string items s
50
50
let items_to_json ?format is = Json.to_string ?format items is
+3
-3
test/codecs/test_bytesrw.ml
+3
-3
test/codecs/test_bytesrw.ml
···
19
19
Test.test "Json.to_writer ~eod" @@ fun () ->
20
20
let b = Buffer.create 255 in
21
21
let w = Bytes.Writer.of_buffer b in
22
-
let () = Result.get_ok (Json.to_writer' Json.bool true ~eod:false w) in
23
-
let () = Result.get_ok (Json.to_writer' Json.bool true ~eod:true w) in
22
+
let () = Result.get_ok (Json.to_writer' Json.Value.bool true ~eod:false w) in
23
+
let () = Result.get_ok (Json.to_writer' Json.Value.bool true ~eod:true w) in
24
24
Test.string (Buffer.contents b) "truetrue";
25
-
Snap.raise (fun () -> Json.to_writer' Json.bool true ~eod:true w)
25
+
Snap.raise (fun () -> Json.to_writer' Json.Value.bool true ~eod:true w)
26
26
@> __POS_OF__ (Invalid_argument "slice written after eod");
27
27
()
28
28
+72
-69
test/codecs/test_common.ml
+72
-69
test/codecs/test_common.ml
···
148
148
let test_basic_invalid =
149
149
Test.test "basic invalid JSON" @@ fun () ->
150
150
decode_error Json.json "" ~__POS__;
151
-
decode_error (Json.null ()) "" ~__POS__;
152
-
decode_error Json.bool "" ~__POS__;
151
+
decode_error (Json.Value.null ()) "" ~__POS__;
152
+
decode_error Json.Value.bool "" ~__POS__;
153
153
decode_error Json.json "ha" ~__POS__;
154
-
decode_error (Json.null ()) "ha" ~__POS__;
155
-
decode_error Json.bool "ha" ~__POS__;
154
+
decode_error (Json.Value.null ()) "ha" ~__POS__;
155
+
decode_error Json.Value.bool "ha" ~__POS__;
156
156
decode_error Json.json " ha" ~__POS__;
157
157
decode_error Json.json " r6 " ~__POS__;
158
158
decode_error Json.json " { " ~__POS__;
···
163
163
let test_indent = Test.test "Encode with indentation" @@ fun () -> ()
164
164
165
165
let test_null =
166
-
Test.test "Json.null" @@ fun () ->
166
+
Test.test "Json.Value.null" @@ fun () ->
167
167
trip ~eq ~format:Layout Json.json " null \r\n" ~__POS__;
168
168
trip ~eq ~format:Layout Json.json "\n null " ~__POS__;
169
169
trip ~eq ~format:Layout Json.json "null" ~__POS__;
···
171
171
decode_error Json.json " nu " ~__POS__;
172
172
decode_error Json.json " nul " ~__POS__;
173
173
decode_error Json.json " n " ~__POS__;
174
-
trip (Json.null ()) " \n null \n " ~value:() ~__POS__;
175
-
trip (Json.null ()) " null " ~value:() ~__POS__;
176
-
decode_error (Json.null ()) " true " ~__POS__;
174
+
trip (Json.Value.null ()) " \n null \n " ~value:() ~__POS__;
175
+
trip (Json.Value.null ()) " null " ~value:() ~__POS__;
176
+
decode_error (Json.Value.null ()) " true " ~__POS__;
177
177
()
178
178
179
179
let test_bool =
180
-
Test.test "Json.bool" @@ fun () ->
180
+
Test.test "Json.Value.bool" @@ fun () ->
181
181
trip ~eq ~format:Layout Json.json " true \r\n" ~__POS__;
182
182
trip ~eq ~format:Layout Json.json "\n false " ~__POS__;
183
183
trip ~eq ~format:Layout Json.json "false" ~__POS__;
···
186
186
decode_error Json.json " fals " ~__POS__;
187
187
decode_error Json.json " falsee " ~__POS__;
188
188
decode_error Json.json " f " ~__POS__;
189
-
trip ~eq:Test.T.bool Json.bool " true \n " ~value:true ~__POS__;
190
-
trip ~eq:Test.T.bool Json.bool " false " ~value:false ~__POS__;
191
-
decode_error Json.bool " fals " ~__POS__;
189
+
trip ~eq:Test.T.bool Json.Value.bool " true \n " ~value:true ~__POS__;
190
+
trip ~eq:Test.T.bool Json.Value.bool " false " ~value:false ~__POS__;
191
+
decode_error Json.Value.bool " fals " ~__POS__;
192
192
()
193
193
194
194
let test_numbers =
195
-
Test.test "Json.number" @@ fun () ->
195
+
Test.test "Json.Value.number" @@ fun () ->
196
196
trip ~eq ~format:Layout Json.json " 1 " ~__POS__;
197
197
trip ~eq ~format:Layout Json.json " 0 \n " ~__POS__;
198
198
trip ~eq ~format:Layout Json.json "\n 2.5 " ~__POS__;
···
206
206
decode_error Json.json " infinity " ~__POS__;
207
207
decode_error Json.json " nan " ~__POS__;
208
208
let eq = Test.T.float in
209
-
trip ~eq Json.number " -0 " ~value:(-0.) ~__POS__;
210
-
trip ~eq Json.number " 0 " ~value:0. ~__POS__;
211
-
trip ~eq Json.number " 0E1 " ~value:0. ~__POS__;
212
-
trip ~eq Json.number " 0e+1 " ~value:0. ~__POS__;
213
-
trip ~eq Json.number " null " ~value:Float.nan ~__POS__;
214
-
encode_ok Json.number "null" ~value:Float.infinity ~__POS__;
215
-
encode_ok Json.number "null" ~value:Float.neg_infinity ~__POS__;
216
-
trip ~eq Json.number " 1e300 " ~value:1.e300 ~__POS__;
217
-
decode_error Json.number " fals " ~__POS__;
218
-
decode_error Json.number " 1. " ~__POS__;
219
-
decode_error Json.number " 1.0e+ " ~__POS__;
220
-
decode_error Json.number " 0E " ~__POS__;
221
-
decode_error Json.number " 1eE2 " ~__POS__;
209
+
trip ~eq Json.Value.number " -0 " ~value:(-0.) ~__POS__;
210
+
trip ~eq Json.Value.number " 0 " ~value:0. ~__POS__;
211
+
trip ~eq Json.Value.number " 0E1 " ~value:0. ~__POS__;
212
+
trip ~eq Json.Value.number " 0e+1 " ~value:0. ~__POS__;
213
+
trip ~eq Json.Value.number " null " ~value:Float.nan ~__POS__;
214
+
encode_ok Json.Value.number "null" ~value:Float.infinity ~__POS__;
215
+
encode_ok Json.Value.number "null" ~value:Float.neg_infinity ~__POS__;
216
+
trip ~eq Json.Value.number " 1e300 " ~value:1.e300 ~__POS__;
217
+
decode_error Json.Value.number " fals " ~__POS__;
218
+
decode_error Json.Value.number " 1. " ~__POS__;
219
+
decode_error Json.Value.number " 1.0e+ " ~__POS__;
220
+
decode_error Json.Value.number " 0E " ~__POS__;
221
+
decode_error Json.Value.number " 1eE2 " ~__POS__;
222
222
()
223
223
224
224
let test_strings =
225
-
Test.test "Json.string" @@ fun () ->
225
+
Test.test "Json.Value.string" @@ fun () ->
226
226
trip ~eq ~format:Layout Json.json {| "" |} ~__POS__;
227
227
trip ~eq ~format:Layout Json.json " \"\\\"\" " ~__POS__;
228
228
trip ~eq ~format:Layout Json.json " \"\\\\\" " ~__POS__;
···
238
238
decode_error Json.json "\"hi\nhi\"" ~__POS__;
239
239
decode_error Json.json "\n \"abla\" hi " ~__POS__;
240
240
decode_error Json.json "\n \"unclosed hi " ~__POS__;
241
-
trip ~eq:Test.T.string Json.string "\"\\ud83D\\uDc2B\"" ~value:"🐫" ~__POS__;
242
-
trip ~eq:Test.T.string Json.string "\"🐫 a\"" ~value:"🐫 a" ~__POS__;
243
-
decode_error Json.string " false " ~__POS__;
244
-
decode_error Json.string "1.0" ~__POS__;
241
+
trip ~eq:Test.T.string Json.Value.string "\"\\ud83D\\uDc2B\"" ~value:"🐫"
242
+
~__POS__;
243
+
trip ~eq:Test.T.string Json.Value.string "\"🐫 a\"" ~value:"🐫 a" ~__POS__;
244
+
decode_error Json.Value.string " false " ~__POS__;
245
+
decode_error Json.Value.string "1.0" ~__POS__;
245
246
()
246
247
247
248
let test_option =
···
286
287
trip Json.int8 "-128" ~value:(-128) ~__POS__;
287
288
trip Json.int8 "127" ~value:127 ~__POS__;
288
289
(* int32 *)
289
-
decode_error Json.int32 "null" ~__POS__;
290
-
decode_error Json.int32 "true" ~__POS__;
291
-
decode_error Json.int32 "-2147483649" ~__POS__;
292
-
decode_error Json.int32 "2147483648" ~__POS__;
293
-
trip Json.int32 "-2147483648" ~value:Int32.min_int ~__POS__;
294
-
trip Json.int32 "2147483647" ~value:Int32.max_int ~__POS__;
290
+
decode_error Json.Value.int32 "null" ~__POS__;
291
+
decode_error Json.Value.int32 "true" ~__POS__;
292
+
decode_error Json.Value.int32 "-2147483649" ~__POS__;
293
+
decode_error Json.Value.int32 "2147483648" ~__POS__;
294
+
trip Json.Value.int32 "-2147483648" ~value:Int32.min_int ~__POS__;
295
+
trip Json.Value.int32 "2147483647" ~value:Int32.max_int ~__POS__;
295
296
(* int64 *)
296
297
let max_exact = Int64.shift_left 1L 53 in
297
298
let max_exact_next = Int64.(add max_exact 1L) in
298
299
let min_exact = Int64.shift_left 1L 53 in
299
300
let min_exact_prev = Int64.(add max_exact 1L) in
300
-
decode_error Json.int64 "null" ~__POS__;
301
-
decode_error Json.int64 "true" ~__POS__;
302
-
trip Json.int64 (Fmt.str "%Ld" max_exact) ~value:max_exact ~__POS__;
303
-
trip Json.int64 (Fmt.str "%Ld" min_exact) ~value:min_exact ~__POS__;
304
-
trip Json.int64
301
+
decode_error Json.Value.int64 "null" ~__POS__;
302
+
decode_error Json.Value.int64 "true" ~__POS__;
303
+
trip Json.Value.int64 (Fmt.str "%Ld" max_exact) ~value:max_exact ~__POS__;
304
+
trip Json.Value.int64 (Fmt.str "%Ld" min_exact) ~value:min_exact ~__POS__;
305
+
trip Json.Value.int64
305
306
(Fmt.str {|"%Ld"|} max_exact_next)
306
307
~value:max_exact_next ~__POS__;
307
-
trip Json.int64
308
+
trip Json.Value.int64
308
309
(Fmt.str {|"%Ld"|} min_exact_prev)
309
310
~value:min_exact_prev ~__POS__;
310
311
(* int_as_string *)
311
-
trip Json.int_as_string {|"2"|} ~value:2 ~__POS__;
312
-
trip Json.int_as_string
312
+
trip Json.Value.int_as_string {|"2"|} ~value:2 ~__POS__;
313
+
trip Json.Value.int_as_string
313
314
(Fmt.str {|"%d"|} Int.max_int)
314
315
~value:Int.max_int ~__POS__;
315
-
trip Json.int_as_string
316
+
trip Json.Value.int_as_string
316
317
(Fmt.str {|"%d"|} Int.min_int)
317
318
~value:Int.min_int ~__POS__;
318
319
(* int64_as_string *)
319
-
trip Json.int64_as_string
320
+
trip Json.Value.int64_as_string
320
321
(Fmt.str {|"%Ld"|} Int64.max_int)
321
322
~value:Int64.max_int ~__POS__;
322
-
trip Json.int64_as_string
323
+
trip Json.Value.int64_as_string
323
324
(Fmt.str {|"%Ld"|} Int64.min_int)
324
325
~value:Int64.min_int ~__POS__;
325
326
()
···
329
330
(* any_float *)
330
331
let jsonstr f = Fmt.str {|"%s"|} (Float.to_string f) in
331
332
let eq = Test.T.float in
332
-
decode_ok ~eq Json.any_float "null" ~value:Float.nan ~__POS__;
333
-
trip ~eq Json.any_float " -0 " ~value:(-0.) ~__POS__;
334
-
trip ~eq Json.any_float " 0 " ~value:0. ~__POS__;
335
-
trip ~eq Json.any_float " 0.5 " ~value:0.5 ~__POS__;
336
-
decode_ok ~eq Json.any_float (jsonstr 0.5) ~value:0.5 ~__POS__;
337
-
trip ~eq Json.any_float (jsonstr Float.nan) ~value:Float.nan ~__POS__;
338
-
trip ~eq Json.any_float (jsonstr Float.infinity) ~value:Float.infinity
333
+
decode_ok ~eq Json.Value.any_float "null" ~value:Float.nan ~__POS__;
334
+
trip ~eq Json.Value.any_float " -0 " ~value:(-0.) ~__POS__;
335
+
trip ~eq Json.Value.any_float " 0 " ~value:0. ~__POS__;
336
+
trip ~eq Json.Value.any_float " 0.5 " ~value:0.5 ~__POS__;
337
+
decode_ok ~eq Json.Value.any_float (jsonstr 0.5) ~value:0.5 ~__POS__;
338
+
trip ~eq Json.Value.any_float (jsonstr Float.nan) ~value:Float.nan ~__POS__;
339
+
trip ~eq Json.Value.any_float (jsonstr Float.infinity) ~value:Float.infinity
339
340
~__POS__;
340
-
trip ~eq Json.any_float
341
+
trip ~eq Json.Value.any_float
341
342
(jsonstr Float.neg_infinity)
342
343
~value:Float.neg_infinity ~__POS__;
343
344
···
402
403
~value:(barr [| 1; 2; 3 |])
403
404
~__POS__;
404
405
let enc = Array.get in
405
-
let t2_int = Json.t2 ~dec:(fun x y -> [| x; y |]) ~enc Json.int in
406
+
let t2_int = Json.t2 ~dec:(fun x y -> [| x; y |]) ~enc Json.Value.int in
406
407
decode_error t2_int "[]" ~__POS__;
407
408
decode_error t2_int "[1]" ~__POS__;
408
409
trip t2_int "[1,2]" ~value:[| 1; 2 |] ~__POS__;
409
410
decode_error t2_int "[1,2,3]" ~__POS__;
410
-
let t3_int = Json.t3 ~dec:(fun x y z -> [| x; y; z |]) ~enc Json.int in
411
+
let t3_int = Json.t3 ~dec:(fun x y z -> [| x; y; z |]) ~enc Json.Value.int in
411
412
decode_error t3_int "[]" ~__POS__;
412
413
decode_error t3_int "[1]" ~__POS__;
413
414
decode_error t3_int "[1,2]" ~__POS__;
414
415
trip t3_int "[1,2,3]" ~value:[| 1; 2; 3 |] ~__POS__;
415
416
decode_error t3_int "[1,2,3,4]" ~__POS__;
416
-
let t4_int = Json.t4 ~dec:(fun x y z w -> [| x; y; z; w |]) ~enc Json.int in
417
+
let t4_int =
418
+
Json.t4 ~dec:(fun x y z w -> [| x; y; z; w |]) ~enc Json.Value.int
419
+
in
417
420
decode_error t4_int "[]" ~__POS__;
418
421
decode_error t4_int "[1]" ~__POS__;
419
422
decode_error t4_int "[1,2]" ~__POS__;
···
503
506
504
507
let test_rec =
505
508
Test.test "Json.rec" @@ fun () ->
506
-
let tree_null = Tree.jsont_with_null Json.int in
509
+
let tree_null = Tree.jsont_with_null Json.Value.int in
507
510
trip tree_null Tree_data.empty_null ~value:Tree_data.empty ~__POS__;
508
511
trip tree_null Tree_data.tree0_null ~value:Tree_data.tree0 ~__POS__;
509
-
let tree_cases = Tree.jsont_with_cases Json.int in
512
+
let tree_cases = Tree.jsont_with_cases Json.Value.int in
510
513
trip tree_cases Tree_data.empty_cases ~value:Tree_data.empty ~__POS__;
511
514
trip tree_cases Tree_data.tree0_cases ~value:Tree_data.tree0 ~__POS__;
512
515
()
513
516
514
517
let test_zero =
515
-
Test.test "Json.zero" @@ fun () ->
518
+
Test.test "Json.Value.zero" @@ fun () ->
516
519
let decode_ok = decode_ok ~eq:Test.T.unit in
517
-
decode_ok Json.zero "null" ~value:() ~__POS__;
518
-
decode_ok Json.zero "2" ~value:() ~__POS__;
519
-
decode_ok Json.zero {|"a"|} ~value:() ~__POS__;
520
-
decode_ok Json.zero {|[1]|} ~value:() ~__POS__;
521
-
decode_ok Json.zero {|{"bli":"bla"}|} ~value:() ~__POS__;
522
-
encode_ok Json.zero ~value:() "null" ~__POS__;
520
+
decode_ok Json.Value.zero "null" ~value:() ~__POS__;
521
+
decode_ok Json.Value.zero "2" ~value:() ~__POS__;
522
+
decode_ok Json.Value.zero {|"a"|} ~value:() ~__POS__;
523
+
decode_ok Json.Value.zero {|[1]|} ~value:() ~__POS__;
524
+
decode_ok Json.Value.zero {|{"bli":"bla"}|} ~value:() ~__POS__;
525
+
encode_ok Json.Value.zero ~value:() "null" ~__POS__;
523
526
()
524
527
525
528
let test_const =
···
594
597
let test_object_queries =
595
598
Test.test "Json.{mem,*_mem,fold_object,filter_map_object}" @@ fun () ->
596
599
let o = {| { "a" : { "b" : 1 }, "c": 2 } |} in
597
-
(* Json.mem *)
600
+
(* Json.Value.member *)
598
601
decode_ok Json.(mem "a" @@ mem "b" int) o ~value:1 ~__POS__;
599
602
decode_error Json.(mem "a" @@ mem "c" int) o ~__POS__;
600
603
decode_ok Json.(mem "a" @@ mem ~absent:3 "c" int) o ~value:3 ~__POS__;
+47
-46
test/codecs/test_common_samples.ml
+47
-46
test/codecs/test_common_samples.ml
···
24
24
25
25
let jsont =
26
26
Json.Object.map ~kind:"Item" make
27
-
|> Json.Object.mem "task" Json.string ~enc:task
28
-
|> Json.Object.mem "status" Status.jsont ~enc:status
29
-
|> Json.Object.mem "tags"
27
+
|> Json.Object.member "task" Json.Value.string ~enc:task
28
+
|> Json.Object.member "status" Status.jsont ~enc:status
29
+
|> Json.Object.member "tags"
30
30
Json.(list string)
31
31
~dec_absent:[] ~enc:tags ~enc_omit:(( = ) [])
32
-
|> Json.Object.finish
32
+
|> Json.Object.seal
33
33
end
34
34
35
35
module Item_data = struct
···
63
63
64
64
let skip_jsont =
65
65
Json.Object.map ~kind:"unknown-skip" make
66
-
|> Json.Object.mem "m" Json.bool ~enc:m
67
-
|> Json.Object.skip_unknown |> Json.Object.finish
66
+
|> Json.Object.member "m" Json.Value.bool ~enc:m
67
+
|> Json.Object.skip_unknown |> Json.Object.seal
68
68
69
69
let error_jsont =
70
70
Json.Object.map ~kind:"unknown-skip" make
71
-
|> Json.Object.mem "m" Json.bool ~enc:m
72
-
|> Json.Object.error_unknown |> Json.Object.finish
71
+
|> Json.Object.member "m" Json.Value.bool ~enc:m
72
+
|> Json.Object.error_unknown |> Json.Object.seal
73
73
74
74
let keep_jsont : (t * int String_map.t) Json.codec =
75
-
let unknown = Json.Object.Mems.string_map Json.int in
75
+
let unknown = Json.Object.Members.string_map Json.Value.int in
76
76
Json.Object.map ~kind:"unknown-keep" (fun m imap -> (make m, imap))
77
-
|> Json.Object.mem "m" Json.bool ~enc:(fun (v, _) -> m v)
77
+
|> Json.Object.member "m" Json.Value.bool ~enc:(fun (v, _) -> m v)
78
78
|> Json.Object.keep_unknown unknown ~enc:snd
79
-
|> Json.Object.finish
79
+
|> Json.Object.seal
80
80
end
81
81
82
82
module Unknown_data = struct
···
113
113
114
114
let jsont =
115
115
Json.Object.map ~kind:"Author" make
116
-
|> Json.Object.mem "name" Json.string ~enc:name
117
-
|> Json.Object.mem "book_count" Json.int ~enc:book_count
118
-
|> Json.Object.mem "pseudo" Json.string ~enc:pseudo
119
-
|> Json.Object.finish
116
+
|> Json.Object.member "name" Json.Value.string ~enc:name
117
+
|> Json.Object.member "book_count" Json.Value.int ~enc:book_count
118
+
|> Json.Object.member "pseudo" Json.Value.string ~enc:pseudo
119
+
|> Json.Object.seal
120
120
end
121
121
122
122
module Editor = struct
···
128
128
129
129
let jsont =
130
130
Json.Object.map ~kind:"Editor" make
131
-
|> Json.Object.mem "name" Json.string ~enc:name
132
-
|> Json.Object.mem "publisher" Json.string ~enc:publisher
133
-
|> Json.Object.finish
131
+
|> Json.Object.member "name" Json.Value.string ~enc:name
132
+
|> Json.Object.member "publisher" Json.Value.string ~enc:publisher
133
+
|> Json.Object.seal
134
134
end
135
135
136
136
type t = Author of Author.t | Editor of Editor.t
···
147
147
| Editor e -> Json.Object.Case.value case_e e
148
148
in
149
149
Json.Object.map ~kind:"Person" Fun.id
150
-
|> Json.Object.case_mem "type" Json.string ~tag_to_string:Fun.id
150
+
|> Json.Object.case_member "type" Json.Value.string ~tag_to_string:Fun.id
151
151
~enc:Fun.id ~enc_case cases
152
-
|> Json.Object.finish
152
+
|> Json.Object.seal
153
153
end
154
154
155
155
module Person_field = struct
···
162
162
163
163
let author_jsont =
164
164
Json.Object.map ~kind:"Author" make_author
165
-
|> Json.Object.mem "pseudo" Json.string ~enc:pseudo
166
-
|> Json.Object.mem "book_count" Json.int ~enc:book_count
167
-
|> Json.Object.finish
165
+
|> Json.Object.member "pseudo" Json.Value.string ~enc:pseudo
166
+
|> Json.Object.member "book_count" Json.Value.int ~enc:book_count
167
+
|> Json.Object.seal
168
168
169
169
type editor = { publisher : string }
170
170
···
173
173
174
174
let editor_jsont =
175
175
Json.Object.map ~kind:"Editor" make_editor
176
-
|> Json.Object.mem "publisher" Json.string ~enc:publisher
177
-
|> Json.Object.finish
176
+
|> Json.Object.member "publisher" Json.Value.string ~enc:publisher
177
+
|> Json.Object.seal
178
178
179
179
type type' = Author of author | Editor of editor
180
180
···
196
196
| Editor e -> Json.Object.Case.value case_e e
197
197
in
198
198
Json.Object.map ~kind:"Person" make
199
-
|> Json.Object.case_mem "type" ~tag_to_string:Fun.id Json.string
199
+
|> Json.Object.case_member "type" ~tag_to_string:Fun.id Json.Value.string
200
200
~enc:type' ~enc_case cases
201
-
|> Json.Object.mem "name" Json.string ~enc:name
202
-
|> Json.Object.finish
201
+
|> Json.Object.member "name" Json.Value.string ~enc:name
202
+
|> Json.Object.seal
203
203
end
204
204
205
205
module Keep_unknown = struct
206
206
type a = string String_map.t
207
207
208
208
let a_jsont =
209
-
let unknown = Json.Object.Mems.string_map Json.string in
209
+
let unknown = Json.Object.Members.string_map Json.Value.string in
210
210
Json.Object.map ~kind:"A" Fun.id
211
211
|> Json.Object.keep_unknown unknown ~enc:Fun.id
212
-
|> Json.Object.finish
212
+
|> Json.Object.seal
213
213
214
214
type b = { name : string }
215
215
···
217
217
218
218
let b_jsont =
219
219
Json.Object.map ~kind:"B" (fun name -> { name })
220
-
|> Json.Object.mem "name" Json.string ~enc:name
221
-
|> Json.Object.error_unknown |> Json.Object.finish
220
+
|> Json.Object.member "name" Json.Value.string ~enc:name
221
+
|> Json.Object.error_unknown |> Json.Object.seal
222
222
223
223
type type' = A of a | B of b
224
224
···
251
251
| B b -> Json.Object.Case.value case_b b
252
252
in
253
253
Json.Object.map ~kind:"Keep_unknown" make
254
-
|> Json.Object.case_mem "type" ~tag_to_string:Fun.id Json.string
254
+
|> Json.Object.case_member "type" ~tag_to_string:Fun.id Json.Value.string
255
255
~enc:type' ~enc_case cases
256
256
|> Json.Object.keep_unknown Json.json_mems ~enc:unknown
257
-
|> Json.Object.finish
257
+
|> Json.Object.seal
258
258
end
259
259
end
260
260
···
340
340
let jsont_with_null t =
341
341
let rec tree =
342
342
lazy begin
343
-
let empty = Json.null Empty in
343
+
let empty = Json.Value.null Empty in
344
344
let node =
345
345
let not_a_node () = failwith "not a node" in
346
346
let value = function Node (_, v, _) -> v | _ -> not_a_node () in
347
347
let left = function Node (l, _, _) -> l | _ -> not_a_node () in
348
348
let right = function Node (_, _, r) -> r | _ -> not_a_node () in
349
349
Json.Object.map ~kind:"node" (fun l v r -> Node (l, v, r))
350
-
|> Json.Object.mem ~enc:left "left" (Json.rec' tree)
351
-
|> Json.Object.mem ~enc:value "value" t
352
-
|> Json.Object.mem ~enc:right "right" (Json.rec' tree)
353
-
|> Json.Object.finish
350
+
|> Json.Object.member ~enc:left "left" (Json.fix tree)
351
+
|> Json.Object.member ~enc:value "value" t
352
+
|> Json.Object.member ~enc:right "right" (Json.fix tree)
353
+
|> Json.Object.seal
354
354
in
355
355
let enc = function Empty -> empty | Node _ -> node in
356
356
Json.any ~kind:"tree" ~dec_null:empty ~dec_object:node ~enc ()
···
370
370
let jsont_with_cases t =
371
371
let rec tree =
372
372
lazy begin
373
-
let leaf_jsont = Json.Object.map Empty |> Json.Object.finish in
373
+
let leaf_jsont = Json.Object.map Empty |> Json.Object.seal in
374
374
let node_jsont =
375
375
let not_a_node () = failwith "not a node" in
376
376
let value = function Node (_, v, _) -> v | _ -> not_a_node () in
377
377
let left = function Node (l, _, _) -> l | _ -> not_a_node () in
378
378
let right = function Node (_, _, r) -> r | _ -> not_a_node () in
379
379
Json.Object.map (fun l v r -> Node (l, v, r))
380
-
|> Json.Object.mem ~enc:left "left" (Json.rec' tree)
381
-
|> Json.Object.mem ~enc:value "value" t
382
-
|> Json.Object.mem ~enc:right "right" (Json.rec' tree)
383
-
|> Json.Object.finish
380
+
|> Json.Object.member ~enc:left "left" (Json.fix tree)
381
+
|> Json.Object.member ~enc:value "value" t
382
+
|> Json.Object.member ~enc:right "right" (Json.fix tree)
383
+
|> Json.Object.seal
384
384
in
385
385
let case_leaf = Json.Object.Case.map "empty" leaf_jsont ~dec:Fun.id in
386
386
let case_node = Json.Object.Case.map "node" node_jsont ~dec:Fun.id in
···
390
390
in
391
391
let cases = Json.Object.Case.[ make case_leaf; make case_node ] in
392
392
Json.Object.map ~kind:"tree" Fun.id
393
-
|> Json.Object.case_mem "type" Json.string ~enc:Fun.id ~enc_case cases
394
-
|> Json.Object.finish
393
+
|> Json.Object.case_member "type" Json.Value.string ~enc:Fun.id
394
+
~enc_case cases
395
+
|> Json.Object.seal
395
396
end
396
397
in
397
398
Lazy.force tree
+34
-30
test/codecs/topojson.ml
+34
-30
test/codecs/topojson.ml
···
36
36
let v2_jsont =
37
37
let dec x y = (x, y) in
38
38
let enc (x, y) i = if i = 0 then x else y in
39
-
Json.t2 ~dec ~enc Json.number
39
+
Json.t2 ~dec ~enc Json.Value.number
40
40
41
41
let jsont =
42
42
Json.Object.map ~kind:"Transform" make
43
-
|> Json.Object.mem "scale" v2_jsont ~enc:scale
44
-
|> Json.Object.mem "translate" v2_jsont ~enc:translate
45
-
|> Json.Object.finish
43
+
|> Json.Object.member "scale" v2_jsont ~enc:scale
44
+
|> Json.Object.member "translate" v2_jsont ~enc:translate
45
+
|> Json.Object.seal
46
46
end
47
47
48
48
module Point = struct
···
53
53
54
54
let jsont =
55
55
Json.Object.map ~kind:"Point" make
56
-
|> Json.Object.mem "coordinates" Position.jsont ~enc:coordinates
57
-
|> Json.Object.finish
56
+
|> Json.Object.member "coordinates" Position.jsont ~enc:coordinates
57
+
|> Json.Object.seal
58
58
end
59
59
60
60
module Multi_point = struct
···
65
65
66
66
let jsont =
67
67
Json.Object.map ~kind:"MultiPoint" make
68
-
|> Json.Object.mem "coordinates" (Json.list Position.jsont) ~enc:coordinates
69
-
|> Json.Object.finish
68
+
|> Json.Object.member "coordinates"
69
+
(Json.Value.list Position.jsont)
70
+
~enc:coordinates
71
+
|> Json.Object.seal
70
72
end
71
73
72
74
module Line_string = struct
···
77
79
78
80
let jsont =
79
81
Json.Object.map ~kind:"LineString" make
80
-
|> Json.Object.mem "arcs" Json.(list int32) ~enc:arcs
81
-
|> Json.Object.finish
82
+
|> Json.Object.member "arcs" Json.(list int32) ~enc:arcs
83
+
|> Json.Object.seal
82
84
end
83
85
84
86
module Multi_line_string = struct
···
89
91
90
92
let jsont =
91
93
Json.Object.map ~kind:"MultiLineString" make
92
-
|> Json.Object.mem "arcs" Json.(list (list int32)) ~enc:arcs
93
-
|> Json.Object.finish
94
+
|> Json.Object.member "arcs" Json.(list (list int32)) ~enc:arcs
95
+
|> Json.Object.seal
94
96
end
95
97
96
98
module Polygon = struct
···
101
103
102
104
let jsont =
103
105
Json.Object.map ~kind:"Polygon" make
104
-
|> Json.Object.mem "arcs" Json.(list (list int32)) ~enc:arcs
105
-
|> Json.Object.finish
106
+
|> Json.Object.member "arcs" Json.(list (list int32)) ~enc:arcs
107
+
|> Json.Object.seal
106
108
end
107
109
108
110
module Multi_polygon = struct
···
113
115
114
116
let jsont =
115
117
Json.Object.map ~kind:"MultiPolygon" make
116
-
|> Json.Object.mem "arcs" Json.(list (list (list int32))) ~enc:arcs
117
-
|> Json.Object.finish
118
+
|> Json.Object.member "arcs" Json.(list (list (list int32))) ~enc:arcs
119
+
|> Json.Object.seal
118
120
end
119
121
120
122
module Geometry = struct
···
171
173
let rec collection_jsont =
172
174
lazy begin
173
175
Json.Object.map ~kind:"GeometryCollection" Fun.id
174
-
|> Json.Object.mem "geometries" (Json.list (Json.rec' jsont)) ~enc:Fun.id
175
-
|> Json.Object.finish
176
+
|> Json.Object.member "geometries"
177
+
(Json.Value.list (Json.fix jsont))
178
+
~enc:Fun.id
179
+
|> Json.Object.seal
176
180
end
177
181
178
182
and jsont =
···
206
210
]
207
211
in
208
212
Json.Object.map ~kind:"Geometry" make
209
-
|> Json.Object.case_mem "type" Json.string ~enc:type' ~enc_case cases
210
-
~tag_to_string:Fun.id ~tag_compare:String.compare
211
-
|> Json.Object.opt_mem "id" id_jsont ~enc:id
212
-
|> Json.Object.opt_mem "properties" properties_type ~enc:properties
213
-
|> Json.Object.opt_mem "bbox" Bbox.jsont ~enc:bbox
213
+
|> Json.Object.case_member "type" Json.Value.string ~enc:type' ~enc_case
214
+
cases ~tag_to_string:Fun.id ~tag_compare:String.compare
215
+
|> Json.Object.opt_member "id" id_jsont ~enc:id
216
+
|> Json.Object.opt_member "properties" properties_type ~enc:properties
217
+
|> Json.Object.opt_member "bbox" Bbox.jsont ~enc:bbox
214
218
|> Json.Object.keep_unknown Json.json_mems ~enc:unknown
215
-
|> Json.Object.finish
219
+
|> Json.Object.seal
216
220
end
217
221
218
222
let jsont = Lazy.force jsont
···
243
247
let jsont =
244
248
let kind = "Topology" in
245
249
Json.Object.map ~kind (fun () -> make)
246
-
|> Json.Object.mem "type" (Json.enum [ (kind, ()) ]) ~enc:(Fun.const ())
247
-
|> Json.Object.mem "objects" Geometry.objects_jsont ~enc:objects
248
-
|> Json.Object.mem "arcs" Arcs.jsont ~enc:arcs
249
-
|> Json.Object.opt_mem "transform" Transform.jsont ~enc:transform
250
-
|> Json.Object.opt_mem "bbox" Bbox.jsont ~enc:bbox
250
+
|> Json.Object.member "type" (Json.enum [ (kind, ()) ]) ~enc:(Fun.const ())
251
+
|> Json.Object.member "objects" Geometry.objects_jsont ~enc:objects
252
+
|> Json.Object.member "arcs" Arcs.jsont ~enc:arcs
253
+
|> Json.Object.opt_member "transform" Transform.jsont ~enc:transform
254
+
|> Json.Object.opt_member "bbox" Bbox.jsont ~enc:bbox
251
255
|> Json.Object.keep_unknown Json.json_mems ~enc:unknown
252
-
|> Json.Object.finish
256
+
|> Json.Object.seal
253
257
end
254
258
255
259
(* Command line interface *)
+3
-3
test/codecs/trials.ml
+3
-3
test/codecs/trials.ml
···
12
12
13
13
let jsont : t Json.codec =
14
14
Json.Object.map make
15
-
|> Json.Object.mem "content" Json.string ~enc:content
16
-
|> Json.Object.mem "public" Json.bool ~enc:public
17
-
|> Json.Object.finish
15
+
|> Json.Object.member "content" Json.Value.string ~enc:content
16
+
|> Json.Object.member "public" Json.Value.bool ~enc:public
17
+
|> Json.Object.seal
18
18
end
19
19
20
20
type ('ret, 'f) app =
+13
-12
test/test_tape.ml
+13
-12
test/test_tape.ml
···
2
2
any generic JSON value through [of_value]/[to_value] and through its byte
3
3
serialization. *)
4
4
5
+
open Json.Value
6
+
5
7
let roundtrip_value name v =
6
8
let tape = Json.Tape.of_value v in
7
9
let v' = Json.Tape.to_value tape in
8
-
Alcotest.(check bool) (name ^ ": value equal") true (Json.equal v v')
10
+
Alcotest.(check bool) (name ^ ": value equal") true (equal v v')
9
11
10
12
let roundtrip_bytes name v =
11
13
let tape = Json.Tape.of_value v in
···
14
16
| Error e -> Alcotest.failf "%s: of_bytes error: %s" name e
15
17
| Ok tape' ->
16
18
let v' = Json.Tape.to_value tape' in
17
-
Alcotest.(check bool) (name ^ ": bytes equal") true (Json.equal v v')
19
+
Alcotest.(check bool) (name ^ ": bytes equal") true (equal v v')
18
20
19
21
let v_simple () =
20
-
let n = Json.name in
21
-
Json.object'
22
+
object'
22
23
[
23
-
(n "a", Json.int 42);
24
-
(n "b", Json.string "hello");
25
-
(n "c", Json.list [ Json.bool true; Json.null () ]);
24
+
(name "a", int 42);
25
+
(name "b", string "hello");
26
+
(name "c", list [ bool true; null () ]);
26
27
]
27
28
28
29
let test_roundtrip_atoms () =
29
-
roundtrip_value "null" (Json.null ());
30
-
roundtrip_value "true" (Json.bool true);
31
-
roundtrip_value "false" (Json.bool false);
32
-
roundtrip_value "int" (Json.int 7);
33
-
roundtrip_value "string" (Json.string "hello")
30
+
roundtrip_value "null" (null ());
31
+
roundtrip_value "true" (bool true);
32
+
roundtrip_value "false" (bool false);
33
+
roundtrip_value "int" (int 7);
34
+
roundtrip_value "string" (string "hello")
34
35
35
36
let test_roundtrip_object () = roundtrip_value "object" (v_simple ())
36
37
let test_bytes_roundtrip () = roundtrip_bytes "object bytes" (v_simple ())
+19
-23
test/test_value.ml
+19
-23
test/test_value.ml
···
1
1
(** Tests for generic JSON values. Covers the constructors, equality, and member
2
-
lookup at the top level of {!Json}. *)
2
+
lookup exposed by {!Json.Value}. *)
3
3
4
-
let v_null = Json.null ()
5
-
let v_true = Json.bool true
6
-
let v_false = Json.bool false
7
-
let v_seven = Json.int 7
8
-
let v_hello = Json.string "hello"
4
+
open Json.Value
5
+
6
+
let v_null = null ()
7
+
let v_true = bool true
8
+
let v_false = bool false
9
+
let v_seven = int 7
10
+
let v_hello = string "hello"
9
11
10
12
let test_sort () =
11
-
Alcotest.(check string) "null" "null" (Json.Sort.to_string (Json.sort v_null));
12
-
Alcotest.(check string) "bool" "bool" (Json.Sort.to_string (Json.sort v_true));
13
-
Alcotest.(check string)
14
-
"number" "number"
15
-
(Json.Sort.to_string (Json.sort v_seven));
16
-
Alcotest.(check string)
17
-
"string" "string"
18
-
(Json.Sort.to_string (Json.sort v_hello))
13
+
Alcotest.(check string) "null" "null" (Json.Sort.to_string (sort v_null));
14
+
Alcotest.(check string) "bool" "bool" (Json.Sort.to_string (sort v_true));
15
+
Alcotest.(check string) "number" "number" (Json.Sort.to_string (sort v_seven));
16
+
Alcotest.(check string) "string" "string" (Json.Sort.to_string (sort v_hello))
19
17
20
18
let test_equal () =
21
-
Alcotest.(check bool) "null = null" true (Json.equal v_null v_null);
22
-
Alcotest.(check bool) "true = true" true (Json.equal v_true v_true);
23
-
Alcotest.(check bool) "true <> false" false (Json.equal v_true v_false);
24
-
Alcotest.(check bool)
25
-
"hello = hello" true
26
-
(Json.equal v_hello (Json.string "hello"))
19
+
Alcotest.(check bool) "null = null" true (equal v_null v_null);
20
+
Alcotest.(check bool) "true = true" true (equal v_true v_true);
21
+
Alcotest.(check bool) "true <> false" false (equal v_true v_false);
22
+
Alcotest.(check bool) "hello = hello" true (equal v_hello (string "hello"))
27
23
28
24
let test_find_mem () =
29
-
let mems = [ (Json.name "a", v_seven); (Json.name "b", v_hello) ] in
30
-
match Json.find_mem "a" mems with
25
+
let mems = [ (name "a", v_seven); (name "b", v_hello) ] in
26
+
match member_key "a" mems with
31
27
| None -> Alcotest.fail "expected member a"
32
-
| Some (_, v) -> Alcotest.(check bool) "found 7" true (Json.equal v v_seven)
28
+
| Some (_, v) -> Alcotest.(check bool) "found 7" true (equal v v_seven)
33
29
34
30
let suite =
35
31
( "value",