jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

pdict fixes

master
Julian Noble 5 months ago
parent
25ed96003c
commit
ad3ca5b9a9
2 changed files with 393 additions and 224 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 53
      src/modules/punk-0.1.tm
  2. 390
      src/modules/punk/lib-999999.0a1.0.tm

53
src/modules/punk-0.1.tm
Unescape View File

@ -513,7 +513,12 @@ namespace eval punk {
}
set varlist [list]
set var_terminals [list "@" "/" "#" "!" ">" "<"] ;# (> required for insertionspecs at rhs of = & .= )
# @ @@ - list and dict functions
# / level separator
# # list count, ## dict size
# % string functions
# ! not
set var_terminals [list "@" "/" "#" "%" "!" ">" "<"] ;# (> required for insertionspecs at rhs of = & .= )
#except when prefixed directly by pin classifier ^
set protect_terminals [list "^"] ;# e.g sequence ^#
#also - an atom usually doesn't need the / as a terminal - because it can't match a missing element unless it's empty string
@ -1228,7 +1233,7 @@ namespace eval punk {
set tpl_return_mismatch_not_a_list {return [dict create -assigned $leveldata -action ?mismatch-not-a-list -lhs $lhs -rhs xxx -index_operations {${$INDEX_OPERATIONS}}]}
set tpl_return_mismatch_list_index_out_of_range {return [dict create -assigned $leveldata -action ?mismatch-list-index-out-of-range -lhs $lhs -rhs xxx -index_operations {${$INDEX_OPERATIONS}}]}
set tpl_return_mismatch_list_index_out_of_range_empty {return [dict create -assigned $leveldata -action ?mismatch-list-index-out-of-range-empty -lhs $lhs -rhs xxx -index_operations {${$INDEX_OPERATIONS}}]}
set tpl_return_mismatch_not_a_dict {return [dict create -assigned $leveldata -action ?mismatch-not-a-dict - -lhs $lhs -rhs xxx -index_operations {${$INDEX_OPERATIONS}}]}
set tpl_return_mismatch_not_a_dict {return [dict create -assigned $leveldata -action ?mismatch-not-a-dict -lhs $lhs -rhs xxx -index_operations {${$INDEX_OPERATIONS}}]}
#dict 'index' when using stateful @@ etc to iterate over dict instead of by key
set tpl_return_mismatch_dict_index_out_of_range {return [dict create -assigned $leveldata -action ?mismatch-dict-index-out-of-range -lhs $lhs -rhs xxx -index_operations {${$INDEX_OPERATIONS}}]}
set tpl_return_mismatch_dict_key_not_found {return [dict create -assigned $leveldata -action ?mismatch-dict-key-not-found -lhs $lhs -rhs xxx -index_operations {${$INDEX_OPERATIONS}}]}
@ -1379,12 +1384,13 @@ namespace eval punk {
}
set level_script_complete 1
}
#? {
%# {
set active_key_type "string"
if $get_not {
error "!#? not string length is not supported"
error "!%# not string length is not supported"
}
#string length - REVIEW -
set index_operation string-length
lappend INDEX_OPERATIONS string-length
append script \n {# set active_key_type "" index_operation: string-length}
append script \n {set assigned [string length $leveldata]}
set level_script_complete 1
@ -1964,6 +1970,15 @@ namespace eval punk {
set index <idx>
}]
}
%* {
set active_key_type "string"
set do_bounds_check 0
set index [string range $index 1 end]
append script \n [string map [list <idx> $index] {
# set active_key_type "string" index_operation: ?
set index <idx>
}]
}
default {
puts "destructure_func_build_body unmatched index $index"
}
@ -2496,6 +2511,34 @@ namespace eval punk {
}
}
}
} elseif {$active_key_type eq "string"} {
if {[string match *-* $index]} {
lappend INDEX_OPERATIONS string-range
set re_idxdashidx {^([-+]{0,1}\d+|end[-+]{1}\d+|end)-([-+]{0,1}\d+|end[-+]{1}\d+|end)$}
#todo - support more complex indices: 0-end-1 etc
lassign [split $index -] a b
append script \n [tstr -return string -allowcommands {
# set active_key_type "string"
set assigned [string range $leveldata ${$a} ${$b}]
}]
} else {
if {$index eq "*"} {
lappend INDEX_OPERATIONS string-all
append script \n [tstr -return string -allowcommands {
# set active_key_type "string"
set assigned $leveldata
}]
} else {
lappend INDEX_OPERATIONS string-index
append script \n [tstr -return string -allowcommands {
# set active_key_type "string"
set assigned [string index $leveldata ${$index}]
}]
}
}
} else {
#treat as dict key
if {$get_not} {

390
src/modules/punk/lib-999999.0a1.0.tm
Unescape View File

@ -402,11 +402,13 @@ namespace eval punk::lib {
proc tstr {args} {
set argd [punk::args::get_dict {
*proc -name punk::lib::tstr -help "A rough equivalent of js template literals"
-allowcommands -default 0 -type none
-allowcommands -default 0 -type none -help "if -allowcommands is true placeholder can contain commands e.g {${plaintext1 [lindex $var 0] plaintext2}}"
-return -default list -choices {dict list string}
*values -min 1 -max 1
templatestring -help "This argument should be a braced string containing placeholders such as ${$var}
where $var will be substituted from the calling context"
templatestring -help "This argument should be a braced string containing placeholders such as ${$var} e.g {The value is ${$var}}
where $var will be substituted from the calling context
The placeholder itself can contain plaintext portions as well as variables.
It can contain commands in square brackets if -allowcommands is true"
} $args]
set templatestring [dict get $argd values templatestring]
set opt_allowcommands [dict get $argd opts -allowcommands]
@ -600,7 +602,10 @@ namespace eval punk::lib {
set isarray [uplevel 1 [list array exists $dvar]]
if {$isarray} {
set dvalue [uplevel 1 [list array get $dvar]]
dict set opts -keytemplates [list ${dvar}(%k%)]
if {![dict exists $opts -keytemplates]} {
set arrdisplay [string map [list %dvar% $dvar] {${[if {[lindex $key 1] eq "query"} {val "%dvar% [lindex $key 0]"} {val "%dvar%($key)"}]}}]
dict set opts -keytemplates [list $arrdisplay]
}
dict set opts -keysorttype dictionary
} else {
set dvalue [uplevel 1 [list set $dvar]]
@ -627,11 +632,11 @@ namespace eval punk::lib {
This can help prevent a single long line that wraps in terminal from making every line wrap due to long rhs padding
"
-separator -default "%sep%" -help "Separator column between keys and values"
-roottype -default "" -help "list,dict,string"
-roottype -default "dict" -help "list,dict,string"
-substructure -default {}
-ansibase_keys -default "" -help "ansi list for each level in -substructure. e.g \[list \[a+ red\] \[a+ web-green\]\]"
-ansibase_values -default ""
-keytemplates -default {%k%} -type list -help "list of templates for keys at each level"
-keytemplates -default {${$key}} -type list -help "list of templates for keys at each level"
-keysorttype -default "none" -choices {none dictionary ascii integer real}
-keysortdirection -default increasing -choices {increasing decreasing}
*values -min 1 -max -1
@ -656,31 +661,136 @@ namespace eval punk::lib {
set pattern_key_index [list] ;#list of pattern_nests, same length as number of keys generated
set pattern_next_substructure [dict create]
set pattern_this_structure [dict create]
set filtered_keys [list]
if {$opt_roottype eq "list"} {
#puts "getting keys for list"
if {$opt_roottype in {dict list string}} {
#puts "getting keys for roottype:$opt_roottype"
if {[llength $dval]} {
set re_numdashnum {^([-+]{0,1}\d+)-([-+]{0,1}\d+)$}
set re_idxdashidx {^([-+]{0,1}\d+|end[-+]{1}\d+|end)-([-+]{0,1}\d+|end[-+]{1}\d+|end)$}
foreach pattern_nest $patterns {
set keyset [list]
set pattern_nest_list [split $patterns /]
set pattern_nest_list [split $pattern_nest /]
set p [lindex $pattern_nest_list 0]
if {$p eq ""} {
continue
}
if {$p eq "*"} {
switch -exact -- $p {
* - "" {
if {$opt_roottype eq "list"} {
lappend keyset {*}[punk::lib::range 0 [llength $dval]-1] ;#compat wrapper around subset of lseq functionality
dict set pattern_this_structure $pattern_nest list
} elseif {$opt_roottype eq "dict"} {
lappend keyset {*}[dict keys $dval]
dict set pattern_this_structure $pattern_nest dict
} else {
lappend keyset %string
dict set pattern_this_structure $pattern_nest string
}
}
%# {
dict set pattern_this_structure $pattern_nest string
lappend keyset %#
}
# {
dict set pattern_this_structure $pattern_nest list
lappend keyset #
}
## {
dict set pattern_this_structure $pattern_nest dict
lappend keyset ##
}
@* {
dict set pattern_this_structure $pattern_nest list
lappend keyset {*}[punk::lib::range 0 [llength $dval]-1]
}
@*k@* - @*K@* {
#returns keys only
lappend keyset [list $p query]
dict set pattern_this_structure $pattern_nest dict
}
@*.@* {
lappend keyset {*}[dict keys $dval]
dict set pattern_this_structure $pattern_nest dict
}
default {
#puts stderr "===p:$p"
switch -glob -- $p {
{@k\*@*} - {@K\*@*} {
#value glob return keys
#set search [string range $p 4 end]
#dict for {k v} $dval {
# if {[string match $search $v]} {
# lappend keyset $k
# }
#}
lappend keyset [list $p query]
dict set pattern_this_structure $pattern_nest dict
}
@@* {
#exact match key - review - should raise error to match punk pipe behaviour?
set k [string range $p 2 end]
if {[dict exists $dval $k]} {
lappend keyset $k
}
dict set pattern_this_structure $pattern_nest dict
}
@k@* - @K@* {
set k [string range $p 3 end]
if {[dict exists $dval $k]} {
lappend keyset $k
}
dict set pattern_this_structure $pattern_nest dict
}
{@\*@*} {
#return list of values
#set k [string range $p 3 end]
#lappend keyset {*}[dict keys $dval $k]
lappend keyset [list $p query]
dict set pattern_this_structure $pattern_nest dict
}
{@\*.@*} {
set k [string range $p 4 end]
lappend keyset {*}[dict keys $dval $k]
dict set pattern_this_structure $pattern_nest dict
}
{@v\*@*} - {@V\*@*} {
#value-glob return value
#error "dict value-glob value-return only not supported here - bad pattern '$p' in '$pattern_nest'"
lappend keyset [list $p query]
dict set pattern_this_structure $pattern_nest dict
}
{@\*v@*} - {@\*V@*} {
#key-glob return value
lappend keyset [list $p query]
dict set pattern_this_structure $pattern_nest dict
}
{@\*@*} - {@\*v@*} - {@\*V@} {
#key glob return val
lappend keyset [list $p query]
dict set pattern_this_structure $pattern_nest dict
}
@??@* {
#exact key match - no error
lappend keyset [list $p query]
dict set pattern_this_structure $pattern_nest dict
}
default {
set this_type $opt_roottype
if {[string match @* $p]} {
#already in list mode - trim optional list specifier @
#list mode - trim optional list specifier @
set p [string range $p 1 end]
dict set pattern_this_structure $pattern_nest list
set this_type list
} elseif {[string match %* $p]} {
dict set pattern_this_structure $pattern_nest string
lappend keyset $p
set this_type string
}
if {$this_type eq "list"} {
dict set pattern_this_structure $pattern_nest list
if {[string is integer -strict $p]} {
lappend keyset $p
} elseif {[string match "?*-?*" $p]} {
#could be either - don't change type
#list indices with tcl8.7 underscores? be careful. Before 8.7 we could have used regexp \d on integers
#now we should map _ to "" first
set p [string map {_ {}} $p]
@ -714,121 +824,93 @@ namespace eval punk::lib {
}
#note lower can legitimately be higher than upper - lib::range, like lseq can produce sequence in reverse order
lappend keyset {*}[punk::lib::range $lower $upper]
} else {
lappend keyset [list @$p query]
}
} elseif {$this_type eq "string"} {
dict set pattern_this_structure $pattern_nest string
} elseif {$this_type eq "dict"} {
#default equivalent to @\*@*
dict set pattern_this_structure $pattern_nest dict
puts "dict: appending keys from index '$p' keys: [dict keys $dval $p]"
lappend keyset {*}[dict keys $dval $p]
} else {
puts stderr "list: unrecognised pattern $p"
}
}
}
}
}
# -- --- --- ---
#check next pattern for substructure type to use
# -- --- --- ---
set substructure ""
set pnext [lindex $pattern_nest_list 1]
if {$pnext in [list "@*k@*" "@*K@*" "@*.@*" *]} {
switch -exact $pnext {
"" {
set substructure string
}
@*k@* - @*K@* - @*.@* - ## {
set substructure dict
} elseif {[string match "@??@*" $pnext] || [string match "@?@*" $pnext]} {
}
# {
set substructure list
}
%# {
set substructure string
}
* {
#set substructure $opt_roottype
set substructure [dict get $pattern_this_structure $pattern_nest]
}
default {
switch -glob -- $pnext {
@??@* - @?@* - @@* {
#all 4 or 3 len prefixes bounded by @ are dict
set substructure dict
} elseif {[string match @@* $pnext]} {
set substructure dict
} elseif {[string match @* $pnext]} {
#if we've ruled out all explicit dict patterns - @* is list
}
default {
if {[string match @* $pnext]} {
set substructure list
} elseif {$pnext eq ""} {
set substructure "string"
} elseif {[string match %* $pnext]} {
set substructure string
} else {
#plain keys are now dict because there was no list-type pattern to flip the structure type
set substructure dict
#set substructure $opt_roottype
set substructure [dict get $pattern_this_structure $pattern_nest]
}
}
}
}
}
#puts "--pattern_nest: $pattern_nest substructure: $substructure"
dict set pattern_next_substructure $pattern_nest $substructure
# -- --- --- ---
lappend filtered_keys {*}$keyset
set int_keyset 1
foreach k $keyset {
lappend pattern_key_index $pattern_nest
}
if {![string is integer -strict $k]} {
set int_keyset 0
break
}
}
#puts stderr "list keys: $filtered_keys"
} elseif {$opt_roottype eq "dict"} {
foreach pattern_nest $patterns {
set keyset [list]
set pattern_nest_list [split $pattern_nest /]
set p [lindex $pattern_nest_list 0]
if {$p in [list "@*k@*" "@*K@*" "@*.@*" *]} {
#exact glob-for-all
lappend keyset {*}[dict keys $dval]
} elseif {[string match @@* $p]} {
set k [string range $p 2 end]
lappend keyset {*}[dict keys $dval $k]
} elseif {[string match -nocase {@k\*@*}]} {
set k [string range $p 4 end]
lappend keyset {*}[dict keys $dval $k]
} elseif {[string match {@\*@*} $p]} {
set k [string range $p 3 end]
lappend keyset {*}[dict keys $dval $k]
} elseif {[string match -nocase {@v\*@*} $p] || [string match -nocase {@\*v@*} $p]} {
#don't match @v.@
error "dict value-return only not supported here - bad pattern '$p' in '$pattern_nest'"
if {$int_keyset} {
set keyset [lsort -integer $keyset]
} else {
lappend keyset {*}[dict keys $dval $p]
set keyset [lsort -dictionary $keyset]
}
# -- --- --- ---
#check next pattern for substructure type to use
# -- --- --- ---
set substructure ""
set pnext [lindex $pattern_nest_list 1]
if {$pnext in [list "@*k@*" "@*K@*" "@*.@*" *]} {
set substructure dict
} elseif {[string match "@??@*" $pnext] || [string match "@?@*" $pnext]} {
#all 4 or 3 len prefixes bounded by @ are dict
set substructure dict
} elseif {[string match @@* $pnext]} {
set substructure dict
} elseif {[string match @* $pnext]} {
#if we've ruled out all explicit dict patterns - @* is list
set substructure list
} elseif {$pnext eq ""} {
set substructure "string"
} else {
#plain keys are now dict because there was no list-type pattern to flip the structure type
set substructure dict
foreach k $keyset {
lappend pattern_key_index $pattern_nest
}
#puts "--pattern_nest: $pattern_nest substructure: $substructure"
dict set pattern_next_substructure $pattern_nest $substructure
# -- --- --- ---
#puts stderr "adding [llength $keyset] keys for pattern_nest: $pattern_nest"
#sort only within each pattern for now
if {$opt_keysorttype ne "none"} {
set keyset [lsort -$opt_keysorttype -$opt_keysortdirection $keyset]
}
lappend filtered_keys {*}$keyset
foreach k $keyset {
lappend pattern_key_index $pattern_nest
#puts stderr "--->pattern_nest:$pattern_nest keyset:$keyset"
}
}
#todo - fix. sorting keys wrecks pattern_key_index
#if {$opt_keysorttype eq "none"} {
# #we can only get duplicate keys if there are multiple patterns supplied
# #ignore keysortdirection - doesn't apply
# if {[llength $patterns] > 1} {
# #order-maintaining (order of keys as they appear in dict)
# set filtered_keys [punk::lib::lunique $filtered_keys]
# }
#} else {
# set filtered_keys [lsort -unique -$opt_keysorttype -$opt_keysortdirection $filtered_keys]
#}
#puts stderr "[dict get $pattern_this_structure $pattern_nest] keys: $filtered_keys"
} else {
#string
puts stdout "xxxx string"
puts stdout "unrecognised roottype: $opt_roottype"
return $dval
}
@ -845,42 +927,44 @@ namespace eval punk::lib {
set kt [lindex $opt_keytemplates 0]
if {$kt eq ""} {
set kt "%k%"
set kt {${$key}}
}
set display_keys [lmap k $filtered_keys {tcl::string::map [list %k% $k] $kt}]
#set display_keys [lmap k $filtered_keys {tcl::string::map [list %k% $k] $kt}]
set display_keys [lmap key $filtered_keys {tstr -ret string -allowcommands $kt}]
set maxl [::tcl::mathfunc::max {*}[lmap v $display_keys {textblock::width $v}]]
set kidx 0
foreach keydisplay $display_keys key $filtered_keys {
if {$opt_roottype eq "list"} {
set thisval [lindex $dval $key]
} else {
#todo - slower lsearch if -dupes 1 flag set so we can display duplicate 'keys' if var not a proper dict but rather a dict-shaped list that we want to display as a dict
set pattern_nest [lindex $pattern_key_index $kidx]
set pattern_nest_list [split $pattern_nest /]
#puts stderr "---> kidx:$kidx key:$key - pattern_nest:$pattern_nest"
set this_type [dict get $pattern_this_structure $pattern_nest]
switch -- $this_type {
dict {
#todo? - slower lsearch if -dupes 1 flag set so we can display duplicate 'keys' if var not a proper dict but rather a dict-shaped list that we want to display as a dict
# - default highlight dupes (ansi underline?)
if {[lindex $key 1] eq "query"} {
set qry [lindex $key 0]
% thisval.= $qry= $dval
} else {
set thisval [tcl::dict::get $dval $key]
}
if {$opt_roottype eq "dict"} {
#set substructure [lrange $opt_structure 1 end]
set nextpatterns [list]
set pattern_nest [lindex $pattern_key_index $kidx]
set nextsub [dict get $pattern_next_substructure $pattern_nest]
#which pattern nest applies to this branch
set pattern_nest_list [split $pattern_nest /]
set nextsub [dict get $pattern_next_substructure $pattern_nest]
if {[llength $pattern_nest_list]} {
set tail [lassign $pattern_nest_list parent]
set nest $tail
#if {![llength $tail]} {
# set nest *
#}
set nest [lrange $pattern_nest_list 1 end]
lappend nextpatterns [join $nest /]
}
#puts "k:$key dict nextpatterns: $nextpatterns"
set nextopts [dict get $argd opts]
set subansibasekeys [lrange $opt_ansibase_keys 1 end]
set nextkeytemplates [lrange $opt_keytemplates 1 end]
set nextopts [dict get $argd opts]
#dict set nextopts -substructure $nextsub
dict set nextopts -keytemplates $nextkeytemplates
dict set nextopts -ansibase_keys $subansibasekeys
@ -888,40 +972,80 @@ namespace eval punk::lib {
dict set nextopts -channel none
#puts stderr "showdict {*}$nextopts $thisval [lindex $args end]"
if {[llength $nextpatterns] && $nextsub ne "string"} {
if {[llength $nextpatterns]} {
set thisval [showdict {*}$nextopts -- $thisval {*}$nextpatterns]
}
} elseif {$opt_roottype eq "list"} {
}
list {
if {[string is integer -strict $key]} {
set thisval [lindex $dval $key]
} else {
if {[lindex $key 1] eq "query"} {
set qry [lindex $key 0]
} else {
set qry $key
}
% thisval.= $qry= $dval
}
set nextpatterns [list]
set pattern_nest [lindex $pattern_key_index $kidx]
#which pattern nest applies to this branch
set nextsub [dict get $pattern_next_substructure $pattern_nest]
set pattern_nest_list [split $pattern_nest /]
if {[llength $pattern_nest_list]} {
set nest [lrange $pattern_nest_list 1 end]
if {![llength $nest]} {
set nest *
}
lappend nextpatterns [join $nest /]
}
#puts "list nextpattern: $nextpatterns"
set nextopts [dict get $argd opts]
#dict set nextopts -substructure $substructure
dict set nextopts -channel none
dict set nextopts -roottype $nextsub
dict set nextopts -channel none
#if {![llength $nextpatterns]} {
# set nextpatterns *
#}
if {[llength $nextpatterns]} {
set thisval [showdict {*}$nextopts -- $thisval {*}$nextpatterns]
}
}
string {
if {$key eq "%string"} {
set thisval $dval
} else {
if {[lindex $key 1] eq "query"} {
set qry [lindex $key 0]
} else {
set qry $key
}
set thisval $dval
if {[string index $key 0] ne "%"} {
set key %$key
}
% thisval.= $key= $thisval
}
if {![llength $nextpatterns]} {
set nextpatterns *
set nextpatterns [list]
#which pattern nest applies to this branch
set nextsub [dict get $pattern_next_substructure $pattern_nest]
if {[llength $pattern_nest_list]} {
set nest [lrange $pattern_nest_list 1 end]
lappend nextpatterns [join $nest /]
}
if {[llength $nextpatterns] && $nextsub ne "string"} {
#set nextopts [dict get $argd opts]
dict set nextopts -roottype $nextsub
dict set nextopts -channel none
if {[llength $nextpatterns]} {
set thisval [showdict {*}$nextopts -- $thisval {*}$nextpatterns]
}
}
}
if {$this_type eq "string" && $key eq "%string"} {
lassign [textblock::size $thisval] _vw vwidth _vh vheight
#set blanks_above [string repeat \n [expr {$kheight -1}]]
set vblock $opt_ansibase_values$thisval$RST
append result [textblock::join_basic -- $vblock] \n
} else {
set ansibase_key [lindex $opt_ansibase_keys 0]
lassign [textblock::size $keydisplay] _kw kwidth _kh kheight
@ -936,10 +1060,12 @@ namespace eval punk::lib {
set vblock $blanks_above$opt_ansibase_values$thisval$RST
#only vblock is ragged - we can do a basic join because we don't care about rhs whitespace
append result [textblock::join_basic -- $kblock $sblock $vblock] \n
}
incr kidx
}
}
"sidebyside" {
#todo
#This is nice for multiline keys and values of reasonable length, will produce unintuitive results when line-wrapping occurs.
#use ansibase_key etc to make the output more comprehensible in that situation.
#This is why it is not the default. (review - terminal width detection and wrapping?)

Write Preview
Loading…
Cancel
Save