# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2023
#
# @@ Meta Begin
# Application dictn 0.1.2
# Meta platform     tcl
# Meta license      <unspecified>
# @@ Meta End



# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
##  Requirements
##e.g package require frobz




# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval dictn {
    namespace export {[a-z]*}
    namespace ensemble create
}


## ::dictn::append
#This can of course 'ruin' a nested dict if applied to the wrong element 
# - i.e using the string op 'append' on an element that is itself a nested dict is analogous to the standard Tcl:
#     %set list {a b {c d}}
#     %append list x
#     a b {c d}x
#  IOW - don't do that unless you really know that's what you want.
#
proc ::dictn::append {dictvar path {value {}}} {
    if {[llength $path] == 1} {
        uplevel 1 [list dict append $dictvar $path $value]
    } else {
        upvar 1 $dictvar dvar

        ::set str [dict get $dvar {*}$path]
        append str $val 
        dict set dvar {*}$path $str
    }
}

proc ::dictn::create {args} {
    ::set data {}    
    foreach {path val} $args {
            dict set data {*}$path $val
    }
    return $data
}

proc ::dictn::exists {dictval path} {
    return [dict exists $dictval {*}$path]
}

proc ::dictn::filter {dictval path filterType args} {
    ::set sub [dict get $dictval {*}$path]
    dict filter $sub $filterType {*}$args
}

proc ::dictn::for {keyvalvars dictval path body} {
    ::set sub [dict get $dictval {*}$path]
    dict for $keyvalvars $sub $body
}

proc ::dictn::get {dictval {path {}}} {
    return [dict get $dictval {*}$path]
}


if {[info commands ::tcl::dict::getdef] ne ""} {
    #tcl 9+
    proc ::dictn::getdef {dictval path default} {
        return [dict getdef $dictval {*}$path $default]
    }

    proc ::dictn::getwithdefault {dictval path default} {
        return [dict getdef $dictval {*}$path $default]
    }

    proc ::dictn::incr {dictvar path {increment {}} } {
        if {$increment eq ""} {
            ::set increment 1
        }
        if {[llength $path] == 1} {
            uplevel 1 [list dict incr $dictvar $path $increment]
        } else {
            upvar 1 $dictvar dvar
            if {![::info exists dvar]} {
                dict set dvar {*}$path $increment
            } else {
                ::set newval [expr {[dict getdef $dvar {*}$path 0] + $increment}]
                dict set dvar {*}$path $newval
            }
            return $dvar
        }
    }
} else {
    #tcl < 9
    proc ::dictn::getdef {dictval path default} {
        if {[tcl::dict::exists $dictval {*}$path]} {
            return [tcl::dict::get $dictval {*}$path]
        } else {
            return $default 
        }
    }
    proc ::dictn::getwithdefault {dictval path default} {
        if {[tcl::dict::exists $dictval {*}$path]} {
            return [tcl::dict::get $dictval {*}$path]
        } else {
            return $default 
        }
    }
    proc ::dictn::incr {dictvar path {increment {}} } {
        if {$increment eq ""} {
            ::set increment 1
        }
        if {[llength $path] == 1} {
            uplevel 1 [list dict incr $dictvar $path $increment]
        } else {
            upvar 1 $dictvar dvar
            if {![::info exists dvar]} {
                dict set dvar {*}$path $increment
            } else {
                if {![dict exists $dvar {*}$path]} {
                    ::set val 0
                } else {
                    ::set val [dict get $dvar {*}$path]
                }
                ::set newval [expr {$val + $increment}]
                dict set dvar {*}$path $newval
            }
            return $dvar
        }
    }
}

proc ::dictn::info {dictval {path {}}} {
    if {![string length $path]} {
        return [dict info $dictval]
    } else {
        ::set sub [dict get $dictval {*}$path]
        return [dict info $sub]
    }
}

proc ::dictn::keys {dictval {path {}} {glob {}}} {
    ::set sub [dict get $dictval {*}$path]
    if {[string length $glob]} {
        return [dict keys $sub $glob]
    } else {
        return [dict keys $sub]
    }
}

proc ::dictn::lappend {dictvar path args} {
    if {[llength $path] == 1} {
        uplevel 1 [list dict lappend $dictvar $path {*}$args]
    } else {
        upvar 1 $dictvar dvar

        ::set list [dict get $dvar {*}$path]
        ::lappend list {*}$args
        dict set dvar {*}$path $list
    }
}

proc ::dictn::merge {args} {
    error "nested merge not yet supported"
}

#dictn remove dictionaryValue ?path ...?
proc ::dictn::remove {dictval args} {
    ::set basic [list] ;#buffer basic (1element path) removals to do in a single call.

    foreach path $args {
        if {[llength $path] == 1} {
            ::lappend basic $path
        } else {
            #extract,modify,replace
            ::set subpath [lrange $path 0 end-1]

            ::set sub [dict get $dictval {*}$subpath]
            ::set sub [dict remove $sub [lindex $path end]]

            dict set dictval {*}$subpath $sub
        }
    }

    if {[llength $basic]} {
        return [dict remove $dictval {*}$basic]
    } else {
        return $dictval
    }
}


proc ::dictn::replace {dictval args} {
    ::set basic [list] ;#buffer basic (1element path) replacements to do in a single call.

    foreach {path val} $args {
        if {[llength $path] == 1} {
            ::lappend basic $path $val
        } else {
            #extract,modify,replace
            ::set subpath [lrange $path 0 end-1]

            ::set sub [dict get $dictval {*}$subpath]
            ::set sub [dict replace $sub [lindex $path end] $val]

            dict set dictval {*}$subpath $sub                        
        }
    }


    if {[llength $basic]} {
        return [dict replace $dictval {*}$basic]
    } else {
        return $dictval
    }
}


proc ::dictn::set {dictvar path newval} {
    upvar 1 $dictvar dvar
    return [dict set dvar {*}$path $newval]
}

proc ::dictn::size {dictval {path {}}} {
    return [dict size [dict get $dictval {*}$path]]
}

proc ::dictn::unset {dictvar path} {
    upvar 1 $dictvar dvar
    return [dict unset dvar {*}$path    
}

proc ::dictn::update {dictvar args} {
    ::set body [lindex $args end]
    ::set maplist [lrange $args 0 end-1]

    upvar 1 $dictvar dvar
    foreach {path var} $maplist {
        if {[dict exists $dvar {*}$path]} {
            uplevel 1 [list set $var [dict get $dvar $path]]
        }
    }

    catch {uplevel 1 $body} result
    
    foreach {path var} $maplist {
        if {[dict exists $dvar {*}$path]} {
            upvar 1 $var $var
            if {![::info exists $var]} {
                uplevel 1 [list dict unset $dictvar {*}$path]
            } else {
                uplevel 1 [list dict set $dictvar {*}$path [::set $var]]
            }
        }        
    }
    return $result
}

#an experiment.
proc ::dictn::Applyupdate {dictvar args} {
    ::set body [lindex $args end]
    ::set maplist [lrange $args 0 end-1]

    upvar 1 $dictvar dvar

    ::set headscript ""
    ::set i 0
    foreach {path var} $maplist {
        if {[dict exists $dvar {*}$path]} {
            #uplevel 1 [list set $var [dict get $dvar $path]]
            ::lappend arglist $var 
            ::lappend vallist [dict get $dvar {*}$path]
            ::append headscript [string map [list %i% $i %v% $var] {upvar 1 %v% %v%; set %v% [lindex $args %i%]} ]
            ::append headscript \n
            ::incr i
        }
    }

    ::set body $headscript\r\n$body

    puts stderr "BODY: $body"
    
    #set result [apply [list args $body] {*}$vallist]
    catch {apply [list args $body] {*}$vallist} result

    foreach {path var} $maplist {
        if {[dict exists $dvar {*}$path] && [::info exists $var]} {
            dict set dvar {*}$path [::set $var]
        }        
    }
    return $result
}

proc ::dictn::values {dictval {path {}} {glob {}}} {
    ::set sub [dict get $dictval {*}$path]
    if {[string length $glob]} {
        return [dict values $sub $glob]
    } else {
        return [dict values $sub]
    }
}

# Standard form:
#'dictn with dictVariable path body'  
#
# Extended form:
#'dictn with dictVariable path arrayVariable body' 
#
proc ::dictn::with {dictvar path args} {
    if {[llength $args] == 1} {
        ::set body [lindex $args 0]
        return [uplevel 1 [list dict with $dictvar {*}$path $body]]
    } else {
        upvar 1 $dictvar dvar
        ::lassign $args arrayname body

        upvar 1 $arrayname arr
        array set arr [dict get $dvar {*}$path]
        ::set prevkeys [array names arr]

        catch {uplevel 1 $body} result


        foreach k $prevkeys {
            if {![::info exists arr($k)]} {
                dict unset $dvar {*}$path $k
            }
        }
        foreach k [array names arr] {
            dict set $dvar {*}$path $k $arr($k)
        }

        return $result
    }   
}












# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
##  Ready   
package provide dictn [namespace eval dictn {
    variable version
    ::set version 0.1.2 
}]
return