jon.recoil.org
RFC6901 JSON Pointer implementation in OCaml using jsont
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(* Token escaping/unescaping per RFC 6901 Section 3-4 *)
7module Token = struct
8 type t = string
9
10 let escape s =
11 let b = Buffer.create (String.length s) in
12 String.iter (function
13 | '~' -> Buffer.add_string b "~0"
14 | '/' -> Buffer.add_string b "~1"
15 | c -> Buffer.add_char b c
16 ) s;
17 Buffer.contents b
18
19 let unescape s =
20 let len = String.length s in
21 let b = Buffer.create len in
22 let rec loop i =
23 if i >= len then Buffer.contents b
24 else match s.[i] with
25 | '~' when i + 1 >= len ->
26 Jsont.Error.msgf Jsont.Meta.none
27 "Invalid JSON Pointer: incomplete escape sequence at end"
28 | '~' ->
29 (match s.[i + 1] with
30 | '0' -> Buffer.add_char b '~'; loop (i + 2)
31 | '1' -> Buffer.add_char b '/'; loop (i + 2)
32 | c ->
33 Jsont.Error.msgf Jsont.Meta.none
34 "Invalid JSON Pointer: invalid escape sequence ~%c" c)
35 | c -> Buffer.add_char b c; loop (i + 1)
36 in
37 loop 0
38
39 (* Check if a token is a valid array index per RFC 6901 ABNF:
40 array-index = %x30 / ( %x31-39 *(%x30-39) )
41 i.e., "0" or a non-zero digit followed by any digits *)
42 let is_valid_array_index s =
43 let len = String.length s in
44 let is_digit c = c >= '0' && c <= '9' in
45 if len = 0 then None
46 else if len = 1 && s.[0] = '0' then Some 0
47 else if s.[0] >= '1' && s.[0] <= '9' then
48 let rec all_digits i =
49 if i >= len then true
50 else if is_digit s.[i] then all_digits (i + 1)
51 else false
52 in
53 if all_digits 1 then int_of_string_opt s else None
54 else None
55end
56
57(* Index type - represents how a token is interpreted in context *)
58module Index = struct
59 type t = [ `Mem of string | `Nth of int | `End ]
60
61 let pp ppf = function
62 | `Mem s -> Format.fprintf ppf "/%s" (Token.escape s)
63 | `Nth n -> Format.fprintf ppf "/%d" n
64 | `End -> Format.fprintf ppf "/-"
65
66 let equal i1 i2 = match i1, i2 with
67 | `Mem s1, `Mem s2 -> String.equal s1 s2
68 | `Nth n1, `Nth n2 -> Int.equal n1 n2
69 | `End, `End -> true
70 | _ -> false
71
72 let compare i1 i2 = match i1, i2 with
73 | `Mem s1, `Mem s2 -> String.compare s1 s2
74 | `Mem _, _ -> -1
75 | _, `Mem _ -> 1
76 | `Nth n1, `Nth n2 -> Int.compare n1 n2
77 | `Nth _, `End -> -1
78 | `End, `Nth _ -> 1
79 | `End, `End -> 0
80
81 let of_path_index (idx : Jsont.Path.index) : t =
82 match idx with
83 | Jsont.Path.Mem (s, _meta) -> `Mem s
84 | Jsont.Path.Nth (n, _meta) -> `Nth n
85
86 let to_path_index (idx : t) : Jsont.Path.index option =
87 match idx with
88 | `Mem s -> Some (Jsont.Path.Mem (s, Jsont.Meta.none))
89 | `Nth n -> Some (Jsont.Path.Nth (n, Jsont.Meta.none))
90 | `End -> None
91end
92
93(* Internal representation: raw unescaped tokens.
94 Per RFC 6901, interpretation as member name vs array index
95 depends on the JSON value type at evaluation time. *)
96module Segment = struct
97 type t =
98 | Token of string (* Unescaped reference token *)
99 | End (* The "-" token for end-of-array *)
100
101 let of_escaped_string s =
102 if s = "-" then End
103 else Token (Token.unescape s)
104
105 let to_escaped_string = function
106 | Token s -> Token.escape s
107 | End -> "-"
108
109 (* Convert to Index for a given JSON value type *)
110 let to_index seg ~for_array =
111 match seg with
112 | End -> `End
113 | Token s ->
114 if for_array then
115 match Token.is_valid_array_index s with
116 | Some n -> `Nth n
117 | None -> `Mem s (* Invalid index becomes member for error msg *)
118 else
119 `Mem s
120
121 (* Convert from Index *)
122 let of_index = function
123 | `End -> End
124 | `Mem s -> Token s
125 | `Nth n -> Token (string_of_int n)
126end
127
128(* Pointer type - list of segments *)
129type t = Segment.t list
130
131let root = []
132
133let is_root p = p = []
134
135(* Convert indices to segments *)
136let make indices = List.map Segment.of_index indices
137
138(* Convert segments to indices, assuming array context for numeric tokens *)
139let indices p = List.map (fun seg -> Segment.to_index seg ~for_array:true) p
140
141let append p idx = p @ [Segment.of_index idx]
142
143let concat p1 p2 = p1 @ p2
144
145let parent p = match List.rev p with
146 | [] -> None
147 | _ :: rest -> Some (List.rev rest)
148
149let last p = match List.rev p with
150 | [] -> None
151 | seg :: _ -> Some (Segment.to_index seg ~for_array:true)
152
153(* Parsing *)
154
155let of_string s =
156 if s = "" then root
157 else if s.[0] <> '/' then
158 Jsont.Error.msgf Jsont.Meta.none
159 "Invalid JSON Pointer: must be empty or start with '/': %s" s
160 else
161 let rest = String.sub s 1 (String.length s - 1) in
162 let tokens = String.split_on_char '/' rest in
163 List.map Segment.of_escaped_string tokens
164
165let of_string_result s =
166 try Ok (of_string s)
167 with Jsont.Error e -> Error (Jsont.Error.to_string e)
168
169(* URI fragment percent-decoding *)
170let hex_value c =
171 if c >= '0' && c <= '9' then Char.code c - Char.code '0'
172 else if c >= 'A' && c <= 'F' then Char.code c - Char.code 'A' + 10
173 else if c >= 'a' && c <= 'f' then Char.code c - Char.code 'a' + 10
174 else -1
175
176let percent_decode s =
177 let len = String.length s in
178 let b = Buffer.create len in
179 let rec loop i =
180 if i >= len then Buffer.contents b
181 else match s.[i] with
182 | '%' when i + 2 < len ->
183 let h1 = hex_value s.[i + 1] in
184 let h2 = hex_value s.[i + 2] in
185 if h1 >= 0 && h2 >= 0 then begin
186 Buffer.add_char b (Char.chr ((h1 lsl 4) lor h2));
187 loop (i + 3)
188 end else
189 Jsont.Error.msgf Jsont.Meta.none
190 "Invalid percent-encoding at position %d" i
191 | '%' ->
192 Jsont.Error.msgf Jsont.Meta.none
193 "Incomplete percent-encoding at position %d" i
194 | c -> Buffer.add_char b c; loop (i + 1)
195 in
196 loop 0
197
198let of_uri_fragment s =
199 of_string (percent_decode s)
200
201let of_uri_fragment_result s =
202 try Ok (of_uri_fragment s)
203 with Jsont.Error e -> Error (Jsont.Error.to_string e)
204
205(* Serialization *)
206
207let to_string p =
208 if p = [] then ""
209 else
210 let b = Buffer.create 64 in
211 List.iter (fun seg ->
212 Buffer.add_char b '/';
213 Buffer.add_string b (Segment.to_escaped_string seg)
214 ) p;
215 Buffer.contents b
216
217(* URI fragment percent-encoding *)
218let needs_percent_encoding c =
219 (* RFC 3986 fragment: unreserved / pct-encoded / sub-delims / ":" / "@" / "/" / "?" *)
220 (* unreserved = ALPHA / DIGIT / "-" / "." / "_" / "~" *)
221 (* sub-delims = "!" / "$" / "&" / "'" / "(" / ")" / "*" / "+" / "," / ";" / "=" *)
222 not (
223 (c >= 'A' && c <= 'Z') ||
224 (c >= 'a' && c <= 'z') ||
225 (c >= '0' && c <= '9') ||
226 c = '-' || c = '.' || c = '_' || c = '~' ||
227 c = '!' || c = '$' || c = '&' || c = '\'' ||
228 c = '(' || c = ')' || c = '*' || c = '+' ||
229 c = ',' || c = ';' || c = '=' ||
230 c = ':' || c = '@' || c = '/' || c = '?'
231 )
232
233let hex_char n =
234 if n < 10 then Char.chr (Char.code '0' + n)
235 else Char.chr (Char.code 'A' + n - 10)
236
237let percent_encode s =
238 let b = Buffer.create (String.length s * 3) in
239 String.iter (fun c ->
240 if needs_percent_encoding c then begin
241 let code = Char.code c in
242 Buffer.add_char b '%';
243 Buffer.add_char b (hex_char (code lsr 4));
244 Buffer.add_char b (hex_char (code land 0xF))
245 end else
246 Buffer.add_char b c
247 ) s;
248 Buffer.contents b
249
250let to_uri_fragment p =
251 percent_encode (to_string p)
252
253let pp ppf p =
254 Format.pp_print_string ppf (to_string p)
255
256let pp_verbose ppf p =
257 let pp_index ppf = function
258 | `Mem s -> Format.fprintf ppf "`Mem %S" s
259 | `Nth n -> Format.fprintf ppf "`Nth %d" n
260 | `End -> Format.fprintf ppf "`End"
261 in
262 Format.fprintf ppf "[%a]"
263 (Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf "; ") pp_index)
264 (indices p)
265
266(* Comparison *)
267
268let segment_equal s1 s2 = match s1, s2 with
269 | Segment.Token t1, Segment.Token t2 -> String.equal t1 t2
270 | Segment.End, Segment.End -> true
271 | _ -> false
272
273let segment_compare s1 s2 = match s1, s2 with
274 | Segment.Token t1, Segment.Token t2 -> String.compare t1 t2
275 | Segment.Token _, Segment.End -> -1
276 | Segment.End, Segment.Token _ -> 1
277 | Segment.End, Segment.End -> 0
278
279let equal p1 p2 =
280 List.equal segment_equal p1 p2
281
282let compare p1 p2 =
283 List.compare segment_compare p1 p2
284
285(* Path conversion *)
286
287let segment_of_path_index (idx : Jsont.Path.index) : Segment.t =
288 match idx with
289 | Jsont.Path.Mem (s, _meta) -> Segment.Token s
290 | Jsont.Path.Nth (n, _meta) -> Segment.Token (string_of_int n)
291
292let of_path (p : Jsont.Path.t) : t =
293 List.rev_map segment_of_path_index (Jsont.Path.rev_indices p)
294
295let to_path p =
296 let rec convert acc = function
297 | [] -> Some acc
298 | Segment.End :: _ -> None
299 | Segment.Token s :: rest ->
300 (* For path conversion, we need to decide if it's a member or index.
301 We use array context for numeric tokens since Jsont.Path distinguishes. *)
302 let acc' = match Token.is_valid_array_index s with
303 | Some n -> Jsont.Path.nth ~meta:Jsont.Meta.none n acc
304 | None -> Jsont.Path.mem ~meta:Jsont.Meta.none s acc
305 in
306 convert acc' rest
307 in
308 convert Jsont.Path.root p
309
310let to_path_exn p =
311 match to_path p with
312 | Some path -> path
313 | None ->
314 Jsont.Error.msgf Jsont.Meta.none
315 "Cannot convert JSON Pointer with '-' index to Jsont.Path"
316
317(* Evaluation helpers *)
318
319let json_sort_string (j : Jsont.json) =
320 match j with
321 | Null _ -> "null"
322 | Bool _ -> "boolean"
323 | Number _ -> "number"
324 | String _ -> "string"
325 | Array _ -> "array"
326 | Object _ -> "object"
327
328let get_member name (obj : Jsont.object') =
329 List.find_opt (fun ((n, _), _) -> String.equal n name) obj
330
331let get_nth n (arr : Jsont.json list) =
332 if n < 0 || n >= List.length arr then None
333 else Some (List.nth arr n)
334
335(* Evaluation *)
336
337let rec eval_get p json =
338 match p with
339 | [] -> json
340 | Segment.End :: _ ->
341 Jsont.Error.msgf (Jsont.Json.meta json)
342 "JSON Pointer: '-' (end marker) refers to nonexistent array element"
343 | Segment.Token token :: rest ->
344 (match json with
345 | Jsont.Object (members, _) ->
346 (* For objects, token is always a member name *)
347 (match get_member token members with
348 | Some (_, value) -> eval_get rest value
349 | None ->
350 Jsont.Error.msgf (Jsont.Json.meta json)
351 "JSON Pointer: member '%s' not found" token)
352 | Jsont.Array (elements, _) ->
353 (* For arrays, token must be a valid array index *)
354 (match Token.is_valid_array_index token with
355 | Some n ->
356 (match get_nth n elements with
357 | Some value -> eval_get rest value
358 | None ->
359 Jsont.Error.msgf (Jsont.Json.meta json)
360 "JSON Pointer: index %d out of bounds (array has %d elements)"
361 n (List.length elements))
362 | None ->
363 Jsont.Error.msgf (Jsont.Json.meta json)
364 "JSON Pointer: invalid array index '%s'" token)
365 | _ ->
366 Jsont.Error.msgf (Jsont.Json.meta json)
367 "JSON Pointer: cannot index into %s with '%s'"
368 (json_sort_string json) token)
369
370let get p json = eval_get p json
371
372let get_result p json =
373 try Ok (get p json)
374 with Jsont.Error e -> Error e
375
376let find p json =
377 try Some (get p json)
378 with Jsont.Error _ -> None
379
380(* Mutation helpers *)
381
382let set_member name value (obj : Jsont.object') : Jsont.object' =
383 let rec loop found acc = function
384 | [] ->
385 if found then List.rev acc
386 else List.rev_append acc [((name, Jsont.Meta.none), value)]
387 | ((n, m), _) :: rest when String.equal n name ->
388 loop true (((n, m), value) :: acc) rest
389 | mem :: rest ->
390 loop found (mem :: acc) rest
391 in
392 loop false [] obj
393
394let remove_member name (obj : Jsont.object') : Jsont.object' =
395 List.filter (fun ((n, _), _) -> not (String.equal n name)) obj
396
397let insert_at n value lst =
398 let rec loop i acc = function
399 | rest when i = n -> List.rev_append acc (value :: rest)
400 | [] -> List.rev acc
401 | h :: t -> loop (i + 1) (h :: acc) t
402 in
403 loop 0 [] lst
404
405let remove_at n lst =
406 List.filteri (fun i _ -> i <> n) lst
407
408let replace_at n value lst =
409 List.mapi (fun i v -> if i = n then value else v) lst
410
411(* Common navigation for mutation operations *)
412
413let navigate_to_child token json ~on_object ~on_array ~on_other =
414 match json with
415 | Jsont.Object (members, meta) -> on_object members meta
416 | Jsont.Array (elements, meta) ->
417 (match Token.is_valid_array_index token with
418 | Some n -> on_array elements meta n
419 | None ->
420 Jsont.Error.msgf (Jsont.Json.meta json)
421 "JSON Pointer: invalid array index '%s'" token)
422 | _ -> on_other ()
423
424let error_member_not_found json token =
425 Jsont.Error.msgf (Jsont.Json.meta json) "JSON Pointer: member '%s' not found" token
426
427let error_index_out_of_bounds json n =
428 Jsont.Error.msgf (Jsont.Json.meta json) "JSON Pointer: index %d out of bounds" n
429
430let error_cannot_navigate json =
431 Jsont.Error.msgf (Jsont.Json.meta json)
432 "JSON Pointer: cannot navigate through %s" (json_sort_string json)
433
434(* Mutation: set *)
435
436let rec eval_set p value json =
437 match p with
438 | [] -> value
439 | [Segment.End] ->
440 (match json with
441 | Jsont.Array (elements, meta) -> Jsont.Array (elements @ [value], meta)
442 | _ ->
443 Jsont.Error.msgf (Jsont.Json.meta json)
444 "JSON Pointer: '-' can only be used on arrays, got %s"
445 (json_sort_string json))
446 | Segment.End :: _ ->
447 Jsont.Error.msgf (Jsont.Json.meta json)
448 "JSON Pointer: '-' (end marker) refers to nonexistent array element"
449 | [Segment.Token token] ->
450 navigate_to_child token json
451 ~on_object:(fun members meta ->
452 if Option.is_some (get_member token members) then
453 Jsont.Object (set_member token value members, meta)
454 else
455 Jsont.Error.msgf (Jsont.Json.meta json)
456 "JSON Pointer: member '%s' not found for set" token)
457 ~on_array:(fun elements meta n ->
458 if n < List.length elements then
459 Jsont.Array (replace_at n value elements, meta)
460 else
461 Jsont.Error.msgf (Jsont.Json.meta json)
462 "JSON Pointer: index %d out of bounds for set" n)
463 ~on_other:(fun () ->
464 Jsont.Error.msgf (Jsont.Json.meta json)
465 "JSON Pointer: cannot set in %s" (json_sort_string json))
466 | Segment.Token token :: rest ->
467 navigate_to_child token json
468 ~on_object:(fun members meta ->
469 match get_member token members with
470 | Some (_, child) ->
471 Jsont.Object (set_member token (eval_set rest value child) members, meta)
472 | None -> error_member_not_found json token)
473 ~on_array:(fun elements meta n ->
474 match get_nth n elements with
475 | Some child ->
476 Jsont.Array (replace_at n (eval_set rest value child) elements, meta)
477 | None -> error_index_out_of_bounds json n)
478 ~on_other:(fun () -> error_cannot_navigate json)
479
480let set p json ~value = eval_set p value json
481
482(* Mutation: add (RFC 6902 semantics) *)
483
484let rec eval_add p value json =
485 match p with
486 | [] -> value
487 | [Segment.End] ->
488 (match json with
489 | Jsont.Array (elements, meta) -> Jsont.Array (elements @ [value], meta)
490 | _ ->
491 Jsont.Error.msgf (Jsont.Json.meta json)
492 "JSON Pointer: '-' can only be used on arrays, got %s"
493 (json_sort_string json))
494 | Segment.End :: _ ->
495 Jsont.Error.msgf (Jsont.Json.meta json)
496 "JSON Pointer: '-' in non-final position"
497 | [Segment.Token token] ->
498 navigate_to_child token json
499 ~on_object:(fun members meta ->
500 Jsont.Object (set_member token value members, meta))
501 ~on_array:(fun elements meta n ->
502 let len = List.length elements in
503 if n <= len then
504 Jsont.Array (insert_at n value elements, meta)
505 else
506 Jsont.Error.msgf (Jsont.Json.meta json)
507 "JSON Pointer: index %d out of bounds for add (array has %d elements)"
508 n len)
509 ~on_other:(fun () ->
510 Jsont.Error.msgf (Jsont.Json.meta json)
511 "JSON Pointer: cannot add to %s" (json_sort_string json))
512 | Segment.Token token :: rest ->
513 navigate_to_child token json
514 ~on_object:(fun members meta ->
515 match get_member token members with
516 | Some (_, child) ->
517 Jsont.Object (set_member token (eval_add rest value child) members, meta)
518 | None -> error_member_not_found json token)
519 ~on_array:(fun elements meta n ->
520 match get_nth n elements with
521 | Some child ->
522 Jsont.Array (replace_at n (eval_add rest value child) elements, meta)
523 | None -> error_index_out_of_bounds json n)
524 ~on_other:(fun () -> error_cannot_navigate json)
525
526let add p json ~value = eval_add p value json
527
528(* Mutation: remove *)
529
530let rec eval_remove p json =
531 match p with
532 | [] ->
533 Jsont.Error.msgf Jsont.Meta.none "JSON Pointer: cannot remove root document"
534 | [Segment.End] ->
535 Jsont.Error.msgf (Jsont.Json.meta json)
536 "JSON Pointer: '-' refers to nonexistent element"
537 | Segment.End :: _ ->
538 Jsont.Error.msgf (Jsont.Json.meta json)
539 "JSON Pointer: '-' in non-final position"
540 | [Segment.Token token] ->
541 navigate_to_child token json
542 ~on_object:(fun members meta ->
543 if Option.is_some (get_member token members) then
544 Jsont.Object (remove_member token members, meta)
545 else
546 Jsont.Error.msgf (Jsont.Json.meta json)
547 "JSON Pointer: member '%s' not found for remove" token)
548 ~on_array:(fun elements meta n ->
549 if n < List.length elements then
550 Jsont.Array (remove_at n elements, meta)
551 else
552 Jsont.Error.msgf (Jsont.Json.meta json)
553 "JSON Pointer: index %d out of bounds for remove" n)
554 ~on_other:(fun () ->
555 Jsont.Error.msgf (Jsont.Json.meta json)
556 "JSON Pointer: cannot remove from %s" (json_sort_string json))
557 | Segment.Token token :: rest ->
558 navigate_to_child token json
559 ~on_object:(fun members meta ->
560 match get_member token members with
561 | Some (_, child) ->
562 Jsont.Object (set_member token (eval_remove rest child) members, meta)
563 | None -> error_member_not_found json token)
564 ~on_array:(fun elements meta n ->
565 match get_nth n elements with
566 | Some child ->
567 Jsont.Array (replace_at n (eval_remove rest child) elements, meta)
568 | None -> error_index_out_of_bounds json n)
569 ~on_other:(fun () -> error_cannot_navigate json)
570
571let remove p json = eval_remove p json
572
573(* Mutation: replace *)
574
575let replace p json ~value =
576 (* Replace requires the target to exist, unlike add *)
577 let _ = get p json in (* Will raise if not found *)
578 eval_set p value json
579
580(* Mutation: move *)
581
582let rec is_prefix_of p1 p2 =
583 match p1, p2 with
584 | [], _ -> true
585 | _, [] -> false
586 | h1 :: t1, h2 :: t2 -> segment_equal h1 h2 && is_prefix_of t1 t2
587
588let move ~from ~path json =
589 (* Check for cycle: path cannot be a proper prefix of from *)
590 if is_prefix_of path from && not (equal path from) then
591 Jsont.Error.msgf Jsont.Meta.none
592 "JSON Pointer: move would create cycle (path is prefix of from)";
593 let value = get from json in
594 let json' = remove from json in
595 add path json' ~value
596
597(* Mutation: copy *)
598
599let copy ~from ~path json =
600 let value = get from json in
601 add path json ~value
602
603(* Mutation: test *)
604
605let test p json ~expected =
606 Option.fold ~none:false ~some:(Jsont.Json.equal expected) (find p json)
607
608(* Jsont codec *)
609
610let jsont : t Jsont.t =
611 let dec _meta s = of_string s in
612 let enc p = to_string p in
613 Jsont.Base.string (Jsont.Base.map
614 ~kind:"JSON Pointer"
615 ~doc:"RFC 6901 JSON Pointer"
616 ~dec ~enc ())
617
618let jsont_uri_fragment : t Jsont.t =
619 let dec _meta s = of_uri_fragment s in
620 let enc p = to_uri_fragment p in
621 Jsont.Base.string (Jsont.Base.map
622 ~kind:"JSON Pointer (URI fragment)"
623 ~doc:"RFC 6901 JSON Pointer in URI fragment encoding"
624 ~dec ~enc ())
625
626(* Query combinators *)
627
628let path ?absent p t =
629 let dec json =
630 match find p json with
631 | Some value ->
632 (match Jsont.Json.decode' t value with
633 | Ok v -> v
634 | Error e -> raise (Jsont.Error e))
635 | None ->
636 match absent with
637 | Some v -> v
638 | None ->
639 Jsont.Error.msgf Jsont.Meta.none
640 "JSON Pointer %s: path not found" (to_string p)
641 in
642 Jsont.map Jsont.json ~dec ~enc:(fun _ ->
643 Jsont.Error.msgf Jsont.Meta.none "path: encode not supported")
644
645let set_path ?(allow_absent = false) t p v =
646 let encoded = match Jsont.Json.encode' t v with
647 | Ok json -> json
648 | Error e -> raise (Jsont.Error e)
649 in
650 let dec json =
651 if allow_absent then
652 add p json ~value:encoded
653 else
654 set p json ~value:encoded
655 in
656 Jsont.map Jsont.json ~dec ~enc:(fun j -> j)
657
658let update_path ?absent p t =
659 let dec json =
660 let value = match find p json with
661 | Some v -> v
662 | None ->
663 match absent with
664 | Some v ->
665 (match Jsont.Json.encode' t v with
666 | Ok j -> j
667 | Error e -> raise (Jsont.Error e))
668 | None ->
669 Jsont.Error.msgf Jsont.Meta.none
670 "JSON Pointer %s: path not found" (to_string p)
671 in
672 let decoded = match Jsont.Json.decode' t value with
673 | Ok v -> v
674 | Error e -> raise (Jsont.Error e)
675 in
676 let re_encoded = match Jsont.Json.encode' t decoded with
677 | Ok j -> j
678 | Error e -> raise (Jsont.Error e)
679 in
680 set p json ~value:re_encoded
681 in
682 Jsont.map Jsont.json ~dec ~enc:(fun j -> j)
683
684let delete_path ?(allow_absent = false) p =
685 let dec json =
686 if allow_absent then
687 match find p json with
688 | Some _ -> remove p json
689 | None -> json
690 else
691 remove p json
692 in
693 Jsont.map Jsont.json ~dec ~enc:(fun j -> j)