downloadCSVFile ::String-> IO (Bool,String)
downloadCSVFile company_code = do
let a="http://ichart.finance.yahoo.com/table.csv?s=" ++ company_code
let b=simpleHTTP $ getRequest a
src <- ( b >>= getResponseBody)
rcode <- fmap rspCode <$> b
h <- fmap findHeader HdrLocation b
case rcode of
Left err -> return (False, "Connection error: " ++ show err)
Right (2,_,_) -> return (True,src)
Right (4,_,_) -> return (False,"Invalid URL/The requested page does not exist..")
Right (5,_,_) -> return (False, "Internal error in the server on trying to process the request")
Right (3,_,_) ->
case h of
Nothing -> return (False, "Error : " )
Just url -> downloadCSVFile a
Please help me to resolve the following error and help me to check whether I've included all the condition in the "case" statement or not:
You've got several problems in your code. The first is your return type. You're trying to encode the notion of failure or success using a tuple and a string. Instead, you could use the Either type to handle this much more elegantly
downloadCSVFile :: String -> IO (Either String String)
downloadCSVFile company_code = do
let url = "http://ichart.finance.yahoo.com/table.csv?s=" ++ company_code
Next, you use let b = simpleHTTP $ getRequest a. You're assigning an IO action inside an IO function, when instead you should be extracting the result using <-
response <- simpleHTTP $ getRequest url
This lets you write the next few lines without duplicate fmaps (<$> is the infix form of fmap, so you're fmap-ing multiple times unnecessarily)
src <- getResponseBody response
let rcode = fmap rspCode response
header = fmap findHeader HdrLocation response
And now we come across what seems to be the culprit. Your use of fmap findHeader HdrLocation response is incorrect. What you meant was fmap (findHeader HdrLocation) response, the parentheses are very important here.
Since we're now using the Either type, we have to change our case statement a bit, but it's certainly cleaner now. We use the convention Left for errors and Right for success. This is exactly how the Network.HTTP library works with the Result type.
case rcode of
Left err -> return $ Left $ "Connection error: " ++ show err
Right (2, _, _) -> return $ Right src
Right (4, _, _) -> return $ Left "Invalid URL..."
Right (5, _, _) -> return $ Left "Internal error in the server..."
Right (3, _, _) ->
case header of
Nothing -> return $ Left "Error"
Just url' -> downloadCSVFile $ fromJust $ parseURI url
To sum up, the real problem was with the line
h <- fmap findHeader HdrLocation <$> b
for its lack of parentheses that would have made it correct. We also looked into using do notation to our advantage to avoid superfluous fmaps, and also assuring the correct behavior of the program. By defining b = simpleHTTP $ getRequest a, you were assigning b to that action, but not to it's result. Depending on the compiler or platform, that could mean that every time you used b, it could be trying to download that URL again. That is obviously bad, since any one of them could fail, it eats up bandwidth, and hits the yahoo server harder than need be. Finally, we examined how we can use the Either data type for more elegant error handling. It's certainly possible that you might want to add another case to case rcode of in which you accidentally return (True, "Some error message") instead of (False, "Some error message"), in which case you could crash your program! By delimiting ourselves with Left and Right, we remove another point of failure.
Related
I am trying to properly understand how side effects work when traversing a list in F# using monadic style, following Scott's guide here
I have an AsyncSeq of items, and a side-effecting function that can return a Result<'a,'b> (it is saving the items to disk).
I get the general idea - split the head and tail, apply the func to the head. If it returns Ok then recurse through the tail, doing the same thing. If an Error is returned at any point then short circuit and return it.
I also get why Scott's ultimate solution uses foldBack rather than fold - it keeps the output list in the same order as the input as each processed item is prepended to the previous.
I can also follow the logic:
The result from the list's last item (processed first as we are using foldback) will be passed as the accumulator to the next item.
If it is an Error and the next item is Ok, the next item is discarded.
If the next item is an Error, it replaces any previous results and becomes the accumulator.
That means by the time you have recursed over the entire list from right to left and ended up at the start, you either have an Ok of all of the results in the correct order or the most recent Error (which would have been the first to occur if we had gone left to right).
The thing that confuses me is that surely, since we are starting at the end of the list, all side effects of processing every item will take place, even if we only get back the last Error that was created?
This seems to be confirmed here as the print output starts with [5], then [4,5], then [3,4,5] etc.
The thing that confuses me is that this isn't what I see happening when I use AsyncSeq.traverseChoiceAsync from the FSharpx lib (which I wrapped to process Result instead of Choice). I see side effects happening from left to right, stopping on the first error, which is what I want to happen.
It also looks like Scott's non-tail recursive version (which doesn't use foldBack and just recurses over the list) goes from left to right? The same goes for the AsyncSeq version. That would explain why I see it short circuit on the first error but surely if it completes Ok then the output items would be reversed, which is why we normally use foldback?
I feel I am misunderstanding or misreading something obvious! Could someone please explain it to me? :)
Edit:
rmunn has given a really great comprehensive explanation of the AsyncSeq traversal below. The TLDR was that
Scott's initial implementation and the AsyncSeq traverse both do go from left to right as I thought and so only process until they hit an error
they keep their contents in order by prepending the head to the processed tail rather than prepending each processed result to the previous (which is what the built in F# fold does).
foldback would keep things in order but would indeed execute every case (which could take forever with an async seq)
It's pretty simple: traverseChoiceAsync isn't using foldBack. Yes, with foldBack the last item would be processed first, so that by the time you get to the first item and discover that its result is Error you'd have triggered the side effects of every item. Which is, I think, precisely why whoever wrote traverseChoiceAsync in FSharpx chose not to use foldBack, because they wanted to ensure that side effects would be triggered in order, and stop at the first Error (or, in the case of the Choice version of the function, the first Choice2Of2 — but I'll pretend from this point on that that function was written to use the Result type.)
Let's look at the traverseChoieAsync function in the code you linked to, and read through it step-by-step. I'll also rewrite it to use Result instead of Choice, because the two types are basically identical in function but with different names in the DU, and it'll be a little easier to tell what's going on if the DU cases are called Ok and Error instead of Choice1Of2 and Choice2Of2. Here's the original code:
let rec traverseChoiceAsync (f:'a -> Async<Choice<'b, 'e>>) (s:AsyncSeq<'a>) : Async<Choice<AsyncSeq<'b>, 'e>> = async {
let! s = s
match s with
| Nil -> return Choice1Of2 (Nil |> async.Return)
| Cons(a,tl) ->
let! b = f a
match b with
| Choice1Of2 b ->
return! traverseChoiceAsync f tl |> Async.map (Choice.mapl (fun tl -> Cons(b, tl) |> async.Return))
| Choice2Of2 e ->
return Choice2Of2 e }
And here's the original code rewritten to use Result. Note that it's a simple rename, and none of the logic needs to be changed:
let rec traverseResultAsync (f:'a -> Async<Result<'b, 'e>>) (s:AsyncSeq<'a>) : Async<Result<AsyncSeq<'b>, 'e>> = async {
let! s = s
match s with
| Nil -> return Ok (Nil |> async.Return)
| Cons(a,tl) ->
let! b = f a
match b with
| Ok b ->
return! traverseChoiceAsync f tl |> Async.map (Result.map (fun tl -> Cons(b, tl) |> async.Return))
| Error e ->
return Error e }
Now let's step through it. The whole function is wrapped inside an async { } block, so let! inside this function means "unwrap" in an async context (essentially, "await").
let! s = s
This takes the s parameter (of type AsyncSeq<'a>) and unwraps it, binding the result to a local name s that henceforth will shadow the original parameter. When you await the result of an AsyncSeq, what you get is the first element only, while the rest is still wrapped in an async that needs to be further awaited. You can see this by looking at the result of the match expression, or by looking at the definition of the AsyncSeq type:
type AsyncSeq<'T> = Async<AsyncSeqInner<'T>>
and AsyncSeqInner<'T> =
| Nil
| Cons of 'T * AsyncSeq<'T>
So when you do let! x = s when s is of type AsyncSeq<'T>, the value of x will either be Nil (when the sequence has run to its end) or it will be Cons(head, tail) where head is of type 'T and tail is of type AsyncSeq<'T>.
So after this let! s = s line, our local name s now refers to an AsyncSeqInner type, which contains the head item of the sequence (or Nil if the sequence was empty), and the rest of the sequence is still wrapped in an AsyncSeq so it has yet to be evaluated (and, crucially, its side effects have not yet happened).
match s with
| Nil -> return Ok (Nil |> async.Return)
There's a lot happening in this line, so it'll take a bit of unpacking, but the gist is that if the input sequence s had Nil as its head, i.e. had reached its end, then that's not an error, and we return an empty sequence.
Now to unpack. The outer return is in an async keyword, so it takes the Result (whose value is Ok something) and turns it into an Async<Result<something>>. Remembering that the return type of the function is declared as Async<Result<AsyncSeq>>, the inner something is clearly an AsyncSeq type. So what's going on with that Nil |> async.Return? Well, async isn't an F# keyword, it's the name of an instance of AsyncBuilder. Inside a computation expression foo { ... }, return x is translated into foo.Return(x). So calling async.Return x is just the same as writing async { return x }, except that it avoids nesting a computation expression inside another computation expression, which would be a little nasty to try and parse mentally (and I'm not 100% sure the F# compiler allows it syntactically). So Nil |> async.Return is async.Return Nil which means it produces a value of Async<x> where x is the type of the value Nil. And as we just saw, this Nil is a value of type AsyncSeqInner, so Nil |> async.Return produces an Async<AsyncSeqInner>. And another name for Async<AsyncSeqInner> is AsyncSeq. So this whole expression produces an Async<Result<AsyncSeq>> that has the meaning of "We're done here, there are no more items in the sequence, and there was no error".
Phew. Now for the next line:
| Cons(a,tl) ->
Simple: if the next item in the AsyncSeq named s was a Cons, we deconstruct it so that the actual item is now called a, and the tail (another AsyncSeq) is called tl.
let! b = f a
This calls f on the value we just got out of s, and then unwraps the Async part of f's return value, so that b is now a Result<'b, 'e>.
match b with
| Ok b ->
More shadowed names. Inside this branch of the match, b now names a value of type 'b rather than a Result<'b, 'e>.
return! traverseResultAsync f tl |> Async.map (Result.map (fun tl -> Cons(b, tl) |> async.Return))
Hoo boy. That's too much to tackle at once. Let's write this as if the |> operators were lined up on separate lines, and then we'll go through each step one at a time. (Note that I've wrapped an extra pair of parentheses around this, just to clarify that it's the final result of this whole expression that will be passed to the return! keyword).
return! (
traverseResultAsync f tl
|> Async.map (
Result.map (
fun tl -> Cons(b, tl) |> async.Return)))
I'm going to tackle this expression from the inside out. The inner line is:
fun tl -> Cons(b, tl) |> async.Return
The async.Return thing we've already seen. This is a function that takes a tail (we don't currently know, or care, what's inside that tail, except that by the necessity of the type signature of Cons it must be an AsyncSeq) and turns it into an AsyncSeq that is b followed by the tail. I.e., this is like b :: tl in a list: it sticks b onto the front of the AsyncSeq.
One step out from that innermost expression is:
Result.map
Remember that the function map can be thought of in two ways: one is "take a function and run it against whatever is "inside" this wrapper". The other is "take a function that operates on 'T and make it into a function that operates on Wrapper<'T>". (If you don't have both of those clear in your mind yet, https://sidburn.github.io/blog/2016/03/27/understanding-map is a pretty good article to help grok that concept). So what this is doing is taking a function of type AsyncSeq -> AsyncSeq and turning it into a function of type Result<AsyncSeq> -> Result<AsyncSeq>. Alternately, you could think of it as taking a Result<tail> and calling fun tail -> ... against that tail result, then re-wrapping the result of that function in a new Result. Important: Because this is using Result.map (Choice.mapl in the original) we know that if tail is an Error value (or if the Choice was a Choice2Of2 in the original), the function will not be called. So if traverseResultAsync produces a result that starts with an Error value, it's going to produce an <Async<Result<foo>>> where the value of Result<foo> is an Error, and so the value of the tail will be discarded. Keep that in mind for later.
Okay, next step out.
Async.map
Here, we have a Result<AsyncSeq> -> Result<AsyncSeq> function produced by the inner expression, and this converts it to an Async<Result<AsyncSeq>> -> Async<Result<AsyncSeq>> function. We've just talked about this, so we don't need to go over how map works again. Just remember that the effect of this Async<Result<AsyncSeq>> -> Async<Result<AsyncSeq>> function that we've built up will be the following:
Await the outer async.
If the result is Error, return that Error.
If the result is Ok tail, produce an Ok (Cons (b, tail)).
Next line:
traverseResultAsync f tl
I probably should have started with this, because this will actually run first, and then its value will be passed into the Async<Result<AsyncSeq>> -> Async<Result<AsyncSeq>> function that we've just analysed.
So what this whole thing will do is to say "Okay, we took the first part of the AsyncSeq we were handed, and passed it to f, and f produced an Ok result with a value we're calling b. So now we need to process the rest of the sequence similarly, and then, if the rest of the sequence produces an Ok result, we'll stick b on the front of it and return an Ok sequence with contents b :: tail. BUT if the rest of the sequence produces an Error, we'll throw away the value of b and just return that Error unchanged."
return!
This just takes the result we just got (either an Error or an Ok (b :: tail), already wrapped in an Async) and returns it unchanged. But note that the call to traverseResultAsync is NOT tail-recursive, because its value had to be passed into the Async.map (...) expression first.
And now we still have one more bit of traverseResultAsync to look at. Remember when I said "Keep that in mind for later"? Well, that time has arrived.
| Error e ->
return Error e }
Here we're back in the match b with expression. If b was an Error result, then no further recursive calls are made, and the whole traverseResultAsync returns an Async<Result> where the Result value is Error. And if we were currently nested deep inside a recursion (i.e., we're in the return! traverseResultAsync ... expression), then our return value will be Error, which means the result of the "outer" call, as we've kept in mind, will also be Error, discarding any other Ok results that might have happened "before".
Conclusion
And so the effect of all of that is:
Step through the AsyncSeq, calling f on each item in turn.
The first time f returns Error, stop stepping through, throw away any previous Ok results, and return that Error as the result of the whole thing.
If f never returns Error and instead returns Ok b every time, return an Ok result that contains an AsyncSeq of all those b values, in their original order.
Why are they in their original order? Because the logic in the Ok case is:
If sequence was empty, return an empty sequence.
Split into head and tail.
Get value b from f head.
Process the tail.
Stick value b in front of the result of processing the tail.
So if we started with (conceptually) [a1; a2; a3], which actually looks like Cons (a1, Cons (a2, Cons (a3, Nil))) we'll end up with Cons (b1, Cons (b2, Cons (b3, Nil))) which translates to the conceptual sequence [b1; b2; b3].
See #rmunn's great answer above for the explanation. I just wanted to post a little helper for anyone that reads this in the future, it allows you to use the AsyncSeq traverse with Results instead of the old Choice type it was written with:
let traverseResultAsyncM (mapping : 'a -> Async<Result<'b,'c>>) source =
let mapping' =
mapping
>> Async.map (function
| Ok x -> Choice1Of2 x
| Error e -> Choice2Of2 e)
AsyncSeq.traverseChoiceAsync mapping' source
|> Async.map (function
| Choice1Of2 x -> Ok x
| Choice2Of2 e -> Error e)
Also here is a version for non-async mappings:
let traverseResultM (mapping : 'a -> Result<'b,'c>) source =
let mapping' x = async {
return
mapping x
|> function
| Ok x -> Choice1Of2 x
| Error e -> Choice2Of2 e
}
AsyncSeq.traverseChoiceAsync mapping' source
|> Async.map (function
| Choice1Of2 x -> Ok x
| Choice2Of2 e -> Error e)
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#.
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
]
Below is the code snippet I am using to decrypt some XML which is encrypted before. If it is not encrypted (plain text), then I don't need to decrypt and process it, and I want to return it as it is.
It is not returning anything at all. Please help me to make it work.
Updated code :
pop_offline_messages(Ls, LUser, LServer, odbc) ->
EUser = ejabberd_odbc:escape(LUser),
case odbc_queries:get_and_del_spool_msg_t(LServer,
EUser)
of
{atomic, {selected, [<<"username">>, <<"xml">>], Rs}} ->
Ls ++
lists:flatmap(fun ([_, XML]) ->
?INFO_MSG("decrypted message from mod_offline ~p ",[XML]),
Top = case str:str(XML, <<"message">>) of
Top >= 1 -> XML;
Top == 0 -> crypto:aes_cfb_128_decrypt(<<"abcdefghabcdefgh">>,<<"12345678abcdefgh">>,base64:decode(XML))
end,
case xml_stream:parse_element(XML) of
{error, _Reason} ->
[];
El ->
case offline_msg_to_route(LServer, El) of
error ->
[];
RouteMsg ->
[RouteMsg]
end
end
end,
Rs);
_ -> Ls
end;
If it is "not returning anything", it is either because you don't execute it or you don't store the result. I suggest you change your code to:
Result = case str:str(XML, <<"message">>) of
1 -> XML;
_ -> crypto:aes_cfb_128_decrypt(<<"abcdefghabcdefgh">>,<<"12345678abcdefgh">>,base64:decode(XML))
end,
io:format("~p~n",[result]),
...
because with this current snippet version, the result of the case is not used, so lost as soon as evaluated.
Thank you for the replies to my first post and my second post on this project. This question is basically the same question as the first, but with my code updated according to the feedback received on those two questions. How do I call my parser recursively?
I'm scratching my head and staring blankly at the code. I've no idea where to go from here. That's when I turn to stackoverflow.
I've included in code comments the compile-time errors I'm receiving. One stumbling block may be my discriminated union. I've not worked with discriminated unions much, so I may be using mine incorrectly.
The example POST I'm working with, bits of which I've included in my previous two questions, consists of one boundary that includes a second post with a new boundary. That second post includes several additional parts separated by the second boundary. Each of those several additional parts is a new post consisting of headers and XML.
My goal in this project is to build a library to be used in our C# solution, with the library taking a stream and returning the POST parsed into headers and parts recursively. I really want F# to shine here.
namespace MultipartMIMEParser
open FParsec
open System.IO
type Header = { name : string
; value : string
; addl : (string * string) list option }
type Content = Content of string
| Post of Post list
and Post = { headers : Header list
; content : Content }
type UserState = { Boundary : string }
with static member Default = { Boundary="" }
module internal P =
let ($) f x = f x
let undefined = failwith "Undefined."
let ascii = System.Text.Encoding.ASCII
let str cs = System.String.Concat (cs:char list)
let makeHeader ((n,v),nvps) = { name=n; value=v; addl=nvps}
let runP p s = match runParserOnStream p UserState.Default "" s ascii with
| Success (r,_,_) -> r
| Failure (e,_,_) -> failwith (sprintf "%A" e)
let blankField = parray 2 newline
let delimited d e =
let pEnd = preturn () .>> e
let part = spaces
>>. (manyTill
$ noneOf d
$ (attempt (preturn () .>> pstring d)
<|> pEnd)) |>> str
in part .>>. part
let delimited3 firstDelimiter secondDelimiter thirdDelimiter endMarker =
delimited firstDelimiter endMarker
.>>. opt (many (delimited secondDelimiter endMarker
>>. delimited thirdDelimiter endMarker))
let isBoundary ((n:string),_) = n.ToLower() = "boundary"
let pHeader =
let includesBoundary (h:Header) = match h.addl with
| Some xs -> xs |> List.exists isBoundary
| None -> false
let setBoundary b = { Boundary=b }
in delimited3 ":" ";" "=" blankField
|>> makeHeader
>>= fun header stream -> if includesBoundary header
then
stream.UserState <- setBoundary (header.addl.Value
|> List.find isBoundary
|> snd)
Reply ()
else Reply ()
let pHeaders = manyTill pHeader $ attempt (preturn () .>> blankField)
let rec pContent (stream:CharStream<UserState>) =
match stream.UserState.Boundary with
| "" -> // Content is text.
let nl = System.Environment.NewLine
let unlines (ss:string list) = System.String.Join (nl,ss)
let line = restOfLine false
let lines = manyTill line $ attempt (preturn () .>> blankField)
in pipe2 pHeaders lines
$ fun h c -> { headers=h
; content=Content $ unlines c }
| _ -> // Content contains boundaries.
let b = "--" + stream.UserState.Boundary
// VS complains about pContent in the following line:
// Type mismatch. Expecting a
// Parser<'a,UserState>
// but given a
// CharStream<UserState> -> Parser<Post,UserState>
// The type 'Reply<'a>' does not match the type 'Parser<Post,UserState>'
let p = pipe2 pHeaders pContent $ fun h c -> { headers=h; content=c }
in skipString b
>>. manyTill p (attempt (preturn () .>> blankField))
// VS complains about Content.Post in the following line:
// Type mismatch. Expecting a
// Post list -> Post
// but given a
// Post list -> Content
// The type 'Post' does not match the type 'Content'
|>> Content.Post
// VS complains about pContent in the following line:
// Type mismatch. Expecting a
// Parser<'a,UserState>
// but given a
// CharStream<UserState> -> Parser<Post,UserState>
// The type 'Reply<'a>' does not match the type 'Parser<Post,UserState>'
let pStream = runP (pipe2 pHeaders pContent $ fun h c -> { headers=h; content=c })
type MParser (s:Stream) =
let r = P.pStream s
let findHeader name =
match r.headers |> List.tryFind (fun h -> h.name.ToLower() = name) with
| Some h -> h.value
| None -> ""
member p.Boundary =
let header = r.headers
|> List.tryFind (fun h -> match h.addl with
| Some xs -> xs |> List.exists P.isBoundary
| None -> false)
in match header with
| Some h -> h.addl.Value |> List.find P.isBoundary |> snd
| None -> ""
member p.ContentID = findHeader "content-id"
member p.ContentLocation = findHeader "content-location"
member p.ContentSubtype = findHeader "type"
member p.ContentTransferEncoding = findHeader "content-transfer-encoding"
member p.ContentType = findHeader "content-type"
member p.Content = r.content
member p.Headers = r.headers
member p.MessageID = findHeader "message-id"
member p.MimeVersion = findHeader "mime-version"
EDIT
In response to the feedback I've received thus far (thank you!), I made the following adjustments, receiving the errors annotated:
let rec pContent (stream:CharStream<UserState>) =
match stream.UserState.Boundary with
| "" -> // Content is text.
let nl = System.Environment.NewLine
let unlines (ss:string list) = System.String.Join (nl,ss)
let line = restOfLine false
let lines = manyTill line $ attempt (preturn () .>> blankField)
in pipe2 pHeaders lines
$ fun h c -> { headers=h
; content=Content $ unlines c }
| _ -> // Content contains boundaries.
let b = "--" + stream.UserState.Boundary
// The following complaint is about `pContent stream`:
// This expression was expected to have type
// Reply<'a>
// but here has type
// Parser<Post,UserState>
let p = pipe2 pHeaders (fun stream -> pContent stream) $ fun h c -> { headers=h; content=c }
in skipString b
>>. manyTill p (attempt (preturn () .>> blankField))
// VS complains about the line above:
// Type mismatch. Expecting a
// Parser<Post,UserState>
// but given a
// Parser<'a list,UserState>
// The type 'Post' does not match the type ''a list'
// See above complaint about `pContent stream`. Same complaint here.
let pStream = runP (pipe2 pHeaders (fun stream -> pContent stream) $ fun h c -> { headers=h; content=c })
I tried throwing in Reply ()s, but they just returned parsers, meaning c above became a Parser<...> rather than Content. That seemed to have been a step backwards, or at least in the wrong direction. I admit my ignorance, though, and welcome correction!
I can help with one of the errors.
F# generally binds arguments left to right, so you need to use either parentheses around the recursive calls to pContent or a pipe-backward operator <| to show that you want to evaluate the recursive call and bind the return value.
It's also worth noting that <| is the same as your $ operator.
Content.Post is not a constructor for a Post object. You need a function to accept a Post list and return a Post. (Does something from the List module do what you need?)
My first answer was completely wrong, but I'd thought I'd leave it up.
The types Post and Content are defined as:
type Content =
| Content of string
| Post of Post list
and Post =
{ headers : Header list
; content : Content }
Post is a Record, and Content is a Discriminated Union.
F# treats the cases for Discriminated Unions as a separate namespace from types. So Content is different from Content.Content, and Post is different from Content.Post. Because they are different, having the same identifier is confusing.
What is pContent supposed to be returning? If it's supposed to be returning the Discriminated Union Content, you need to wrap the Post record you are returning in the first case in the Content.Post case i.e.
$ fun h c -> Post [ { headers=h
; content=Content $ unlines c } ]
(F# is able to infer that 'Post' refers to Content.Post case, instead of the Post record type here.)