proc deparse {data} {
switch -regexp [lindex $data 0] {
- ^true|false|null$ { uplevel 1 return [lindex $data 0] }
- ^num|str|obj|list$ {}
+ ^(true|false|null)$ { lindex $data 0 }
+ ^(num|str|obj|list)$ { eval $data }
default { error [ concat "Invalid JSON type " [lindex $data 0 0] ] }
}
- return [ eval $data ]
}
}
} else {
set deparse::nl "\n"
}
- namespace inscope deparse eval $data
+ deparse::deparse $data
+ }
+
+ namespace eval tclify {
+
+ proc str {str} { return $str }
+
+ proc num {num} { return $num }
+
+ proc obj {args} {
+ return $args
+ }
+
+ proc tclify {data} {
+ switch -regexp [lindex $data 0] {
+ ^(true|false|null)$ { uplevel 1 return [lindex $data 0] }
+ ^(num|str|obj|list)$ {}
+ default { error [ concat "Invalid JSON type " [lindex $data 0 0] ] }
+ }
+ eval $data
+ }
+ }
+
+ proc tclify_json {data} {
+ tclify::tclify $data
+ }
+
+ namespace eval parse {
+
+ variable json
+
+ proc eat_spaces {} {
+ variable json
+ set json [string trimleft $json]
+ }
+
+ proc eat_char {char} {
+ variable json
+ eat_spaces
+ if {[string index $json 0] eq "$char"} {
+ eat_any
+ }
+ }
+
+ proc eat_any {} {
+ variable json
+ set json [ string range $json 1 end ]
+ }
+
+ proc parse_list {} {
+ variable json
+ eat_any
+ set tcl {list}
+ while {"$json" ne ""} {
+ eat_spaces
+ if {[string index $json 0] eq "]"} {
+ eat_any
+ return $tcl
+ }
+ lappend tcl [ parse ]
+ eat_char ,
+ }
+ error "Ran out of JSON. Confused now."
+ }
+
+ proc parse_obj {} {
+ variable json
+ eat_any
+ set tcl {obj}
+ while {"$json" ne ""} {
+ eat_spaces
+ if {[string index $json 0] eq "\}"} {
+ eat_any
+ return $tcl
+ }
+ eat_spaces
+ lappend tcl [ parse_str ]
+ eat_spaces
+ eat_char :
+ eat_spaces
+ lappend tcl [ parse ]
+ eat_char ,
+ }
+ error "Ran out of JSON. Confused now."
+ }
+
+ proc parse_str {} {
+ variable json
+ # like Text::Balanced except ugly (borrowed from tcvJSON's code)
+ set reStr {(?:(?:\")(?:[^\\\"]*(?:\\.[^\\\"]*)*)(?:\"))}
+ if {![regexp $reStr $json string]} {
+ error "Invalid string: $json"
+ }
+ set json [string range $json [string length $string] end]
+ # chop off outer ""s and substitute backslashes
+ # This does more than the RFC-specified backslash sequences,
+ # but it does cover them all
+ list str [subst -nocommand -novariable [string range $string 1 end-1]]
+ }
+
+ proc parse_num {} {
+ variable json
+ string is double -failindex last $json
+ if {$last == 0} {
+ error "Saw number but wasn't - $json"
+ }
+ set num [string range $json 0 [expr {$last - 1}]]
+ set json [string range $json $last end]
+ list num $num
+ }
+
+ proc parse_bare {} {
+ variable json
+ if [regexp {^(true|false|null)} $json matched] {
+ set json [ string range $json [ string length $matched ] end ]
+ return $matched
+ } else {
+ error "Out of ideas parsing: $json"
+ }
+ }
+
+ proc parse {} {
+ variable json
+ eat_spaces
+ if {$json eq ""} {
+ return
+ }
+ switch -regexp [string index $json 0] {
+ {\{} { parse_obj }
+ {\[} { parse_list }
+ {\"} { parse_str }
+
+ {[-0-9]} { parse_num }
+
+ default { parse_bare }
+ }
+ }
+ }
+
+ proc parse_json {json} {
+ set parse::json [ string trim $json ]
+ set result [ parse::parse ]
+ parse::eat_spaces
+ if {$parse::json ne ""} {
+ error "Had JSON left over: $parse::json"
+ }
+ return $result
}
}
-puts [ ten::json::deparse_json {
- list {str foo} {num 0} {obj __remote_object__ {str 512}} {null}
-} 2 ]
+set ex_json { list {str foo} {num 0} {obj __remote_object__ {str 512}} {null} }
+
+set jtext {
+ [
+ "foo",
+ 0,
+ {
+ "__remote_object__": "512",
+ },
+ null,
+ ]
+}
+
+puts [ ten::json::deparse_json $ex_json 2 ]
+
+dict for {k v} [ ten::json::tclify_json [
+ lindex [ ten::json::tclify_json $ex_json ] 2
+] ] { puts "$k: $v" }
+
+puts [ ten::json::parse_json $jtext ]
+
+puts [ ten::json::parse_json {["foo",2345,["bar"]]} ]