RFC6901 JSON Pointer implementation in OCaml using jsont
anil.recoil.org
1(* Toplevel printers for Json_pointer.t, Jsont.json, and Jsont.Error.t
2
3 Usage in toplevel:
4 #require "json-pointer.top";;
5
6 Printers are automatically installed when the library is loaded.
7*)
8
9let nav_printer ppf (p : Json_pointer.nav Json_pointer.t) =
10 Json_pointer.pp_verbose ppf p
11
12let append_printer ppf (p : Json_pointer.append Json_pointer.t) =
13 Json_pointer.pp_verbose ppf p
14
15let json_printer ppf (json : Jsont.json) =
16 match Jsont_bytesrw.encode_string Jsont.json json with
17 | Ok s -> Format.pp_print_string ppf s
18 | Error e -> Format.fprintf ppf "<json encoding error: %s>" e
19
20let error_printer ppf (e : Jsont.Error.t) =
21 Format.pp_print_string ppf (Jsont.Error.to_string e)
22
23(* Automatic printer installation *)
24
25let printers =
26 [ "Json_pointer_top.nav_printer";
27 "Json_pointer_top.append_printer";
28 "Json_pointer_top.json_printer";
29 "Json_pointer_top.error_printer" ]
30
31(* Suppress stderr during printer installation to avoid noise in MDX tests *)
32let null_formatter = Format.make_formatter (fun _ _ _ -> ()) (fun () -> ())
33
34let eval_string_quiet str =
35 try
36 let lexbuf = Lexing.from_string str in
37 let phrase = !Toploop.parse_toplevel_phrase lexbuf in
38 Toploop.execute_phrase false null_formatter phrase
39 with _ -> false
40
41let rec do_install_printers = function
42 | [] -> true
43 | printer :: rest ->
44 let cmd = Printf.sprintf "#install_printer %s;;" printer in
45 eval_string_quiet cmd && do_install_printers rest
46
47let install () =
48 (* Silently ignore failures - this handles non-toplevel contexts like MDX *)
49 ignore (do_install_printers printers)
50
51(* Only auto-install when OCAML_TOPLEVEL_NAME is set, indicating a real toplevel *)
52let () =
53 if Sys.getenv_opt "OCAML_TOPLEVEL_NAME" <> None then
54 install ()