Adapter for event-based pattern. With a blackjack and ...other components

Recently during overview of Async module I’ve promised to make an adapter for async workflows, so they can be consumed as implementations of a good old event-based async pattern. Let's start.

Define inheritor from AsyncCompletedEventArgs class (with a few helper functions – we will need them later). It will be used as a container for operation result.

type OperationCompletedEventArgs<'T>(result : 'T, ex, cancelled) = 
    inherit AsyncCompletedEventArgs(ex, cancelled, null)
    member this.Result = result

let raiseSuccess f (evt : Event<_, _>) r =   evt.Trigger(null, f r null false)
let raiseError   f (evt : Event<_, _>) ex =  evt.Trigger(null, f (Unchecked.defaultof<_>) ex false)
let raiseCancel  f (evt : Event<_, _>) _ =   evt.Trigger(null, f (Unchecked.defaultof<_>) null true)

let createResult res ex cancelled = new OperationCompletedEventArgs<_>(res, ex, cancelled)
let createUnit () ex cancelled = new AsyncCompletedEventArgs(ex, cancelled, null)

Declare two wrapper interfaces: first interface will represent void operation, second - operation that can return a result.

type IOperation<'TArg> = 
    [<CLIEvent>]
    abstract Completed : IEvent<EventHandler<AsyncCompletedEventArgs>, _> 
    abstract RunAsync : 'TArg -> unit
    abstract CancelAsync : unit -> unit
 
type IOperation<'TArg, 'TResult> = 
    [<CLIEvent>]
    abstract Completed : IEvent<EventHandler<OperationCompletedEventArgs<'TResult>>, _> 
    abstract RunAsync : 'TArg -> unit
    abstract CancelAsync : unit -> unit

These operations will behave as prescribed in article:Implementing the Event-based Asynchronous Pattern:

• Completed event is raised when async execution is finished, cancelled or failed
• CancelAsync method is used to signal a cancel for running operation
• RunAsync method starts async operation.

Single argument ('TArg) in RunAsync method doesn't mean that we will be able to adapt only one-argument computations. Sometimes one generic argument is enough especially if type parameter can be substituted by tuple of any rank :).

Finally, implementation itself:

type Async with
    static member AsEventBased(computation) = 
        let cts = new CancellationTokenSource()
        let event = new Event<_, _>()
        { new IOperation<_, _> with
            [<CLIEvent>]
            member this.Completed = event.Publish
            member this.RunAsync(arg) = 
                Async.StartWithContinuations(
                    computation arg, 
                    raiseSuccess createResult event,  
                    raiseError createResult event, 
                    raiseCancel createResult event, 
                    cts.Token)
            member this.CancelAsync() = cts.Cancel() }

    static member AsEventBased(computation) = 
        let cts = new CancellationTokenSource()
        let event = new Event<_, _>()        
        { new IOperation<_> with
            [<CLIEvent>]
            member this.Completed = event.Publish 
            member this.RunAsync(arg) = 
                Async.StartWithContinuations(
                    computation arg, 
                    raiseSuccess createUnit event,  
                    raiseError createUnit event, 
                    raiseCancel createUnit event, 
                    cts.Token)
            member this.CancelAsync() = cts.Cancel() }

Well, adapter is ready but I need to ensure, that it actually works. Everybody are sick and tired of parallel download demonstration, so I've decided to make something new: async computation that makes requests to Google translate through AJAX API. So said, so done.

1. Google Translate returns data as JSON and BCL already includes DataContractJsonSerializer. Define data contracts:

open System.IO
open System.Web
open System.Net

open System.Runtime.Serialization
open System.Runtime.Serialization.Json

[<DataContract>]
type ResponseData = {
    [<DataMember(Name = "translatedText")>]
    mutable TranslatedText : string
    [<DataMember(Name = "detectedSourceLanguage")>]
    mutable DetectedSourceLanguage : string
    }
[<DataContract>]
type Response = {
    [<DataMember(Name = "responseData")>]
    mutable ResponseData : ResponseData
    [<DataMember(Name = "responseDetails")>]
    mutable Details : string
    [<DataMember(Name = "responseStatus")>]
    mutable Status : int
    }

2. Create a workflow:

let translate (referer, word : string, sourceLang, targetLangs) =
    let translateOne lang = async {
        let s = new DataContractJsonSerializer(typeof<Response>)

        let requestString = 
            sprintf "http://ajax.googleapis.com/ajax/services/language/translate?v=1.0&q=%s&langpair=%s%%7C%s" (HttpUtility.UrlEncode word) sourceLang lang
        let req = HttpWebRequest.Create(requestString) :?> HttpWebRequest
        req.Referer <- referer
        req.Timeout <- 4000
        let! resp = req.AsyncGetResponse()
        use stream = resp.GetResponseStream()
        return s.ReadObject(stream) :?> Response
        }
    targetLangs
        |> Seq.map translateOne
        |> Async.Parallel

Remarks: Evidently sending request is trivial, arguments are encoded in url. If empty string is passed in first position of langpair argument then Translate service will try to autodetect source language. Also presense of correct Referer header is mandatory (prescribed by Google Terms of Service).

3. Declare a helper module with language-related settings

module Languages 

    [<Literal>]
    let Unknown = "UNKNOWN"

    type Lang = {
        Name : string
        Id : string 
        }
        with 
        member this.IsAutodetect = this.Id = ""

    let Autodetect = { Name = "AUTODETECT"; Id = ""}

    let All = 
        [
           {Name="BELARUSIAN" ; Id =  "be"}
           {Name="BENGALI" ; Id =  "bn"}    
           {Name="GUJARATI" ; Id =  "gu"}
           {Name="HEBREW" ; Id =  "iw"}
           {Name="HINDI" ; Id =  "hi"}
           {Name="HUNGARIAN" ; Id =  "hu"}
           {Name="ICELANDIC" ; Id =  "is"}
           {Name="INDONESIAN" ; Id =  "id"}
           {Name="INUKTITUT" ; Id =  "iu"}
           {Name="IRISH" ; Id =  "ga"}
           {Name="ITALIAN" ; Id =  "it"}
           {Name="JAPANESE" ; Id =  "ja"}
           {Name="KANNADA" ; Id =  "kn"}
           {Name="KAZAKH" ; Id =  "kk"}
           {Name="KHMER" ; Id =  "km"}
           {Name="PERSIAN" ; Id =  "fa"}
           {Name="POLISH" ; Id =  "pl"}
           {Name="PORTUGUESE" ; Id =  "pt-PT"}
           {Name="PUNJABI" ; Id =  "pa"}
           {Name="ROMANIAN" ; Id =  "ro"}
           {Name="RUSSIAN" ; Id =  "ru"}
           {Name="SANSKRIT" ; Id =  "sa"}
        ]
    let private lookup = All |> Seq.map(fun x -> (x.Id, x.Name)) |> dict
    let Find n = 
        match lookup.TryGetValue n with
        | true, v -> v
        | false, _ -> Unknown

I've intentionally trimmed it because of size, full list of supported languages can be found here.

4. Create a client application(WPF based). I've cheated a bit and made F# client but pretended that I've never heart about Async module. All interaction with real workflow implementation will be performed through adapter. In fact I've cheated twice, instead of crafting UI object by object I've defined structure in XAML and load it with XamlReader.

type LanguageListItem = {
    [<DefaultValue>]
    mutable Checked : bool
    Language : Languages.Lang 
    }

[<STAThread>]
do
    let referer = "put_your_referer here"

    let win = load "MainForm.xaml" :?> Window
    let input = win.FindName("input") :?> TextBox
    let translateBtn = win.FindName("translate") :?> Button
    let langsList = win.FindName("languages") :?> ItemsControl
    let sourceLangCombo = win.FindName("sourceLanguages") :?> ComboBox
    
    let languages = Languages.All |> List.map (fun l -> {Language = l})
    langsList.ItemsSource <- languages
    
    sourceLangCombo.ItemsSource <- [Languages.Autodetect] @ Languages.All
    sourceLangCombo.SelectedIndex <- 0

    translateBtn.Click.Add(fun _ ->
        let phrase = input.Text
        if not <|String.IsNullOrWhiteSpace(phrase) then
            let checkedLangs = languages |> List.choose(fun l -> if l.Checked then Some(l.Language) else None)
            let sourceLang = sourceLangCombo.SelectedItem :?> Languages.Lang
            let op = Async.AsEventBased(translate) 

            let rec disposable = op.Completed.Subscribe(handler)
            and handler args = 
                disposable.Dispose()
                if args.Error <> null then
                    MessageBox.Show(args.Error.Message) |> ignore
                else if not <| args.Cancelled then
                    showResults phrase sourceLang win (args.Result |> Seq.zip checkedLangs |> List.ofSeq)

            op.RunAsync(referer, phrase, sourceLang.Id, checkedLangs |> Seq.map(fun l -> l.Id))
    )

    let app = new Application()
    app.Run(win) |> ignore
    

showResults function accepts source text, source language, and results and displays all information on new window (Owner = parent win). Its signature: let showResults text (sourceLang : Languages.Lang) parentWin (results : list). Implementation is similar to main function and thus omitted.

Xaml of main window (UI design is not strong point of mine :) )

<Window xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
         xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" 
        WindowStyle="SingleBorderWindow"
        WindowStartupLocation="CenterScreen"
        Height="350" Width="450">
    <Window.Resources>
        <ResourceDictionary Source="/PresentationFramework.Luna, Version=4.0.0.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35, ProcessorArchitecture=MSIL;component/themes/luna.metallic.xaml" />
    </Window.Resources>
    <Grid>
        <Grid.RowDefinitions>
            <RowDefinition MaxHeight="25"/>
            <RowDefinition />
            <RowDefinition MaxHeight="25" />
        </Grid.RowDefinitions>
        <Grid.ColumnDefinitions>
            <ColumnDefinition/>
            <ColumnDefinition MaxWidth="120"/>
        </Grid.ColumnDefinitions>
        <TextBox Height="23" x:Name="input" Grid.Row="0"/>
        <ComboBox x:Name="sourceLanguages" Grid.Row="0" Grid.Column="1">
            <ComboBox.ItemTemplate>
                <DataTemplate>
                    <TextBlock Text="{Binding Path=Name}"/>
                </DataTemplate>
            </ComboBox.ItemTemplate>
        </ComboBox>
        <ScrollViewer Grid.Row="1" Grid.ColumnSpan="2">
            <ItemsControl x:Name="languages" >
                <ItemsControl.ItemTemplate>
                    <DataTemplate>
                        <Border BorderThickness="1" BorderBrush="Black">
                            <CheckBox Margin="5,2,5,2" Content="{Binding Path=Language.Name}" x:Name="check" IsChecked="{Binding Path=Checked}"/>
                        </Border>
                    </DataTemplate>
                </ItemsControl.ItemTemplate>
            </ItemsControl>
        </ScrollViewer>
        <Button Content="Translate" Grid.Row="2" Grid.ColumnSpan="2" x:Name="translate" Margin="0,2,0,2"/>
        <Image Grid.Column="1" Grid.Row="1" Grid.RowSpan="2" Height="150" HorizontalAlignment="Left" Margin="252,244,0,0" Stretch="Fill" VerticalAlignment="Top" Width="200" />
    </Grid>
</Window>

Main window

Results