From 51a5a7a16b7bdb173a3c6fd8638b1a1fe4ee80b4 Mon Sep 17 00:00:00 2001
From: Julian Noble <julian@precisium.com.au>
Date: Tue, 1 Aug 2023 12:03:18 +1000
Subject: [PATCH] various scriptlib updates

---
 scriptlib/error.tcl                           |   4 +-
 scriptlib/hello.tcl                           |   2 +-
 scriptlib/scriptinfo                          |  20 +++
 scriptlib/scriptinfo2                         |   6 +
 scriptlib/stdout_per_second.tcl               | 156 +++++++++---------
 scriptlib/tests/block_padleft.tcl             |   8 +
 scriptlib/tests/codewars_cola.tcl             |  95 +++++++++++
 scriptlib/tests/first_assign.tcl              |   6 +
 scriptlib/tests/fun.tcl                       |  32 ++--
 .../tests/functional/divisible_sum_pairs.tcl  |  37 +++++
 scriptlib/tests/functional/j.tcl              |  28 ++++
 scriptlib/tests/functional/quicksort.tcl      |  23 +++
 scriptlib/tests/html.tcl                      |   6 +-
 scriptlib/tests/listbuilder.tcl               |   6 +-
 scriptlib/tests/nameservers.tcl               |  10 +-
 scriptlib/tests/parser.tcl                    |  64 +++++++
 scriptlib/tests/pipeline1.tcl                 |   5 +-
 scriptlib/tests/pipeswitch.tcl                |   4 +-
 scriptlib/tests/wanted.tcl                    |  10 +-
 19 files changed, 411 insertions(+), 111 deletions(-)
 create mode 100644 scriptlib/scriptinfo
 create mode 100644 scriptlib/scriptinfo2
 create mode 100644 scriptlib/tests/codewars_cola.tcl
 create mode 100644 scriptlib/tests/functional/divisible_sum_pairs.tcl
 create mode 100644 scriptlib/tests/functional/j.tcl
 create mode 100644 scriptlib/tests/functional/quicksort.tcl
 create mode 100644 scriptlib/tests/parser.tcl

diff --git a/scriptlib/error.tcl b/scriptlib/error.tcl
index d890ca96..f26d17fe 100644
--- a/scriptlib/error.tcl
+++ b/scriptlib/error.tcl
@@ -1,5 +1,7 @@
 puts stdout "1 (stdout) test of error in scriptlib tcl script"
-puts stderr "2 (stderr) error line will be run next - followed by a dashed line on stdout"
+puts stderr "2 (stderr) error line will be run next"
 error "This is the error"
+
+#should be unreachable
 puts stdout "-----------------------------"
 
diff --git a/scriptlib/hello.tcl b/scriptlib/hello.tcl
index 883fba1d..40b7243e 100644
--- a/scriptlib/hello.tcl
+++ b/scriptlib/hello.tcl
@@ -12,6 +12,6 @@ puts -nonewline stderr "5 hello on stderr no line-ending"
 flush stderr
 puts -nonewline stdout "6 hello on stdout no line-ending"
 flush stdout
-
+set ::tcl_interactive 1
 
 
diff --git a/scriptlib/scriptinfo b/scriptlib/scriptinfo
new file mode 100644
index 00000000..665e8974
--- /dev/null
+++ b/scriptlib/scriptinfo
@@ -0,0 +1,20 @@
+# tcl  - commented line with 'tcl' as indicator this is a tcl script. A standard shebang line would also work.
+
+puts stderr "info script: [info script]"
+
+apply {{self} {
+    set selfdir [file dirname $self]
+    puts stderr "selfdir: $selfdir"
+    source $selfdir/scriptinfo2
+    
+    #if {[file exists $selfdir/kettle.tcl]} {
+	## Look for a local copy first, for when we install ourselves.
+	#source $selfdir/kettle.tcl
+    #} else {
+	## use the installed core.
+	#package require kettle
+    #}
+    
+    
+}} [file dirname [file normalize [info script]/__]]
+
diff --git a/scriptlib/scriptinfo2 b/scriptlib/scriptinfo2
new file mode 100644
index 00000000..9a3bd37c
--- /dev/null
+++ b/scriptlib/scriptinfo2
@@ -0,0 +1,6 @@
+# tcl  - commented line with 'tcl' as indicator this is a tcl script. A standard shebang line would also work.
+
+puts stderr "scriptinfo2 info script: [info script]"
+puts stderr "scriptinfo2 argc: $::argc"
+puts stderr "scriptinfo2 argv: $::argv"
+puts stderr "scriptinfo2 argv0: $::argv0"
diff --git a/scriptlib/stdout_per_second.tcl b/scriptlib/stdout_per_second.tcl
index 0c31c3e8..68d19903 100644
--- a/scriptlib/stdout_per_second.tcl
+++ b/scriptlib/stdout_per_second.tcl
@@ -1,78 +1,78 @@
-
-if {$::argc >= 1} {
-   set persec [lindex $::argv 0]
-} else {
-   set persec 1
-}
-if {$::argc == 2} {
-    set what [lindex $::argv 1]
-} else {
-    set what "."
-}
-
-if {$persec > 1000} {
-  puts stderr "WARNING: (>1000) sub millisecond scheduling not available - will go full speed"
-  flush stderr
-  after 500
-}
-#--- confg ---
-set newline_every_x_seconds 5
-#---
-chan configure stdout -blocking 1 -buffering none
-set counter 0
-set ms [expr {1000 / $persec}]
-set nl_every [expr {$persec * $newline_every_x_seconds}]
-
-proc schedule {} {
-    if {$::forever_stdout_per_second} {
-        after idle [list after 0 ::emit]
-        tailcall after $::ms ::schedule
-    } else {
-        after idle [list ::the_end]
-    }
-}
-
-set ::forever_stdout_per_second 1
-
-proc the_end {} {
-    puts stderr "-done-"
-    flush stderr
-    flush stdout
-    set ::done_stdout_per_second 1
-}
-
-proc emit {} {
-    upvar ::counter c
-    if {($c > 1) && (($c % $::nl_every) == 0)} {
-        puts -nonewline stdout " "
-        flush stdout
-        puts stderr $c
-        flush stderr
-    } else {
-        puts -nonewline stdout $::what
-    }
-    #flush stdout
-    incr c
-}
-chan configure stdin -blocking 0 -buffering none
-chan event stdin readable [list apply {{chan} {
-    set chunk [chan read $chan]
-    if {[string length $chunk]} {
-        if {[string match "*q*" [string tolower $chunk]]} {
-            set ::forever_stdout_per_second 0
-            chan event $chan readable {}
-            puts stderr "cancelling"
-        }
-    }
-    if {[chan eof $chan]} {
-        chan event $chan readable {}
-    }
-}} stdin]
-
-schedule
-vwait ::forever_stdout_per_second
-
-vwait ::done_stdout_per_second
-
-
-
+
+if {$::argc >= 1} {
+   set persec [lindex $::argv 0]
+} else {
+   set persec 1
+}
+if {$::argc == 2} {
+    set what [lindex $::argv 1]
+} else {
+    set what "."
+}
+
+if {$persec > 1000} {
+  puts stderr "WARNING: (>1000) sub millisecond scheduling not available - will go full speed"
+  flush stderr
+  after 500
+}
+#--- confg ---
+set newline_every_x_seconds 5
+#---
+chan configure stdout -blocking 1 -buffering none
+set counter 0
+set ms [expr {1000 / $persec}]
+set nl_every [expr {$persec * $newline_every_x_seconds}]
+
+proc schedule {} {
+    if {$::forever_stdout_per_second} {
+        after idle [list after 0 ::emit]
+        tailcall after $::ms ::schedule
+    } else {
+        after idle [list ::the_end]
+    }
+}
+
+set ::forever_stdout_per_second 1
+
+proc the_end {} {
+    puts stderr "-done-"
+    flush stderr
+    flush stdout
+    set ::done_stdout_per_second 1
+}
+
+proc emit {} {
+    upvar ::counter c
+    if {($c > 1) && (($c % $::nl_every) == 0)} {
+        puts -nonewline stdout " "
+        flush stdout
+        puts stderr $c
+        flush stderr
+    } else {
+        puts -nonewline stdout $::what
+    }
+    #flush stdout
+    incr c
+}
+chan configure stdin -blocking 0 -buffering none
+chan event stdin readable [list apply {{chan} {
+    set chunk [chan read $chan]
+    if {[string length $chunk]} {
+        if {[string match "*q*" [string tolower $chunk]]} {
+            set ::forever_stdout_per_second 0
+            chan event $chan readable {}
+            puts stderr "cancelling"
+        }
+    }
+    if {[chan eof $chan]} {
+        chan event $chan readable {}
+    }
+}} stdin]
+
+schedule
+vwait ::forever_stdout_per_second
+
+vwait ::done_stdout_per_second
+
+
+
diff --git a/scriptlib/tests/block_padleft.tcl b/scriptlib/tests/block_padleft.tcl
index e71c372b..c892104c 100644
--- a/scriptlib/tests/block_padleft.tcl
+++ b/scriptlib/tests/block_padleft.tcl
@@ -7,3 +7,11 @@ puts stdout "block_padleft pipeline"
 puts stdout "[alias block_padleft]"
 puts stderr "block_padleft \[>punk . logo] 50"
 puts stdout "[block_padleft [>punk . logo] 50]"
+
+
+package require overtype
+set out ""
+foreach ln [.= block_padleft [>punk . logo ] 2 |> linelist] bgline [.= block_padleft [>punk . logo] 100 |> linelist] {
+    append out [overtype::left $bgline [a+ green bold]$ln[a+]]\n
+}
+puts stdout "$out"
\ No newline at end of file
diff --git a/scriptlib/tests/codewars_cola.tcl b/scriptlib/tests/codewars_cola.tcl
new file mode 100644
index 00000000..3e683b41
--- /dev/null
+++ b/scriptlib/tests/codewars_cola.tcl
@@ -0,0 +1,95 @@
+
+#naive - literal approach to the problem via a form of simulation (as attempted in https://www.youtube.com/watch?v=7fylNa2wZaU)
+#the proper solution is of course just a little bit of maths - but the list-manipulation is an interesting exercise.
+
+proc collapse lst {
+    #puts stdout "lst:'$lst' len:[llength $lst]"
+     foreach i $lst {
+        #puts stderr "'$i len:[llength $i] len-el0:[llength [lindex $i 0]]'"
+        if {[llength $i] == 2 && [llength [lindex $i 0]] ==2} {
+            lappend out [list [list [lindex $i 0 0] [expr {[lindex $i 0 1] + [lindex $i 1 1]}]   ] ]
+        } else {
+            lappend out $i
+        }
+     }
+     return $out
+}
+
+#.=* list |h/0,t/tail> .=t>1*,h>end,h>end list |> punk::group_list_by {[lindex $item 0]} |> inspect  |> .= collapse <q| {a 1} {b 1} {c 1}
+
+#usage: drinkx 0 n {a 1} {b 1}...
+pipealias drinkx .=* list {|
+    h/0,t/tail
+    >} .=t>1*,h>end,h>end list {|
+        data2,
+        nplus@end/1
+    >} {expr {$nsofar + $nplus}}  {|
+        nsofar
+    >} {set data2}  {|
+    
+    >} punk::group_list_by {[lindex $item 0]} {|
+    
+    >} .= collapse {|
+    
+    >} .=>2 lmap v {lindex $v 0} {|
+    >} .=nsofar>1,n>2,data>end* list                        <q/2-end,nsofar/0,n/1| 
+    
+    
+
+input.= list {sheldon 1} {leonard 1} {penny 1} {rajesh 1} {howard 1}
+
+
+pipealias xxx .= {list $nsofar $n {*}$q} {|
+    ,
+    i/0,
+    n/1
+    >} .=>.  {set in $data; while {$i < $n } {
+                                #puts stdout "$i < $n"
+                                #puts stdout "drinkx $in"
+                                set in [drinkx {*}$in]
+                                lassign $in i n 
+                            }; set in}  {|
+    >}  inspect -channel null {|
+
+        result/end
+     >} {set result}  <q/2-end,nsofar/0,n/1| 
+    
+
+#xxx 0 10010 {*}$input
+#howard
+
+#xxx 0 7230702951 {*}$input  
+#(our result is at end of list)
+#leonard
+
+
+set js_solution {
+    function whoIsNext(names, r){
+        let peopleInLine = names.length;
+        let copiesOfEachPerson = 1;
+          
+          while (r > peopleInLine) {
+            r -= peopleInLine;
+            copiesOfEachPerson *= 2;
+            peopleInLine *= 2;
+          }
+          
+        return names[Math.floor((r - 1) / copiesOfEachPerson) % peopleInLine];
+    }
+}
+
+proc who_is_next {names n} {
+    set peopleInLine [llength $names]
+    set copiesOfEachPerson 1
+    while {$n > $peopleInLine} {
+        set n [expr {$n - $peopleInLine}]
+        set copiesOfEachPerson [expr {$copiesOfEachPerson * 2}]
+        set peopleInLine [expr {$peopleInLine * 2}]
+    }
+    set idx [expr {int(floor(($n -1)/$copiesOfEachPerson)) % $peopleInLine}]
+    #puts "idx:$idx names: $names" 
+    set result [lindex $names $idx]
+}
+
+
+
diff --git a/scriptlib/tests/first_assign.tcl b/scriptlib/tests/first_assign.tcl
index a6d7d67b..9e7b8c18 100644
--- a/scriptlib/tests/first_assign.tcl
+++ b/scriptlib/tests/first_assign.tcl
@@ -1,4 +1,6 @@
 #experiment with the dangers of substitution in the first position after = in pipelines
+puts stderr "Relevant for consideration if attempting to build pipelines parametrically"
+
 
 puts stdout {set i {"a b "}}
 set i {"a b "}
@@ -12,3 +14,7 @@ puts stderr "% x=\$i   -> $errm"
 
 #%x="a b "
 
+#however.. this is no different from the risk in normal tcl usage
+# e.g  lindex x$i 0
+
+
diff --git a/scriptlib/tests/fun.tcl b/scriptlib/tests/fun.tcl
index 03eb4aba..3f2ce4b3 100644
--- a/scriptlib/tests/fun.tcl
+++ b/scriptlib/tests/fun.tcl
@@ -253,11 +253,15 @@ proc pipefun::fun {name argspec body} {
         
         #set case [list pipecase ,$a= |$a> .= $b <|]
         
-        
         append  case { {*}$switchargs}
         #we can't maintain case as a proper list.. because it isn't. (contains {*}$xxx)
         append pipecases $case\n
     }
+    set casenomatch [string map [list <name> $name] {pipecase .= {error "casenomatch fun: <name> args: $args" "pipefun::fun <name>" {casenomatch unhandled_args}} <args|}]
+    append casenomatch { {*}$switchargs}
+    append pipecases $casenomatch\n
+
+
     set nsup [uplevel 1 [list namespace current]]
     if {$nsup eq "::"} {
         set nsup ""
@@ -273,18 +277,18 @@ proc pipefun::fun {name argspec body} {
     #        }
     #    } <arglist| {*}$args
     #}]
-    puts "creating alias '$name'"
-    interp alias {} $name {} pipeswitchc $pipecases 
+    puts "creating alias '$name' (argspec:$argspec)"
+    #interp alias {} $name {} pipeswitchc $pipecases 
+    interp alias {} $name {} pipeswitch $pipecases 
     
     
 }
 
-
-interp alias {} fun {} pipefun::fun
-interp alias {} funs {} pipefun::funs
-interp alias {} funclear {} pipefun::funclear
-interp alias {} funinfo {} pipefun::funinfo
-interp alias {} funclause {} pipefun::funclause
+interp alias {} fun {}          [nsjoin [namespace current] pipefun::fun]
+interp alias {} funs {}         [nsjoin [namespace current] pipefun::funs]
+interp alias {} funclear {}     [nsjoin [namespace current] pipefun::funclear]
+interp alias {} funinfo {}      [nsjoin [namespace current] pipefun::funinfo]
+interp alias {} funclause {}    [nsjoin [namespace current] pipefun::funclause]
 
 fun age argc#,v@0-end {
     #always runs for age - falls through to other implementations
@@ -294,8 +298,12 @@ fun age argc#,v@0-end {
 
 #only runs for exactly 2 args
 fun age a@,m@,2# {
-        puts "You're $a!  $m"
-        # pipematch r@@ok/resultx.= age $a
+        puts stderr "You're $a!  $m"
+        pipeswitch {
+            pipecase r@@ok/result.= age $a
+            pipecase r.= age $a
+        }
+        return $r
     }
 
 
@@ -357,7 +365,7 @@ fun age a {
     #but only if we *don't* have a mismatch.
     #i.e we require an @@error/mismatch to proceed to other implementations
     #puts stderr "=--->$switchresult"
-    if {[ispipematch r@@error/mismatch.= val $switchresult]} {
+    if {[ispipematch r@@casemismatch.= val $switchresult]} {
         #all good - simulate an @@error/mismatch - or raise an 'ignore' error so that this implementation is considered to be unmatched and we fall through to others.
         #puts stdout "=ispipematch true"
         error [list ignore [list argcheck passed]]
diff --git a/scriptlib/tests/functional/divisible_sum_pairs.tcl b/scriptlib/tests/functional/divisible_sum_pairs.tcl
new file mode 100644
index 00000000..842f43e3
--- /dev/null
+++ b/scriptlib/tests/functional/divisible_sum_pairs.tcl
@@ -0,0 +1,37 @@
+
+
+
+set ints [list 1 2 3 4 5 6]
+set k 5
+
+cartesianpairs1.= {foreach i $ints {foreach j $ints {lappend out [list $i $j]}}; set out} <ints| {*}$ints
+
+
+pipeset cpairs1 .= {foreach i $ints {foreach j $ints {lappend out [list $i $j]}}; set out} <ints| 
+pipeset cpairs2 .= {foreach i $a {foreach j $b {lappend out [list $i $j]}}; set out} <a@0,b@1| 
+
+
+
+pipeset alg .= list  |> \
+{inspect -label K= $k} |> \
+.= {foreach i $ints {foreach j $ints {lappend out [list $i $j]}}; set out} |> \
+list_filter_cond { = $item |a/0,b/1> .= {expr $b > $a}} |> \
+{list_filter_cond { .= list $item $k |a/0/0,b/0/1,k/1> \
+.= {expr {($a + $b) % $k == 0} }} $data } <k/head,ints/tail|
+
+
+puts [{*}$alg $k {*}$ints]
+
+
+#todo 
+#https://wiki.tcl-lang.org/page/cons
+proc cons {a b} {list $a $b}
+proc car {p} {lindex $p 0}
+proc cdr {p} {lindex $p 1}
+proc LIST args {
+    if {![llength $args]} {
+        return {}
+    } else {
+        return [cons [lindex $args 0] [LIST {*}[lrange $args 1 end]]]
+    }
+}  
diff --git a/scriptlib/tests/functional/j.tcl b/scriptlib/tests/functional/j.tcl
new file mode 100644
index 00000000..2e8ce249
--- /dev/null
+++ b/scriptlib/tests/functional/j.tcl
@@ -0,0 +1,28 @@
+
+#NOT really very lazy..
+
+#pipealias lazy .=>. {inspect "$h|$t"} |> {list $h [list lazy $name $t]} |r,fn/1> {upvar $name nm; pipeset nm .= {*}$fn} |> {lindex $r 0} <h/1/anyhead,t/1/anytail,name@0|
+pipealias lazy .=>. {list $h [list lazy $name $t]} |r,fn/1> {upvar $name nm; pipeset nm .= {*}$fn} |> {lindex $r 0} <h/1/anyhead,t/1/anytail,name@0|
+
+pipealias lazyfun =infun>0 |a/0/0,b/0/1,c/0/2> {list $a $b [list init {*}$c]} |> .=*  |> inspect  |h> {pipealias $name .= eval \$$name} |>  {set name} <infun/0,name/0/1,'lazy'/@0/0|
+
+
+lazyfun {lazy j {a b c d e}}
+
+#pipealias listgen =  |h/0,fn/1> {upvar $name nm; pipeset nm .= {*}$fn} |> {set h}  <l@1,name@0| 
+
+
+#NOTE that not all functional languages seem to make use of cons cells - and they are arguably not required and/or not the right approach for Tcl(?)
+#standard lists are likely to be more efficient. 
+#
+proc cons {a b} {list $a $b}
+proc car {p} {lindex $p 0}
+proc cdr {p} {lindex $p 1}
+# "cons cell" structure (a specific type of linked-list)
+proc LIST args {
+    if {![llength $args]} {
+        return {}
+    } else {
+        return [cons [lindex $args 0] [LIST {*}[lrange $args 1 end]]]
+    }
+}
diff --git a/scriptlib/tests/functional/quicksort.tcl b/scriptlib/tests/functional/quicksort.tcl
new file mode 100644
index 00000000..494fc310
--- /dev/null
+++ b/scriptlib/tests/functional/quicksort.tcl
@@ -0,0 +1,23 @@
+
+#quicksort is a prime example of an algorithm that is more suited to imperative than functional.
+#As it relies on swap in place it can be considered a pathological case for functional programmin
+#There are however ways to make it work
+#example of some functional approaches to quicksort 
+#https://www.youtube.com/watch?v=vzfy4EKwG_Y
+
+set js {
+
+function partition(arr, pivotIndex, low, high) {
+    let partitionIndex = low;
+    for (let i = low; i< high; i++) {
+        if (arr[i] < arr[pivotIndex]) {
+            swap(arr, i, partitionIndex);
+            partitionIndex++;
+        }
+    }
+    swap(arr, high, partitionIndex);
+    return partitionIndex;
+}
+
+}
+
diff --git a/scriptlib/tests/html.tcl b/scriptlib/tests/html.tcl
index 05570069..662df6ba 100644
--- a/scriptlib/tests/html.tcl
+++ b/scriptlib/tests/html.tcl
@@ -120,7 +120,7 @@ pipeset htmldoc .= list "julian@precisium.com.au" "info@precisium.com"   |email_
             pipeswitch {
                 
                 pipecase \
-                .= val $pipeargs                |argd> \
+                .= val $pipeargs                |argd> inspect -channel null |>\
                 1.=         {
                                 dict exists $argd -author
                             } {
@@ -139,7 +139,7 @@ pipeset htmldoc .= list "julian@precisium.com.au" "info@precisium.com"   |email_
                 
                 pipecase .= val "Author: unknown" |> div [attrs hidden hidden] 
                 
-            } |> p [attrs] |> footer [attrs]
+            } |> inspect -channel null -label argd |> p [attrs] |> footer [attrs]
             
             
         #puts "author: $author"
@@ -215,5 +215,5 @@ proc make_script {pipeline} {
 proc run_pipe {pipeline} {
     funcl::funcl_script_test [make_script $pipeline]
 }
-
+puts stdout "created pipeline in variable htmldoc"
 
diff --git a/scriptlib/tests/listbuilder.tcl b/scriptlib/tests/listbuilder.tcl
index 56302dd4..7fd1a96f 100644
--- a/scriptlib/tests/listbuilder.tcl
+++ b/scriptlib/tests/listbuilder.tcl
@@ -101,7 +101,7 @@ pipeset commentpipe normallist.= rawlist/0.= {
 } {
 #more comments - but we need to pass the pipeline data through here - so 'set data' required at end.
 set data
-} |> string trim |> linelist |> .=/2 lmap v {string trim $v}
+} |> string trim |> linelist |> .=>2 lmap v {string trim $v}
 
 pipeputs $commentpipe
 {*}$commentpipe
@@ -111,14 +111,14 @@ puts stdout "normallist:$normallist"
 puts stderr $sep
 
 
-pipeset pipe2 alt.= = $rawlist |> .=/1 lrange 0 end
+pipeset pipe2 alt.= = $rawlist |> .=>1 lrange 0 end
 puts stdout "Alternative interpretation of list data"
 puts stdout "pipe2:"
 pipeputs $pipe2
 {*}$pipe2
 puts stdout "alt: $alt"
 
-pipeset pipe3 alt.= = $rawlist |> .=* list
+pipeset pipe3 alt.= = $rawlist |> .=>* list
 puts stdout "Or.."
 puts stdout "pipe3:"
 pipeputs $pipe3
diff --git a/scriptlib/tests/nameservers.tcl b/scriptlib/tests/nameservers.tcl
index aee4573b..f8349aa6 100644
--- a/scriptlib/tests/nameservers.tcl
+++ b/scriptlib/tests/nameservers.tcl
@@ -7,12 +7,12 @@ proc pipe_webpub {} {
 pipeset subpipe % .= {
     pipeswitch {
         pipecase \
-            .= val [lindex $switchargs 0] \
-            |> {string trimright $data .} |server> {split $data .} \
-            |> 'webpub.net'.= {
+            .= val [lindex $switchargs 0] {|
+            >} {string trimright $data .} |server> {split $data .} {|
+            >} 'webpub.net'.= {
                 join [lrange $data 1 2] .
-            } \
-            |> {
+            } {|
+            >} {
                 list type internal server $server
             }
             
diff --git a/scriptlib/tests/parser.tcl b/scriptlib/tests/parser.tcl
new file mode 100644
index 00000000..8c3378e3
--- /dev/null
+++ b/scriptlib/tests/parser.tcl
@@ -0,0 +1,64 @@
+
+
+
+proc p_digit str {
+    if {[string is digit -strict [string index $str 0]]} {
+        return [list [string index $str 0] [string range $str 1 end]]
+    } else {
+        return [list]
+    }
+}
+
+proc p_char {str ch} {
+    if {[string index $str 0] eq $ch} {
+        return [list [string index $str 0] [string range $str 1 end]]
+    } else {
+        return [list]
+    }
+}
+
+proc parser_of_char {ch} {
+    pipeset outparser @@ok/result.= {
+        pipeswitch {
+            pipecase .= list $input $ch |data/0,char/1> \
+            ,'${ch}'@0.= {p_char $data $char}
+
+            return  [list ok [list result [list]]]
+        }
+    } <ch/0,input/1| $ch
+}
+
+proc some {parser} {
+
+
+}
+
+
+#generate a functor on a pipeline targeting a specific section of the 'value' in: ok {result value}
+proc fmap {cmdlist pipeline} {
+    pipeset functor .= {
+        pipeswitch {
+            pipecase .= list $cmd $p $input |cmd@,pipe@,input@> \
+            ,'result'@@ok/@0.= { 
+                .= list $pipe $input |p@,i@> {{*}$p $i} 
+            } |result@@ok/result>  =result>1/1  
+        
+            return nothing-functor
+        }
+    } <cmd@,p@,input@| $cmdlist $pipeline
+}
+
+
+
+proc charP {ch} {
+    pipeset parser .=  {
+        pipeswitch {
+            #puts "-->$input"
+            pipecase = $input |> \
+            ,'${ch}'@0.= {list [string index $data 0] [string range $data 1 end] } |> {
+                set data
+            }
+            return nothing
+        } 
+    }   <ch/0,input/1| $ch
+}        
\ No newline at end of file
diff --git a/scriptlib/tests/pipeline1.tcl b/scriptlib/tests/pipeline1.tcl
index 45b2f49c..014ef1d1 100644
--- a/scriptlib/tests/pipeline1.tcl
+++ b/scriptlib/tests/pipeline1.tcl
@@ -41,8 +41,9 @@ set input [list a b c d e f g]
 
 a.= val $input    |> {
 
-         .= lrange $data 1 end-1 |>\
-        b.= string toupper 
+         .= lrange $data 1 end-1 {|
+         
+         >} b.= string toupper 
         
         puts stdout "=================================="
         puts stdout "info vars: [info vars]"
diff --git a/scriptlib/tests/pipeswitch.tcl b/scriptlib/tests/pipeswitch.tcl
index ef35576d..3ac0e32d 100644
--- a/scriptlib/tests/pipeswitch.tcl
+++ b/scriptlib/tests/pipeswitch.tcl
@@ -64,7 +64,9 @@ proc  match_args {args} {
             return [list source pipecase3 data [list transformed {*}$data]]
         }
         
-        pipecase .= val $args |> {
+        pipecase .= val $args {|
+        
+        >} {
             puts "catchall pipe4 $data"
             return $data
         }
diff --git a/scriptlib/tests/wanted.tcl b/scriptlib/tests/wanted.tcl
index 252d69af..d5c3f81a 100644
--- a/scriptlib/tests/wanted.tcl
+++ b/scriptlib/tests/wanted.tcl
@@ -2,17 +2,17 @@
 # this should run 'list a b c tail' 
 catch {
 
-% x.=/0*   tail  |> {puts $data;set data} <in| list a b c
+% x.=>0*   tail  |> inspect <in| list a b c
 
 }
 
 #should it then be able to run pipelines as 'args' 
-% x.=/0*    |> {puts $data;set data} <in| % y.= list etc blah |> string toupper
+% x.=>0*    |> inspect <in| % y.= list etc blah |> string toupper
 
 #but then what would happen if the args pipeline also took input via another <| ?
-#% x.=/0*    |> {puts $data;set data} <in| % y.= list etc blah  <| list data 
+% x.=>*    |> inspect <in| % y.= list etc blah  <| list data 
 
-#presumably pipelines shouldn't be passed in as expanded lists..
+#punk modified so pipeline operates to the leftmost <| 
 
 
-% out= x=   |> {puts $data; set data}  |p1/0> .= { {*}$p1 }   |> {puts $data;set data} <in| [list % y.= list etc blah |> string toupper]
+% out= x=   |> inspect  |p1/0> .= { {*}$p1 }   |> inspect <in| [list % y.= list etc blah |> string toupper]