#! /usr/bin/env ocamlscript
Ocaml.packs := ["json-wheel"; "easy-format"]
--
(* $Id$ *)
open Json_type
open Easy_format
(* JSON does not allow rendering floats with a trailing dot: that is,
1234. is not allowed, but 1234.0 is ok. here, we add a '0' if
string_of_int result in a trailing dot *)
let jstring_of_float f =
let s = string_of_float f in
let s_len = String.length s in
if s.[ s_len - 1 ] = '.' then
s ^ "0"
else
s
let escape_json_string buf s =
for i = 0 to String.length s - 1 do
let c = String.unsafe_get s i in
match c with
| '"' -> Buffer.add_string buf "\\\""
| '\t' -> Buffer.add_string buf "\\t"
| '\r' -> Buffer.add_string buf "\\r"
| '\b' -> Buffer.add_string buf "\\b"
| '\n' -> Buffer.add_string buf "\\n"
| '\012' -> Buffer.add_string buf "\\f"
| '\\' -> Buffer.add_string buf "\\\\"
(* | '/' -> "\\/" *) (* Forward slash can be escaped
but doesn't have to *)
| '\x00'..'\x1F' (* Control characters that must be escaped *)
| '\x7F' (* DEL *) ->
Printf.bprintf buf "\\u%04X" (int_of_char c)
| _ ->
(* Don't bother detecting or escaping multibyte chars *)
Buffer.add_char buf c
done
let jstring_of_string s =
let buf = Buffer.create (String.length s) in
Buffer.add_char buf '"';
escape_json_string buf s;
Buffer.add_char buf '"';
Buffer.contents buf
let null = { atom_style = Some "null" }
let bool = { atom_style = Some "bool" }
let int = { atom_style = Some "int" }
let float = { atom_style = Some "float" }
let string = { atom_style = Some "string" }
let label_string = { atom_style = Some "label" }
let colon = { atom_style = Some "punct" }
let array =
{ list with
opening_style = Some "punct";
separator_style = Some "punct";
closing_style = Some "punct" }
let label_with_colon =
{ list with
space_after_opening = false;
space_before_closing = false;
space_after_separator = false;
wrap_body = `No_breaks }
let rec format = function
Null -> Atom ("null", null)
| Bool b -> Atom (string_of_bool b, bool)
| Int i -> Atom (string_of_int i, int)
| Float f -> Atom (jstring_of_float f, float)
| String s -> Atom (jstring_of_string s, string)
| Array l -> List (("[", ",", "]", array), List.map format l)
| Object l -> List (("{", ",", "}", array), List.map format_field l)
and format_field (s, x) =
let lab =
List (("", "", "", label_with_colon),
[ Atom (jstring_of_string s, label_string);
Atom (":", colon) ])
in
Label ((lab, label), format x)
let html_escape_string s =
let buf = Buffer.create (2 * String.length s) in
for i = 0 to String.length s - 1 do
match s.[i] with
'&' -> Buffer.add_string buf "&"
| '<' -> Buffer.add_string buf "<"
| '>' -> Buffer.add_string buf ">"
| c -> Buffer.add_char buf c
done;
Buffer.contents buf
let html_escape = `Escape_string html_escape_string
let html_style = [
"null", { tag_open = "";
tag_close = "" };
"bool", { tag_open = "";
tag_close = "" };
"int", { tag_open = "";
tag_close = "" };
"float", { tag_open = "";
tag_close = "" };
"string", { tag_open = "";
tag_close = "" };
"label", { tag_open = "";
tag_close = "" };
"punct", { tag_open = "";
tag_close = "" };
]
let print_html json =
print_string "\
JSON
";
Pretty.to_stdout ~escape: html_escape ~styles: html_style (format json);
print_string "\
"
let _ =
let options = [] in
let files = ref [] in
let anon_fun s = files := s :: !files in
let usage_msg = Printf.sprintf "Usage: %s " Sys.argv.(0) in
Arg.parse options anon_fun usage_msg;
let file =
match !files with
[s] -> s
| _ -> Arg.usage options usage_msg; exit 1
in
let json = Json_io.load_json ~allow_comments:true file in
print_html json