Tcl Library Source Code

Check-in [0bb3131985]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Integrated latest tweak by Miguel.
Timelines: family | ancestors | descendants | both | huddle-a753cade83
Files: files | file ages | folders
SHA1: 0bb3131985e8efdcf80d199dfbd95ca813793fed
User & Date: andreask 2015-05-26 21:47:38
Context
2015-05-26
23:41
Keep up to date with trunk check-in: ca4c2acc78 user: andreask tags: huddle-a753cade83
21:47
Integrated latest tweak by Miguel. check-in: 0bb3131985 user: andreask tags: huddle-a753cade83
20:52
Fixed more trailing whitespace, and indentation (use 4 spaces per level). Fixed two missing closing brackets in huddle::compile (bool type). Updated package index to note requirement for 8.5+ for all packages. check-in: 70538d56d1 user: andreask tags: huddle-a753cade83
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/yaml/huddle.tcl.

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

    variable types

    # Some subcommands conflict reserved words. So, we make the convention of using first letter in uppercase for private
    # procs (e.g. from "set" to "Set")

    namespace ensemble create -map {
	set					::huddle::Set
	append				::huddle::Append
	get					::huddle::Get
	get_stripped		::huddle::get_stripped
	unset				::huddle::Unset
	combine				::huddle::combine
	combine_relaxed 	::huddle::combine_relaxed
	type				::huddle::type
	remove				::huddle::remove
	equal				::huddle::equal
	exists				::huddle::exists
	clone				::huddle::clone
	isHuddle			::huddle::isHuddle
	wrap				::huddle::wrap
	unwrap				::huddle::unwrap
	addType				::huddle::addType
	jsondump			::huddle::jsondump
	compile				::huddle::compile
    }
}

proc ::huddle::addTypes {} {
    foreach typeNamespace [namespace children ::huddle::types] {
	addType $typeNamespace
    }







|
|
|

|
|

|
|
|
|
|
|
|
|
|
|
|







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

    variable types

    # Some subcommands conflict reserved words. So, we make the convention of using first letter in uppercase for private
    # procs (e.g. from "set" to "Set")

    namespace ensemble create -map {
	set			::huddle::Set
	append			::huddle::Append
	get			::huddle::Get
	get_stripped		::huddle::get_stripped
	unset			::huddle::Unset
	combine			::huddle::combine
	combine_relaxed 	::huddle::combine_relaxed
	type			::huddle::type
	remove			::huddle::remove
	equal			::huddle::equal
	exists			::huddle::exists
	clone			::huddle::clone
	isHuddle		::huddle::isHuddle
	wrap			::huddle::wrap
	unwrap			::huddle::unwrap
	addType			::huddle::addType
	jsondump		::huddle::jsondump
	compile			::huddle::compile
    }
}

proc ::huddle::addTypes {} {
    foreach typeNamespace [namespace children ::huddle::types] {
	addType $typeNamespace
    }
534
535
536
537
538
539
540

541

542
543
544
545
546
547
548
		}
	    }
	    return [dict create {*}$resultL]
	}

	# $args: all arguments after "huddle create"
	proc create {args} {

	    if {[llength $args] % 2} {error "wrong # args: should be \"huddle create ?key value ...?\""}

	    set resultL [dict create]

	    foreach {key value} $args {
		if {[isHuddle $key]} {
		    foreach {tag src} [unwrap $key] break
		    if {$tag ne "string"} {error "The key '$key' must a string literal or huddle string" }
		    set key $src







>
|
>







534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
		}
	    }
	    return [dict create {*}$resultL]
	}

	# $args: all arguments after "huddle create"
	proc create {args} {
	    if {[llength $args] % 2} {
		error "wrong # args: should be \"huddle create ?key value ...?\""
	    }
	    set resultL [dict create]

	    foreach {key value} $args {
		if {[isHuddle $key]} {
		    foreach {tag src} [unwrap $key] break
		    if {$tag ne "string"} {error "The key '$key' must a string literal or huddle string" }
		    set key $src
815
816
817
818
819
820
821

822
823

824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850

851



852
853
854
855
856
857
858
859
860

861


862








863
864
865
866
867
868
proc ::huddle::compile {spec data} {
    while {[llength $spec]} {
	set type [lindex $spec 0]
	set spec [lrange $spec 1 end]

	switch -- $type {
	    dict {

		lappend spec * string


		set result [huddle create]
		foreach {key val} $data {
		    foreach {keymatch valtype} $spec {
			if {[string match $keymatch $key]} {
			    huddle append result $key [compile $valtype $val]
			    break
			}
		    }
		}
		return $result
	    }
	    list {
		if {![llength $spec]} {
		    set spec string
		} else {
		    set spec [lindex $spec 0]
		}
		set result [huddle list]
		foreach val $data {
		    huddle append result [compile $spec $val]
		}
		return $result
	    }
	    string {
		return [wrap [list s $data]]
	    }
	    number {

		return [wrap [list num $data]]



	    }
	    bool {
		if {$data} {
		    return [wrap [list bool true]]
		} else {
		    return [wrap [list bool false]]
		}
	    }
	    null {

		return [wrap [list null]]


	    }








	    default {error "Invalid type"}
	}
    }
}

::huddle::addTypes







>
|
|
>

|
|
|
|













|
|







>
|
>
>
>









>
|
>
>
|
>
>
>
>
>
>
>
>
|





817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
proc ::huddle::compile {spec data} {
    while {[llength $spec]} {
	set type [lindex $spec 0]
	set spec [lrange $spec 1 end]

	switch -- $type {
	    dict {
		if {![llength $spec]} {
		    lappend spec * string
		}

		set result [huddle create]
		foreach {key value} $data {
		    foreach {matching_key subspec} $spec {
			if {[string match $matching_key $key]} {
			    Append result $key [compile $subspec $value]
			    break
			}
		    }
		}
		return $result
	    }
	    list {
		if {![llength $spec]} {
		    set spec string
		} else {
		    set spec [lindex $spec 0]
		}
		set result [huddle list]
		foreach list_item $data {
		    Append result [compile $spec $list_item]
		}
		return $result
	    }
	    string {
		return [wrap [list s $data]]
	    }
	    number {
		if {[string is double -strict $data]} {
		    return [wrap [list num $data]]
		} else {
		    error "Bad number: $data"
		}
	    }
	    bool {
		if {$data} {
		    return [wrap [list bool true]]
		} else {
		    return [wrap [list bool false]]
		}
	    }
	    null {
		if {$data eq ""} {
		    return [wrap [list null]]
		} else {
		    error "Data must be an empty string: '$data'"
		}
	    }
	    huddle {
		if {[isHuddle $data]} {
		    return $data
		} else {
		    error "Data is not a huddle object: $data"
		}
	    }
	    default {error "Invalid type: '$type'"}
	}
    }
}

::huddle::addTypes

Changes to modules/yaml/huddle.test.

169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184

























185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
      "g",
      "h"
    ]
  ],
  "t"
]}

if { [package vcompare [package provide Tcl] 8.5] > 0 } {
test huddle-3.3 "test of huddle jsondump" -body {
    set huddle1 {HUDDLE {D {dd {D {bb {D {a {s baa} c {s {d a}}}} cc {D {g {s h}}}}} ee {D {i {s j} k {s 1} j {s { m\a}}}}}}}
    set json1 [huddle jsondump $huddle1]
    set json2 {{
  "dd": {
    "bb": {
      "a": "baa",
      "c": "d\na"

























    },
    "cc": {"g": "h"}
  },
  "ee": {
    "i": "j",
    "k": 1,
    "j": " m\\a"
  }
}}
    if {$json1 == $json2} {return 1}
    set data [json::json2dict $json1]
    set data [huddle compile {dict dd {dict * dict} ee dict} $data]
    huddle equal $huddle1 $data
} -result {1}
}

# ... 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}}}}}}







|







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>









|

|


<







169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223

224
225
226
227
228
229
230
      "g",
      "h"
    ]
  ],
  "t"
]}


test huddle-3.3 "test of huddle jsondump" -body {
    set huddle1 {HUDDLE {D {dd {D {bb {D {a {s baa} c {s {d a}}}} cc {D {g {s h}}}}} ee {D {i {s j} k {s 1} j {s { m\a}}}}}}}
    set json1 [huddle jsondump $huddle1]
    set json2 {{
  "dd": {
    "bb": {
      "a": "baa",
      "c": "d a"
    },
    "cc": {"g": "h"}
  },
  "ee": {
    "i": "j",
    "k": 1,
    "j": " m\\a"
  }
}}

    if {$json1 == $json2} {
	return 1
    } else {
	return 0
    }
} -result {1}


test huddle-3.4 "test of huddle compile" -body {
    set huddle1 {HUDDLE {D {dd {D {bb {D {a {s baa} c {s {d a}}}} cc {D {g {s h}}}}} ee {D {i {s j} k {num 1} j {s { m\a}}}}}}}
    set json1 {{
  "dd": {
    "bb": {
      "a": "baa",
      "c": "d a"
    },
    "cc": {"g": "h"}
  },
  "ee": {
    "i": "j",
    "k": 1,
    "j": " m\\a"
  }
}}
	
    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}


# ... 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}}}}}}