Discussion: a layer of abstraction above WebPart?

[njlr]

I have found that my complex Suave code can be quite deeply nested. To fix this, I've been sketching out some abstractions that might help to make code more linear. Here's what I came up with.

A WebFlow is like a WebPart, except that it carries a strongly-typed value:

type WebFlow<'t> = HttpContext -> Async<('t * HttpContext) option>

A WebPart is logically equivalent to a WebFlow<unit>.

Basic functions for working with WebFlow values:

[<RequireQualifiedAccess>]
module WebFlow =

  let ofAsync (wf : Async<'t>) : WebFlow<'t> =
    fun ctx ->
      async {
        let! t = wf

        return Some (t, ctx)
      }

  let ofWebPart (part : WebPart) : WebFlow<unit> =
    fun ctx ->
      async {
        let! m = part ctx

        return
          m
          |> Option.map (fun ctx -> (), ctx)
      }

  let toWebPart (flow : WebFlow<unit>) : WebPart =
    fun ctx ->
      async {
        let! m = flow ctx

        return
          m
          |> Option.map snd
      }

  let ctx : WebFlow<HttpContext> =
    fun ctx ->
      async {
        return Some (ctx, ctx)
      }

  let just x : WebFlow<'t> =
    fun ctx ->
      async {
        return Some (x, ctx)
      }

  let zero<'t> : WebFlow<'t> =
    fun _ ->
      async {
        return None
      }

  let map (f : 't -> 'u) (flow : WebFlow<'t>) : WebFlow<'u> =
    fun ctx ->
      async {
        let! m = flow ctx

        return
          m
          |> Option.map (fun (t, ctx) -> f t, ctx)
      }

  let bind (f : 't -> WebFlow<'u>) (flow : WebFlow<'t>) : WebFlow<'u> =
    fun ctx ->
      async {
        let! m = flow ctx

        match m with
        | Some (t, ctx) ->
          let next = f t

          return! next ctx
        | None ->
          return None
      }

And from these we can make a computation expression:

[<AutoOpen>]
module WebFlowSyntax =

  type WebFlowBuilder() =
    member this.Bind(m, f) =
      WebFlow.bind f m

    member this.Return(x) =
      WebFlow.just x

    member this.ReturnFrom(x) =
      (x : WebFlow<'t>)

    member this.BindReturn(m, f) =
      WebFlow.map f m

    member this.Zero() =
      WebFlow.zero

  [<AutoOpen>]
  module AsyncExtensions =

    type WebFlowBuilder with
      member this.Bind(m, f) =
        WebFlow.bind f (WebFlow.ofAsync m)

      member this.BindReturn(m, f) =
        WebFlow.map f (WebFlow.ofAsync m)

  [<AutoOpen>]
  module WebPartExtensions =

    type WebFlowBuilder with
      member this.Bind(m, f) =
        WebFlow.bind f (WebFlow.ofWebPart m)

      member this.BindReturn(m, f) =
        WebFlow.map f (WebFlow.ofWebPart m)

  let webFlow = WebFlowBuilder()

With this setup, apps can be very terse yet readable!

Before:

let app : WebPart = 
  Filters.pathScanCi
    "/users/%s/profile"
    (fun requestedUser ->
      Authentication.authenticateBasicAsync 
        (fun (_, _) -> async { return true })
        (fun ctx -> 
          async {
            let user = ctx.userState[Authentication.UserNameKey] :?> string

            if requestedUser = user then
              return! Successful.OK $"Hello, %s{user}" ctx
            else
              return! RequestErrors.challenge ctx
          }))

startWebServer defaultConfig app

After:

let app =
  webFlow {
    let! requestedUser = Filters.pathScanCiFlow "/users/%s/profile"
    let! maybeUser = Authentication.tryBasicFlow (fun (username, _) -> async { return Some username })

    match maybeUser with
    | Some user when user = requestedUser ->
      do! Successful.OK $"Hello, %s{user}"
    | _ ->
      do! RequestErrors.challenge
  }

startWebServer defaultConfig (WebFlow.toWebPart app)

(Implementation of Filters.pathScanCiFlow and Authentication.tryBasicFlow omitted, but they are quite simple)

I'm curious what people think!