RFC6901 JSON Pointer implementation in OCaml using jsont
anil.recoil.org
1(* Test runner for json_pointer *)
2
3let read_file path =
4 let ic = open_in path in
5 let n = in_channel_length ic in
6 let s = really_input_string ic n in
7 close_in ic;
8 s
9
10let parse_json s =
11 match Jsont_bytesrw.decode_string Jsont.json s with
12 | Ok json -> json
13 | Error e -> failwith e
14
15let json_to_string json =
16 match Jsont_bytesrw.encode_string Jsont.json json with
17 | Ok s -> s
18 | Error e -> failwith e
19
20(* Helper to get indices from any pointer *)
21let indices_of_any (Json_pointer.Any p) = Json_pointer.indices p
22
23(* Helper to convert to string from any pointer *)
24let to_string_of_any (Json_pointer.Any p) = Json_pointer.to_string p
25
26(* Helper to check if pointer is append *)
27let is_append_any p = not (Json_pointer.is_nav p)
28
29(* Test: parse pointer and print indices *)
30let test_parse pointer_str =
31 try
32 let result = Json_pointer.of_string pointer_str in
33 let indices = indices_of_any result in
34 let index_strs = List.map (fun idx ->
35 match idx with
36 | Jsont.Path.Mem (s, _) -> Printf.sprintf "Mem:%s" s
37 | Jsont.Path.Nth (n, _) -> Printf.sprintf "Nth:%d" n
38 ) indices in
39 let suffix = if is_append_any result then ", /-" else "" in
40 Printf.printf "OK: [%s%s]\n" (String.concat ", " index_strs) suffix
41 with Jsont.Error e ->
42 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
43
44(* Test: roundtrip pointer string *)
45let test_roundtrip pointer_str =
46 try
47 let result = Json_pointer.of_string pointer_str in
48 let s = to_string_of_any result in
49 if s = pointer_str then
50 Printf.printf "OK: %s\n" s
51 else
52 Printf.printf "MISMATCH: input=%s output=%s\n" pointer_str s
53 with Jsont.Error e ->
54 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
55
56(* Test: evaluate pointer against JSON *)
57let test_eval json_path pointer_str =
58 try
59 let json = parse_json (read_file json_path) in
60 let p = Json_pointer.of_string_nav pointer_str in
61 let result = Json_pointer.get p json in
62 Printf.printf "OK: %s\n" (json_to_string result)
63 with
64 | Jsont.Error e ->
65 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
66 | Failure e ->
67 Printf.printf "FAIL: %s\n" e
68
69(* Test: escape token *)
70let test_escape token =
71 let escaped = Json_pointer.Token.escape token in
72 Printf.printf "%s\n" escaped
73
74(* Test: unescape token *)
75let test_unescape token =
76 try
77 let unescaped = Json_pointer.Token.unescape token in
78 Printf.printf "OK: %s\n" unescaped
79 with Jsont.Error e ->
80 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
81
82(* Test: URI fragment roundtrip *)
83let test_uri_fragment pointer_str =
84 try
85 let result = Json_pointer.of_string pointer_str in
86 let (Json_pointer.Any p) = result in
87 let frag = Json_pointer.to_uri_fragment p in
88 let result2 = Json_pointer.of_uri_fragment frag in
89 let s2 = to_string_of_any result2 in
90 if s2 = pointer_str then
91 Printf.printf "OK: %s -> %s\n" pointer_str frag
92 else
93 Printf.printf "MISMATCH: %s -> %s -> %s\n" pointer_str frag s2
94 with Jsont.Error e ->
95 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
96
97(* Test: add operation *)
98let test_add json_str pointer_str value_str =
99 try
100 let json = parse_json json_str in
101 let value = parse_json value_str in
102 let p = Json_pointer.of_string pointer_str in
103 let result = Json_pointer.add p json ~value in
104 Printf.printf "%s\n" (json_to_string result)
105 with Jsont.Error e ->
106 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
107
108(* Test: remove operation *)
109let test_remove json_str pointer_str =
110 try
111 let json = parse_json json_str in
112 let p = Json_pointer.of_string_nav pointer_str in
113 let result = Json_pointer.remove p json in
114 Printf.printf "%s\n" (json_to_string result)
115 with Jsont.Error e ->
116 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
117
118(* Test: replace operation *)
119let test_replace json_str pointer_str value_str =
120 try
121 let json = parse_json json_str in
122 let p = Json_pointer.of_string_nav pointer_str in
123 let value = parse_json value_str in
124 let result = Json_pointer.replace p json ~value in
125 Printf.printf "%s\n" (json_to_string result)
126 with Jsont.Error e ->
127 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
128
129(* Test: move operation *)
130let test_move json_str from_str path_str =
131 try
132 let json = parse_json json_str in
133 let from = Json_pointer.of_string_nav from_str in
134 let path = Json_pointer.of_string path_str in
135 let result = Json_pointer.move ~from ~path json in
136 Printf.printf "%s\n" (json_to_string result)
137 with Jsont.Error e ->
138 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
139
140(* Test: copy operation *)
141let test_copy json_str from_str path_str =
142 try
143 let json = parse_json json_str in
144 let from = Json_pointer.of_string_nav from_str in
145 let path = Json_pointer.of_string path_str in
146 let result = Json_pointer.copy ~from ~path json in
147 Printf.printf "%s\n" (json_to_string result)
148 with Jsont.Error e ->
149 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
150
151(* Test: test operation *)
152let test_test json_str pointer_str expected_str =
153 try
154 let json = parse_json json_str in
155 let p = Json_pointer.of_string_nav pointer_str in
156 let expected = parse_json expected_str in
157 let result = Json_pointer.test p json ~expected in
158 Printf.printf "%b\n" result
159 with Jsont.Error e ->
160 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
161
162(* Test: has operation (checks if pointer exists) *)
163let test_has json_str pointer_str =
164 try
165 let json = parse_json json_str in
166 let p = Json_pointer.of_string_nav pointer_str in
167 let result = Json_pointer.find p json in
168 Printf.printf "%b\n" (Option.is_some result)
169 with Jsont.Error e ->
170 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
171
172(* Test: JMAP extended pointer parse *)
173let test_jmap_parse pointer_str =
174 try
175 let p = Json_pointer.Jmap.of_string pointer_str in
176 let s = Json_pointer.Jmap.to_string p in
177 if s = "" then Printf.printf "OK: (root)\n"
178 else Printf.printf "OK: %s\n" s
179 with Jsont.Error e ->
180 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
181
182(* Test: JMAP extended pointer evaluation *)
183let test_jmap_eval json_str pointer_str =
184 try
185 let json = parse_json json_str in
186 let p = Json_pointer.Jmap.of_string pointer_str in
187 let result = Json_pointer.Jmap.eval p json in
188 Printf.printf "OK: %s\n" (json_to_string result)
189 with
190 | Jsont.Error e ->
191 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
192 | Failure e ->
193 Printf.printf "FAIL: %s\n" e
194
195(* Test: JMAP extended pointer evaluation from file *)
196let test_jmap_eval_file json_path pointer_str =
197 try
198 let json = parse_json (read_file json_path) in
199 let p = Json_pointer.Jmap.of_string pointer_str in
200 let result = Json_pointer.Jmap.eval p json in
201 Printf.printf "OK: %s\n" (json_to_string result)
202 with
203 | Jsont.Error e ->
204 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
205 | Failure e ->
206 Printf.printf "FAIL: %s\n" e
207
208(* Test: JMAP path combinator - extract strings *)
209let test_jmap_path_strings json_str pointer_str =
210 try
211 let json = parse_json json_str in
212 let p = Json_pointer.Jmap.of_string pointer_str in
213 let codec = Json_pointer.Jmap.path_list p Jsont.string in
214 let result = match Jsont.Json.decode' codec json with
215 | Ok v -> v
216 | Error e -> raise (Jsont.Error e)
217 in
218 Printf.printf "OK: [%s]\n" (String.concat ", " result)
219 with
220 | Jsont.Error e ->
221 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
222 | Failure e ->
223 Printf.printf "FAIL: %s\n" e
224
225(* Test: JMAP path combinator - extract ints *)
226let test_jmap_path_ints json_str pointer_str =
227 try
228 let json = parse_json json_str in
229 let p = Json_pointer.Jmap.of_string pointer_str in
230 let codec = Json_pointer.Jmap.path_list p Jsont.int in
231 let result = match Jsont.Json.decode' codec json with
232 | Ok v -> v
233 | Error e -> raise (Jsont.Error e)
234 in
235 Printf.printf "OK: [%s]\n" (String.concat ", " (List.map string_of_int result))
236 with
237 | Jsont.Error e ->
238 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
239 | Failure e ->
240 Printf.printf "FAIL: %s\n" e
241
242(* Test: JMAP path combinator - extract single value *)
243let test_jmap_path_single json_str pointer_str =
244 try
245 let json = parse_json json_str in
246 let p = Json_pointer.Jmap.of_string pointer_str in
247 let codec = Json_pointer.Jmap.path p Jsont.string in
248 let result = match Jsont.Json.decode' codec json with
249 | Ok v -> v
250 | Error e -> raise (Jsont.Error e)
251 in
252 Printf.printf "OK: %s\n" result
253 with
254 | Jsont.Error e ->
255 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
256 | Failure e ->
257 Printf.printf "FAIL: %s\n" e
258
259(* Test: JMAP path combinator with absent *)
260let test_jmap_path_absent json_str pointer_str default =
261 try
262 let json = parse_json json_str in
263 let p = Json_pointer.Jmap.of_string pointer_str in
264 let codec = Json_pointer.Jmap.path ~absent:default p Jsont.string in
265 let result = match Jsont.Json.decode' codec json with
266 | Ok v -> v
267 | Error e -> raise (Jsont.Error e)
268 in
269 Printf.printf "OK: %s\n" result
270 with
271 | Jsont.Error e ->
272 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
273 | Failure e ->
274 Printf.printf "FAIL: %s\n" e
275
276(* Test: index functions - mem, nth, pp_index, equal_index, compare_index *)
277let test_mem name =
278 let idx = Json_pointer.mem name in
279 Format.printf "mem(%s) = %a\n" name Json_pointer.pp_index idx
280
281let test_nth n =
282 let idx = Json_pointer.nth n in
283 Format.printf "nth(%d) = %a\n" n Json_pointer.pp_index idx
284
285let test_equal_index idx1_str idx2_str =
286 let parse_idx s =
287 if String.length s > 0 && s.[0] >= '0' && s.[0] <= '9' then
288 Json_pointer.nth (int_of_string s)
289 else
290 Json_pointer.mem s
291 in
292 let idx1 = parse_idx idx1_str in
293 let idx2 = parse_idx idx2_str in
294 Printf.printf "%b\n" (Json_pointer.equal_index idx1 idx2)
295
296let test_compare_index idx1_str idx2_str =
297 let parse_idx s =
298 if String.length s > 0 && s.[0] >= '0' && s.[0] <= '9' then
299 Json_pointer.nth (int_of_string s)
300 else
301 Json_pointer.mem s
302 in
303 let idx1 = parse_idx idx1_str in
304 let idx2 = parse_idx idx2_str in
305 let cmp = Json_pointer.compare_index idx1 idx2 in
306 if cmp < 0 then Printf.printf "LT\n"
307 else if cmp > 0 then Printf.printf "GT\n"
308 else Printf.printf "EQ\n"
309
310(* Test: pointer constructors - root, is_root, make *)
311let test_root () =
312 let r = Json_pointer.root in
313 Printf.printf "root = %s\n" (Json_pointer.to_string r);
314 Printf.printf "is_root(root) = %b\n" (Json_pointer.is_root r)
315
316let test_is_root pointer_str =
317 try
318 let p = Json_pointer.of_string pointer_str in
319 let (Json_pointer.Any ptr) = p in
320 Printf.printf "%b\n" (Json_pointer.is_root ptr)
321 with Jsont.Error e ->
322 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
323
324let test_make indices_str =
325 (* Parse comma-separated indices like "foo,0,bar" *)
326 let parts = String.split_on_char ',' indices_str in
327 let indices = List.map (fun s ->
328 let s = String.trim s in
329 if s = "" then Json_pointer.mem ""
330 else if String.length s > 0 && s.[0] >= '0' && s.[0] <= '9' then
331 Json_pointer.nth (int_of_string s)
332 else
333 Json_pointer.mem s
334 ) parts in
335 let p = Json_pointer.make indices in
336 Printf.printf "%s\n" (Json_pointer.to_string p)
337
338(* Test: append_index and / operator *)
339let test_append_index base_str index_str =
340 try
341 let base = Json_pointer.of_string_nav base_str in
342 let idx =
343 if String.length index_str > 0 && index_str.[0] >= '0' && index_str.[0] <= '9' then
344 Json_pointer.nth (int_of_string index_str)
345 else
346 Json_pointer.mem index_str
347 in
348 let result = Json_pointer.(base / idx) in
349 Printf.printf "%s\n" (Json_pointer.to_string result)
350 with Jsont.Error e ->
351 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
352
353(* Test: at_end *)
354let test_at_end pointer_str =
355 try
356 let p = Json_pointer.of_string_nav pointer_str in
357 let append_p = Json_pointer.at_end p in
358 Printf.printf "%s\n" (Json_pointer.to_string append_p)
359 with Jsont.Error e ->
360 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
361
362(* Test: concat *)
363let test_concat p1_str p2_str =
364 try
365 let p1 = Json_pointer.of_string_nav p1_str in
366 let p2 = Json_pointer.of_string_nav p2_str in
367 let result = Json_pointer.concat p1 p2 in
368 Printf.printf "%s\n" (Json_pointer.to_string result)
369 with Jsont.Error e ->
370 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
371
372(* Test: parent *)
373let test_parent pointer_str =
374 try
375 let p = Json_pointer.of_string_nav pointer_str in
376 match Json_pointer.parent p with
377 | Some parent -> Printf.printf "Some(%s)\n" (Json_pointer.to_string parent)
378 | None -> Printf.printf "None\n"
379 with Jsont.Error e ->
380 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
381
382(* Test: last *)
383let test_last pointer_str =
384 try
385 let p = Json_pointer.of_string_nav pointer_str in
386 match Json_pointer.last p with
387 | Some idx -> Format.printf "Some(%a)\n" Json_pointer.pp_index idx
388 | None -> Printf.printf "None\n"
389 with Jsont.Error e ->
390 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
391
392(* Test: indices *)
393let test_indices pointer_str =
394 try
395 let p = Json_pointer.of_string pointer_str in
396 let indices = indices_of_any p in
397 let strs = List.map (fun idx ->
398 match idx with
399 | Jsont.Path.Mem (s, _) -> Printf.sprintf "Mem:%s" s
400 | Jsont.Path.Nth (n, _) -> Printf.sprintf "Nth:%d" n
401 ) indices in
402 Printf.printf "[%s]\n" (String.concat ", " strs)
403 with Jsont.Error e ->
404 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
405
406(* Test: coercion - to_nav, to_nav_exn *)
407let test_to_nav pointer_str =
408 try
409 let p = Json_pointer.of_string pointer_str in
410 match Json_pointer.to_nav p with
411 | Some nav -> Printf.printf "Some(%s)\n" (Json_pointer.to_string nav)
412 | None -> Printf.printf "None\n"
413 with Jsont.Error e ->
414 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
415
416let test_to_nav_exn pointer_str =
417 try
418 let p = Json_pointer.of_string pointer_str in
419 let nav = Json_pointer.to_nav_exn p in
420 Printf.printf "OK: %s\n" (Json_pointer.to_string nav)
421 with Jsont.Error e ->
422 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
423
424(* Test: of_string_kind *)
425let test_of_string_kind pointer_str =
426 try
427 match Json_pointer.of_string_kind pointer_str with
428 | `Nav p -> Printf.printf "Nav(%s)\n" (Json_pointer.to_string p)
429 | `Append p -> Printf.printf "Append(%s)\n" (Json_pointer.to_string p)
430 with Jsont.Error e ->
431 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
432
433(* Test: of_string_result *)
434let test_of_string_result pointer_str =
435 match Json_pointer.of_string_result pointer_str with
436 | Ok p -> Printf.printf "Ok(%s)\n" (to_string_of_any p)
437 | Error e -> Printf.printf "Error(%s)\n" e
438
439(* Test: of_uri_fragment_nav *)
440let test_of_uri_fragment_nav frag =
441 try
442 let p = Json_pointer.of_uri_fragment_nav frag in
443 Printf.printf "OK: %s\n" (Json_pointer.to_string p)
444 with Jsont.Error e ->
445 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
446
447(* Test: of_uri_fragment_result *)
448let test_of_uri_fragment_result frag =
449 match Json_pointer.of_uri_fragment_result frag with
450 | Ok p -> Printf.printf "Ok(%s)\n" (to_string_of_any p)
451 | Error e -> Printf.printf "Error(%s)\n" e
452
453(* Test: pp and pp_verbose *)
454let test_pp pointer_str =
455 try
456 let p = Json_pointer.of_string pointer_str in
457 let (Json_pointer.Any ptr) = p in
458 Format.printf "%a\n" Json_pointer.pp ptr
459 with Jsont.Error e ->
460 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
461
462let test_pp_verbose pointer_str =
463 try
464 let p = Json_pointer.of_string pointer_str in
465 let (Json_pointer.Any ptr) = p in
466 Format.printf "%a\n" Json_pointer.pp_verbose ptr
467 with Jsont.Error e ->
468 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
469
470(* Test: equal *)
471let test_equal p1_str p2_str =
472 try
473 let p1 = Json_pointer.of_string p1_str in
474 let p2 = Json_pointer.of_string p2_str in
475 let (Json_pointer.Any ptr1) = p1 in
476 let (Json_pointer.Any ptr2) = p2 in
477 Printf.printf "%b\n" (Json_pointer.equal ptr1 ptr2)
478 with Jsont.Error e ->
479 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
480
481(* Test: compare *)
482let test_compare p1_str p2_str =
483 try
484 let p1 = Json_pointer.of_string p1_str in
485 let p2 = Json_pointer.of_string p2_str in
486 let (Json_pointer.Any ptr1) = p1 in
487 let (Json_pointer.Any ptr2) = p2 in
488 let cmp = Json_pointer.compare ptr1 ptr2 in
489 if cmp < 0 then Printf.printf "LT\n"
490 else if cmp > 0 then Printf.printf "GT\n"
491 else Printf.printf "EQ\n"
492 with Jsont.Error e ->
493 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
494
495(* Test: of_path and to_path *)
496let test_of_path () =
497 (* Create a Jsont.Path and convert to pointer *)
498 let path = Jsont.Path.(
499 root
500 |> Jsont.Path.nth 0
501 |> Jsont.Path.mem "foo"
502 |> Jsont.Path.nth 1
503 ) in
504 let p = Json_pointer.of_path path in
505 Printf.printf "%s\n" (Json_pointer.to_string p)
506
507let test_to_path pointer_str =
508 try
509 let p = Json_pointer.of_string_nav pointer_str in
510 let path = Json_pointer.to_path p in
511 (* Use rev_indices to get the indices in reverse order *)
512 let indices = Jsont.Path.rev_indices path in
513 let parts = List.rev_map (fun idx ->
514 match idx with
515 | Jsont.Path.Mem (s, _) -> Printf.sprintf "Mem:%s" s
516 | Jsont.Path.Nth (n, _) -> Printf.sprintf "Nth:%d" n
517 ) indices in
518 Printf.printf "[%s]\n" (String.concat ", " parts)
519 with Jsont.Error e ->
520 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
521
522(* Test: get_result *)
523let test_get_result json_str pointer_str =
524 try
525 let json = parse_json json_str in
526 let p = Json_pointer.of_string_nav pointer_str in
527 match Json_pointer.get_result p json with
528 | Ok result -> Printf.printf "Ok(%s)\n" (json_to_string result)
529 | Error e -> Printf.printf "Error(%s)\n" (Jsont.Error.to_string e)
530 with Jsont.Error e ->
531 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
532
533(* Test: set operation *)
534let test_set json_str pointer_str value_str =
535 try
536 let json = parse_json json_str in
537 let value = parse_json value_str in
538 let p = Json_pointer.of_string pointer_str in
539 let result = Json_pointer.set p json ~value in
540 Printf.printf "%s\n" (json_to_string result)
541 with Jsont.Error e ->
542 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
543
544(* Test: jsont codec *)
545let test_jsont_codec pointer_str =
546 try
547 let json = Jsont.Json.string pointer_str in
548 let decoded = match Jsont.Json.decode' Json_pointer.jsont json with
549 | Ok p -> p
550 | Error e -> raise (Jsont.Error e)
551 in
552 let encoded = match Jsont.Json.encode' Json_pointer.jsont decoded with
553 | Ok j -> j
554 | Error e -> raise (Jsont.Error e)
555 in
556 let encoded_str = json_to_string encoded in
557 Printf.printf "%s\n" encoded_str
558 with Jsont.Error e ->
559 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
560
561(* Test: jsont_kind codec *)
562let test_jsont_kind pointer_str =
563 try
564 let json = Jsont.Json.string pointer_str in
565 let decoded = match Jsont.Json.decode' Json_pointer.jsont_kind json with
566 | Ok p -> p
567 | Error e -> raise (Jsont.Error e)
568 in
569 match decoded with
570 | `Nav p -> Printf.printf "Nav(%s)\n" (Json_pointer.to_string p)
571 | `Append p -> Printf.printf "Append(%s)\n" (Json_pointer.to_string p)
572 with Jsont.Error e ->
573 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
574
575(* Test: jsont_nav codec *)
576let test_jsont_nav pointer_str =
577 try
578 let json = Jsont.Json.string pointer_str in
579 let decoded = match Jsont.Json.decode' Json_pointer.jsont_nav json with
580 | Ok p -> p
581 | Error e -> raise (Jsont.Error e)
582 in
583 Printf.printf "OK: %s\n" (Json_pointer.to_string decoded)
584 with Jsont.Error e ->
585 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
586
587(* Test: jsont_uri_fragment codec *)
588let test_jsont_uri_fragment pointer_str =
589 try
590 (* First parse it normally, then encode as URI fragment *)
591 let p = Json_pointer.of_string pointer_str in
592 let encoded = match Jsont.Json.encode' Json_pointer.jsont_uri_fragment p with
593 | Ok j -> j
594 | Error e -> raise (Jsont.Error e)
595 in
596 let encoded_str = json_to_string encoded in
597 Printf.printf "%s\n" encoded_str
598 with Jsont.Error e ->
599 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
600
601(* Test: query combinator - path *)
602let test_query_path json_str pointer_str =
603 try
604 let json = parse_json json_str in
605 let p = Json_pointer.of_string_nav pointer_str in
606 let codec = Json_pointer.path p Jsont.string in
607 let result = match Jsont.Json.decode' codec json with
608 | Ok v -> v
609 | Error e -> raise (Jsont.Error e)
610 in
611 Printf.printf "OK: %s\n" result
612 with Jsont.Error e ->
613 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
614
615(* Test: query combinator - path with absent *)
616let test_query_path_absent json_str pointer_str default =
617 try
618 let json = parse_json json_str in
619 let p = Json_pointer.of_string_nav pointer_str in
620 let codec = Json_pointer.path ~absent:default p Jsont.string in
621 let result = match Jsont.Json.decode' codec json with
622 | Ok v -> v
623 | Error e -> raise (Jsont.Error e)
624 in
625 Printf.printf "OK: %s\n" result
626 with Jsont.Error e ->
627 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
628
629(* Test: query combinator - set_path *)
630let test_set_path json_str pointer_str value_str =
631 try
632 let json = parse_json json_str in
633 let p = Json_pointer.of_string pointer_str in
634 let codec = Json_pointer.set_path Jsont.string p value_str in
635 let result = match Jsont.Json.recode' codec json with
636 | Ok v -> v
637 | Error e -> raise (Jsont.Error e)
638 in
639 Printf.printf "%s\n" (json_to_string result)
640 with Jsont.Error e ->
641 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
642
643(* Test: query combinator - update_path *)
644let test_update_path json_str pointer_str =
645 try
646 let json = parse_json json_str in
647 let p = Json_pointer.of_string_nav pointer_str in
648 let codec = Json_pointer.update_path p Jsont.string in
649 let result = match Jsont.Json.recode' codec json with
650 | Ok v -> v
651 | Error e -> raise (Jsont.Error e)
652 in
653 Printf.printf "%s\n" (json_to_string result)
654 with Jsont.Error e ->
655 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
656
657(* Test: query combinator - delete_path *)
658let test_delete_path json_str pointer_str =
659 try
660 let json = parse_json json_str in
661 let p = Json_pointer.of_string_nav pointer_str in
662 let codec = Json_pointer.delete_path p in
663 let result = match Jsont.Json.recode' codec json with
664 | Ok v -> v
665 | Error e -> raise (Jsont.Error e)
666 in
667 Printf.printf "%s\n" (json_to_string result)
668 with Jsont.Error e ->
669 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
670
671(* Test: query combinator - delete_path with allow_absent *)
672let test_delete_path_absent json_str pointer_str =
673 try
674 let json = parse_json json_str in
675 let p = Json_pointer.of_string_nav pointer_str in
676 let codec = Json_pointer.delete_path ~allow_absent:true p in
677 let result = match Jsont.Json.recode' codec json with
678 | Ok v -> v
679 | Error e -> raise (Jsont.Error e)
680 in
681 Printf.printf "%s\n" (json_to_string result)
682 with Jsont.Error e ->
683 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
684
685(* Test: JMAP of_string_result *)
686let test_jmap_of_string_result pointer_str =
687 match Json_pointer.Jmap.of_string_result pointer_str with
688 | Ok p -> Printf.printf "Ok(%s)\n" (Json_pointer.Jmap.to_string p)
689 | Error e -> Printf.printf "Error(%s)\n" e
690
691(* Test: JMAP pp *)
692let test_jmap_pp pointer_str =
693 try
694 let p = Json_pointer.Jmap.of_string pointer_str in
695 Format.printf "%a\n" Json_pointer.Jmap.pp p
696 with Jsont.Error e ->
697 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
698
699(* Test: JMAP eval_result *)
700let test_jmap_eval_result json_str pointer_str =
701 try
702 let json = parse_json json_str in
703 let p = Json_pointer.Jmap.of_string pointer_str in
704 match Json_pointer.Jmap.eval_result p json with
705 | Ok result -> Printf.printf "Ok(%s)\n" (json_to_string result)
706 | Error e -> Printf.printf "Error(%s)\n" (Jsont.Error.to_string e)
707 with Jsont.Error e ->
708 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
709
710(* Test: JMAP find *)
711let test_jmap_find json_str pointer_str =
712 try
713 let json = parse_json json_str in
714 let p = Json_pointer.Jmap.of_string pointer_str in
715 match Json_pointer.Jmap.find p json with
716 | Some result -> Printf.printf "Some(%s)\n" (json_to_string result)
717 | None -> Printf.printf "None\n"
718 with Jsont.Error e ->
719 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
720
721(* Test: JMAP jsont codec *)
722let test_jmap_jsont pointer_str =
723 try
724 let json = Jsont.Json.string pointer_str in
725 let decoded = match Jsont.Json.decode' Json_pointer.Jmap.jsont json with
726 | Ok p -> p
727 | Error e -> raise (Jsont.Error e)
728 in
729 let encoded = match Jsont.Json.encode' Json_pointer.Jmap.jsont decoded with
730 | Ok j -> j
731 | Error e -> raise (Jsont.Error e)
732 in
733 let encoded_str = json_to_string encoded in
734 Printf.printf "%s\n" encoded_str
735 with Jsont.Error e ->
736 Printf.printf "ERROR: %s\n" (Jsont.Error.to_string e)
737
738let () =
739 match Array.to_list Sys.argv with
740 | _ :: "parse" :: pointer :: _ ->
741 test_parse pointer
742 | _ :: "roundtrip" :: pointer :: _ ->
743 test_roundtrip pointer
744 | _ :: "eval" :: json_path :: pointer :: _ ->
745 test_eval json_path pointer
746 | _ :: "escape" :: token :: _ ->
747 test_escape token
748 | _ :: "unescape" :: token :: _ ->
749 test_unescape token
750 | _ :: "uri-fragment" :: pointer :: _ ->
751 test_uri_fragment pointer
752 | _ :: "add" :: json :: pointer :: value :: _ ->
753 test_add json pointer value
754 | _ :: "remove" :: json :: pointer :: _ ->
755 test_remove json pointer
756 | _ :: "replace" :: json :: pointer :: value :: _ ->
757 test_replace json pointer value
758 | _ :: "move" :: json :: from :: path :: _ ->
759 test_move json from path
760 | _ :: "copy" :: json :: from :: path :: _ ->
761 test_copy json from path
762 | _ :: "test" :: json :: pointer :: expected :: _ ->
763 test_test json pointer expected
764 | _ :: "has" :: json :: pointer :: _ ->
765 test_has json pointer
766 | _ :: "jmap-parse" :: pointer :: _ ->
767 test_jmap_parse pointer
768 | _ :: "jmap-eval" :: json :: pointer :: _ ->
769 test_jmap_eval json pointer
770 | _ :: "jmap-eval-file" :: json_path :: pointer :: _ ->
771 test_jmap_eval_file json_path pointer
772 | _ :: "jmap-path-strings" :: json :: pointer :: _ ->
773 test_jmap_path_strings json pointer
774 | _ :: "jmap-path-ints" :: json :: pointer :: _ ->
775 test_jmap_path_ints json pointer
776 | _ :: "jmap-path-single" :: json :: pointer :: _ ->
777 test_jmap_path_single json pointer
778 | _ :: "jmap-path-absent" :: json :: pointer :: default :: _ ->
779 test_jmap_path_absent json pointer default
780 (* Index functions *)
781 | _ :: "mem" :: name :: _ ->
782 test_mem name
783 | _ :: "nth" :: n :: _ ->
784 test_nth (int_of_string n)
785 | _ :: "equal-index" :: idx1 :: idx2 :: _ ->
786 test_equal_index idx1 idx2
787 | _ :: "compare-index" :: idx1 :: idx2 :: _ ->
788 test_compare_index idx1 idx2
789 (* Pointer constructors *)
790 | _ :: "root" :: _ ->
791 test_root ()
792 | _ :: "is-root" :: pointer :: _ ->
793 test_is_root pointer
794 | _ :: "make" :: indices :: _ ->
795 test_make indices
796 | _ :: "append-index" :: base :: index :: _ ->
797 test_append_index base index
798 | _ :: "at-end" :: pointer :: _ ->
799 test_at_end pointer
800 | _ :: "concat" :: p1 :: p2 :: _ ->
801 test_concat p1 p2
802 | _ :: "parent" :: pointer :: _ ->
803 test_parent pointer
804 | _ :: "last" :: pointer :: _ ->
805 test_last pointer
806 | _ :: "indices" :: pointer :: _ ->
807 test_indices pointer
808 (* Coercion *)
809 | _ :: "to-nav" :: pointer :: _ ->
810 test_to_nav pointer
811 | _ :: "to-nav-exn" :: pointer :: _ ->
812 test_to_nav_exn pointer
813 (* Parsing variants *)
814 | _ :: "of-string-kind" :: pointer :: _ ->
815 test_of_string_kind pointer
816 | _ :: "of-string-result" :: pointer :: _ ->
817 test_of_string_result pointer
818 | _ :: "of-uri-fragment-nav" :: frag :: _ ->
819 test_of_uri_fragment_nav frag
820 | _ :: "of-uri-fragment-result" :: frag :: _ ->
821 test_of_uri_fragment_result frag
822 (* Pretty printing *)
823 | _ :: "pp" :: pointer :: _ ->
824 test_pp pointer
825 | _ :: "pp-verbose" :: pointer :: _ ->
826 test_pp_verbose pointer
827 (* Comparison *)
828 | _ :: "equal" :: p1 :: p2 :: _ ->
829 test_equal p1 p2
830 | _ :: "compare" :: p1 :: p2 :: _ ->
831 test_compare p1 p2
832 (* Path conversion *)
833 | _ :: "of-path" :: _ ->
834 test_of_path ()
835 | _ :: "to-path" :: pointer :: _ ->
836 test_to_path pointer
837 (* Evaluation *)
838 | _ :: "get-result" :: json :: pointer :: _ ->
839 test_get_result json pointer
840 | _ :: "set" :: json :: pointer :: value :: _ ->
841 test_set json pointer value
842 (* Jsont codecs *)
843 | _ :: "jsont-codec" :: pointer :: _ ->
844 test_jsont_codec pointer
845 | _ :: "jsont-kind" :: pointer :: _ ->
846 test_jsont_kind pointer
847 | _ :: "jsont-nav" :: pointer :: _ ->
848 test_jsont_nav pointer
849 | _ :: "jsont-uri-fragment" :: pointer :: _ ->
850 test_jsont_uri_fragment pointer
851 (* Query combinators *)
852 | _ :: "query-path" :: json :: pointer :: _ ->
853 test_query_path json pointer
854 | _ :: "query-path-absent" :: json :: pointer :: default :: _ ->
855 test_query_path_absent json pointer default
856 | _ :: "set-path" :: json :: pointer :: value :: _ ->
857 test_set_path json pointer value
858 | _ :: "update-path" :: json :: pointer :: _ ->
859 test_update_path json pointer
860 | _ :: "delete-path" :: json :: pointer :: _ ->
861 test_delete_path json pointer
862 | _ :: "delete-path-absent" :: json :: pointer :: _ ->
863 test_delete_path_absent json pointer
864 (* JMAP extras *)
865 | _ :: "jmap-of-string-result" :: pointer :: _ ->
866 test_jmap_of_string_result pointer
867 | _ :: "jmap-pp" :: pointer :: _ ->
868 test_jmap_pp pointer
869 | _ :: "jmap-eval-result" :: json :: pointer :: _ ->
870 test_jmap_eval_result json pointer
871 | _ :: "jmap-find" :: json :: pointer :: _ ->
872 test_jmap_find json pointer
873 | _ :: "jmap-jsont" :: pointer :: _ ->
874 test_jmap_jsont pointer
875 | _ ->
876 Printf.printf "Usage:\n";
877 Printf.printf " test_pointer parse <pointer>\n";
878 Printf.printf " test_pointer roundtrip <pointer>\n";
879 Printf.printf " test_pointer eval <json-file> <pointer>\n";
880 Printf.printf " test_pointer escape <token>\n";
881 Printf.printf " test_pointer unescape <token>\n";
882 Printf.printf " test_pointer uri-fragment <pointer>\n";
883 Printf.printf " test_pointer add <json> <pointer> <value>\n";
884 Printf.printf " test_pointer remove <json> <pointer>\n";
885 Printf.printf " test_pointer replace <json> <pointer> <value>\n";
886 Printf.printf " test_pointer move <json> <from> <path>\n";
887 Printf.printf " test_pointer copy <json> <from> <path>\n";
888 Printf.printf " test_pointer test <json> <pointer> <expected>\n";
889 Printf.printf " test_pointer has <json> <pointer>\n";
890 Printf.printf " test_pointer jmap-parse <pointer>\n";
891 Printf.printf " test_pointer jmap-eval <json> <pointer>\n";
892 Printf.printf " test_pointer jmap-eval-file <json-file> <pointer>\n";
893 Printf.printf " -- Index functions --\n";
894 Printf.printf " test_pointer mem <name>\n";
895 Printf.printf " test_pointer nth <n>\n";
896 Printf.printf " test_pointer equal-index <idx1> <idx2>\n";
897 Printf.printf " test_pointer compare-index <idx1> <idx2>\n";
898 Printf.printf " -- Pointer constructors --\n";
899 Printf.printf " test_pointer root\n";
900 Printf.printf " test_pointer is-root <pointer>\n";
901 Printf.printf " test_pointer make <indices>\n";
902 Printf.printf " test_pointer append-index <base> <index>\n";
903 Printf.printf " test_pointer at-end <pointer>\n";
904 Printf.printf " test_pointer concat <p1> <p2>\n";
905 Printf.printf " test_pointer parent <pointer>\n";
906 Printf.printf " test_pointer last <pointer>\n";
907 Printf.printf " test_pointer indices <pointer>\n";
908 Printf.printf " -- Coercion --\n";
909 Printf.printf " test_pointer to-nav <pointer>\n";
910 Printf.printf " test_pointer to-nav-exn <pointer>\n";
911 Printf.printf " -- Parsing variants --\n";
912 Printf.printf " test_pointer of-string-kind <pointer>\n";
913 Printf.printf " test_pointer of-string-result <pointer>\n";
914 Printf.printf " test_pointer of-uri-fragment-nav <frag>\n";
915 Printf.printf " test_pointer of-uri-fragment-result <frag>\n";
916 Printf.printf " -- Pretty printing --\n";
917 Printf.printf " test_pointer pp <pointer>\n";
918 Printf.printf " test_pointer pp-verbose <pointer>\n";
919 Printf.printf " -- Comparison --\n";
920 Printf.printf " test_pointer equal <p1> <p2>\n";
921 Printf.printf " test_pointer compare <p1> <p2>\n";
922 Printf.printf " -- Path conversion --\n";
923 Printf.printf " test_pointer of-path\n";
924 Printf.printf " test_pointer to-path <pointer>\n";
925 Printf.printf " -- Evaluation --\n";
926 Printf.printf " test_pointer get-result <json> <pointer>\n";
927 Printf.printf " test_pointer set <json> <pointer> <value>\n";
928 Printf.printf " -- Jsont codecs --\n";
929 Printf.printf " test_pointer jsont-codec <pointer>\n";
930 Printf.printf " test_pointer jsont-kind <pointer>\n";
931 Printf.printf " test_pointer jsont-nav <pointer>\n";
932 Printf.printf " test_pointer jsont-uri-fragment <pointer>\n";
933 Printf.printf " -- Query combinators --\n";
934 Printf.printf " test_pointer query-path <json> <pointer>\n";
935 Printf.printf " test_pointer query-path-absent <json> <pointer> <default>\n";
936 Printf.printf " test_pointer set-path <json> <pointer> <value>\n";
937 Printf.printf " test_pointer update-path <json> <pointer>\n";
938 Printf.printf " test_pointer delete-path <json> <pointer>\n";
939 Printf.printf " test_pointer delete-path-absent <json> <pointer>\n";
940 Printf.printf " -- JMAP extras --\n";
941 Printf.printf " test_pointer jmap-of-string-result <pointer>\n";
942 Printf.printf " test_pointer jmap-pp <pointer>\n";
943 Printf.printf " test_pointer jmap-eval-result <json> <pointer>\n";
944 Printf.printf " test_pointer jmap-find <json> <pointer>\n";
945 Printf.printf " test_pointer jmap-jsont <pointer>\n";
946 exit 1