jon.recoil.org
forked from
anil.recoil.org/ocaml-jmap
this repo has no description
1(* Toplevel printers for JMAP types
2
3 Usage in toplevel:
4 #require "jmap.top";;
5
6 Printers are automatically installed when the library is loaded.
7*)
8
9(* JSON printers *)
10
11let json_printer ppf (json : Jsont.json) =
12 match Jsont_bytesrw.encode_string Jsont.json json with
13 | Ok s -> Format.pp_print_string ppf s
14 | Error e -> Format.fprintf ppf "<json encoding error: %s>" e
15
16let jsont_error_printer ppf (e : Jsont.Error.t) =
17 Format.pp_print_string ppf (Jsont.Error.to_string e)
18
19(* JSON encoding helpers *)
20
21let encode (type a) (codec : a Jsont.t) (value : a) : Jsont.json =
22 match Jsont.Json.encode codec value with
23 | Ok json -> json
24 | Error e -> invalid_arg e
25
26let encode_string (type a) (codec : a Jsont.t) (value : a) : string =
27 match Jsont_bytesrw.encode_string codec value with
28 | Ok s -> s
29 | Error e -> invalid_arg e
30
31let pp_as_json (type a) (codec : a Jsont.t) ppf (value : a) =
32 json_printer ppf (encode codec value)
33
34(* Automatic printer installation *)
35
36let printers =
37 [ "Jmap.Id.pp";
38 "Jmap.Keyword.pp";
39 "Jmap.Role.pp";
40 "Jmap.Capability.pp";
41 "Jmap.Error.pp";
42 "Jmap_top.json_printer";
43 "Jmap_top.jsont_error_printer" ]
44
45(* Suppress stderr during printer installation to avoid noise in MDX tests *)
46let null_formatter = Format.make_formatter (fun _ _ _ -> ()) (fun () -> ())
47
48let eval_string_quiet str =
49 try
50 let lexbuf = Lexing.from_string str in
51 let phrase = !Toploop.parse_toplevel_phrase lexbuf in
52 Toploop.execute_phrase false null_formatter phrase
53 with _ -> false
54
55let rec do_install_printers = function
56 | [] -> true
57 | printer :: rest ->
58 let cmd = Printf.sprintf "#install_printer %s;;" printer in
59 eval_string_quiet cmd && do_install_printers rest
60
61let install () =
62 (* Silently ignore failures - this handles non-toplevel contexts like MDX *)
63 ignore (do_install_printers printers)
64
65(* Only auto-install when OCAML_TOPLEVEL_NAME is set, indicating a real toplevel *)
66let () =
67 if Sys.getenv_opt "OCAML_TOPLEVEL_NAME" <> None then
68 install ()