Tcl Library Source Code

[vset VERSION 0.3]
[comment {-*- tcl -*- doctools manpage}]
[manpage_begin huddle n [vset VERSION]]
[see_also yaml]
[keywords {data exchange}]
[keywords {exchange format}]
[keywords huddle]
[keywords json]

# huddle.tcl (working title)
#
# huddle.tcl 0.1.5 2011-08-23 14:46:47 KATO Kanryu([email protected])
#
#   It is published with the terms of tcllib's BSD-style license.
#   See the file named license.terms.
#
# This library provide functions to differentinate string/list/dict in multi-ranks.
#
# Copyright (c) 2008-2011 KATO Kanryu <[email protected]>
# Copyright (c) 2015 Miguel Martínez López <[email protected]>

package require Tcl 8.5
package provide huddle 0.3

namespace eval ::huddle {
    namespace export huddle wrap unwrap isHuddle strip_node are_equal_nodes argument_to_node get_src

    variable types

    # Some subcommands conflict with Tcl builtin commands. So, we make

    set sp " "
    if {[string equal $offset ""]} {set sp ""}

    set type [huddle type $huddle_object]

    switch -- $type {
        boolean -
        number {

            return [huddle get_stripped $huddle_object]
        }
	null {
	    return null
	}
        string {
            set data [huddle get_stripped $huddle_object]

            # JSON permits only oneline string
            set data [string map {
                    \n \\n
                    \t \\t
                    \r \\r
                    \b \\b
                    \f \\f
                    \\ \\\\
                    \" \\\"
                    / \\/
                } $data
            ]
	    return "\"$data\""
        }

        list {
            set inner {}
            set len [huddle llength $huddle_object]
            for {set i 0} {$i < $len} {incr i} {
                set subobject [huddle get $huddle_object $i]
                lappend inner [jsondump $subobject $offset $newline $nextoff]
            }
            if {[llength $inner] == 1} {
                return "\[[lindex $inner 0]\]"
            }

            return "\[$nlof[join $inner ,$nlof]$newline$begin\]"
        }

        dict {
            set inner {}
            foreach {key} [huddle keys $huddle_object] {
                lappend inner [subst {"$key":$sp[jsondump [huddle get $huddle_object $key] $offset $newline $nextoff]}]
            }
            if {[llength $inner] == 1} {
                return $inner
            }
            return "\{$nlof[join $inner ,$nlof]$newline$begin\}"
        }

        default {
            return [$types(callback:$type) jsondump $data $offset $newline $nextoff]
        }
    }
}

# data is plain old tcl values

  }
}}
    
    set data [json::json2dict $json1]
    set data [huddle compile {dict dd {dict * dict} ee {dict k number * string}}  $data]
    huddle equal $huddle1 $data
} -result {1}

test huddle-3.5 "test of huddle jsondump - null handling" -body {
    huddle jsondump {HUDDLE null}
} -result {null}

test huddle-3.6 "test of huddle jsondump - dict and null handling" -body {
    huddle jsondump {HUDDLE {D {a {s foo} b null}}}
} -result {{
  "a": "foo",
  "b": null
}}

# ... Tests of addStrings ...
#     (Requires introspection of parser state)

test huddle-4.1 "test of huddle set" -body {
    huddle set data_dict dd bb a baa
} -result {HUDDLE {D {dd {D {bb {D {a {s baa} c {s d}}} cc {D {e {s f} g {s h}}}}} ee {D {i {s j} k {s l}}}}}}

if {![package vsatisfies [package provide Tcl] 8.5]} {return}

package ifneeded yaml         0.3.10 [list source [file join $dir yaml.tcl]]
package ifneeded huddle       0.3    [list source [file join $dir huddle.tcl]]
package ifneeded huddle::json 0.1    [list source [file join $dir json2huddle.tcl]]