beginnings of parser

[scpubgit/TenDotTcl.git] / json.tcl

diff --git a/json.tcl b/json.tcl
index 659c152..67c1b2e 100644 (file)
--- a/json.tcl
+++ b/json.tcl
@@ -39,7 +39,7 @@ namespace eval ten::json {
       indent_one
       foreach el [lrange $args 0 end] {
         append out $nl$indent
-        append out [ eval $el ],
+        append out [ deparse $el ],
       }
       outdent_one
       append out $nl$indent\]
@@ -52,18 +52,19 @@ namespace eval ten::json {
       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 ],
       }
       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$ { uplevel 1 return [lindex $data 0] }
+        ^num|str|obj|list$ {}
+        default { error [ concat "Invalid JSON type " [lindex $data 0 0] ] }
       }
-      return [ eval $args ]
+      eval $data
     }
   }
 
@@ -75,10 +76,117 @@ namespace eval ten::json {
     } 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_comma {} {
+      variable json
+      set json [string trimleft $json]
+      if {[string index $json 0] eq ","} {
+        set json [string range $json 1 end]
+      }
+    }
+
+    proc parse_list {} {
+      variable json
+      set json [ string range $json 1 end ]
+      set tcl {list}
+      while {"$json" ne ""} {
+        if {[string index $json 0] eq "]"} {
+          return $tcl
+        }
+        lappend tcl [ parse ]
+        eat_comma
+      }
+      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]
+      }
+      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 {} {
+      variable json
+      set json [string trimleft $json]
+      if {$json eq ""} {
+        return
+      }
+      switch -regexp [string index $json 0] {
+        {\{} { parse_obj }
+        {\[} { parse_list }
+        {\"} { parse_str }
+
+        {[-0-9]} { parse_number }
+
+        default { error "argh" }
+      }
+    }
+  }
+
+  proc parse_json {json} {
+    set parse::json $json
+    parse::parse
   }
 }
 
-puts [ ten::json::deparse_json {
-  list {str foo} {num 0} {obj __remote_object__ {str 512}}
-} 0 ]
+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"]} ]