5 people like it.

Asynchronous Workflow Controller

The snippet overrides default AsyncControllerActionInvoker so F# async workflows can be used for ASP.NET MVC 3. It declares a new base class for asynchronous controller. Controller method has to have return type Async.

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
74: 
open Unchecked
open System
open System.Web.Mvc
open System.Web.Mvc.Async
open System.Net

// Preserving stack trace when rethrowing exceptions
// http://weblogs.asp.net/fmarguerie/archive/2008/01/02/rethrowing-exceptions-and-preserving-the-full-call-stack-trace.aspx
// http://stackoverflow.com/questions/57383/in-c-how-can-i-rethrow-innerexception-without-losing-stack-trace
exception PreserveStackTraceWrapper of exn

//New base async controller. 
type AsyncWorkflowController() = 
    inherit AsyncController()

    override __.CreateActionInvoker() = 
        //In real-life applications  object expression for AsyncControllerActionInvoker can be pulled off into separate type/file.
        //See how F# object expressions smooth out sharp OOP corners. 
        // In C# it would require to create 3 extra classes that only have meaning in local context.
        upcast {   
            new AsyncControllerActionInvoker() with

                member __.GetControllerDescriptor(controllerContext) =
                    let controllerType = controllerContext.Controller.GetType()

                    upcast {
                        new ReflectedControllerDescriptor(controllerType) with 
                            member ctrlDesc.FindAction(controllerContext, actionName) =
                                //getting default sync implementation 
                                let forwarder = base.FindAction(controllerContext, actionName) :?> ReflectedActionDescriptor
                                
                                if (forwarder <> null && forwarder.MethodInfo.ReturnType = typeof<Async<ActionResult>>) then 
                                    let endAsync' = ref (defaultof<IAsyncResult -> Choice<ActionResult, exn>>)

                                    upcast {
                                        new AsyncActionDescriptor() with

                                            member actionDesc.ActionName = forwarder.ActionName
                                            member actionDesc.ControllerDescriptor = upcast ctrlDesc
                                            member actionDesc.GetParameters() = forwarder.GetParameters()

                                            member actionDesc.BeginExecute(controllerContext, parameters, callback, state) =
                                                let asyncWorkflow = 
                                                    forwarder.Execute(controllerContext, parameters) :?> Async<ActionResult>
                                                    |> Async.Catch
                                                let beginAsync, endAsync, _ = Async.AsBeginEnd(fun () -> asyncWorkflow)
                                                endAsync' := endAsync
                                                beginAsync((), callback, state)

                                            member actionDesc.EndExecute(asyncResult) =
                                                match endAsync'.Value(asyncResult) with
                                                    | Choice1Of2 value -> box value
                                                    | Choice2Of2 why -> raise <| PreserveStackTraceWrapper(why)

                                    } 
                                else 
                                    upcast forwarder 
                    } 

        }

//Sample Asynchronous Controller
type MainController() = 
    inherit AsyncWorkflowController()

    member this.Index() = this.View()

    member this.LengthAsync() = 
        async {
            let wc = new WebClient()
            let! html = wc.AsyncDownloadString(Uri("http://news.google.com"))
            //Constrain under current design that method has to return Async <ActionResult>
            return ContentResult(Content = string html.Length) :> ActionResult 
        }
module Unchecked

from Microsoft.FSharp.Core.Operators
namespace System
namespace System.Web
Multiple items
type Async
static member AsBeginEnd : computation:('Arg -> Async<'T>) -> ('Arg * AsyncCallback * obj -> IAsyncResult) * (IAsyncResult -> 'T) * (IAsyncResult -> unit)
static member AwaitEvent : event:IEvent<'Del,'T> * ?cancelAction:(unit -> unit) -> Async<'T> (requires delegate and 'Del :> Delegate)
static member AwaitIAsyncResult : iar:IAsyncResult * ?millisecondsTimeout:int -> Async<bool>
static member AwaitTask : task:Task<'T> -> Async<'T>
static member AwaitWaitHandle : waitHandle:WaitHandle * ?millisecondsTimeout:int -> Async<bool>
static member CancelDefaultToken : unit -> unit
static member Catch : computation:Async<'T> -> Async<Choice<'T,exn>>
static member FromBeginEnd : beginAction:(AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg:'Arg1 * beginAction:('Arg1 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * beginAction:('Arg1 * 'Arg2 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * arg3:'Arg3 * beginAction:('Arg1 * 'Arg2 * 'Arg3 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromContinuations : callback:(('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) -> Async<'T>
static member Ignore : computation:Async<'T> -> Async<unit>
static member OnCancel : interruption:(unit -> unit) -> Async<IDisposable>
static member Parallel : computations:seq<Async<'T>> -> Async<'T []>
static member RunSynchronously : computation:Async<'T> * ?timeout:int * ?cancellationToken:CancellationToken -> 'T
static member Sleep : millisecondsDueTime:int -> Async<unit>
static member Start : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions * ?cancellationToken:CancellationToken -> Task<'T>
static member StartChild : computation:Async<'T> * ?millisecondsTimeout:int -> Async<Async<'T>>
static member StartChildAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions -> Async<Task<'T>>
static member StartImmediate : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartWithContinuations : computation:Async<'T> * continuation:('T -> unit) * exceptionContinuation:(exn -> unit) * cancellationContinuation:(OperationCanceledException -> unit) * ?cancellationToken:CancellationToken -> unit
static member SwitchToContext : syncContext:SynchronizationContext -> Async<unit>
static member SwitchToNewThread : unit -> Async<unit>
static member SwitchToThreadPool : unit -> Async<unit>
static member TryCancelled : computation:Async<'T> * compensation:(OperationCanceledException -> unit) -> Async<'T>
static member CancellationToken : Async<CancellationToken>
static member DefaultCancellationToken : CancellationToken

Full name: Microsoft.FSharp.Control.Async

--------------------
type Async<'T>

Full name: Microsoft.FSharp.Control.Async<_>
namespace System.Net
exception PreserveStackTraceWrapper of exn

Full name: Script.PreserveStackTraceWrapper
type exn = Exception

Full name: Microsoft.FSharp.Core.exn
Multiple items
type AsyncWorkflowController =
  inherit obj
  new : unit -> AsyncWorkflowController
  override CreateActionInvoker : unit -> 'a

Full name: Script.AsyncWorkflowController

--------------------
new : unit -> AsyncWorkflowController
override AsyncWorkflowController.CreateActionInvoker : unit -> 'a

Full name: Script.AsyncWorkflowController.CreateActionInvoker
val typeof<'T> : Type

Full name: Microsoft.FSharp.Core.Operators.typeof
Multiple items
val ref : value:'T -> 'T ref

Full name: Microsoft.FSharp.Core.Operators.ref

--------------------
type 'T ref = Ref<'T>

Full name: Microsoft.FSharp.Core.ref<_>
val defaultof<'T> : 'T

Full name: Microsoft.FSharp.Core.Operators.Unchecked.defaultof
type IAsyncResult =
  member AsyncState : obj
  member AsyncWaitHandle : WaitHandle
  member CompletedSynchronously : bool
  member IsCompleted : bool

Full name: System.IAsyncResult
Multiple items
type Choice<'T1,'T2> =
  | Choice1Of2 of 'T1
  | Choice2Of2 of 'T2

Full name: Microsoft.FSharp.Core.Choice<_,_>

--------------------
type Choice<'T1,'T2,'T3> =
  | Choice1Of3 of 'T1
  | Choice2Of3 of 'T2
  | Choice3Of3 of 'T3

Full name: Microsoft.FSharp.Core.Choice<_,_,_>

--------------------
type Choice<'T1,'T2,'T3,'T4> =
  | Choice1Of4 of 'T1
  | Choice2Of4 of 'T2
  | Choice3Of4 of 'T3
  | Choice4Of4 of 'T4

Full name: Microsoft.FSharp.Core.Choice<_,_,_,_>

--------------------
type Choice<'T1,'T2,'T3,'T4,'T5> =
  | Choice1Of5 of 'T1
  | Choice2Of5 of 'T2
  | Choice3Of5 of 'T3
  | Choice4Of5 of 'T4
  | Choice5Of5 of 'T5

Full name: Microsoft.FSharp.Core.Choice<_,_,_,_,_>

--------------------
type Choice<'T1,'T2,'T3,'T4,'T5,'T6> =
  | Choice1Of6 of 'T1
  | Choice2Of6 of 'T2
  | Choice3Of6 of 'T3
  | Choice4Of6 of 'T4
  | Choice5Of6 of 'T5
  | Choice6Of6 of 'T6

Full name: Microsoft.FSharp.Core.Choice<_,_,_,_,_,_>

--------------------
type Choice<'T1,'T2,'T3,'T4,'T5,'T6,'T7> =
  | Choice1Of7 of 'T1
  | Choice2Of7 of 'T2
  | Choice3Of7 of 'T3
  | Choice4Of7 of 'T4
  | Choice5Of7 of 'T5
  | Choice6Of7 of 'T6
  | Choice7Of7 of 'T7

Full name: Microsoft.FSharp.Core.Choice<_,_,_,_,_,_,_>
static member Async.Catch : computation:Async<'T> -> Async<Choice<'T,exn>>
static member Async.AsBeginEnd : computation:('Arg -> Async<'T>) -> ('Arg * AsyncCallback * obj -> IAsyncResult) * (IAsyncResult -> 'T) * (IAsyncResult -> unit)
union case Choice.Choice1Of2: 'T1 -> Choice<'T1,'T2>
val box : value:'T -> obj

Full name: Microsoft.FSharp.Core.Operators.box
union case Choice.Choice2Of2: 'T2 -> Choice<'T1,'T2>
val raise : exn:Exception -> 'T

Full name: Microsoft.FSharp.Core.Operators.raise
Multiple items
type MainController =
  inherit AsyncWorkflowController
  new : unit -> MainController
  member Index : unit -> 'b
  member LengthAsync : unit -> Async<'a>

Full name: Script.MainController

--------------------
new : unit -> MainController
val this : MainController
member MainController.Index : unit -> 'b

Full name: Script.MainController.Index
member MainController.LengthAsync : unit -> Async<'a>

Full name: Script.MainController.LengthAsync
val async : AsyncBuilder

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.async
val wc : WebClient
Multiple items
type WebClient =
  inherit Component
  new : unit -> WebClient
  member BaseAddress : string with get, set
  member CachePolicy : RequestCachePolicy with get, set
  member CancelAsync : unit -> unit
  member Credentials : ICredentials with get, set
  member DownloadData : address:string -> byte[] + 1 overload
  member DownloadDataAsync : address:Uri -> unit + 1 overload
  member DownloadFile : address:string * fileName:string -> unit + 1 overload
  member DownloadFileAsync : address:Uri * fileName:string -> unit + 1 overload
  member DownloadString : address:string -> string + 1 overload
  ...

Full name: System.Net.WebClient

--------------------
WebClient() : unit
val html : string
member WebClient.AsyncDownloadString : address:Uri -> Async<string>
Multiple items
type Uri =
  new : uriString:string -> Uri + 5 overloads
  member AbsolutePath : string
  member AbsoluteUri : string
  member Authority : string
  member DnsSafeHost : string
  member Equals : comparand:obj -> bool
  member Fragment : string
  member GetComponents : components:UriComponents * format:UriFormat -> string
  member GetHashCode : unit -> int
  member GetLeftPart : part:UriPartial -> string
  ...

Full name: System.Uri

--------------------
Uri(uriString: string) : unit
Uri(uriString: string, uriKind: UriKind) : unit
Uri(baseUri: Uri, relativeUri: string) : unit
Uri(baseUri: Uri, relativeUri: Uri) : unit
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = String

Full name: Microsoft.FSharp.Core.string
property String.Length: int
Raw view Test code New version

More information

Link:http://fssnip.net/5q
Posted:13 years ago
Author:Dmitry Morozov
Tags: async , asynchronous workflows , asp.net , web , mvc