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 ]
}
}
^num|str|obj|list$ {}
default { error [ concat "Invalid JSON type " [lindex $data 0 0] ] }
}
- return [ eval $data ]
+ 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 ""} {
+ 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_char
+ set tcl {obj}
+ while {"$json" ne ""} {
+ if {[string index $json 0] eq "]"} {
+ eat_char
+ return $tcl
+ }
+ lappend tcl [
+ 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 [ concat "Invalid string: " [string range $json 0 32]
+ }
+ 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 {} {
+ 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 { error "argh" }
+ }
+ }
+ }
+
+ 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
+ }
}
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"]]} ]