# Shimmer tracker Module v1.0.3 | 11.04.2026 | CGICoffee.com

# PURPOSE:
#   Maintain Tcl_Obj "Internal Representation" integrity to ensure peak
#   performance in large-scale applications. Tcl uses a dual-ported
#   object system. This code respects that reality.

# USAGE (METHODS):
#   Shimmer enable 1       ; # Global On/Off switch for all calls
#   Shimmer track myVar 0  ; # Start tracking and log type changes to console (Warn Mode)
#   Shimmer track myVar 1  ; # Start tracking and throw an error on type change (Strict Mode)
#   Shimmer release myVar  ; # Stop tracking variable's internal rep changes
#   Shimmer reset          ; # Wipe tracking history (preserves ENABLED state)

# USAGE (EXAMPLE):
# set myData [dict create a 1 b 2] ; # Create a variable of whichever type it must stay in, like 'dict'
# Shimmer track myData             ; # Enable warn mode tracking from this moment on
# dict get $myData a               ; # No alert, since there's no change to the myData variable itself
# set myData [string trim $myData] ; # Shimmer! myData changed from dict to list
# lappend myData "newkey" "newval" ; # Shimmer! myData changed from list to string
# Shimmer release myData           ; # Disable tracking of the variable

# BEST PRACTICES TO AVOID SHIMMERING:
#   1. Use Type-Specific Commands: 
#      Use [dict size $v] or [llength $v] instead of [string length $v]
#   2. Avoid "Poking" with String Ops: 
#      Don't use [regexp], [string match], or [subst] on complex dicts/lists
#   3. Pass by Name for Large Structures: 
#      If a variable is huge, consider passing the name and using [upvar]
#   4. Clean Concatenation: 
#      Use [lappend] or [dict set] rather than 'set var "$var $newitem"'

namespace eval Shimmer {
    namespace export track release reset enable
    namespace ensemble create

    # Internal state - Store the last known type in a namespace variable for comparison
    variable tracker
    # Internal state - Store configuration (like the 'throw' flag) per variable
    variable config
    # Global On/OFF switch - Default to enabled
    set config(ENABLED) 1

    # Public API: Global On/OFF switch
    proc enable {{bool 1}} {
        variable config
        set config(ENABLED) [string is true -strict $bool]
    }

    # Public API: Track a variable for shimmering and ensure memory cleanup
    # If 'throw' not empty, the script will throw a Tcl error instead of using 'puts'
    proc track {name {throw "0"}} {
        variable tracker
        variable config

        if {!$config(ENABLED)} { return }
        
        # Get the scope context for the key to ensure uniqueness
        # By generating unique keys (L0, L1, G), we ensure that if we ever nest procs
        # the inner variable won't overwrite the outer variable's tracking history
        set level [info level]
        set scope_id [expr {$level > 1 ? "L[expr {$level - 1}]" : "G"}]
        set trace_key "${scope_id}::$name"

        # SAFETY CHECK: If this specific variable in this scope is already being tracked,
        # release it first. This prevents Tcl from attaching multiple identical traces.
        if {[info exists config($trace_key)]} {
            uplevel 1 [list [namespace current]::release $name]
        }

        # Capture the current state BEFORE the first trace fires.
        # This ensures that even an immediate overwrite/assignment is caught.
        # We use upvar to look at the variable in the caller's scope.
        upvar 1 $name current_var
        if {[info exists current_var]} {
            set repr [tcl::unsupported::representation $current_var]
            if {![regexp {value is a (.+?)(?: with a refcount|, object pointer)} $repr -> type]} {
                set type "none/string"
            }
            set tracker($trace_key) $type
        }

        # Store the configuration for this specific variable instance
        set config($trace_key) $throw

        # 'uplevel 1' makes the 'trace' command happen in the proc that called 'track'
        # We use [namespace current]::handler to ensure the trace finds the proc regardless of scope
        uplevel 1 [list trace add variable $name {read write unset} [namespace current]::handler]
    }

    # Public API: Stop monitoring a particular variable
    proc release {name} {
        variable tracker
        variable config

        # Reconstruct the same key used during tracking
        set level [info level]
        set scope_id [expr {$level > 1 ? "L[expr {$level - 1}]" : "G"}]
        set trace_key "${scope_id}::$name"

        # Remove the trace from the variable in the caller's scope
        # Trace removal requires the exact same operation list and handler name
        # We use catch because the trace might have already been removed by an 'unset' op
        catch { uplevel 1 [list trace remove variable $name {read write unset} [namespace current]::handler] }

        # Clean up the internal state for this variable to keep memory clean
        unset -nocomplain tracker($trace_key)
        unset -nocomplain config($trace_key)
    }

    # Internal Handler for the trace
    proc handler {varname index op} {
        variable tracker
        variable config

        # If disabled globally, skip processing.
        # Note: The trace still fires, but this is the fastest possible exit.
        if {!$config(ENABLED)} { return }
        
        # Access the variable in the scope where the trace fired
        upvar 1 $varname var

        # Key Generation (Fixed for both Global and Proc scopes)
        # By using scope_id, we ensure that if we have the same variable name in different procs,
        # the tracker won't overwrite the history of one with the other
        set level [info level]
        set scope_id [expr {$level > 1 ? "L[expr {$level - 1}]" : "G"}]
        set trace_key "${scope_id}::$varname"

        # Cleanup on Unset
        if {$op eq "unset"} {
            # Ensure that when the variable goes out of scope, we don't leak memory the tracker
            unset -nocomplain tracker($trace_key)
            unset -nocomplain config($trace_key)
            return
        }

        # Get representation (Check if variable still exists/is defined)
        # This prevents errors if a read trace fires on an uninitialized variable
        if {![info exists var]} { return }

        # Get the current internal representation
        # Tcl objects store the native representation in an internalRep pointer
        # Shimmering occurs when this pointer is re-assigned to a different Tcl_ObjType.
        set repr [tcl::unsupported::representation $var]
        
        # Extrract the type (e.g., "list", "dict", "string")
        if {![regexp {value is a (.+?)(?: with a refcount|, object pointer)} $repr -> type]} {
            set type "none/string"
        }

        # Compare and Alert
        if {[info exists tracker($trace_key)]} {
            set last_type $tracker($trace_key)
            if {$last_type ne $type} {
                set msg "!!! TYPE CHANGE ALERT ($varname): '$last_type' -> '$type'"
                
                # Logic to switch between puts and throw based on user preference
                if {[string is boolean -strict $config($trace_key)] && $config($trace_key)} {
                    # return -code error stops execution entirely, mimicking a compiler error
                    return -code error $msg
                } else {
                    # Default behavior: log to console
                    puts $msg
                }
            }
        }

        # Store the current type for the next comparison
        set tracker($trace_key) $type
    }

    # Helper to clear all currently tracked data if needed
    proc reset {} { 
        variable tracker
        variable config
        set enabled $config(ENABLED)
        # Array unset only takes one array name at a time
        array unset tracker *
        array unset config *
        set config(ENABLED) $enabled
    }
}