# ReacTcl - Reactive Programming Infrastructure for Tcl

# See https://en.wikipedia.org/wiki/Reactive_programming - here we use
# invalidity notification propagation and a dynamic dependency graph.

# clean up in case we are reloading
catch {Reactive destroy; Reactive.Delegate destroy}
catch {ReactiveMap destroy; ReactiveMap.Delegate destroy}

# In Tcl8.7 reactcl_target can become a classvariable in Reactive
set reactcl_target {}

# A Reactive object represents a variable which can either be set to a
# specific value or computed from other Reactive objects.  Such computed
# values are memoized and their dependencies on other Reactive values are
# automatically tracked so that these computations are re-run only when
# changes to their inputs have invalidated the currently memoized output
# value.

oo::class create Reactive {

variable value script ret_code ret_opts version targets_vers
variable traced_var driven_vars

constructor args {

    set value {}
    set script {}; # run this to (re)calculate value when required.
    set ret_code {}; # return code from running script,
                     # or empty when value is unknown,
                     # or code 4 used to detect circular dependencies.
    set ret_opts {}; # return-options from running script.
    set version 0; # incremented when previous value becomes invalid.
    set targets_vers [dict create]; # record the Reactive objects whose
                # values were computed from this one, and their versions.
    set traced_var {}; # when tracking a variable this holds its
                       # fully qualified name.
    set driven_vars [dict create]; # set of variables which we keep
                # updated with our value; having this non-empty
                # forces eager, not lazy, recomputation.

    # Support appending the definition to the creation of the object:
    if {[llength $args]} {tailcall [self] {*}$args}
}

destructor {
    my untrace
}

method == val {
    my unset
    set value $val
    set ret_code 0
    set ret_opts {}
}

method unset {} {
    my := {}
}

method := code {
    my untrace
    set script $code
    my invalidate
    return [self]
}

method = expr {
    my := [list expr $expr]
}

method get {} {
    global reactcl_target

    set prev_target $reactcl_target
    set reactcl_target [list [self] $version]

    try {
        # Do sanity check and (re)calculate if needed
        switch $ret_code {
            {} {if {$script eq {}} {error "[self] is unset."}
                set ret_code 4; # For cycle check

                # Evaluate the script, catching errors
                set ret_code [catch $script value ret_opts]
               }
            4  {error "[self]: Circular dependency"}
        }
    } finally {
        # Record the target value (if any) that we are contributing to
        set reactcl_target $prev_target
        foreach {target ver} $reactcl_target {
            dict set targets_vers $target $ver
        }
    }

    if {$ret_code == 1} {return -options $ret_opts $value }
    return $value
}

method valid {} {
    return [expr {$ret_code == 0}]
}

method invalidate {} {
    set ret_code {}
    set ret_opts {}
    set value {}
    incr version
    dict for {target ver} $targets_vers  {
        $target invalidate_target $ver
    }
    set targets_vers {}

    # If we are driving any variables, schedule their update
    if {[dict size $driven_vars]} {after idle [self] drive_vars}
}

method invalidate_target ver {
    if {$ver == $version && $ret_code ne {}} {
        my invalidate
    }
}

# Show internal state for debugging
method show {} {
    return "[self] value='$value' script='$script' ret_code='$ret_code' ret_opts='$ret_opts' version='$version' targets_vers='$targets_vers' traced_var='$traced_var' driven_vars='$driven_vars'"
}

# Hack so we can call with no arguments to get the value
method unknown {} {
    return [my get]
}

# Derive our value from a traced variable
method <= var_name {
    my unset
    uplevel [list trace add variable $var_name {write unset} [list [self] var_trace]]
    set traced_var [uplevel namespace which -variable $var_name]

    if {[info exists $traced_var]} {
        set value [set $traced_var]
        set ret_code 0
    }
}

method untrace {} {
    if {$traced_var ne {}} {
        trace remove variable $traced_var {write unset} [list [self] var_trace]
        set traced_var {}
    }
}

method var_trace {n1 n2 op} {
    switch $op {
        write {
            my invalidate
            set value [set $traced_var]
            set ret_code 0
        }
        unset {
            my unset
        }
    }
}

# Drive a Tcl variable from our value
method => var_name {
    if {[catch {my get} val]} {set val {}}
    upvar $var_name var
    set var $val
    #uplevel set $var_name [my get]
    set driven_var [uplevel namespace which -variable $var_name]
    dict set driven_vars $driven_var {}
}

# Stop driving a Tcl variable
method !=> var_name {
    set driven_var [uplevel namespace which -variable $var_name]
    dict unset driven_vars $driven_var
}

# Update all driven variables
method drive_vars {} {
    if {[catch {my get} val]} {set val {}}
    dict for {var -} $driven_vars {
        set $var $val
    }
}

export == = := <= => !=>

}

interp alias {} react {} Reactive create


# A ReactiveMap object represents a set of Reactive variables generated
# by applying a common function to a varying parameter (or list of
# parameters).  Each Reactive variable is created on first use of its
# specific parameter(s) and then cached.

oo::class create ReactiveMap {
    variable params script cache

constructor {parms code} {
    #puts "MAP::CONSTRUCT [self] code='$code'"
    set params $parms
    set script $code
    set cache [dict create]
}

method get args {
    #puts "MAP::GET [self] args='$args' cache='$cache'"
    if {[llength $args] != [llength $params]} {
        error "[self]: parameters expected: $params, parameters supplied: $args."
    }

    # Check if we have a cached object for this argument list
    if {[dict exists $cache {*}$args]} {
        set react [dict get $cache {*}$args]
    } else {
        # Otherwise create object and add to cache
        set react [Reactive new := [list apply [list $params $script] {*}$args]]
        dict set cache {*}$args $react
    }

    return [$react]
}

# Show internal state for debugging
method show {} {
    return "params='$params' script='$script' cache='$cache'"
}

}

interp alias {} react_map {} ReactiveMap create

# ReacTcl demo - GUI to calculate (a+b)/c

package require Tk

source reactcl.tcl

ttk::label .la -text a
ttk::entry .a -textvariable a -justify center
ttk::label .lb -text b
ttk::entry .b -textvariable b -justify center
ttk::label .lc -text c
ttk::entry .c -textvariable c -justify center
ttk::label .lr -text {(a+b)/c}
ttk::label .result -textvariable result

grid .la .a
grid .lb .b
grid .lc .c
grid .lr .result

react a <= a
react b <= b
react c <= c

react calc = {([a] + [b]) / [c]}
react result := {catch calc val; set val}
result => result