1 namespace eval ten::json {
3 namespace eval deparse {
6 list "\"" "\\\"" / \\/ \\ \\\\ \b \\b \f \\f \n \\n \r \\r \t \\t
16 variable indentBy [ expr $indentBy + $indentIncr ]
17 variable indent [ string repeat " " $indentBy ]
22 variable indentBy [ expr $indentBy - $indentIncr ]
23 variable indent [ string repeat " " $indentBy ]
28 return \"[ string map $quotes $str ]\"
40 foreach el [lrange $args 0 end] {
42 append out [ deparse $el ],
45 append out $nl$indent\]
54 dict for {k v} $args {
55 append out $nl$indent[ str $k ]:\ [ deparse $v ],
58 append out $nl$indent\}
62 switch -regexp [lindex $data 0] {
63 ^(true|false|null)$ { lindex $data 0 }
64 ^(num|str|obj|list)$ { eval $data }
65 default { error [ concat "Invalid JSON type " [lindex $data 0 0] ] }
70 proc deparse_json {data {indentIncr 2}} {
71 set deparse::indentBy 0
72 set deparse::indentIncr $indentIncr
73 if [expr $indentIncr == 0] {
78 deparse::deparse $data
81 namespace eval tclify {
83 proc str {str} { return $str }
85 proc num {num} { return $num }
92 switch -regexp [lindex $data 0] {
93 ^(true|false|null)$ { uplevel 1 return [lindex $data 0] }
94 ^(num|str|obj|list)$ {}
95 default { error [ concat "Invalid JSON type " [lindex $data 0 0] ] }
101 proc tclify_json {data} {
105 namespace eval parse {
111 set json [string trimleft $json]
114 proc eat_char {char} {
117 if {[string index $json 0] eq "$char"} {
124 set json [ string range $json 1 end ]
131 while {"$json" ne ""} {
133 if {[string index $json 0] eq "]"} {
137 lappend tcl [ parse ]
140 error "Ran out of JSON. Confused now."
147 while {"$json" ne ""} {
149 if {[string index $json 0] eq "\}"} {
154 lappend tcl [ parse_str ]
158 lappend tcl [ parse ]
161 error "Ran out of JSON. Confused now."
166 # like Text::Balanced except ugly (borrowed from tcvJSON's code)
167 set reStr {(?:(?:\")(?:[^\\\"]*(?:\\.[^\\\"]*)*)(?:\"))}
168 if {![regexp $reStr $json string]} {
169 error "Invalid string: $json"
171 set json [string range $json [string length $string] end]
172 # chop off outer ""s and substitute backslashes
173 # This does more than the RFC-specified backslash sequences,
174 # but it does cover them all
175 list str [subst -nocommand -novariable [string range $string 1 end-1]]
180 string is double -failindex last $json
182 error "Saw number but wasn't - $json"
184 set num [string range $json 0 [expr {$last - 1}]]
185 set json [string range $json $last end]
191 if [regexp {^(true|false|null)} $json matched] {
192 set json [ string range $json [ string length $matched ] end ]
195 error "Out of ideas parsing: $json"
205 switch -regexp [string index $json 0] {
210 {[-0-9]} { parse_num }
212 default { parse_bare }
217 proc parse_json {json} {
218 set parse::json [ string trim $json ]
219 set result [ parse::parse ]
221 if {$parse::json ne ""} {
222 error "Had JSON left over: $parse::json"
228 set ex_json { list {str foo} {num 0} {obj __remote_object__ {str 512}} {null} }
235 "__remote_object__": "512",
241 puts [ ten::json::deparse_json $ex_json 2 ]
243 dict for {k v} [ ten::json::tclify_json [
244 lindex [ ten::json::tclify_json $ex_json ] 2
245 ] ] { puts "$k: $v" }
247 puts [ ten::json::parse_json $jtext ]
249 puts [ ten::json::parse_json {["foo",2345,["bar"]]} ]