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
append out $nl$indent
append out [ deparse $el ],
}
+ set out [ decomma $out ]
outdent_one
append out $nl$indent\]
return $out
dict for {k v} $args {
append out $nl$indent[ str $k ]:\ [ deparse $v ],
}
+ set out [ decomma $out ]
outdent_one
append out $nl$indent\}
}
proc deparse {data} {
switch -regexp [lindex $data 0] {
- ^true|false|null$ { lindex $data 0 }
- ^num|str|obj|list$ { eval $data }
+ ^(true|false|null)$ { lindex $data 0 }
+ ^(num|str|obj|list)$ { eval $data }
default { error [ concat "Invalid JSON type " [lindex $data 0 0] ] }
}
}
proc tclify {data} {
switch -regexp [lindex $data 0] {
- ^true|false|null$ { uplevel 1 return [lindex $data 0] }
- ^num|str|obj|list$ {}
+ ^(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
variable json
- proc eat_comma {} {
+ proc eat_spaces {} {
variable json
set json [string trimleft $json]
- if {[string index $json 0] eq ","} {
- set json [string range $json 1 end]
+ }
+
+ proc eat_char {char} {
+ variable json
+ eat_spaces
+ if {[string index $json 0] eq "$char"} {
+ eat_any
}
}
- proc parse_list {} {
+ 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_comma
+ eat_char ,
}
error "Ran out of JSON. Confused now."
}
# 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]
+ error "Invalid string: $json"
}
set json [string range $json [string length $string] end]
# chop off outer ""s and substitute backslashes
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
- set json [string trimleft $json]
+ eat_spaces
if {$json eq ""} {
return
}
{\[} { parse_list }
{\"} { parse_str }
- {[-0-9]} { parse_number }
+ {[-0-9]} { parse_num }
- default { error "argh" }
+ default { parse_bare }
}
}
}
proc parse_json {json} {
- set parse::json $json
- parse::parse
+ 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} }
]
}
-puts [ ten::json::deparse_json $ex_json 2 ]
+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} [ ten::json::tclify_json [
- lindex [ ten::json::tclify_json $ex_json ] 2
+dict for {k v} [ tclify_json [
+ lindex [ tclify_json $ex_json ] 2
] ] { puts "$k: $v" }
-#puts [ ten::json::parse_json $jtext ]
+puts [ parse_json $jtext ]
-puts [ ten::json::parse_json {["foo"]} ]
+puts [ parse_json {["foo",2345,["bar"]]} ]