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
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