Declarative JSON data manipulation for OCaml
loc,json,skill: hoist Context out of Error, make Path.step extensible
Loc.Error.Context moves to top-level Loc.Context: the noun that cursors,
stream callbacks, and errors all speak is position-in-document, not
error-specific. Errors are one consumer of Context, alongside Cursor
and Stream.
Path.index becomes an extensible Path.step (Mem of string node | Nth of
int node baseline); formats add native addressing (Attribute,
Namespaced, Cbor_key, Field_number) via extension + register_step_printer.
Path.rev_indices -> Path.rev_steps; add Path.last, Path.to_list.
Error.t exposed as a record {ctx; meta; kind} so pattern matches
remain clean. Error.v/msg/raise take ~ctx ~meta labelled args.
JSON consumer: Json.Error.Context dropped; Json.Context aliases
Loc.Context. Query step fallback projects unknown steps to Mem via
Path.pp_step so foreign paths degrade to no-op queries instead of
failing.
Skill: Foo.Stream.fold/iter take (Loc.Context.t -> ...) callback
(one primitive, no _mem/_nth variants); transform takes f:(Context.t
-> [Copy|Edit|Drop]). Layer 3 documents extensible Path.step with
per-format native step examples.
+68
-64
+2
-2
lib/brr/json_brr.ml
+2
-2
lib/brr/json_brr.ml
···
10
10
let error_to_jv_error e = Jv.Error.v (Jstr.of_string (Json.Error.to_string e))
11
11
12
12
let jv_error_to_error e =
13
-
let ctx = Json.Error.Context.empty and meta = Json.Meta.none in
14
-
Json.Error.msg ctx meta (Jstr.to_string (Jv.Error.message e))
13
+
let ctx = Json.Context.empty and meta = Json.Meta.none in
14
+
Json.Error.msg ~ctx ~meta (Jstr.to_string (Jv.Error.message e))
15
15
16
16
(* Browser JSON codec *)
17
17
+8
-5
lib/error.ml
+8
-5
lib/error.ml
···
22
22
Fmt.pf ppf "Expected %a but found %a" Fmt.code exp Sort.pp fnd)
23
23
| _ -> None)
24
24
25
-
type t = Loc.Error.t
26
-
27
-
module Context = Loc.Error.Context
25
+
type t = Loc.Error.t = {
26
+
ctx : Loc.Context.t;
27
+
meta : Loc.Meta.t;
28
+
kind : kind;
29
+
}
28
30
29
31
let kind_to_string = Loc.Error.kind_to_string
30
32
let v = Loc.Error.v
···
47
49
let expected meta exp ~fnd =
48
50
msgf meta "Expected %a but found %a" Fmt.code exp Fmt.code fnd
49
51
50
-
let sort meta ~exp ~fnd = raise Context.empty meta (Sort_mismatch { exp; fnd })
52
+
let sort meta ~exp ~fnd =
53
+
raise ~ctx:Loc.Context.empty ~meta (Sort_mismatch { exp; fnd })
51
54
52
55
let kinded_sort meta ~exp ~fnd =
53
-
raise Context.empty meta (Kinded_sort_mismatch { exp; fnd })
56
+
raise ~ctx:Loc.Context.empty ~meta (Kinded_sort_mismatch { exp; fnd })
54
57
55
58
let missing_mems meta ~kinded_sort ~exp ~fnd =
56
59
let pp_miss ppf m =
+11
-9
lib/error.mli
+11
-9
lib/error.mli
···
16
16
(** [kind_to_string k] is a human-readable rendering of [k], using the printers
17
17
registered with {!Loc.Error.register_kind_printer}. *)
18
18
19
-
type t = Loc.Error.t
19
+
type t = Loc.Error.t = {
20
+
ctx : Loc.Context.t;
21
+
meta : Loc.Meta.t;
22
+
kind : kind;
23
+
}
20
24
(** The type for errors: a context, a meta and a kind. *)
21
25
22
-
module Context = Loc.Error.Context
23
-
24
-
val v : Context.t -> Loc.Meta.t -> kind -> t
25
-
(** [v ctx meta k] is a fresh error [(ctx, meta, k)]. *)
26
+
val v : ctx:Loc.Context.t -> meta:Loc.Meta.t -> kind -> t
27
+
(** [v ~ctx ~meta k] is a fresh error. *)
26
28
27
-
val msg : Context.t -> Loc.Meta.t -> string -> t
28
-
(** [msg ctx meta s] is a fresh error with a plain {!Loc.Error.Msg} kind. *)
29
+
val msg : ctx:Loc.Context.t -> meta:Loc.Meta.t -> string -> t
30
+
(** [msg ~ctx ~meta s] is a fresh error with a plain {!Loc.Error.Msg} kind. *)
29
31
30
-
val raise : Context.t -> Loc.Meta.t -> kind -> 'a
31
-
(** [raise ctx meta k] raises [Loc.Error.Error (v ctx meta k)]. *)
32
+
val raise : ctx:Loc.Context.t -> meta:Loc.Meta.t -> kind -> 'a
33
+
(** [raise ~ctx ~meta k] raises [Loc.Error.Error (v ~ctx ~meta k)]. *)
32
34
33
35
val fail : Loc.Meta.t -> string -> 'a
34
36
(** [fail meta s] raises with an empty context and message [s]. *)
+28
-10
lib/json.ml
+28
-10
lib/json.ml
···
12
12
type 'a node = 'a * Meta.t
13
13
14
14
module Path = Loc.Path
15
+
module Context = Loc.Context
15
16
module Sort = Core.Sort
16
17
17
18
exception Error = Loc.Error
···
1597
1598
1598
1599
(* Index queries *)
1599
1600
1601
+
(* Foreign path steps (introduced by other formats via the extensible
1602
+
[Path.step]) are projected to [Mem <pp>]: any step pretty-prints to a
1603
+
string, so treat it as a name-addressed member by that stringification.
1604
+
Worst case this yields a no-op query against a JSON object that does not
1605
+
hold a member of that name. *)
1606
+
let step_as_mem s = Fmt.str "%a" Path.pp_step s
1607
+
1600
1608
let index ?absent i t =
1601
-
match (i : Path.index) with
1609
+
match (i : Path.step) with
1602
1610
| Path.Nth (n, _) -> nth ?absent n t
1603
1611
| Path.Mem (n, _) -> mem ?absent n t
1612
+
| s -> mem ?absent (step_as_mem s) t
1604
1613
1605
1614
let set_index ?allow_absent t i v =
1606
-
match (i : Path.index) with
1615
+
match (i : Path.step) with
1607
1616
| Path.Nth (n, _) -> set_nth ?allow_absent t n v
1608
1617
| Path.Mem (n, _) -> set_mem ?allow_absent t n v
1618
+
| s -> set_mem ?allow_absent t (step_as_mem s) v
1609
1619
1610
1620
let update_index ?stub ?absent i t =
1611
-
match (i : Path.index) with
1621
+
match (i : Path.step) with
1612
1622
| Path.Nth (n, _) -> update_nth ?stub ?absent n t
1613
1623
| Path.Mem (n, _) -> update_mem ?absent n t
1624
+
| s -> update_mem ?absent (step_as_mem s) t
1614
1625
1615
1626
let delete_index ?allow_absent = function
1616
1627
| Path.Nth (n, _) -> delete_nth ?allow_absent n
1617
1628
| Path.Mem (n, _) -> delete_mem ?allow_absent n
1629
+
| s -> delete_mem ?allow_absent (step_as_mem s)
1618
1630
1619
1631
(* Path queries *)
1620
1632
1621
1633
let path ?absent p q =
1622
-
List.fold_left (fun q i -> index ?absent i q) q (Path.rev_indices p)
1634
+
List.fold_left (fun q i -> index ?absent i q) q (Path.rev_steps p)
1623
1635
1624
1636
let update_path ?stub ?absent p t =
1625
-
match Path.rev_indices p with
1637
+
match Path.rev_steps p with
1626
1638
| [] -> update t
1627
1639
| i :: is -> (
1628
1640
match absent with
···
1636
1648
| Path.Mem (n, _) :: is ->
1637
1649
loop Ast.empty_object (update_mem ~absent n t) is
1638
1650
| [] -> t
1651
+
| s :: is ->
1652
+
loop Ast.empty_object (update_mem ~absent (step_as_mem s) t) is
1639
1653
in
1640
1654
match i with
1641
1655
| Path.Nth (n, _) ->
1642
1656
loop Ast.empty_array (update_nth ?stub ~absent n t) is
1643
1657
| Path.Mem (n, _) ->
1644
-
loop Ast.empty_object (update_mem ~absent n t) is))
1658
+
loop Ast.empty_object (update_mem ~absent n t) is
1659
+
| s ->
1660
+
loop Ast.empty_object
1661
+
(update_mem ~absent (step_as_mem s) t)
1662
+
is))
1645
1663
1646
1664
let null_value : Ast.t = Ast.Null ((), Meta.none)
1647
1665
1648
1666
let delete_path ?allow_absent p =
1649
-
match Path.rev_indices p with
1667
+
match Path.rev_steps p with
1650
1668
| [] -> recode ~dec:ignore (fun () -> null_value) ~enc:Value.t
1651
1669
| i :: is ->
1652
1670
let upd del i = update_index i del in
1653
1671
List.fold_left upd (delete_index ?allow_absent i) is
1654
1672
1655
1673
let set_path ?stub ?(allow_absent = false) t p v =
1656
-
match Path.rev_indices p with
1674
+
match Path.rev_steps p with
1657
1675
| [] -> recode ~dec:ignore (fun () -> encode_exn t v) ~enc:Value.t
1658
1676
| _ :: _ ->
1659
1677
let absent = if allow_absent then Some v else None in
···
2541
2559
decode_object_map d map (Unknown_mems None) String_map.empty
2542
2560
String_map.empty [] Dict.empty
2543
2561
with
2544
-
| Error (ctx, meta, k) when Error.Context.is_empty ctx ->
2562
+
| Error { ctx; meta; kind } when Loc.Context.is_empty ctx ->
2545
2563
let meta =
2546
2564
(* This is for when Codec.finish_object_decode raises. *)
2547
2565
if Loc.is_none (Meta.textloc meta) then
2548
2566
error_meta_to_current d ~first_byte ~first_line_num ~first_line_byte
2549
2567
else meta
2550
2568
in
2551
-
Error.raise ctx meta k
2569
+
Error.raise ~ctx ~meta kind
2552
2570
| Error e ->
2553
2571
Error.adjust_context ~first_byte ~first_line_num ~first_line_byte e
2554
2572
in
+19
-38
lib/json.mli
+19
-38
lib/json.mli
···
40
40
module Path = Loc.Path
41
41
(** Structural paths (object members, array indices). *)
42
42
43
+
module Context = Loc.Context
44
+
(** Navigation contexts (path + source loc + active sort). *)
45
+
43
46
(** Sorts of JSON values. *)
44
47
module Sort : sig
45
48
(** The type for sorts of JSON values. *)
···
86
89
87
90
(** {1:errors Errors} *)
88
91
89
-
(** JSON error contexts. *)
90
-
module Context : sig
91
-
type index = string node * Path.index
92
-
(** The type for context indices. The kinded sort of an array or object and
93
-
its index. *)
94
-
95
-
type t = index list
96
-
(** The type for erroring contexts. The first element indexes the root JSON
97
-
value. *)
98
-
99
-
val empty : t
100
-
(** [empty] is the empty context. *)
101
-
102
-
val is_empty : t -> bool
103
-
(** [is_empty ctx] is [true] iff [ctx] is {!empty}. *)
104
-
105
-
val push_array : string node -> int node -> t -> t
106
-
(** [push_array kinded_sort n ctx] wraps [ctx] as the [n]th element of an
107
-
array of kinded sort [kinded_sort]. *)
108
-
109
-
val push_object : string node -> string node -> t -> t
110
-
(** [push_object kinded_sort n ctx] wraps [ctx] as the member named [n] of
111
-
an object of kinded sort [kinded_sort]. *)
112
-
end
92
+
type t = Loc.Error.t = {
93
+
ctx : Context.t;
94
+
meta : Meta.t;
95
+
kind : kind;
96
+
}
97
+
(** The type for errors. *)
113
98
114
-
type t = Context.t * Meta.t * kind
115
-
(** The type for errors. The context, the error localisation and the kind of
116
-
error. *)
99
+
val v : ctx:Context.t -> meta:Meta.t -> kind -> t
100
+
(** [v ~ctx ~meta k] constructs an error with a typed kind. *)
117
101
118
-
val v : Context.t -> Meta.t -> kind -> t
119
-
(** [v ctx meta k] constructs an error with a typed kind. *)
102
+
val msg : ctx:Context.t -> meta:Meta.t -> string -> t
103
+
(** [msg ~ctx ~meta s] constructs an error from a plain string. *)
120
104
121
-
val msg : Context.t -> Meta.t -> string -> t
122
-
(** [msg ctx meta s] constructs an error from a plain string. *)
123
-
124
-
val raise : Context.t -> Meta.t -> kind -> 'a
125
-
(** [raise ctx meta k] raises an error with a typed kind. *)
105
+
val raise : ctx:Context.t -> meta:Meta.t -> kind -> 'a
106
+
(** [raise ~ctx ~meta k] raises an error with a typed kind. *)
126
107
127
108
val fail : Meta.t -> string -> 'a
128
109
(** [fail meta s] raises an error with empty context and message [s]. *)
···
1482
1463
1483
1464
(** {2:index_queries Indices} *)
1484
1465
1485
-
val index : ?absent:'a -> Path.index -> 'a t -> 'a t
1466
+
val index : ?absent:'a -> Path.step -> 'a t -> 'a t
1486
1467
(** [index] uses {!val-nth} or {!val-mem} on the given index. *)
1487
1468
1488
-
val set_index : ?allow_absent:bool -> 'a t -> Path.index -> 'a -> value t
1469
+
val set_index : ?allow_absent:bool -> 'a t -> Path.step -> 'a -> value t
1489
1470
(** [set_index] uses {!set_nth} or {!set_mem} on the given index. *)
1490
1471
1491
-
val update_index : ?stub:value -> ?absent:'a -> Path.index -> 'a t -> value t
1472
+
val update_index : ?stub:value -> ?absent:'a -> Path.step -> 'a t -> value t
1492
1473
(** [update_index] uses {!update_nth} or {!update_mem}. *)
1493
1474
1494
-
val delete_index : ?allow_absent:bool -> Path.index -> value t
1475
+
val delete_index : ?allow_absent:bool -> Path.step -> value t
1495
1476
(** [delete_index] uses {!delete_nth} or {!delete_mem}. *)
1496
1477
1497
1478
(** {2:path_queries Paths} *)