-
Notifications
You must be signed in to change notification settings - Fork 4
/
printer.dylan
193 lines (174 loc) · 6.4 KB
/
printer.dylan
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
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
Module: %json
Copyright: Original Code is Copyright (c) 2011 Dylan Hackers
All rights reserved.
License: See License.txt in this distribution for details.
/*
Notes on pretty printing:
* For now this code either prints without whitespace at all or prints objects
with one key per line. There is no attempt to fit multiple key/value pairs on
one line or to output { "one": "pair" } on one line.
* If a prefix is given, the block's indentation level is at the column after
where the prefix ends.
* The suffix, if given, begins at the block's indentation level.
* I am not an expert, but the above two facts appear to make prefix/suffix
unusable if you want this style of braces:
"ghi": {
"pqr": "stu",
"jkl": "mno"
}
*/
// Either #f, meaning that pretty printing is turned off, or a string
// containing the number of spaces for ONE indent level.
define thread variable *indent* :: false-or(<string>) = #f;
// Whether to output JSON objects (i.e., tables) with keys sorted by <.
define thread variable *sort-keys?* :: <boolean> = #f;
// Print an object in json format.
//
// Parameters:
// object: The object to print.
// stream: Stream on which to do output.
// indent: If false, `object` is printed with minimal whitespace. If an integer,
// then use pretty printing and output `indent` spaces for each indent level.
// sort-keys?: If true, output object keys in lexicographical order.
define function print-json
(object :: <object>, stream :: <stream>,
#key indent :: false-or(<integer>),
sort-keys? :: <boolean> = *sort-keys?*)
dynamic-bind (*sort-keys?* = sort-keys?)
if (indent)
dynamic-bind (*indent* = make(<string>, size: indent, fill: ' '),
*print-pretty?* = #t) // bug: shouldn't be required.
io/printing-logical-block(stream)
do-print-json(object, stream);
end;
end
else
do-print-json(object, stream);
end;
end;
end function;
// Override this to print your own objects in json format. It can be
// implemented by converting objects to built-in Dylan types (tables,
// collections, etc) and calling `print` on those objects, or by writing json
// syntax directly to `stream`.
//
// If `indent:` was passed to `print` then `stream` will be a pretty printing
// stream and the io:pprint module may be used to implement pretty printing.
define open generic do-print-json (object :: <object>, stream :: <stream>);
define method do-print-json (object == $null, stream :: <stream>)
write(stream, "null");
end method;
define method do-print-json (object :: <integer>, stream :: <stream>)
write(stream, integer-to-string(object));
end method;
define method do-print-json (object :: <float>, stream :: <stream>)
write(stream, float-to-string(object));
end method;
define method do-print-json (object :: <boolean>, stream :: <stream>)
write(stream, if (object) "true" else "false" end);
end method;
define method do-print-json (object :: <string>, stream :: <stream>)
write-element(stream, '"');
let zero :: <integer> = as(<integer>, '0');
let a :: <integer> = as(<integer>, 'a') - 10;
local
method write-hex-digit (code :: <integer>)
write-element(stream, as(<character>,
if (code < 10) zero + code else a + code end));
end,
method write-unicode-escape (code :: <integer>)
write(stream, "\\u");
write-hex-digit(ash(logand(code, #xf000), -12));
write-hex-digit(ash(logand(code, #x0f00), -8));
write-hex-digit(ash(logand(code, #x00f0), -4));
write-hex-digit(logand(code, #x000f));
end;
for (char in object)
let code = as(<integer>, char);
case
code <= #x1f =>
let escape-char = select (char)
'\b' => 'b';
'\f' => 'f';
'\n' => 'n';
'\r' => 'r';
'\t' => 't';
otherwise => #f;
end;
if (escape-char)
write-element(stream, '\\');
write-element(stream, escape-char);
else
write-unicode-escape(code);
end;
char == '"' =>
write(stream, "\\\"");
char == '\\' =>
write(stream, "\\\\");
code < 127 => // omits DEL
write-element(stream, char);
otherwise =>
write-unicode-escape(code);
end case;
end for;
write-element(stream, '"');
end method;
define method do-print-json (object :: <collection>, stream :: <stream>)
io/printing-logical-block (stream, prefix: "[", suffix: "]")
for (o in object,
i from 0)
if (i > 0)
write(stream, ",");
if (*indent*)
// TODO: is there a way to tell the pretty printer to output a space
// only if the conditional newline isn't output? Don't want trailing
// spaces.
write(stream, " ");
io/pprint-newline(#"fill", stream);
end;
end if;
do-print-json(o, stream);
end for;
end;
end method;
// TODO: print on a single line when entire table fits, otherwise always output
// one element per line. Not sure if the pretty printer can be coaxed into
// doing that. Might be easier to do it (even just the current functionality)
// by hand.
define method do-print-json (object :: <table>, stream :: <stream>)
local
method print-key-value-pairs-body (stream, i, key, value)
if (i > 0)
write(stream, ",");
*indent* & io/pprint-newline(#"mandatory", stream);
end if;
do-print-json(key, stream);
write(stream, ":");
*indent* & write(stream, " ");
do-print-json(value, stream);
end method,
method print-key-value-pairs (stream :: <stream>)
if (*sort-keys?*)
for (key in sort!(key-sequence(object)), i from 0)
print-key-value-pairs-body(stream, i, key, object[key]);
end;
else
for (value keyed-by key in object, i from 0)
print-key-value-pairs-body(stream, i, key, value)
end for;
end;
end method;
write(stream, "{");
if (~empty?(object))
if (*indent*)
io/pprint-newline(#"mandatory", stream);
io/printing-logical-block (stream, per-line-prefix: *indent*)
print-key-value-pairs(stream)
end;
io/pprint-newline(#"mandatory", stream);
else
print-key-value-pairs(stream);
end;
end;
write(stream, "}");
end method;