1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
#! /usr/bin/env ocamlscript
Ocaml.packs := ["json-wheel"; "easy-format"]
--
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 = "<span class=\"json-null\">";
tag_close = "</span>" };
"bool", { tag_open = "<span class=\"json-bool\">";
tag_close = "</span>" };
"int", { tag_open = "<span class=\"json-int\">";
tag_close = "</span>" };
"float", { tag_open = "<span class=\"json-float\">";
tag_close = "</span>" };
"string", { tag_open = "<span class=\"json-string\">";
tag_close = "</span>" };
"label", { tag_open = "<span class=\"json-label\">";
tag_close = "</span>" };
"punct", { tag_open = "<span class=\"json-punct\">";
tag_close = "</span>" };
]
let print_html json =
print_string "\
<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">
<head>
<title>JSON</title>
<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />
<meta name=\"generator\" content=\"Easy-format\" />
<style type=\"text/css\">
body,code,pre { color:black;background-color:white }
.json-null { color: #808080; }
.json-bool { color: black; }
.json-int { color: black; }
.json-float { color: black; }
.json-string { color: black; }
.json-label { color: #0033cc; }
.json-punct { color: black; }
</style>
</head>
<body>
<pre>
";
Pretty.to_stdout ~escape: html_escape ~styles: html_style (format json);
print_string "\
</pre>
</body>
</html>
"
let () =
let options = [] in
let files = ref [] in
let anon_fun s = files := s :: !files in
let usage_msg = Printf.sprintf "Usage: %s <file>" 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
|
