Declarative JSON data manipulation for OCaml
ocaml-json: move AST type and value ops to value.ml{i}
Value-centric content (the generic JSON AST and pure operations on it:
meta/set_meta/copy_layout/sort/compare/equal, pretty-printers, the
constructor zoo null/bool/number/int*/string/list/array/object',
find_mem / object_names, zero) moves out of json.ml into its own
module. json.ml re-exposes the AST as [type t = Value.t = ...] so the
public surface is unchanged, and fetches the pretty-printers via
[Value.pp_json] etc. aliases.
This matches the layout already used by ocaml-toml and ocaml-sexp:
a value module for the AST, a main module for codecs and encoders.
Future commits will pull more of the codec combinators into their
own codec.ml{i}.
+284
-54
+15
-52
lib/json.ml
+15
-52
lib/json.ml
···
1381
1381
let enc _v = Error.encode_todo Meta.none ~kind_opt:kind in
1382
1382
map ~kind ?doc ~dec ~enc ignore
1383
1383
1384
-
(* Generic JSON *)
1385
-
1386
-
type name = string node
1384
+
(* Generic JSON. AST type and pure value operations live in Value; this
1385
+
module re-exposes the fields that json.mli keeps at the top level. *)
1387
1386
1388
-
type mem = name * t
1389
-
and object' = mem list
1387
+
type name = Value.name
1388
+
type mem = Value.mem
1389
+
type object' = Value.object'
1390
1390
1391
-
and t =
1391
+
type t = Value.t =
1392
1392
| Null of unit node
1393
1393
| Bool of bool node
1394
1394
| Number of float node
···
1396
1396
| Array of t list node
1397
1397
| Object of object' node
1398
1398
1399
-
let pp_null = Fmt.json_null
1400
-
let pp_bool = Fmt.json_bool
1401
-
let pp_string = Fmt.json_string
1402
-
let pp_number = Fmt.json_number
1403
-
let pp_number' = Fmt.json_number'
1399
+
let pp_null = Value.pp_null
1400
+
let pp_bool = Value.pp_bool
1401
+
let pp_string = Value.pp_string
1402
+
let pp_number = Value.pp_number
1403
+
let pp_number' = Value.pp_number'
1404
+
let pp_json = Value.pp_json
1405
+
let pp_json' = Value.pp_json'
1404
1406
1405
-
let pp_json' ?(number_format = Fmt.json_default_number_format) () ppf j =
1406
-
let pp_indent = 2 in
1407
-
let pp_sep ppf () =
1408
-
Format.pp_print_char ppf ',';
1409
-
Format.pp_print_break ppf 1 pp_indent
1410
-
in
1411
-
let rec pp_array ppf a =
1412
-
Format.pp_open_hovbox ppf 0;
1413
-
Format.pp_print_char ppf '[';
1414
-
Format.pp_print_break ppf 0 pp_indent;
1415
-
(Format.pp_print_list ~pp_sep pp_value) ppf a;
1416
-
Format.pp_print_break ppf 0 0;
1417
-
Format.pp_print_char ppf ']';
1418
-
Format.pp_close_box ppf ()
1419
-
and pp_mem ppf ((m, _), v) =
1420
-
Format.pp_open_hvbox ppf 0;
1421
-
pp_string ppf m;
1422
-
Format.pp_print_string ppf ": ";
1423
-
pp_value ppf v;
1424
-
Format.pp_close_box ppf ()
1425
-
and pp_obj ppf o =
1426
-
Format.pp_open_hvbox ppf 0;
1427
-
Format.pp_print_char ppf '{';
1428
-
Format.pp_print_break ppf 0 pp_indent;
1429
-
(Format.pp_print_list ~pp_sep pp_mem) ppf o;
1430
-
Format.pp_print_break ppf 0 0;
1431
-
Format.pp_print_char ppf '}';
1432
-
Format.pp_close_box ppf ()
1433
-
and pp_value ppf = function
1434
-
| Null _ -> pp_null ppf ()
1435
-
| Bool (b, _) -> pp_bool ppf b
1436
-
| Number (f, _) -> pp_number' number_format ppf f
1437
-
| String (s, _) -> pp_string ppf s
1438
-
| Array (a, _) -> pp_array ppf a
1439
-
| Object (o, _) -> pp_obj ppf o
1440
-
in
1441
-
pp_value ppf j
1407
+
type number_format = Value.number_format
1442
1408
1443
-
let pp_json ppf j = pp_json' () ppf j
1409
+
let default_number_format = Value.default_number_format
1444
1410
1445
1411
(* Generic JSON *)
1446
1412
···
2253
2219
(* Formatting *)
2254
2220
2255
2221
type format = Minify | Indent | Layout
2256
-
type number_format = Fmt.json_number_format
2257
-
2258
-
let default_number_format = Fmt.json_default_number_format
2259
2222
2260
2223
let pp_value ?number_format t () =
2261
2224
fun ppf v ->
+182
-1
lib/value.ml
+182
-1
lib/value.ml
···
1
-
(** Generic JSON values. See {!Json.Value} for the public API. *)
1
+
(* Generic JSON values. See value.mli for documentation. *)
2
+
3
+
module Meta = Loc.Meta
4
+
5
+
type 'a fmt = Format.formatter -> 'a -> unit
6
+
type 'a node = 'a * Meta.t
7
+
type name = string node
8
+
9
+
type mem = name * t
10
+
and object' = mem list
11
+
12
+
and t =
13
+
| Null of unit node
14
+
| Bool of bool node
15
+
| Number of float node
16
+
| String of string node
17
+
| Array of t list node
18
+
| Object of object' node
19
+
20
+
type 'a cons = ?meta:Meta.t -> 'a -> t
21
+
22
+
(* Pretty-printers *)
23
+
24
+
let pp_null = Core.Fmt.json_null
25
+
let pp_bool = Core.Fmt.json_bool
26
+
let pp_string = Core.Fmt.json_string
27
+
let pp_number = Core.Fmt.json_number
28
+
let pp_number' = Core.Fmt.json_number'
29
+
30
+
type number_format = Core.Fmt.json_number_format
31
+
32
+
let default_number_format = Core.Fmt.json_default_number_format
33
+
34
+
let pp_json' ?(number_format = default_number_format) () ppf j =
35
+
let pp_indent = 2 in
36
+
let pp_sep ppf () =
37
+
Format.pp_print_char ppf ',';
38
+
Format.pp_print_break ppf 1 pp_indent
39
+
in
40
+
let rec pp_array ppf a =
41
+
Format.pp_open_hovbox ppf 0;
42
+
Format.pp_print_char ppf '[';
43
+
Format.pp_print_break ppf 0 pp_indent;
44
+
(Format.pp_print_list ~pp_sep pp_value) ppf a;
45
+
Format.pp_print_break ppf 0 0;
46
+
Format.pp_print_char ppf ']';
47
+
Format.pp_close_box ppf ()
48
+
and pp_mem ppf ((m, _), v) =
49
+
Format.pp_open_hvbox ppf 0;
50
+
pp_string ppf m;
51
+
Format.pp_print_string ppf ": ";
52
+
pp_value ppf v;
53
+
Format.pp_close_box ppf ()
54
+
and pp_obj ppf o =
55
+
Format.pp_open_hvbox ppf 0;
56
+
Format.pp_print_char ppf '{';
57
+
Format.pp_print_break ppf 0 pp_indent;
58
+
(Format.pp_print_list ~pp_sep pp_mem) ppf o;
59
+
Format.pp_print_break ppf 0 0;
60
+
Format.pp_print_char ppf '}';
61
+
Format.pp_close_box ppf ()
62
+
and pp_value ppf = function
63
+
| Null _ -> pp_null ppf ()
64
+
| Bool (b, _) -> pp_bool ppf b
65
+
| Number (f, _) -> pp_number' number_format ppf f
66
+
| String (s, _) -> pp_string ppf s
67
+
| Array (a, _) -> pp_array ppf a
68
+
| Object (o, _) -> pp_obj ppf o
69
+
in
70
+
pp_value ppf j
71
+
72
+
let pp_json ppf j = pp_json' () ppf j
73
+
let pp = pp_json
74
+
75
+
(* Metadata *)
76
+
77
+
let meta = function
78
+
| Null (_, m) -> m
79
+
| Bool (_, m) -> m
80
+
| Number (_, m) -> m
81
+
| String (_, m) -> m
82
+
| Array (_, m) -> m
83
+
| Object (_, m) -> m
84
+
85
+
let set_meta m = function
86
+
| Null (v, _) -> Null (v, m)
87
+
| Bool (v, _) -> Bool (v, m)
88
+
| Number (v, _) -> Number (v, m)
89
+
| String (v, _) -> String (v, m)
90
+
| Array (v, _) -> Array (v, m)
91
+
| Object (v, _) -> Object (v, m)
92
+
93
+
let get_meta = meta
94
+
let copy_layout v ~dst = set_meta (Meta.copy_ws (meta v) ~dst:(meta dst)) dst
95
+
96
+
let sort = function
97
+
| Null _ -> Core.Sort.Null
98
+
| Bool _ -> Core.Sort.Bool
99
+
| Number _ -> Core.Sort.Number
100
+
| String _ -> Core.Sort.String
101
+
| Array _ -> Core.Sort.Array
102
+
| Object _ -> Core.Sort.Object
103
+
104
+
(* Equality and comparison *)
105
+
106
+
let rec compare (j0 : t) (j1 : t) =
107
+
match (j0, j1) with
108
+
| Null ((), _), Null ((), _) -> 0
109
+
| Null _, _ -> -1
110
+
| _, Null _ -> 1
111
+
| Bool (b0, _), Bool (b1, _) -> Bool.compare b0 b1
112
+
| Bool _, _ -> -1
113
+
| _, Bool _ -> 1
114
+
| Number (f0, _), Number (f1, _) -> Float.compare f0 f1
115
+
| Number _, _ -> -1
116
+
| _, Number _ -> 1
117
+
| String (s0, _), String (s1, _) -> String.compare s0 s1
118
+
| String _, _ -> -1
119
+
| _, String _ -> 1
120
+
| Array (a0, _), Array (a1, _) -> List.compare compare a0 a1
121
+
| Array _, _ -> -1
122
+
| _, Array _ -> 1
123
+
| Object (o0, _), Object (o1, _) ->
124
+
let order_mem ((n0, _), _) ((n1, _), _) = String.compare n0 n1 in
125
+
let compare_mem ((n0, _), j0) ((n1, _), j1) =
126
+
let c = String.compare n0 n1 in
127
+
if c = 0 then compare j0 j1 else c
128
+
in
129
+
List.compare compare_mem (List.sort order_mem o0) (List.sort order_mem o1)
130
+
131
+
let equal j0 j1 = compare j0 j1 = 0
132
+
133
+
(* Constructors *)
134
+
135
+
let null' = Null ((), Meta.none)
136
+
let null ?(meta = Meta.none) () = Null ((), meta)
137
+
let option c ?meta = function None -> null ?meta () | Some v -> c ?meta v
138
+
let bool ?(meta = Meta.none) b = Bool (b, meta)
139
+
let number ?(meta = Meta.none) n = Number (n, meta)
140
+
141
+
let any_float ?(meta = Meta.none) v =
142
+
if Float.is_finite v then Number (v, meta) else String (Float.to_string v, meta)
143
+
144
+
let int32 ?(meta = Meta.none) v = Number (Int32.to_float v, meta)
145
+
let int64_as_string ?(meta = Meta.none) v = String (Int64.to_string v, meta)
146
+
147
+
let int64 ?(meta = Meta.none) v =
148
+
if Core.Number.can_store_exact_int64 v then Number (Int64.to_float v, meta)
149
+
else String (Int64.to_string v, meta)
150
+
151
+
let int_as_string ?(meta = Meta.none) i = String (Int.to_string i, meta)
152
+
153
+
let int ?(meta = Meta.none) v =
154
+
if Core.Number.can_store_exact_int v then Number (Int.to_float v, meta)
155
+
else String (Int.to_string v, meta)
156
+
157
+
let string ?(meta = Meta.none) s = String (s, meta)
158
+
let list ?(meta = Meta.none) l = Array (l, meta)
159
+
let array ?(meta = Meta.none) a = Array (Stdlib.Array.to_list a, meta)
160
+
let empty_array = list []
161
+
let name ?(meta = Meta.none) n = (n, meta)
162
+
let mem n v = (n, v)
163
+
let object' ?(meta = Meta.none) mems = Object (mems, meta)
164
+
let empty_object = object' []
165
+
166
+
let rec find_mem n = function
167
+
| [] -> None
168
+
| (((n', _), _) as m) :: ms ->
169
+
if String.equal n n' then Some m else find_mem n ms
170
+
171
+
let find_mem' (n, _) ms = find_mem n ms
172
+
let object_names mems = List.map (fun ((n, _), _) -> n) mems
173
+
let object_names' mems = List.map fst mems
174
+
175
+
let zero ?meta j =
176
+
match sort j with
177
+
| Null -> null ?meta ()
178
+
| Bool -> bool ?meta false
179
+
| Number -> number ?meta 0.
180
+
| String -> string ?meta ""
181
+
| Array -> list ?meta []
182
+
| Object -> object' ?meta []
+87
-1
lib/value.mli
+87
-1
lib/value.mli
···
1
-
(** Generic JSON values. See {!Json.Value} for the public API. *)
1
+
(** Generic JSON values.
2
+
3
+
The core AST: atoms ([Null], [Bool], [Number], [String]) plus [Array] and
4
+
[Object] built from them. Each value carries metadata (source location,
5
+
surrounding whitespace) for error reporting and layout-preserving recode.
6
+
7
+
{!Json.Value} re-exports this module as the value-facing part of the public
8
+
API. *)
9
+
10
+
module Meta = Loc.Meta
11
+
12
+
type 'a fmt = Format.formatter -> 'a -> unit
13
+
type 'a node = 'a * Meta.t
14
+
type name = string node
15
+
16
+
type mem = name * t
17
+
and object' = mem list
18
+
19
+
and t =
20
+
| Null of unit node
21
+
| Bool of bool node
22
+
| Number of float node
23
+
| String of string node
24
+
| Array of t list node
25
+
| Object of object' node
26
+
27
+
type 'a cons = ?meta:Meta.t -> 'a -> t
28
+
29
+
(** {1:metadata Metadata} *)
30
+
31
+
val meta : t -> Meta.t
32
+
val set_meta : Meta.t -> t -> t
33
+
val get_meta : t -> Meta.t
34
+
val copy_layout : t -> dst:t -> t
35
+
val sort : t -> Core.Sort.t
36
+
37
+
(** {1:compare Equality and ordering} *)
38
+
39
+
val compare : t -> t -> int
40
+
val equal : t -> t -> bool
41
+
42
+
(** {1:construct Constructors} *)
43
+
44
+
val null : unit cons
45
+
val option : 'a cons -> 'a option cons
46
+
val bool : bool cons
47
+
val number : float cons
48
+
val any_float : float cons
49
+
val int32 : int32 cons
50
+
val int64 : int64 cons
51
+
val int64_as_string : int64 cons
52
+
val int : int cons
53
+
val int_as_string : int cons
54
+
val string : string cons
55
+
val list : t list cons
56
+
val array : t array cons
57
+
val object' : mem list cons
58
+
val empty_array : t
59
+
val empty_object : t
60
+
val name : ?meta:Meta.t -> string -> name
61
+
val mem : name -> t -> mem
62
+
63
+
(** {1:object Object operations} *)
64
+
65
+
val find_mem : string -> mem list -> mem option
66
+
val find_mem' : name -> mem list -> mem option
67
+
val object_names : mem list -> string list
68
+
val object_names' : mem list -> name list
69
+
70
+
(** {1:zero Zero values} *)
71
+
72
+
val zero : ?meta:Meta.t -> t -> t
73
+
74
+
(** {1:printing Pretty-printing} *)
75
+
76
+
val pp_null : unit fmt
77
+
val pp_bool : bool fmt
78
+
val pp_string : string fmt
79
+
val pp_number : float fmt
80
+
81
+
type number_format = Core.Fmt.json_number_format
82
+
83
+
val default_number_format : number_format
84
+
val pp_number' : number_format -> float fmt
85
+
val pp_json : t fmt
86
+
val pp_json' : ?number_format:number_format -> unit -> t fmt
87
+
val pp : t fmt