Napier 2016-02-22 PYK 2020-01-24:
Below, ensemble extend is used to extend the built-in dict ensemble with routines that have generally helped with building and passing around data.
In Tcllib 1.17 there is also the dicttool package, which provides additional routines for manipulating dictionaries and has some overlap. Perhaps some of the routines below will be merged into Tcllib at some point.
There may be better ways to handle various parts of this API but it has worked great for our needs at Dash, where incoming data can differ from what is documented, making it necessary, for situations like the absence of expected keys. These routines are also used to transform data as it moves through a pipeline.
dict get? provides a default result in the case that the specified item is missing:
proc myProc {} {
set tempDict [dict create Foo one Bar two Baz three]
set Grill [dict get? $tempDict Grill]
puts $Grill
# -> {}
}MSH 2016-08-22: I have a similar function and find it useful to have an optional default value argument this allows using the return value without an extra isempty test.
proc myProc {} {
set tempDict [dict create Foo one Bar two Baz three]
set Flag [dict get? $tempDict isOn false]
if {$isOn} {
puts {IS ON}
}
}dict modify modifies the specified items in the dictionary without affecting the others. It is useful in cases where dict set would overwrite the entire key, or where dict create would think the keys are nested and provide undesired results.
proc myProc {} {
set tempDict [dict create Foo one Bar two Baz three]
dict modify tempDict Foo oneTwo Grill four
# Foo oneTwo Bar two Baz three Grill four
puts $tempDict
}To modify a key in a nested dictionary, include the keys leading to it in the first argument (this is generally accepted with any of the additional routines except dict pull, which requires the use of dict pullFrom to get the same functionality. Reasons for that are given later.
proc myProc {} {
set tempDict [dict create Foo one Bar two Baz three]
dict modify [list tempDict Grill] Foo oneTwo Grill four
puts $tempDict
# -> Foo one Bar two Baz three Grill {Foo oneTwo Grill four}
}dict push, stores the value of the named name in the named dictionary at that same name. A few options are also provided. If the dictionary name contains more than one item the first item is the name of the dictionary and remaining items are a keys to a nested dictionary. If the name of a variable contains two items, the first item is the name of the variable and the second item is the name of the key to store its value in. dict push returns the resulting dictionary.
proc myProc {} {
set Foo one
set Bar two
set Baz three
dict push tempDict Foo Bar Baz
puts $tempdict
# -> Foo one Bar two Baz three
dict push [list tempDict Grill] Foo Bar Baz
puts $empDict
# -> Foo one Bar two Baz three Grill {Foo one Bar two Baz three}
dict push tempDict {Foo _Foo} {Bar _Bar} {Baz _Baz}
puts $tempDict
# -> Foo one Bar two Baz three Grill {Foo one Bar two Baz three} _Foo one _Bar two _Baz three
return [dict push vars Foo Baz]
}
set myDict [myProc]
puts $myDict
# -> Foo one Baz threedict pull, dict pullFrom, and dict destruct provide functionality similar to ES6 Javascript's ability to work with objects such as const { key1, key2 } = myObject.
dict pull and dict pullFrom both try to stay somewhat consistent with the standard way the Tcl handles dictionaries. dict pull accepts the name of a dictionary or the dictionary value itself. dict pullFrom extracts values from a nested dictionary in the named dictionary:
proc myProc {} {
# create a nested dictionary
set tempDict [dict create Foo one Bar two Baz three Grill [dict create Yay value]]
# pull keys from tempDict and assign them to variables having the same name as the key
dict pull tempDict Foo Bar Grill
# this would also work
#dict pull $tempDict Foo Bar Grill
puts $Foo
# -> one
puts $Bar
# -> two
puts $Grill
# ->Yay value
# grab keys from $tempDict and assign them to the given variable names
dict pullFrom tempDict {Foo _Foo} {Bar myVar}
puts $_Foo
# -> one
puts $myVar
# -> two
# extract values from a nested dictionary and assign them to the given
# names, and also "extract" a default value for "RandomKey" for which
# there is no entry
dict pullFrom {tempDict Grill} {Yay nestedVar} RandomKey
puts $nestedVar
# -> value
puts $RandomKey
# -> {}
return [dict pullFrom {tempDict Grill} {Yay finalValue} RandomKey]
}
set myDict [myProc]
set $myDict
# -> finalValue value RandomKey {}'dict destruct' is nearly identical to 'dict pullFrom' except that it also removes any values it grabs from the dictionary. We do not remove the nested keys should they become empty due to a destruct call. Destruct does not return any value.
proc myProc {} {
# Create a nested dictionary to provide an example of operating against a nested dictionary.
set tempDict [dict create Foo one Bar two Baz three Grill [dict create Yay value]]
dict destruct {tempDict Grill} {Yay _yay}
puts $_yay
# -> value
puts $tempDict
# -> Foo one Bar two Baz three Grill {}
dict destruct tempDict Foo
puts $Foo
# -> one
puts $tempDict
# -> Bar two Baz three Grill {}
}proc extend {ens script} {
uplevel 1 [string map [list %ens [list $ens]] {
namespace ensemble configure %ens -unknown [list ::apply [list {ens cmd args} {
::if {$cmd in [::namespace eval ::${ens} {
::info commands}]
} {
::set map [::namespace ensemble configure $ens -map]
::dict set map $cmd ::${ens}::$cmd
::namespace ensemble configure $ens -map $map
}
# back to namespace ensemble dispatch
# which will error appropriately if the cmd doesn't exist
::return {}
} [namespace current]]]
}]\;[list namespace eval $ens $script]
}
extend dict {
proc isDict var {
if {[::catch {::dict size $var}]} {
::return 0
} else {
::return 1
}
}
proc get? {tempDict key args} {
if {[::dict exists $tempDict $key {*}$args]} {
::return [::dict get $tempDict $key {*}$args]
}
}
proc pull {var args} {
::upvar 1 $var check
if {[::info exists check]} {
::set d $check
} else {
::set d $var
}
::foreach v $args {
::set path [::lassign $v variable name default]
::if {$name eq {}} {
::set name $variable
}
::upvar 1 $name value
::if {[::dict exists $d {*}$path $variable]} {
::set value [::dict get $d {*}$path $variable]
} else {
::set value $default
}
::dict set rd $name $value
}
::return $rd
}
proc pullFrom {var args} {
::set mpath [::lassign $var var]
::upvar 1 $var check
::if {[::info exists check]} {
::set d $check
} else {
::set d $var
}
::foreach v $args {
::set path [::lassign $v variable name default]
::if {$name eq {}} {
::set name $variable
}
::upvar 1 $name value
::if {[::dict exists $d {*}$mpath $variable {*}$path]} {
::set value [::dict get $d {*}$mpath $variable {*}$path]
} else {
::set value $default
}
::dict set rd $name $value
}
::return $rd
}
proc modify {var args} {
::upvar 1 $var d
::if {![info exists d]} {
::set d {}
}
::if {[::llength $args] == 1} {
::set args [::lindex $args 0]
}
::dict for {k v} $args {
::dict set d $k $v
}
::return $d
}
proc push {var args} {
::if {$var ne {->}} {
::upvar 1 $var d
}
::if {![::info exists d]} {
::set d {}
}
::foreach arg $args {
::set default [::lassign $arg variable name]
::upvar 1 $variable value
::if {[::info exists value]} {
::if {$name eq {}} {
::set name $variable
}
::if {$value ne {}} {
::dict set d $name $value
} else {
::dict set d $name $default
}
} else {
::throw error "$variable doesn't exist when trying to push $name into dict $var"
}
}
::return $d
}
proc pushIf {var args} {
::if {$var ne {->}} {
::upvar 1 $var d
}
::if {![::info exists d]} {
::set d {}
}
::foreach arg $args {
::set default [::lassign $arg variable name]
::upvar 1 $variable value
::if {![::info exists value]} {
::throw error "$variable doesn't exist when trying to pushIf $name into dict $var"
}
::if {$name eq {}} {
::set name $variable
}
::if {$value ne {}} {
::dict set d $name $value
} elseif {$default ne {}} {
::dict set d $name $default
}
}
::return $d
}
proc pushTo {var args} {
::set mpath [::lassign $var var]
::if {$var ne {->}} {
::upvar 1 $var d
}
::if {! [::info exists d]} {
::set d {}
}
::foreach arg $args {
::set path [::lassign $arg variable name]
::upvar 1 $variable value
::if {![::info exists value]} {
::throw error "$variable doesn't exist when trying to pushTo $name into dict $var at path $path"
}
::if {$name eq {}} {
::set name $variable
}
::dict set d {*}$mpath {*}$path $name $value
}
::return $d
}
proc destruct {var args} {
::set opVar [::lindex $var 0]
::set dArgs [::lrange $var 1 end]
::upvar $opVar theDict
::if {![::info exists theDict]} {
::set theDict {}
}
::set returnDict {}
::foreach val $args {
::lassign $val val nVar def
::if {$nVar eq {}} {
::set nVar $val
}
::upvar $nVar $nVar
::if {$def ne {}} {
::set $nVar [::if? [::dict get? $theDict {*}$dArgs $val] $def]
} else {
::set $nVar [::dict get? $theDict {*}$dArgs $val]
}
::dict set returnDict $nVar [set $nVar]
::catch {::dict unset theDict {*}$dArgs $val}
}
::return $returnDict
}
proc pickIf {var args} {
::return [::dict pick $var {*}$args]
}
proc pick {var args} {
::set tempDict {}
::foreach arg $args {
::lassign $arg key as
::if {[::dict exists $var $key]} {
::if {$as eq {}} {
::set as $key
}
::set v [::dict get $var $key]
::if {$v ne {}} {
::dict set tempDict $as $v
}
}
}
::return $tempDict
}
proc withKey {var key} {
::set tempDict {}
::dict for {k v} $var {
::if {[::dict exists $v $key]} {
::dict set tempDict $k [::dict get $v $key]
}
}
::return $tempDict
}
proc fromlist {lst {values {}}} {
::set tempDict {}
::append tempDict [::join $lst " [list $values] "] " [list $values]"
}
proc sort {what dict args} {
::set res {}
::if {$dict eq {}} ::return
::set dictKeys [::dict keys $dict]
::switch -glob -nocase -- $what {
v* {
::set valuePositions [::dict values $dict]
::foreach value [::lsort {*}$args [::dict values $dict]] {
::set position [::lsearch $valuePositions $value]
::if {$position eq -1} {
::puts "Error for $value"
}
::set key [::lindex $dictKeys $position]
::set dictKeys [::lreplace $dictKeys $position $position]
::set valuePositions [::lreplace $valuePositions $position $position]
::dict set res $key $value
}
}
k* -
default {
::foreach key [::lsort {*}$args $dictKeys] {
::dict set res $key [::dict get $dict $key]
}
}
}
::return $res
}
proc invert {var args} {
::set d {}
::dict for {k v} $var {
::if {"-overwrite" in $args} {
::dict set d $v $k
} else {
::dict lappend d $v $k
}
}
::return $d
}
proc json {json dict {key {}}} {
::upvar 1 $dict convertFrom
::if {![info exists convertFrom] || $convertFrom eq {}} ::return
::set key [::if? $key $dict]
$json map_key $key map_open
::dict for {k v} $convertFrom {
::if {$v eq {} || $k eq {}} ::continue
::if {[::string is entier -strict $v]} {
$json string $k number $v
} elseif {[::string is bool -strict $v]} {
$json string $k bool $v
} else {
$json string $k string $v
}
}
$json map_close
::return
}
proc serialize {json dict} {
::dict for {k v} $dict {
::if {$v eq {} || $k eq {}} ::continue
::if {[::string is entier -strict $v]} {
$json string $k number $v
} elseif {[::string is bool -strict $v]} {
$json string $k bool $v
} else {
$json string $k string $v
}
}
}
proc types tempDict {
::set typeDict {}
::dict for {k v} $tempDict {
::if {[::string is entier -strict $v]} {
::dict set typeDict $k number
} elseif {[::string is bool -strict $v]} {
::dict set typeDict $k bool
} else {
::dict set typeDict $k string
}
}
::return $typeDict
}
}