Fixing Zebra Async Timeouts (#3971)

* Fix Async Stalling

* Add Template & Fix Async bind

* update int printer

* do GC collect after app build

* add GC Collect on appbuild2

* update config to use Postgres

* Add doctype to template

* fixed bind html encode and simple dep unit error

* retest timout fail

* missing comma in plaintext hello world

frameworks/FSharp/Zebra/benchmark_config.json

@@ -5,9 +5,31 @@
       "default": {
         "plaintext_url": "/plaintext",
         "json_url": "/json",
+        "fortune_url": "/fortunes",
         "port": 8080,
         "approach": "Realistic",
         "classification": "fullstack",
+        "database": "Postgres",
+        "framework": "zebra",
+        "language": "F#",
+        "orm": "Raw",
+        "platform": ".NET",
+        "flavor": "CoreCLR",
+        "webserver": "Kestrel",
+        "os": "Linux",
+        "database_os": "Linux",
+        "display_name": "Zebra, Dapper",
+        "notes": "",
+        "versus": "aspcore"
+      }
+    },
+    {
+      "simple": {
+        "plaintext_url": "/plaintext",
+        "json_url": "/json",
+        "port": 8080,
+        "approach": "Realistic",
+        "classification": "Micro",
         "database": "None",
         "framework": "zebra",
         "language": "F#",
@@ -17,7 +39,7 @@
         "webserver": "Kestrel",
         "os": "Linux",
         "database_os": "Linux",
-        "display_name": "Zebra",
+        "display_name": "Zebra, Simple",
         "notes": "",
         "versus": "aspcore"
       }

frameworks/FSharp/Zebra/src/App/App.fsproj

@@ -13,6 +13,8 @@
     <PackageReference Include="Microsoft.AspNetCore.Http" Version="2.1.1" />
     <PackageReference Include="Microsoft.AspNetCore.Hosting" Version="2.1.0" />
     <PackageReference Include="Microsoft.AspNetCore.Server.Kestrel" Version="2.1.0" />
+    <PackageReference Include="Dapper" Version="1.50.5" />
+    <PackageReference Include="Npgsql" Version="4.0.0" />
     <PackageReference Include="Utf8Json" Version="1.3.7" />
   </ItemGroup>
 
@@ -20,6 +22,7 @@
     <Compile Include="Buffer.fs" />
     <Compile Include="Parsers.fs" />
     <Compile Include="Encoding.fs" />
+    <Compile Include="TemplateEngine.fs" />
     <Compile Include="State.fs" />
     <Compile Include="ExecNodes.fs" />
     <Compile Include="RouteNode.fs" />

frameworks/FSharp/Zebra/src/App/Composition.fs

@@ -32,9 +32,9 @@ let inline composeFnFn (parentFn:PipeLine<'T>) (childFn:PipeLine<'T>) : PipeLine
         let parent = parentFn(child,fail)
         parent
 
-let inline composeFnChoose (parentFn:PipeLine<'T>) (childFn:ChooseWrap<'T>) : PipeLine<'T> =
+let inline composeFnChoose (parentFn:PipeLine<'T>) (ChooseWrap(childFn):ChooseWrap<'T>) : PipeLine<'T> =
     fun (next:INode<'T>,fail:INode<'T>) -> // new nodeTree Fn
-        let child = childFn.Apply(next,fail)
+        let child = childFn(next,fail)
         let parent = parentFn(child,fail)
         parent
 
@@ -63,9 +63,9 @@ let inline composeBase (a:RouteBase<'T>) (b:Zapp<'T>) =
         let child = ChoiceNode<'T>(next,fail,b)
         route a.Method a.Pattern (child,fail)
 
-let inline composeRouteChoose (a:RouteBase<'T>) (b:ChooseWrap<'T>) =
+let inline composeRouteChoose (a:RouteBase<'T>) (ChooseWrap(b):ChooseWrap<'T>) =
     fun (next:INode<'T>,fail:INode<'T>) ->
-        let child = b.Apply(next,fail)
+        let child = b(next,fail)
         route a.Method a.Pattern (child,fail)
 
 

frameworks/FSharp/Zebra/src/App/Middleware.fs

@@ -1,13 +1,14 @@
+[<AutoOpenAttribute>]
 module Middleware
 
+open Microsoft.AspNetCore.Http
+open Microsoft.AspNetCore.Builder
+
 open State
 open Router
 open ExecNodes
+
 open System.Threading.Tasks
-open System.Runtime.CompilerServices
-open Microsoft.AspNetCore.Http
-open Microsoft.AspNetCore.Hosting
-open Microsoft.AspNetCore.Builder
 
 type ZebraMiddleware<'T>(
                         next          : RequestDelegate,
@@ -18,17 +19,39 @@ type ZebraMiddleware<'T>(
     let finishNode = FinishNode() :> INode<'T>
     let failNode = FailNode<'T>(failAction,finishNode)
     let appNode = AppBuilder(finishNode,failNode) // build App node
-
-    do System.GC.Collect() // AppBuilder creates alot of garbage
+    
+    do System.GC.Collect()
     
     member __.Invoke (ctx : HttpContext) = 
         
-        let amb = AsyncTaskMethodBuilder()
-        let state = State<'T>(ctx,Dependencies,amb)
+        let tcs = TaskCompletionSource()
+                
+        let mutable state = State<'T>(ctx,Dependencies,tcs)
         appNode.Apply state
-        amb.Task
 
+        tcs.Task
+
+
+type ZebraSimpleMiddleware<'T>(
+                        next          : RequestDelegate,
+                        Dependencies  : 'T,
+                        App    : State<'T> -> unit
+                        ) =
+    
+    do System.GC.Collect()
+    
+    member __.Invoke (ctx : HttpContext) = 
+        
+        let tcs  = TaskCompletionSource()
+                
+        let mutable state = State<'T>(ctx,Dependencies,tcs)
+        App state
+
+        tcs.Task
 
 type IApplicationBuilder with
     member x.UseZebraMiddleware<'T>(dependencies:'T,fallback:Zapp<'T>,app:PipeLine<'T>) = 
-        x.UseMiddleware<ZebraMiddleware<'T>> [|box dependencies;box fallback;box app|] 
+        x.UseMiddleware<ZebraMiddleware<'T>> [|box dependencies;box fallback;box app|]
+
+    member x.UseZebraSimpleMiddleware<'T>(dependencies:'T,app:State<'T> -> unit) = 
+         x.UseMiddleware<ZebraSimpleMiddleware<'T>> [|box dependencies;box app|]

frameworks/FSharp/Zebra/src/App/Program.fs

@@ -4,21 +4,84 @@ open State
 open Router
 open ExecNodes
 open Middleware
-open System.Threading.Tasks
-open System.Runtime.CompilerServices
+
 open Microsoft.AspNetCore.Http
 open Microsoft.AspNetCore.Hosting
-open Microsoft.AspNetCore.Builder
-
+open Microsoft.AspNetCore
+open System
+open TemplateViewEngine
+open Npgsql
+open Dapper
+open System.Collections.Generic
 
 
 [<CLIMutable>][<Struct>] 
 type JsonStructMessage = { message : string }
 
+ [<CLIMutable>]
+type Fortune = { id: int; message: string }
+
+[<Literal>]
+let ConnectionString = "Server=tfb-database;Database=hello_world;User Id=benchmarkdbuser;Password=benchmarkdbpass;Maximum Pool Size=1024;NoResetOnClose=true;Enlist=false;Max Auto Prepare=3"
+
+
+module Simple =
+    let textFn<'T> (text:string) = 
+        let bytes =         System.Text.Encoding.UTF8.GetBytes(text)
+        let contentLength = Microsoft.Extensions.Primitives.StringValues(bytes.Length.ToString())
+        let contentType =   Microsoft.Extensions.Primitives.StringValues "text/plain"
+        fun (x:State<'T>) -> 
+            x.HttpContext.Response.Headers.["Content-Length"] <- contentLength
+            x.HttpContext.Response.Headers.["Content-Type"] <- contentType
+            let t = x.HttpContext.Response.Body.WriteAsync(bytes,0,bytes.Length)
+            let awt = t.GetAwaiter()
+            x.CurrentState <- MachineState.Complete
+            awt.OnCompleted x.Continue
+
+    let inline jsonFn<'T> (value: ^a) =
+        let bytes =         Utf8Json.JsonSerializer.Serialize< ^a>(value)
+        let contentLength = Microsoft.Extensions.Primitives.StringValues(bytes.Length.ToString())
+        let contentType =   Microsoft.Extensions.Primitives.StringValues "application/json"
+        fun (x:State<'T>) -> 
+            x.HttpContext.Response.Headers.["Content-Length"] <- contentLength
+            x.HttpContext.Response.Headers.["Content-Type"] <- contentType
+            let t = x.HttpContext.Response.Body.WriteAsync(bytes,0,bytes.Length)
+            let awt = t.GetAwaiter()
+            x.CurrentState <- MachineState.Complete
+            awt.OnCompleted x.Continue
+
+module View =
+     
+    let fortuneView =
+        html [] [
+            head [] [
+                title []  [ rawText "Fortunes" ]
+            ]        
+            body [] [
+                table [] [ 
+                    tr [] [
+                        th [] [ rawText "id" ]
+                        th [] [ rawText "message" ]
+                    ]
+                    bindFor<_,_> (fun ls -> ls :> seq<Fortune> ) (
+                        tr [] [
+                            td [] [ bindInt (fun v -> v.id) ]
+                            td [] [ bindStr (fun v -> v.message) ]
+                        ]
+                    )
+                ]
+            ]
+        ] |> compileDoc
+
+    let extra = { id = 0; message = "Additional fortune added at request time." }
+    let FortuneComparer = { new IComparer<Fortune> with 
+        member self.Compare(a,b) = String.CompareOrdinal(a.message, b.message)
+}
 
 [<EntryPoint>]
-let main _ = 
-    
+let main args = 
+
+    // Defualt implimentation        
     let fallback : Zapp<_> = (fun ctx -> ctx {
         text "Url Not Found"
         status 404        
@@ -26,13 +89,47 @@ let main _ =
 
     let webapp = 
         router [
-            get "/plaintext" => (fun ctx -> ctx { text "Hello, World!" } )
-            get "/json"      => (fun ctx -> ctx { json {JsonStructMessage.message = "Hello, World!"} } )
+            get "/plaintext" => fun ctx -> ctx { text "Hello, World!" }
+            get "/json"      => fun ctx -> ctx { json {JsonStructMessage.message = "Hello, World!"} }
+            get "/fortunes"  => fun ctx -> ctx { 
+                use conn = new NpgsqlConnection(ConnectionString)
+                
+                let! (data : Fortune seq) = conn.QueryAsync<Fortune>("SELECT id, message FROM fortune")
+                
+                let fortunes = 
+                    let xs = data.AsList()
+                    xs.Add View.extra
+                    xs.Sort View.FortuneComparer
+                    xs
+
+                ctx.Render( fortunes, View.fortuneView )
+                }
         ]
 
+    // Simple implimentation
+    let plaintextPrint = Simple.textFn "Hello, World!"
+    let jsonPrint = Simple.jsonFn<_> {JsonStructMessage.message = "Hello, World!"}
+    let notFound = Simple.textFn "Not Found"
+
+    let inline simpleApp (ctx:State<_>) =
+        match ctx.HttpContext.Request.Path.Value with
+        | "/plaintext" -> plaintextPrint ctx
+        | "/json"      -> jsonPrint      ctx
+        | _            -> notFound       ctx
+
+    // Config to used based on console arg
+    let config : Action<Builder.IApplicationBuilder> =
+            match args with
+            | [|"simple"|] -> 
+                printfn "Using Simple Config..."
+                Action<Builder.IApplicationBuilder>( fun app -> app.UseZebraSimpleMiddleware<int>(0,simpleApp) |> ignore )
+            | _            -> 
+                printfn "Using Stock Config..."
+                Action<Builder.IApplicationBuilder>( fun app -> app.UseZebraMiddleware<int>(0,fallback,webapp) |> ignore )
+        
     WebHostBuilder()
         .UseKestrel()
-        .Configure(fun app -> app.UseZebraMiddleware<string>("zebra",fallback,webapp) |> ignore)
+        .Configure(config)
         .Build()
         .Run()
     0

frameworks/FSharp/Zebra/src/App/RouteNode.fs

@@ -4,10 +4,12 @@ open ExecNodes
 open Parsers
 open System.Collections.Generic
 open System.Text
+open System.Collections.Generic
 
 
 type IRouteNode<'T> =
-    abstract Parse : Range [] * State<'T> -> unit
+    abstract Parse : Range [] * State<'T> -> bool
+    
 
 let validFormats = set ['s';'i';'b';'f';'o'] // the PrintfFormat already valids but we check in pattern parse to be sure
 
@@ -97,6 +99,8 @@ type RNode<'T>(token:string) =
         with get () = edges.Count
     member __.GetEdgeKeys = edges.Keys
     member __.TryGetValue v = edges.TryGetValue v
+
+    member val MethodFilters = HashSet<METHODS>() with get,set
     override x.ToString() =
         let sb = StringBuilder()
         x.ToString(0, sb)
@@ -223,3 +227,16 @@ and Cont<'T> =
             | MatchComplete _   -> 3             
             | Complete _        -> 4
             | Empty             -> 5
+
+let private emptyMethodSet = HashSet<METHODS>()
+
+let MethodOptimise (root:RNode<'T>) =
+
+    let rec go(node:RNode<'T>,parent:HashSet<METHODS>) =
+        for kvp in node.Edges do
+            if kvp.Value.MethodFilters = parent then
+                kvp.Value.MethodFilters <- emptyMethodSet // clear the hashset
+                go(kvp.Value,parent)
+            else
+                go(kvp.Value,kvp.Value.MethodFilters)
+    go(root,root.MethodFilters)

frameworks/FSharp/Zebra/src/App/Router.fs

@@ -11,16 +11,14 @@ open ExecNodes
 open RouteNode
 
 
-type Zapp<'T> = State<'T> -> unit
-
-
+//type State<'T> -> unit = State<'T> -> unit
 
 
 // RouteNodes
 //////////////////
 type ParseFn<'a> = string * Range -> ValueOption< 'a> 
 
-type RouteNode1<'T,'a>(inext:INode<'T>,ifail:INode<'T>,current:'a -> Zapp<'T>,parseA:ParseFn<'a>) =
+type RouteNode1<'T,'a>(inext:INode<'T>,ifail:INode<'T>,current:'a -> State<'T> -> unit,parseA:ParseFn<'a>) =
     let mutable next = inext
     let mutable fail = ifail
     //let parseA : string * Range -> ValueOption< ^a> = Parse $ Unchecked.defaultof< ^a>
@@ -28,13 +26,14 @@ type RouteNode1<'T,'a>(inext:INode<'T>,ifail:INode<'T>,current:'a -> Zapp<'T>,pa
     
     // Parse like a specialised Apply so routing functions need concrete type
     interface IRouteNode<'T> with
-        member x.Parse (range:Range [],ctx:State<'T>) =
+        member x.Parse (range:Range [],ctx: State<'T>) : bool =
             let path = ctx.HttpContext.Request.Path.Value
             let v1 = parseA(path,range.[0])
             if v1.HasValue then
                 ctx.DNode <- x 
                 fnOpt.Invoke(v1.Value,ctx)
-            else fail.Apply ctx
+                true
+            else false
 
     interface INode<'T> with
         member __.Next with get () = next and set v = next <- v
@@ -43,7 +42,7 @@ type RouteNode1<'T,'a>(inext:INode<'T>,ifail:INode<'T>,current:'a -> Zapp<'T>,pa
 
 ///////////////////      
 
-type RouteNode2<'T,'a,'b>(inext:INode<'T>,ifail:INode<'T>,fn:^a -> ^b -> Zapp<'T>,
+type RouteNode2<'T,'a,'b>(inext:INode<'T>,ifail:INode<'T>,fn:^a -> ^b -> State<'T> -> unit,
                             parseA:ParseFn<'a>,parseB:ParseFn<'b>) =
     let mutable next = inext
     let mutable fail = ifail
@@ -58,15 +57,16 @@ type RouteNode2<'T,'a,'b>(inext:INode<'T>,ifail:INode<'T>,fn:^a -> ^b -> Zapp<'T
                 if v2.HasValue then
                     ctx.DNode <- x
                     fnOpt.Invoke(v1.Value,v2.Value,ctx)
-                else fail.Apply ctx    
-            else fail.Apply ctx
+                    true
+                else false    
+            else false
 
     interface INode<'T> with
         member __.Next with get () = next and set v = next <- v
         member __.Fail with get () = fail and set v = fail <- v
         member x.Apply (_) = failwith "Who's calling apply on a route node !? ya dipshit"    
 
-type RouteNode3<'T,'a,'b,'c>(inext:INode<'T>,ifail:INode<'T>,fn:'a -> 'b -> 'c -> Zapp<'T>,
+type RouteNode3<'T,'a,'b,'c>(inext:INode<'T>,ifail:INode<'T>,fn:'a -> 'b -> 'c -> State<'T> -> unit,
                                 parseA:ParseFn<'a>,parseB:ParseFn<'b>,parseC:ParseFn<'c>) =
     let mutable next = inext
     let mutable fail = ifail
@@ -83,9 +83,10 @@ type RouteNode3<'T,'a,'b,'c>(inext:INode<'T>,ifail:INode<'T>,fn:'a -> 'b -> 'c -
                     if v3.HasValue then
                         ctx.DNode <- x
                         fnOpt.Invoke(v1.Value,v2.Value,v3.Value,ctx)
-                    else fail.Apply ctx
-                else fail.Apply ctx    
-            else fail.Apply ctx
+                        true
+                    else false
+                else false    
+            else false
 
     interface INode<'T> with
         member __.Next with get () = next and set v = next <- v
@@ -93,7 +94,7 @@ type RouteNode3<'T,'a,'b,'c>(inext:INode<'T>,ifail:INode<'T>,fn:'a -> 'b -> 'c -
         member x.Apply (_) = failwith "Who's calling apply on a route node !? ya dipshit"    
 
 
-type RouteNode4<'T,'a,'b,'c,'d>(inext:INode<'T>,ifail:INode<'T>,fn:'a -> 'b -> 'c -> 'd -> Zapp<'T>,
+type RouteNode4<'T,'a,'b,'c,'d>(inext:INode<'T>,ifail:INode<'T>,fn:'a -> 'b -> 'c -> 'd -> State<'T> -> unit,
                                 parseA:ParseFn<'a>,parseB:ParseFn<'b>,parseC:ParseFn<'c>,parseD:ParseFn<'d>) =
     let mutable next = inext
     let mutable fail = ifail
@@ -112,10 +113,11 @@ type RouteNode4<'T,'a,'b,'c,'d>(inext:INode<'T>,ifail:INode<'T>,fn:'a -> 'b -> '
                         if v4.HasValue then
                             ctx.DNode <- x
                             fnOpt.Invoke(v1.Value,v2.Value,v3.Value,v4.Value,ctx)
-                        else fail.Apply ctx
-                    else fail.Apply ctx
-                else fail.Apply ctx    
-            else fail.Apply ctx
+                            true
+                        else false
+                    else false
+                else false    
+            else false
 
     interface INode<'T> with
         member __.Next with get () = next and set v = next <- v
@@ -217,13 +219,15 @@ let routef (method:METHODS) (pattern : string) (fn:IRouteNode<'T>) (argCount:int
     let last = pattern.Length - 1
 
     let rec go (i:int,ts:int,pcount,node:RNode<'T>) =
+        node.MethodFilters.Add method |> ignore
+
         let pl = pattern.IndexOf('%',i)
         if pl < 0 || pl = last then
             //Match Complete (no futher parse '%' chars
             if pcount = 0 then
                 failwith "'routef' (route Parse) used with no arguments? please add % format args or change to simple 'route' for non-parse routes"
             else
-                RNode.ExtendPath node (pattern -| ts) ( Complete( method,fn ))  //todo: boxing & upcasting bad for performance, need to fix
+                RNode.ExtendPath node (pattern -| ts) ( Complete( method,fn )) 
         else
             let fmtChar = pattern.[pl + 1]
             // overrided %% -> % case
@@ -237,12 +241,15 @@ let routef (method:METHODS) (pattern : string) (fn:IRouteNode<'T>) (argCount:int
                     // if node.MidFns |> List.exists (function | ApplyMatchAndComplete(c,_,_) -> fmtChar = c | _ -> false )
                     // then sprintf "duplicate paths detected '%s', Trie Build skipping..." pattern |> failwith
                     // else
-                        RNode.ExtendPath node (pattern.Substring(ts,pl - ts)) (MatchComplete( method,pcount,fn ))
+                        let nnode = RNode.ExtendPath node (pattern.Substring(ts,pl - ts)) (MatchComplete( method,pcount,fn ))
+                        nnode.MethodFilters.Add method |> ignore
+                        nnode
                 else //otherwise add mid pattern parse apply
                     //get node this parser will be on
                     let nnode = RNode.ExtendPath node (pattern.Substring(ts,pl - ts)) Empty
                     let cnode,midFns = getPostMatchNode argCount pcount fmtChar pattern.[pl+2] nnode.MidFns
                     nnode.MidFns <- midFns //update adjusted functions
+                    nnode.MethodFilters.Add method |> ignore
                     go(pl + 2, pl + 2, pcount + 1, cnode)
             // badly formated format string that has unknown char after %
             else
@@ -258,19 +265,19 @@ let routef (method:METHODS) (pattern : string) (fn:IRouteNode<'T>) (argCount:int
 ////////////////////////////////
 
 /// **get1**: GET Method filtered route with **one** parameter to be parsed and applied
-let inline get1 (fmt:PrintfFormat< ^a -> Zapp<'T>,_,_,Zapp<'T>>) = 
+let inline get1 (fmt:PrintfFormat< ^a -> State<'T> -> unit,_,_,State<'T> -> unit>) = 
     RouteBase<'T, ^a>(METHODS.GET,fmt.Value)
 
 /// **get2**: GET Method filtered route with **two** parameter to be parsed and applied
-let inline get2 (fmt:PrintfFormat< ^a -> ^b -> Zapp<'T>,_,_,Zapp<'T>>) = 
+let inline get2 (fmt:PrintfFormat< ^a -> ^b -> State<'T> -> unit,_,_,State<'T> -> unit>) = 
     RouteBase<'T, ^a, ^b>(METHODS.GET,fmt.Value)
 
 /// **get3**: GET Method filtered route with **three** parameter to be parsed and applied
-let inline get3 (fmt:PrintfFormat< ^a -> ^b -> ^c -> Zapp<'T>,_,_,Zapp<'T>>) =
+let inline get3 (fmt:PrintfFormat< ^a -> ^b -> ^c -> State<'T> -> unit,_,_,State<'T> -> unit>) =
     RouteBase<'T, ^a, ^b, ^c>(METHODS.GET,fmt.Value)
 
 /// **get4**: GET Method filtered route with **four** parameter to be parsed and applied
-let inline get4 (fmt:PrintfFormat< ^a -> ^b -> ^c -> ^d -> Zapp<'T>,_,_,Zapp<'T>>) =
+let inline get4 (fmt:PrintfFormat< ^a -> ^b -> ^c -> ^d -> State<'T> -> unit,_,_,State<'T> -> unit>) =
     RouteBase<'T, ^a, ^b, ^c>(METHODS.GET,fmt.Value)
 
 
@@ -278,59 +285,40 @@ let inline get4 (fmt:PrintfFormat< ^a -> ^b -> ^c -> ^d -> Zapp<'T>,_,_,Zapp<'T>
 //////////////////////////////////
 
 /// **post1**: POST Method filtered route with **one** parameter to be parsed and applied
-let inline post1 (fmt:PrintfFormat< ^a -> Zapp<'T>,_,_,Zapp<'T>>) = 
+let inline post1 (fmt:PrintfFormat< ^a -> State<'T> -> unit,_,_,State<'T> -> unit>) = 
     RouteBase<'T, ^a>(METHODS.POST,fmt.Value)
 
 /// **post2**: POST Method filtered route with **two** parameter to be parsed and applied
-let inline post2 (fmt:PrintfFormat< ^a -> ^b -> Zapp<'T>,_,_,Zapp<'T>>) = 
+let inline post2 (fmt:PrintfFormat< ^a -> ^b -> State<'T> -> unit,_,_,State<'T> -> unit>) = 
     RouteBase<'T, ^a, ^b>(METHODS.POST,fmt.Value)
 
 /// **post3**: POST Method filtered route with **three** parameter to be parsed and applied
-let inline post3 (fmt:PrintfFormat< ^a -> ^b -> ^c -> Zapp<'T>,_,_,Zapp<'T>>) (fn: ^a -> ^b -> ^c -> Zapp<'T>) =
+let inline post3 (fmt:PrintfFormat< ^a -> ^b -> ^c -> State<'T> -> unit,_,_,State<'T> -> unit>) (fn: ^a -> ^b -> ^c -> State<'T> -> unit) =
     RouteBase<'T, ^a, ^b, ^c>(METHODS.POST,fmt.Value)
 
 /// **post4**: POST Method filtered route with **four** parameter to be parsed and applied
-let inline post4 (fmt:PrintfFormat< ^a -> ^b -> ^c -> ^d -> Zapp<'T>,_,_,Zapp<'T>>) (fn: ^a -> ^b -> ^c -> ^d -> Zapp<'T>) =
+let inline post4 (fmt:PrintfFormat< ^a -> ^b -> ^c -> ^d -> State<'T> -> unit,_,_,State<'T> -> unit>) (fn: ^a -> ^b -> ^c -> ^d -> State<'T> -> unit) =
     RouteBase<'T, ^a, ^b, ^c>(METHODS.POST,fmt.Value)
 
 // PUT Functions
 ///////////////////////////////////
 
 /// **put1**: PUT Method filtered route with **one** parameter to be parsed and applied
-let inline put1 (fmt:PrintfFormat< ^a -> Zapp<'T>,_,_,Zapp<'T>>) = 
+let inline put1 (fmt:PrintfFormat< ^a -> State<'T> -> unit,_,_,State<'T> -> unit>) = 
     RouteBase<'T, ^a>(METHODS.PUT,fmt.Value)
 
 /// **put2**: PUT Method filtered route with **two** parameter to be parsed and applied
-let inline put2 (fmt:PrintfFormat< ^a -> ^b -> Zapp<'T>,_,_,Zapp<'T>>) = 
+let inline put2 (fmt:PrintfFormat< ^a -> ^b -> State<'T> -> unit,_,_,State<'T> -> unit>) = 
     RouteBase<'T, ^a, ^b>(METHODS.PUT,fmt.Value)
 
 /// **put3**: PUT Method filtered route with **three** parameter to be parsed and applied
-let inline put3 (fmt:PrintfFormat< ^a -> ^b -> ^c -> Zapp<'T>,_,_,Zapp<'T>>) (fn: ^a -> ^b -> ^c -> Zapp<'T>) =
+let inline put3 (fmt:PrintfFormat< ^a -> ^b -> ^c -> State<'T> -> unit,_,_,State<'T> -> unit>) (fn: ^a -> ^b -> ^c -> State<'T> -> unit) =
     RouteBase<'T, ^a, ^b, ^c>(METHODS.PUT,fmt.Value)
 
 /// **put4**: PUT Method filtered route with **four** parameter to be parsed and applied
-let inline put4 (fmt:PrintfFormat< ^a -> ^b -> ^c -> ^d -> Zapp<'T>,_,_,Zapp<'T>>) (fn: ^a -> ^b -> ^c -> ^d -> Zapp<'T>) =
+let inline put4 (fmt:PrintfFormat< ^a -> ^b -> ^c -> ^d -> State<'T> -> unit,_,_,State<'T> -> unit>) (fn: ^a -> ^b -> ^c -> ^d -> State<'T> -> unit) =
     RouteBase<'T, ^a, ^b, ^c>(METHODS.PUT,fmt.Value)
 
-// DELETE Functions
-///////////////////////////////////
-
-/// **delete1**: delete Method filtered route with **one** parameter to be parsed and applied
-let inline delete1 (fmt:PrintfFormat< ^a -> Zapp<'T>,_,_,Zapp<'T>>) = 
-    RouteBase<'T, ^a>(METHODS.DELETE,fmt.Value)
-
-/// **delete2**: delete Method filtered route with **two** parameter to be parsed and applied
-let inline delete2 (fmt:PrintfFormat< ^a -> ^b -> Zapp<'T>,_,_,Zapp<'T>>) = 
-    RouteBase<'T, ^a, ^b>(METHODS.DELETE,fmt.Value)
-
-/// **delete3**: delete Method filtered route with **three** parameter to be parsed and applied
-let inline delete3 (fmt:PrintfFormat< ^a -> ^b -> ^c -> Zapp<'T>,_,_,Zapp<'T>>) (fn: ^a -> ^b -> ^c -> Zapp<'T>) =
-    RouteBase<'T, ^a, ^b, ^c>(METHODS.DELETE,fmt.Value)
-
-/// **delete4**: delete Method filtered route with **four** parameter to be parsed and applied
-let inline delete4 (fmt:PrintfFormat< ^a -> ^b -> ^c -> ^d -> Zapp<'T>,_,_,Zapp<'T>>) (fn: ^a -> ^b -> ^c -> ^d -> Zapp<'T>) =
-    RouteBase<'T, ^a, ^b, ^c>(METHODS.DELETE,fmt.Value)
-
 
 // Runtime Processor
 /////////////////////////////////////////
@@ -354,7 +342,7 @@ type getNodeCompletionResult<'T> =
 
 let private emptyRange = Unchecked.defaultof<Range []>
 
-let processPath (abort:INode<'T>) (root:RNode<'T>) : Zapp<'T> =
+let processPath (abort:INode<'T>) (root:RNode<'T>) : State<'T> -> unit =
 
     fun ctx ->
 
@@ -362,36 +350,17 @@ let processPath (abort:INode<'T>) (root:RNode<'T>) : Zapp<'T> =
 
         let path : string = ctx.HttpContext.Request.Path.Value
         let last = path.Length - 1
-
-        let rec crawl (pos:int , node:RNode<'T>, mf , ef) =
-            if node.Token.Length > 0 then
-                let cp = commonPathIndex path pos node.Token
-                if cp = node.Token.Length then
-                    let nxtChar = pos + node.Token.Length
-                    if (nxtChar - 1 ) = last then //if have reached end of path through nodes, run HandlerFn
-                        ef(node.EndFns, pos, emptyRange )
-                    else
-                        match node.TryGetValue path.[nxtChar] with
-                        | true, cnode ->
-                            if (pos + cnode.Token.Length ) = last then //if have reached end of path through nodes, run HandlerFn
-                                ef(cnode.EndFns, pos + node.Token.Length, emptyRange )
-                            else                //need to continue down chain till get to end of path
-                                crawl (nxtChar,cnode,mf,ef)
-                        | false, _ ->
-                            // no further nodes, either a static url didnt match or there is a pattern match required
-                            mf( node.MidFns, nxtChar, emptyRange )
-                else
-                    abort.Apply ctx
-            elif node.Token.Length = 0 then
-                match node.TryGetValue path.[pos] with
-                | true, cnode ->
-                    crawl (pos,cnode,mf,ef)
-                | false, _ ->
-                    // no further nodes, either a static url didnt match or there is a pattern match required
-                    mf( node.MidFns, pos , emptyRange )
-            else
-                //printfn ">> failed to match %s path with %s token, commonPath=%i" (path.Substring(pos)) (node.Token) (commonPathIndex path pos node.Token)
-                abort.Apply ctx
+        let method = 
+            match ctx.HttpContext.Request.Method with
+            | "GET"     -> METHODS.GET
+            | "POST"    -> METHODS.POST 
+            | "PUT"     -> METHODS.PUT
+            | "DELETE"  -> METHODS.DELETE
+            | "PATCH"   -> METHODS.PATCH 
+            | _ -> METHODS.UNKNOWN 
+            
+
+        
 
         let rec checkCompletionPath (pos:int,node:RNode<'T>) = // this funciton is only used by parser paths
             //this function doesn't test array bounds as all callers do so before
@@ -432,23 +401,23 @@ let processPath (abort:INode<'T>) (root:RNode<'T>) : Zapp<'T> =
         //let createResult (args:obj list) (argCount:int) (pfc:ParseFnCache) =
 
 
-        let rec processEnd (fns:Cont<'T> list, pos, range:Range []) =
+        let rec processEnd (fns:Cont<'T> list, pos, range:Range []) : bool =
             match fns with
-            | [] -> abort.Apply ctx
+            | [] -> false
             | h :: t ->
                 match h with
                 | HandlerMap(method,inode) ->
                     if methodMatch(ctx,method) then
                         ctx.PathPosition <- pos
-                        inode.Apply ctx
-                    else
-                        abort.Apply ctx
+                        inode.Apply (ctx)
+                        true
+                    else false
                 | Complete (method,fn) -> 
                     if methodMatch(ctx,method) then
                         ctx.PathPosition <- pos
-                        fn.Parse(range,ctx)
-                    else
-                        abort.Apply ctx
+                        if fn.Parse(range,ctx) then true
+                        else processEnd (t,pos,range)
+                    else false
                 | x -> failwithf "Cont Mapping failed: %A in processEnd" x                    
 
         let rec processMid (fns:Cont<'T> list,pos, range) =
@@ -456,9 +425,9 @@ let processPath (abort:INode<'T>) (root:RNode<'T>) : Zapp<'T> =
             let inline applyMatchAndComplete pos pcount (range:Range []) (fn:IRouteNode<'T>) tail =
                 range.[pcount] <- Range(pos,last)
                 ctx.PathPosition <- pos
-                fn.Parse(range,ctx)  /// fall back on list not included and using default abort need tail fallback ???
-                // else processMid(tail, pos, range) // ??????????????????
-
+                if fn.Parse(range,ctx) then true
+                else processMid(tail, pos, range)
+                 
             let rec applyMatch pos pcount (f:char) (ca:char[]) n (range:Range []) tail  =
                 let nc = getNodeCompletion(ca, pos, n) 
                 match nc.Success with
@@ -477,7 +446,7 @@ let processPath (abort:INode<'T>) (root:RNode<'T>) : Zapp<'T> =
                 applyMatch pos 0 fmt nextChars node range tail  // Apply match using 0 inital paramter position
 
             match fns with
-            | [] -> abort.Apply ctx
+            | [] -> false
             | h :: t ->
                 match h with
                 | InitialMatch (argCount,fmt,nextChars,node) -> InitialMatch argCount fmt nextChars node t                 
@@ -488,11 +457,45 @@ let processPath (abort:INode<'T>) (root:RNode<'T>) : Zapp<'T> =
                             applyMatchAndComplete pos pcount [|Range(pos,last)|] fn t  //<< HACK
                         else
                             applyMatchAndComplete pos pcount range fn t 
-                    else abort.Apply ctx
+                    else false
                 | x -> failwithf "Cont Mapping failed: %A in processMid" x 
 
+        let rec crawl (pos:int , node:RNode<'T>) : bool =
+            if node.MethodFilters.Count > 0 && not (node.MethodFilters.Contains method) then
+                    false
+            else
+                if node.Token.Length > 0 then
+                    let cp = commonPathIndex path pos node.Token
+                    if cp = node.Token.Length then
+                        let nxtChar = pos + node.Token.Length
+                        if (nxtChar - 1 ) = last then //if have reached end of path through nodes, run HandlerFn
+                            processEnd(node.EndFns, pos, emptyRange )
+                        else
+                            match node.TryGetValue path.[nxtChar] with
+                            | true, cnode ->
+                                if (pos + cnode.Token.Length ) = last then //if have reached end of path through nodes, run HandlerFn
+                                    processEnd(cnode.EndFns, pos + node.Token.Length, emptyRange )
+                                else                //need to continue down chain till get to end of path
+                                    crawl (nxtChar,cnode)
+                            | false, _ ->
+                                // no further nodes, either a static url didnt match or there is a pattern match required
+                                processMid( node.MidFns, nxtChar, emptyRange )
+                    else
+                        false
+                elif node.Token.Length = 0 then
+                    match node.TryGetValue path.[pos] with
+                    | true, cnode ->
+                        crawl (pos,cnode)
+                    | false, _ ->
+                        // no further nodes, either a static url didnt match or there is a pattern match required
+                        processMid( node.MidFns, pos , emptyRange )
+                else
+                    //printfn ">> failed to match %s path with %s token, commonPath=%i" (path.Substring(pos)) (node.Token) (commonPathIndex path pos node.Token)
+                    false
+
         // begin path crawl process
-        crawl(ctx.PathPosition,root,processMid,processEnd)
+        if crawl(ctx.PathPosition,root) then () 
+        else abort.Apply(ctx)
 
 
 type RouterNode<'T>(inext:INode<'T>,ifail:INode<'T>,routes:((INode<'T> * INode<'T>) -> RNode<'T> -> RNode<'T>) list) =
@@ -510,8 +513,7 @@ type RouterNode<'T>(inext:INode<'T>,ifail:INode<'T>,routes:((INode<'T> * INode<'
         member __.Next with get () = Unchecked.defaultof<INode<'T>> and set _ = ()
         member __.Fail with get () = Unchecked.defaultof<INode<'T>> and set _ = ()
         member x.Apply (state:State<'T>) = 
-            processPath fail inode state
-
+            processPath fail inode (state)
 
 let inline router (routes:((INode<'T> * INode<'T>) -> RNode<'T> -> RNode<'T>) list) =
     fun (next:INode<'T>,fail:INode<'T>) ->
@@ -525,14 +527,6 @@ let subRoute (path:string) (fns:((INode<'T> * INode<'T>) -> RNode<'T>->RNode<'T>
             fn itree child |> ignore
         child
 
-type ChooseWrap<'T>(fns:PipeLine<'T> list) =
-    member x.Apply(next:INode<'T>,fail:INode<'T>) =
-        let rec go (ls:PipeLine<'T> list) =
-            match ls with
-            | [] -> fail
-            | h :: t ->
-                h(next,go t)
-        go fns
 
 /// **Description**
 ///     Choose provides a list of options the app attempts in order listed, returning false in any pipeline will proceed to the next pipeline on the list 
@@ -549,10 +543,35 @@ type ChooseWrap<'T>(fns:PipeLine<'T> list) =
 type PipelineList<'T> = PipeLine<'T> list
 type ActionList<'T> = (State<'T> -> unit) list
 
-let choose (fns:PipeLine<'T> list) = ChooseWrap<'T>(fns)
 
 // Wraps a Handler (Zapp) in a Pipeline function to allow binding in choose and other fixed seq type scenarios 
-let pipeline (fn:Zapp<'T>) =
+let pipeline (fn:State<'T> -> unit) =
     fun (next:INode<'T>,fail:INode<'T>) ->
         ChoiceNode(next,fail,fn) :> INode<'T>
 
+type ChooseWrap<'T> =
+| ChooseWrap of (INode<'T> * INode<'T> -> INode<'T>)
+
+type ChooseBuilder() =
+    member x.Delay(f) = f() 
+    member x.YieldFrom(pipe:PipeLine<'T>) = ChooseWrap(pipe)
+
+    member x.Yield(action:State<'T> -> unit) = ChooseWrap(fun (next:INode<'T>,fail:INode<'T>) -> ChoiceNode(next,fail,action) :> INode<'T> )
+
+    member x.Combine(ChooseWrap(parentFn),ChooseWrap(childFn)) =
+        ChooseWrap(fun (next:INode<'T>,fail:INode<'T>) ->
+            let child = childFn(next,fail)
+            parentFn(next,child)
+        )
+
+let choose = ChooseBuilder()
+
+let choosePipe (fns:PipeLine<'T> list) =     
+    ChooseWrap(fun (next:INode<'T>,fail:INode<'T>) ->
+    let rec go (ls:PipeLine<'T> list) =
+        match ls with
+        | [] -> fail
+        | h :: t ->
+            h(next,go t)
+    go fns)           
+

frameworks/FSharp/Zebra/src/App/State.fs

@@ -10,131 +10,144 @@ open System.Xml.Serialization
 open StreamBuffer
 open System.IO
 open EncodeHelper
-open System.Net.Mime
 
-[<Struct>]
-type GenericStateAwaiter<'T>(awaiter:TaskAwaiter<'T> ,continuation:'T -> unit,methodBuilder:AsyncTaskMethodBuilder) =
-    interface IAsyncStateMachine with
-        member __.MoveNext() =
-                continuation ( awaiter.GetResult() )  // runs cont, will update awaiter & continuation
-        member __.SetStateMachine (sm) = methodBuilder.SetStateMachine sm 
+open System.Text
+open System
+open TemplateViewEngine   
 
 [<Struct>]
-type PlainStateAwaiter(continuation:unit -> unit,methodBuilder:AsyncTaskMethodBuilder) =
-    interface IAsyncStateMachine with
-        member __.MoveNext() =
-                continuation ()  // runs cont, will update awaiter & continuation
-        member __.SetStateMachine sm = methodBuilder.SetStateMachine sm
+type GenericStateAwaiter<'T>(awaiter:TaskAwaiter<'T> ,continuation:'T -> unit) =
+    member x.Apply() = continuation ( awaiter.GetResult() ) 
 
 [<Struct>]
-type FinishStateAwaiter(methodBuilder:AsyncTaskMethodBuilder,ms:MemoryStream) =
-    interface IAsyncStateMachine with
-        member __.MoveNext() =         
-            MemoryStreamCache.Release ms
-            methodBuilder.SetResult()
-        member __.SetStateMachine sm = methodBuilder.SetStateMachine sm  
+type PlainStateAwaiter(continuation:unit -> unit) =
+    member x.MoveNext() = continuation () 
 
 
 ////////////////
 // nodes are embedded in list so on each node load there is no additional calls to fucntions
-type ContentType =
-| Text = 0uy
-| Json = 1uy
-| Xml = 2uy
-| Custom = 3uy
 
+type MachineState =
+| Start = 0uy
+| BindUnit = 1uy
+| BindGen = 2uy
+| Complete = 3uy
+| CompleteRelease = 4uy 
+
+[<Struct>]
+type BindType =
+| None
+| Text of text:string
+| Stream of stream:MemoryStream
+| Bytes of bytes:byte []
 
 type INode<'T> =
     abstract member Next  : INode<'T> with get, set
     abstract member Fail  : INode<'T> with get, set
     abstract member Apply : State<'T> -> unit
 
-and State<'T>(hctx: HttpContext, deps: 'T,amb: AsyncTaskMethodBuilder) =
-        let buffer = MemoryStreamCache.Get()
-        
-        member val MethodBuilder : AsyncTaskMethodBuilder = amb with get
-        member val HttpContext              = hctx with get,set
-        member val Dependencies             = deps with get // alternative dependency injection system
-        member val DNode : INode<'T>        = Unchecked.defaultof<INode<'T>> with get, set // <<<TEMP
-
-        member val PathPosition             = 0 with get, set // pos starts 0 and mutates via routers
-
-        member val Disposables              = List.empty<IDisposable> with get, set
-        member __.Buffer with get () = buffer
-        member val ContentType = ContentType.Text with get, set
-
-        member inline x.Next   () = x.DNode.Next.Apply x
-        member inline x.Fail   () = x.DNode.Next.Apply x
+and State<'T>(hctx: HttpContext, deps: 'T, amb: TaskCompletionSource<unit>) =
+
+        let mutable buffer = Unchecked.defaultof<MemoryStream>
+        let mutable bindUnit = Unchecked.defaultof<unit -> unit>
+        let mutable bindGen = Unchecked.defaultof<GenericStateAwaiter<obj>>
+        let mutable currentState = MachineState.Start
+        member x.BindUnit with get() = bindUnit and set v = bindUnit <- v
+        member x.BindGen with get() = bindGen and set v = bindGen <- v
+        member val BindType = BindType.None with get,set
+        member x.CurrentState with get() = currentState and set v = currentState <- v
+        member x.Continue : Action = Action (fun _ ->
+            match currentState with
+            | MachineState.Start    -> ()
+            | MachineState.BindGen  ->  bindGen.Apply()
+            | MachineState.BindUnit ->  bindUnit ()
+            | MachineState.CompleteRelease ->
+                amb.SetResult()
+                MemoryStreamCache.Release buffer
+            | MachineState.Complete
+            | _ -> amb.SetResult()
+        )       
+        member val HttpContext        : HttpContext = hctx with get
+        member val Dependencies : 'T = deps with get,set
+        member val DNode = Unchecked.defaultof<INode<'T>> with get,set
+        member val PathPosition : int = 0 with get, set
+        member val Disposables : IDisposable list = [] with get, set 
                    
         // Computaion Expresssion Members
         /////////////////////////////////
-        member inline x.Run(_:unit) = () // runs last on customOperations, runs after first bind
-
-        member inline x.Run(n:INode<'T>) = // runs last on customOperations, runs after first bind
-            n.Apply x
-
+        member inline x.Run(_:unit) = ()  // runs after first async bind
+
+        member inline x.Run(n:BindType) = // runs last on customOperations,
+            match n with
+            | BindType.None -> ()
+            | BindType.Text _ 
+            | BindType.Stream _ 
+            | BindType.Bytes _ -> x.BindType <- n
+            x.DNode.Next.Apply x
 
         member inline x.Zero() =
-            // Zero presumes a true, failing must be explicit, progressing is implicit 
-            x.DNode.Next.Apply x
+            // Zero presumes a true, failing must be explicit, progressing is implicit
+            x.DNode.Next.Apply (x)
 
-        member inline x.Return(_:unit) = x.DNode.Next 
+        member inline x.Return(_:unit) = x.BindType 
+        
         member inline x.Return(result: bool) = // runs after last bind
             if result then
-                x.DNode.Next.Apply x
+                x.DNode.Next.Apply (x)
             else
-                x.DNode.Fail.Apply x
-        member inline x.Return(a) = () // passthrough bound values for now
-
-        member inline x.Bind<'a,'b>(n:INode<'T>,b:unit -> unit) = b () // input is output of last custom op
+                x.DNode.Fail.Apply (x)                
+            
+        member inline x.Bind(bt:BindType,b:unit -> unit) =
+            x.BindType <- bt
+            b ()// input is output of last custom op
 
-        member inline x.Bind(task:Task, continuation : unit -> unit) : unit =
-            let awt : TaskAwaiter = task.GetAwaiter()
+        member inline x.Bind(task:Task,continuation : unit -> unit) : unit =
+            let mutable awt : TaskAwaiter = task.GetAwaiter()
             if awt.IsCompleted then
                 continuation ()
             else
-                let mutable awtref = awt
-                let mutable smref = PlainStateAwaiter(continuation,x.MethodBuilder)
-                x.MethodBuilder.AwaitUnsafeOnCompleted(&awtref,&smref)
+                x.BindUnit <- continuation
+                x.CurrentState <- MachineState.BindUnit
+                awt.UnsafeOnCompleted x.Continue
 
-        member inline x.Bind(configurableTaskLike:Task< ^inp>, continuation : ^inp -> unit) : unit =
-            let awt : TaskAwaiter< ^inp> = configurableTaskLike.GetAwaiter() 
+        member inline x.Bind< ^inp>(taskGen:Task< ^inp>,continuation : ^inp -> unit) : unit =
+            let mutable awt : TaskAwaiter< ^inp> = taskGen.GetAwaiter() 
             if awt.IsCompleted then
                 continuation (awt.GetResult())
             else
-                let mutable awtref = awt
-                let mutable smref =  GenericStateAwaiter< ^inp>(awt,continuation,x.MethodBuilder)
-                x.MethodBuilder.AwaitUnsafeOnCompleted(&awtref,&smref)          
+                let mutable smref = GenericStateAwaiter< ^inp>(awt,continuation)
+                let mutable cast = Unsafe.As<GenericStateAwaiter< ^inp>,GenericStateAwaiter<obj>>(&smref)
+                x.BindGen <- cast
+                x.CurrentState <- MachineState.BindGen
+                awt.UnsafeOnCompleted x.Continue  
 
         member inline x.Using(disp : #IDisposable, continuation : #IDisposable -> unit) =
             x.Disposables <- disp :> IDisposable :: x.Disposables
             continuation disp
-               
-        member inline x.SetComplete() =
-            let inline contType (v:string) = x.HttpContext.Response.Headers.["Content-Type"] <- StringValues v
-            
-            if x.Buffer.Length > 0L then
-                x.HttpContext.Response.Headers.["Content-Length"] <- StringValues(x.Buffer.Length.ToString())
-                x.HttpContext.Response.StatusCode <- 200
-                match x.ContentType with
-                | ContentType.Custom -> ()
-                | ContentType.Text -> contType "text/plain" 
-                | ContentType.Json -> contType "application/json"
-                | ContentType.Xml  -> contType "application/xml"
-                | _                -> contType "text/plain"
-
-                x.Buffer.Seek(0L,SeekOrigin.Begin) |> ignore
-
-                let t = x.Buffer.CopyToAsync(x.HttpContext.Response.Body)
-                let awt = t.GetAwaiter()
-                let mutable awtref = awt
-                let mutable smref = FinishStateAwaiter(x.MethodBuilder,x.Buffer)
-                x.MethodBuilder.AwaitUnsafeOnCompleted(&awtref,&smref)
-
-            else                
-                x.HttpContext.Response.Headers.["Content-Length"] <- StringValues("0")
-                x.HttpContext.Response.StatusCode <- 404
-                x.MethodBuilder.SetResult()
+
+        member x.SetComplete() =
+            match x.BindType with
+            | BindType.None -> amb.SetResult()
+            | BindType.Text v ->
+                let bytes = Encoding.UTF8.GetBytes(v)
+                x.HttpContext.Response.Headers.["Content-Length"] <- StringValues(bytes.Length.ToString())
+                let t = x.HttpContext.Response.Body.WriteAsync(bytes,0,bytes.Length)
+                x.CurrentState <- MachineState.Complete
+                t.GetAwaiter().UnsafeOnCompleted x.Continue
+                
+            | BindType.Stream ms ->
+                buffer <- ms
+                x.HttpContext.Response.Headers.["Content-Length"] <- StringValues(ms.Length.ToString())
+                buffer.Seek(0L,SeekOrigin.Begin) |> ignore
+                let t = ms.CopyToAsync(x.HttpContext.Response.Body)
+                x.CurrentState <- MachineState.CompleteRelease
+                t.GetAwaiter().UnsafeOnCompleted x.Continue
+
+            | BindType.Bytes bytes ->
+                x.HttpContext.Response.Headers.["Content-Length"] <- StringValues(bytes.Length.ToString())
+                let t = x.HttpContext.Response.Body.WriteAsync(bytes,0,bytes.Length)
+                x.CurrentState <- MachineState.Complete
+                t.GetAwaiter().UnsafeOnCompleted x.Continue
 
             // at end of pipeline when buffer written, we can start disposing waiting for Async copy to finish                         
             for disp in x.Disposables do disp.Dispose()   // may need to be pushed out to FinishStateAwaiter
@@ -142,10 +155,9 @@ and State<'T>(hctx: HttpContext, deps: 'T,amb: AsyncTaskMethodBuilder) =
         // Custom Ops
         /////////////////////////////
         
-
+        
         // Text
         ////////
-        member inline x.Text(text: string ) = StreamWrite(text,x.Buffer) ;    
 
         [<CustomOperation("text",MaintainsVariableSpaceUsingBind=true)>] //,MaintainsVariableSpaceUsingBind = true)>]
         
@@ -154,35 +166,67 @@ and State<'T>(hctx: HttpContext, deps: 'T,amb: AsyncTaskMethodBuilder) =
         /// **Parameters**
         ///   * `
         ///   * `text` - parameter of type `string`
-
-        member inline x.Text<'a>(n:INode<'T>, text: string ) =  x.Text(text); n
+        member inline x.Text(bt:BindType, text: string ) =
+            match bt with
+            | BindType.None -> 
+                x.HttpContext.Response.Headers.["Content-Type"] <- StringValues "text/plain"
+                BindType.Text(text)
+            | BindType.Text v ->
+                let ms = MemoryStreamCache.Get()
+                StreamWrite(v,ms)
+                StreamWrite(text,ms)
+                BindType.Stream ms
+            | BindType.Stream ms ->
+                StreamWrite(text,ms)
+                bt
+            | BindType.Bytes _ -> failwith "Error : passed json bytes into a text pipeline!?!"
+
+        member inline x.Text(text: string ) = x.Text(x.BindType,text)        
 
         // Json
         //////////
         
-        member inline x.Json< ^a>(value: ^a ) =
-            Utf8Json.JsonSerializer.Serialize< ^a>(x.Buffer,value)
-            x.ContentType <- ContentType.Json
         [<CustomOperation("json",MaintainsVariableSpaceUsingBind=true)>]//,MaintainsVariableSpaceUsingBind = true)>]
-        member inline x.Json< ^a>(n:INode<'T>, value: ^a ) =  x.Json< ^a>(value: ^a); n
-
-
-        // XML
-        /////////
-        member inline x.Xml< ^a>(value: ^a ) =
-            let ser = XmlSerializer(typeof< ^a>).Serialize(x.Buffer,value)   // <<< should find better serialiser
-            x.ContentType <- ContentType.Xml
+        member inline x.Json< ^a>(n:BindType, value: ^a ) =
+            match n with
+            | BindType.None -> 
+                x.HttpContext.Response.Headers.["Content-Type"] <- StringValues "application/json"
+                BindType.Bytes (Utf8Json.JsonSerializer.Serialize< ^a>(value))
+            | BindType.Text _ -> failwith "Error : passed text into json funtion"
+            | BindType.Stream ms -> Utf8Json.JsonSerializer.Serialize< ^a>(ms,value) ; n
+            | BindType.Bytes bytes ->
+                let ms = MemoryStreamCache.Get()
+                ms.Write(bytes,0,bytes.Length)
+                Utf8Json.JsonSerializer.Serialize< ^a>(ms,value)
+                BindType.Stream ms
+
+        member inline x.Json< ^a>(value: ^a ) = x.Json< ^a>(x.BindType, value) 
+
+         
+       
+        [<CustomOperation("render",MaintainsVariableSpaceUsingBind=true)>]//,MaintainsVariableSpaceUsingBind = true)>]
+        member inline x.Render< ^a>(n:BindType, value: ^a, compiledNodes :CompiledNode< ^a> [] ) =
+            match n with
+            | BindType.None -> 
+                x.HttpContext.Response.Headers.["Content-Type"] <- StringValues "text/html;charset=utf-8"
+                let ms = MemoryStreamCache.Get()
+                renderHtmlDocument value compiledNodes ms
+                BindType.Stream ms
+            | _ -> failwith "render can be the only writer in a pipeline" 
+
+        member inline x.Render< ^a>(value: ^a,compiledNodes :CompiledNode< ^a> []) =
+            x.HttpContext.Response.Headers.["Content-Type"] <- StringValues "text/html;charset=utf-8"
+            let ms = MemoryStreamCache.Get()
+            renderHtmlDocument value compiledNodes ms
+            x.BindType <- BindType.Stream ms
 
-        [<CustomOperation("xml",MaintainsVariableSpaceUsingBind=true)>]//,MaintainsVariableSpaceUsingBind = true)>]
-        member inline x.Xml< ^a>(n:INode<'T>, value: ^a ) = x.Xml< ^a>(value: ^a) ; n
-        
         // setHeader
         ////////////
         member inline x.SetHeader(header: string, value:string ) =
             x.HttpContext.Response.Headers.[header] <- StringValues(value)  
 
         [<CustomOperation("setHeader",MaintainsVariableSpaceUsingBind=true)>]//,MaintainsVariableSpaceUsingBind = true)>]
-        member inline x.SetHeader(n:INode<'T>, header: string, value:string ) = x.SetHeader(header, value) ; n
+        member inline x.SetHeader(n:BindType, header: string, value:string ) = x.SetHeader(header, value) ; n
 
         // status code
         ///////////////
@@ -190,19 +234,16 @@ and State<'T>(hctx: HttpContext, deps: 'T,amb: AsyncTaskMethodBuilder) =
             x.HttpContext.Response.StatusCode <- value
 
         [<CustomOperation("status",MaintainsVariableSpaceUsingBind=true)>]//,MaintainsVariableSpaceUsingBind = true)>]
-        member inline x.SetStatus(n:INode<'T>, value:int ) = x.SetStatus(value) ; n
+        member inline x.SetStatus(n:BindType, value:int ) = x.SetStatus(value) ; n
 
         // content_type
         ////////////////////
         member inline x.SetContentType(value:string ) =
-            x.ContentType <- ContentType.Custom
             x.HttpContext.Response.Headers.["Content-Type"] <- StringValues value
 
         
-        [<CustomOperation("content_type",MaintainsVariableSpaceUsingBind=true)>]//,MaintainsVariableSpaceUsingBind = true)>]
-        member inline x.SetContentType(_:unit, value:string ) = x.SetContentType(value)
-
-
+        [<CustomOperation("contentType",MaintainsVariableSpaceUsingBind=true)>]//,MaintainsVariableSpaceUsingBind = true)>]
+        member inline x.SetContentType(n:BindType, value:string ) = x.SetContentType(value) ; n
 
 and Zapp<'T> = State<'T> -> unit
 and PipeLine<'T> = (INode<'T> * INode<'T>) -> INode<'T>

frameworks/FSharp/Zebra/src/App/TemplateEngine.fs

@@ -0,0 +1,274 @@
+module TemplateViewEngine
+open System.IO
+open System.Text
+open System.Net
+
+
+type Stream with
+    member x.Write(value:int) =
+        let mutable v = value
+        
+        if v < 0 then
+            v <- (~~~v) + 1
+            x.WriteByte(byte '-')
+        
+        // for i in 0 .. 8 do
+        //     if v >= divisors.[i] then Math.DivRem(v,divisors.[i],&v) |> byte |> ms.WriteByte
+        let inline check divisor =
+            if v >= divisor then byte '0' + (System.Math.DivRem(v,divisor,&v) |> byte) |> x.WriteByte
+
+        check 1000000000
+        check 100000000
+        check 10000000
+        check 1000000
+        check 100000
+        check 10000
+        check 1000
+        check 100
+        check 10
+
+        byte '0' + (v |> byte) |> x.WriteByte
+
+    member x.Write(value:string) =
+        for char in value do
+            if int char < 128 then // vast majority of encoding <128 
+                x.WriteByte(byte char)
+            else
+            for byte in Encoding.UTF8.GetBytes([|char|]) do
+                x.WriteByte byte    
+
+
+type CompiledNode<'T> =
+| CText of byte []
+| CAttr of ('T -> string * string)
+| CBindStr of ('T -> string)
+| CBindInt of ('T -> int)
+| CBindIf of ('T -> bool) * CompiledNode<'T> [] * CompiledNode<'T> []
+| CBindFor of ('T * Stream -> unit)
+
+type XmlAttr<'T> =
+| KeyValue of string * string
+| BindAttr of ('T -> string * string)
+
+type XmlNode<'T> =
+| ParentNode of  string * XmlAttr<'T> list * XmlNode<'T> list
+| VoidNode of  string * XmlAttr<'T> list 
+| EncodedText of string
+| RawText of string
+| BindStr of ('T -> string)
+| BindInt of ('T -> int)
+| BindIf of ('T -> bool) * CompiledNode<'T> [] * CompiledNode<'T> []
+| BindFor of ('T * Stream -> unit)
+
+let inline toUTF8 (v:string) = Encoding.UTF8.GetBytes v
+
+let writeFlush (sb:StringBuilder,acc:CompiledNode<'T> list) =
+    if sb.Length > 0 
+    then 
+        let nacc = (sb.ToString() |> toUTF8 |> CText) :: acc
+        sb.Clear() |> ignore
+        nacc
+    else acc
+
+let private compile (raw:XmlNode<'T>) (prefix:string option) : CompiledNode<'T> [] =
+    let rec go node (sb:StringBuilder) acc =
+        match node with
+        | ParentNode (name,attrs,children) ->
+            let mutable acc = acc 
+            sb.Append("<" + name) |> ignore
+            for attr in attrs do
+                match attr with
+                | KeyValue (key,value) -> sb.Append(key + "=" + value) |> ignore
+                | BindAttr (fn) -> 
+                    acc <- CAttr fn :: writeFlush(sb,acc)
+                //| add bool flag
+            sb.Append ">" |> ignore
+
+            for child in children do
+                acc <- go child sb acc
+            
+            sb.Append("</" + name + ">") |> ignore
+            acc
+                
+        | VoidNode (name,attrs) ->
+            let mutable acc = acc 
+            sb.Append("<" + name) |> ignore
+            for attr in attrs do
+                match attr with
+                | KeyValue (key,value) -> sb.Append(key + "=" + value) |> ignore
+                | BindAttr (fn) -> 
+                    acc <- CAttr fn :: writeFlush(sb,acc)
+                //| add bool flag            
+            sb.Append(" />") |> ignore
+            acc
+        | EncodedText txt -> sb.Append (WebUtility.HtmlEncode txt) |> ignore ; acc
+        | RawText txt    -> sb.Append txt |> ignore; acc
+        | BindStr fn        -> CBindStr fn :: writeFlush(sb,acc)
+        | BindInt fn        -> CBindInt fn :: writeFlush(sb,acc)
+        | BindIf (p,t,f) -> CBindIf(p,t,f) :: writeFlush(sb,acc)
+        | BindFor fn     -> CBindFor(fn) :: writeFlush(sb,acc)
+    
+    let sb = 
+        match prefix with
+        | Some pre -> StringBuilder(pre) // re-usable stringbuilder for building string parts
+        | None -> StringBuilder()
+
+    let acc = go raw sb [] // node list in reverse order so position backwards down array
+    let acc' = writeFlush(sb,acc)
+    let result = Array.zeroCreate<_>(acc'.Length)
+    let rec roll (ls,index) =
+        match ls, index with
+        | [] , -1 -> ()
+        | h :: t, i -> result.[i] <- h ; roll (t,i - 1)
+        | _,_ -> failwith "unexpected unroll error"
+    roll (acc',result.Length - 1)
+    result
+
+let rec processNodes (item:'T,sw:Stream,nodes:CompiledNode<'T> [] ) =
+    for node in nodes do
+        match node with                
+        | CText v -> sw.Write(v,0,v.Length) //.Write v
+        | CBindStr fn -> item |> fn |> WebUtility.HtmlEncode |> sw.Write
+        | CBindInt fn -> item |> fn |> sw.Write
+        | CAttr fn -> let key,value = fn item in sw.Write(key) ; sw.Write("=") ; sw.Write(value)  
+        | CBindIf (pred,trueFns,falseFns) ->
+            if pred item then
+                processNodes(item,sw,trueFns)
+            else
+                processNodes(item,sw,falseFns)
+        | CBindFor (fn) -> fn(item,sw)
+
+let compileDoc (raw:XmlNode<'T>) = 
+    compile raw (Some "<!DOCTYPE html>")
+
+let bindFor<'T,'U> (enumFn:'T -> #seq<'U>) (template:XmlNode<'U>) =
+    let compiledNodes = compile template None
+    BindFor (fun (model:'T,sw:Stream) ->
+        for item in enumFn model do
+            processNodes(item,sw,compiledNodes)
+    )
+
+let bindIf<'T> (predicate:'T -> bool,trueTemplate:XmlNode<'T>,falseTemplate:XmlNode<'T>) =
+    let trueNodes = compile trueTemplate None
+    let falseNodes = compile falseTemplate None
+    BindIf(predicate,trueNodes,falseNodes)
+
+let inline bindStr<'T>(map:'T -> string) = BindStr(map)
+let inline bindInt<'T>(map:'T -> int) = BindInt(map)
+
+let inline html attrs children      = ParentNode("html",attrs,children )
+let inline ``base`` attrs           = VoidNode("base",attrs )
+let inline head attrs children      = ParentNode("head",attrs,children )
+let inline link attrs               = VoidNode("link",attrs )
+let inline meta attrs               = VoidNode("meta",attrs )
+let inline style attrs children     = ParentNode("style",attrs,children )
+let inline title attrs children     = ParentNode("title",attrs,children )
+let inline body attrs children      = ParentNode("body",attrs,children )
+let inline address attrs children   = ParentNode("address",attrs,children )
+let inline article attrs children   = ParentNode("article",attrs,children )
+let inline aside attrs children     = ParentNode("aside",attrs,children )
+let inline footer attrs children    = ParentNode("footer",attrs,children )
+let inline hgroup attrs children    = ParentNode("hgroup",attrs,children )
+let inline h1 attrs children        = ParentNode("h1",attrs,children )
+let inline h2 attrs children        = ParentNode("h2",attrs,children )
+let inline h3 attrs children        = ParentNode("h3",attrs,children )
+let inline h4 attrs children        = ParentNode("h4",attrs,children )
+let inline h5 attrs children        = ParentNode("h5",attrs,children )
+let inline h6 attrs children        = ParentNode("h6",attrs,children )
+let inline header attrs children    = ParentNode("header",attrs,children )
+let inline nav attrs children       = ParentNode("nav",attrs,children )
+let inline section attrs children   = ParentNode("section",attrs,children )
+let inline dd attrs children        = ParentNode("dd",attrs,children )
+let inline div attrs children       = ParentNode("div",attrs,children )
+let inline dl attrs children        = ParentNode("dl",attrs,children )
+let inline dt attrs children        = ParentNode("dt",attrs,children )
+let inline figcaption attrs children= ParentNode("figcaption",attrs,children )
+let inline figure attrs children    = ParentNode("figure",attrs,children )
+let inline hr attrs                 = VoidNode("hr",attrs )
+let inline li attrs children        = ParentNode("li",attrs,children )
+let inline main attrs children      = ParentNode("main",attrs,children )
+let inline ol attrs children        = ParentNode("ol",attrs,children )
+let inline p attrs children         = ParentNode("p",attrs,children )
+let inline pre attrs children       = ParentNode("pre",attrs,children )
+let inline ul attrs children        = ParentNode("ul",attrs,children )
+let inline a attrs children         = ParentNode("a",attrs,children )
+let inline abbr attrs children      = ParentNode("abbr",attrs,children )
+let inline b attrs children         = ParentNode("b",attrs,children )
+let inline bdi attrs children       = ParentNode("bdi",attrs,children )
+let inline bdo attrs children       = ParentNode("bdo",attrs,children )
+let inline br attrs                 = VoidNode("br",attrs )
+let inline cite attrs children      = ParentNode("cite",attrs,children )
+let inline code attrs children      = ParentNode("code",attrs,children )
+let inline data attrs children      = ParentNode("data",attrs,children )
+let inline dfn attrs children       = ParentNode("dfn",attrs,children )
+let inline em attrs children        = ParentNode("em",attrs,children )
+let inline i attrs children         = ParentNode("i",attrs,children )
+let inline kbd attrs children       = ParentNode("kbd",attrs,children )
+let inline mark attrs children      = ParentNode("mark",attrs,children )
+let inline q attrs children         = ParentNode("q",attrs,children )
+let inline rp attrs children        = ParentNode("rp",attrs,children )
+let inline rt attrs children        = ParentNode("rt",attrs,children )
+let inline rtc attrs children       = ParentNode("rtc",attrs,children )
+let inline ruby attrs children      = ParentNode("ruby",attrs,children )
+let inline s attrs children         = ParentNode("s",attrs,children )
+let inline samp attrs children      = ParentNode("samp",attrs,children )
+let inline small attrs children     = ParentNode("small",attrs,children )
+let inline span attrs children      = ParentNode("span",attrs,children )
+let inline strong attrs children    = ParentNode("strong",attrs,children )
+let inline sub attrs children       = ParentNode("sub",attrs,children )
+let inline sup attrs children       = ParentNode("sup",attrs,children )
+let inline time attrs children      = ParentNode("time",attrs,children )
+let inline u attrs children         = ParentNode("u",attrs,children )
+let inline var attrs children       = ParentNode("var",attrs,children )
+let inline wbr attrs                = VoidNode("wbr",attrs )
+let inline area attrs               = VoidNode("area",attrs )
+let inline audio attrs children     = ParentNode("audio",attrs,children )
+let inline img attrs                = VoidNode("img",attrs )
+let inline map attrs children       = ParentNode("map",attrs,children )
+let inline track attrs              = VoidNode("track",attrs )
+let inline video attrs children     = ParentNode("video",attrs,children )
+let inline embed attrs              = VoidNode("embed",attrs )
+let inline object attrs children    = ParentNode("object",attrs,children )
+let inline param attrs              = VoidNode("param",attrs )
+let inline source attrs             = VoidNode("source",attrs )
+let inline canvas attrs children    = ParentNode("canvas",attrs,children )
+let inline noscript attrs children  = ParentNode("noscript",attrs,children )
+let inline script attrs children    = ParentNode("script",attrs,children )
+let inline del attrs children       = ParentNode("del",attrs,children )
+let inline ins attrs children       = ParentNode("ins",attrs,children )
+let inline caption attrs children   = ParentNode("caption",attrs,children )
+let inline col attrs                = VoidNode("col",attrs )
+let inline colgroup attrs children  = ParentNode("colgroup",attrs,children )
+let inline table attrs children     = ParentNode("table",attrs,children )
+let inline tbody attrs children     = ParentNode("tbody",attrs,children )
+let inline td attrs children        = ParentNode("td",attrs,children )
+let inline tfoot attrs children     = ParentNode("tfoot",attrs,children )
+let inline th attrs children        = ParentNode("th",attrs,children )
+let inline thead attrs children     = ParentNode("thead",attrs,children )
+let inline tr attrs children        = ParentNode("tr",attrs,children )
+let inline button attrs children    = ParentNode("button",attrs,children )
+let inline datalist attrs children  = ParentNode("datalist",attrs,children )
+let inline fieldset attrs children  = ParentNode("fieldset",attrs,children )
+let inline form attrs children      = ParentNode("form",attrs,children )
+let inline input attrs              = VoidNode("input",attrs )
+let inline label attrs children     = ParentNode("label",attrs,children )
+let inline legend attrs children    = ParentNode("legend",attrs,children )
+let inline meter attrs children     = ParentNode("meter",attrs,children )
+let inline optgroup attrs children  = ParentNode("optgroup",attrs,children )
+let inline option attrs children    = ParentNode("option",attrs,children )
+let inline output attrs children    = ParentNode("output",attrs,children )
+let inline progress attrs children  = ParentNode("progress",attrs,children )
+let inline select attrs children    = ParentNode("select",attrs,children )
+let inline textarea attrs children  = ParentNode("textarea",attrs,children )
+let inline details attrs children   = ParentNode("details",attrs,children )
+let inline dialog attrs children    = ParentNode("dialog",attrs,children )
+let inline menu attrs children      = ParentNode("menu",attrs,children )
+let inline menuitem attrs           = VoidNode("menuitem",attrs )
+let inline summary attrs children   = ParentNode("summary",attrs,children )
+let inline encodedText txt          = EncodedText(txt)
+let inline rawText txt              = RawText(txt)
+let inline comment txt              = RawText("<!-- " + txt + " -->")
+
+
+let inline renderHtmlDocument (model:'T) ( document : CompiledNode<'T> []) (writer : #Stream) =
+    processNodes(model,writer,document) 

frameworks/FSharp/Zebra/zebra-simple.dockerfile

@@ -0,0 +1,12 @@
+FROM microsoft/dotnet:2.1-sdk-stretch AS build
+WORKDIR /app
+COPY src/App .
+RUN dotnet publish -c Release -o out
+
+FROM microsoft/dotnet:2.1-aspnetcore-runtime AS runtime
+ENV ASPNETCORE_URLS http://+:8080
+ENV COMPlus_ReadyToRun 0
+WORKDIR /app
+COPY --from=build /app/out ./
+
+ENTRYPOINT ["dotnet", "App.dll","simple"]