Declarative JSON data manipulation for OCaml
json: replace ?format with ?indent + ?preserve, drop recode*, rework json.brr
Migrate every `to_string` / `to_writer` from the three-variant enum
`?format:format = Minify | Indent | Layout` to two orthogonal knobs:
?indent:int -- omit for compact; pass 2 for pretty (two-space indent).
Inside the function the value is `int option`.
?preserve:bool -- default false; honor per-node Loc.Meta whitespace when
true, with the ?indent path as fallback for new nodes.
This exposes the two underlying axes (pretty-vs-compact / preserve-vs-
regenerate) rather than collapsing them into a closed enum, and makes the
partial-rewrite use case (parse with ~layout:true, edit a subtree, encode
with ~preserve:true ~indent:2) the composition of the two knobs.
Drop `recode` / `recode_exn` / `recode_string` / `recode_string_exn`: they
were four extra verbs on top of the six the skill defines, and users can
compose `of_string |> to_string` in one line.
Rework json.brr to mirror the core six-verb shape exactly:
of_jstr / of_jstr_exn / to_jstr -- Jstr.t replaces string
of_jv / of_jv_exn / to_jv -- Jv.t (zero-copy JS value)
Dropping the jsont-era `decode`/`encode`/`'`/`recode*` verbs and the
dual Jv.Error.t / Json.Error.t return types -- everything returns
Loc.Error.t now.
Update all known downstream callers (claude, http, hap, requests, slack,
sigstore, rego, atp/xrpc-auth) and fix collateral Oauth issues flagged
by the migration (auth, gauth use Oauth.Client_auth.post now).
Also apply merlint docstyle hints to ocaml-json: drop the
`get_meta`/`get_meta` aliases, document `Json.Dict.{empty,mem,add,
remove,find}`, rewrite the int/int32/int64 cons docs so they don't trip
E410's `[x]` bracket heuristic, rename Bench.bench_file to Bench.run_file.
Drive-by: restore did/test/test_did.ml (sed-mangled `let\1\2X` names and
`Quick\1\2X` variants left behind by a prior rename pass) and fix stray
leftover lines in ocaml-tty's dune-project so `dune fmt` can run.
+181
-287
+2
-2
bench/bench.ml
+2
-2
bench/bench.ml
···
109
109
in
110
110
(iters, min_s, median_s, stddev_s, alloc_mb_per_iter, peak_mb)
111
111
112
-
let bench_file path =
112
+
let run_file path =
113
113
let name = Filename.basename path in
114
114
let content = read_file path in
115
115
let size_bytes = String.length content in
···
132
132
field best MB/s | field med MB/s | field alloc/iter MB |\n";
133
133
Fmt.pr
134
134
"|------|---------|----------------|--------------|-------------------|-----------------|----------------|---------------------|\n";
135
-
let results = List.map bench_file files in
135
+
let results = List.map run_file files in
136
136
List.iter
137
137
(fun (name, size_mb, dom, fld) ->
138
138
let _, dmin, dmed, _, dalloc, _ = dom in
+2
-2
dune-project
+2
-2
dune-project
···
4
4
5
5
(generate_opam_files true)
6
6
7
-
(source (tangled gazagnaire.org/ocaml-jsont))
7
+
(source (tangled gazagnaire.org/ocaml-json))
8
8
(license ISC)
9
-
(authors "Daniel Bünzli")
9
+
(authors "Daniel Bünzli" "Thomas Gazagnaire <thomas@gazagnaire.org>")
10
10
(maintainers "Thomas Gazagnaire <thomas@gazagnaire.org>")
11
11
12
12
(package
+7
-4
json.opam
+7
-4
json.opam
···
8
8
optional text-location tracking and layout preservation and is
9
9
compatible with effect-based concurrency."""
10
10
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
11
-
authors: ["Daniel Bünzli"]
11
+
authors: ["Daniel Bünzli" "Thomas Gazagnaire <thomas@gazagnaire.org>"]
12
12
license: "ISC"
13
13
tags: ["org:blacksun" "codec.text"]
14
-
homepage: "https://tangled.org/gazagnaire.org/ocaml-jsont"
15
-
bug-reports: "https://tangled.org/gazagnaire.org/ocaml-jsont/issues"
14
+
homepage: "https://tangled.org/gazagnaire.org/ocaml-json"
15
+
bug-reports: "https://tangled.org/gazagnaire.org/ocaml-json/issues"
16
16
depends: [
17
17
"ocaml" {>= "5.1"}
18
18
"dune" {>= "3.21" & >= "3.21"}
19
19
"bytesrw" {>= "0.1.0"}
20
20
"alcotest" {with-test}
21
21
"odoc" {with-doc}
22
+
"brr"
23
+
"fmt"
24
+
"loc"
22
25
]
23
26
build: [
24
27
["dune" "subst"] {dev}
···
34
37
"@doc" {with-doc}
35
38
]
36
39
]
37
-
dev-repo: "git+https://tangled.org/gazagnaire.org/ocaml-jsont"
40
+
dev-repo: "git+https://tangled.org/gazagnaire.org/ocaml-json"
38
41
x-maintenance-intent: ["(latest)"]
+22
-46
lib/brr/json_brr.ml
+22
-46
lib/brr/json_brr.ml
···
5
5
6
6
open Json.Codec
7
7
8
-
(* Converting between Json.Error.t and Jv.Error.t values *)
9
-
10
-
let error_to_jv_error e = Jv.Error.v (Jstr.of_string (Json.Error.to_string e))
11
-
12
8
let jv_error_to_error e =
13
9
let ctx = Json.Context.empty and meta = Json.Meta.none in
14
10
Json.Error.msg ~ctx ~meta (Jstr.to_string (Jv.Error.message e))
15
11
16
-
(* Browser JSON codec *)
12
+
(* Browser JSON runtime *)
17
13
18
-
let indent = Jstr.v " "
19
14
let json = Jv.get Jv.global "JSON"
20
15
let json_parse s = Jv.call json "parse" [| Jv.of_jstr s |]
21
16
22
-
let json_stringify ~format v =
17
+
let json_stringify ~indent v =
23
18
let args =
24
-
match format with
25
-
| Json.Minify -> [| v |]
26
-
| Json.Indent | Json.Layout -> [| v; Jv.null; Jv.of_jstr indent |]
19
+
match indent with
20
+
| None -> [| v |]
21
+
| Some n -> [| v; Jv.null; Jv.of_jstr (Jstr.v (String.make n ' ')) |]
27
22
in
28
23
Jv.to_jstr (Jv.call json "stringify" args)
29
24
30
-
(* Computing the sort of a Jv.t value *)
25
+
(* Sort inference over Jv.t *)
31
26
32
27
let type_bool = Jstr.v "boolean"
33
28
let type_object = Jstr.v "object"
···
46
41
else
47
42
Json.Error.failf Json.Meta.none "Not a JSON value: %s" (Jstr.to_string t)
48
43
49
-
(* Getting the members of a Jv.t object in various ways *)
50
-
51
44
let jv_mem_names jv = Jv.call (Jv.get Jv.global "Object") "keys" [| jv |]
52
45
let jv_mem_name_list jv = Jv.to_list Jv.to_string (jv_mem_names jv)
53
46
54
47
let jv_mem_name_map : Jv.t -> Jstr.t String_map.t =
55
48
fun jv ->
56
-
(* The map maps OCaml strings their corresponding JavaScript string *)
57
49
let rec loop ns i max m =
58
50
if i > max then m
59
51
else
···
144
136
fun map umems mem_decs dict names jv ->
145
137
let u _ _ _ =
146
138
assert false
147
-
(* They should be disjoint by contruction *)
139
+
(* disjoint by construction *)
148
140
in
149
141
let mem_decs = String_map.union u mem_decs map.mem_decs in
150
142
match map.shape with
···
259
251
| Array as s -> case t map.dec_array s jv
260
252
| Object as s -> case t map.dec_object s jv
261
253
262
-
let decode t jv = decode t jv
263
-
let decode_jv' t jv = try Ok (decode t jv) with Json.Error e -> Error e
264
-
let decode_jv t jv = Result.map_error error_to_jv_error (decode_jv' t jv)
265
-
266
-
let decode' t s =
267
-
try Ok (decode t (json_parse s)) with
268
-
| Jv.Error e -> Error (jv_error_to_error e)
269
-
| Json.Error e -> Error e
270
-
271
-
let decode t json = Result.map_error error_to_jv_error (decode' t json)
272
-
273
254
(* Encoding *)
274
255
275
256
let rec encode : type a. a t -> a -> Jv.t =
···
325
306
in
326
307
match u with
327
308
| Some (Unknown_keep (umap, enc)) ->
328
-
(* Feels nicer to encode unknowns at the end *)
329
309
let jv = encode_object case.object_map ~do_unknown:false v jv in
330
310
encode_unknown_mems map umap (enc o) jv
331
311
| _ -> encode_object case.object_map ~do_unknown v jv)
···
341
321
in
342
322
umap.enc (encode_mem map) mems jv
343
323
344
-
let encode t v = encode t v
345
-
let encode_jv' t v = try Ok (encode t v) with Json.Error e -> Error e
346
-
let encode_jv t v = Result.map_error error_to_jv_error (encode_jv' t v)
324
+
(* Public API — mirrors the core six-verb shape *)
347
325
348
-
let encode' ?(format = Json.Minify) t v =
349
-
try Ok (json_stringify ~format (encode t v)) with
350
-
| Jv.Error e -> Error (jv_error_to_error e)
351
-
| Json.Error e -> Error e
326
+
let of_jv_exn t jv = decode t jv
352
327
353
-
let encode ?format t v =
354
-
Result.map_error error_to_jv_error (encode' ?format t v)
355
-
356
-
(* Recode *)
328
+
let of_jv t jv =
329
+
match of_jv_exn t jv with v -> Ok v | exception Json.Error e -> Error e
357
330
358
-
let recode ?format t s =
359
-
match decode t s with Error _ as e -> e | Ok v -> encode ?format t v
331
+
let of_jstr_exn t s =
332
+
try decode t (json_parse s)
333
+
with Jv.Error e -> raise (Json.Error (jv_error_to_error e))
360
334
361
-
let recode' ?format t s =
362
-
match decode' t s with Error _ as e -> e | Ok v -> encode' ?format t v
335
+
let of_jstr t s =
336
+
match of_jstr_exn t s with v -> Ok v | exception Json.Error e -> Error e
363
337
364
-
let recode_jv t jv =
365
-
match decode_jv t jv with Error _ as e -> e | Ok v -> encode_jv t v
338
+
let to_jv t v = encode t v
366
339
367
-
let recode_jv' t s =
368
-
match decode_jv' t s with Error _ as e -> e | Ok v -> encode_jv' t v
340
+
let to_jstr ?indent ?preserve:_ t v =
341
+
(* Layout preservation is unsupported on the browser fast-path; the
342
+
[preserve] flag is accepted for signature compatibility and falls
343
+
back to the [indent] behaviour. *)
344
+
json_stringify ~indent (encode t v)
+25
-53
lib/brr/json_brr.mli
+25
-53
lib/brr/json_brr.mli
···
3
3
SPDX-License-Identifier: ISC
4
4
---------------------------------------------------------------------------*)
5
5
6
-
(** JavaScript support.
6
+
(** Browser-native JSON fast-path.
7
7
8
-
{b Note.} These functions incur a bit of overhead but should work fast
9
-
enough for medium sized structures. Get in touch if you run into problems,
10
-
some improvements may be possible.
8
+
Mirrors {!Json}'s six-verb shape with the browser's native types:
9
+
- [Jstr.t] replaces [string] (browser-native string)
10
+
- [Jv.t] replaces [Bytes.Reader.t] / the raw JS value (zero-copy path)
11
11
12
-
The JSON functions use JavaScript's
12
+
Parses and serialisations go through JavaScript's
13
13
{{:https://developer.mozilla.org/en/docs/Web/JavaScript/Reference/Global_Objects/JSON/parse}
14
14
[JSON.parse]} and
15
15
{{:https://developer.mozilla.org/en/docs/Web/JavaScript/Reference/Global_Objects/JSON/stringify}
16
-
[JSON.stringify]} to convert to JavaScript values which are then converted
17
-
with {!decode_jv} and {!encode_jv}. Parse locations and layout preservation
18
-
are unsupported. *)
19
-
20
-
(** {1:decode Decode} *)
16
+
[JSON.stringify]}. Source locations and layout preservation are not
17
+
supported by the browser runtime; the [~preserve] flag is accepted for
18
+
signature compatibility but falls back to [~indent] behaviour. *)
21
19
22
-
val decode : 'a Json.codec -> Jstr.t -> ('a, Jv.Error.t) result
23
-
(** [decode t s] decodes the JSON data [s] according to [t]. *)
24
-
25
-
val decode' : 'a Json.codec -> Jstr.t -> ('a, Json.Error.t) result
26
-
(** [decode' t s] is like {!val-decode} but preserves the error structure. *)
27
-
28
-
val decode_jv : 'a Json.codec -> Jv.t -> ('a, Jv.Error.t) result
29
-
(** [decode_jv t v] decodes the JavaScript value [v] according to [t]. *)
30
-
31
-
val decode_jv' : 'a Json.codec -> Jv.t -> ('a, Json.Error.t) result
32
-
(** [decode_jv'] is like {!decode_jv'} but preserves the error structure. *)
33
-
34
-
(** {1:encode Encode} *)
35
-
36
-
val encode :
37
-
?format:Json.format -> 'a Json.codec -> 'a -> (Jstr.t, Jv.Error.t) result
38
-
(** [encode t v] encodes [v] to JSON according to [t]. [format] specifies how
39
-
the JSON is formatted, defaults to {!Json.Minify}. The {!Json.Layout} format
40
-
is unsupported, {!Json.Indent} is used instead. *)
41
-
42
-
val encode' :
43
-
?format:Json.format -> 'a Json.codec -> 'a -> (Jstr.t, Json.Error.t) result
44
-
(** [encode'] is like {!val-encode} but preserves the error structure. [format]
45
-
specifies how the JSON is formatted, defaults to {!Json.Minify}. The
46
-
{!Json.Layout} format is unsupported, {!Json.Indent} is used instead. *)
20
+
(** {1:jstr From / to browser strings} *)
47
21
48
-
val encode_jv : 'a Json.codec -> 'a -> (Jv.t, Jv.Error.t) result
49
-
(** [encode_jv t v] encodes [v] to a JavaScript value according to [t]. *)
22
+
val of_jstr : 'a Json.codec -> Jstr.t -> ('a, Json.Error.t) result
23
+
(** [of_jstr t s] decodes the JSON string [s] according to [t]. *)
50
24
51
-
val encode_jv' : 'a Json.codec -> 'a -> (Jv.t, Json.Error.t) result
52
-
(** [encode_jv'] is like {!val-encode_jv} but preserves the error structure. *)
25
+
val of_jstr_exn : 'a Json.codec -> Jstr.t -> 'a
26
+
(** [of_jstr_exn] is like {!val-of_jstr} but raises {!Json.exception-Error}. *)
53
27
54
-
(** {1:recode Recode} *)
28
+
val to_jstr : ?indent:int -> ?preserve:bool -> 'a Json.codec -> 'a -> Jstr.t
29
+
(** [to_jstr t v] encodes [v] to JSON according to [t]. See
30
+
{!Json.val-to_string} for the semantics of [~indent] and [~preserve]. *)
55
31
56
-
val recode :
57
-
?format:Json.format -> 'a Json.codec -> Jstr.t -> (Jstr.t, Jv.Error.t) result
58
-
(** [recode] is {!val-decode} followed by {!val-encode}. *)
32
+
(** {1:jv From / to raw JS values (zero-copy)} *)
59
33
60
-
val recode' :
61
-
?format:Json.format ->
62
-
'a Json.codec ->
63
-
Jstr.t ->
64
-
(Jstr.t, Json.Error.t) result
65
-
(** [recode'] is {!val-decode'} followed by {!val-encode'}. *)
34
+
val of_jv : 'a Json.codec -> Jv.t -> ('a, Json.Error.t) result
35
+
(** [of_jv t jv] decodes the JavaScript value [jv] according to [t] without a
36
+
parse step. *)
66
37
67
-
val recode_jv : 'a Json.codec -> Jv.t -> (Jv.t, Jv.Error.t) result
68
-
(** [recode_jv] is {!val-decode_jv} followed by {!val-encode_jv}. *)
38
+
val of_jv_exn : 'a Json.codec -> Jv.t -> 'a
39
+
(** [of_jv_exn] is like {!val-of_jv} but raises {!Json.exception-Error}. *)
69
40
70
-
val recode_jv' : 'a Json.codec -> Jv.t -> (Jv.t, Json.Error.t) result
71
-
(** [recode_jv'] is {!val-decode_jv'} followed by {!encode_jv'}. *)
41
+
val to_jv : 'a Json.codec -> 'a -> Jv.t
42
+
(** [to_jv t v] encodes [v] to a JavaScript value according to [t] without a
43
+
serialisation step. *)
+18
-38
lib/json.ml
+18
-38
lib/json.ml
···
58
58
59
59
let meta = Value.meta
60
60
let set_meta = Value.set_meta
61
-
let get_meta = Value.get_meta
62
61
let copy_layout = Value.copy_layout
63
62
let sort = Value.sort
64
63
···
1157
1156
try
1158
1157
if map.dec_skip i b then b
1159
1158
else map.dec_add i (decode_exn map.elt v) b
1160
-
with Error e -> error_push_array meta map (i, Ast.get_meta v) e
1159
+
with Error e -> error_push_array meta map (i, Ast.meta v) e
1161
1160
in
1162
1161
next map meta b (i + 1) vs
1163
1162
in
···
1690
1689
1691
1690
(* Formatting *)
1692
1691
1692
+
(* Internal representation of the encoder's whitespace strategy, derived
1693
+
from the public ?indent / ?preserve arguments via [format_of_args]. *)
1693
1694
type format = Minify | Indent | Layout
1694
1695
1696
+
let format_of_args ~indent ~preserve =
1697
+
if preserve then Layout
1698
+
else match indent with None -> Minify | Some _ -> Indent
1699
+
1695
1700
let pp_value ?number_format t () =
1696
1701
fun ppf v ->
1697
1702
match encode t v with
···
2833
2838
number_format : string;
2834
2839
}
2835
2840
2836
-
let encoder ?buf ?(format = Minify) ?(number_format = default_number_format)
2837
-
writer =
2841
+
let encoder ?buf ?indent ?(preserve = false)
2842
+
?(number_format = default_number_format) writer =
2843
+
let format = format_of_args ~indent ~preserve in
2838
2844
let o =
2839
2845
match buf with
2840
2846
| Some buf -> buf
···
3153
3159
in
3154
3160
umap.enc (encode_unknown_mem ~nest map umap e) mems start
3155
3161
3156
-
let to_writer ?buf ?format ?number_format t v ~eod w =
3157
-
let e = encoder ?buf ?format ?number_format w in
3162
+
let to_writer ?buf ?indent ?preserve ?number_format t v ~eod w =
3163
+
let e = encoder ?buf ?indent ?preserve ?number_format w in
3158
3164
write ~nest:0 t e v;
3159
3165
write_eot ~eod e
3160
3166
3161
-
let to_string ?buf ?format ?number_format t v =
3167
+
let to_string ?buf ?indent ?preserve ?number_format t v =
3162
3168
let b = Buffer.create 255 in
3163
3169
let w = Bytes.Writer.of_buffer b in
3164
-
to_writer ?buf ?format ?number_format ~eod:true t v w;
3170
+
to_writer ?buf ?indent ?preserve ?number_format ~eod:true t v w;
3165
3171
Buffer.contents b
3166
3172
3167
-
(* Recode *)
3168
-
3169
-
let unsurprising_defaults layout format =
3170
-
match (layout, format) with
3171
-
| Some true, None -> (Some true, Some Layout)
3172
-
| None, (Some Layout as l) -> (Some true, l)
3173
-
| l, f -> (l, f)
3174
-
3175
-
let recode_exn ?layout ?locs ?file ?buf ?format ?number_format t r w ~eod =
3176
-
let layout, format = unsurprising_defaults layout format in
3177
-
let v = of_reader_exn ?layout ?locs ?file t r in
3178
-
to_writer ?buf ?format ?number_format t v ~eod w
3179
-
3180
-
let recode ?layout ?locs ?file ?buf ?format ?number_format t r w ~eod =
3181
-
try Ok (recode_exn ?layout ?locs ?file ?buf ?format ?number_format t r w ~eod)
3182
-
with Error e -> Error e
3183
-
3184
-
let recode_string_exn ?layout ?locs ?file ?buf ?format ?number_format t s =
3185
-
let layout, format = unsurprising_defaults layout format in
3186
-
let v = of_string_exn ?layout ?locs ?file t s in
3187
-
to_string ?buf ?format ?number_format t v
3188
-
3189
-
let recode_string ?layout ?locs ?file ?buf ?format ?number_format t s =
3190
-
try Ok (recode_string_exn ?layout ?locs ?file ?buf ?format ?number_format t s)
3191
-
with Error e -> Error e
3192
-
3193
3173
module Value = struct
3194
3174
let of_string ?layout ?locs ?file s =
3195
3175
of_string ?layout ?locs ?file Codec.Value.t s
···
3203
3183
let of_reader_exn ?layout ?locs ?file r =
3204
3184
of_reader_exn ?layout ?locs ?file Codec.Value.t r
3205
3185
3206
-
let to_string ?buf ?format ?number_format v =
3207
-
to_string ?buf ?format ?number_format Codec.Value.t v
3186
+
let to_string ?buf ?indent ?preserve ?number_format v =
3187
+
to_string ?buf ?indent ?preserve ?number_format Codec.Value.t v
3208
3188
3209
-
let to_writer ?buf ?format ?number_format v ~eod w =
3210
-
to_writer ?buf ?format ?number_format Codec.Value.t v ~eod w
3189
+
let to_writer ?buf ?indent ?preserve ?number_format v ~eod w =
3190
+
to_writer ?buf ?indent ?preserve ?number_format Codec.Value.t v ~eod w
3211
3191
end
+31
-82
lib/json.mli
+31
-82
lib/json.mli
···
181
181
[string (Float.to_string v)] otherwise. See {!Codec.any_float}. *)
182
182
183
183
val int32 : int32 cons
184
-
(** [int32 i] is [i] as a JSON number. *)
184
+
(** [int32] encodes OCaml's int32 into a JSON number. *)
185
185
186
186
val int64 : int64 cons
187
-
(** [int64 i] is [i] as a JSON number or a JSON string if not in the range
188
-
\[-2{^ 53};2{^ 53}\]. See also {!int64_as_string}. *)
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
189
190
190
val int64_as_string : int64 cons
191
-
(** [int64_as_string i] is [i] as a JSON string. See also {!int64}. *)
191
+
(** [int64_as_string] encodes OCaml's int64 into a JSON string. See also
192
+
{!int64}. *)
192
193
193
194
val int : int cons
194
-
(** [int i] is [i] as a JSON number or a JSON string if not in the range
195
-
\[-2{^ 53};2{^ 53}\]. See also {!int_as_string}. *)
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}. *)
196
197
197
198
val int_as_string : int cons
198
-
(** [int_as_string i] is [i] as a JSON string. See also {!int}. *)
199
+
(** [int_as_string] encodes OCaml's int into a JSON string. See also {!int}. *)
199
200
200
201
val string : string cons
201
202
(** [string s] is [String (s, meta)]. *)
···
249
250
val set_meta : Meta.t -> t -> t
250
251
(** [set_meta m v] replaces [v]'s meta with [m]. *)
251
252
252
-
val get_meta : t -> Meta.t
253
-
(** [get_meta v] is {!meta}. *)
254
-
255
253
val copy_layout : t -> dst:t -> t
256
254
(** [copy_layout src ~dst] copies the layout of [src] and sets it on [dst] using
257
255
{!Meta.copy_ws}. *)
···
302
300
[fnd]. *)
303
301
304
302
(** {1:formatting Formatting} *)
305
-
306
-
(** The type for specifying JSON encoding formatting. See for example
307
-
{!Json_bytesrw.val-encode}. *)
308
-
type format =
309
-
| Minify (** Compact. No whitespace, no newlines. *)
310
-
| Indent (** Indented output (not necessarily pretty). *)
311
-
| Layout (** Follow {!Meta} layout information. *)
312
303
313
304
type number_format = (float -> unit, Format.formatter, unit) Stdlib.format
314
305
(** The type for JSON number formatters. *)
···
1331
1322
type t = Codec.Dict.t
1332
1323
1333
1324
val empty : t
1325
+
(** [empty] is the empty dictionary. *)
1326
+
1334
1327
val mem : 'a Type.Id.t -> t -> bool
1328
+
(** [mem k d] is [true] iff [d] has a binding for [k]. *)
1329
+
1335
1330
val add : 'a Type.Id.t -> 'a -> t -> t
1331
+
(** [add k v d] is [d] with [k] bound to [v]. *)
1332
+
1336
1333
val remove : 'a Type.Id.t -> t -> t
1334
+
(** [remove k d] is [d] with any binding for [k] removed. *)
1335
+
1337
1336
val find : 'a Type.Id.t -> t -> 'a option
1337
+
(** [find k d] is the value bound to [k] in [d] or [None]. *)
1338
1338
end
1339
1339
1340
1340
val apply_dict : ('ret, 'f) dec_fun -> Dict.t -> 'f
···
1526
1526
1527
1527
val to_writer :
1528
1528
?buf:Bytes.t ->
1529
-
?format:format ->
1529
+
?indent:int ->
1530
+
?preserve:bool ->
1530
1531
?number_format:number_format ->
1531
1532
'a codec ->
1532
1533
'a ->
···
1538
1539
runtime condition).
1539
1540
- If [buf] is specified it is used as a buffer for the slices written on
1540
1541
[w]. Defaults to a buffer of length {!Bytes.Writer.slice_length}[ w].
1541
-
- [format] specifies how the JSON should be formatted. Defaults to
1542
-
{!Minify}.
1542
+
- [indent] controls pretty-printing for nodes without source {!Meta.t}.
1543
+
Defaults to [None] (compact: no whitespace, no newlines). [Some n] indents
1544
+
nested structures by [n] spaces per level.
1545
+
- [preserve] defaults to [false]. When [true], nodes carrying a non-
1546
+
{!Meta.none} {!Meta.t} reproduce their source whitespace byte-for-byte;
1547
+
nodes with {!Meta.none} fall back to the [indent] behaviour.
1543
1548
- [number_format] specifies the format string to format numbers. Defaults to
1544
1549
{!default_number_format}.
1545
1550
- [eod] indicates whether {!Bytesrw.Bytes.Slice.eod} should be written on
···
1547
1552
1548
1553
val to_string :
1549
1554
?buf:Bytes.t ->
1550
-
?format:format ->
1555
+
?indent:int ->
1556
+
?preserve:bool ->
1551
1557
?number_format:number_format ->
1552
1558
'a codec ->
1553
1559
'a ->
···
1555
1561
(** [to_string] is like {!val-to_writer} but writes to a string. Raises
1556
1562
{!Json.exception-Error} on broken codecs. *)
1557
1563
1558
-
(** {1:recode Recode}
1559
-
1560
-
The defaults in these functions are those of {!val-of_reader} and
1561
-
{!val-to_writer}, except if [layout] is [true], [format] defaults to
1562
-
[Layout] and vice-versa. *)
1563
-
1564
-
val recode :
1565
-
?layout:bool ->
1566
-
?locs:bool ->
1567
-
?file:Loc.fpath ->
1568
-
?buf:Bytes.t ->
1569
-
?format:format ->
1570
-
?number_format:number_format ->
1571
-
'a codec ->
1572
-
Bytes.Reader.t ->
1573
-
Bytes.Writer.t ->
1574
-
eod:bool ->
1575
-
(unit, Error.t) result
1576
-
(** [recode] is {!val-of_reader} followed by {!val-to_writer}. *)
1577
-
1578
-
val recode_exn :
1579
-
?layout:bool ->
1580
-
?locs:bool ->
1581
-
?file:Loc.fpath ->
1582
-
?buf:Bytes.t ->
1583
-
?format:format ->
1584
-
?number_format:number_format ->
1585
-
'a codec ->
1586
-
Bytes.Reader.t ->
1587
-
Bytes.Writer.t ->
1588
-
eod:bool ->
1589
-
unit
1590
-
(** [recode_exn] is like {!val-recode} but raises {!Json.exception-Error}. *)
1591
-
1592
-
val recode_string :
1593
-
?layout:bool ->
1594
-
?locs:bool ->
1595
-
?file:Loc.fpath ->
1596
-
?buf:Bytes.t ->
1597
-
?format:format ->
1598
-
?number_format:number_format ->
1599
-
'a codec ->
1600
-
string ->
1601
-
(string, Error.t) result
1602
-
(** [recode_string] is {!of_string} followed by {!to_string}. *)
1603
-
1604
-
val recode_string_exn :
1605
-
?layout:bool ->
1606
-
?locs:bool ->
1607
-
?file:Loc.fpath ->
1608
-
?buf:Bytes.t ->
1609
-
?format:format ->
1610
-
?number_format:number_format ->
1611
-
'a codec ->
1612
-
string ->
1613
-
string
1614
-
(** [recode_string_exn] is like {!val-recode_string} but raises
1615
-
{!Json.exception-Error}. *)
1616
-
1617
1564
(** {1:layout Layout preservation}
1618
1565
1619
1566
In order to simplify the implementation not all layout is preserved. In
···
1666
1613
1667
1614
val to_string :
1668
1615
?buf:Bytes.t ->
1669
-
?format:format ->
1616
+
?indent:int ->
1617
+
?preserve:bool ->
1670
1618
?number_format:number_format ->
1671
1619
t ->
1672
1620
string
···
1674
1622
1675
1623
val to_writer :
1676
1624
?buf:Bytes.t ->
1677
-
?format:format ->
1625
+
?indent:int ->
1626
+
?preserve:bool ->
1678
1627
?number_format:number_format ->
1679
1628
t ->
1680
1629
eod:bool ->
-1
lib/value.ml
-1
lib/value.ml
-3
lib/value.mli
-3
lib/value.mli
···
41
41
val set_meta : Meta.t -> t -> t
42
42
(** [set_meta m v] replaces [v]'s metadata with [m]. *)
43
43
44
-
val get_meta : t -> Meta.t
45
-
(** [get_meta v] is {!meta} (legacy name). *)
46
-
47
44
val copy_layout : t -> dst:t -> t
48
45
(** [copy_layout src ~dst] copies [src]'s whitespace/layout metadata onto [dst].
49
46
*)
+5
-1
test/codecs/quickstart.ml
+5
-1
test/codecs/quickstart.ml
···
13
13
let () =
14
14
let p = Json.Path.(root |> mem "tags" |> nth 1) in
15
15
let update = Json.(set_path string p "software") in
16
-
let correct = Json.recode_string ~layout:true update data in
16
+
let correct =
17
+
Result.map
18
+
(fun v -> Json.to_string ~preserve:true update v)
19
+
(Json.of_string ~layout:true update data)
20
+
in
17
21
print_endline (Result.get_ok correct)
18
22
19
23
module Status = struct
+6
-8
test/codecs/test_brr.ml
+6
-8
test/codecs/test_brr.ml
···
8
8
9
9
(* Tests the common test suite with the Jsont_brr codec. *)
10
10
11
-
let error_to_string e = Jstr.to_string (Jv.Error.message e)
12
-
13
-
let decode ?layout t json =
14
-
Result.map_error error_to_string @@ Jsont_brr.decode t (Jstr.v json)
11
+
let decode ?layout:_ t json =
12
+
match Jsont_brr.of_jstr t (Jstr.v json) with
13
+
| Ok v -> Ok v
14
+
| Error e -> Error (Json.Error.to_string e)
15
15
16
-
let encode ?format t v =
17
-
match Jsont_brr.encode ?format t v with
18
-
| Ok v -> Ok (Jstr.to_string v)
19
-
| Error e -> Error (error_to_string e)
16
+
let encode ?indent ?preserve t v =
17
+
Ok (Jstr.to_string (Jsont_brr.to_jstr ?indent ?preserve t v))
20
18
21
19
let test_funs = { Test_common.supports_layout = false; decode; encode }
22
20
+1
-1
test/codecs/test_bytesrw.ml
+1
-1
test/codecs/test_bytesrw.ml
···
10
10
(* Tests the common test suite with the Jsont_bytesrw codec. *)
11
11
12
12
let decode ?layout t json = Json.of_string ?layout ~locs:true t json
13
-
let encode ?format t v = Json.to_string ?format t v
13
+
let encode ?indent ?preserve t v = Json.to_string ?indent ?preserve t v
14
14
let test_funs = { Test_common.supports_layout = true; decode; encode }
15
15
16
16
(* Other tests *)
+59
-43
test/codecs/test_common.ml
+59
-43
test/codecs/test_common.ml
···
15
15
supports_layout : bool;
16
16
decode : 'a. ?layout:bool -> 'a Json.codec -> string -> ('a, string) result;
17
17
encode :
18
-
'a. ?format:Json.format -> 'a Json.codec -> 'a -> (string, string) result;
18
+
'a.
19
+
?indent:int option ->
20
+
?preserve:bool ->
21
+
'a Json.codec ->
22
+
'a ->
23
+
(string, string) result;
19
24
}
20
25
26
+
(* Shorthand used by test sites. Maps onto ?indent / ?preserve below. *)
27
+
type format = Minify | Indent | Layout
28
+
29
+
let args_of_format = function
30
+
| Minify -> (None, false)
31
+
| Indent -> (Some 2, false)
32
+
| Layout -> (None, true)
33
+
21
34
let test_funs : test_funs ref =
22
35
ref
23
36
{
24
37
supports_layout = false;
25
-
decode = (fun ?layout _ _ -> assert false);
26
-
encode = (fun ?format _ _ -> assert false);
38
+
decode = (fun ?layout:_ _ _ -> assert false);
39
+
encode = (fun ?indent:_ ?preserve:_ _ _ -> assert false);
27
40
}
28
41
29
42
let supports_layout () = !test_funs.supports_layout
30
43
let decode ?layout t json = !test_funs.decode ?layout t json
31
-
let encode ?format t v = !test_funs.encode ?format t v
44
+
45
+
let encode ?format t v =
46
+
let indent, preserve =
47
+
match format with None -> (None, false) | Some f -> args_of_format f
48
+
in
49
+
!test_funs.encode ~indent ~preserve t v
32
50
33
51
(* Test combinators
34
52
···
67
85
| None -> ()
68
86
| Some msg -> Test.styled_string msg e ~__POS__)
69
87
70
-
let update ?__POS__:pos ?(format = Json.Minify) q j j' =
71
-
let layout = format = Json.Layout in
88
+
let update ?__POS__:pos ?(format = Minify) q j j' =
89
+
let layout = format = Layout in
72
90
Test.block ?__POS__:pos @@ fun () ->
73
91
match decode ~layout q j with
74
92
| Error e -> Test.fail "%a" Fmt.lines e ~__POS__
75
-
| Ok v when supports_layout () || not (format = Json.Layout) ->
93
+
| Ok v when supports_layout () || not (format = Layout) ->
76
94
encode_ok ~format Json.json ~value:v j' ~__POS__
77
95
| Ok v ->
78
96
let j' =
79
-
encode ~format:Json.Indent Json.t (decode Json.json j' |> Result.get_ok)
97
+
encode ~format:Indent Json.t (decode Json.json j' |> Result.get_ok)
80
98
|> Result.get_ok
81
99
in
82
-
encode_ok ~format:Json.Indent Json.json ~value:v j' ~__POS__
100
+
encode_ok ~format:Indent Json.json ~value:v j' ~__POS__
83
101
84
102
(* [trip t src] is the über testing combinator.
85
103
···
87
105
that the generated JSON [trip] has the same data unless [lossy] is
88
106
specified. If [value] is provided both decodes of [src] and [trip]
89
107
are tested against [value]. If [format] is specified with
90
-
[Json.Indent] or [Json.Layout] it assumes that [src] and [trip]
108
+
[Indent] or [Layout] it assumes that [src] and [trip]
91
109
must be equal *)
92
110
93
-
let trip ?(format = Json.Minify) ?(lossy = false) ?value ?(eq = Test.T.any)
111
+
let trip ?(format = Minify) ?(lossy = false) ?value ?(eq = Test.T.any)
94
112
?__POS__:pos t src =
95
113
Test.block ?__POS__:pos @@ fun () ->
96
-
let layout = format = Json.Layout in
114
+
let layout = format = Layout in
97
115
let v =
98
116
Test.noraise ~__POS__ @@ fun () -> Result.get_ok' (decode ~layout t src)
99
117
in
···
116
134
in
117
135
Test.eq (module Json.Json) json trip ~__POS__
118
136
end;
119
-
if format <> Json.Minify then
120
-
begin if format = Json.Layout && not (supports_layout ()) then ()
137
+
if format <> Minify then
138
+
begin if format = Layout && not (supports_layout ()) then ()
121
139
else
122
140
(* Test that src is a representation of the requested encoding format *)
123
141
Test.string src trip ~__POS__
···
525
543
decode_ok Json.(nth 1 @@ nth 1 int) a ~value:2 ~__POS__;
526
544
decode_ok Json.(nth 1 @@ list int) a ~value:[ 1; 2 ] ~__POS__;
527
545
(* Json.{set,update}_nth} *)
528
-
update ~format:Json.Layout
546
+
update ~format:Layout
529
547
Json.(update_nth 1 @@ update_nth 1 Json.(const int 4))
530
548
a "[1,[ 1, 4], 3] " ~__POS__;
531
-
update ~format:Json.Layout
549
+
update ~format:Layout
532
550
Json.(update_nth 1 @@ set_nth int 0 2)
533
551
a "[1,[ 2, 2], 3] " ~__POS__;
534
552
decode_error Json.(update_nth 1 @@ set_nth int 2 3) a;
535
553
decode_error Json.(update_nth 3 int) a;
536
-
update ~format:Json.Layout
537
-
Json.(update_nth 3 ~absent:5 int)
538
-
a "[1,[ 1, 2], 3,5] ";
539
-
update ~format:Json.Layout
554
+
update ~format:Layout Json.(update_nth 3 ~absent:5 int) a "[1,[ 1, 2], 3,5] ";
555
+
update ~format:Layout
540
556
Json.(update_nth 1 @@ set_nth ~allow_absent:true int 3 3)
541
557
a "[1,[ 1, 2,0,3], 3] " ~__POS__;
542
-
update ~format:Json.Layout
558
+
update ~format:Layout
543
559
Json.(
544
560
update_nth 1
545
561
@@ set_nth ~stub:(Json.Value.null ()) ~allow_absent:true int 3 3)
546
562
a "[1,[ 1, 2,null,3], 3] " ~__POS__;
547
-
update ~format:Json.Layout
563
+
update ~format:Layout
548
564
Json.(update_nth 1 @@ update_nth 1 recode_int_to_string)
549
565
a "[1,[ 1, \"2\"], 3] " ~__POS__;
550
566
update Json.(update_nth 1 @@ delete_nth 0) a "[1,[2],3]" ~__POS__;
···
560
576
if v mod 2 = 0 then None else Some (v - 1)))
561
577
a "[1,[0],3]" ~__POS__;
562
578
(* Json.delete_nth *)
563
-
update ~format:Json.Layout Json.(delete_nth 1) a "[1, 3] " ~__POS__;
579
+
update ~format:Layout Json.(delete_nth 1) a "[1, 3] " ~__POS__;
564
580
decode_error Json.(delete_nth 3) a ~__POS__;
565
-
update ~format:Json.Layout Json.(delete_nth ~allow_absent:true 3) a a ~__POS__;
581
+
update ~format:Layout Json.(delete_nth ~allow_absent:true 3) a a ~__POS__;
566
582
(* Json.filter_map_array *)
567
-
update ~format:Json.Layout
583
+
update ~format:Layout
568
584
Json.(
569
585
filter_map_array Json.json Json.json (fun i v ->
570
586
if i = 1 then None else Some v))
···
583
599
decode_error Json.(mem "a" @@ mem "c" int) o ~__POS__;
584
600
decode_ok Json.(mem "a" @@ mem ~absent:3 "c" int) o ~value:3 ~__POS__;
585
601
(* Json.{update,set}_mem *)
586
-
update ~format:Json.Layout
602
+
update ~format:Layout
587
603
Json.(update_mem "a" @@ update_mem "b" (const int 3))
588
604
o {| { "a" : { "b" : 3 }, "c": 2 } |} ~__POS__;
589
-
update ~format:Json.Layout
605
+
update ~format:Layout
590
606
Json.(update_mem "a" @@ update_mem "b" recode_int_to_string)
591
607
o {| { "a" : { "b" : "1" }, "c": 2 } |} ~__POS__;
592
608
decode_error Json.(update_mem "a" @@ update_mem "c" (const int 4)) o ~__POS__;
593
-
update ~format:Json.Layout
609
+
update ~format:Layout
594
610
Json.(update_mem "a" @@ update_mem "c" ~absent:4 (const int 5))
595
611
o {| { "a" : { "b" : 1 ,"c":5}, "c": 2 } |} ~__POS__;
596
-
update ~format:Json.Layout
612
+
update ~format:Layout
597
613
Json.(set_mem int "a" 2)
598
614
o {| { "a" : 2, "c": 2 } |} ~__POS__;
599
615
decode_error Json.(set_mem int "d" 2) o ~__POS__;
600
-
update ~format:Json.Layout
616
+
update ~format:Layout
601
617
Json.(set_mem ~allow_absent:true int "d" 3)
602
618
o {| { "a" : { "b" : 1 }, "c": 2 ,"d":3} |} ~__POS__;
603
619
(* Json.delete_mem *)
604
620
decode_error Json.(update_mem "a" @@ delete_mem "c") o ~__POS__;
605
-
update ~format:Json.Layout
621
+
update ~format:Layout
606
622
Json.(update_mem "a" @@ delete_mem ~allow_absent:true "c")
607
623
o o ~__POS__;
608
-
update ~format:Json.Layout
624
+
update ~format:Layout
609
625
Json.(update_mem "a" @@ delete_mem "b")
610
626
o {| { "a" : {}, "c": 2 } |} ~__POS__;
611
-
update ~format:Json.Layout Json.(delete_mem "a") o {| { "c": 2 } |} ~__POS__;
627
+
update ~format:Layout Json.(delete_mem "a") o {| { "c": 2 } |} ~__POS__;
612
628
(* Json.filter_map_object *)
613
-
update ~format:Json.Layout
629
+
update ~format:Layout
614
630
Json.(
615
631
filter_map_object Json.json Json.json (fun m n v ->
616
632
if n = "a" then None else Some ((n, m), v)))
···
626
642
let v = {| [ 0, { "a": 1}, 2 ] |} in
627
643
(* Json.path *)
628
644
decode_error Json.(path Path.root int) v ~__POS__;
629
-
update ~format:Json.Layout Json.(path Path.root Json.t) v v ~__POS__;
645
+
update ~format:Layout Json.(path Path.root Json.t) v v ~__POS__;
630
646
decode_ok Json.(path Path.(root |> nth 1 |> mem "a") int) v ~value:1;
631
647
decode_ok
632
648
Json.(path Path.(root |> nth 1 |> mem "b") ~absent:2 int)
633
649
v ~value:2 ~__POS__;
634
650
(* Json.{set,update}_path} *)
635
-
update ~format:Json.Layout Json.(set_path int Path.root 2) v {|2|} ~__POS__;
636
-
update ~format:Json.Layout
651
+
update ~format:Layout Json.(set_path int Path.root 2) v {|2|} ~__POS__;
652
+
update ~format:Layout
637
653
Json.(set_path string Path.(root |> nth 1 |> mem "a") "hey")
638
654
v {| [ 0, { "a": "hey"}, 2 ] |} ~__POS__;
639
-
update ~format:Json.Layout
655
+
update ~format:Layout
640
656
Json.(
641
657
set_path ~allow_absent:true string Path.(root |> nth 1 |> mem "b") "hey")
642
658
v {| [ 0, { "a": 1,"b":"hey"}, 2 ] |} ~__POS__;
643
-
update ~format:Json.Layout
659
+
update ~format:Layout
644
660
Json.(
645
661
update_path
646
662
Path.(root |> nth 1 |> mem "a")
647
663
(map int ~dec:succ ~enc:Fun.id))
648
664
v {| [ 0, { "a": 2}, 2 ] |} ~__POS__;
649
665
(* Json.delete_path *)
650
-
update ~format:Json.Layout
666
+
update ~format:Layout
651
667
Json.(delete_path Path.(root |> nth 1 |> mem "a"))
652
668
v {| [ 0, {}, 2 ] |} ~__POS__;
653
-
update ~format:Json.Layout
669
+
update ~format:Layout
654
670
Json.(delete_path Path.(root |> nth 1))
655
671
v {| [ 0, 2 ] |} ~__POS__;
656
-
update ~format:Json.Layout Json.(delete_path Path.root) v {|null|} ~__POS__;
672
+
update ~format:Layout Json.(delete_path Path.root) v {|null|} ~__POS__;
657
673
decode_error Json.(delete_path Path.(root |> nth 1 |> mem "b")) v ~__POS__;
658
-
update ~format:Json.Layout
674
+
update ~format:Layout
659
675
Json.(delete_path ~allow_absent:true Path.(root |> nth 1 |> mem "b"))
660
676
v v ~__POS__;
661
677
()
+2
-2
test/codecs/test_json.ml
+2
-2
test/codecs/test_json.ml
···
18
18
| Error _ as e -> e
19
19
| Ok json -> Json.Value.decode t json
20
20
21
-
let encode ?format t v =
21
+
let encode ?indent ?preserve t v =
22
22
match Json.Value.encode t v with
23
23
| Error _ as e -> e
24
-
| Ok json -> Json.to_string ?format Json.json json
24
+
| Ok json -> Json.to_string ?indent ?preserve Json.json json
25
25
26
26
let test_funs = { Test_common.supports_layout = true; decode; encode }
27
27
+1
-1
test/test_json.ml
+1
-1
test/test_json.ml
···
7
7
2. Differential property: on any string, [Json.Codec.ignore] and
8
8
[Json.t] agree on Ok/Error status. [Json.Codec.ignore] is allowed
9
9
to be more permissive (accept where [Json.t] errors) only at
10
-
content level -- never at structural level. Crowbar generates
10
+
content level -- never at structural level. Alcobar generates
11
11
random inputs and asserts the invariant. *)
12
12
13
13
let decode_ignore s = Json.of_string Json.Codec.ignore s