HttpReader to allow composing an HttpHandler using values from HttpContext without having to implement the HttpHandler function

[TheJayMann]

For some time I've been wanting to implement simple functions which take in values and return an HttpHandler, typically by making use of the built in functions that generate an HttpHandler, where the values passed in to the function would ultimately come from HttpContext. This ultimately requires implementing a new HttpHandler in order to get the HttpContext value to pass in to the function, then calling the resulting HttpHandler with the passed in HttpFunc and HttpContext values.

Some time ago I played around with the idea of reimplementing HttpHandler as a proper monad, but this made certain optimizations of the compose function become difficult or impossible to use properly. Recently, an attempt to use the razorHtmlView with a function designed to build a view model to pass in, I realized this could be satisfied by making use of an applicative making use of apply, and after some thought realized this resembles a specialization of the Reader applicative.

Based on this, I was able to come up with two versions of the HttpReader applicative, one which obtains simple values from HttpContext and passes them into the function directly, and another one which is aware of Task and Result<_,HttpHandler>.

The first one is very simple and I implemented it in 9 lines of code.

type 'value HttpReader = HttpContext -> 'value
module HttpReader =
  let map func (read : 'value HttpReader) : 'result HttpReader =  read >> func
  let apply readFunc (read : 'value HttpReader) : 'result HttpReader = fun ctx -> let func = readFunc ctx in map func read ctx
  let complete (handler : 'value -> HttpHandler) read : HttpHandler = fun next ctx -> read ctx |> handler <| next <| ctx
  let run readHandler : HttpHandler = fun next ctx -> readHandler ctx next ctx

  let (<!>) = map
  let (<*>) = apply
  let (=>>=) read handler = complete handler read

This allows an HttpHandler to be composed from HttpContext provided values fairly simply.

// Assuming:
// val getService: HttpContext -> 'T
// val getCookie: string -> HttpContext -> string
// val getDatabaseRecord: DataContext -> DataRecord
// val modelBuilder: DataRecord -> string -> ViewModel
// val renderViewFromModel: string -> ViewModel -> HttpHandler
// val renderViewFromArgs: string -> DataRecord -> string -> HttpHandler
// using the builder pattern
let myHandler = modelBuilder <!> (getService >> getDatabaseRecord) <*> getCookie "myCookie" =>>= renderViewFromModel "myView"

// using the function pattern
let myHandler = renderViewFromArgs "myView" <!> (getService >> getDatabaseRecord) <*> getCookie "myCookie" |> HttpReader.run

The second one allows the reader functions to return a task, which will be awaited in the final HttpHandler which will be built, as well as allowing the reader function to return a Result which can have an alternate HttpHandler be used in case of an error, short circuiting the rest. This is a bit more complicated, as it requires a DU in order to know which state the function building is in (in order to avoid allocating Task and Result objects if not necessary), as well as making member operators rather than function operators so that overloading can allow the different reader functions without having to create many different operators for essentially the same operation. Due to not being able to create a member operator which uses two functions as its operands, I have instead created a return prefix operator to convert the initial function into an HttpReader2 rather than using the map operator used by HttpReader. The use is mostly the same, except that the <!> is replaced with <*>, and a !> is added at the beginning. Also, the getDatabaseRecord and getCookie can return either a Result<'T,HttpHandler>, a Task<'T>, or a Task<Result<'T,HttpHandler>> and will still work as expected.

type 'value HttpReader2 = 
| HttpReader of (HttpContext -> 'value)
| HttpReaderWithResult of (HttpContext -> Result<'value, HttpHandler>)
| HttpReaderAsync of (HttpContext -> 'value Task)
| HttpReaderWithResultAsync of (HttpContext -> Result<'value, HttpHandler> Task)
with
  static member (<*>) (funcReader,  read) = 
    match funcReader with
    | HttpReader readFunc -> HttpReader <| fun ctx -> read ctx |> readFunc ctx
    | HttpReaderWithResult readFuncWithResult -> HttpReaderWithResult <| fun ctx -> readFuncWithResult ctx |> Result.map (read ctx |> (|>))
    | HttpReaderAsync readFuncAsync -> HttpReaderAsync <| fun ctx -> task { let! func = readFuncAsync ctx in return read ctx |> func }
    | HttpReaderWithResultAsync readFuncWithResultAsync -> HttpReaderWithResultAsync <| fun ctx -> task { let! funcWithResult = readFuncWithResultAsync ctx in return funcWithResult |> Result.map (read ctx |> (|>)) }
  static member (<*>) (funcReader,  readWithResult) = 
    let inline applyResult f r = f |> Result.bind (fun f -> r |> Result.map f)
    match funcReader with
    | HttpReader readFunc -> HttpReaderWithResult <| fun ctx -> readWithResult ctx |> Result.map (readFunc ctx)
    | HttpReaderWithResult readFuncWithResult -> HttpReaderWithResult <| fun ctx -> readWithResult ctx |> applyResult (readFuncWithResult ctx)
    | HttpReaderAsync readFuncAsync -> HttpReaderWithResultAsync <| fun ctx -> task { let! func = readFuncAsync ctx in return readWithResult ctx |> Result.map func }
    | HttpReaderWithResultAsync readFuncWithResultAsync -> HttpReaderWithResultAsync <| fun ctx -> task { let! funcWithResult = readFuncWithResultAsync ctx in return readWithResult ctx |> applyResult funcWithResult }
  static member (<*>) (funcReader,  readAsync: _ -> _ Task) = 
    match funcReader with
    | HttpReader readFunc -> HttpReaderAsync <| fun ctx -> task { let! value = readAsync ctx in return readFunc ctx value }
    | HttpReaderWithResult readFuncWithResult -> HttpReaderWithResultAsync <| fun ctx -> task { let! value = readAsync ctx in return readFuncWithResult ctx |> Result.map (value |> (|>)) }
    | HttpReaderAsync readFuncAsync -> HttpReaderAsync <| fun ctx -> task { let! func = readFuncAsync ctx in let! value = readAsync ctx in return func value }
    | HttpReaderWithResultAsync readFuncWithResultAsync -> HttpReaderWithResultAsync <| fun ctx -> task { let! funcWithResult = readFuncWithResultAsync ctx in let! value = readAsync ctx in return funcWithResult |> Result.map (value |> (|>)) }
  static member (<*>) (funcReader,  readWithResultAsync: _ -> _ Task) = 
    let inline applyResult f r = f |> Result.bind (fun f -> r |> Result.map f)
    match funcReader with
    | HttpReader readFunc -> HttpReaderWithResultAsync <| fun ctx -> task { let! valueWithResult = readWithResultAsync ctx in return valueWithResult |> Result.map (readFunc ctx)  }
    | HttpReaderWithResult readFuncWithResult -> HttpReaderWithResultAsync <| fun ctx -> task { let! valueWithResult = readWithResultAsync ctx in return valueWithResult |> applyResult (readFuncWithResult ctx) }
    | HttpReaderAsync readFuncAsync -> HttpReaderWithResultAsync <| fun ctx -> task { let! valueWithResult = readWithResultAsync ctx in let! func = readFuncAsync ctx in return valueWithResult |> Result.map func }
    | HttpReaderWithResultAsync readFuncWithResultAsync -> HttpReaderWithResultAsync <| fun ctx -> task { let! valueWithResult = readWithResultAsync ctx in let! funcWithResult = readFuncWithResultAsync ctx in return valueWithResult |> applyResult funcWithResult }
  static member (=>>=) (reader, handler: _ -> HttpHandler) : HttpHandler = fun next ctx ->
    match reader with
    | HttpReader read -> handler (read ctx) next ctx
    | HttpReaderWithResult readWithResult -> match readWithResult ctx with Ok value-> handler value next ctx | Error handler -> handler next ctx
    | HttpReaderAsync readAsync -> task { let! value = readAsync ctx in return! handler value next ctx }
    | HttpReaderWithResultAsync readWithResultAsync -> task { match! readWithResultAsync ctx with Ok read -> return! handler read next ctx | Error handler -> return! handler next ctx }


module HttpHandler2 =
  let inline (!>) value =  HttpReader <| fun _ -> value
  let run (handlerReader: HttpHandler HttpReader2) : HttpHandler = fun next ctx ->
    let collapseResult = function Ok value -> value | Error value -> value
    match handlerReader with
    | HttpReader read -> read ctx next ctx
    | HttpReaderWithResult readWithResult -> collapseResult (readWithResult ctx) next ctx
    | HttpReaderAsync readAsync -> task { let! handler = readAsync ctx in return! handler next ctx }
    | HttpReaderWithResultAsync readWithResultAsync -> task { let! handlerResult = readWithResultAsync ctx in return! collapseResult handlerResult next ctx }

The code could be optimized a bit better, specifically when the function is a result type and the next reader is an async, by not awaiting the next value if the current result is an Error. Also, it could be written a bit more clear, as this prototype was mostly written just to make the types match properly and have proper execution. I'd like to request this to be added to the library if such functionality would be considered desirable. If necessary, I can also alter the code as necessary to be more consistent with the rest of the code base, as well as easier to read and understand.