Commit | Line | Data |
7b31d3c3 |
1 | namespace eval ten::json { |
2 | |
3 | namespace eval deparse { |
4 | |
5 | variable quotes [ |
6 | list "\"" "\\\"" / \\/ \\ \\\\ \b \\b \f \\f \n \\n \r \\r \t \\t |
7 | ] |
8 | |
9 | variable indent |
10 | variable indentBy 0 |
11 | variable indentIncr |
12 | variable nl |
13 | |
14 | proc indent_one {} { |
15 | variable indentIncr |
16 | variable indentBy [ expr $indentBy + $indentIncr ] |
17 | variable indent [ string repeat " " $indentBy ] |
18 | } |
19 | |
20 | proc outdent_one {} { |
21 | variable indentIncr |
22 | variable indentBy [ expr $indentBy - $indentIncr ] |
23 | variable indent [ string repeat " " $indentBy ] |
24 | } |
25 | |
26 | proc str {str} { |
27 | variable quotes |
28 | return \"[ string map $quotes $str ]\" |
29 | } |
30 | |
31 | proc num {num} { |
32 | return $num |
33 | } |
34 | |
1a2f3e8b |
35 | proc decomma {str} { |
36 | switch [string index $str end] { |
37 | , { string range $str 0 end-1 } |
38 | default { return $str } |
39 | } |
40 | } |
41 | |
7b31d3c3 |
42 | proc list {args} { |
43 | variable indent |
44 | variable nl |
45 | set out \[ |
46 | indent_one |
47 | foreach el [lrange $args 0 end] { |
48 | append out $nl$indent |
ced6e98e |
49 | append out [ deparse $el ], |
7b31d3c3 |
50 | } |
1a2f3e8b |
51 | set out [ decomma $out ] |
7b31d3c3 |
52 | outdent_one |
53 | append out $nl$indent\] |
54 | return $out |
55 | } |
56 | |
57 | proc obj {args} { |
58 | variable indent |
59 | variable nl |
60 | set out \{ |
61 | indent_one |
62 | dict for {k v} $args { |
ced6e98e |
63 | append out $nl$indent[ str $k ]:\ [ deparse $v ], |
7b31d3c3 |
64 | } |
1a2f3e8b |
65 | set out [ decomma $out ] |
7b31d3c3 |
66 | outdent_one |
67 | append out $nl$indent\} |
68 | } |
69 | |
ced6e98e |
70 | proc deparse {data} { |
71 | switch -regexp [lindex $data 0] { |
015669f7 |
72 | ^(true|false|null)$ { lindex $data 0 } |
73 | ^(num|str|obj|list)$ { eval $data } |
ced6e98e |
74 | default { error [ concat "Invalid JSON type " [lindex $data 0 0] ] } |
7b31d3c3 |
75 | } |
7b31d3c3 |
76 | } |
77 | } |
78 | |
79 | proc deparse_json {data {indentIncr 2}} { |
80 | set deparse::indentBy 0 |
81 | set deparse::indentIncr $indentIncr |
82 | if [expr $indentIncr == 0] { |
83 | set deparse::nl "" |
84 | } else { |
85 | set deparse::nl "\n" |
86 | } |
a001e5b2 |
87 | deparse::deparse $data |
88 | } |
89 | |
90 | namespace eval tclify { |
91 | |
92 | proc str {str} { return $str } |
93 | |
94 | proc num {num} { return $num } |
95 | |
96 | proc obj {args} { |
97 | return $args |
98 | } |
99 | |
100 | proc tclify {data} { |
101 | switch -regexp [lindex $data 0] { |
015669f7 |
102 | ^(true|false|null)$ { uplevel 1 return [lindex $data 0] } |
103 | ^(num|str|obj|list)$ {} |
a001e5b2 |
104 | default { error [ concat "Invalid JSON type " [lindex $data 0 0] ] } |
105 | } |
f5961f8c |
106 | eval $data |
a001e5b2 |
107 | } |
108 | } |
109 | |
110 | proc tclify_json {data} { |
111 | tclify::tclify $data |
7b31d3c3 |
112 | } |
f5961f8c |
113 | |
114 | namespace eval parse { |
115 | |
116 | variable json |
117 | |
fd341d42 |
118 | proc eat_spaces {} { |
f5961f8c |
119 | variable json |
120 | set json [string trimleft $json] |
fd341d42 |
121 | } |
122 | |
123 | proc eat_char {char} { |
124 | variable json |
125 | eat_spaces |
126 | if {[string index $json 0] eq "$char"} { |
127 | eat_any |
f5961f8c |
128 | } |
129 | } |
130 | |
fd341d42 |
131 | proc eat_any {} { |
f5961f8c |
132 | variable json |
133 | set json [ string range $json 1 end ] |
5d26694f |
134 | } |
135 | |
136 | proc parse_list {} { |
137 | variable json |
fd341d42 |
138 | eat_any |
f5961f8c |
139 | set tcl {list} |
140 | while {"$json" ne ""} { |
015669f7 |
141 | eat_spaces |
f5961f8c |
142 | if {[string index $json 0] eq "]"} { |
fd341d42 |
143 | eat_any |
144 | return $tcl |
145 | } |
146 | lappend tcl [ parse ] |
147 | eat_char , |
148 | } |
149 | error "Ran out of JSON. Confused now." |
150 | } |
151 | |
152 | proc parse_obj {} { |
153 | variable json |
015669f7 |
154 | eat_any |
fd341d42 |
155 | set tcl {obj} |
156 | while {"$json" ne ""} { |
015669f7 |
157 | eat_spaces |
158 | if {[string index $json 0] eq "\}"} { |
159 | eat_any |
f5961f8c |
160 | return $tcl |
161 | } |
015669f7 |
162 | eat_spaces |
163 | lappend tcl [ parse_str ] |
164 | eat_spaces |
165 | eat_char : |
166 | eat_spaces |
f5961f8c |
167 | lappend tcl [ parse ] |
fd341d42 |
168 | eat_char , |
f5961f8c |
169 | } |
170 | error "Ran out of JSON. Confused now." |
171 | } |
172 | |
173 | proc parse_str {} { |
174 | variable json |
f5961f8c |
175 | # like Text::Balanced except ugly (borrowed from tcvJSON's code) |
176 | set reStr {(?:(?:\")(?:[^\\\"]*(?:\\.[^\\\"]*)*)(?:\"))} |
177 | if {![regexp $reStr $json string]} { |
015669f7 |
178 | error "Invalid string: $json" |
f5961f8c |
179 | } |
180 | set json [string range $json [string length $string] end] |
181 | # chop off outer ""s and substitute backslashes |
182 | # This does more than the RFC-specified backslash sequences, |
183 | # but it does cover them all |
184 | list str [subst -nocommand -novariable [string range $string 1 end-1]] |
185 | } |
186 | |
5d26694f |
187 | proc parse_num {} { |
188 | variable json |
189 | string is double -failindex last $json |
190 | if {$last == 0} { |
191 | error "Saw number but wasn't - $json" |
192 | } |
193 | set num [string range $json 0 [expr {$last - 1}]] |
194 | set json [string range $json $last end] |
195 | list num $num |
196 | } |
197 | |
015669f7 |
198 | proc parse_bare {} { |
199 | variable json |
200 | if [regexp {^(true|false|null)} $json matched] { |
201 | set json [ string range $json [ string length $matched ] end ] |
202 | return $matched |
203 | } else { |
204 | error "Out of ideas parsing: $json" |
205 | } |
206 | } |
207 | |
f5961f8c |
208 | proc parse {} { |
209 | variable json |
fd341d42 |
210 | eat_spaces |
f5961f8c |
211 | if {$json eq ""} { |
212 | return |
213 | } |
214 | switch -regexp [string index $json 0] { |
215 | {\{} { parse_obj } |
216 | {\[} { parse_list } |
217 | {\"} { parse_str } |
218 | |
5d26694f |
219 | {[-0-9]} { parse_num } |
f5961f8c |
220 | |
015669f7 |
221 | default { parse_bare } |
f5961f8c |
222 | } |
223 | } |
224 | } |
225 | |
226 | proc parse_json {json} { |
5d26694f |
227 | set parse::json [ string trim $json ] |
228 | set result [ parse::parse ] |
fd341d42 |
229 | parse::eat_spaces |
230 | if {$parse::json ne ""} { |
5d26694f |
231 | error "Had JSON left over: $parse::json" |
232 | } |
233 | return $result |
f5961f8c |
234 | } |
0fcbbbfb |
235 | |
236 | namespace export parse_json deparse_json tclify_json |
7b31d3c3 |
237 | } |
238 | |
a001e5b2 |
239 | set ex_json { list {str foo} {num 0} {obj __remote_object__ {str 512}} {null} } |
240 | |
f5961f8c |
241 | set jtext { |
242 | [ |
243 | "foo", |
244 | 0, |
245 | { |
246 | "__remote_object__": "512", |
247 | }, |
248 | null, |
249 | ] |
250 | } |
251 | |
1a2f3e8b |
252 | namespace eval ten::connection { |
253 | |
254 | proc receive_data_for {name} { |
255 | |
256 | |
257 | proc conn_setup {name input output initial_handlers} { |
258 | variable "${name}_input" $input |
259 | variable "${name}_input_closed" "" |
260 | variable "${name}_output" $output |
261 | variable "${name}_handlers" |
262 | array set "${name}_handlers" $initial_handlers |
263 | fileevent $input readable [list receive_data_for $name] |
264 | puts $output Shere |
265 | } |
266 | |
267 | proc run_until_close {name} { |
268 | vwait "${name}_input_closed" |
269 | set close_value "\$${name}_input_closed" |
270 | teardown $name |
271 | return $close_value |
272 | } |
273 | |
274 | proc teardown {name} { |
275 | close [ expr "\$${name}_output" ] |
276 | unset "${name}_input" |
277 | unset "${name}_input_closed" |
278 | unset "${name}_output" |
279 | unset "${name}_handlers" |
280 | } |
281 | |
0fcbbbfb |
282 | namespace import ten::json::* |
283 | |
284 | puts [ deparse_json $ex_json 2 ] |
a001e5b2 |
285 | |
0fcbbbfb |
286 | dict for {k v} [ tclify_json [ |
287 | lindex [ tclify_json $ex_json ] 2 |
a001e5b2 |
288 | ] ] { puts "$k: $v" } |
f5961f8c |
289 | |
0fcbbbfb |
290 | puts [ parse_json $jtext ] |
f5961f8c |
291 | |
0fcbbbfb |
292 | puts [ parse_json {["foo",2345,["bar"]]} ] |