json.tcl

   1 namespace eval ten::json {
   2
   3   namespace eval deparse {
   4
   5     variable quotes [
   6       list "\"" "\\\"" / \\/ \\ \\\\ \b \\b \f \\f \n \\n \r \\r \t \\t
   7     ]
   8
   9     variable indent
  10     variable indentBy 0
  11     variable indentIncr
  12     variable nl
  13
  14     proc indent_one {} {
  15       variable indentIncr
  16       variable indentBy [ expr $indentBy + $indentIncr ]
  17       variable indent [ string repeat " " $indentBy ]
  18     }
  19
  20     proc outdent_one {} {
  21       variable indentIncr
  22       variable indentBy [ expr $indentBy - $indentIncr ]
  23       variable indent [ string repeat " " $indentBy ]
  24     }
  25
  26     proc str {str} {
  27       variable quotes
  28       return \"[ string map $quotes $str ]\"
  29     }
  30
  31     proc num {num} {
  32       return $num
  33     }
  34
  35     proc list {args} {
  36       variable indent
  37       variable nl
  38       set out \[
  39       indent_one
  40       foreach el [lrange $args 0 end] {
  41         append out $nl$indent
  42         append out [ deparse $el ],
  43       }
  44       outdent_one
  45       append out $nl$indent\]
  46       return $out
  47     }
  48
  49     proc obj {args} {
  50       variable indent
  51       variable nl
  52       set out \{
  53       indent_one
  54       dict for {k v} $args {
  55         append out $nl$indent[ str $k ]:\ [ deparse $v ],
  56       }
  57       outdent_one
  58       append out $nl$indent\}
  59     }
  60
  61     proc deparse {data} {
  62       switch -regexp [lindex $data 0] {
  63         ^true|false|null$ { uplevel 1 return [lindex $data 0] }
  64         ^num|str|obj|list$ {}
  65         default { error [ concat "Invalid JSON type " [lindex $data 0 0] ] }
  66       }
  67       return [ eval $data ]
  68     }
  69   }
  70
  71   proc deparse_json {data {indentIncr 2}} {
  72     set deparse::indentBy 0
  73     set deparse::indentIncr $indentIncr
  74     if [expr $indentIncr == 0] {
  75       set deparse::nl ""
  76     } else {
  77       set deparse::nl "\n"
  78     }
  79     deparse::deparse $data
  80   }
  81
  82   namespace eval tclify {
  83
  84     proc str {str} { return $str }
  85
  86     proc num {num} { return $num }
  87
  88     proc obj {args} {
  89       return $args
  90     }
  91
  92     proc tclify {data} {
  93       switch -regexp [lindex $data 0] {
  94         ^true|false|null$ { uplevel 1 return [lindex $data 0] }
  95         ^num|str|obj|list$ {}
  96         default { error [ concat "Invalid JSON type " [lindex $data 0 0] ] }
  97       }
  98       return [ eval $data ]
  99     }
 100   }
 101
 102   proc tclify_json {data} {
 103     tclify::tclify $data
 104   }
 105 }
 106
 107 set ex_json { list {str foo} {num 0} {obj __remote_object__ {str 512}} {null} }
 108
 109 puts [ ten::json::deparse_json $ex_json 2 ]
 110
 111 dict for {k v} [ ten::json::tclify_json [
 112   lindex [ ten::json::tclify_json $ex_json ] 2
 113 ] ] { puts "$k: $v" }