Command handler receives wrong arguments when it's a let binding but works as lambda - reflection

I'm trying to use F# and System.CommandLine to make a little CLI tool. A command can have a handler callback that is called when the command is used. Usually one can define several flags for a command and the name of the flag is used to bind to an argument of the handler function with the same name.
Example
myApp foo --a
will call the handler for the foo command
let handler (a: bool) (b: bool) = // a should be true, b should be false
...
However this doesn't work and both a and b are false when I bind the handler that is a let binding:
let fooCommand = Command ...
fooCommand.Handler <- CommandHandler.Create handler
// will call handler false false
But, when I use a lambda directly it works fine and the function arguments have the correct values
let fooCommand = Command ...
fooCommand.Handler <- CommandHandler.Create (fun (a: bool) (b: bool) -> handler a b)
// will call handler true false
Why is that? Why does the handler work as a lambda but not as a let binding?
Here is a MRE
#r "nuget: System.CommandLine, 2.0.0-beta1.21308.1"
open System.CommandLine
open System.CommandLine.Invocation
open System.CommandLine.Parsing
let opts = [Option<bool>([|"--a"|]); Option<bool>([|"--b"|])]
let fooCmd = Command("foo", "")
List.iter fooCmd.AddOption opts
let barCmd = Command("bar", "")
List.iter barCmd.AddOption opts
let handler (a: bool) (b: bool) =
printfn "%A" {| a = a; b = b|}
fooCmd.Handler <- CommandHandler.Create handler
barCmd.Handler <- CommandHandler.Create (fun (a: bool) (b: bool) -> handler a b)
let root = RootCommand("")
root.Add fooCmd
root.Add barCmd
printfn "foo --a: "
root.Invoke("foo --a")
printfn "bar --a: "
root.Invoke("bar --a")
which prints
foo --a:
{ a = false
b = false }
bar --a:
{ a = true
b = false }

I found that the issue lies in the delegate creation from a let binding. If I create an Action<bool, bool> from the let binding, parameter names are lost. If the Action is created from a lambda directly, parameter names are preserved:
open System
open System.Reflection
let foo (a: bool) (b: bool) = ()
let x = Action<bool, bool>(foo)
x.Method.GetParameters() |> Seq.iter (printfn "%A")
let y = Action<bool, bool>(fun (a: bool) (b: bool) -> ())
y.Method.GetParameters() |> Seq.iter (printfn "%A")
prints
Boolean delegateArg0
Boolean delegateArg1
Boolean a
Boolean b
I guess let bindings just don't keep metadata like this, probably because it would've too big of a runtime impact, especially with currying.
Please correct me if there is a different reason for this.

Related

recursive stack overflow with exceptions in F#

let's look at that code:
let rec doSomething () =
let d = GetSomeDataFromSomewhere()
match d with
| Some x -> x
| None -> doSomething()
so that's some form of non stop polling..
but now the following form:
let rec doSomething () =
try
let d = GetSomeDataFromSomewhereButItCouldCrash()
match d with
| Some x -> x
| None -> doSomething()
with _ ->
doSomething()
that one will lead to a stack overflow if there are a lot of exceptions.
Can someone explain the mechanics at play that make the two versions behave differently?
The issue is that the first call in your second version is not in a tail-call position. This is not entirely obvious, because the recursive call is the "last thing the function does", but the runtime still has to keep the stack frame around, because it needs to keep the associated exception handler.
let rec doSomething () =
try
let d = GetSomeDataFromSomewhereButItCouldCrash()
match d with
| Some x -> x
| None -> doSomething() // This is not a tail call!
with _ ->
doSomething() // This is a tail call
If you handle exceptions directly when calling GetSomeDataFromSomewhere and turn them into None, then you can keep the same logic, but make it tail recursive:
let rec doSomething () =
let d = try GetSomeDataFromSomewhereButItCouldCrash() with _ -> None
match d with
| Some x -> x
| None -> doSomething()

How can I create an F# async from a C# method with a callback?

Suppose I have some C# code that takes a callback:
void DoSomething(Action<string> callback);
Now, I want to use this in F#, but wrap it in an async. How would I go about this?
// Not real code
let doSomething = async {
let mutable result = null
new Action(fun x -> result <- x) |> Tasks.DoSomething
// Wait for result to be assigned
return result
}
For example, suppose DoSomething looks like this:
module Tasks
let DoSomething callback =
callback "Hello"
()
Then the output of the following should be "Hello":
let wrappedDoSomething = async {
// Call DoSomething somehow
}
[<EntryPoint>]
let main argv =
async {
let! resultOfDoSomething = wrappedDoSomething
Console.WriteLine resultOfDoSomething
return ()
} |> Async.RunSynchronously
0
The function Async.FromContinuations is, so to say, the "lowest level" of Async. All other async combinators can be expressed in terms of it.
It is the lowest level in the sense that it directly encodes the very nature of async computations - the knowledge of what to do in the three possible cases: (1) a successful completion of the previous computation step, (2) a crash of the previous computation step, and (3) cancellation from outside. These possible cases are expressed as the three function-typed arguments of the function that you pass to Async.FromContinuations. For example:
let returnFive =
Async.FromContinuations( fun (succ, err, cancl) ->
succ 5
)
async {
let! res = returnFive
printfn "%A" res // Prints "5"
}
|> Async.RunSynchronously
Here, my function fun (succ, err, cancl) -> succ 5 has decided that it has completed successfully, and calls the succ continuation to pass its computation result to the next step.
In your case, the function DoSomething expresses only one of the three cases - i.e. "what to do on successful completion". Once you're inside the callback, it means that whatever DoSomething was doing, has completed successfully. That's when you need to call the succ continuation:
let doSometingAsync =
Async.FromContinuations( fun (succ, err, cancl) ->
Tasks.DoSomething( fun res -> succ res )
)
Of course, you can avoid a nested lambda-expression fun res -> succ res by passing succ directly into DoSomething as callback. Unfortunately, you'll have to explicitly specify which type of Action to use for wrapping it, which negates the advantage:
let doSometingAsync =
Async.FromContinuations( fun (succ, err, cancl) ->
Tasks.DoSomething( System.Action<string> succ )
)
As an aside, note that this immediately uncovered a hole in the DoSomething's API: it ignores the error case. What happens if DoSomething fails to do whatever it was meant to do? There is no way you'd know about it, and the whole async workflow will just hang. Or, even worse: the process will exit immediately (depending on how the crash happens).
If you have any control over DoSomething, I suggest you address this issue.
You can try something like:
let doSomething callback = async {
Tasks.DoSomething(callback)
}
If your goal is to define the callback in the method you could do something like:
let doSomething () = async {
let callback = new Action<string>(fun result -> printfn "%A" result )
Tasks.DoSomething(callback)
}
If your goal is to have the result of the async method be used in the DoSomething callback you could do something like:
let doSomething =
Async.StartWithContinuations(
async {
return result
},
(fun result -> Tasks.DoSomething(result)),
(fun _ -> printfn "Deal with exception."),
(fun _ -> printfn "Deal with cancellation."))

Function with type 'T -> Async<'T> like C#'s Task.FromResult

I'm playing around asynchronous programming and was wondering if there's a function that exists that can take a value of type 'T and transform it to an Async<'T>, similar to C#'s Task.FromResult that can take a value of type TResult and transform it to a Task<TResult> that can then be awaited.
If such a function does not exist in F#, is it possible to create it? I can kind of emulate this by using Async.AwaitTask and Task.FromResult, but can I do this by only using Async?
Essentially, I'd like to be able to do something like this:
let asyncValue = toAsync 3 // toAsync: 'T -> Async<'T>
let foo = async{
let! value = asyncValue
}
...or just async.Return
let toAsync = async.Return
let toAsync` x = async.Return x
moreover there is async.Bind (in tupled form)
let asyncBind
(asyncValue: Async<'a>)
(asyncFun: 'a -> Async<'b>) : Async<'b> =
async.Bind(asyncValue, asyncFun)
you could use them to make pretty complicated async computation without builder gist link
let inline (>>-) x f = async.Bind(x, f >> async.Return)
let requestMasterAsync limit urls =
let results = Array.zeroCreate (List.length urls)
let chunks =
urls
|> Seq.chunkBySize limit
|> Seq.indexed
async.For (chunks, fun (i, chunk) ->
chunk
|> Seq.map asyncMockup
|> Async.Parallel
>>- Seq.iteri (fun j r -> results.[i*limit+j]<-r))
>>- fun _ -> results
You can use return within your async expression:
let toAsync x = async { return x }

F#, FParsec, and Calling a Stream Parser Recursively, Second Take

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

Calling a F# function via a Linq expression tree MethodCallExpression node?

I am trying to create an expression tree containing a function call to a F# function on a certain module. However, I am missing something because the System.Linq.Expressions.Expression.Call() helper function cant find the function I'm supplying.
The Call() call gives an InvalidOperationException: "No method 'myFunction' on type 'TestReflection.Functions' is compatible with the supplied arguments."
If anyone can give me a hint on what I am doing wrong it would be very helpful.
See the code below:
namespace TestReflection
open System.Linq.Expressions
module Functions =
let myFunction (x: float) =
x*x
let assem = System.Reflection.Assembly.GetExecutingAssembly()
let modul = assem.GetType("TestReflection.Functions")
let mi = modul.GetMethod("myFunction")
let pi = mi.GetParameters()
let argTypes =
Array.map
(fun (x: System.Reflection.ParameterInfo) -> x.ParameterType) pi
let parArray =
[| (Expression.Parameter(typeof<float>, "a") :> Expression); |]
let ce = Expression.Call(modul, mi.Name, argTypes, parArray)
let del = (Expression.Lambda<System.Func<float, float>>(ce)).Compile()
printf "%A" (Functions.del.Invoke(3.5))
Regards,
Rickard
The third argument to Expression.Call is an array of generic type parameters - your method is not generic, so that should be null. You'll also need to pass your "a" argument to Expression.Lambda:
let a = Expression.Parameter(typeof<float>, "a")
let parArray = [| (a :> Expression); |]
let ce = Expression.Call(modul, mi.Name, null, parArray)
let del = (Expression.Lambda<System.Func<float, float>>(ce, a)).Compile()

Resources