#4 add Context record, small cleanups

Sitelets/Application.fs

@@ -34,21 +34,19 @@ type Application =
 
     static member BaseMultiPage f = Sitelet.Infer f
 
-    static member BaseSinglePage (f: HttpContext -> obj) =
+    static member BaseSinglePage (f: Context<SPA.EndPoint> -> obj) =
         {
             Router = Router.Single SPA.EndPoint.Home "/"
             Controller = fun ctx _ -> f ctx
         }
 
-    static member SinglePage (f: Func<HttpContext, obj>) : Sitelet<SPA.EndPoint> =
+    static member SinglePage (f: Func<Context<SPA.EndPoint>, obj>) : Sitelet<SPA.EndPoint> =
         Application.BaseSinglePage (fun ctx -> f.Invoke ctx)
 
-    static member MultiPage (f: Func<HttpContext, 'EndPoint, obj>) : Sitelet<'EndPoint> =
+    static member MultiPage (f: Func<Context<'EndPoint>, 'EndPoint, obj>) : Sitelet<'EndPoint> =
         Application.BaseMultiPage (fun ctx ep -> f.Invoke(ctx, ep))
 
-    static member Text (f: Func<HttpContext, string>) : Sitelet<SPA.EndPoint> =
+    static member Text (f: Func<Context<SPA.EndPoint>, string>) : Sitelet<SPA.EndPoint> =
         Application.BaseSinglePage (fun ctx ->
-            do
-                ctx.Response.WriteAsync(f.Invoke ctx)
-                |> Async.AwaitTask |> Async.RunSynchronously
-            ( f.Invoke ctx):> obj)
+            f.Invoke ctx |> box
+        )

Sitelets/Application.fsi

@@ -31,19 +31,19 @@ open Microsoft.AspNetCore.Http
 [<Class>]
 type Application =
     /// Create a multi-page application.
-    static member BaseMultiPage : (HttpContext -> 'EndPoint -> obj) -> Sitelet<'EndPoint>
+    static member BaseMultiPage : (Context<'EndPoint> -> 'EndPoint -> obj) -> Sitelet<'EndPoint>
 
     /// Create a single-page HTML application.
-    static member BaseSinglePage : (HttpContext -> obj) -> Sitelet<SPA.EndPoint>
+    static member BaseSinglePage : (Context<SPA.EndPoint> -> obj) -> Sitelet<SPA.EndPoint>
 
     /// Create a single-page application that returns text.
     // static member Text : (Context<SPA.EndPoint> -> string) -> Sitelet<SPA.EndPoint>
 
     /// Create a multi-page application.
-    static member MultiPage : Func<HttpContext, 'EndPoint, obj> -> Sitelet<'EndPoint>
+    static member MultiPage : Func<Context<'EndPoint>, 'EndPoint, obj> -> Sitelet<'EndPoint>
 
     /// Create a single-page HTML application.
-    static member SinglePage : Func<HttpContext, obj> -> Sitelet<SPA.EndPoint>
+    static member SinglePage : Func<Context<SPA.EndPoint>, obj> -> Sitelet<SPA.EndPoint>
 
     /// Create a single-page application that returns text.
-    static member Text : Func<HttpContext, string> -> Sitelet<SPA.EndPoint>
+    static member Text : Func<Context<SPA.EndPoint>, string> -> Sitelet<SPA.EndPoint>

Sitelets/Middleware.fs

@@ -43,33 +43,11 @@ module Middleware =
         | Some sitelet ->
             Func<_,_,_>(fun (httpCtx: HttpContext) (next: Func<Task>) ->
                 let req = httpCtx.Request
-                let rec contentHelper (content: obj) =
-                    async {
-                        match content with
-                        | :? string as stringContent ->
-                            httpCtx.Response.StatusCode <- StatusCodes.Status200OK
-                            do! httpCtx.Response.WriteAsync(stringContent) |> Async.AwaitTask
-                        | :? IActionResult as actionResult ->
-                            let actionCtx = ActionContext(httpCtx, RouteData(), ActionDescriptor())
-                            do! actionResult.ExecuteResultAsync(actionCtx) |> Async.AwaitTask
-                        | _ ->
-                            let contentType = content.GetType()
-                            if contentType.IsGenericType && contentType.GetGenericTypeDefinition() = typedefof<Task<_>> then
-                                let contentTask = content :?> Task
-                                do! contentTask |> Async.AwaitTask
-                                let contentResult =
-                                    let resultGetter = contentType.GetProperty("Result")
-                                    resultGetter.GetMethod.Invoke(contentTask, [||])
-                                return! contentHelper contentResult
-                            else
-                                httpCtx.Response.StatusCode <- StatusCodes.Status200OK
-                                //let jsonOptions = httpCtx.RequestServices.GetService(typeof(JsonSerializerOptions))
-                                do! System.Text.Json.JsonSerializer.SerializeAsync(httpCtx.Response.Body, content) |> Async.AwaitTask
-                    }
                 match sitelet.Router.Route req with
                 | Some endpoint ->
-                    let content = sitelet.Controller httpCtx endpoint
-                    contentHelper content
+                    let ctx = SiteletHelper.createContext sitelet httpCtx
+                    let content = sitelet.Controller ctx endpoint
+                    SiteletHelper.contentHelper httpCtx content
                     |> Async.StartAsTask :> Task
                 | None -> next.Invoke()
             )

Sitelets/Sitelet.fs

@@ -29,10 +29,23 @@ open System.Threading.Tasks
 open System.Runtime.CompilerServices
 open Microsoft.AspNetCore.Http
 
+type Context<'T> =
+    {
+        Link : 'T -> string
+        HttpContext : HttpContext
+    }
+
+module Context =
+    let Map (f: 'T2 -> 'T1) (ctx: Context<'T1>) : Context<'T2> =
+        {
+            Link = (ctx.Link << f)
+            HttpContext = ctx.HttpContext
+        }
+
 type Sitelet<'T when 'T : equality> =
     {
         Router : IRouter<'T>
-        Controller : HttpContext -> 'T -> obj
+        Controller : Context<'T> -> 'T -> obj
     }
 
     static member (+) (s1: Sitelet<'T>, s2: Sitelet<'T>) =
@@ -60,7 +73,7 @@ module Sitelet =
         }
 
     /// Creates a WebSharper.Sitelet using the given router and handler function.
-    let New (router: IRouter<'T>) (handle: HttpContext -> 'T -> obj) =
+    let New (router: IRouter<'T>) (handle: Context<'T> -> 'T -> obj) =
         {
             Router = router
             Controller = handle
@@ -81,11 +94,9 @@ module Sitelet =
             Controller = fun ctx endpoint ->
                 let prot = filter
                 let failure () =
-                    let redirEndpoint = prot.LoginRedirect endpoint
-                    let link = ctx.Items.["Sitelets.Link"] |> unbox<'T -> string>
-                    (RedirectResult (link redirEndpoint)) :> obj
+                    RedirectResult (ctx.Link endpoint) |> box
                 let loggedIn = 
-                    let nameClaim = ctx.User.FindFirst(Security.Claims.ClaimTypes.NameIdentifier)
+                    let nameClaim = ctx.HttpContext.User.FindFirst(Security.Claims.ClaimTypes.NameIdentifier)
                     if isNull nameClaim then None else Some nameClaim.Value
                 match loggedIn with
                 | Some user ->
@@ -99,7 +110,7 @@ module Sitelet =
 
     /// Constructs a singleton sitelet that contains exactly one endpoint
     /// and serves a single content value at a given location.
-    let Content (location: string) (endpoint: 'T) (cnt: HttpContext -> obj) =
+    let Content (location: string) (endpoint: 'T) (cnt: Context<'T> -> obj) =
         {
             Router = Router.Single endpoint location
             Controller = fun ctx _ -> cnt ctx 
@@ -110,7 +121,7 @@ module Sitelet =
         {
             Router = IRouter.Map f g s.Router
             Controller = fun ctx endpoint ->
-                s.Controller ctx (g endpoint)
+                s.Controller (Context.Map f ctx) (g endpoint)
         }
 
     /// Maps over the served sitelet content.
@@ -128,7 +139,7 @@ module Sitelet =
             Router = IRouter.TryMap f g s.Router
             Controller = fun ctx a ->
                 match g a with
-                | Some ea -> s.Controller ctx ea
+                | Some ea -> s.Controller (Context.Map (f >> Option.get) ctx) ea
                 | None -> failwith "Invalid endpoint in Sitelet.Embed"
         }
 
@@ -138,7 +149,7 @@ module Sitelet =
             Router = IRouter.Embed embed unembed sitelet.Router
             Controller = fun ctx a ->
                 match unembed a with
-                | Some ea -> sitelet.Controller ctx ea
+                | Some ea -> sitelet.Controller (Context.Map embed ctx) ea
                 | None -> failwith "Invalid endpoint in Sitelet.Embed"
         }
 
@@ -195,7 +206,7 @@ module Sitelet =
         {
             Router = IRouter.Box sitelet.Router
             Controller = fun ctx a ->
-                sitelet.Controller ctx (unbox a)
+                sitelet.Controller (Context.Map box ctx) (unbox a)
         }
 
     let Upcast sitelet = Box sitelet
@@ -205,31 +216,27 @@ module Sitelet =
         {
             Router = IRouter.Unbox sitelet.Router
             Controller = fun ctx a ->
-                sitelet.Controller ctx (box a)
+                sitelet.Controller (Context.Map unbox ctx) (box a)
         }
 
     let UnsafeDowncast sitelet = Unbox sitelet
 
     /// Constructs a sitelet with an inferred router and a given controller
     /// function.
-    let Infer<'T when 'T : equality> (handle : HttpContext -> 'T -> obj) =
+    let Infer<'T when 'T : equality> (handle : Context<'T> -> 'T -> obj) =
         {
             Router = Router.IInfer<'T>()
             Controller = handle
         }
 
-    let InferWithCustomErrors<'T when 'T : equality> (handle : HttpContext -> ParseRequestResult<'T> -> obj) =
+    let InferWithCustomErrors<'T when 'T : equality> (handle : Context<'T> -> ParseRequestResult<'T> -> obj) =
         {
             Router = Router.IInferWithCustomErrors<'T>()
-            Controller = handle // TODO
-                //C.CustomContentAsync <| fun ctx -> async {
-                //    let ctx = (Context.Map ParseRequestResult.Success ctx)
-                //    let! content = handle ctx x
-                //    return! C.ToResponse content ctx
-                //}
+            Controller = fun ctx x ->
+                handle (Context.Map ParseRequestResult.Success ctx) x
         }
 
-    let InferPartial (embed: 'T1 -> 'T2) (unembed: 'T2 -> 'T1 option) (mkContent: HttpContext -> 'T1 -> obj) : Sitelet<'T2> =
+    let InferPartial (embed: 'T1 -> 'T2) (unembed: 'T2 -> 'T1 option) (mkContent: Context<'T2> -> 'T1 -> obj) : Sitelet<'T2> =
         {
             Router = Router.IInfer<'T1>() |> IRouter.Embed embed unembed
             Controller = fun ctx p ->
@@ -245,7 +252,7 @@ module Sitelet =
         | Some (embed, unembed) -> InferPartial embed unembed mkContent
         | None -> failwith "Invalid union case in Sitelet.InferPartialInUnion"
 
-    let MapContext (f: HttpContext -> HttpContext) (sitelet: Sitelet<'T>) : Sitelet<'T> =
+    let MapContext (f: Context<'T> -> Context<'T>) (sitelet: Sitelet<'T>) : Sitelet<'T> =
         { sitelet with
             Controller = fun ctx action ->
                 sitelet.Controller (f ctx) action
@@ -254,7 +261,7 @@ module Sitelet =
     // let WithSettings (settings: seq<string * string>) (sitelet: Sitelet<'T>) : Sitelet<'T> =
     //     MapContext (Context.WithSettings settings) sitelet // TODO
 
-type RouteHandler<'T> = delegate of HttpContext * 'T -> obj
+type RouteHandler<'T> = delegate of Context<obj> * 'T -> obj
 
 [<CompiledName "Sitelet"; Sealed>]
 type CSharpSitelet =
@@ -266,7 +273,7 @@ type CSharpSitelet =
             handle.Invoke(ctx, unbox<'T> ep)
         )
 
-    static member Content (location: string, endpoint: 'T, cnt: Func<HttpContext, obj>) =
+    static member Content (location: string, endpoint: 'T, cnt: Func<Context<'T>, obj>) =
         Sitelet.Content location endpoint cnt.Invoke
 
     static member Sum ([<ParamArray>] sitelets: Sitelet<'T>[]) =
@@ -311,7 +318,7 @@ type SiteletBuilder() =
 
     let sitelets = ResizeArray()
 
-    member this.With<'T when 'T : equality>(content: Func<HttpContext, 'T, obj>) =
+    member this.With<'T when 'T : equality>(content: Func<Context<obj>, 'T, obj>) =
         sitelets.Add <|
             Sitelet.InferPartial
                 box
@@ -322,7 +329,7 @@ type SiteletBuilder() =
                 )
         this
 
-    member this.With(path: string, content: Func<HttpContext, obj>) =
+    member this.With(path: string, content: Func<Context<obj>, obj>) =
         let content ctx =
             content.Invoke(ctx)
         sitelets.Add <| Sitelet.Content path (box path) content

Sitelets/Sitelet.fsi

@@ -25,14 +25,21 @@ open System.Threading.Tasks
 open System.Runtime.CompilerServices
 open Microsoft.AspNetCore.Http
 
+/// Provides services available to handlers at run-time.
+type Context<'T> =
+    {
+        Link : 'T -> string
+        HttpContext : HttpContext
+    }
+
 /// Represents a self-contained website parameterized by the type of actions.
 /// A sitelet combines a router, which is used to match incoming requests to
 /// actions and actions to URLs, and a controller, which is used to handle
 /// the actions.
 type Sitelet<'T when 'T : equality> =
     {
         Router : IRouter<'T>
-        Controller : HttpContext -> 'T -> obj
+        Controller : Context<'T> -> 'T -> obj
     }
 
     /// Combines two sitelets, with the leftmost taking precedence.
@@ -63,7 +70,7 @@ module Sitelet =
     val Empty<'T when 'T : equality> : Sitelet<'T>
 
     /// Creates a WebSharper.Sitelet using the given router and handler function.
-    val New<'T when 'T : equality> : router: IRouter<'T> -> handle: (HttpContext -> 'T -> obj) -> Sitelet<'T>
+    val New<'T when 'T : equality> : router: IRouter<'T> -> handle: (Context<'T> -> 'T -> obj) -> Sitelet<'T>
 
     /// Represents filters for protecting sitelets.
     type Filter<'T> =
@@ -83,7 +90,7 @@ module Sitelet =
     val Content<'T when 'T : equality> :
         location: string ->
         endpoint: 'T ->
-        cnt: (HttpContext -> obj) ->
+        cnt: (Context<'T> -> obj) ->
         Sitelet<'T>
 
     /// Maps over the sitelet endpoint type. Requires a bijection.
@@ -140,26 +147,26 @@ module Sitelet =
         sitelet: Sitelet<obj> -> Sitelet<'T>
 
     /// Constructs a sitelet with an inferred router and a given controller function.
-    val Infer<'T when 'T : equality> : (HttpContext -> 'T -> obj) -> Sitelet<'T>
+    val Infer<'T when 'T : equality> : (Context<'T> -> 'T -> obj) -> Sitelet<'T>
 
     /// Constructs a sitelet with an inferred router and a given controller function.
     val InferWithCustomErrors<'T when 'T : equality>
-        : (HttpContext -> ParseRequestResult<'T> -> obj)
+        : (Context<'T> -> ParseRequestResult<'T> -> obj)
         -> Sitelet<ParseRequestResult<'T>>
 
     /// Constructs a partial sitelet with an inferred router and a given controller function.
     val InferPartial<'T1, 'T2 when 'T1 : equality and 'T2 : equality> :
-        ('T1 -> 'T2) -> ('T2 -> 'T1 option) -> (HttpContext -> 'T1 -> obj) -> Sitelet<'T2>
+        ('T1 -> 'T2) -> ('T2 -> 'T1 option) -> (Context<'T2> -> 'T1 -> obj) -> Sitelet<'T2>
 
     /// Constructs a partial sitelet with an inferred router and a given controller function.
     /// The actions covered by this sitelet correspond to the given union case.
     val InferPartialInUnion<'T1, 'T2 when 'T1 : equality and 'T2 : equality> :
-        Expr<'T1 -> 'T2> -> (HttpContext -> 'T1 -> obj) -> Sitelet<'T2>
+        Expr<'T1 -> 'T2> -> (Context<'T2> -> 'T1 -> obj) -> Sitelet<'T2>
 
     /// Applies a mapping function on the Context object whenever a sitelet controller is used.
-    val MapContext : (HttpContext -> HttpContext) -> Sitelet<'T> -> Sitelet<'T>
+    val MapContext : (Context<'T> -> Context<'T>) -> Sitelet<'T> -> Sitelet<'T>
 
-type RouteHandler<'T> = delegate of HttpContext * 'T -> obj
+type RouteHandler<'T> = delegate of Context<obj> * 'T -> obj
 
 [<CompiledName "Sitelet"; Class; Sealed>]
 type CSharpSitelet =
@@ -172,7 +179,7 @@ type CSharpSitelet =
 
     /// Constructs a singleton sitelet that contains exactly one endpoint
     /// and serves a single content value at a given location.
-    static member Content<'T when 'T: equality> : location: string * endpoint: 'T * cnt: Func<HttpContext, obj> -> Sitelet<'T>
+    static member Content<'T when 'T: equality> : location: string * endpoint: 'T * cnt: Func<Context<'T>, obj> -> Sitelet<'T>
         
     /// Combines several sitelets, leftmost taking precedence.
     /// Is equivalent to folding with the choice operator.
@@ -202,11 +209,11 @@ type SiteletBuilder =
     new : unit -> SiteletBuilder
 
     /// Add a handler for an inferred endpoint.
-    member With<'T> : Func<HttpContext, 'T, obj> -> SiteletBuilder
+    member With<'T> : Func<Context<obj>, 'T, obj> -> SiteletBuilder
         when 'T : equality
 
     /// Add a handler for a specific path.
-    member With : string * Func<HttpContext, obj> -> SiteletBuilder
+    member With : string * Func<Context<obj>, obj> -> SiteletBuilder
 
     /// Get the resulting Sitelet.
     member Install : unit -> Sitelet<obj>