Declarative JSON data manipulation for OCaml
ocaml-linkedin: apply dune fmt
Pure formatting changes from `dune fmt`: doc comment placement moves
from above the binding to below it for `type`s, multi-line `match`
expressions collapse onto one line where they fit, and infix operator
applications pick up spaces (`Soup.($?)` -> `Soup.( $? )`). No
semantic changes.
+246
-156
+14
-3
README.md
+14
-3
README.md
···
26
26
27
27
## Installation
28
28
29
-
Json can be installed with `opam`:
29
+
Install with opam:
30
+
31
+
```sh
32
+
$ opam install json
33
+
```
34
+
35
+
If opam cannot find the package, it may not yet be released in the public
36
+
`opam-repository`. Add the overlay repository, then install it:
30
37
31
-
opam install json
38
+
```sh
39
+
$ opam repo add samoht https://tangled.org/gazagnaire.org/opam-overlay.git
40
+
$ opam update
41
+
$ opam install json
42
+
```
32
43
33
44
The main library depends on `bytesrw`, `fmt`, and `loc`. Browser support is
34
45
provided by the optional Dune library `json.brr`, which depends on `brr`.
···
67
78
```ocaml
68
79
let value =
69
80
let open Json.Value in
70
-
object' [ name "ok", bool true ]
81
+
object' [ member (name "ok") (bool true) ]
71
82
72
83
let text = Json.Value.to_string value
73
84
```
+147
-90
lib/codec.ml
+147
-90
lib/codec.ml
···
383
383
module Ast = Value
384
384
385
385
type value = Value.t
386
-
type 'a codec = 'a t
387
386
type name = Value.name
388
387
type member = Value.member
389
388
type object' = Value.object'
···
1370
1369
let error_type t fnd =
1371
1370
Error.fail_kinded_sort (Ast.meta fnd) ~exp:(kinded_sort t) ~fnd:(Ast.sort fnd)
1372
1371
1373
-
let find_all_unexpected ~mem_decs mems =
1372
+
let all_unexpected ~mem_decs mems =
1374
1373
let unexpected (((n, _) as nm), _v) =
1375
1374
match String_map.find_opt n mem_decs with None -> Some nm | Some _ -> None
1376
1375
in
···
1491
1490
decode_object_basic map meta umems umap mem_miss mem_decs dict
1492
1491
mems
1493
1492
| Unknown_error ->
1494
-
let fnd = nm :: find_all_unexpected ~mem_decs mems in
1493
+
let fnd = nm :: all_unexpected ~mem_decs mems in
1495
1494
fail_unexpected_members meta map ~fnd
1496
1495
| Unknown_keep (umap', _) ->
1497
1496
let umap =
···
2899
2898
let next = ref true in
2900
2899
try
2901
2900
while !next do
2902
-
begin
2903
-
let first_byte = last_byte_of d in
2904
-
let first_line_num = d.line and first_line_byte = d.line_start in
2905
-
try
2906
-
if map.dec_skip !i !b then parse d ignore
2907
-
else b := map.dec_add !i (parse d map.elt) !b
2908
-
with Error e ->
2909
-
let imeta =
2910
-
error_meta_to_current ~first_byte ~first_line_num
2911
-
~first_line_byte d
2912
-
in
2913
-
fail_push_array (error_meta d) map (!i, imeta) e
2914
-
end;
2901
+
b := decode_array_item d map !i !b;
2915
2902
incr i;
2916
2903
match
2917
2904
read_ws d;
···
2936
2923
in
2937
2924
let meta = meta_make d ~ws_before ~ws_after loc in
2938
2925
map.dec_finish meta len b
2926
+
2927
+
and decode_array_item : type a elt b.
2928
+
decoder -> (a, elt, b) array_map -> int -> b -> b =
2929
+
fun d map i b ->
2930
+
let first_byte = last_byte_of d in
2931
+
let first_line_num = d.line and first_line_byte = d.line_start in
2932
+
try
2933
+
if map.dec_skip i b then
2934
+
let () = parse d ignore in
2935
+
b
2936
+
else map.dec_add i (parse d map.elt) b
2937
+
with Error e ->
2938
+
let imeta =
2939
+
error_meta_to_current ~first_byte ~first_line_num ~first_line_byte d
2940
+
in
2941
+
fail_push_array (error_meta d) map (i, imeta) e
2939
2942
2940
2943
and decode_object : type a. decoder -> (a, a) object_map -> a =
2941
2944
fun d map ->
···
3073
3076
string if no match was found (for Unknown_keep paths and
3074
3077
error messages). *)
3075
3078
begin match mem_by_token d mem_decs with
3076
-
| Some (Mem_dec mem, name) ->
3077
-
token_clear d;
3078
-
let mem_miss = String_map.remove name mem_miss in
3079
-
let dict =
3080
-
try Dict.add mem.id (parse d mem.type') dict
3081
-
with Error e -> fail_push_object (error_meta d) map (name, meta) e
3082
-
in
3083
-
read_json_mem_sep d;
3084
-
decode_object_basic d map u umap mem_miss mem_decs dict
3085
-
| None -> (
3086
-
match u with
3087
-
| Unknown_skip ->
3088
-
(* The name is never read, so we don't need to allocate it. *)
3089
-
token_clear d;
3090
-
let () =
3091
-
try parse d ignore
3092
-
with Error e ->
3093
-
fail_push_object (error_meta d) map (token_pop d, meta) e
3094
-
in
3095
-
read_json_mem_sep d;
3096
-
decode_object_basic d map u umap mem_miss mem_decs dict
3097
-
| Unknown_error ->
3098
-
let name = token_pop d in
3099
-
let fnd = [ (name, meta) ] in
3100
-
fail_unexpected_members (error_meta d) map ~fnd
3101
-
| Unknown_keep (umap', _) ->
3102
-
let name = token_pop d in
3103
-
let umap =
3104
-
try umap'.dec_add meta name (parse d umap'.mems_type) umap
3105
-
with Error e ->
3106
-
fail_push_object (error_meta d) map (name, meta) e
3107
-
in
3108
-
read_json_mem_sep d;
3109
-
decode_object_basic d map u umap mem_miss mem_decs dict)
3079
+
| Some (mem, name) ->
3080
+
decode_object_known_mem d map u umap mem_miss mem_decs dict meta name
3081
+
mem
3082
+
| None ->
3083
+
decode_object_unknown_mem d map u umap mem_miss mem_decs dict meta
3110
3084
end
3111
3085
| u when u = eot -> err_unclosed_object d map
3112
3086
| _ -> err_exp_mem_or_eoo d
3113
3087
3088
+
and decode_object_known_mem : type o p mems builder.
3089
+
decoder ->
3090
+
(o, o) object_map ->
3091
+
(p, mems, builder) unknown_mems ->
3092
+
builder ->
3093
+
mem_dec String_map.t ->
3094
+
mem_dec String_map.t ->
3095
+
Dict.t ->
3096
+
Meta.t ->
3097
+
string ->
3098
+
mem_dec ->
3099
+
Dict.t =
3100
+
fun d map u umap mem_miss mem_decs dict meta name (Mem_dec mem) ->
3101
+
token_clear d;
3102
+
let mem_miss = String_map.remove name mem_miss in
3103
+
let dict =
3104
+
try Dict.add mem.id (parse d mem.type') dict
3105
+
with Error e -> fail_push_object (error_meta d) map (name, meta) e
3106
+
in
3107
+
read_json_mem_sep d;
3108
+
decode_object_basic d map u umap mem_miss mem_decs dict
3109
+
3110
+
and decode_object_unknown_mem : type o p mems builder.
3111
+
decoder ->
3112
+
(o, o) object_map ->
3113
+
(p, mems, builder) unknown_mems ->
3114
+
builder ->
3115
+
mem_dec String_map.t ->
3116
+
mem_dec String_map.t ->
3117
+
Dict.t ->
3118
+
Meta.t ->
3119
+
Dict.t =
3120
+
fun d map u umap mem_miss mem_decs dict meta ->
3121
+
match u with
3122
+
| Unknown_skip ->
3123
+
(* The name is never read, so we don't need to allocate it. *)
3124
+
token_clear d;
3125
+
let () =
3126
+
try parse d ignore
3127
+
with Error e ->
3128
+
fail_push_object (error_meta d) map (token_pop d, meta) e
3129
+
in
3130
+
read_json_mem_sep d;
3131
+
decode_object_basic d map u umap mem_miss mem_decs dict
3132
+
| Unknown_error ->
3133
+
let name = token_pop d in
3134
+
let fnd = [ (name, meta) ] in
3135
+
fail_unexpected_members (error_meta d) map ~fnd
3136
+
| Unknown_keep (umap', _) ->
3137
+
let name = token_pop d in
3138
+
let umap =
3139
+
try umap'.dec_add meta name (parse d umap'.mems_type) umap
3140
+
with Error e -> fail_push_object (error_meta d) map (name, meta) e
3141
+
in
3142
+
read_json_mem_sep d;
3143
+
decode_object_basic d map u umap mem_miss mem_decs dict
3144
+
3114
3145
and decode_object_case : type o cases tag.
3115
3146
decoder ->
3116
3147
(o, o) object_map ->
···
3122
3153
Dict.t ->
3123
3154
Dict.t =
3124
3155
fun d map umems cases mem_miss mem_decs delay dict ->
3125
-
let decode_case_tag ~sep map umems cases mem_miss mem_decs nmeta tag delay =
3126
-
let eq_tag (Case c) = cases.tag_compare c.tag tag = 0 in
3127
-
match List.find_opt eq_tag cases.cases with
3128
-
| None -> (
3129
-
try fail_unexpected_case_tag (error_meta d) map cases tag
3130
-
with Error e ->
3131
-
fail_push_object (error_meta d) map (cases.tag.name, nmeta) e)
3132
-
| Some (Case case) ->
3133
-
if sep then read_json_mem_sep d;
3134
-
let dict =
3135
-
decode_object_map d case.object_map umems mem_miss mem_decs delay dict
3136
-
in
3137
-
Dict.add cases.id (case.dec (apply_dict case.object_map.dec dict)) dict
3138
-
in
3139
3156
match d.u with
3140
3157
| 0x007D (* } *) -> (
3141
3158
match cases.tag.dec_absent with
3142
3159
| Some tag ->
3143
-
decode_case_tag ~sep:false map umems cases mem_miss mem_decs
3144
-
d.meta_none tag delay
3160
+
decode_object_case_tag d ~sep:false map umems cases mem_miss mem_decs
3161
+
d.meta_none tag delay dict
3145
3162
| None ->
3146
3163
let fnd = List.map (fun ((n, _), _) -> n) delay in
3147
3164
let exp = String_map.singleton cases.tag.name (Mem_dec cases.tag) in
···
3154
3171
try parse d cases.tag.type'
3155
3172
with Error e -> fail_push_object (error_meta d) map (name, meta) e
3156
3173
in
3157
-
decode_case_tag ~sep:true map umems cases mem_miss mem_decs meta tag
3158
-
delay
3174
+
decode_object_case_tag d ~sep:true map umems cases mem_miss mem_decs
3175
+
meta tag delay dict
3159
3176
else
3160
-
begin match String_map.find_opt name mem_decs with
3161
-
| Some (Mem_dec mem) ->
3162
-
let mem_miss = String_map.remove name mem_miss in
3163
-
let dict =
3164
-
try Dict.add mem.id (parse d mem.type') dict
3165
-
with Error e ->
3166
-
fail_push_object (error_meta d) map (name, meta) e
3167
-
in
3168
-
read_json_mem_sep d;
3169
-
decode_object_case d map umems cases mem_miss mem_decs delay dict
3170
-
| None ->
3171
-
(* Because JSON can be out of order we don't know how to decode
3172
-
this yet. Generic decode *)
3173
-
let v =
3174
-
try parse d Value.t
3175
-
with Error e ->
3176
-
fail_push_object (error_meta d) map (name, meta) e
3177
-
in
3178
-
let delay = ((name, meta), v) :: delay in
3179
-
read_json_mem_sep d;
3180
-
decode_object_case d map umems cases mem_miss mem_decs delay dict
3181
-
end
3177
+
decode_object_case_mem d map umems cases mem_miss mem_decs delay dict
3178
+
meta name
3182
3179
| u when u = eot -> err_unclosed_object d map
3183
3180
| _ -> err_exp_mem_or_eoo d
3181
+
3182
+
and decode_object_case_tag : type o cases tag.
3183
+
decoder ->
3184
+
sep:bool ->
3185
+
(o, o) object_map ->
3186
+
unknown_mems_option ->
3187
+
(o, cases, tag) object_cases ->
3188
+
mem_dec String_map.t ->
3189
+
mem_dec String_map.t ->
3190
+
Meta.t ->
3191
+
tag ->
3192
+
object' ->
3193
+
Dict.t ->
3194
+
Dict.t =
3195
+
fun d ~sep map umems cases mem_miss mem_decs nmeta tag delay dict ->
3196
+
let eq_tag (Case c) = cases.tag_compare c.tag tag = 0 in
3197
+
match List.find_opt eq_tag cases.cases with
3198
+
| None -> (
3199
+
try fail_unexpected_case_tag (error_meta d) map cases tag
3200
+
with Error e ->
3201
+
fail_push_object (error_meta d) map (cases.tag.name, nmeta) e)
3202
+
| Some (Case case) ->
3203
+
if sep then read_json_mem_sep d;
3204
+
let dict =
3205
+
decode_object_map d case.object_map umems mem_miss mem_decs delay dict
3206
+
in
3207
+
Dict.add cases.id (case.dec (apply_dict case.object_map.dec dict)) dict
3208
+
3209
+
and decode_object_case_mem : type o cases tag.
3210
+
decoder ->
3211
+
(o, o) object_map ->
3212
+
unknown_mems_option ->
3213
+
(o, cases, tag) object_cases ->
3214
+
mem_dec String_map.t ->
3215
+
mem_dec String_map.t ->
3216
+
object' ->
3217
+
Dict.t ->
3218
+
Meta.t ->
3219
+
string ->
3220
+
Dict.t =
3221
+
fun d map umems cases mem_miss mem_decs delay dict meta name ->
3222
+
match String_map.find_opt name mem_decs with
3223
+
| Some (Mem_dec mem) ->
3224
+
let mem_miss = String_map.remove name mem_miss in
3225
+
let dict =
3226
+
try Dict.add mem.id (parse d mem.type') dict
3227
+
with Error e -> fail_push_object (error_meta d) map (name, meta) e
3228
+
in
3229
+
read_json_mem_sep d;
3230
+
decode_object_case d map umems cases mem_miss mem_decs delay dict
3231
+
| None ->
3232
+
(* JSON object members can appear before the case tag. Keep this member as
3233
+
a generic value until the tag tells us which object codec to use. *)
3234
+
let v =
3235
+
try parse d Value.t
3236
+
with Error e -> fail_push_object (error_meta d) map (name, meta) e
3237
+
in
3238
+
let delay = ((name, meta), v) :: delay in
3239
+
read_json_mem_sep d;
3240
+
decode_object_case d map umems cases mem_miss mem_decs delay dict
3184
3241
3185
3242
and decode_any : type a. decoder -> a t -> a any_map -> a =
3186
3243
fun d t map ->
+48
-18
lib/codec.mli
+48
-18
lib/codec.mli
···
56
56
(** Alias for the generic JSON AST; codec signatures below produce/consume
57
57
codecs over [Value.t]. *)
58
58
59
-
type 'a codec = 'a t
60
-
(** Alias for the codec type [t]. *)
61
-
62
59
type name = Value.name
63
60
(** The type for JSON member names. *)
64
61
···
523
520
?enc:('o -> 'a) ->
524
521
?enc_omit:('a -> bool) ->
525
522
string ->
526
-
'a codec ->
523
+
'a t ->
527
524
('o, 'a -> 'b) map ->
528
525
('o, 'b) map
529
526
(** [member name t map] is a member named [name] of type [t] for an object of
···
543
540
?doc:string ->
544
541
?enc:('o -> 'a option) ->
545
542
string ->
546
-
'a codec ->
543
+
'a t ->
547
544
('o, 'a option -> 'b) map ->
548
545
('o, 'b) map
549
546
(** [opt_member name t map] is:
···
560
557
module Case : sig
561
558
(** {1:maps Maps} *)
562
559
563
-
type 'a codec := 'a codec
564
-
565
560
type ('cases, 'case, 'tag) map
566
561
(** The type for mapping a case object. *)
567
562
568
563
val map :
569
-
?dec:('case -> 'cases) -> 'tag -> 'case codec -> ('cases, 'case, 'tag) map
564
+
?dec:('case -> 'cases) -> 'tag -> 'case t -> ('cases, 'case, 'tag) map
570
565
(** [map ~dec v obj] defines the object map [obj] as being the case for the
571
566
tag value [v] of the case member. [dec] indicates how to inject the
572
567
object case into the type common to all cases.
···
606
601
?enc_omit:('tag -> bool) ->
607
602
?enc_case:('cases -> ('cases, 'tag) Case.value) ->
608
603
string ->
609
-
'tag codec ->
604
+
'tag t ->
610
605
('cases, 'tag) Case.t list ->
611
606
('o, 'cases -> 'a) map ->
612
607
('o, 'a) map
···
619
614
(** Uniform members. *)
620
615
module Members : sig
621
616
(** {1:maps Maps} *)
622
-
623
-
type 'a codec := 'a codec
624
617
625
618
type ('mems, 'a) enc = {
626
619
enc :
···
639
632
?dec_add:(Meta.t -> string -> 'a -> 'builder -> 'builder) ->
640
633
?dec_finish:(Meta.t -> 'builder -> 'mems) ->
641
634
?enc:('mems, 'a) enc ->
642
-
'a codec ->
635
+
'a t ->
643
636
('mems, 'a, 'builder) map
644
637
(** [map type'] maps unknown members of uniform type ['a] to values of type
645
638
['mems] built with type ['builder]. *)
···
647
640
val string_map :
648
641
?kind:string ->
649
642
?doc:string ->
650
-
'a codec ->
643
+
'a t ->
651
644
('a Stdlib.Map.Make(String).t, 'a, 'a Stdlib.Map.Make(String).t) map
652
645
(** [string_map t] collects unknown member by name and types their values
653
646
with [t]. *)
···
669
662
(** {1:codecs Codec constructors} *)
670
663
671
664
val as_string_map :
672
-
?kind:string ->
673
-
?doc:string ->
674
-
'a codec ->
675
-
'a Stdlib.Map.Make(String).t codec
665
+
?kind:string -> ?doc:string -> 'a t -> 'a Stdlib.Map.Make(String).t t
676
666
(** [as_string_map t] maps object to key-value maps of type [t]. *)
677
667
678
-
val zero : unit codec
668
+
val zero : unit t
679
669
(** [zero] ignores JSON objects on decoding and encodes an empty object. *)
680
670
end
681
671
···
886
876
'a t ->
887
877
Bytesrw.Bytes.Reader.t ->
888
878
('a, Error.t) result
879
+
(** [of_reader t r] decodes a JSON value from [r] with [t]. *)
889
880
890
881
val of_reader_exn :
891
882
?meta:meta -> ?file:string -> 'a t -> Bytesrw.Bytes.Reader.t -> 'a
883
+
(** [of_reader_exn] is like {!val-of_reader} but raises [Json.Error]. *)
892
884
893
885
val of_string :
894
886
?meta:meta -> ?file:string -> 'a t -> string -> ('a, Error.t) result
887
+
(** [of_string t s] decodes JSON text [s] with [t]. *)
895
888
896
889
val of_string_exn : ?meta:meta -> ?file:string -> 'a t -> string -> 'a
890
+
(** [of_string_exn] is like {!val-of_string} but raises [Json.Error]. *)
897
891
898
892
val to_writer :
899
893
?buf:Bytes.t ->
···
905
899
eod:bool ->
906
900
Bytesrw.Bytes.Writer.t ->
907
901
unit
902
+
(** [to_writer t v ~eod w] encodes [v] with [t] on [w]. *)
908
903
909
904
val to_string :
910
905
?buf:Bytes.t ->
···
914
909
'a t ->
915
910
'a ->
916
911
string
912
+
(** [to_string t v] encodes [v] with [t] to JSON text. *)
917
913
end
918
914
919
915
module Internal : sig
···
1054
1050
-> unknown_mems_option_
1055
1051
1056
1052
val repr : 'a t -> 'a repr
1053
+
(** [repr t] exposes [t]'s internal representation for sibling libraries. *)
1054
+
1057
1055
val array_kinded_sort : ('a, 'elt, 'builder) array_map_ -> string
1056
+
(** [array_kinded_sort m] is the diagnostic kinded sort for array map [m]. *)
1057
+
1058
1058
val object_kinded_sort : ('o, 'dec) object_map_ -> string
1059
+
(** [object_kinded_sort m] is the diagnostic kinded sort for object map [m].
1060
+
*)
1059
1061
1060
1062
val fail_push_array :
1061
1063
Meta.t -> ('array, 'elt, 'builder) array_map_ -> int node -> Error.t -> 'a
1064
+
(** [fail_push_array meta map index e] raises [e] with [index] pushed in the
1065
+
error context for [map]. *)
1062
1066
1063
1067
val fail_push_object :
1064
1068
Meta.t -> ('o, 'dec) object_map_ -> string node -> Error.t -> 'a
1069
+
(** [fail_push_object meta map name e] raises [e] with [name] pushed in the
1070
+
error context for [map]. *)
1065
1071
1066
1072
val fail_type_mismatch : Meta.t -> 'a t -> fnd:Sort.t -> 'b
1073
+
(** [fail_type_mismatch meta t ~fnd] raises the sort mismatch error for [t].
1074
+
*)
1067
1075
1068
1076
val fail_missing_members :
1069
1077
Meta.t ->
···
1071
1079
exp:mem_dec_ String_map.t ->
1072
1080
fnd:string list ->
1073
1081
'a
1082
+
(** [fail_missing_members meta map ~exp ~fnd] raises the missing-members error
1083
+
for [map]. *)
1074
1084
1075
1085
val fail_unexpected_members :
1076
1086
Meta.t -> ('o, 'o) object_map_ -> fnd:(string * Meta.t) list -> 'a
1087
+
(** [fail_unexpected_members meta map ~fnd] raises the unexpected-members
1088
+
error for [map]. *)
1077
1089
1078
1090
val fail_unexpected_case_tag :
1079
1091
Meta.t -> ('o, 'o) object_map_ -> ('o, 'd, 'tag) object_cases_ -> 'tag -> 'a
1092
+
(** [fail_unexpected_case_tag meta map cases tag] raises the unexpected case
1093
+
tag error for [tag]. *)
1080
1094
1081
1095
val object_meta_arg : Meta.t Type.Id.t
1096
+
(** Dictionary key used to pass object metadata to object decoders. *)
1082
1097
1083
1098
module Dict : sig
1084
1099
type binding = B : 'a Type.Id.t * 'a -> binding
1085
1100
type t
1086
1101
1087
1102
val empty : t
1103
+
(** The empty dictionary. *)
1104
+
1088
1105
val mem : 'a Type.Id.t -> t -> bool
1106
+
(** [mem id d] is [true] iff [d] binds [id]. *)
1107
+
1089
1108
val add : 'a Type.Id.t -> 'a -> t -> t
1109
+
(** [add id v d] binds [id] to [v] in [d]. *)
1110
+
1090
1111
val remove : 'a Type.Id.t -> t -> t
1112
+
(** [remove id d] removes [id] from [d]. *)
1113
+
1091
1114
val find : 'a Type.Id.t -> t -> 'a option
1115
+
(** [find id d] is [Some v] if [d] binds [id] to [v]. *)
1092
1116
end
1093
1117
1094
1118
val apply_dict : ('ret, 'f) dec_fun_ -> Dict.t -> 'f
1119
+
(** [apply_dict f d] applies delayed decoder function [f] with arguments from
1120
+
[d]. *)
1095
1121
1096
1122
val override_unknown_mems :
1097
1123
by:unknown_mems_option_ ->
1098
1124
unknown_mems_option_ ->
1099
1125
Dict.t ->
1100
1126
unknown_mems_option_ * Dict.t
1127
+
(** [override_unknown_mems ~by current dict] combines nested unknown-member
1128
+
policies and returns the updated policy and dictionary. *)
1101
1129
1102
1130
val finish_object_decode :
1103
1131
('o, 'o) object_map_ ->
···
1107
1135
mem_dec_ String_map.t ->
1108
1136
Dict.t ->
1109
1137
Dict.t
1138
+
(** [finish_object_decode map meta unknown builder missing dict] finalizes
1139
+
object decoding and inserts default or unknown-member values in [dict]. *)
1110
1140
end
1111
1141
1112
1142
(**/**)
+7
-5
lib/core.ml
+7
-5
lib/core.ml
···
66
66
67
67
exception Illegal_hex of int
68
68
69
+
let err_illegal_hex h i =
70
+
if i = String.length h then Error "Missing final hexadecimal digit"
71
+
else
72
+
let c = String.get_uint8 h i in
73
+
Error (Fmt.str "%d: byte x%x not an ASCII hexadecimal digit" i c)
74
+
69
75
let binary_string_of_hex h =
70
76
let hex_value s i =
71
77
match s.[i] with
···
88
94
let s_len = len / 2 in
89
95
let s = Bytes.create s_len in
90
96
loop (s_len - 1) s 0 h 0
91
-
with Illegal_hex i ->
92
-
if i = String.length h then Error "Missing final hexadecimal digit"
93
-
else
94
-
let c = String.get_uint8 h i in
95
-
Error (Fmt.str "%d: byte x%x not an ASCII hexadecimal digit" i c)
97
+
with Illegal_hex i -> err_illegal_hex h i
96
98
97
99
(* Resizable arrays *)
98
100
+4
-1
lib/json.ml
+4
-1
lib/json.ml
+8
-21
lib/json.mli
+8
-21
lib/json.mli
···
135
135
type 'a t = 'a Codec.t
136
136
(** The type of codecs mapping JSON values to OCaml values of type ['a]. *)
137
137
138
-
type 'a codec = 'a t
139
-
(** Alias for {!type-t}, useful in nested signatures. *)
140
-
141
138
type value = Value.t
142
139
(** Alias for the generic JSON value type. *)
143
140
···
348
345
?enc:('o -> 'a) ->
349
346
?enc_omit:('a -> bool) ->
350
347
string ->
351
-
'a codec ->
348
+
'a t ->
352
349
('o, 'a -> 'b) map ->
353
350
('o, 'b) map
354
351
(** Add a required object member. [dec_absent] supplies a default when the
···
359
356
?doc:string ->
360
357
?enc:('o -> 'a option) ->
361
358
string ->
362
-
'a codec ->
359
+
'a t ->
363
360
('o, 'a option -> 'b) map ->
364
361
('o, 'b) map
365
362
(** Add an optional object member. Missing and JSON null members decode to
···
368
365
module Case : sig
369
366
(** Tagged object cases for sum types. *)
370
367
371
-
type 'a codec := 'a codec
372
-
373
368
type ('cases, 'case, 'tag) map
374
369
(** A single case object before it is added to a case set. *)
375
370
376
371
val map :
377
-
?dec:('case -> 'cases) ->
378
-
'tag ->
379
-
'case codec ->
380
-
('cases, 'case, 'tag) map
372
+
?dec:('case -> 'cases) -> 'tag -> 'case t -> ('cases, 'case, 'tag) map
381
373
(** [map tag codec] declares [codec] as the object shape for [tag]. *)
382
374
383
375
val map_tag : ('cases, 'case, 'tag) map -> 'tag
···
408
400
?enc_omit:('tag -> bool) ->
409
401
?enc_case:('cases -> ('cases, 'tag) Case.value) ->
410
402
string ->
411
-
'tag codec ->
403
+
'tag t ->
412
404
('cases, 'tag) Case.t list ->
413
405
('o, 'cases -> 'a) map ->
414
406
('o, 'a) map
···
418
410
module Members : sig
419
411
(** Maps for unknown or uniform object members. *)
420
412
421
-
type 'a codec := 'a codec
422
-
423
413
type ('mems, 'a) enc = {
424
414
enc :
425
415
'acc.
···
437
427
?dec_add:(Meta.t -> string -> 'a -> 'builder -> 'builder) ->
438
428
?dec_finish:(Meta.t -> 'builder -> 'mems) ->
439
429
?enc:('mems, 'a) enc ->
440
-
'a codec ->
430
+
'a t ->
441
431
('mems, 'a, 'builder) map
442
432
(** Build a custom uniform-member map. *)
443
433
444
434
val string_map :
445
435
?kind:string ->
446
436
?doc:string ->
447
-
'a codec ->
437
+
'a t ->
448
438
('a Stdlib.Map.Make(String).t, 'a, 'a Stdlib.Map.Make(String).t) map
449
439
(** Uniform members collected in a string map. *)
450
440
end
···
464
454
constructor. *)
465
455
466
456
val as_string_map :
467
-
?kind:string ->
468
-
?doc:string ->
469
-
'a codec ->
470
-
'a Stdlib.Map.Make(String).t codec
457
+
?kind:string -> ?doc:string -> 'a t -> 'a Stdlib.Map.Make(String).t t
471
458
(** JSON objects as string maps with uniform member values. *)
472
459
473
-
val zero : unit codec
460
+
val zero : unit t
474
461
(** Ignore JSON objects on decoding and encode an empty object. *)
475
462
end
476
463
+4
test/bytesrw/json_bytesrw_cases.mli
+4
test/bytesrw/json_bytesrw_cases.mli
+1
-1
test/bytesrw/test.ml
+1
-1
test/bytesrw/test.ml
+2
-2
test/bytesrw/test_json_bytesrw.ml
test/bytesrw/json_bytesrw_cases.ml
+2
-2
test/bytesrw/test_json_bytesrw.ml
test/bytesrw/json_bytesrw_cases.ml
···
1
-
(** Tests for {!Json_bytesrw}: decode/encode roundtrips through the bytesrw
2
-
streaming I/O surface. *)
1
+
(** Tests for JSON decode/encode roundtrips through the bytesrw streaming I/O
2
+
surface. *)
3
3
4
4
let test_decode_primitive () =
5
5
match Json.of_string Json.Codec.int "42" with
-2
test/bytesrw/test_json_bytesrw.mli
-2
test/bytesrw/test_json_bytesrw.mli
+1
-1
test/test.ml
+1
-1
test/test.ml
+8
-10
test/test_core.ml
test/test_sort.ml
+8
-10
test/test_core.ml
test/test_sort.ml
···
1
-
(** Tests for {!Json.Codec.Sort} and the low-level number utilities in the
2
-
internal [Core] module. [Core] is not directly exposed but its [Sort]
3
-
submodule is re-exported as [Json.Sort]. *)
1
+
(** Tests for {!Json.Sort}. *)
4
2
5
3
module Sort = Json.Sort
6
4
7
-
let test_sort_to_string () =
5
+
let test_to_string () =
8
6
Alcotest.(check string) "Null" "null" (Sort.to_string Sort.Null);
9
7
Alcotest.(check string) "Bool" "bool" (Sort.to_string Sort.Bool);
10
8
Alcotest.(check string) "Number" "number" (Sort.to_string Sort.Number);
···
12
10
Alcotest.(check string) "Array" "array" (Sort.to_string Sort.Array);
13
11
Alcotest.(check string) "Object" "object" (Sort.to_string Sort.Object)
14
12
15
-
let test_sort_kinded () =
13
+
let test_kinded () =
16
14
Alcotest.(check string)
17
15
"empty kind" "object"
18
16
(Sort.kinded ~kind:"" Sort.Object);
···
20
18
"with kind" "user object"
21
19
(Sort.kinded ~kind:"user" Sort.Object)
22
20
23
-
let test_sort_or_kind () =
21
+
let test_or_kind () =
24
22
Alcotest.(check string)
25
23
"empty kind" "number"
26
24
(Sort.or_kind ~kind:"" Sort.Number);
···
29
27
(Sort.or_kind ~kind:"port" Sort.Number)
30
28
31
29
let suite =
32
-
( "core",
30
+
( "sort",
33
31
[
34
-
Alcotest.test_case "Sort.to_string" `Quick test_sort_to_string;
35
-
Alcotest.test_case "Sort.kinded" `Quick test_sort_kinded;
36
-
Alcotest.test_case "Sort.or_kind" `Quick test_sort_or_kind;
32
+
Alcotest.test_case "to_string" `Quick test_to_string;
33
+
Alcotest.test_case "kinded" `Quick test_kinded;
34
+
Alcotest.test_case "or_kind" `Quick test_or_kind;
37
35
] )
-2
test/test_core.mli
-2
test/test_core.mli