Railway oriented programming with Async operations - asynchronous

Previously asked similar question but somehow I'm not finding my way out, attempting again with another example.
The code as a starting point (a bit trimmed) is available at https://ideone.com/zkQcIU.
(it has some issue recognizing Microsoft.FSharp.Core.Result type, not sure why)
Essentially all operations have to be pipelined with the previous function feeding the result to the next one. The operations have to be async and they should return error to the caller in case an exception occurred.
The requirement is to give the caller either result or fault. All functions return a Tuple populated with either Success type Article or Failure with type Error object having descriptive code and message returned from the server.
Will appreciate a working example around my code both for the callee and the caller in an answer.
Callee Code
type Article = {
name: string
}
type Error = {
code: string
message: string
}
let create (article: Article) : Result<Article, Error> =
let request = WebRequest.Create("http://example.com") :?> HttpWebRequest
request.Method <- "GET"
try
use response = request.GetResponse() :?> HttpWebResponse
use reader = new StreamReader(response.GetResponseStream())
use memoryStream = new MemoryStream(Encoding.UTF8.GetBytes(reader.ReadToEnd()))
Ok ((new DataContractJsonSerializer(typeof<Article>)).ReadObject(memoryStream) :?> Article)
with
| :? WebException as e ->
use reader = new StreamReader(e.Response.GetResponseStream())
use memoryStream = new MemoryStream(Encoding.UTF8.GetBytes(reader.ReadToEnd()))
Error ((new DataContractJsonSerializer(typeof<Error>)).ReadObject(memoryStream) :?> Error)
Rest of the chained methods - Same signature and similar bodies. You can actually reuse the body of create for update, upload, and publish to be able to test and compile code.
let update (article: Article) : Result<Article, Error>
// body (same as create, method <- PUT)
let upload (article: Article) : Result<Article, Error>
// body (same as create, method <- PUT)
let publish (article: Article) : Result<Article, Error>
// body (same as create, method < POST)
Caller Code
let chain = create >> Result.bind update >> Result.bind upload >> Result.bind publish
match chain(schemaObject) with
| Ok article -> Debug.WriteLine(article.name)
| Error error -> Debug.WriteLine(error.code + ":" + error.message)
Edit
Based on the answer and matching it with Scott's implementation (https://i.stack.imgur.com/bIxpD.png), to help in comparison and in better understanding.
let bind2 (switchFunction : 'a -> Async<Result<'b, 'c>>) =
fun (asyncTwoTrackInput : Async<Result<'a, 'c>>) -> async {
let! twoTrackInput = asyncTwoTrackInput
match twoTrackInput with
| Ok s -> return! switchFunction s
| Error err -> return Error err
}
Edit 2 Based on F# implementation of bind
let bind3 (binder : 'a -> Async<Result<'b, 'c>>) (asyncResult : Async<Result<'a, 'c>>) = async {
let! result = asyncResult
match result with
| Error e -> return Error e
| Ok x -> return! binder x
}

Take a look at the Suave source code, and specifically the WebPart.bind function. In Suave, a WebPart is a function that takes a context (a "context" is the current request and the response so far) and returns a result of type Async<context option>. The semantics of chaining these together are that if the async returns None, the next step is skipped; if it returns Some value, the next step is called with value as the input. This is pretty much the same semantics as the Result type, so you could almost copy the Suave code and adjust it for Result instead of Option. E.g., something like this:
module AsyncResult
let bind (f : 'a -> Async<Result<'b, 'c>>) (a : Async<Result<'a, 'c>>) : Async<Result<'b, 'c>> = async {
let! r = a
match r with
| Ok value ->
let next : Async<Result<'b, 'c>> = f value
return! next
| Error err -> return (Error err)
}
let compose (f : 'a -> Async<Result<'b, 'e>>) (g : 'b -> Async<Result<'c, 'e>>) : 'a -> Async<Result<'c, 'e>> =
fun x -> bind g (f x)
let (>>=) a f = bind f a
let (>=>) f g = compose f g
Now you can write your chain as follows:
let chain = create >=> update >=> upload >=> publish
let result = chain(schemaObject) |> Async.RunSynchronously
match result with
| Ok article -> Debug.WriteLine(article.name)
| Error error -> Debug.WriteLine(error.code + ":" + error.message)
Caution: I haven't been able to verify this code by running it in F# Interactive, since I don't have any examples of your create/update/etc. functions. It should work, in principle — the types all fit together like Lego building blocks, which is how you can tell that F# code is probably correct — but if I've made a typo that the compiler would have caught, I don't yet know about it. Let me know if that works for you.
Update: In a comment, you asked whether you need to have both the >>= and >=> operators defined, and mentioned that you didn't see them used in the chain code. I defined both because they serve different purposes, just like the |> and >> operators serve different purposes. >>= is like |>: it passes a value into a function. While >=> is like >>: it takes two functions and combines them. If you would write the following in a non-AsyncResult context:
let chain = step1 >> step2 >> step3
Then that translates to:
let asyncResultChain = step1AR >=> step2AR >=> step3AR
Where I'm using the "AR" suffix to indicate versions of those functions that return an Async<Result<whatever>> type. On the other hand, if you had written that in a pass-the-data-through-the-pipeline style:
let result = input |> step1 |> step2 |> step3
Then that would translate to:
let asyncResult = input >>= step1AR >>= step2AR >>= step3AR
So that's why you need both the bind and compose functions, and the operators that correspond to them: so that you can have the equivalent of either the |> or the >> operators for your AsyncResult values.
BTW, the operator "names" that I picked (>>= and >=>), I did not pick randomly. These are the standard operators that are used all over the place for the "bind" and "compose" operations on values like Async, or Result, or AsyncResult. So if you're defining your own, stick with the "standard" operator names and other people reading your code won't be confused.
Update 2: Here's how to read those type signatures:
'a -> Async<Result<'b, 'c>>
This is a function that takes type A, and returns an Async wrapped around a Result. The Result has type B as its success case, and type C as its failure case.
Async<Result<'a, 'c>>
This is a value, not a function. It's an Async wrapped around a Result where type A is the success case, and type C is the failure case.
So the bind function takes two parameters:
a function from A to an async of (either B or C)).
a value that's an async of (either A or C)).
And it returns:
a value that's an async of (either B or C).
Looking at those type signatures, you can already start to get an idea of what the bind function will do. It will take that value that's either A or C, and "unwrap" it. If it's C, it will produce an "either B or C" value that's C (and the function won't need to be called). If it's A, then in order to convert it to an "either B or C" value, it will call the f function (which takes an A).
All this happens within an async context, which adds an extra layer of complexity to the types. It might be easier to grasp all this if you look at the basic version of Result.bind, with no async involved:
let bind (f : 'a -> Result<'b, 'c>) (a : Result<'a, 'c>) =
match a with
| Ok val -> f val
| Error err -> Error err
In this snippet, the type of val is 'a, and the type of err is 'c.
Final update: There was one comment from the chat session that I thought was worth preserving in the answer (since people almost never follow chat links). Developer11 asked,
... if I were to ask you what Result.bind in my example code maps to your approach, can we rewrite it as create >> AsyncResult.bind update? It worked though. Just wondering i liked the short form and as you said they have a standard meaning? (in haskell community?)
My reply was:
Yes. If the >=> operator is properly written, then f >=> g will always be equivalent to f >> bind g. In fact, that's precisely the definition of the compose function, though that might not be immediately obvious to you because compose is written as fun x -> bind g (f x) rather than as f >> bind g. But those two ways of writing the compose function would be exactly equivalent. It would probably be very instructive for you to sit down with a piece of paper and draw out the function "shapes" (inputs & outputs) of both ways of writing compose.

Why do you want to use Railway Oriented Programming here? If you just want to run a sequence of operations and return information about the first exception that occurs, then F# already provides a language support for this using exceptions. You do not need Railway Oriented Programming for this. Just define your Error as an exception:
exception Error of code:string * message:string
Modify the code to throw the exception (also note that your create function takes article but does not use it, so I deleted that):
let create () = async {
let ds = new DataContractJsonSerializer(typeof<Error>)
let request = WebRequest.Create("http://example.com") :?> HttpWebRequest
request.Method <- "GET"
try
use response = request.GetResponse() :?> HttpWebResponse
use reader = new StreamReader(response.GetResponseStream())
use memoryStream = new MemoryStream(Encoding.UTF8.GetBytes(reader.ReadToEnd()))
return ds.ReadObject(memoryStream) :?> Article
with
| :? WebException as e ->
use reader = new StreamReader(e.Response.GetResponseStream())
use memoryStream = new MemoryStream(Encoding.UTF8.GetBytes(reader.ReadToEnd()))
return raise (Error (ds.ReadObject(memoryStream) :?> Error)) }
And then you can compose functions just by sequencing them in async block using let! and add exception handling:
let main () = async {
try
let! created = create ()
let! updated = update created
let! uploaded = upload updated
Debug.WriteLine(uploaded.name)
with Error(code, message) ->
Debug.WriteLine(code + ":" + message) }
If you wanted more sophisticated exception handling, then Railway Oriented Programming might be useful and there is certainly a way of integrating it with async, but if you just want to do what you described in your question, then you can do that much more easily with just standard F#.

Related

currying multiple functions in parallel in F#

I'm trying to learn F# at the moment and have come up on a problem I can't solve and can't find any answers for on google.
Initially I wanted a log function that would work like the printf family of functions whereby I could provide a format string and a number of arguments (statically checked) but which would add a little metadata before printing it out. With googling, I found this was possible using a function like the following:
let LogToConsole level (format:Printf.TextWriterFormat<'T>) =
let extendedFormat = (Printf.TextWriterFormat<string->string->'T> ("%s %s: " + format.Value))
let date = DateTime.UtcNow.ToString "yyyy-MM-dd HH:mm:ss.fff"
let lvl = string level
printfn extendedFormat date lvl
having the printfn function as the last line of this function allows the varargs-like magic of the printf syntax whereby the partially-applied printfn method is returned to allow the caller to finish applying arguments.
However, if I have multiple such functions with the same signature, say LogToConsole, LogToFile and others, how could I write a function that would call them all keeping this partial-application magic?
Essential I'm looking for how I could implement a function MultiLog
that would allow me to call multiple printf-like functions from a single function call Such as in the ResultIWant function below:
type LogFunction<'T> = LogLevel -> Printf.TextWriterFormat<'T> -> 'T
let MultiLog<'T> (loggers:LogFunction<'T>[]) level (format:Printf.TextWriterFormat<'T>) :'T =
loggers
|> Seq.map (fun f -> f level format)
|> ?????????
let TheResultIWant =
let MyLog = MultiLog [LogToConsole; LogToFile]
MyLog INFO "Text written to %i outputs" 2
Perhaps the essence of this question can be caught more succintly: given a list of functions of the same signature how can I partially apply them all with the same arguments?
type ThreeArg = string -> int -> bool -> unit
let funcs: ThreeArg seq = [func1; func2; func3]
let MagicFunction = ?????
// I'd like this to be valid
let partiallyApplied = MagicFunction funcs "string"
// I'd also like this to be valid
let partiallyApplied = MagicFunction funcs "string" 255
// and this (fullyApplied will be `unit`)
let fullyApplied = MagicFunction funcs "string" 255 true
To answer the specific part of the question regarding string formatting, there is a useful function Printf.kprintf which lets you do what you need in a very simple way - the first parameter of the function is a continuation that gets called with the formatted string as an argument. In this continuation, you can just take the formatted string and write it to all the loggers you want. Here is a basic example:
let Loggers = [printfn "%s"]
let LogEverywhere level format =
Printf.kprintf (fun s ->
let date = DateTime.UtcNow.ToString "yyyy-MM-dd HH:mm:ss.fff"
let lvl = string level
for logger in Loggers do logger (sprintf "%s %s %s" date lvl s)) format
LogEverywhere "BAD" "hi %d" 42
I don't think there is a nice and simple way to do what you wanted to do in the more general case - I suspect you might be able to use some reflection or static member constraints magic, but fortunately, you don't need to in this case!
There is almost nothing to add to a perfect #TomasPetricek answer as he is basically a "semi-god" in F#. Another alternative, which comes to mind, is to use a computation expression (see, for example: https://fsharpforfunandprofit.com/series/computation-expressions.html). When used properly it does look like magic :) However, I have a feeling that it is a little bit too heavy for the problem, which you described.

get any non-error element from a list of deferred in OCaml/Async

Suppose I have a function such as:
query_server : Server.t -> string Or_error.t Deferred.t
Then I produce a list of deferred queries:
let queries : string Or_error.t Deferred.t list = List.map servers ~f:query_server
How to get the result of the first query that doesn't fail (or some error otherwise). Basically, I'd like a function such as:
any_non_error : 'a Or_error.t Deferred.t list -> 'a Or_error.t
Also, I'm not sure how to somehow aggregate the errors. Maybe my function needs an extra parameter such as Error.t -> Error.t -> Error.t or is there a standard way to combine errors?
A simple approach would be to use Deferred.List that contains list operations lifted into the Async monad, basically a container interface in the Kleisli category. We will try each server in order until the first one is ready, e.g.,
let first_non_error =
Deferred.List.find ~f:(fun s -> query_server s >>| Result.is_ok)
Of course, it is not any_non_error, as the processing is sequential. Also, we are losing the error information (though the latter is very easy to fix).
So to make it parallel, we will employ the following strategy. We will have two deferred computations, the first will run all queries in parallel and wait until all are ready, the second will become determined as soon as an Ok result is received. If the first one happens before the last one, then it means that all servers failed. So let's try:
let query_servers servers =
let a_success,got_success = Pipe.create () in
let all_errors = Deferred.List.map ~how:`Parallel servers ~f:(fun s ->
query_server s >>| function
| Error err as e -> e
| Ok x as ok -> Pipe.write_without_pushback x; ok) in
Deferred.any [
Deferred.any all_errors;
Pipe.read a_success >>= function
| `Ok x -> Ok x
| `Eof -> assert false
]

How to get the name of a higher order function in F#? [duplicate]

How can I create a function called getFuncName that takes a function of type (unit -> 'a) and returns its name.
I was talking to one of the C# devs and they said you could use the .Method property on a Func type as shown in an example here.
I tried to convert this to F# :
for example convert (unit -> 'a) to a type Func<_> then call the property on it but it always returns the string "Invoke".
let getFuncName f =
let fFunc = System.Func<_>(fun _ -> f())
fFunc.Method.Name
let customFunc() = 1.0
// Returns "Invoke" but I want it to return "customFunc"
getFuncName customFunc
A bit of background to this problem is:
I have created an array of functions of type (unit -> Deedle.Frame). I now want to cycle through those functions invoking them and saving them to csv with the csv name having the same name as the function. Some hypothetical code is below:
let generators : (unit -> Frame<int, string>) array = ...
generators
|> Array.iter (fun generator -> generator().SaveCsv(sprintf "%s\%s.csv" __SOURCE_DIRECTORY__ (getFuncName generator)))
This is being used in a scripting sense rather than as application code.
Not sure how you searched for information, but the first query to the search engine gave me this response:
let getFuncName f =
let type' = f.GetType()
let method' = type'.GetMethods() |> Array.find (fun m -> m.Name="Invoke")
let il = method'.GetMethodBody().GetILAsByteArray()
let methodCodes = [byte OpCodes.Call.Value;byte OpCodes.Callvirt.Value]
let position = il |> Array.findIndex(fun x -> methodCodes |> List.exists ((=)x))
let metadataToken = BitConverter.ToInt32(il, position+1)
let actualMethod = type'.Module.ResolveMethod metadataToken
actualMethod.Name
Unfortunately, this code only works when F# compiler does not inline function body into calling method.
Taken from here
Although there may be a more simple way.

Select First Async Result

Is there an async operator to get the value first returned by two asynchronous values (Async<_>)?
For example, given two Async<_> values where one A1 returns after 1 second and A2 returns after 2 seconds, then I want the result from A1.
The reason is I want to implement an interleave function for asynchronous sequences, so that if there are two asynchronous sequences "defined" like this (with space indicating time as with marble diagrams):
S1 = -+-----+------------+----+
S2 = ---+-------+----------+-----+
Then I want to generate a new asynchronous sequence that acts like this:
S3 = -+-+---+---+--------+-+--+--+
Interleave S1 S2 = S3
But two do that, I probably need a kind of async select operator to select select values.
I think this would be like "select" in Go, where you can take the first available value from two channels.
TPL has a function called Task.WhenAny - I probably need something similar here.
I don't think the operator is available in the F# library. To combine this from existing operations, you could use Async.StartAsTask and then use the existing Task.WhenAny operator. However, I'm not exactly sure how that would behave with respect to cancellation.
The other option is to use the Async.Choose operator implemented on F# Snippets web site. This is not particularly elegant, but it should do the trick! To make the answer stand-alone, the code is attached below.
/// Creates an asynchronous workflow that non-deterministically returns the
/// result of one of the two specified workflows (the one that completes
/// first). This is similar to Task.WaitAny.
static member Choose(a, b) : Async<'T> =
Async.FromContinuations(fun (cont, econt, ccont) ->
// Results from the two
let result1 = ref (Choice1Of3())
let result2 = ref (Choice1Of3())
let handled = ref false
let lockObj = new obj()
let synchronized f = lock lockObj f
// Called when one of the workflows completes
let complete () =
let op =
synchronized (fun () ->
// If we already handled result (and called continuation)
// then ignore. Otherwise, if the computation succeeds, then
// run the continuation and mark state as handled.
// Only throw if both workflows failed.
match !handled, !result1, !result2 with
| true, _, _ -> ignore
| false, (Choice2Of3 value), _
| false, _, (Choice2Of3 value) ->
handled := true
(fun () -> cont value)
| false, Choice3Of3 e1, Choice3Of3 e2 ->
handled := true;
(fun () ->
econt (new AggregateException
("Both clauses of a choice failed.", [| e1; e2 |])))
| false, Choice1Of3 _, Choice3Of3 _
| false, Choice3Of3 _, Choice1Of3 _
| false, Choice1Of3 _, Choice1Of3 _ -> ignore )
op()
// Run a workflow and write result (or exception to a ref cell
let run resCell workflow = async {
try
let! res = workflow
synchronized (fun () -> resCell := Choice2Of3 res)
with e ->
synchronized (fun () -> resCell := Choice3Of3 e)
complete() }
// Start both work items in thread pool
Async.Start(run result1 a)
Async.Start(run result2 b) )
Tomas already answered the precise question. However, you might be interested to know that my Hopac library for F# directly supports Concurrent ML -style first-class, higher-order, selective events, called alternatives, which directly provide a choose -combinator and provide a more expressive concurrency abstraction mechanism than Go's select statement.
Regarding your more specific problem of interleaving two asynchronous sequences, I recently started experimenting with ideas on how Rx-style programming could be done with Hopac. One potential approach I came up with is to define a kind of ephemeral event streams. You can find the experimental code here:
Alts.fsi
Alts.fs
As you can see, one of the operations defined for event streams is merge. What you are looking for may be slightly different semantically, but would likely be straightforward to implement using Hopac -style alternatives (or Concurrent ML -style events).

Monadic Retry logic w/ F# and async?

I've found this snippet:
http://fssnip.net/8o
But I'm working not only with retriable functions, but also with asynchronous such, and I was wondering how I make this type properly. I have a tiny piece of retryAsync monad that I'd like to use as a replacement for async computations, but that contains retry logic, and I'm wondering how I combine them?
type AsyncRetryBuilder(retries) =
member x.Return a = a // Enable 'return'
member x.ReturnFrom a = x.Run a
member x.Delay f = f // Gets wrapped body and returns it (as it is)
// so that the body is passed to 'Run'
member x.Bind expr f = async {
let! tmp = expr
return tmp
}
member x.Zero = failwith "Zero"
member x.Run (f : unit -> Async<_>) : _ =
let rec loop = function
| 0, Some(ex) -> raise ex
| n, _ ->
try
async { let! v = f()
return v }
with ex -> loop (n-1, Some(ex))
loop(retries, None)
let asyncRetry = AsyncRetryBuilder(4)
Consuming code is like this:
module Queue =
let desc (nm : NamespaceManager) name = asyncRetry {
let! exists = Async.FromBeginEnd(name, nm.BeginQueueExists, nm.EndQueueExists)
let beginCreate = nm.BeginCreateQueue : string * AsyncCallback * obj -> IAsyncResult
return! if exists then Async.FromBeginEnd(name, nm.BeginGetQueue, nm.EndGetQueue)
else Async.FromBeginEnd(name, beginCreate, nm.EndCreateQueue)
}
let recv (client : MessageReceiver) timeout =
let bRecv = client.BeginReceive : TimeSpan * AsyncCallback * obj -> IAsyncResult
asyncRetry {
let! res = Async.FromBeginEnd(timeout, bRecv, client.EndReceive)
return res }
Error is:
This expression was expected to have type Async<'a> but here has type 'b -> Async<'c>
Your Bind operation behaves like a normal Bind operation of async, so your code is mostly a re-implementation (or wrapper) over async. However, your Return does not have the right type (it should be 'T -> Async<'T>) and your Delay is also different than normal Delay of async. In general, you should start with Bind and Return - using Run is a bit tricky, because Run is used to wrap the entire foo { .. } block and so it does not give you the usual nice composability.
The F# specification and a free chapter 12 from Real-World Functional Programming both show the usual types that you should follow when implementing these operations, so I won't repeat that here.
The main issue with your approach is that you're trying to retry the computation only in Run, but the retry builder that you're referring to attempts to retry each individual operation called using let!. Your approach may be sufficient, but if that's the case, you can just implement a function that tries to run normal Async<'T> and retries:
let RetryRun count (work:Async<'T>) = async {
try
// Try to run the work
return! work
with e ->
// Retry if the count is larger than 0, otherwise fail
if count > 0 then return! RetryRun (count - 1) work
else return raise e }
If you actually want to implement a computation builder that will implicitly try to retry every single asynchronous operation, then you can write something like the following (it is just a sketch, but it should point you in the right direction):
// We're working with normal Async<'T> and
// attempt to retry it until it succeeds, so
// the computation has type Async<'T>
type RetryAsyncBuilder() =
member x.ReturnFrom(comp) = comp // Just return the computation
member x.Return(v) = async { return v } // Return value inside async
member x.Delay(f) = async { return! f() } // Wrap function inside async
member x.Bind(work, f) =
async {
try
// Try to call the input workflow
let! v = work
// If it succeeds, try to do the rest of the work
return! f v
with e ->
// In case of exception, call Bind to try again
return! x.Bind(work, f) }

Resources