Posted to tcl by evilotto at Fri Sep 08 20:53:16 GMT 2017view pretty

package require rl_json

namespace eval ::jsb {

    variable current {}
    variable ctx {}

    proc build {script} {
        variable current
       
        set current {}
        set cpath [uplevel namespace path]
        uplevel [list namespace path [list {*}$cpath ::jsb]]
        ctx val val $script
        uplevel [list namespace path $cpath]
        try {
            set json [rl_json::json new {*}[lindex $current 0]]
        } on error e {
            puts "$e trying to format \n\t$current"
        }

        return $json
    }

    proc ctx {req cur script} {
        variable ctx
        set cc [lindex $ctx end]
        if {$cc ne $req} {
            error "invalid context for $cur (is $cc, needs $req)"
        }
        if {$cur ne "-"} {
            lappend ctx $cur
            uplevel 2 $script
            set ctx [lrange $ctx 0 end-1]
        } else {
            uplevel 1 $script
        }
    }

    proc Obj {script} {
        variable current
        set cval $current
        set current {}
        ctx val obj $script
        set current [list {*}$cval [list object {*}$current]]
    }

    proc Entry {k script} {
        variable current
        set cval $current
        set current {}
        ctx obj val $script
        set current [list {*}$cval $k {*}$current]
    }

    proc Array {script} {
        variable current
        set cval $current
        set current {}
        ctx val val $script
        set current [list {*}$cval [list array {*}$current]]
    }

    proc Null {} {
        variable current
        ctx val - {lappend current null}
    }
    proc Number {v} {
        variable current
        ctx val - {lappend current [list number $v]}
    }
    proc String {s} {
        variable current
        ctx val - {lappend current [list string $s]}
    }
}



### usage ###

puts [jsb::build {
    Obj {
        Entry woo {String baz}
        Entry zoo {
            Array {
                Null
                Obj {
                    Entry a {Null}
                    for {set a 0} {$a < 10} {incr a} {
                        Entry "a$a" {Number $a}
                    }
                }
            }
        }
    }
}]

### results in:
# {"woo":"baz","zoo":[null,{"a":null,"a0":0,"a1":1,"a2":2,"a3":3,"a4":4,"a5":5,"a6":6,"a7":7,"a8":8,"a9":9}]}