Declarative JSON data manipulation for OCaml
ocaml-json: follow-up Jsont -> Json cleanup
Expose Json.Error (and the Error exception) from Json.mli, tighten
odoc cross-references across codec / tape / brr mlis, and drop the
now-obsolete Jsont test files (test_brr, test_bytesrw, test_common,
test_json, test_jsont_tool, test_seriot_suite). CHANGES.md pruned to
remove entries that referred to the pre-rename API.
+201
-1670
+8
-33
CHANGES.md
+8
-33
CHANGES.md
···
1
-
v0.2.0 2025-07-25 Zagreb
2
-
------------------------
1
+
Unreleased
2
+
----------
3
3
4
-
- Fix `Jsont_bytesrw.{encode,encode'}`. Do not write the `eod` slice if
5
-
`eod:false` is specified. Thanks to Benjamin Nguyen-Van-Yen for
6
-
the report and the fix (#8).
7
-
- Fix `Jsont.zero` failing encodes rather than encoding `null` as
8
-
advertised. Thanks to Adrián Montesinos González for the report (#6).
9
-
- Add `Jsont.Error.expected` to help format error messages.
10
-
- Add `Jsont.with_doc` to update kind and doc strings of existing JSON
11
-
types.
12
-
- Add `Jsont.Object.Case.{tag,map_tag}` to access a case and case map tags.
13
-
- Fix `META` file. Really export all requires and
14
-
remove uneeded `bytesrw` dependency from `jsont` library.
15
-
16
-
v0.1.1 2024-12-06 La Forclaz (VS)
17
-
---------------------------------
18
-
19
-
- `Jsont.Object.Mems.map` make encoding and decoding optional. Like
20
-
in every other map.
21
-
- `Jsont.Array.map` make encoding and decoding optional. Like
22
-
in every other map.
23
-
- `Jsont_bytesrw.encode` change the default buffer size
24
-
to match the one hinted by the writer rather than
25
-
`Bytesrw.Bytes.Slice.io_buffer_size`.
26
-
- `jsont.{bytesrw,brr}` export all requires.
27
-
- `jsont` tool remove spurious dependency on `b0.std` (#2).
28
-
29
-
v0.1.0 2024-11-29 Zagreb
30
-
------------------------
31
-
32
-
First release.
33
-
34
-
Supported by a grant from the OCaml Software Foundation.
4
+
- Fork Jsont as Json.
5
+
- Keep `Json.t` as the primary generic JSON value type.
6
+
- Move typed combinators under `Json.Codec`; object combinators live under
7
+
`Json.Codec.Object`.
8
+
- Add `json.brr` support for decoding and encoding browser-native JavaScript
9
+
values without materializing `Json.t`.
+2
-1
bench/bench.ml
+2
-1
bench/bench.ml
···
1
1
(* Benchmark json decode throughput against the simdjson corpus.
2
2
3
3
Two modes per file:
4
-
[dom] - full DOM parse via [Json.json] (simdjson "DOM" equivalent).
4
+
[dom] - full generic value parse via [Json.Codec.Value.t]
5
+
(simdjson "DOM" equivalent).
5
6
[field] - parse + extract one top-level field as [Json.ignore];
6
7
other members / array elements are parsed but DOM is not
7
8
materialised (simdjson "OnDemand" equivalent).
+6
-6
lib/brr/json_brr.mli
+6
-6
lib/brr/json_brr.mli
···
21
21
22
22
(** {1:jstr From / to browser strings} *)
23
23
24
-
val of_jstr : 'a Json.codec -> Jstr.t -> ('a, Json.Error.t) result
24
+
val of_jstr : 'a Json.Codec.t -> Jstr.t -> ('a, Json.Error.t) result
25
25
(** [of_jstr t s] decodes the JSON string [s] according to [t]. *)
26
26
27
-
val of_jstr_exn : 'a Json.codec -> Jstr.t -> 'a
27
+
val of_jstr_exn : 'a Json.Codec.t -> Jstr.t -> 'a
28
28
(** [of_jstr_exn] is like {!val-of_jstr} but raises {!Json.exception-Error}. *)
29
29
30
-
val to_jstr : ?indent:int -> ?preserve:bool -> 'a Json.codec -> 'a -> Jstr.t
30
+
val to_jstr : ?indent:int -> ?preserve:bool -> 'a Json.Codec.t -> 'a -> Jstr.t
31
31
(** [to_jstr t v] encodes [v] to JSON according to [t]. See
32
32
{!Json.val-to_string} for the semantics of [~indent] and [~preserve]. *)
33
33
34
34
(** {1:jv From / to raw JS values (zero-copy)} *)
35
35
36
-
val of_jv : 'a Json.codec -> Jv.t -> ('a, Json.Error.t) result
36
+
val of_jv : 'a Json.Codec.t -> Jv.t -> ('a, Json.Error.t) result
37
37
(** [of_jv t jv] decodes the JavaScript value [jv] according to [t] without a
38
38
parse step. *)
39
39
40
-
val of_jv_exn : 'a Json.codec -> Jv.t -> 'a
40
+
val of_jv_exn : 'a Json.Codec.t -> Jv.t -> 'a
41
41
(** [of_jv_exn] is like {!val-of_jv} but raises {!Json.exception-Error}. *)
42
42
43
-
val to_jv : 'a Json.codec -> 'a -> Jv.t
43
+
val to_jv : 'a Json.Codec.t -> 'a -> Jv.t
44
44
(** [to_jv t v] encodes [v] to a JavaScript value according to [t] without a
45
45
serialisation step. *)
+1
-1
lib/codec.ml
+1
-1
lib/codec.ml
+20
-16
lib/codec.mli
+20
-16
lib/codec.mli
···
26
26
Decode and encode with {!Json.of_string} and {!Json.to_string}, or use the
27
27
runtime functions in this module when you already have a {!Json.t}. *)
28
28
29
-
module Meta = Loc.Meta
30
-
(** Node metadata. *)
31
-
32
-
module Path = Loc.Path
33
-
(** JSON paths used by query and update codecs. *)
34
-
35
-
module Sort = Sort
36
-
(** JSON sorts used in diagnostics. *)
37
-
38
-
type 'a node = 'a * Meta.t
39
-
(** A payload with node metadata. *)
40
-
41
29
(** {1:core Core concepts} *)
42
30
43
31
type 'a t
···
83
71
type number_format = Value.number_format
84
72
(** The type for JSON number formatters. *)
85
73
74
+
(** {1:support Codec support types} *)
75
+
76
+
module Meta = Loc.Meta
77
+
(** Node metadata: source location and surrounding whitespace. Most callers only
78
+
handle this when preserving layout, reporting precise errors, or writing
79
+
custom maps. *)
80
+
81
+
type 'a node = 'a * Meta.t
82
+
(** A payload with node metadata. *)
83
+
84
+
module Path = Loc.Path
85
+
(** JSON paths used by query and update codecs. *)
86
+
87
+
module Sort = Sort
88
+
(** JSON sorts used in diagnostics. *)
89
+
86
90
(** {1:base Base types} *)
87
91
88
92
(** Mapping JSON base types. *)
···
123
127
val ignore : ('a, unit) map
124
128
(** [ignore] is the ignoring map. It ignores decodes and errors on encodes. *)
125
129
126
-
(** {2:types JSON types} *)
130
+
(** {2:codecs Codec constructors} *)
127
131
128
132
val null : (unit, 'a) map -> 'a t
129
133
(** [null map] maps with [map] JSON nulls represented by [()] to values of
···
389
393
(** [bigarray k l elt] maps JSON arrays with elements of type [elt] to
390
394
bigarray values of kind [k] and layout [l]. See also {!Codec.bigarray}. *)
391
395
392
-
(** {1:types JSON types} *)
396
+
(** {1:codecs Codec constructors} *)
393
397
394
398
val array : ('a, _, _) map -> 'a t
395
399
(** [array map] maps with [map] JSON arrays to values of type ['a]. See the
···
500
504
(** [enc_only ()] is like {!val-map} but can only be used for encoding. *)
501
505
502
506
val seal : ('o, 'o) map -> 'o t
503
-
(** [seal map] is a JSON type for objects mapped by [map]. Raises
507
+
(** [seal map] is a codec for objects mapped by [map]. Raises
504
508
[Invalid_argument] if [map] describes a member name more than once. *)
505
509
506
510
(** {1:mems Members} *)
···
681
685
('o, 'a) map
682
686
(** [keep_unknown mems map] makes [map] keep unknown member with [mems]. *)
683
687
684
-
(** {1:types JSON types} *)
688
+
(** {1:codecs Codec constructors} *)
685
689
686
690
val as_string_map :
687
691
?kind:string ->
+9
-9
lib/json.mli
+9
-9
lib/json.mli
···
88
88
type number_format = Value.number_format
89
89
(** The type for JSON number formatters. *)
90
90
91
+
module Error = Error
92
+
(** Typed JSON errors. See {!module-Error} for the full set. *)
93
+
94
+
exception Error of Error.t
95
+
(** The exception raised by [_exn] functions and failing codec maps. *)
96
+
91
97
(** {1:codecs Typed codecs} *)
92
98
93
99
module Codec = Codec
94
-
(** Typed codec combinators. Build codecs here, then pass them to {!of_string},
95
-
{!to_string}, {!decode}, {!encode}, or the browser-native functions from
96
-
[json.brr]. *)
100
+
(** Typed codec combinators. Build codecs here, then pass them to
101
+
{!val-of_string}, {!val-to_string}, {!val-decode}, {!val-encode}, or the
102
+
browser-native functions from [json.brr]. *)
97
103
98
104
type 'a codec = 'a Codec.t
99
105
(** The type for JSON codecs: a bidirectional map between JSON values and OCaml
···
286
292
module Sort = Sort
287
293
(** Sorts of JSON values ({!Sort.Null}, {!Sort.Bool}, {!Sort.Number},
288
294
{!Sort.String}, {!Sort.Array}, {!Sort.Object}) used in diagnostics. *)
289
-
290
-
module Error = Error
291
-
(** Typed JSON errors. See {!module-Error} for the full set. *)
292
-
293
-
exception Error of Error.t
294
-
(** The exception raised by [_exn] functions and failing codec maps. *)
295
295
296
296
module Tape = Tape
297
297
(** Simdjson-compatible tape format. A columnar representation of a JSON value
+2
-2
lib/tape.mli
+2
-2
lib/tape.mli
···
34
34
{b Note on numbers.} Genuine 64-bit doubles and large integers cannot fit in
35
35
56 bits. This implementation stores their top 56 bits only — enough for
36
36
schema / layout use cases but not for lossless roundtrips of arbitrary
37
-
doubles. For exact numbers, decode values against the standard {!Json.codec}
38
-
instead of using the tape. *)
37
+
doubles. For exact numbers, decode values against a {!Json.Codec.t} instead
38
+
of using the tape. *)
39
39
40
40
type t
41
41
(** An immutable tape. *)
+24
-24
test/codecs/cookbook.ml
+24
-24
test/codecs/cookbook.ml
···
20
20
let to_string v : string = invalid_arg "unimplemented"
21
21
end
22
22
23
-
let m_jsont =
23
+
let m_codec =
24
24
let dec = Json.Codec.Base.dec_result M.result_of_string in
25
25
let enc = Json.Codec.Base.enc M.to_string in
26
26
Json.Codec.Base.string (Json.Codec.Base.map ~kind:"M.t" ~dec ~enc ())
27
27
28
-
let m_jsont' =
28
+
let m_codec' =
29
29
let dec = Json.Codec.Base.dec_failure M.of_string_or_failure in
30
30
let enc = Json.Codec.Base.enc M.to_string in
31
31
Json.Codec.Base.string (Json.Codec.Base.map ~kind:"M.t" ~dec ~enc ())
32
32
33
-
let m_jsont'' =
33
+
let m_codec'' =
34
34
Json.Codec.of_of_string ~kind:"M.t" M.result_of_string ~enc:M.to_string
35
35
36
36
(* Objects as records *)
···
42
42
let name p = p.name
43
43
let age p = p.age
44
44
45
-
let jsont =
45
+
let codec =
46
46
Json.Codec.Object.map ~kind:"Person" make
47
47
|> Json.Codec.Object.member "name" Json.Codec.string ~enc:name
48
48
|> Json.Codec.Object.member "age" Json.Codec.int ~enc:age
···
53
53
54
54
module String_map = Map.Make (String)
55
55
56
-
let map : ?kind:string -> 'a Json.codec -> 'a String_map.t Json.codec =
56
+
let map : ?kind:string -> 'a Json.Codec.t -> 'a String_map.t Json.Codec.t =
57
57
fun ?kind t ->
58
58
Json.Codec.Object.map ?kind Fun.id
59
59
|> Json.Codec.Object.keep_unknown
···
70
70
let name p = p.name
71
71
let age p = p.age
72
72
73
-
let jsont =
73
+
let codec =
74
74
Json.Codec.Object.map ~kind:"Person" make
75
75
|> Json.Codec.Object.member "name" Json.Codec.string ~enc:name
76
76
|> Json.Codec.Object.member "age"
···
88
88
let name p = p.name
89
89
let age p = p.age
90
90
91
-
let jsont =
91
+
let codec =
92
92
Json.Codec.Object.map ~kind:"Person" make
93
93
|> Json.Codec.Object.member "name" Json.Codec.string ~enc:name
94
94
|> Json.Codec.Object.member "age" Json.Codec.int ~enc:age
···
103
103
let age p = p.age
104
104
let unknown v = v.unknown
105
105
106
-
let jsont =
106
+
let codec =
107
107
Json.Codec.Object.map ~kind:"Person" make
108
108
|> Json.Codec.Object.member "name" Json.Codec.string ~enc:name
109
109
|> Json.Codec.Object.member "age" Json.Codec.int ~enc:age
···
120
120
let value (Node (v, _)) = v
121
121
let children (Node (_, children)) = children
122
122
123
-
let jsont value_type =
123
+
let codec value_type =
124
124
let rec t =
125
125
lazy
126
126
(Json.Codec.Object.map ~kind:"Tree" make
···
143
143
let name c = c.name
144
144
let radius c = c.radius
145
145
146
-
let jsont =
146
+
let codec =
147
147
Json.Codec.Object.map ~kind:"Circle" make
148
148
|> Json.Codec.Object.member "name" Json.Codec.string ~enc:name
149
149
|> Json.Codec.Object.member "radius" Json.Codec.number ~enc:radius
···
158
158
let width r = r.width
159
159
let height r = r.height
160
160
161
-
let jsont =
161
+
let codec =
162
162
Json.Codec.Object.map ~kind:"Rect" make
163
163
|> Json.Codec.Object.member "name" Json.Codec.string ~enc:name
164
164
|> Json.Codec.Object.member "width" Json.Codec.number ~enc:width
···
171
171
let circle c = Circle c
172
172
let rect r = Rect r
173
173
174
-
let jsont =
175
-
let circle = Json.Codec.Object.Case.map "Circle" Circle.jsont ~dec:circle in
176
-
let rect = Json.Codec.Object.Case.map "Rect" Rect.jsont ~dec:rect in
174
+
let codec =
175
+
let circle = Json.Codec.Object.Case.map "Circle" Circle.codec ~dec:circle in
176
+
let rect = Json.Codec.Object.Case.map "Rect" Rect.codec ~dec:rect in
177
177
let enc_case = function
178
178
| Circle c -> Json.Codec.Object.Case.value circle c
179
179
| Rect r -> Json.Codec.Object.Case.value rect r
···
192
192
let make radius = { radius }
193
193
let radius c = c.radius
194
194
195
-
let jsont =
195
+
let codec =
196
196
Json.Codec.Object.map ~kind:"Circle" make
197
197
|> Json.Codec.Object.member "radius" Json.Codec.number ~enc:radius
198
198
|> Json.Codec.Object.seal
···
205
205
let width r = r.width
206
206
let height r = r.height
207
207
208
-
let jsont =
208
+
let codec =
209
209
Json.Codec.Object.map ~kind:"Rect" make
210
210
|> Json.Codec.Object.member "width" Json.Codec.number ~enc:width
211
211
|> Json.Codec.Object.member "height" Json.Codec.number ~enc:height
···
223
223
let name g = g.name
224
224
let type' g = g.type'
225
225
226
-
let jsont =
227
-
let circle = Json.Codec.Object.Case.map "Circle" Circle.jsont ~dec:circle in
228
-
let rect = Json.Codec.Object.Case.map "Rect" Rect.jsont ~dec:rect in
226
+
let codec =
227
+
let circle = Json.Codec.Object.Case.map "Circle" Circle.codec ~dec:circle in
228
+
let rect = Json.Codec.Object.Case.map "Rect" Rect.codec ~dec:rect in
229
229
let enc_case = function
230
230
| Circle c -> Json.Codec.Object.Case.value circle c
231
231
| Rect r -> Json.Codec.Object.Case.value rect r
···
258
258
let result r = match r.value with Ok v -> Some v | Error _ -> None
259
259
let error r = match r.value with Ok _ -> None | Error e -> Some e
260
260
261
-
let jsont =
261
+
let codec =
262
262
Json.Codec.Object.map make
263
263
|> Json.Codec.Object.member "id" Json.Codec.int ~enc:(fun r -> r.id)
264
264
|> Json.Codec.Object.opt_member "result" Json.Codec.Value.t ~enc:result
···
273
273
274
274
let make id name persons = { id; name; persons }
275
275
276
-
let info_jsont =
276
+
let info_codec =
277
277
Json.Codec.Object.map make
278
278
|> Json.Codec.Object.member "id" Json.Codec.int
279
279
|> Json.Codec.Object.member "name" Json.Codec.string
280
280
|> Json.Codec.Object.seal
281
281
282
-
let jsont =
282
+
let codec =
283
283
Json.Codec.Object.map (fun k persons -> k persons)
284
-
|> Json.Codec.Object.member "info" info_jsont
285
-
|> Json.Codec.Object.member "persons" (Json.Codec.list Person.jsont)
284
+
|> Json.Codec.Object.member "info" info_codec
285
+
|> Json.Codec.Object.member "persons" (Json.Codec.list Person.codec)
286
286
|> Json.Codec.Object.seal
287
287
end
+47
-47
test/codecs/geojson.ml
+47
-47
test/codecs/geojson.ml
···
18
18
19
19
type float_array = float array
20
20
21
-
let float_array_jsont ~kind = Json.Codec.array ~kind Json.Codec.number
21
+
let float_array_codec ~kind = Json.Codec.array ~kind Json.Codec.number
22
22
23
23
type 'a garray = 'a array
24
24
···
27
27
module Bbox = struct
28
28
type t = float_array
29
29
30
-
let jsont = float_array_jsont ~kind:"Bbox"
30
+
let codec = float_array_codec ~kind:"Bbox"
31
31
end
32
32
33
33
module Position = struct
34
34
type t = float_array
35
35
36
-
let jsont = float_array_jsont ~kind:"Position"
36
+
let codec = float_array_codec ~kind:"Position"
37
37
end
38
38
39
39
module Geojson_object = struct
···
44
44
let bbox o = o.bbox
45
45
let unknown o = o.unknown
46
46
47
-
let finish_jsont map =
47
+
let finish_codec map =
48
48
map
49
-
|> Json.Codec.Object.opt_member "bbox" Bbox.jsont ~enc:bbox
49
+
|> Json.Codec.Object.opt_member "bbox" Bbox.codec ~enc:bbox
50
50
|> Json.Codec.Object.keep_unknown Json.Codec.Value.members ~enc:unknown
51
51
|> Json.Codec.Object.seal
52
52
53
53
let geometry ~kind coordinates =
54
54
Json.Codec.Object.map ~kind make
55
55
|> Json.Codec.Object.member "coordinates" coordinates ~enc:type'
56
-
|> finish_jsont
56
+
|> finish_codec
57
57
end
58
58
59
59
module Point = struct
60
60
type t = Position.t
61
61
62
-
let jsont = Geojson_object.geometry ~kind:"Point" Position.jsont
62
+
let codec = Geojson_object.geometry ~kind:"Point" Position.codec
63
63
end
64
64
65
65
module Multi_point = struct
66
66
type t = Position.t garray
67
67
68
-
let jsont = Geojson_object.geometry ~kind:"MultiPoint" (garray Position.jsont)
68
+
let codec = Geojson_object.geometry ~kind:"MultiPoint" (garray Position.codec)
69
69
end
70
70
71
71
module Line_string = struct
72
72
type t = Position.t garray
73
73
74
-
let jsont = Geojson_object.geometry ~kind:"LineString" (garray Position.jsont)
74
+
let codec = Geojson_object.geometry ~kind:"LineString" (garray Position.codec)
75
75
end
76
76
77
77
module Multi_line_string = struct
78
78
type t = Line_string.t garray
79
79
80
-
let jsont =
81
-
Geojson_object.geometry ~kind:"LineString" (garray (garray Position.jsont))
80
+
let codec =
81
+
Geojson_object.geometry ~kind:"LineString" (garray (garray Position.codec))
82
82
end
83
83
84
84
module Polygon = struct
85
85
type t = Line_string.t garray
86
86
87
-
let jsont =
88
-
Geojson_object.geometry ~kind:"Polygon" (garray (garray Position.jsont))
87
+
let codec =
88
+
Geojson_object.geometry ~kind:"Polygon" (garray (garray Position.codec))
89
89
end
90
90
91
91
module Multi_polygon = struct
92
92
type t = Polygon.t garray
93
93
94
-
let jsont =
94
+
let codec =
95
95
Geojson_object.geometry ~kind:"MultiPolygon"
96
-
(garray (garray (garray Position.jsont)))
96
+
(garray (garray (garray Position.codec)))
97
97
end
98
98
99
99
module Geojson = struct
···
146
146
let feature v = `Feature v
147
147
let feature_collection vs = `Feature_collection vs
148
148
149
-
let feature_id_jsont =
149
+
let feature_id_codec =
150
150
let number =
151
151
let dec = Json.Codec.Base.dec (fun n -> `Number n) in
152
152
let enc =
···
170
170
let case_map obj dec =
171
171
Json.Codec.Object.Case.map (Json.Codec.kind obj) obj ~dec
172
172
173
-
let rec geometry_jsont =
173
+
let rec geometry_codec =
174
174
lazy begin
175
-
let case_point = case_map Point.jsont point in
176
-
let case_multi_point = case_map Multi_point.jsont multi_point in
177
-
let case_line_string = case_map Line_string.jsont line_string in
175
+
let case_point = case_map Point.codec point in
176
+
let case_multi_point = case_map Multi_point.codec multi_point in
177
+
let case_line_string = case_map Line_string.codec line_string in
178
178
let case_multi_line_string =
179
-
case_map Multi_line_string.jsont multi_line_string
179
+
case_map Multi_line_string.codec multi_line_string
180
180
in
181
-
let case_polygon = case_map Polygon.jsont polygon in
182
-
let case_multi_polygon = case_map Multi_polygon.jsont multi_polygon in
181
+
let case_polygon = case_map Polygon.codec polygon in
182
+
let case_multi_polygon = case_map Multi_polygon.codec multi_polygon in
183
183
let case_geometry_collection =
184
-
case_map (Lazy.force geometry_collection_jsont) geometry_collection
184
+
case_map (Lazy.force geometry_collection_codec) geometry_collection
185
185
in
186
186
let enc_case = function
187
187
| `Point v -> Json.Codec.Object.Case.value case_point v
···
212
212
|> Json.Codec.Object.seal
213
213
end
214
214
215
-
and feature_jsont : Feature.t object' Json.codec Lazy.t =
215
+
and feature_codec : Feature.t object' Json.Codec.t Lazy.t =
216
216
lazy begin
217
-
let case_feature = case_map (Lazy.force case_feature_jsont) Fun.id in
217
+
let case_feature = case_map (Lazy.force case_feature_codec) Fun.id in
218
218
let enc_case v = Json.Codec.Object.Case.value case_feature v in
219
219
let cases = Json.Codec.Object.Case.[ make case_feature ] in
220
220
Json.Codec.Object.map ~kind:"Feature" Fun.id
···
223
223
|> Json.Codec.Object.seal
224
224
end
225
225
226
-
and case_feature_jsont : Feature.t object' Json.codec Lazy.t =
226
+
and case_feature_codec : Feature.t object' Json.Codec.t Lazy.t =
227
227
lazy begin
228
228
Json.Codec.Object.map ~kind:"Feature" Feature.make_geojson_object
229
-
|> Json.Codec.Object.opt_member "id" feature_id_jsont ~enc:(fun o ->
229
+
|> Json.Codec.Object.opt_member "id" feature_id_codec ~enc:(fun o ->
230
230
Feature.id (Geojson_object.type' o))
231
231
|> Json.Codec.Object.member "geometry"
232
-
(Json.Codec.option (Json.Codec.fix geometry_jsont))
232
+
(Json.Codec.option (Json.Codec.fix geometry_codec))
233
233
~enc:(fun o -> Feature.geometry (Geojson_object.type' o))
234
234
|> Json.Codec.Object.member "properties"
235
235
(Json.Codec.option Json.Codec.Value.object') ~enc:(fun o ->
236
236
Feature.properties (Geojson_object.type' o))
237
-
|> Geojson_object.finish_jsont
237
+
|> Geojson_object.finish_codec
238
238
end
239
239
240
-
and geometry_collection_jsont =
240
+
and geometry_collection_codec =
241
241
lazy begin
242
242
Json.Codec.Object.map ~kind:"GeometryCollection" Geojson_object.make
243
243
|> Json.Codec.Object.member "geometries"
244
-
(Json.Codec.list (Json.Codec.fix geometry_jsont))
244
+
(Json.Codec.list (Json.Codec.fix geometry_codec))
245
245
~enc:Geojson_object.type'
246
-
|> Geojson_object.finish_jsont
246
+
|> Geojson_object.finish_codec
247
247
end
248
248
249
249
and feature_collection_json =
250
250
lazy begin
251
251
Json.Codec.Object.map ~kind:"FeatureCollection" Geojson_object.make
252
252
|> Json.Codec.Object.member "features"
253
-
Json.Codec.(list (Json.Codec.fix feature_jsont))
253
+
Json.Codec.(list (Json.Codec.fix feature_codec))
254
254
~enc:Geojson_object.type'
255
-
|> Geojson_object.finish_jsont
255
+
|> Geojson_object.finish_codec
256
256
end
257
257
258
-
and jsont : t Json.codec Lazy.t =
258
+
and codec : t Json.Codec.t Lazy.t =
259
259
lazy begin
260
-
let case_point = case_map Point.jsont point in
261
-
let case_multi_point = case_map Multi_point.jsont multi_point in
262
-
let case_line_string = case_map Line_string.jsont line_string in
260
+
let case_point = case_map Point.codec point in
261
+
let case_multi_point = case_map Multi_point.codec multi_point in
262
+
let case_line_string = case_map Line_string.codec line_string in
263
263
let case_multi_line_string =
264
-
case_map Multi_line_string.jsont multi_line_string
264
+
case_map Multi_line_string.codec multi_line_string
265
265
in
266
-
let case_polygon = case_map Polygon.jsont polygon in
267
-
let case_multi_polygon = case_map Multi_polygon.jsont multi_polygon in
266
+
let case_polygon = case_map Polygon.codec polygon in
267
+
let case_multi_polygon = case_map Multi_polygon.codec multi_polygon in
268
268
let case_geometry_collection =
269
-
case_map (Lazy.force geometry_collection_jsont) geometry_collection
269
+
case_map (Lazy.force geometry_collection_codec) geometry_collection
270
270
in
271
-
let case_feature = case_map (Lazy.force case_feature_jsont) feature in
271
+
let case_feature = case_map (Lazy.force case_feature_codec) feature in
272
272
let case_feature_collection =
273
273
case_map (Lazy.force feature_collection_json) feature_collection
274
274
in
···
306
306
|> Json.Codec.Object.seal
307
307
end
308
308
309
-
let jsont = Lazy.force jsont
309
+
let codec = Lazy.force codec
310
310
end
311
311
312
312
(* Command line interface *)
···
340
340
@@ fun r ->
341
341
log_if_error ~use:1
342
342
@@
343
-
let* t = Json.of_reader ~file ~locs Geojson.jsont r in
343
+
let* t = Json.of_reader ~file ~locs Geojson.codec r in
344
344
if dec_only then Ok 0
345
345
else
346
346
let w = Bytesrw.Bytes.Writer.of_out_channel stdout in
347
-
Json.to_writer ?indent ~eod:true Geojson.jsont t w;
347
+
Json.to_writer ?indent ~eod:true Geojson.codec t w;
348
348
Ok 0
349
349
350
350
open Cmdliner
+12
-12
test/codecs/json_rpc.ml
+12
-12
test/codecs/json_rpc.ml
···
9
9
10
10
type jsonrpc = [ `V2 ]
11
11
12
-
let jsonrpc_jsont = Json.Codec.enum [ ("2.0", `V2) ]
12
+
let jsonrpc_codec = Json.Codec.enum [ ("2.0", `V2) ]
13
13
14
14
(* JSON-RPC identifiers *)
15
15
16
16
type id = [ `String of string | `Number of float | `Null ]
17
17
18
-
let id_jsont : id Json.codec =
18
+
let id_codec : id Json.Codec.t =
19
19
let null = Json.Codec.null `Null in
20
20
let string =
21
21
let dec s = `String s in
···
38
38
39
39
type params = Json.t (* An array or object *)
40
40
41
-
let params_jsont =
41
+
let params_codec =
42
42
let enc = function
43
43
| Json.Value.Object _ | Json.Value.Array _ -> Json.Codec.Value.t
44
44
| j ->
···
59
59
60
60
let request jsonrpc method' params id = { jsonrpc; method'; params; id }
61
61
62
-
let request_jsont : request Json.codec =
62
+
let request_codec : request Json.Codec.t =
63
63
Json.Codec.Object.map request
64
-
|> Json.Codec.Object.member "jsonrpc" jsonrpc_jsont ~enc:(fun r -> r.jsonrpc)
64
+
|> Json.Codec.Object.member "jsonrpc" jsonrpc_codec ~enc:(fun r -> r.jsonrpc)
65
65
|> Json.Codec.Object.member "method" Json.Codec.string ~enc:(fun r ->
66
66
r.method')
67
-
|> Json.Codec.Object.opt_member "params" params_jsont ~enc:(fun r -> r.params)
68
-
|> Json.Codec.Object.opt_member "id" id_jsont ~enc:(fun r -> r.id)
67
+
|> Json.Codec.Object.opt_member "params" params_codec ~enc:(fun r -> r.params)
68
+
|> Json.Codec.Object.opt_member "id" id_codec ~enc:(fun r -> r.id)
69
69
|> Json.Codec.Object.seal
70
70
71
71
(* JSON-RPC error objects *)
···
74
74
75
75
let error code message data = { code; message; data }
76
76
77
-
let error_jsont =
77
+
let error_codec =
78
78
Json.Codec.Object.map error
79
79
|> Json.Codec.Object.member "code" Json.Codec.int ~enc:(fun e -> e.code)
80
80
|> Json.Codec.Object.member "message" Json.Codec.string ~enc:(fun e ->
···
105
105
let response_result r = match r.value with Ok v -> Some v | Error _ -> None
106
106
let response_error r = match r.value with Ok _ -> None | Error e -> Some e
107
107
108
-
let response_jsont : response Json.codec =
108
+
let response_codec : response Json.Codec.t =
109
109
Json.Codec.Object.map response
110
-
|> Json.Codec.Object.member "jsonrpc" jsonrpc_jsont ~enc:(fun r -> r.jsonrpc)
110
+
|> Json.Codec.Object.member "jsonrpc" jsonrpc_codec ~enc:(fun r -> r.jsonrpc)
111
111
|> Json.Codec.Object.opt_member "result" Json.Codec.Value.t
112
112
~enc:response_result
113
-
|> Json.Codec.Object.opt_member "error" error_jsont ~enc:response_error
114
-
|> Json.Codec.Object.member "id" id_jsont ~enc:(fun r -> r.id)
113
+
|> Json.Codec.Object.opt_member "error" error_codec ~enc:response_error
114
+
|> Json.Codec.Object.member "id" id_codec ~enc:(fun r -> r.id)
115
115
|> Json.Codec.Object.seal
-489
test/codecs/jsont_tool.ml
-489
test/codecs/jsont_tool.ml
···
1
-
(*---------------------------------------------------------------------------
2
-
Copyright (c) 2024 The jsont programmers. All rights reserved.
3
-
SPDX-License-Identifier: ISC
4
-
---------------------------------------------------------------------------*)
5
-
6
-
let ( let* ) = Result.bind
7
-
let strf = Format.asprintf
8
-
9
-
let log_if_error ~use = function
10
-
| Ok v -> v
11
-
| Error e ->
12
-
let exec = Filename.basename Sys.executable_name in
13
-
let lines = String.split_on_char '\n' e in
14
-
Format.eprintf "%s: %a @[<v>%a@]@." exec Json.Error.puterr ()
15
-
Format.(pp_print_list pp_print_string)
16
-
lines;
17
-
use
18
-
19
-
let exit_err_file = 1
20
-
let exit_err_json = 2
21
-
let exit_err_diff = 3
22
-
23
-
module Os = struct
24
-
(* Emulate B0_std.Os functionality to eschew the dep.
25
-
Note: this is only used for the [diff] function. *)
26
-
27
-
let read_file file =
28
-
try
29
-
let ic = if file = "-" then stdin else open_in_bin file in
30
-
let finally () = if file = "-" then () else close_in_noerr ic in
31
-
Fun.protect ~finally @@ fun () -> Ok (In_channel.input_all ic)
32
-
with Sys_error err -> Error err
33
-
34
-
let write_file file s =
35
-
try
36
-
let oc = if file = "-" then stdout else open_out_bin file in
37
-
let finally () = if file = "-" then () else close_out_noerr oc in
38
-
Fun.protect ~finally @@ fun () -> Ok (Out_channel.output_string oc s)
39
-
with Sys_error err -> Error err
40
-
41
-
let with_tmp_dir f =
42
-
try
43
-
let tmpdir =
44
-
let file = Filename.temp_file "cmarkit" "dir" in
45
-
Sys.remove file;
46
-
Sys.mkdir file 0o700;
47
-
file
48
-
in
49
-
let finally () = try Sys.rmdir tmpdir with Sys_error _ -> () in
50
-
Fun.protect ~finally @@ fun () -> Ok (f tmpdir)
51
-
with Sys_error err -> Error ("Making temporary dir: " ^ err)
52
-
53
-
let with_cwd cwd f =
54
-
try
55
-
let curr = Sys.getcwd () in
56
-
let () = Sys.chdir cwd in
57
-
let finally () = try Sys.chdir curr with Sys_error _ -> () in
58
-
Fun.protect ~finally @@ fun () -> Ok (f ())
59
-
with Sys_error err -> Error ("With cwd: " ^ err)
60
-
end
61
-
62
-
let diff src fmted =
63
-
let env = [ "GIT_CONFIG_SYSTEM=/dev/null"; "GIT_CONFIG_GLOBAL=/dev/null" ] in
64
-
let set_env =
65
-
match Sys.win32 with
66
-
| true -> String.concat "" (List.map (fun e -> "set " ^ e ^ " && ") env)
67
-
| false -> String.concat " " env
68
-
in
69
-
let diff = "git diff --ws-error-highlight=all --no-index --patience " in
70
-
let src_file = "src" and fmted_file = "fmt" in
71
-
let cmd = String.concat " " [ set_env; diff; src_file; fmted_file ] in
72
-
Result.join @@ Result.join @@ Os.with_tmp_dir
73
-
@@ fun dir ->
74
-
Os.with_cwd dir @@ fun () ->
75
-
let* () = Os.write_file src_file src in
76
-
let* () = Os.write_file fmted_file fmted in
77
-
Ok (Sys.command cmd)
78
-
79
-
let with_infile file f =
80
-
(* XXX add something to bytesrw. *)
81
-
let process file ic =
82
-
try Ok (f (Bytesrw.Bytes.Reader.of_in_channel ic))
83
-
with Sys_error e -> Error (Format.sprintf "@[<v>%s:@,%s@]" file e)
84
-
in
85
-
try
86
-
match file with
87
-
| "-" -> process file In_channel.stdin
88
-
| file -> In_channel.with_open_bin file (process file)
89
-
with Sys_error e -> Error e
90
-
91
-
let output ~format ~number_format j =
92
-
match format with
93
-
| `Pretty -> Ok (Format.printf "@[%a@]@." (Json.pp' ~number_format ()) j)
94
-
| `Format format ->
95
-
let w = Bytesrw.Bytes.Writer.of_out_channel stdout in
96
-
Json.to_writer ~format ~number_format ~eod:true Json.json j w
97
-
98
-
let output_string ~format ~number_format j =
99
-
match format with
100
-
| `Pretty -> Ok (Format.asprintf "@[%a@]" (Json.pp' ~number_format ()) j)
101
-
| `Format format -> Json.to_string ~format ~number_format Json.json j
102
-
103
-
let trip_type ?(dec_only = false) ~file ~format ~number_format ~diff:do_diff
104
-
~locs t =
105
-
log_if_error ~use:exit_err_file
106
-
@@ with_infile file
107
-
@@ fun r ->
108
-
log_if_error ~use:exit_err_json
109
-
@@
110
-
let layout = format = `Format Json.Layout in
111
-
match do_diff with
112
-
| false ->
113
-
let* j = Json.of_reader ~file ~layout ~locs t r in
114
-
if dec_only then Ok 0
115
-
else
116
-
let* () = output ~format ~number_format j in
117
-
Ok 0
118
-
| true -> (
119
-
let src = Bytesrw.Bytes.Reader.to_string r in
120
-
let* j = Json.of_string ~file ~layout ~locs t src in
121
-
let* fmted = output_string ~format ~number_format j in
122
-
match diff src fmted with
123
-
| Ok exit -> if exit = 0 then Ok 0 else Ok exit_err_diff
124
-
| Error e ->
125
-
Format.eprintf "%s" e;
126
-
Ok Cmdliner.Cmd.Exit.some_error)
127
-
128
-
let delete ~file ~path ~format ~number_format ~diff ~allow_absent ~locs =
129
-
let del = Json.delete_path ~allow_absent path in
130
-
trip_type ~file ~format ~number_format ~diff ~locs del
131
-
132
-
let fmt ~file ~format ~number_format ~diff ~locs ~dec_only =
133
-
trip_type ~file ~format ~number_format ~diff ~locs ~dec_only Json.t
134
-
135
-
let get ~file ~path ~format ~number_format ~diff ~absent ~locs =
136
-
let get = Json.path ?absent path Json.json in
137
-
trip_type ~file ~format ~number_format ~diff ~locs get
138
-
139
-
let locs' ~file =
140
-
let pf = Format.fprintf in
141
-
let pp_code = Json.Codec.pp_code in
142
-
let pp_locs_outline ppf v =
143
-
let indent = 2 in
144
-
let loc label ppf m =
145
-
pf ppf "@[<v>%s:@,%a@]@," label Loc.pp_ocaml (Json.Meta.loc m)
146
-
in
147
-
let rec value ppf = function
148
-
| Json.Value.Null ((), m) ->
149
-
loc (strf "%a" pp_code (strf "%a" Json.Value.pp_null ())) ppf m
150
-
| Json.Value.Bool (b, m) ->
151
-
loc (strf "Bool %a" pp_code (strf "%a" Json.Value.pp_bool b)) ppf m
152
-
| Json.Value.Number (n, m) ->
153
-
loc
154
-
(strf "Number %a" pp_code (strf "%a" Json.Value.pp_number n))
155
-
ppf m
156
-
| Json.Value.String (s, m) ->
157
-
loc
158
-
(strf "String %a" pp_code (strf "%a" Json.Value.pp_string s))
159
-
ppf m
160
-
| Json.Value.Array (l, m) ->
161
-
Format.pp_open_vbox ppf indent;
162
-
loc "Array" ppf m;
163
-
(Format.pp_print_list value) ppf l;
164
-
Format.pp_close_box ppf ()
165
-
| Json.Value.Object (o, m) ->
166
-
let mem ppf ((name, m), v) =
167
-
let l =
168
-
strf "Member %a" pp_code (strf "%a" Json.Value.pp_string name)
169
-
in
170
-
loc l ppf m;
171
-
value ppf v
172
-
in
173
-
Format.pp_open_vbox ppf indent;
174
-
loc "Object" ppf m;
175
-
(Format.pp_print_list mem) ppf o;
176
-
Format.pp_close_box ppf ()
177
-
in
178
-
value ppf v
179
-
in
180
-
log_if_error ~use:exit_err_file
181
-
@@ with_infile file
182
-
@@ fun reader ->
183
-
log_if_error ~use:exit_err_json
184
-
@@
185
-
let* j = Json.of_reader ~file ~locs:true Json.json reader in
186
-
pp_locs_outline Format.std_formatter j;
187
-
Ok 0
188
-
189
-
let set ~file ~path ~format ~number_format ~diff ~allow_absent ~stub ~json:j
190
-
~locs =
191
-
let set = Json.set_path ?stub ~allow_absent Json.json path j in
192
-
trip_type ~file ~format ~number_format ~diff ~locs set
193
-
194
-
(* Command line interface *)
195
-
196
-
open Cmdliner
197
-
open Cmdliner.Term.Syntax
198
-
199
-
let exits =
200
-
Cmd.Exit.info exit_err_file ~doc:"on file read errors."
201
-
:: Cmd.Exit.info exit_err_json ~doc:"on JSON parse or path errors."
202
-
:: Cmd.Exit.info exit_err_diff ~doc:"on JSON output differences."
203
-
:: Cmd.Exit.defaults
204
-
205
-
let path_arg = Arg.conv' ~docv:"JSON_PATH" Json.Path.(of_string, pp)
206
-
207
-
let json_arg =
208
-
let of_string s = Json.of_string ~locs:true ~layout:true Json.json s in
209
-
let pp = Json.pp in
210
-
Arg.conv' ~docv:"JSON" (of_string, pp)
211
-
212
-
let format_opt ~default =
213
-
let fmt =
214
-
[
215
-
("indent", `Format Json.Indent);
216
-
("minify", `Format Json.Minify);
217
-
("preserve", `Format Json.Layout);
218
-
("pretty", `Pretty);
219
-
]
220
-
in
221
-
let doc =
222
-
strf
223
-
"Output style. Must be %s. $(b,minify) guarantess there is no CR \
224
-
(U+000D) or LF (U+000A) in the output. $(b,pretty) is similar to \
225
-
$(b,indent) but may yield more compact outputs."
226
-
(Arg.doc_alts_enum fmt)
227
-
in
228
-
Arg.(value & opt (enum fmt) default & info [ "f"; "format" ] ~doc ~docv:"FMT")
229
-
230
-
let format_opt_default_pretty = format_opt ~default:`Pretty
231
-
let format_opt_default_preserve = format_opt ~default:(`Format Json.Layout)
232
-
233
-
let allow_absent_opt =
234
-
let doc = "Do not error if $(i,JSON_PATH) does not exist." in
235
-
Arg.(value & flag & info [ "a"; "allow-absent" ] ~doc)
236
-
237
-
let locs_default_false =
238
-
let doc = "Keep track of source locations (improves error messages)." in
239
-
Arg.(value & flag & info [ "locs" ] ~doc)
240
-
241
-
let locs_default_true =
242
-
let doc = "Do not keep track of source locations." in
243
-
Term.(const not $ Arg.(value & flag & info [ "no-locs" ] ~doc))
244
-
245
-
let number_format_opt =
246
-
let doc = "Use C float format string $(docv) to format JSON numbers." in
247
-
let number_format : Json.number_format Arg.conv =
248
-
let parse s =
249
-
try Ok (Scanf.format_from_string s Json.Value.default_number_format)
250
-
with Scanf.Scan_failure _ ->
251
-
Error (strf "Cannot format a float with %S" s)
252
-
in
253
-
let pp ppf fmt = Format.pp_print_string ppf (string_of_format fmt) in
254
-
Arg.conv' (parse, pp)
255
-
in
256
-
Arg.(
257
-
value
258
-
& opt number_format Json.Value.default_number_format
259
-
& info [ "n"; "number-format" ] ~doc ~docv:"FMT")
260
-
261
-
let diff_flag =
262
-
let doc =
263
-
"Output diff between input and output (needs $(b,git) in your $(b,PATH)). \
264
-
Exits with 0 only there are no differences."
265
-
in
266
-
Arg.(value & flag & info [ "diff" ] ~doc)
267
-
268
-
let dec_only =
269
-
let doc = "Decode only, no output." in
270
-
Arg.(value & flag & info [ "d"; "decode-only" ] ~doc)
271
-
272
-
let file_pos ~pos:p =
273
-
let doc = "$(docv) is the JSON file. Use $(b,-) for stdin." in
274
-
Arg.(value & pos p string "-" & info [] ~doc ~docv:"FILE")
275
-
276
-
let file_pos0 = file_pos ~pos:0
277
-
let file_pos1 = file_pos ~pos:1
278
-
let file_pos2 = file_pos ~pos:2
279
-
280
-
let common_man =
281
-
[
282
-
`S Manpage.s_bugs;
283
-
`P
284
-
"This program is distributed with the jsont OCaml library. See \
285
-
$(i,https://erratique.ch/software/jsont) for contact information.";
286
-
]
287
-
288
-
let delete_cmd =
289
-
let doc = "Delete the value indexed by a JSON path" in
290
-
let sdocs = Manpage.s_common_options in
291
-
let man =
292
-
[
293
-
`S Manpage.s_description;
294
-
`P
295
-
"$(iname) deletes the value indexed by a JSON path. Outputs $(b,null) \
296
-
on the root path $(b,'.'). Examples:";
297
-
`Pre "$(iname) $(b,keywords.[0] package.json)";
298
-
`Noblank;
299
-
`Pre "$(iname) $(b,-a keywords.[0] package.json)";
300
-
`Blocks common_man;
301
-
]
302
-
in
303
-
let path_opt =
304
-
let doc = "Delete JSON path $(docv)." and docv = "JSON_PATH" in
305
-
Arg.(required & pos 0 (some path_arg) None & info [] ~doc ~docv)
306
-
in
307
-
Cmd.v (Cmd.info "delete" ~doc ~sdocs ~exits ~man)
308
-
@@
309
-
let+ file = file_pos1
310
-
and+ path = path_opt
311
-
and+ format = format_opt_default_preserve
312
-
and+ number_format = number_format_opt
313
-
and+ diff = diff_flag
314
-
and+ allow_absent = allow_absent_opt
315
-
and+ locs = locs_default_true in
316
-
delete ~file ~path ~format ~number_format ~diff ~allow_absent ~locs
317
-
318
-
let fmt_cmd =
319
-
let doc = "Format JSON" in
320
-
let sdocs = Manpage.s_common_options in
321
-
let man =
322
-
[
323
-
`S Manpage.s_description;
324
-
`P "$(iname) formats JSON. Examples:";
325
-
`Pre "$(iname) $(b,package.json)";
326
-
`Noblank;
327
-
`Pre "$(iname) $(b,-f minify package.json)";
328
-
`Blocks common_man;
329
-
]
330
-
in
331
-
Cmd.v (Cmd.info "fmt" ~doc ~sdocs ~exits ~man)
332
-
@@
333
-
let+ file = file_pos0
334
-
and+ format = format_opt_default_pretty
335
-
and+ number_format = number_format_opt
336
-
and+ diff = diff_flag
337
-
and+ locs = locs_default_false
338
-
and+ dec_only = dec_only in
339
-
fmt ~file ~format ~number_format ~diff ~locs ~dec_only
340
-
341
-
let get_cmd =
342
-
let doc = "Extract the value indexed by a JSON path" in
343
-
let sdocs = Manpage.s_common_options in
344
-
let man =
345
-
[
346
-
`S Manpage.s_description;
347
-
`P "$(iname) outputs the value indexed by a JSON path. Examples:";
348
-
`Pre "$(iname) $(b,'keywords.[0]' package.json)";
349
-
`Noblank;
350
-
`Pre "$(iname) $(b,-a 'null' 'keywords.[0]' package.json)";
351
-
`Noblank;
352
-
`Pre "$(iname) $(b,-a '[]' 'keywords' package.json)";
353
-
`Noblank;
354
-
`Pre "$(iname) $(b,'.' package.json)";
355
-
`Blocks common_man;
356
-
]
357
-
in
358
-
let path_pos =
359
-
let doc = "Extract the value indexed by JSON path $(docv)." in
360
-
Arg.(required & pos 0 (some path_arg) None & info [] ~doc ~docv:"JSON_PATH")
361
-
in
362
-
let absent_opt =
363
-
let doc =
364
-
"Do not error if $(i,JSON_PATH) does not exist, output $(docv) instead."
365
-
in
366
-
Arg.(
367
-
value
368
-
& opt (some json_arg) None
369
-
& info [ "a"; "absent" ] ~doc ~docv:"JSON")
370
-
in
371
-
Cmd.v (Cmd.info "get" ~doc ~sdocs ~exits ~man)
372
-
@@
373
-
let+ file = file_pos1
374
-
and+ path = path_pos
375
-
and+ format = format_opt_default_pretty
376
-
and+ number_format = number_format_opt
377
-
and+ diff = diff_flag
378
-
and+ absent = absent_opt
379
-
and+ locs = locs_default_true in
380
-
get ~file ~path ~format ~number_format ~diff ~absent ~locs
381
-
382
-
let set_cmd =
383
-
let doc = "Set the value indexed by a JSON path" in
384
-
let sdocs = Manpage.s_common_options in
385
-
let man =
386
-
[
387
-
`S Manpage.s_description;
388
-
`P "$(iname) sets the value indexed by a JSON path. Examples:";
389
-
`Pre "$(iname) $(b,keywords '[\"codec\"]' package.json)";
390
-
`Noblank;
391
-
`Pre "$(iname) $(b,keywords.[0] '\"codec\"' package.json)";
392
-
`Noblank;
393
-
`Pre "$(iname) $(b,-a keywords.[4] '\"codec\"' package.json)";
394
-
`Noblank;
395
-
`Pre "$(iname) $(b,-s null -a keywords.[4] '\"codec\"' package.json)";
396
-
`Blocks common_man;
397
-
]
398
-
in
399
-
let path_pos =
400
-
let doc = "Set the value indexed by JSON path $(docv)." in
401
-
Arg.(required & pos 0 (some path_arg) None & info [] ~doc ~docv:"JSON_PATH")
402
-
in
403
-
let json_pos =
404
-
let doc = "Set value to $(docv)." in
405
-
Arg.(required & pos 1 (some json_arg) None & info [] ~doc ~docv:"JSON")
406
-
in
407
-
let stub =
408
-
let doc =
409
-
"Use $(b,docv) as a stub value to use if an array needs to be extended \
410
-
when $(b,-a) is used. By default uses the natural zero of the set data: \
411
-
null for null, false for booleans, 0 for numbers, empty\n\
412
-
\ string for strings, empty array for array, empty object for \
413
-
object."
414
-
in
415
-
Arg.(
416
-
value & opt (some json_arg) None & info [ "s"; "stub" ] ~doc ~docv:"JSON")
417
-
in
418
-
Cmd.v (Cmd.info "set" ~doc ~sdocs ~exits ~man)
419
-
@@
420
-
let+ file = file_pos2
421
-
and+ path = path_pos
422
-
and+ json = json_pos
423
-
and+ stub = stub
424
-
and+ format = format_opt_default_preserve
425
-
and+ number_format = number_format_opt
426
-
and+ diff = diff_flag
427
-
and+ allow_absent = allow_absent_opt
428
-
and+ locs = locs_default_true in
429
-
set ~file ~path ~format ~number_format ~diff ~allow_absent ~stub ~json ~locs
430
-
431
-
let locs_cmd =
432
-
let doc = "Show JSON parse locations" in
433
-
let sdocs = Manpage.s_common_options in
434
-
let man =
435
-
[
436
-
`S Manpage.s_description;
437
-
`P "$(tname) outputs JSON parse locations. Example:";
438
-
`Pre "$(iname) $(b,package.json)";
439
-
`Blocks common_man;
440
-
]
441
-
in
442
-
Cmd.v (Cmd.info "locs" ~doc ~sdocs ~exits ~man)
443
-
@@
444
-
let+ file = file_pos0 in
445
-
locs' ~file
446
-
447
-
let jsont =
448
-
let doc = "Process JSON data" in
449
-
let sdocs = Manpage.s_common_options in
450
-
let man =
451
-
[
452
-
`S Manpage.s_description;
453
-
`P "$(mname) processes JSON data in various ways.";
454
-
`Pre "$(b,curl -L URL) | $(mname) $(b,fmt)";
455
-
`Noblank;
456
-
`Pre "$(mname) $(b,fmt package.json)";
457
-
`Noblank;
458
-
`Pre "$(mname) $(b,get 'keywords.[0]' package.json)";
459
-
`Noblank;
460
-
`Pre "$(mname) $(b,set 'keywords.[0]' '\"codec\"' package.json)";
461
-
`Noblank;
462
-
`Pre "$(mname) $(b,delete 'keywords.[0]' package.json)";
463
-
`P
464
-
"More information about $(b,jsont)'s JSON paths is in the section JSON \
465
-
PATHS below.";
466
-
`S Manpage.s_commands;
467
-
`S Manpage.s_common_options;
468
-
`S "JSON PATHS";
469
-
`P
470
-
"For $(mname) a JSON path is a dot separated sequence of indexing \
471
-
operations. For example $(b,books.[1].authors.[0]) indexes an object \
472
-
on the $(b,books) member, then on the second element of an array, \
473
-
then the $(b,authors) member of an object and finally the first \
474
-
element of that array. The root path is $(b,.), it can\n\
475
-
\ be omitted if there are indexing operations.";
476
-
`P
477
-
"In general because of your shell's special characters it's better to \
478
-
single quote your JSON paths.";
479
-
`P
480
-
"Note that $(mname)'s JSON PATH are unrelated to the JSONPath query \
481
-
language (RFC 9535).";
482
-
`Blocks common_man;
483
-
]
484
-
in
485
-
Cmd.group (Cmd.info "jsont" ~version:"%%VERSION%%" ~doc ~sdocs ~exits ~man)
486
-
@@ [ get_cmd; delete_cmd; fmt_cmd; locs_cmd; set_cmd ]
487
-
488
-
let main () = Cmd.eval' jsont
489
-
let () = if !Sys.interactive then () else exit (main ())
+4
-4
test/codecs/quickstart.ml
+4
-4
test/codecs/quickstart.ml
···
24
24
type t = Todo | Done | Cancelled
25
25
26
26
let assoc = [ ("todo", Todo); ("done", Done); ("cancelled", Cancelled) ]
27
-
let jsont = Json.Codec.enum ~kind:"Status" assoc
27
+
let codec = Json.Codec.enum ~kind:"Status" assoc
28
28
end
29
29
30
30
module Item = struct
···
35
35
let status i = i.status
36
36
let tags i = i.tags
37
37
38
-
let jsont =
38
+
let codec =
39
39
Json.Codec.Object.map ~kind:"Item" make
40
40
|> Json.Codec.Object.member "task" Json.Codec.string ~enc:task
41
-
|> Json.Codec.Object.member "status" Status.jsont ~enc:status
41
+
|> Json.Codec.Object.member "status" Status.codec ~enc:status
42
42
|> Json.Codec.Object.member "tags"
43
43
Json.Codec.(list string)
44
44
~enc:tags ~dec_absent:[] ~enc_omit:(( = ) [])
45
45
|> Json.Codec.Object.seal
46
46
end
47
47
48
-
let items = Json.Codec.list Item.jsont
48
+
let items = Json.Codec.list Item.codec
49
49
let items_of_json s = Json.of_string items s
50
50
let items_to_json ?indent is = Json.to_string ?indent items is
-37
test/codecs/test_brr.ml
-37
test/codecs/test_brr.ml
···
1
-
(*---------------------------------------------------------------------------
2
-
Copyright (c) 2024 The jsont programmers. All rights reserved.
3
-
SPDX-License-Identifier: ISC
4
-
---------------------------------------------------------------------------*)
5
-
6
-
open Brr
7
-
open B0_testing
8
-
9
-
(* Tests the common test suite with the Jsont_brr codec. *)
10
-
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
-
16
-
let encode ?indent ?preserve t v =
17
-
Ok (Jstr.to_string (Jsont_brr.to_jstr ?indent ?preserve t v))
18
-
19
-
let test_funs = { Test_common.supports_layout = false; decode; encode }
20
-
21
-
let main () =
22
-
let exit =
23
-
Test.main @@ fun () ->
24
-
Test_common.test_funs := test_funs;
25
-
Test_common.tests ()
26
-
in
27
-
let result = if exit = 0 then "All tests passed!" else "Some tests FAILED!" in
28
-
let children =
29
-
[
30
-
El.h1 [ El.txt' "Jsont_brr tests" ];
31
-
El.p [ El.txt' result ];
32
-
El.p [ El.txt' "Open the browser console for details." ];
33
-
]
34
-
in
35
-
El.set_children (Document.body G.document) children
36
-
37
-
let () = if !Sys.interactive then () else main ()
-35
test/codecs/test_bytesrw.ml
-35
test/codecs/test_bytesrw.ml
···
1
-
(*---------------------------------------------------------------------------
2
-
Copyright (c) 2024 The jsont programmers. All rights reserved.
3
-
SPDX-License-Identifier: ISC
4
-
---------------------------------------------------------------------------*)
5
-
6
-
open B0_std
7
-
open B0_testing
8
-
open Bytesrw
9
-
10
-
(* Tests the common test suite with the Jsont_bytesrw codec. *)
11
-
12
-
let decode ?layout t json = Json.of_string ?layout ~locs:true t json
13
-
let encode ?indent ?preserve t v = Json.to_string ?indent ?preserve t v
14
-
let test_funs = { Test_common.supports_layout = true; decode; encode }
15
-
16
-
(* Other tests *)
17
-
18
-
let test_eod =
19
-
Test.test "Json.to_writer ~eod" @@ fun () ->
20
-
let b = Buffer.create 255 in
21
-
let w = Bytes.Writer.of_buffer b 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
-
Test.string (Buffer.contents b) "truetrue";
25
-
Snap.raise (fun () -> Json.to_writer' Json.Value.bool true ~eod:true w)
26
-
@> __POS_OF__ (Invalid_argument "slice written after eod");
27
-
()
28
-
29
-
let main () =
30
-
Test.main @@ fun () ->
31
-
Test_common.test_funs := test_funs;
32
-
Test.autorun ();
33
-
()
34
-
35
-
let () = if !Sys.interactive then () else exit (main ())
-702
test/codecs/test_common.ml
-702
test/codecs/test_common.ml
···
1
-
(*---------------------------------------------------------------------------
2
-
Copyright (c) 2024 The jsont programmers. All rights reserved.
3
-
SPDX-License-Identifier: ISC
4
-
---------------------------------------------------------------------------*)
5
-
6
-
open B0_std
7
-
open B0_testing
8
-
open Test_common_samples
9
-
10
-
let ( let* ) = Result.bind
11
-
12
-
(* This abstracts over codecs Jsont_brr, Jsont_bytesrw and Json.Json *)
13
-
14
-
type test_funs = {
15
-
supports_layout : bool;
16
-
decode : 'a. ?layout:bool -> 'a Json.codec -> string -> ('a, string) result;
17
-
encode :
18
-
'a.
19
-
?indent:int option ->
20
-
?preserve:bool ->
21
-
'a Json.codec ->
22
-
'a ->
23
-
(string, string) result;
24
-
}
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
-
34
-
let test_funs : test_funs ref =
35
-
ref
36
-
{
37
-
supports_layout = false;
38
-
decode = (fun ?layout:_ _ _ -> assert false);
39
-
encode = (fun ?indent:_ ?preserve:_ _ _ -> assert false);
40
-
}
41
-
42
-
let supports_layout () = !test_funs.supports_layout
43
-
let decode ?layout t json = !test_funs.decode ?layout t json
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
50
-
51
-
(* Test combinators
52
-
53
-
Note that the part of the test combinators rely on the library to
54
-
be correct. If something really feels fishy you may have to
55
-
investigate here too. *)
56
-
57
-
let decode_ok ?__POS__:pos ?value ?(eq = Test.T.any) t json =
58
-
Test.block ?__POS__:pos @@ fun () ->
59
-
match decode t json with
60
-
| Error e -> Test.fail "%a" Fmt.lines e ~__POS__
61
-
| Ok v' -> (
62
-
match value with None -> () | Some value -> Test.eq eq v' value ~__POS__)
63
-
64
-
let encode_ok ?__POS__:pos ?format t ~value json =
65
-
Test.block ?__POS__:pos @@ fun () ->
66
-
match encode ?format t value with
67
-
| Error e -> Test.fail "%a" Fmt.lines e ~__POS__
68
-
| Ok json' -> Test.string json' json ~__POS__
69
-
70
-
let decode_error ?__POS__:pos ?layout ?msg t json =
71
-
Test.block ?__POS__:pos @@ fun () ->
72
-
match decode ?layout t json with
73
-
| Ok _ -> Test.fail "Decode did not error" ~__POS__
74
-
| Error e -> (
75
-
match msg with
76
-
| None -> ()
77
-
| Some msg -> Test.styled_string msg e ~__POS__)
78
-
79
-
let encode_error ?__POS__:pos ?msg t v =
80
-
Test.block ?__POS__:pos @@ fun () ->
81
-
match encode t v with
82
-
| Ok _ -> Test.fail "Encode did not error" ~__POS__
83
-
| Error e -> (
84
-
match msg with
85
-
| None -> ()
86
-
| Some msg -> Test.styled_string msg e ~__POS__)
87
-
88
-
let update ?__POS__:pos ?(format = Minify) q j j' =
89
-
let layout = format = Layout in
90
-
Test.block ?__POS__:pos @@ fun () ->
91
-
match decode ~layout q j with
92
-
| Error e -> Test.fail "%a" Fmt.lines e ~__POS__
93
-
| Ok v when supports_layout () || not (format = Layout) ->
94
-
encode_ok ~format Json.json ~value:v j' ~__POS__
95
-
| Ok v ->
96
-
let j' =
97
-
encode ~format:Indent Json.t (decode Json.json j' |> Result.get_ok)
98
-
|> Result.get_ok
99
-
in
100
-
encode_ok ~format:Indent Json.json ~value:v j' ~__POS__
101
-
102
-
(* [trip t src] is the über testing combinator.
103
-
104
-
It rounds trips a decode of [src] according to [t] and verifies
105
-
that the generated JSON [trip] has the same data unless [lossy] is
106
-
specified. If [value] is provided both decodes of [src] and [trip]
107
-
are tested against [value]. If [format] is specified with
108
-
[Indent] or [Layout] it assumes that [src] and [trip]
109
-
must be equal *)
110
-
111
-
let trip ?(format = Minify) ?(lossy = false) ?value ?(eq = Test.T.any)
112
-
?__POS__:pos t src =
113
-
Test.block ?__POS__:pos @@ fun () ->
114
-
let layout = format = Layout in
115
-
let v =
116
-
Test.noraise ~__POS__ @@ fun () -> Result.get_ok' (decode ~layout t src)
117
-
in
118
-
let trip =
119
-
Test.noraise ~__POS__ @@ fun () -> Result.get_ok' (encode ~format t v)
120
-
in
121
-
let v' = Test.noraise ~__POS__ @@ fun () -> Result.get_ok' (decode t trip) in
122
-
begin match value with
123
-
| None -> Test.eq eq v v' ~__POS__
124
-
| Some value ->
125
-
Test.eq eq v value ~__POS__;
126
-
Test.eq eq v' value ~__POS__
127
-
end;
128
-
if not lossy then begin
129
-
let json =
130
-
Test.noraise ~__POS__ @@ fun () -> Result.get_ok' (decode Json.json src)
131
-
in
132
-
let trip =
133
-
Test.noraise ~__POS__ @@ fun () -> Result.get_ok' (decode Json.json trip)
134
-
in
135
-
Test.eq (module Json.Json) json trip ~__POS__
136
-
end;
137
-
if format <> Minify then
138
-
begin if format = Layout && not (supports_layout ()) then ()
139
-
else
140
-
(* Test that src is a representation of the requested encoding format *)
141
-
Test.string src trip ~__POS__
142
-
end
143
-
144
-
let eq : (module Test.T with type t = 'a) = (module Json.Json)
145
-
146
-
(* Tests *)
147
-
148
-
let test_basic_invalid =
149
-
Test.test "basic invalid JSON" @@ fun () ->
150
-
decode_error Json.json "" ~__POS__;
151
-
decode_error (Json.Value.null ()) "" ~__POS__;
152
-
decode_error Json.Value.bool "" ~__POS__;
153
-
decode_error Json.json "ha" ~__POS__;
154
-
decode_error (Json.Value.null ()) "ha" ~__POS__;
155
-
decode_error Json.Value.bool "ha" ~__POS__;
156
-
decode_error Json.json " ha" ~__POS__;
157
-
decode_error Json.json " r6 " ~__POS__;
158
-
decode_error Json.json " { " ~__POS__;
159
-
decode_error Json.json " [ " ~__POS__;
160
-
decode_error Json.json " ][ " ~__POS__;
161
-
()
162
-
163
-
let test_indent = Test.test "Encode with indentation" @@ fun () -> ()
164
-
165
-
let test_null =
166
-
Test.test "Json.Value.null" @@ fun () ->
167
-
trip ~eq ~format:Layout Json.json " null \r\n" ~__POS__;
168
-
trip ~eq ~format:Layout Json.json "\n null " ~__POS__;
169
-
trip ~eq ~format:Layout Json.json "null" ~__POS__;
170
-
trip ~eq ~format:Indent Json.json "null" ~__POS__;
171
-
decode_error Json.json " nu " ~__POS__;
172
-
decode_error Json.json " nul " ~__POS__;
173
-
decode_error Json.json " n " ~__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
-
()
178
-
179
-
let test_bool =
180
-
Test.test "Json.Value.bool" @@ fun () ->
181
-
trip ~eq ~format:Layout Json.json " true \r\n" ~__POS__;
182
-
trip ~eq ~format:Layout Json.json "\n false " ~__POS__;
183
-
trip ~eq ~format:Layout Json.json "false" ~__POS__;
184
-
trip ~eq ~format:Indent Json.json "true" ~__POS__;
185
-
trip ~eq ~format:Indent Json.json "false" ~__POS__;
186
-
decode_error Json.json " fals " ~__POS__;
187
-
decode_error Json.json " falsee " ~__POS__;
188
-
decode_error Json.json " f " ~__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
-
()
193
-
194
-
let test_numbers =
195
-
Test.test "Json.Value.number" @@ fun () ->
196
-
trip ~eq ~format:Layout Json.json " 1 " ~__POS__;
197
-
trip ~eq ~format:Layout Json.json " 0 \n " ~__POS__;
198
-
trip ~eq ~format:Layout Json.json "\n 2.5 " ~__POS__;
199
-
trip ~eq ~format:Indent Json.json "0";
200
-
trip ~eq ~format:Indent Json.json "0.5";
201
-
decode_error Json.json " 01 " ~__POS__;
202
-
decode_error Json.json " -a " ~__POS__;
203
-
decode_error Json.json " 1. " ~__POS__;
204
-
decode_error Json.json " 1.0e+ " ~__POS__;
205
-
decode_error Json.json " inf " ~__POS__;
206
-
decode_error Json.json " infinity " ~__POS__;
207
-
decode_error Json.json " nan " ~__POS__;
208
-
let eq = Test.T.float in
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
-
()
223
-
224
-
let test_strings =
225
-
Test.test "Json.Value.string" @@ fun () ->
226
-
trip ~eq ~format:Layout Json.json {| "" |} ~__POS__;
227
-
trip ~eq ~format:Layout Json.json " \"\\\"\" " ~__POS__;
228
-
trip ~eq ~format:Layout Json.json " \"\\\\\" " ~__POS__;
229
-
trip ~eq ~format:Layout Json.json " \"hihi\" \n " ~__POS__;
230
-
trip ~eq ~format:Layout Json.json " \"hi\\nhi\" \n " ~__POS__;
231
-
if Sys.backend_type <> Sys.Other "js_of_ocaml" then begin
232
-
decode_error Json.json "\"\\uDC01\"" ~__POS__;
233
-
decode_error Json.json "\"\\uDBFF\"" ~__POS__;
234
-
decode_error Json.json "\"\\uDBFF\\uDBFF\"" ~__POS__
235
-
end;
236
-
trip ~format:Indent Json.json {|""|};
237
-
trip ~format:Indent Json.json {|"blablabla"|};
238
-
decode_error Json.json "\"hi\nhi\"" ~__POS__;
239
-
decode_error Json.json "\n \"abla\" hi " ~__POS__;
240
-
decode_error Json.json "\n \"unclosed hi " ~__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__;
246
-
()
247
-
248
-
let test_option =
249
-
Test.test "Json.{none,some,option}" @@ fun () ->
250
-
(* none *)
251
-
decode_error Json.none "2" ~__POS__;
252
-
decode_error Json.none "true" ~__POS__;
253
-
trip Json.none "null" ~value:None ~__POS__;
254
-
(* some *)
255
-
decode_error Json.(some bool) "null" ~__POS__;
256
-
decode_error Json.(some bool) "1.0" ~__POS__;
257
-
trip Json.(some bool) "true" ~value:(Some true) ~__POS__;
258
-
(* option *)
259
-
decode_error Json.(option bool) "1.0" ~__POS__;
260
-
decode_error Json.(option bool) "{}" ~__POS__;
261
-
trip Json.(option bool) "true" ~value:(Some true) ~__POS__;
262
-
trip Json.(option bool) "false" ~value:(Some false) ~__POS__;
263
-
trip Json.(option bool) "null" ~value:None ~__POS__;
264
-
()
265
-
266
-
let test_ints =
267
-
Test.test "Json.{int…,uint…}" @@ fun () ->
268
-
(* uint8 *)
269
-
decode_error Json.uint8 "null" ~__POS__;
270
-
decode_error Json.uint8 "true" ~__POS__;
271
-
decode_error Json.uint8 "-1" ~__POS__;
272
-
decode_error Json.uint8 "256" ~__POS__;
273
-
trip Json.uint8 "0" ~value:0 ~__POS__;
274
-
trip Json.uint8 "255" ~value:255 ~__POS__;
275
-
(* uint16 *)
276
-
decode_error Json.uint16 "null" ~__POS__;
277
-
decode_error Json.uint16 "true" ~__POS__;
278
-
decode_error Json.uint16 "-1" ~__POS__;
279
-
decode_error Json.uint16 "65536" ~__POS__;
280
-
trip Json.uint16 "0" ~value:0 ~__POS__;
281
-
trip Json.uint16 "65535" ~value:65535 ~__POS__;
282
-
(* int8 *)
283
-
decode_error Json.int8 "null" ~__POS__;
284
-
decode_error Json.int8 "true" ~__POS__;
285
-
decode_error Json.int8 "-129" ~__POS__;
286
-
decode_error Json.int8 "128" ~__POS__;
287
-
trip Json.int8 "-128" ~value:(-128) ~__POS__;
288
-
trip Json.int8 "127" ~value:127 ~__POS__;
289
-
(* int32 *)
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__;
296
-
(* int64 *)
297
-
let max_exact = Int64.shift_left 1L 53 in
298
-
let max_exact_next = Int64.(add max_exact 1L) in
299
-
let min_exact = Int64.shift_left 1L 53 in
300
-
let min_exact_prev = Int64.(add max_exact 1L) in
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
306
-
(Fmt.str {|"%Ld"|} max_exact_next)
307
-
~value:max_exact_next ~__POS__;
308
-
trip Json.Value.int64
309
-
(Fmt.str {|"%Ld"|} min_exact_prev)
310
-
~value:min_exact_prev ~__POS__;
311
-
(* int_as_string *)
312
-
trip Json.Value.int_as_string {|"2"|} ~value:2 ~__POS__;
313
-
trip Json.Value.int_as_string
314
-
(Fmt.str {|"%d"|} Int.max_int)
315
-
~value:Int.max_int ~__POS__;
316
-
trip Json.Value.int_as_string
317
-
(Fmt.str {|"%d"|} Int.min_int)
318
-
~value:Int.min_int ~__POS__;
319
-
(* int64_as_string *)
320
-
trip Json.Value.int64_as_string
321
-
(Fmt.str {|"%Ld"|} Int64.max_int)
322
-
~value:Int64.max_int ~__POS__;
323
-
trip Json.Value.int64_as_string
324
-
(Fmt.str {|"%Ld"|} Int64.min_int)
325
-
~value:Int64.min_int ~__POS__;
326
-
()
327
-
328
-
let test_floats =
329
-
Test.test "Json.{any_float,float_as_hex_string}" @@ fun () ->
330
-
(* any_float *)
331
-
let jsonstr f = Fmt.str {|"%s"|} (Float.to_string f) in
332
-
let eq = Test.T.float in
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
340
-
~__POS__;
341
-
trip ~eq Json.Value.any_float
342
-
(jsonstr Float.neg_infinity)
343
-
~value:Float.neg_infinity ~__POS__;
344
-
345
-
(* float_as_hex_string *)
346
-
let jsonstr f = Fmt.str {|"%h"|} f in
347
-
let t = Json.float_as_hex_string in
348
-
decode_error t "null" ~__POS__;
349
-
decode_error t "1.0" ~__POS__;
350
-
trip ~eq t (jsonstr 0.5) ~value:0.5 ~__POS__;
351
-
trip ~eq t (jsonstr Float.nan) ~value:Float.nan ~__POS__;
352
-
trip ~eq t (jsonstr Float.infinity) ~value:Float.infinity ~__POS__;
353
-
trip ~eq t (jsonstr Float.neg_infinity) ~value:Float.neg_infinity ~__POS__;
354
-
()
355
-
356
-
let test_enum_and_binary_string =
357
-
Test.test "Json.{of_of_string,enum,binary_string}" @@ fun () ->
358
-
(* of_string *)
359
-
let int_of_string s =
360
-
match int_of_string_opt s with
361
-
| None -> Error "Not an integer"
362
-
| Some i -> Ok i
363
-
in
364
-
let t = Json.of_of_string ~kind:"int" int_of_string ~enc:Int.to_string in
365
-
trip ~eq:Test.T.int t {|"1"|} ~value:1 ~__POS__;
366
-
decode_error t {|"bla"|} ~__POS__;
367
-
(* enum *)
368
-
let enum = Json.enum ~kind:"heyho" [ ("hey", `Hey); ("ho", `Ho) ] in
369
-
decode_error enum {|null|} ~__POS__;
370
-
decode_error enum {|"ha"|} ~__POS__;
371
-
decode_error enum {|"farfarfar"|} ~__POS__;
372
-
trip enum {|"hey"|} ~value:`Hey ~__POS__;
373
-
trip enum {|"ho"|} ~value:`Ho ~__POS__;
374
-
(* binary_string *)
375
-
decode_error Json.binary_string {|null|};
376
-
decode_error Json.binary_string {|"00gabb"|} ~__POS__;
377
-
decode_error Json.binary_string {|"00aab"|} ~__POS__;
378
-
trip Json.binary_string {|"00a1bb"|} ~__POS__;
379
-
trip Json.binary_string {|"00a1ff"|} ~value:"\x00\xa1\xff" ~__POS__;
380
-
()
381
-
382
-
let test_arrays =
383
-
Test.test "Json.{list,array,bigarray,t2,t3,t4,tn}" @@ fun () ->
384
-
let barr arr = Bigarray.Array1.of_array Int C_layout arr in
385
-
trip ~eq ~format:Layout Json.json " [] \n" ~__POS__;
386
-
trip ~eq ~format:Layout Json.json " [1, 3] \n\n" ~__POS__;
387
-
trip ~eq ~format:Layout Json.json " [1\n,3] \n\n" ~__POS__;
388
-
trip ~eq ~format:Layout Json.json " [1\n, \"a\",\n3 ] \n\n" ~__POS__;
389
-
trip ~eq ~format:Indent Json.json "[]" ~__POS__;
390
-
trip ~eq ~format:Indent Json.json "[\n 1\n]" ~__POS__;
391
-
trip ~eq ~format:Indent Json.json "[\n 1,\n \"bla\",\n 2\n]" ~__POS__;
392
-
decode_error Json.json "[1 ~__POS__;3]" ~__POS__;
393
-
decode_error Json.json " [1,3 " ~__POS__;
394
-
decode_error Json.(list number) "[1,true,3]" ~__POS__;
395
-
trip Json.(list int) " [ ] \n" ~value:[] ~__POS__;
396
-
trip Json.(list int) "[1,2,3]" ~value:[ 1; 2; 3 ] ~__POS__;
397
-
trip Json.(array int) " [ ] \n" ~value:[||] ~__POS__;
398
-
trip Json.(array int) "[1,2,3]" ~value:[| 1; 2; 3 |] ~__POS__;
399
-
trip Json.(bigarray Int int) " [ ] \n" ~value:(barr [||]) ~__POS__;
400
-
trip
401
-
Json.(bigarray Int int)
402
-
" [1,2,3] \n"
403
-
~value:(barr [| 1; 2; 3 |])
404
-
~__POS__;
405
-
let enc = Array.get in
406
-
let t2_int = Json.t2 ~dec:(fun x y -> [| x; y |]) ~enc Json.Value.int in
407
-
decode_error t2_int "[]" ~__POS__;
408
-
decode_error t2_int "[1]" ~__POS__;
409
-
trip t2_int "[1,2]" ~value:[| 1; 2 |] ~__POS__;
410
-
decode_error t2_int "[1,2,3]" ~__POS__;
411
-
let t3_int = Json.t3 ~dec:(fun x y z -> [| x; y; z |]) ~enc Json.Value.int in
412
-
decode_error t3_int "[]" ~__POS__;
413
-
decode_error t3_int "[1]" ~__POS__;
414
-
decode_error t3_int "[1,2]" ~__POS__;
415
-
trip t3_int "[1,2,3]" ~value:[| 1; 2; 3 |] ~__POS__;
416
-
decode_error t3_int "[1,2,3,4]" ~__POS__;
417
-
let t4_int =
418
-
Json.t4 ~dec:(fun x y z w -> [| x; y; z; w |]) ~enc Json.Value.int
419
-
in
420
-
decode_error t4_int "[]" ~__POS__;
421
-
decode_error t4_int "[1]" ~__POS__;
422
-
decode_error t4_int "[1,2]" ~__POS__;
423
-
decode_error t4_int "[1,2,3]" ~__POS__;
424
-
trip t4_int "[1,2,3,4]" ~value:[| 1; 2; 3; 4 |] ~__POS__;
425
-
decode_error t4_int "[1,2,3,4,5]" ~__POS__;
426
-
let t0_int = Json.(tn ~n:0 int) in
427
-
let t2_int = Json.(tn ~n:2 int) in
428
-
trip t0_int "[]" ~value:[||] ~__POS__;
429
-
decode_error t0_int "[1]" ~__POS__;
430
-
decode_error t0_int "[1;2]" ~__POS__;
431
-
decode_error t2_int "[]" ~__POS__;
432
-
decode_error t2_int "[1]" ~__POS__;
433
-
trip t2_int "[1,2]" ~value:[| 1; 2 |] ~__POS__;
434
-
decode_error t2_int "[1,2,3]" ~__POS__;
435
-
()
436
-
437
-
let test_objects =
438
-
Test.test "Json.Object.map" @@ fun () ->
439
-
trip ~eq ~format:Layout Json.json " {} \n" ~__POS__;
440
-
trip ~eq ~format:Layout Json.json {| {"a": 1} |} ~__POS__;
441
-
trip ~eq ~format:Layout Json.json {| {"a": 1, "b":2} |} ~__POS__;
442
-
trip ~eq ~format:Indent Json.json "{}" ~__POS__;
443
-
trip ~eq ~format:Indent Json.json "{\n \"bla\": 1\n}";
444
-
trip ~format:Indent Item.jsont Item_data.i0_json ~value:Item_data.i0 ~__POS__;
445
-
trip ~format:Indent Item.jsont Item_data.i1_json ~value:Item_data.i1 ~__POS__;
446
-
()
447
-
448
-
let test_unknown_mems =
449
-
Test.test "Json.Object.*_unknown" @@ fun () ->
450
-
(* Skip unknowns *)
451
-
trip Unknown.skip_jsont Unknown_data.u0 ~__POS__;
452
-
trip ~lossy:true Unknown.skip_jsont Unknown_data.u1 ~__POS__;
453
-
trip ~lossy:true Unknown.skip_jsont Unknown_data.u2 ~__POS__;
454
-
(* Error on unknown *)
455
-
trip Unknown.error_jsont Unknown_data.u0 ~__POS__;
456
-
decode_error Unknown.error_jsont Unknown_data.u1 ~__POS__;
457
-
decode_error Unknown.error_jsont Unknown_data.u2 ~__POS__;
458
-
(* Keep unknowns *)
459
-
trip Unknown.keep_jsont Unknown_data.u0 ~__POS__;
460
-
trip Unknown.keep_jsont Unknown_data.u1 ~__POS__;
461
-
trip Unknown.keep_jsont Unknown_data.u2 ~__POS__;
462
-
()
463
-
464
-
let test_cases =
465
-
Test.test "Json.Object.Case" @@ fun () ->
466
-
decode_error Cases.Person_top.jsont Cases_data.invalid_miss ~__POS__;
467
-
decode_error Cases.Person_top.jsont Cases_data.invalid_case ~__POS__;
468
-
decode_error Cases.Person_field.jsont Cases_data.invalid_miss ~__POS__;
469
-
decode_error Cases.Person_field.jsont Cases_data.invalid_case ~__POS__;
470
-
trip Cases.Person_top.jsont Cases_data.author0 ~value:Cases_data.author0_top
471
-
~__POS__;
472
-
trip Cases.Person_top.jsont Cases_data.author0' ~value:Cases_data.author0_top
473
-
~__POS__;
474
-
trip Cases.Person_top.jsont Cases_data.editor0 ~value:Cases_data.editor0_top
475
-
~__POS__;
476
-
trip Cases.Person_top.jsont Cases_data.editor0' ~value:Cases_data.editor0_top
477
-
~__POS__;
478
-
trip Cases.Person_field.jsont Cases_data.author0
479
-
~value:Cases_data.author0_field ~__POS__;
480
-
trip Cases.Person_field.jsont Cases_data.author0'
481
-
~value:Cases_data.author0_field ~__POS__;
482
-
trip Cases.Person_field.jsont Cases_data.editor0
483
-
~value:Cases_data.editor0_field ~__POS__;
484
-
trip Cases.Person_field.jsont Cases_data.editor0'
485
-
~value:Cases_data.editor0_field ~__POS__;
486
-
(* Unknown value override *)
487
-
trip Cases.Keep_unknown.jsont
488
-
~eq:(module Cases.Keep_unknown)
489
-
Cases_data.unknown_a ~value:Cases_data.unknown_a_value ~__POS__;
490
-
trip Cases.Keep_unknown.jsont
491
-
~eq:(module Cases.Keep_unknown)
492
-
Cases_data.unknown_b ~value:Cases_data.unknown_b_value ~__POS__;
493
-
let module M = struct
494
-
type t = string String_map.t
495
-
496
-
let equal = String_map.equal String.equal
497
-
let pp ppf v = Fmt.string ppf "<value>"
498
-
end in
499
-
trip Cases.Keep_unknown.a_jsont
500
-
~eq:(module M)
501
-
Cases_data.unknown_a ~value:Cases_data.unknown_a_a_value ~__POS__;
502
-
encode_ok Cases.Keep_unknown.jsont ~format:Indent
503
-
~value:Cases_data.unknown_a_no_a_unknown_value
504
-
Cases_data.unknown_a_no_a_unknown;
505
-
()
506
-
507
-
let test_rec =
508
-
Test.test "Json.rec" @@ fun () ->
509
-
let tree_null = Tree.jsont_with_null Json.Value.int in
510
-
trip tree_null Tree_data.empty_null ~value:Tree_data.empty ~__POS__;
511
-
trip tree_null Tree_data.tree0_null ~value:Tree_data.tree0 ~__POS__;
512
-
let tree_cases = Tree.jsont_with_cases Json.Value.int in
513
-
trip tree_cases Tree_data.empty_cases ~value:Tree_data.empty ~__POS__;
514
-
trip tree_cases Tree_data.tree0_cases ~value:Tree_data.tree0 ~__POS__;
515
-
()
516
-
517
-
let test_zero =
518
-
Test.test "Json.Value.zero" @@ fun () ->
519
-
let decode_ok = decode_ok ~eq:Test.T.unit in
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__;
526
-
()
527
-
528
-
let test_const =
529
-
Test.test "Json.const" @@ fun () ->
530
-
trip ~lossy:true Json.(const int 4) " {} " ~value:4 ~__POS__;
531
-
trip ~lossy:true Json.(const bool true) ~value:true "false" ~__POS__;
532
-
()
533
-
534
-
let recode_int_to_string = Json.(recode ~dec:int string_of_int ~enc:string)
535
-
536
-
let test_array_queries =
537
-
let a = "[1,[ 1, 2], 3] " in
538
-
Test.test "Json.{nth,*_nth,filter_map_array,fold_array}" @@ fun () ->
539
-
(* Json.nth *)
540
-
decode_ok Json.(nth 0 @@ int) a ~value:1 ~__POS__;
541
-
decode_ok Json.(nth 1 @@ nth 1 int) a ~value:2 ~__POS__;
542
-
decode_ok Json.(nth 1 @@ list int) a ~value:[ 1; 2 ] ~__POS__;
543
-
decode_error Json.(nth 3 @@ int) a ~__POS__;
544
-
decode_ok Json.(nth ~absent:3 3 @@ int) ~value:3 a ~__POS__;
545
-
decode_ok Json.(nth 0 @@ int) ~value:1 a ~__POS__;
546
-
decode_ok Json.(nth 1 @@ nth 1 int) a ~value:2 ~__POS__;
547
-
decode_ok Json.(nth 1 @@ list int) a ~value:[ 1; 2 ] ~__POS__;
548
-
(* Json.{set,update}_nth} *)
549
-
update ~format:Layout
550
-
Json.(update_nth 1 @@ update_nth 1 Json.(const int 4))
551
-
a "[1,[ 1, 4], 3] " ~__POS__;
552
-
update ~format:Layout
553
-
Json.(update_nth 1 @@ set_nth int 0 2)
554
-
a "[1,[ 2, 2], 3] " ~__POS__;
555
-
decode_error Json.(update_nth 1 @@ set_nth int 2 3) a;
556
-
decode_error Json.(update_nth 3 int) a;
557
-
update ~format:Layout Json.(update_nth 3 ~absent:5 int) a "[1,[ 1, 2], 3,5] ";
558
-
update ~format:Layout
559
-
Json.(update_nth 1 @@ set_nth ~allow_absent:true int 3 3)
560
-
a "[1,[ 1, 2,0,3], 3] " ~__POS__;
561
-
update ~format:Layout
562
-
Json.(
563
-
update_nth 1
564
-
@@ set_nth ~stub:(Json.Value.null ()) ~allow_absent:true int 3 3)
565
-
a "[1,[ 1, 2,null,3], 3] " ~__POS__;
566
-
update ~format:Layout
567
-
Json.(update_nth 1 @@ update_nth 1 recode_int_to_string)
568
-
a "[1,[ 1, \"2\"], 3] " ~__POS__;
569
-
update Json.(update_nth 1 @@ delete_nth 0) a "[1,[2],3]" ~__POS__;
570
-
decode_ok
571
-
Json.(nth 1 @@ fold_array int (fun i v acc -> (i, v) :: acc) [])
572
-
a
573
-
~value:[ (1, 2); (0, 1) ]
574
-
~__POS__;
575
-
update
576
-
Json.(
577
-
update_nth 1
578
-
@@ filter_map_array int int (fun _ v ->
579
-
if v mod 2 = 0 then None else Some (v - 1)))
580
-
a "[1,[0],3]" ~__POS__;
581
-
(* Json.delete_nth *)
582
-
update ~format:Layout Json.(delete_nth 1) a "[1, 3] " ~__POS__;
583
-
decode_error Json.(delete_nth 3) a ~__POS__;
584
-
update ~format:Layout Json.(delete_nth ~allow_absent:true 3) a a ~__POS__;
585
-
(* Json.filter_map_array *)
586
-
update ~format:Layout
587
-
Json.(
588
-
filter_map_array Json.json Json.json (fun i v ->
589
-
if i = 1 then None else Some v))
590
-
a "[1, 3] " ~__POS__;
591
-
(* Json.fold_array *)
592
-
decode_ok
593
-
Json.(nth 1 @@ fold_array int (fun i v acc -> i + v + acc) 0)
594
-
a ~value:4 ~__POS__;
595
-
()
596
-
597
-
let test_object_queries =
598
-
Test.test "Json.{mem,*_mem,fold_object,filter_map_object}" @@ fun () ->
599
-
let o = {| { "a" : { "b" : 1 }, "c": 2 } |} in
600
-
(* Json.Value.member *)
601
-
decode_ok Json.(mem "a" @@ mem "b" int) o ~value:1 ~__POS__;
602
-
decode_error Json.(mem "a" @@ mem "c" int) o ~__POS__;
603
-
decode_ok Json.(mem "a" @@ mem ~absent:3 "c" int) o ~value:3 ~__POS__;
604
-
(* Json.{update,set}_mem *)
605
-
update ~format:Layout
606
-
Json.(update_mem "a" @@ update_mem "b" (const int 3))
607
-
o {| { "a" : { "b" : 3 }, "c": 2 } |} ~__POS__;
608
-
update ~format:Layout
609
-
Json.(update_mem "a" @@ update_mem "b" recode_int_to_string)
610
-
o {| { "a" : { "b" : "1" }, "c": 2 } |} ~__POS__;
611
-
decode_error Json.(update_mem "a" @@ update_mem "c" (const int 4)) o ~__POS__;
612
-
update ~format:Layout
613
-
Json.(update_mem "a" @@ update_mem "c" ~absent:4 (const int 5))
614
-
o {| { "a" : { "b" : 1 ,"c":5}, "c": 2 } |} ~__POS__;
615
-
update ~format:Layout
616
-
Json.(set_mem int "a" 2)
617
-
o {| { "a" : 2, "c": 2 } |} ~__POS__;
618
-
decode_error Json.(set_mem int "d" 2) o ~__POS__;
619
-
update ~format:Layout
620
-
Json.(set_mem ~allow_absent:true int "d" 3)
621
-
o {| { "a" : { "b" : 1 }, "c": 2 ,"d":3} |} ~__POS__;
622
-
(* Json.delete_mem *)
623
-
decode_error Json.(update_mem "a" @@ delete_mem "c") o ~__POS__;
624
-
update ~format:Layout
625
-
Json.(update_mem "a" @@ delete_mem ~allow_absent:true "c")
626
-
o o ~__POS__;
627
-
update ~format:Layout
628
-
Json.(update_mem "a" @@ delete_mem "b")
629
-
o {| { "a" : {}, "c": 2 } |} ~__POS__;
630
-
update ~format:Layout Json.(delete_mem "a") o {| { "c": 2 } |} ~__POS__;
631
-
(* Json.filter_map_object *)
632
-
update ~format:Layout
633
-
Json.(
634
-
filter_map_object Json.json Json.json (fun m n v ->
635
-
if n = "a" then None else Some ((n, m), v)))
636
-
o {| { "c": 2 } |} ~__POS__;
637
-
(* Json.fold *)
638
-
decode_ok
639
-
Json.(mem "a" @@ fold_object int (fun _ n i acc -> i + acc) 2)
640
-
o ~value:3 ~__POS__;
641
-
()
642
-
643
-
let test_path_queries =
644
-
Test.test "Json.{path,*_path}" @@ fun () ->
645
-
let v = {| [ 0, { "a": 1}, 2 ] |} in
646
-
(* Json.path *)
647
-
decode_error Json.(path Path.root int) v ~__POS__;
648
-
update ~format:Layout Json.(path Path.root Json.t) v v ~__POS__;
649
-
decode_ok Json.(path Path.(root |> nth 1 |> mem "a") int) v ~value:1;
650
-
decode_ok
651
-
Json.(path Path.(root |> nth 1 |> mem "b") ~absent:2 int)
652
-
v ~value:2 ~__POS__;
653
-
(* Json.{set,update}_path} *)
654
-
update ~format:Layout Json.(set_path int Path.root 2) v {|2|} ~__POS__;
655
-
update ~format:Layout
656
-
Json.(set_path string Path.(root |> nth 1 |> mem "a") "hey")
657
-
v {| [ 0, { "a": "hey"}, 2 ] |} ~__POS__;
658
-
update ~format:Layout
659
-
Json.(
660
-
set_path ~allow_absent:true string Path.(root |> nth 1 |> mem "b") "hey")
661
-
v {| [ 0, { "a": 1,"b":"hey"}, 2 ] |} ~__POS__;
662
-
update ~format:Layout
663
-
Json.(
664
-
update_path
665
-
Path.(root |> nth 1 |> mem "a")
666
-
(map int ~dec:succ ~enc:Fun.id))
667
-
v {| [ 0, { "a": 2}, 2 ] |} ~__POS__;
668
-
(* Json.delete_path *)
669
-
update ~format:Layout
670
-
Json.(delete_path Path.(root |> nth 1 |> mem "a"))
671
-
v {| [ 0, {}, 2 ] |} ~__POS__;
672
-
update ~format:Layout
673
-
Json.(delete_path Path.(root |> nth 1))
674
-
v {| [ 0, 2 ] |} ~__POS__;
675
-
update ~format:Layout Json.(delete_path Path.root) v {|null|} ~__POS__;
676
-
decode_error Json.(delete_path Path.(root |> nth 1 |> mem "b")) v ~__POS__;
677
-
update ~format:Layout
678
-
Json.(delete_path ~allow_absent:true Path.(root |> nth 1 |> mem "b"))
679
-
v v ~__POS__;
680
-
()
681
-
682
-
let tests () =
683
-
test_basic_invalid ();
684
-
test_null ();
685
-
test_bool ();
686
-
test_numbers ();
687
-
test_strings ();
688
-
test_option ();
689
-
test_ints ();
690
-
test_floats ();
691
-
test_enum_and_binary_string ();
692
-
test_arrays ();
693
-
test_objects ();
694
-
test_unknown_mems ();
695
-
test_cases ();
696
-
test_rec ();
697
-
test_zero ();
698
-
test_const ();
699
-
test_array_queries ();
700
-
test_object_queries ();
701
-
test_path_queries ();
702
-
()
+28
-28
test/codecs/test_common_samples.ml
+28
-28
test/codecs/test_common_samples.ml
···
11
11
type t = Todo | Done | Cancelled
12
12
13
13
let assoc = [ ("todo", Todo); ("done", Done); ("cancelled", Cancelled) ]
14
-
let jsont = Json.Codec.enum ~kind:"Status" assoc
14
+
let codec = Json.Codec.enum ~kind:"Status" assoc
15
15
end
16
16
17
17
module Item = struct
···
22
22
let status i = i.status
23
23
let tags i = i.tags
24
24
25
-
let jsont =
25
+
let codec =
26
26
Json.Codec.Object.map ~kind:"Item" make
27
27
|> Json.Codec.Object.member "task" Json.Codec.string ~enc:task
28
-
|> Json.Codec.Object.member "status" Status.jsont ~enc:status
28
+
|> Json.Codec.Object.member "status" Status.codec ~enc:status
29
29
|> Json.Codec.Object.member "tags"
30
30
Json.Codec.(list string)
31
31
~dec_absent:[] ~enc:tags ~enc_omit:(( = ) [])
···
53
53
"{\n \"task\": \"Ho\",\n \"status\": \"done\"\n}"
54
54
end
55
55
56
-
(* JSON types to excerice the different unknown member behaviours. *)
56
+
(* Codecs to exercise the different unknown member behaviours. *)
57
57
58
58
module Unknown = struct
59
59
type t = { m : bool }
···
61
61
let make m = { m }
62
62
let m v = v.m
63
63
64
-
let skip_jsont =
64
+
let skip_codec =
65
65
Json.Codec.Object.map ~kind:"unknown-skip" make
66
66
|> Json.Codec.Object.member "m" Json.Codec.bool ~enc:m
67
67
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.seal
68
68
69
-
let error_jsont =
69
+
let error_codec =
70
70
Json.Codec.Object.map ~kind:"unknown-skip" make
71
71
|> Json.Codec.Object.member "m" Json.Codec.bool ~enc:m
72
72
|> Json.Codec.Object.error_unknown |> Json.Codec.Object.seal
73
73
74
-
let keep_jsont : (t * int String_map.t) Json.codec =
74
+
let keep_codec : (t * int String_map.t) Json.Codec.t =
75
75
let unknown = Json.Codec.Object.Members.string_map Json.Codec.int in
76
76
Json.Codec.Object.map ~kind:"unknown-keep" (fun m imap -> (make m, imap))
77
77
|> Json.Codec.Object.member "m" Json.Codec.bool ~enc:(fun (v, _) -> m v)
···
111
111
let book_count a = a.book_count
112
112
let pseudo a = a.pseudo
113
113
114
-
let jsont =
114
+
let codec =
115
115
Json.Codec.Object.map ~kind:"Author" make
116
116
|> Json.Codec.Object.member "name" Json.Codec.string ~enc:name
117
117
|> Json.Codec.Object.member "book_count" Json.Codec.int ~enc:book_count
···
126
126
let name e = e.name
127
127
let publisher e = e.publisher
128
128
129
-
let jsont =
129
+
let codec =
130
130
Json.Codec.Object.map ~kind:"Editor" make
131
131
|> Json.Codec.Object.member "name" Json.Codec.string ~enc:name
132
132
|> Json.Codec.Object.member "publisher" Json.Codec.string ~enc:publisher
···
138
138
let author a = Author a
139
139
let editor e = Editor e
140
140
141
-
let jsont =
141
+
let codec =
142
142
let case_a =
143
-
Json.Codec.Object.Case.map "author" Author.jsont ~dec:author
143
+
Json.Codec.Object.Case.map "author" Author.codec ~dec:author
144
144
in
145
145
let case_e =
146
-
Json.Codec.Object.Case.map "editor" Editor.jsont ~dec:editor
146
+
Json.Codec.Object.Case.map "editor" Editor.codec ~dec:editor
147
147
in
148
148
let cases = Json.Codec.Object.Case.[ make case_a; make case_e ] in
149
149
let enc_case = function
···
164
164
let pseudo a = a.pseudo
165
165
let book_count a = a.book_count
166
166
167
-
let author_jsont =
167
+
let author_codec =
168
168
Json.Codec.Object.map ~kind:"Author" make_author
169
169
|> Json.Codec.Object.member "pseudo" Json.Codec.string ~enc:pseudo
170
170
|> Json.Codec.Object.member "book_count" Json.Codec.int ~enc:book_count
···
175
175
let make_editor publisher = { publisher }
176
176
let publisher e = e.publisher
177
177
178
-
let editor_jsont =
178
+
let editor_codec =
179
179
Json.Codec.Object.map ~kind:"Editor" make_editor
180
180
|> Json.Codec.Object.member "publisher" Json.Codec.string ~enc:publisher
181
181
|> Json.Codec.Object.seal
···
191
191
let type' v = v.type'
192
192
let name v = v.name
193
193
194
-
let jsont =
194
+
let codec =
195
195
let case_a =
196
-
Json.Codec.Object.Case.map "author" author_jsont ~dec:author
196
+
Json.Codec.Object.Case.map "author" author_codec ~dec:author
197
197
in
198
198
let case_e =
199
-
Json.Codec.Object.Case.map "editor" editor_jsont ~dec:editor
199
+
Json.Codec.Object.Case.map "editor" editor_codec ~dec:editor
200
200
in
201
201
let cases = Json.Codec.Object.Case.[ make case_a; make case_e ] in
202
202
let enc_case = function
···
213
213
module Keep_unknown = struct
214
214
type a = string String_map.t
215
215
216
-
let a_jsont =
216
+
let a_codec =
217
217
let unknown = Json.Codec.Object.Members.string_map Json.Codec.string in
218
218
Json.Codec.Object.map ~kind:"A" Fun.id
219
219
|> Json.Codec.Object.keep_unknown unknown ~enc:Fun.id
···
223
223
224
224
let name b = b.name
225
225
226
-
let b_jsont =
226
+
let b_codec =
227
227
Json.Codec.Object.map ~kind:"B" (fun name -> { name })
228
228
|> Json.Codec.Object.member "name" Json.Codec.string ~enc:name
229
229
|> Json.Codec.Object.error_unknown |> Json.Codec.Object.seal
···
250
250
251
251
let pp ppf v = B0_std.Fmt.string ppf "<value>"
252
252
253
-
let jsont =
254
-
let case_a = Json.Codec.Object.Case.map "A" a_jsont ~dec:a in
255
-
let case_b = Json.Codec.Object.Case.map "B" b_jsont ~dec:b in
253
+
let codec =
254
+
let case_a = Json.Codec.Object.Case.map "A" a_codec ~dec:a in
255
+
let case_b = Json.Codec.Object.Case.map "B" b_codec ~dec:b in
256
256
let cases = Json.Codec.Object.Case.[ make case_a; make case_b ] in
257
257
let enc_case = function
258
258
| A a -> Json.Codec.Object.Case.value case_a a
···
347
347
"right": … }
348
348
349
349
and null is used for empty. *)
350
-
let jsont_with_null t =
350
+
let codec_with_null t =
351
351
let rec tree =
352
352
lazy begin
353
353
let empty = Json.Codec.null Empty in
···
377
377
"value": …,
378
378
"right": … } *)
379
379
380
-
let jsont_with_cases t =
380
+
let codec_with_cases t =
381
381
let rec tree =
382
382
lazy begin
383
-
let leaf_jsont =
383
+
let leaf_codec =
384
384
Json.Codec.Object.map Empty |> Json.Codec.Object.seal
385
385
in
386
-
let node_jsont =
386
+
let node_codec =
387
387
let not_a_node () = failwith "not a node" in
388
388
let value = function Node (_, v, _) -> v | _ -> not_a_node () in
389
389
let left = function Node (l, _, _) -> l | _ -> not_a_node () in
···
395
395
|> Json.Codec.Object.seal
396
396
in
397
397
let case_leaf =
398
-
Json.Codec.Object.Case.map "empty" leaf_jsont ~dec:Fun.id
398
+
Json.Codec.Object.Case.map "empty" leaf_codec ~dec:Fun.id
399
399
in
400
400
let case_node =
401
-
Json.Codec.Object.Case.map "node" node_jsont ~dec:Fun.id
401
+
Json.Codec.Object.Case.map "node" node_codec ~dec:Fun.id
402
402
in
403
403
let enc_case = function
404
404
| Empty as v -> Json.Codec.Object.Case.value case_leaf v
-34
test/codecs/test_json.ml
-34
test/codecs/test_json.ml
···
1
-
(*---------------------------------------------------------------------------
2
-
Copyright (c) 2024 The jsont programmers. All rights reserved.
3
-
SPDX-License-Identifier: ISC
4
-
---------------------------------------------------------------------------*)
5
-
6
-
open B0_std
7
-
open B0_testing
8
-
9
-
(* Tests the common test suite with the Json.Json codec. *)
10
-
11
-
(* Since the Json.Json codec works only on Json.json values we use
12
-
Jsont_bytesrw to codec JSON to Json.json values and then apply the
13
-
Json.Json codec. So the tests rely on a working Jsont_bytesrw
14
-
codec *)
15
-
16
-
let decode ?layout t json =
17
-
match Json.of_string ?layout ~locs:true Json.json json with
18
-
| Error _ as e -> e
19
-
| Ok json -> Json.Value.decode t json
20
-
21
-
let encode ?indent ?preserve t v =
22
-
match Json.Value.encode t v with
23
-
| Error _ as e -> e
24
-
| Ok json -> Json.to_string ?indent ?preserve Json.json json
25
-
26
-
let test_funs = { Test_common.supports_layout = true; decode; encode }
27
-
28
-
let main () =
29
-
Test.main @@ fun () ->
30
-
Test_common.test_funs := test_funs;
31
-
Test_common.tests ();
32
-
()
33
-
34
-
let () = if !Sys.interactive then () else exit (main ())
-82
test/codecs/test_jsont_tool.ml
-82
test/codecs/test_jsont_tool.ml
···
1
-
(*---------------------------------------------------------------------------
2
-
Copyright (c) 2026 The jsont programmers. All rights reserved.
3
-
SPDX-License-Identifier: ISC
4
-
---------------------------------------------------------------------------*)
5
-
6
-
open B0_std
7
-
open Result.Syntax
8
-
open B0_testing
9
-
10
-
let args = Test.Arg.make ()
11
-
let src_in ~cwd src = Fpath.drop_strict_prefix ~prefix:cwd src |> Option.get
12
-
13
-
let snap_stdout ~cwd cmd ~ext src =
14
-
let cmd = Cmd.(cmd %% path (src_in ~cwd src)) in
15
-
Snap.stdout ~cwd ~trim:false cmd !@Fpath.(src -+ ext) ~__POS__
16
-
17
-
let test_locs =
18
-
Test.test' args "locs" @@ fun (finit, cwd, (_i, valid_srcs)) ->
19
-
let cmd = Cmd.(finit % "locs") and ext = ".locs" in
20
-
List.iter (snap_stdout ~cwd cmd ~ext) valid_srcs;
21
-
()
22
-
23
-
let test_pretty =
24
-
Test.test' args "fmt -fpretty" @@ fun (finit, cwd, (_i, valid_srcs)) ->
25
-
let cmd = Cmd.(finit % "fmt" % "-fpretty") and ext = ".pretty.json" in
26
-
List.iter (snap_stdout ~cwd cmd ~ext) valid_srcs;
27
-
()
28
-
29
-
let test_indent =
30
-
Test.test' args "fmt -findent" @@ fun (finit, cwd, (_i, valid_srcs)) ->
31
-
let cmd = Cmd.(finit % "fmt" % "-findent") and ext = ".indent.json" in
32
-
List.iter (snap_stdout ~cwd cmd ~ext) valid_srcs;
33
-
()
34
-
35
-
let test_minify =
36
-
Test.test' args "fmt -fminify" @@ fun (finit, cwd, (_i, valid_srcs)) ->
37
-
let cmd = Cmd.(finit % "fmt" % "-fminify") and ext = ".minify.json" in
38
-
List.iter (snap_stdout ~cwd cmd ~ext) valid_srcs;
39
-
()
40
-
41
-
let test_preserve =
42
-
Test.test' args "fmt -fpreserve" @@ fun (finit, cwd, (_i, valid_srcs)) ->
43
-
let cmd = Cmd.(finit % "fmt" % "-fpreserve") and ext = ".layout.json" in
44
-
List.iter (snap_stdout ~cwd cmd ~ext) valid_srcs;
45
-
()
46
-
47
-
let test_invalid =
48
-
Test.test' args "fmt invalid JSON" @@ fun (finit, cwd, (invalid_srcs, _v)) ->
49
-
let snap src =
50
-
let cmd = Cmd.(finit % "fmt" %% path (src_in ~cwd src)) in
51
-
Snap.run ~cwd cmd !@Fpath.(src -+ ".run") ~__POS__
52
-
in
53
-
List.iter snap invalid_srcs
54
-
55
-
(* Try to streamline that in B0_testing *)
56
-
57
-
let get_jsont_cmd () =
58
-
let var = "B0_TESTING_JSONT" in
59
-
match Os.Env.var ~empty_is_none:true var with
60
-
| None -> Fmt.error "%s unspecified, needs to point to jsont executable" var
61
-
| Some cmd -> Ok (Cmd.tool cmd)
62
-
63
-
let get_srcs dir =
64
-
let* files =
65
-
let dotfiles = false and follow_symlinks = true and recurse = true in
66
-
Os.Dir.contents ~kind:`Files ~dotfiles ~follow_symlinks ~recurse dir
67
-
in
68
-
let is_json f = Fpath.take_ext ~multi:true f = ".json" in
69
-
let is_invalid f = String.starts_with ~prefix:"invalid" (Fpath.basename f) in
70
-
Ok (List.partition is_invalid (List.filter is_json files))
71
-
72
-
let main () =
73
-
Test.main @@ fun () ->
74
-
Test.error_to_failstop
75
-
@@
76
-
let* cmd = get_jsont_cmd () in
77
-
let snapshot_dir = Fpath.(Test.dir () / "snapshots") in
78
-
let* srcs = get_srcs snapshot_dir in
79
-
let args = Test.Arg.[ value args (cmd, snapshot_dir, srcs) ] in
80
-
Ok (Test.autorun ~args ())
81
-
82
-
let () = if !Sys.interactive then () else exit (main ())
-70
test/codecs/test_seriot_suite.ml
-70
test/codecs/test_seriot_suite.ml
···
1
-
(*---------------------------------------------------------------------------
2
-
Copyright (c) 2024 The jsont programmers. All rights reserved.
3
-
SPDX-License-Identifier: ISC
4
-
---------------------------------------------------------------------------*)
5
-
6
-
(* Runs the codec on https://github.com/nst/JSONTestSuite *)
7
-
8
-
open B0_std
9
-
open B0_testing
10
-
open Result.Syntax
11
-
12
-
let status_of_filename name =
13
-
if String.starts_with ~prefix:"y_" name then `Accept
14
-
else if String.starts_with ~prefix:"n_" name then `Reject
15
-
else if String.starts_with ~prefix:"i_" name then `Indeterminate
16
-
else Test.failstop "Unknown kind of test: %s" name
17
-
18
-
let args = Test.Arg.make ()
19
-
20
-
let test_file ~show_errors file =
21
-
Test.error_to_fail
22
-
@@
23
-
let* json = Os.File.read file in
24
-
let name = Fpath.basename file in
25
-
let status = status_of_filename name in
26
-
let file = Fpath.to_string file in
27
-
match Json.of_string ~file ~locs:true Json.json json with
28
-
| Ok _ ->
29
-
if status = `Accept || status = `Indeterminate then Ok (Test.pass ())
30
-
else Fmt.error "@[<v>Test %s@,Should have been rejected:@,%s@]" name json
31
-
| Error e ->
32
-
if show_errors then Test.Log.msg "@[<v>Test %s@,%s@]" name e;
33
-
if status = `Reject || status = `Indeterminate then Ok (Test.pass ())
34
-
else Fmt.error "@[<v>Test %s@,Should have been accepted:@,%s@]" name json
35
-
36
-
let test =
37
-
Test.test' args "test_parsing tests" @@ fun (show_errors, test_files) ->
38
-
Test.block ~kind:"test file" @@ fun () ->
39
-
List.iter (test_file ~show_errors) test_files
40
-
41
-
let get_test_files dir =
42
-
let* exists = Os.Dir.exists dir in
43
-
if not exists then
44
-
Fmt.error "@[%a @[<v>JSONTestSuite not found@,Use %a to download it@]@]"
45
-
Test.Fmt.skip () Fmt.code "b0 -- download-seriot-suite"
46
-
else
47
-
let dir = Fpath.(dir / "test_parsing") in
48
-
let dotfiles = false and follow_symlinks = true and recurse = false in
49
-
Os.Dir.contents ~kind:`Files ~dotfiles ~follow_symlinks ~recurse dir
50
-
51
-
open Cmdliner
52
-
open Cmdliner.Term.Syntax
53
-
54
-
let main () =
55
-
Test.main'
56
-
@@
57
-
let+ show_errors =
58
-
let doc = "Show errors" in
59
-
Arg.(value & flag & info [ "e"; "show-errors" ] ~doc)
60
-
and+ dir =
61
-
let doc = "Repository directory of the test suite." in
62
-
let default = Fpath.v "../tmp/JSONTestSuite" in
63
-
Arg.(value & opt B0_std_cli.dirpath default & info [ "repo-dir" ] ~doc)
64
-
in
65
-
fun () ->
66
-
let dir = Fpath.(Test.dir () // dir) in
67
-
let files = get_test_files dir |> Test.error_to_failstop in
68
-
Test.autorun ~args:Test.Arg.[ value args (show_errors, files) ] ()
69
-
70
-
let () = if !Sys.interactive then () else exit (main ())
+37
-37
test/codecs/topojson.ml
+37
-37
test/codecs/topojson.ml
···
10
10
module Position = struct
11
11
type t = float array
12
12
13
-
let jsont = Json.Codec.(array ~kind:"Position" number)
13
+
let codec = Json.Codec.(array ~kind:"Position" number)
14
14
end
15
15
16
16
module Bbox = struct
17
17
type t = float array
18
18
19
-
let jsont = Json.Codec.(array ~kind:"Bbox" number)
19
+
let codec = Json.Codec.(array ~kind:"Bbox" number)
20
20
end
21
21
22
22
module Arcs = struct
23
23
type t = Position.t array array
24
24
25
-
let jsont = Json.Codec.(array ~kind:"Arcs" (array Position.jsont))
25
+
let codec = Json.Codec.(array ~kind:"Arcs" (array Position.codec))
26
26
end
27
27
28
28
module Transform = struct
···
33
33
let scale t = t.scale
34
34
let translate t = t.translate
35
35
36
-
let v2_jsont =
36
+
let v2_codec =
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
39
Json.Codec.t2 ~dec ~enc Json.Codec.number
40
40
41
-
let jsont =
41
+
let codec =
42
42
Json.Codec.Object.map ~kind:"Transform" make
43
-
|> Json.Codec.Object.member "scale" v2_jsont ~enc:scale
44
-
|> Json.Codec.Object.member "translate" v2_jsont ~enc:translate
43
+
|> Json.Codec.Object.member "scale" v2_codec ~enc:scale
44
+
|> Json.Codec.Object.member "translate" v2_codec ~enc:translate
45
45
|> Json.Codec.Object.seal
46
46
end
47
47
···
51
51
let make coordinates = { coordinates }
52
52
let coordinates v = v.coordinates
53
53
54
-
let jsont =
54
+
let codec =
55
55
Json.Codec.Object.map ~kind:"Point" make
56
-
|> Json.Codec.Object.member "coordinates" Position.jsont ~enc:coordinates
56
+
|> Json.Codec.Object.member "coordinates" Position.codec ~enc:coordinates
57
57
|> Json.Codec.Object.seal
58
58
end
59
59
···
63
63
let make coordinates = { coordinates }
64
64
let coordinates v = v.coordinates
65
65
66
-
let jsont =
66
+
let codec =
67
67
Json.Codec.Object.map ~kind:"MultiPoint" make
68
68
|> Json.Codec.Object.member "coordinates"
69
-
(Json.Codec.list Position.jsont)
69
+
(Json.Codec.list Position.codec)
70
70
~enc:coordinates
71
71
|> Json.Codec.Object.seal
72
72
end
···
77
77
let make arcs = { arcs }
78
78
let arcs v = v.arcs
79
79
80
-
let jsont =
80
+
let codec =
81
81
Json.Codec.Object.map ~kind:"LineString" make
82
82
|> Json.Codec.Object.member "arcs" Json.Codec.(list int32) ~enc:arcs
83
83
|> Json.Codec.Object.seal
···
89
89
let make arcs = { arcs }
90
90
let arcs v = v.arcs
91
91
92
-
let jsont =
92
+
let codec =
93
93
Json.Codec.Object.map ~kind:"MultiLineString" make
94
94
|> Json.Codec.Object.member "arcs" Json.Codec.(list (list int32)) ~enc:arcs
95
95
|> Json.Codec.Object.seal
···
101
101
let make arcs = { arcs }
102
102
let arcs v = v.arcs
103
103
104
-
let jsont =
104
+
let codec =
105
105
Json.Codec.Object.map ~kind:"Polygon" make
106
106
|> Json.Codec.Object.member "arcs" Json.Codec.(list (list int32)) ~enc:arcs
107
107
|> Json.Codec.Object.seal
···
113
113
let make arcs = { arcs }
114
114
let arcs v = v.arcs
115
115
116
-
let jsont =
116
+
let codec =
117
117
Json.Codec.Object.map ~kind:"MultiPolygon" make
118
118
|> Json.Codec.Object.member "arcs"
119
119
Json.Codec.(list (list (list int32)))
···
124
124
module Geometry = struct
125
125
type id = [ `Number of float | `String of string ]
126
126
127
-
let id_jsont =
127
+
let id_codec =
128
128
let number =
129
129
let dec = Json.Codec.Base.dec (fun n -> `Number n) in
130
130
let enc =
···
178
178
let properties_type =
179
179
Json.Codec.Object.as_string_map ~kind:"properties" Json.Codec.Value.t
180
180
181
-
let rec collection_jsont =
181
+
let rec collection_codec =
182
182
lazy begin
183
183
Json.Codec.Object.map ~kind:"GeometryCollection" Fun.id
184
184
|> Json.Codec.Object.member "geometries"
185
-
(Json.Codec.list (Json.Codec.fix jsont))
185
+
(Json.Codec.list (Json.Codec.fix codec))
186
186
~enc:Fun.id
187
187
|> Json.Codec.Object.seal
188
188
end
189
189
190
-
and jsont =
190
+
and codec =
191
191
lazy begin
192
192
let case_map obj dec =
193
193
Json.Codec.Object.Case.map (Json.Codec.kind obj) obj ~dec
194
194
in
195
-
let case_point = case_map Point.jsont point in
196
-
let case_multi_point = case_map Multi_point.jsont multi_point in
197
-
let case_line_string = case_map Line_string.jsont line_string in
198
-
let case_multi_linestr = case_map Multi_line_string.jsont multi_linestr in
199
-
let case_polygon = case_map Polygon.jsont polygon in
200
-
let case_multi_polygon = case_map Multi_polygon.jsont multi_polygon in
201
-
let case_coll = case_map (Lazy.force collection_jsont) collection in
195
+
let case_point = case_map Point.codec point in
196
+
let case_multi_point = case_map Multi_point.codec multi_point in
197
+
let case_line_string = case_map Line_string.codec line_string in
198
+
let case_multi_linestr = case_map Multi_line_string.codec multi_linestr in
199
+
let case_polygon = case_map Polygon.codec polygon in
200
+
let case_multi_polygon = case_map Multi_polygon.codec multi_polygon in
201
+
let case_coll = case_map (Lazy.force collection_codec) collection in
202
202
let enc_case = function
203
203
| Point p -> Json.Codec.Object.Case.value case_point p
204
204
| Multi_point m -> Json.Codec.Object.Case.value case_multi_point m
···
223
223
Json.Codec.Object.map ~kind:"Geometry" make
224
224
|> Json.Codec.Object.case_member "type" Json.Codec.string ~enc:type'
225
225
~enc_case cases ~tag_to_string:Fun.id ~tag_compare:String.compare
226
-
|> Json.Codec.Object.opt_member "id" id_jsont ~enc:id
226
+
|> Json.Codec.Object.opt_member "id" id_codec ~enc:id
227
227
|> Json.Codec.Object.opt_member "properties" properties_type
228
228
~enc:properties
229
-
|> Json.Codec.Object.opt_member "bbox" Bbox.jsont ~enc:bbox
229
+
|> Json.Codec.Object.opt_member "bbox" Bbox.codec ~enc:bbox
230
230
|> Json.Codec.Object.keep_unknown Json.Codec.Value.members ~enc:unknown
231
231
|> Json.Codec.Object.seal
232
232
end
233
233
234
-
let jsont = Lazy.force jsont
234
+
let codec = Lazy.force codec
235
235
236
236
type objects = t String_map.t
237
237
238
-
let objects_jsont = Json.Codec.Object.as_string_map ~kind:"objects map" jsont
238
+
let objects_codec = Json.Codec.Object.as_string_map ~kind:"objects map" codec
239
239
end
240
240
241
241
module Topology = struct
···
256
256
let bbox t = t.bbox
257
257
let unknown t = t.unknown
258
258
259
-
let jsont =
259
+
let codec =
260
260
let kind = "Topology" in
261
261
Json.Codec.Object.map ~kind (fun () -> make)
262
262
|> Json.Codec.Object.member "type"
263
263
(Json.Codec.enum [ (kind, ()) ])
264
264
~enc:(Fun.const ())
265
-
|> Json.Codec.Object.member "objects" Geometry.objects_jsont ~enc:objects
266
-
|> Json.Codec.Object.member "arcs" Arcs.jsont ~enc:arcs
267
-
|> Json.Codec.Object.opt_member "transform" Transform.jsont ~enc:transform
268
-
|> Json.Codec.Object.opt_member "bbox" Bbox.jsont ~enc:bbox
265
+
|> Json.Codec.Object.member "objects" Geometry.objects_codec ~enc:objects
266
+
|> Json.Codec.Object.member "arcs" Arcs.codec ~enc:arcs
267
+
|> Json.Codec.Object.opt_member "transform" Transform.codec ~enc:transform
268
+
|> Json.Codec.Object.opt_member "bbox" Bbox.codec ~enc:bbox
269
269
|> Json.Codec.Object.keep_unknown Json.Codec.Value.members ~enc:unknown
270
270
|> Json.Codec.Object.seal
271
271
end
···
301
301
@@ fun r ->
302
302
log_if_error ~use:1
303
303
@@
304
-
let* t = Json.of_reader ~file ~locs Topology.jsont r in
304
+
let* t = Json.of_reader ~file ~locs Topology.codec r in
305
305
if dec_only then Ok 0
306
306
else
307
307
let w = Bytesrw.Bytes.Writer.of_out_channel stdout in
308
-
Json.to_writer ?indent ~eod:true Topology.jsont t w;
308
+
Json.to_writer ?indent ~eod:true Topology.codec t w;
309
309
Ok 0
310
310
311
311
open Cmdliner
+1
-1
test/codecs/trials.ml
+1
-1
test/codecs/trials.ml
···
10
10
let content msg = msg.content
11
11
let public msg = msg.public
12
12
13
-
let jsont : t Json.codec =
13
+
let codec : t Json.Codec.t =
14
14
Json.Codec.Object.map make
15
15
|> Json.Codec.Object.member "content" Json.Codec.string ~enc:content
16
16
|> Json.Codec.Object.member "public" Json.Codec.bool ~enc:public