I have the following code. And I want to run without blocking the main thread.
let post () = .....
try
let response = post ()
logger.Info(response.ToString())
with
| ex -> logger.Error(ex, "Exception: " + ex.Message)
So I changed the code to the following. However, how to catch the exception in post?
let post = async {
....
return X }
try
let response = post |> Async.StartChild
logger.Info(response.ToString())
with
| ex -> logger.Error(ex, "Exception: " + ex.Message)
One way is to use Async.Catch in a calling workflow. Given a couple of functions (a throwaway "async" function and something to work with the result):
let work a = async {
return
match a with
| 1 -> "Success!"
| _ -> failwith "Darnit"
}
let printResult (res:Choice<'a,System.Exception>) =
match res with
| Choice1Of2 a -> printfn "%A" a
| Choice2Of2 e -> printfn "Exception: %s" e.Message
One can use Async.Catch
let callingWorkflow =
async {
let result = work 1 |> Async.Catch
let result2 = work 0 |> Async.Catch
[ result; result2 ]
|> Async.Parallel
|> Async.RunSynchronously
|> Array.iter printResult
}
callingWorkflow |> Async.RunSynchronously
Async.Catch returns a Choice<'T1,'T2>. Choice1Of2 for a successful execution, and the exception thrown for the Choice2Of2.
You'd put the try/catch in an async block as well
let post = async { .... }
async {
try
let! response = post
logger.Info(response.ToString())
with
| ex -> logger.Error(ex, "Exception: " + ex.Message)
} |> Async.Start
Related
When I have a runtime error like this one
type Msg = Any
type Agent() =
let agent =
MailboxProcessor.Start(fun inbox ->
let rec messageLoop (oldState) =
async {
let! msg = inbox.Receive()
printfn "1"
match msg with
| Any ->
printfn "2"
let neverFound=
oldState
|> List.find (fun x -> x = 42)
printfn "3" // <- never happens, because I tried to find something that does not exists
return! messageLoop (oldState # [neverFound])
}
printfn "0"
messageLoop ([ 1; 2; 3 ]))
member __.Post a = agent.Post a
let agent = Agent()
agent.Post ( Any)
it doest crash, the error is completely silent, but if I do explicitly try .. with:
type Msg = Any
type Agent() =
let agent =
MailboxProcessor.Start(fun inbox ->
let rec messageLoop (oldState) =
async {
let! msg = inbox.Receive()
printfn "1"
match msg with
| Any ->
printfn "2"
try
let neverFound=
oldState
|> List.find (fun x -> x = 42)
printfn "3"
return! messageLoop (oldState # [neverFound])
with e ->
printfn "%A" e <-- does print
printfn "4"
}
printfn "0"
messageLoop ([ 1; 2; 3 ]))
member __.Post a = agent.Post a
let agent = Agent()
agent.Post ( Any)
if does catches the error.
This is not the only place this happens, apparently, errors that happen inside async are silent? How can I prevent this? Is there a flag one can run with no silent errors? or maybe a global async error handler?
This is by design. You don't expect actors to crash on receiving a message.
Start is essentially:
Async.Start(async { try do! body x with exn -> trigger exn })
So if you expose MailboxProcessor.Error with
member _.Error = agent.Error
and listen to it:
agent.Error
|> Observable.subscribe(fun (err) -> printfn "Oh no, an error: %s" err.Message)
|> ignore
you will indeed see:
Oh no, an error: An index satisfying the predicate was not found in the collection.
Using AsyncResult from Scott Wlashin and wondering how I can change from the error track to the success track.
Pseudo-code:
let orchestratorFunction() : AsyncResult<Customer, CustomerError> = asyncResult {
let! output1 = callFunction1 arg1 arg2 |> AsyncResult.MapError CustomerError.Val1
let! output2 = callFunction2 arg1 arg2 |> AsyncResult.MapError CustomerError.Val2
let! output3 = callFunction3 arg1 arg2 |> AsyncResult.MapError (fun e -> ********HERE I WANT TO GET BACK TO THE SUCCESS PATH AND RETURN output3*********)
}
or a more realistic example:
let createCustomer() : AsyncResult<Customer, CustomerError> = asyncResult {
let! customerDto = mapDtoFromHttpRequest arg1 arg2 |> AsyncResult.MapError CustomerError.Val1
let! validatedCustomer = validateCustomer arg1 arg2 |> AsyncResult.MapError CustomerError.Val2
let! validatedCustomer = insertCustomer arg1 arg2
|> AsyncResult.MapError (fun e ->
match e with
| DuplicateCustomer _ ->
loadCustomerById xx
|> (fun c ->
if c.LastCausationId = validatedCustomer.LastCausationId
then c
else e))
}
So basically I am trying to get out of the unhappy path, because this is an idempotent REST operation and any repetitive requests will be answered with 200 OK, as if they were the original request, so that the client can have a simple logic.
Based on the answer from #Gus to this question (AsyncResult and handling rollback) it seems that bindError is what I needed. I created a similar to his bindError bindExn, and it seems to work as well, so now both error and exns can be converted to Ok:
(From Gus):
/// Apply a monadic function to an AsyncResult error
let bindError (f: 'a -> AsyncResult<'b,'c>) (xAsyncResult : AsyncResult<_, _>) :AsyncResult<_,_> = async {
let! xResult = xAsyncResult
match xResult with
| Ok x -> return Ok x
| Error err -> return! f err
}
(My code):
let bindExn
(f: exn -> AsyncResult<'a,'b>)
(xAsyncResult:AsyncResult<_,_>)
: AsyncResult<'a,'b>
=
async {
let! res =
xAsyncResult
|> Async.Catch
|> Async.map(function
| Choice1Of2 res -> res |> AsyncResult.ofResult
| Choice2Of2 (ex:exn) ->
f ex
)
return! res
}
How can I get get a list of names visible in the scope with FSC?
I tried this:
#r "../../packages/FSharp.Compiler.Service.16.0.2/lib/net45/FSharp.Compiler.Service.dll"
open Microsoft.FSharp.Compiler
open Microsoft.FSharp.Compiler.SourceCodeServices
do
let file = "TestFileName.fsx"
let checker = SourceCodeServices.FSharpChecker.Create()
let code =
"""
let testStr = "x"
t
"""
async{
let! options, _ = checker.GetProjectOptionsFromScript(file,code)
let! parseRes,checkAnser = checker.ParseAndCheckFileInProject(file, 0, code, options)
match checkAnser with
| FSharpCheckFileAnswer.Succeeded checkRes ->
let! decls =
checkRes.GetDeclarationListInfo(
Some parseRes, //ParsedFileResultsOpt
3 , //line
1 , //colAtEndOfPartialName
"t" , //lineText
[ "t" ] , //qualifyingNames
"" , //partialName
( fun _ -> [] ) //getAllSymbols: (unit -> AssemblySymbol list)
)
if Seq.isEmpty decls.Items then
printfn "*no declarations found*"
else
decls.Items
|> Seq.sortBy (fun d -> d.Name)
|> Seq.truncate 10
|> Seq.iter (fun d -> printfn "decl: %s" d.Name)
| _ -> failwithf "*Parsing did not finish... "
} |> Async.RunSynchronously
but it only prints "no declarations found". I would expect not only testStr but also all the other names that are available by default.
I did not find an example in the documentation.
qualifyingNames should be an empty list, it’s for dot separated prefix, excluding the last (possibly partial) ident. However, there is no a method in FCS that returns unfiltered list of names for scope, yet it’s really easy to add one.
With the answer of vasily-kirichenko and using the current FCS 17.0.1 I came up with this solution:
#r "../../packages/FSharp.Compiler.Service.17.0.1/lib/net45/FSharp.Compiler.Service.dll"
open Microsoft.FSharp.Compiler
open Microsoft.FSharp.Compiler.SourceCodeServices
do
let file = "TestFileName.fsx"
let checker = SourceCodeServices.FSharpChecker.Create()
let code =
"""
let testStr = "x"
testStr.
"""
async{
let! options, _ = checker.GetProjectOptionsFromScript(file,code)
let! parseRes,checkAnser = checker.ParseAndCheckFileInProject(file, 0, code, options)
match checkAnser with
| FSharpCheckFileAnswer.Succeeded checkRes ->
let! decls =
let partialName = PartialLongName.Empty 6 //use any location before before the dot to get all declarations in scope
//let partialName = PartialLongName.Empty 7 //use the loacation of the dot (7) to get memebers of string
checkRes.GetDeclarationListInfo(
Some parseRes, // ParsedFileResultsOpt
3 , // line
"testStr." , // lineText
partialName, // PartialLongName
( fun _ -> [] ) // getAllSymbols: (unit -> AssemblySymbol list)
)
if Seq.isEmpty decls.Items then
printfn "*no declarations found*"
else
decls.Items
|> Seq.sortBy (fun d -> d.Name)
|> Seq.truncate 10
|> Seq.iter (fun d -> printfn "decl: %s" d.Name)
| _ -> failwithf "*Parsing did not finish... "
} |> Async.RunSynchronously
I'm trying to learn about the Observable module in F# by writing a program that connects to a web socket, listens for messages, and then handles them in some set of streams based on Observables. However, I'm having a hard time understanding the actual behavior.
First, I set up a web socket like this:
open System
open System.Net.WebSockets
open System.Threading
let connectFeed =
let feedUrl = "blah blah"
let buffer : byte array = Array.zeroCreate 1024
let segment = ArraySegment(buffer)
let socketEvent = new Event<string>()
let task = async {
let random = Random(DateTime.Now.Millisecond)
use socket = new ClientWebSocket()
let! token = Async.CancellationToken
do! Async.AwaitTask (socket.ConnectAsync(Uri(feedUrl), token))
while not token.IsCancellationRequested do
let! result = Async.AwaitTask (socket.ReceiveAsync(segment, token))
socketEvent.Trigger (Encoding.UTF8.GetString(buffer))
Array.fill buffer 0 buffer.Length 0uy
}
(task, socketEvent.Publish)
let deserializeMsg (raw:string) =
// returns a MsgType based on the received message
let tryGetData (msg:MsgType) =
// returns Some data for specific kind of message; None otherwise
[<EntryPoint>]
let main argv =
let feedProc, feedStream = connectFeed
let msgStream = feedStream |> Observable.map deserializeMsg
msgStream |> Observable.subscribe (fun m -> printfn "got msg: %A" m) |> ignore
let dataStream = feedStream |> Observable.choose tryGetData
dataStream |> Observable.subscribe (fun d -> printfn "got data: %A" d) |> ignore
Async.RunSynchronously feedProc
0
I'm expecting to see a printout like:
got msg: { some: "field" }
got msg: { some: "other" }
got msg: { some: "data" }
got data: { // whatever }
got msg: ...
...
Instead, only the "got msg" messages appear, even though there are messages that would cause tryGetData to return Some.
What's going on here? How do I set up multiple Observable streams from a single event?
Update: I've updated my code with this:
let isMsgA msg =
printfn "isMsgA"
match msg with
| MsgA -> true // where MsgA is a member of a DU defined elsewhere, and is the result of deserializeMsg
| _ -> false
let isStringMsgA msg =
printfn "isStringMsgA"
if msg.StartsWith("{ \"type\": \"msga\"") then true else false
[<EntryPoint>]
let main argv =
let feedProc, feedStream = connectFeed
let msgStream = feedStream |> Observable.map deserializeMsg
msgStream
|> Observable.filter isMsgA
|> Observable.subscribe (fun m -> printfn "got msg MsgA")
|> ignore
feedStream
|> Observable.filter isStringMsgA
|> Observable.subscribe (fun m -> printfn "got string MsgA")
|> ignore
And I get a screen full of "isStringMsgA" and "got string MsgA" messages, but exactly one each of "isMsgA" and "got msg MsgA".
I am baffled.
Here is a trimmed-down, reproducible example for anyone interesting in fiddling with it:
https://github.com/aggieben/test-observable
Update 2: looks like I may be seeing this behavior due to an exception being thrown in the deserializeMsg function. Still digging...
I do not see any obvious reason why this should be happening - can you add some logging to tryGetData to check what inputs it gets and what results it returns?
When using the Observable module, you construct a description of the processing pipeline and Observable.subscribe creates a concrete chain of listeners that do the work and attach handlers to the primary event source. However, the events do not get "consumed" - they should be sent to all the observers.
For example, try playing with the following minimal demo:
let evt = Event<int>()
let e1 = evt.Publish |> Observable.choose (fun n ->
if n % 2 = 0 then Some "woop!" else None)
let e2 = evt.Publish |> Observable.map (fun n -> n * 10)
e1 |> Observable.subscribe (printfn "E1: %s")
e2 |> Observable.subscribe (printfn "E2: %d")
evt.Trigger(1)
evt.Trigger(2)
If you run this, it prints the expected result:
E2: 10
E1: woop!
E2: 20
After playing with F# agents I tried to do a map reduce using them.
The basic structure I use is:
map supervisor which queues up all the work to do in its state and receives work request from map workers
reduce supervisor does the same thing as map supervisor for reduce work
a bunch of map and reduce workers that map and reduce, if one fails its work it sends it back to the respective supervisr to be reprocessed.
The questions I wonder about is:
does this make any sense compared to a more traditional (yet very nice) map reduce like (http://tomasp.net/blog/fsharp-parallel-aggregate.aspx) that uses PSeq ?
the way I implemented the map and reduce workers seems ugly is there a better way ?
it seems like I can create a 1000 000 map workers and 1000 0000 reduce workers lol, how should I choose these numbers, the more the better ?
Thanks a lot,
type Agent<'T> = MailboxProcessor<'T>
//This is the response the supervisor
//gives to the worker request for work
type 'work SupervisorResponse =
| Work of 'work //a piece of work
| NoWork//no work left to do
//This is the message to the supervisor
type 'work WorkMsg =
| ToDo of 'work //piles up work in the Supervisor queue
| WorkReq of AsyncReplyChannel<SupervisorResponse<'work>> //'
//The supervisor agent can be interacted with
type AgentOperation =
| Stop //stop the agent
| Status //yield the current status of supervisor
type 'work SupervisorMsg =
| WorkRel of 'work WorkMsg
| Operation of AgentOperation
//Supervises Map and Reduce workers
module AgentSupervisor=
let getNew (name:string) =
new Agent<SupervisorMsg<'work>>(fun inbox -> //'
let rec loop state = async {
let! msg = inbox.Receive()
match msg with
| WorkRel(m) ->
match m with
| ToDo(work) ->
let newState = work:state
return! loop newState
| WorkReq(replyChannel) ->
match state with
| [] ->
replyChannel.Reply(NoWork)
return! loop []
| [item] ->
replyChannel.Reply(Work(item))
return! loop []
| (item::remaining) ->
replyChannel.Reply(Work(item))
return! loop remaining
| Operation(op) ->
match op with
| Status ->
Console.WriteLine(name+" current Work Queue "+
string (state.Length))
return! loop state
| Stop ->
Console.WriteLine("Stoppped SuperVisor Agent "+name)
return()
}
loop [] )
let stop (agent:Agent<SupervisorMsg<'work>>) = agent.Post(Operation(Stop))
let status (agent:Agent<SupervisorMsg<'work>>) =agent.Post(Operation(Status))
//Code for the workers
type 'success WorkOutcome =
| Success of 'success
| Fail
type WorkerMsg =
| Start
| Stop
| Continue
module AgentWorker =
type WorkerSupervisors<'reduce,'work> =
{ Map:Agent<SupervisorMsg<'work>> ; Reduce:Agent<SupervisorMsg<'reduce>> }
let stop (agent:Agent<WorkerMsg>) = agent.Post(Stop)
let start (agent:Agent<WorkerMsg>) = agent.Start()
agent.Post(Start)
let getNewMapWorker( map, supervisors:WorkerSupervisors<'reduce,'work> ) =
new Agent<WorkerMsg>(fun inbox ->
let rec loop () = async {
let! msg = inbox.Receive()
match msg with
| Start -> inbox.Post(Continue)
return! loop ()
| Continue ->
let! supervisorOrder =
supervisors.Map.PostAndAsyncReply(
fun replyChannel ->
WorkRel(WorkReq(replyChannel)))
match supervisorOrder with
| Work(work) ->
let! res = map work
match res with
| Success(toReduce) ->
supervisors.Reduce
.Post(WorkRel(ToDo(toReduce)))
| Fail ->
Console.WriteLine("Map Fail")
supervisors.Map
.Post(WorkRel(ToDo(work)))
inbox.Post(Continue)
| NoWork ->
inbox.Post(Continue)
return! loop ()
| Stop ->
Console.WriteLine("Map worker stopped")
return ()
}
loop () )
let getNewReduceWorker(reduce,reduceSupervisor:Agent<SupervisorMsg<'work>>)=//'
new Agent<WorkerMsg>(fun inbox ->
let rec loop () = async {
let! msg = inbox.Receive()
match msg with
| Start -> inbox.Post(Continue)
return! loop()
| Continue ->
let! supervisorOrder =
reduceSupervisor.PostAndAsyncReply(fun replyChannel ->
WorkRel(WorkReq(replyChannel)))
match supervisorOrder with
| Work(work) ->
let! res = reduce work
match res with
| Success(toReduce) -> inbox.Post(Continue)
| Fail ->
Console.WriteLine("ReduceFail")
reduceSupervisor.Post(WorkRel(ToDo(work)))
inbox.Post(Continue)
| NoWork -> inbox.Post(Continue)
return! loop()
|Stop ->Console.WriteLine("Reduce worker stopped"); return ()
}
loop() )
open AgentWorker
type MapReduce<'work,'reduce>( numberMap:int ,
numberReduce: int,
toProcess:'work list,
map:'work->Async<'reduce WorkOutcome>,
reduce:'reduce-> Async<unit WorkOutcome>) =
let mapSupervisor= AgentSupervisor.getNew("MapSupervisor")
let reduceSupervisor = AgentSupervisor.getNew("ReduceSupervisor")
let workerSupervisors = {Map = mapSupervisor ; Reduce = reduceSupervisor }
let mapWorkers =
[for i in 1..numberMap ->
AgentWorker.getNewMapWorker(map,workerSupervisors) ]
let reduceWorkers =
[for i in 1..numberReduce ->
AgentWorker.getNewReduceWorker(reduce,workerSupervisors.Reduce) ]
member this.Start() =
//Post work to do
toProcess
|>List.iter(fun elem -> mapSupervisor.Post( WorkRel(ToDo(elem))))
//Start supervisors
mapSupervisor.Start()
reduceSupervisor.Start()
//start workers
List.iter( fun mapper -> mapper |>start) mapWorkers
List.iter( fun reducer ->reducer|>start) reduceWorkers
member this.Status() = (mapSupervisor|>AgentSupervisor.status)
(reduceSupervisor|>AgentSupervisor.status)
member this.Stop() =
List.map2(fun mapper reducer ->
mapper |>stop; reducer|>stop) mapWorkers reduceWorkers
//Run some tests
let map = function (n:int64) -> async{ return Success(n) }
let reduce = function (toto: int64) -> async{ return Success() }
let mp = MapReduce<int64,int64>( 1,1,[for i in 1L..1000000L->i],map,reduce)
mp.Start()
mp.Status()
mp.Stop()
I like to use MailboxProcessor for the reduce part of the algorithm, and async block that's invoked with Async.Parallel for the map part. It makes things more explicit, giving you finer control over exception handling, timeouts, and cancellation.
The following code was designed with Brian's help, and with the help of his excellent F# block highlighting "F# Depth Colorizer" plug-in for VS2010.
This code is meant to pull RSS feeds from yahoo weather server in a map-reduce pattern. It demonstrates how we can control execution flow from the outside of actual algorithm.
fetchWeather is the map part, and mailboxLoop is the reduce part of the algorithm.
#r "System.Xml.Linq.dll"
#r "FSharp.PowerPack.dll"
open System
open System.Diagnostics
open System.IO
open System.Linq
open System.Net
open System.Xml.Linq
open Microsoft.FSharp.Control.WebExtensions
type Weather (city, region, temperature) = class
member x.City = city
member x.Region = region
member x.Temperature : int = temperature
override this.ToString() =
sprintf "%s, %s: %d F" this.City this.Region this.Temperature
end
type MessageForActor =
| ProcessWeather of Weather
| ProcessError of int
| GetResults of (Weather * Weather * Weather list) AsyncReplyChannel
let parseRss woeid (rssStream : Stream) =
let xn str = XName.Get str
let yweather elementName = XName.Get(elementName, "http://xml.weather.yahoo.com/ns/rss/1.0")
let channel = (XDocument.Load rssStream).Descendants(xn "channel").First()
let location = channel.Element(yweather "location")
let condition = channel.Element(xn "item").Element(yweather "condition")
// If the RSS server returns error, condition XML element won't be available.
if not(condition = null) then
let temperature = Int32.Parse(condition.Attribute(xn "temp").Value)
ProcessWeather(new Weather(
location.Attribute(xn "city").Value,
location.Attribute(xn "region").Value,
temperature))
else
ProcessError(woeid)
let fetchWeather (actor : MessageForActor MailboxProcessor) woeid =
async {
let rssAddress = sprintf "http://weather.yahooapis.com/forecastrss?w=%d&u=f" woeid
let webRequest = WebRequest.Create rssAddress
use! response = webRequest.AsyncGetResponse()
use responseStream = response.GetResponseStream()
let weather = parseRss woeid responseStream
//do! Async.Sleep 1000 // enable this line to see amplified timing that proves concurrent flow
actor.Post(weather)
}
let mailboxLoop initialCount =
let chooseCityByTemperature op (x : Weather) (y : Weather) =
if op x.Temperature y.Temperature then x else y
let sortWeatherByCityAndState (weatherList : Weather list) =
weatherList
|> List.sortWith (fun x y -> x.City.CompareTo(y.City))
|> List.sortWith (fun x y -> x.Region.CompareTo(y.Region))
MailboxProcessor.Start(fun inbox ->
let rec loop minAcc maxAcc weatherList remaining =
async {
let! message = inbox.Receive()
let remaining = remaining - 1
match message with
| ProcessWeather weather ->
let colderCity = chooseCityByTemperature (<) minAcc weather
let warmerCity = chooseCityByTemperature (>) maxAcc weather
return! loop colderCity warmerCity (weather :: weatherList) remaining
| ProcessError woeid ->
let errorWeather = new Weather(sprintf "Error with woeid=%d" woeid, "ZZ", 99999)
return! loop minAcc maxAcc (errorWeather :: weatherList) remaining
| GetResults replyChannel ->
replyChannel.Reply(minAcc, maxAcc, sortWeatherByCityAndState weatherList)
}
let minValueInitial = new Weather("", "", Int32.MaxValue)
let maxValueInitial = new Weather("", "", Int32.MinValue)
loop minValueInitial maxValueInitial [] initialCount
)
let RunSynchronouslyWithExceptionAndTimeoutHandlers computation =
let timeout = 30000
try
Async.RunSynchronously(Async.Catch(computation), timeout)
|> function Choice1Of2 answer -> answer |> ignore
| Choice2Of2 (except : Exception) -> printfn "%s" except.Message; printfn "%s" except.StackTrace; exit -4
with
| :? System.TimeoutException -> printfn "Timed out waiting for results for %d seconds!" <| timeout / 1000; exit -5
let main =
// Should have script name, sync/async select, and at least one woeid
if fsi.CommandLineArgs.Length < 3 then
printfn "Expecting at least two arguments!"
printfn "There were %d arguments" (fsi.CommandLineArgs.Length - 1)
exit -1
let woeids =
try
fsi.CommandLineArgs
|> Seq.skip 2 // skip the script name and sync/async select
|> Seq.map Int32.Parse
|> Seq.toList
with
| except -> printfn "One of supplied arguments was not an integer: %s" except.Message; exit -2
let actor = mailboxLoop woeids.Length
let processWeatherItemsConcurrently woeids =
woeids
|> Seq.map (fetchWeather actor)
|> Async.Parallel
|> RunSynchronouslyWithExceptionAndTimeoutHandlers
let processOneWeatherItem woeid =
woeid
|> fetchWeather actor
|> RunSynchronouslyWithExceptionAndTimeoutHandlers
let stopWatch = new Stopwatch()
stopWatch.Start()
match fsi.CommandLineArgs.[1].ToUpper() with
| "C" -> printfn "Concurrent execution: "; processWeatherItemsConcurrently woeids
| "S" -> printfn "Synchronous execution: "; woeids |> Seq.iter processOneWeatherItem
| _ -> printfn "Unexpected run options!"; exit -3
let (min, max, weatherList) = actor.PostAndReply GetResults
stopWatch.Stop()
assert (weatherList.Length = woeids.Length)
printfn "{"
weatherList |> List.iter (printfn " %O")
printfn "}"
printfn "Coldest place: %O" min
printfn "Hottest place: %O" max
printfn "Completed in %d millisec" stopWatch.ElapsedMilliseconds
main