punkshell/scriptlib/tests/monadtest.tcl

package require punk

#https://www.youtube.com/watch?v=26jVysJHB-s
#based on Monads in Python: Why and How?

#some function timer 
proc xxxpipet {subcommand} {
    return [list % val $subcommand |sub> {
        if {![info exists input]} {
            set input ""
        } else {
            set input
        }
        } |input> {clock micros} |start> {{*}$sub {*}$input} |res> {expr [clock micros] - $start} |t> {list $res $t} <input| ]
}
proc pipet {subcommand} {
    return [list % list $subcommand |sub/0,input/1> \
        {clock micros} |start> {{*}$sub {*}$input} |res> {expr [clock micros] - $start} |t> {list $res $t} <input| ]
}

pipeset fast  % {expr {$x + 1}} <x|
pipeset slow  % {after 100} |> {expr {$x + 1}} <x|
pipeset slow2 % {after 150} |> {expr {$x + 2}} <x|

#naive chaining of time-wrapped commands. 
#Requires unpacking/matching at each stage of pipeline and summing at end.
% .= val 2 |> .= {{*}[pipet $::fast] $data} |d@0,t@1> {{*}[pipet $::slow] $d} |d@,t2@> {{*}[pipet $::slow2] $d} |d@,t3@> {list $d [expr {$t + $t2 + $t3}]}


#method 2 - abstract away the extraction and summation in a bind function
# x2, t = bind(bind(fast(1), slow), slow2)
# % bind=% {list $vt $f} |v@0/0,t@0/1> {{*}$f $v} |r2@,t2@>  {list $r2 [expr {$t + $t2}]} <vt@,f@|
 pipeset bind % {list $vt $f} |v@0/0,t@0/1> {{*}$f $v} |r2@,t2@>  {list $r2 [expr {$t + $t2}]} <vt@,f@|

# requires nested binds .. a bit messy 
 {*}$bind    [{*}$bind [{*}[pipet $::fast] 1] [pipet $::slow]]       [pipet $::slow2]
 
 #we can neaten it up with tcl aliases, but we still don't have a straightforward pipeline so it will get messier with more operations.
 alias t_fast   {*}[pipet $fast]
 alias t_slow   {*}[pipet $slow]
 alias t_slow2  {*}[pipet $slow2]
 alias bind {*}$bind
 
 bind [bind [t_fast 1] t_slow] t_slow2
  
#now with oo approach

catch {timedvalue destroy}

oo::class create timedvalue {
    variable o_value
    variable o_time
    constructor {value {time 0}} {
        set o_value $value
        set o_time $time
    }
    method value {} {return $o_value}
    method time {} {return $o_time}
    method bind {f} {
        set timed_value [{*}$f $o_value]
        set new_value [$timed_value value]
        set new_time [expr {$o_time + [$timed_value time]}]
        return [timedvalue new $new_value $new_time]
    }
}
 
#we need a new timing wrapper that returns an object
proc pipet2 {subcommand} {
    return [list % list $subcommand |sub/0,input/1> \
    {clock micros} |start> {{*}$sub {*}$input} |res> {expr [clock micros] - $start} |t> {timedvalue new $res $t} <input| ]
}
  
alias o_fast {*}[pipet2 $fast]
alias o_slow {*}[pipet2 $slow]
alias o_slow2 {*}[pipet2 $slow2]

tvresult.=             \
 .=          o_fast 1  \
|o> {$o bind o_slow}   \
|o> {$o bind o_slow2} 

puts "tvresult value: [$tvresult value]"
puts "tvresult time: [$tvresult time]"
#timedvalue class is a monad