X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=json.tcl;h=1acd13f16877d6d2146f9e0e52b36ed5ff59ec72;hb=451af734a02bd95ae80362af9e0a4f6b6e4ee34e;hp=67c1b2e1400d2b395c0c4e4faa2667d960de3bb1;hpb=f5961f8c52877b8bc38bd289cb420b065cc81c64;p=scpubgit%2FTenDotTcl.git

diff --git a/json.tcl b/json.tcl
index 67c1b2e..1acd13f 100644
--- a/json.tcl
+++ b/json.tcl
@@ -32,6 +32,13 @@ namespace eval ten::json {
       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
@@ -41,6 +48,7 @@ namespace eval ten::json {
         append out $nl$indent
         append out [ deparse $el ],
       }
+      set out [ decomma $out ]
       outdent_one
       append out $nl$indent\]
       return $out
@@ -54,17 +62,17 @@ namespace eval ten::json {
       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$ { 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] ] }
       }
-      eval $data
     }
   }
 
@@ -91,8 +99,8 @@ namespace eval ten::json {
 
     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
@@ -107,35 +115,67 @@ namespace eval ten::json {
 
     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."
     }
 
     proc parse_str {} {
       variable json
-puts $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]
+        error "Invalid string: $json"
       }
       set json [string range $json [string length $string] end]
       # chop off outer ""s and substitute backslashes
@@ -144,9 +184,30 @@ puts $json
       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
       }
@@ -155,17 +216,24 @@ puts $json
         {\[} { 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} }
@@ -181,12 +249,44 @@ set jtext {
   ]
 }
 
-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"]]} ]