return $num
}
+ proc decomma {str} {
+ switch [string index $str end] {
+ , { string range $str 0 end-1 }
+ default { return $str }
+ }
+ }
+
proc list {args} {
variable indent
variable nl
indent_one
foreach el [lrange $args 0 end] {
append out $nl$indent
- append out [ eval $el ],
+ append out [ deparse $el ],
}
+ set out [ decomma $out ]
outdent_one
append out $nl$indent\]
return $out
set out \{
indent_one
dict for {k v} $args {
- append out $nl$indent[ str $k ]:\ [ eval $v ],
+ append out $nl$indent[ str $k ]:\ [ deparse $v ],
}
+ set out [ decomma $out ]
outdent_one
append out $nl$indent\}
}
- proc deparse {args} {
- switch -regexp [lindex $args 0] {
- ^num|str|obj|list$ -
- default { error "Invalid JSON type [lindex $args 0]" }
+ proc deparse {data} {
+ switch -regexp [lindex $data 0] {
+ ^(true|false|null)$ { lindex $data 0 }
+ ^(num|str|obj|list)$ { eval $data }
+ default { error [ concat "Invalid JSON type " [lindex $data 0 0] ] }
}
- return [ eval $args ]
}
}
} 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
+ }
+
+ namespace export parse_json deparse_json tclify_json
+}
+
+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 {
- list {str foo} {num 0} {obj __remote_object__ {str 512}}
-} 0 ]
+namespace eval ten::connection {
+
+ proc receive_data_for {name} {
+
+
+ proc conn_setup {name input output initial_handlers} {
+ variable "${name}_input" $input
+ variable "${name}_input_closed" ""
+ variable "${name}_output" $output
+ variable "${name}_handlers"
+ array set "${name}_handlers" $initial_handlers
+ fileevent $input readable [list receive_data_for $name]
+ puts $output Shere
+ }
+
+ proc run_until_close {name} {
+ vwait "${name}_input_closed"
+ set close_value "\$${name}_input_closed"
+ teardown $name
+ return $close_value
+ }
+
+ proc teardown {name} {
+ close [ expr "\$${name}_output" ]
+ unset "${name}_input"
+ unset "${name}_input_closed"
+ unset "${name}_output"
+ unset "${name}_handlers"
+ }
+
+namespace import ten::json::*
+
+puts [ deparse_json $ex_json 2 ]
+
+dict for {k v} [ tclify_json [
+ lindex [ tclify_json $ex_json ] 2
+] ] { puts "$k: $v" }
+
+puts [ parse_json $jtext ]
+
+puts [ parse_json {["foo",2345,["bar"]]} ]
projects / scpubgit/TenDotTcl.git / blobdiff