Saturn Router - same function for getf and get? - f#

should be simple question but I can't find the API docs that detail how to do this.
I have a controller function like this
let loadScreen (ctx: HttpContext) (number: int) : HttpHandler = htmlString "etc"
And a router that defines two routes that use that function. One passes a default value of 0 to the number parameter. The other allows a user to specify a number
let PageRouter = router {
(* Works fine: *)
get "/order" (warbler (fun (_, ctx) -> PageController.loadScreen ctx 0))
(* Does not compile: *)
getf "/order/%i" (fun number func ctx -> PageController.loadScreen ctx number)
}
That gives the error
This expression was expected to have type 'HttpFuncResult' but here has type 'HttpFunc -> 'a -> HttpFuncResult'
I know it's a simple missing thing but can't figure out what.
Cheers

The get combinator expects a second parameter of type HttpHandler. This is it in your code:
get "/order" (warbler (fun (_, ctx) -> PageController.loadScreen ctx 0))
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
/
This is an HttpHandler value
getf, on the other hand, expects a different second parameter. It expects a function that takes an int as a parameter and returns a HttpHandler as a result.
So just stick fun number -> in front of your existing HttpHandler, and voila:
getf "/order/%i" (fun number ->
(warbler (fun (_, ctx) -> PageController.loadScreen ctx number))
)

Related

type mismatch error for async chained operations

Previously had a very compact and comprehensive answer for my question.
I had it working for my custom type but now due to some reason I had to change it to string type which is now causing type mismatch errors.
module AsyncResult =
let bind (binder : 'a -> Async<Result<'b, 'c>>) (asyncFun : Async<Result<'a, 'c>>) : Async<Result<'b, 'c>> =
async {
let! result = asyncFun
match result with
| Error e -> return Error e
| Ok x -> return! binder x
}
let compose (f : 'a -> Async<Result<'b, 'e>>) (g : 'b -> Async<Result<'c, 'e>>) = fun x -> bind g (f x)
let (>>=) a f = bind f a
let (>=>) f g = compose f g
Railway Oriented functions
let create (json: string) : Async<Result<string, Error>> =
let url = "http://api.example.com"
let request = WebRequest.CreateHttp(Uri url)
request.Method <- "GET"
async {
try
// http call
return Ok "result"
with :? WebException as e ->
return Error {Code = 500; Message = "Internal Server Error"}
}
test
type mismatch error for the AsyncResult.bind line
let chain = create
>> AsyncResult.bind (fun (result: string) -> (async {return Ok "more results"}))
match chain "initial data" |> Async.RunSynchronously with
| Ok data -> Assert.IsTrue(true)
| Error error -> Assert.IsTrue(false)
Error details:
EntityTests.fs(101, 25): [FS0001] Type mismatch. Expecting a '(string -> string -> Async<Result<string,Error>>) -> 'a' but given a 'Async<Result<'b,'c>> -> Async<Result<'d,'c>>' The type 'string -> string -> Async<Result<string,Error>>' does not match the type 'Async<Result<'a,'b>>'.
EntityTests.fs(101, 25): [FS0001] Type mismatch. Expecting a '(string -> string -> Async<Result<string,Error>>) -> 'a' but given a 'Async<Result<string,'b>> -> Async<Result<string,'b>>' The type 'string -> string -> Async<Result<string,Error>>' does not match the type 'Async<Result<string,'a>>'.
Edit
Curried or partial application
In context of above example, is it the problem with curried functions? for instance if create function has this signature.
let create (token: string) (json: string) : Async<Result<string, Error>> =
and then later build chain with curried function
let chain = create "token" >> AsyncResult.bind (fun (result: string) -> (async {return Ok "more results"}))
Edit 2
Is there a problem with following case?
signature
let create (token: Token) (entityName: string) (entityType: string) (publicationId: string) : Async<Result<string, Error>> =
test
let chain = create token >> AsyncResult.bind ( fun (result: string) -> async {return Ok "more results"} )
match chain "test" "article" "pubid" |> Async.RunSynchronously with
Update: At the front of the answer, even, since your edit 2 changes everything.
In your edit 2, you have finally revealed your actual code, and your problem is very simple: you're misunderstanding how the types work in a curried F# function.
When your create function looked like let create (json: string) = ..., it was a function of one parameter. It took a string, and returned a result type (in this case, Async<Result<string, Error>>). So the function signature was string -> Async<Result<string, Error>>.
But the create function you've just shown us is a different type entirely. It takes four parameters (one Token and three strings), not one. That means its signature is:
Token -> string -> string -> string -> Async<Result<string, Error>>
Remember how currying works: any function of multiple parameters can be thought of as a series of functions of one parameter, which return the "next" function in that chain. E.g., let add3 a b c = a + b + c is of type int -> int -> int -> int; this means that add3 1 returns a function that's equivalent to let add2 b c = 1 + b + c. And so on.
Now, keeping currying in mind, look at your function type. When you pass a single Token value to it as you do in your example (where it's called as create token, you get a function of type:
string -> string -> string -> Async<Result<string, Error>>
This is a function that takes a string, which returns another function that takes a string, which returns a third function which takes a string and returns an Async<Result<whatever>>. Now compare that to the type of the binder parameter in your bind function:
(binder : 'a -> Async<Result<'b, 'c>>)
Here, 'a is string, so is 'b, and 'c is Error. So when the generic bind function is applied to your specific case, it's looking for a function of type string -> Async<Result<'b, 'c>>. But you're giving it a function of type string -> string -> string -> Async<Result<string, Error>>. Those two function types are not the same!
That's the fundamental cause of your type error. You're trying to apply a function that returns a function that returns function that returns a result of type X to a design pattern (the bind design pattern) that expects a function that returns a result of type X. What you need is the design pattern called apply. I have to leave quite soon so I don't have time to write you an explanation of how to use apply, but fortunately Scott Wlaschin has already written a good one. It covers a lot, not just "apply", but you'll find the details about apply in there as well. And that's the cause of your problem: you used bind when you needed to use apply.
Original answer follows:
I don't yet know for a fact what's causing your problem, but I have a suspicion. But first, I want to comment that the parameter names for your AsyncResult.bind are wrong. Here's what you wrote:
let bind (binder : 'a -> Async<Result<'b, 'c>>)
(asyncFun : Async<Result<'a, 'c>>) : Async<Result<'b, 'c>> =
(I moved the second parameter in line with the first parameter so it wouldn't scroll on Stack Overflow's smallish column size, but that would compile correctly if the types were right: since the two parameters are lined up vertically, F# would know that they are both belonging to the same "parent", in this case a function.)
Look at your second parameter. You've named it asyncFun, but there's no arrow in its type description. That's not a function, it's a value. A function would look like something -> somethingElse. You should name it something like asyncValue, not asyncFun. By naming it asyncFun, you're setting yourself up for confusion later.
Now for the answer to the question you asked. I think your problem is this line, where you've fallen afoul of the F# "offside rule":
let chain = create
>> AsyncResult.bind (fun (result: string) -> (async {return Ok "more results"}))
Note the position of the >> operator, which is to the left of its first operand. Yes, the F# syntax appears to allow that in most situations, but I suspect that if you simply change that function definition to the following, your code will work:
let chain =
create
>> AsyncResult.bind (fun (result: string) -> (async {return Ok "more results"}))
Or, better yet because it's good style to make the |> (and >>) operators line up with their first operand:
let chain =
create
>> AsyncResult.bind (fun (result: string) -> (async {return Ok "more results"}))
If you look carefully at the rules that Scott Wlaschin lays out in https://fsharpforfunandprofit.com/posts/fsharp-syntax/, you'll note that his examples where he shows exceptions to the "offside rule", he writes them like this:
let f g h = g // defines a new line at col 15
>> h // ">>" allowed to be outside the line
Note how the >> character is still to the right of the = in the function definition. I don't know exactly what the F# spec says about the combination of function definitions and the offside rule (Scott Wlaschin is great, but he's not the spec so he could be wrong, and I don't have time to look up the spec right now), but I've seen it do funny things that I didn't quite expect when I wrote functions with part of the function definition on the same line as the function, and the rest on the next line.
E.g., I once wrote something like this, which didn't work:
let f a = if a = 0 then
printfn "Zero"
else
printfn "Non-zero"
But then I changed it to this, which did work:
let f a =
if a = 0 then
printfn "Zero"
else
printfn "Non-zero"
I notice that in Snapshot's answer, he made your chain function be defined on a single line, and that worked for him. So I suspect that that's your problem.
Rule of thumb: If your function has anything after the = on the same line, make the function all on one line. If your function is going to be two lines, put nothing after the =. E.g.:
let f a b = a + b // This is fine
let g c d =
c * d // This is also fine
let h x y = x
+ y // This is asking for trouble
I would suspect that the error stems from a minor change in indentation since adding a single space to an FSharp program changes its meaning, the FSharp compiler than quickly reports phantom errors because it interprets the input differently. I just pasted it in and added bogus classes and removed some spaces and now it is working just fine.
module AsyncResult =
[<StructuralEquality; StructuralComparison>]
type Result<'T,'TError> =
| Ok of ResultValue:'T
| Error of ErrorValue:'TError
let bind (binder : 'a -> Async<Result<'b, 'c>>) (asyncFun : Async<Result<'a, 'c>>) : Async<Result<'b, 'c>> =
async {
let! result = asyncFun
match result with
| Error e -> return Error e
| Ok x -> return! binder x
}
let compose (f : 'a -> Async<Result<'b, 'e>>) (g : 'b -> Async<Result<'c, 'e>>) = fun x -> bind g (f x)
let (>>=) a f = bind f a
let (>=>) f g = compose f g
open AsyncResult
open System.Net
type Assert =
static member IsTrue (conditional:bool) = System.Diagnostics.Debug.Assert(conditional)
type Error = {Code:int; Message:string}
[<EntryPoint>]
let main args =
let create (json: string) : Async<Result<string, Error>> =
let url = "http://api.example.com"
let request = WebRequest.CreateHttp(Uri url)
request.Method <- "GET"
async {
try
// http call
return Ok "result"
with :? WebException as e ->
return Error {Code = 500; Message = "Internal Server Error"}
}
let chain = create >> AsyncResult.bind (fun (result: string) -> (async {return Ok "more results"}))
match chain "initial data" |> Async.RunSynchronously with
| Ok data -> Assert.IsTrue(true)
| Error error -> Assert.IsTrue(false)
0

Deconstructing Discriminated Unions

I have a discriminated-union type of the form
type ParameterName = string
type ParameterValues =
| String of string[]
| Float of float[]
| Int of int[]
type Parameter = Parameter of ParameterName * ParameterValues
I want to pass the ParameterValues part to a function taking generic arguments returning unit, such as
let func1 (name:string) (data:'a) = printfn "%s" name
To deconstruct Parameter I could wrap func1 like this
let func2 (Parameter (name, values)) =
match values with
| String s -> func1 name s
| Float s -> func1 name s
| Int s -> func1 name s
however this is inconvenient if I have to do this for multiple functions. Instead, I would like to define a more flexible wrapper like this:
let func3 (fn: ('a -> 'b -> unit)) (Parameter (name, values)) =
match values with
| String s -> fn name s
| Float s -> fn name s
| Int s -> fn name s
This however fails, as the type of b gets restricted to string[] in the first option of the match expression; consequently the match expression fails with the error Type string does not match type float.
Is this expected? How can I work around this problem?
This is an expected behaviour. The problem is that you cannot directly pass a generic function as an argument to another function in F#. When you define a function as follows:
let func3 (fn: ('a -> 'b -> unit)) (Parameter (name, values)) = (...)
... you are defining a generic function func3 that has two generic parameters and, when those are specified, can be called with a given function and a parameter. This can be written as:
\forall 'a, 'b . (('a -> 'b -> unit) -> Parameter -> unit)
What you would need to do is to make those type parameters not top-level, but make the first parameter itself a generic function. You could write this as:
(\forall 'a, 'b . ('a -> 'b -> unit)) -> Parameter -> unit
This can be clumsily written in F# using interfaces:
type IFunction<'a> =
abstract Invoke<'b> : 'a -> 'b -> unit
let func1 =
{ new IFunction<string> with
member x.Invoke<'b> name (data:'b) = printfn "%s" name }
let func3 (fn: IFunction<string>) (Parameter (name, values)) =
match values with
| String s -> fn.Invoke name s
| Float s -> fn.Invoke name s
| Int s -> fn.Invoke name s
In practice, your function does not really need to be generic, because you are never using the second argument - but you could probably achieve pretty much anything that you can achieve with this interfaces trick just by passing the data as obj and your code would be significantly simpler than this monstrosity!
Following the suggestions by Lee and Tomas, I came up with the following solution:
type Parameter = Parameter of string * obj
let func0 (name:string) (data:obj) = printfn "%s %A" name data
let func1 (fn: string->obj->unit) (Parameter (name, value)) =
fn name value
let p1 = Parameter ("p1", [|"a"; "b"|])
let p2 = Parameter ("p1", [|1.; 2.|])
func1 func0 p1
func1 func0 p2

How to use AutoMapper to map an object with multiple generic lists to another object with corresponding non-generic lists?

I have created a ListTypeConverter:
type ListTypeConverter<'source, 'destination>() =
interface ITypeConverter<'source list, Proxies.List> with
member this.Convert(source, destination, context) =
let proxyList = new Proxies.List()
source
|> List.map(fun item -> _mapper.Map<'source, 'destination>(item))
|> List.iter(fun item -> proxyList.addEnd(item) |> ignore)
proxyList
And usage: ForMemberFs by Ian Griffiths
this.CreateMap<SourceItemType list, Proxies.List>().ConvertUsing<ListTypeConverter<SourceItemType, DestItemType>>()
this.CreateMap<SourceType, DestType>().
ForMemberFs((fun d -> d.MyNonGenericList), (fun opts -> opts.MapFrom(fun s -> s.MyGenericList))).
This works fine if I only have one property on my primary map that maps from a 'a list -> Proxy.List. But the moment I introduce a second mapping from a 'b -> Proxy.List then I get an InvalidCastException.
Introducing a second mapping causes the exception:
this.CreateMap<SourceItemType list, Proxies.List>().ConvertUsing<ListTypeConverter<SourceItemType, DestItemType>>()
this.CreateMap<SourceItemType2 list, Proxies.List>().ConvertUsing<ListTypeConverter<SourceItemType2, DestItemType2>>()
this.CreateMap<SourceType, DestType>().
ForMemberFs((fun d -> d.MyNonGenericList), (fun opts -> opts.MapFrom(fun s -> s.MyGenericList))).
ForMemberFs((fun d -> d.MyNonGenericList2), (fun opts -> opts.MapFrom(fun s -> s.MyGenericList2))).
Exception:
Unable to cast object of type 'obj' to type 'DestItemType'
So, my problem is a bit deeper than just F# and AutoMapper. The Proxies.List type is actually gotten via a TypeProvider for Microsoft Dynamics AX that we've written in-house. I wanted to exclude that variable from the equation, so I wrote a simple script using System.Collections.Generic.List<'t> -> System.Collections.ArrayList (which is non-generic) and I was able to successfully cast from items in my ArrayList back to their correct "destination" type.
While I'm here, we came up with some pretty cool F# helpers for AutoMapper:
type OptionExpressions =
static member MapFrom<'source, 'destination, 'sourceMember, 'destinationMember> (e: 'source -> 'sourceMember) =
System.Action<IMemberConfigurationExpression<'source, 'destination, 'destinationMember>> (fun (opts: IMemberConfigurationExpression<'source, 'destination, 'destinationMember>) -> opts.MapFrom(e))
static member UseValue<'source, 'destination, 'value> (e: 'value) =
System.Action<IMemberConfigurationExpression<'source, 'destination, 'value>> (fun (opts: IMemberConfigurationExpression<'source, 'destination, 'value>) -> opts.UseValue(e))
static member Ignore<'source, 'destination, 'destinationMember> () =
System.Action<IMemberConfigurationExpression<'source, 'destination, 'destinationMember>> (fun (opts: IMemberConfigurationExpression<'source, 'destination, 'destinationMember>) -> opts.Ignore())
Usage:
// Shortened local helpers
let mapFrom = OptionExpressions.MapFrom
let ignoreMap = OptionExpressions.Ignore
let useValue = OptionExpressions.UseValue
this.CreateMap<Source, Destination>()
.ForMemberFs((fun d -> d.DestMember1), mapFrom (fun s -> s.SourceMember1))
.ForMemberFs((fun d -> d.DestMember2), useValue (MyValue))
.ForMemberFs((fun d -> d.DestMember3), ignoreMap ())

F# Type mismatch on curried functions

I'm having a bit of trouble with the following FSharp/F# code:
module File1
let api a =
printf ("VALUE = %A") a
let router ops =
[|
api (ops (fun (list, _) -> list()))
api (ops (fun (_, get) -> get 1))
|]
let withContext ops handler =
let context = "CONTEXT"
handler (ops context)
let operations context =
printf ("CONTEXT = %s") context
let list () = [|1;2;3|]
let get id = "Test"
(list, get)
let setup() =
let ops = withContext operations
router ops
Results in the following error
Results in the following compation error
Error 1 Type mismatch. Expecting a
((unit -> int []) * (int -> int []) -> int []) -> 'a
but given a
((unit -> int []) * (int -> string) -> 'b) -> 'b
The type 'int []' does not match the type 'string'
I know the problem is that ops function has been bound to return a int[] but I want to be able to also return a string.
I think I'm missing a trick with some generic declarations but after hours of moving code around I can’t seem to work it out.
(I've simplified the code to highlight my problem)
The error is because ops needs to have a return type of its handler resolved at compilation, and you want to return different types base on some run-time logic.
It is basically an equivalent of:
let fun1 switch arg2 arg3 =
if switch then
arg2
else
arg3
and you want to run it this way:
fun1 true 1 "string"
Of course, arg2 and arg3 need to have the same type, so it won't work
What you can do is to run "api" function on a handler result, before returning it (so it will always the same type - unit).
let router ops =
[|
ops (fun (list, _) -> api <| list()))
ops (fun (_, get) -> api <| get 1))
|]
Alternatively, you could return objects of discriminated union type (then you will need some more logic in api function).
(Technically, you could also return obj).
Bonus
You don't need the array of units to be returned in a router function, returning one unit is just fine:
let router ops =
ops (fun (list, _) -> api <| list()))
ops (fun (_, get) -> api <| get 1))
In this way, setup function will also return unit and you will be able to run it without a need to run ignore on the result to get rid of This expression should have type 'unit', but has type 'unit[]' warning.
Your code is hard for me to understand, but I think the basic issue is that you want withContext to have a "rank 2" type (so that the universal quantification of the type variable 'b can happen after the application of the first argument). In F#, this can be accomplished by creating a new type with a generic method and using that:
let api a =
printf ("VALUE = %A") a
type Handler<'a> = abstract Handle<'b> : f:('a->'b) -> 'b
let router (ops:Handler<_>) =
[|
api (ops.Handle (fun (list, _) -> list()))
api (ops.Handle (fun (_, get) -> get 1))
|]
let withContext ops =
let context = "CONTEXT"
{ new Handler<_> with member __.Handle f = f (ops context) }
let operations context =
printf ("CONTEXT = %s") context
let list () = [|1;2;3|]
let get id = "Test"
(list, get)
let setup() =
let ops = withContext operations
router ops

Memoize a function of type () -> 'a

This memoize function fails on any functions of type () -> 'a at runtime with a Null-Argument-Exception.
let memoize f =
let cache = System.Collections.Generic.Dictionary()
fun x ->
if cache.ContainsKey(x) then
cache.[x]
else
let res = f x
cache.[x] <- res
res
Is there a way to write a memoize function that also works for a () -> 'a ?
(My only alternative for now is using a Lazy type. calling x.Force() to get the value.)
The reason why the function fails is that F# represents unit () using null of type unit. The dictionary does not allow taking null values as keys and so it fails.
In your specific case, there is not much point in memoizing function of type unit -> 'a (because it is better to use lazy for this), but there are other cases where this would be an issue - for example None is also represented by null so this fails too:
let f : int option -> int = memoize (fun a -> defaultArg a 42)
f None
The easy way to fix this is to wrap the key in another data type to make sure it is never null:
type Key<'K> = K of 'K
Then you can just wrap the key with the K constructor and everything will work nicely:
let memoize f =
let cache = System.Collections.Generic.Dictionary()
fun x ->
if cache.ContainsKey(K x) then
cache.[K x]
else
let res = f x
cache.[K x] <- res
res
I just found that the last memoize function on the same website using Map instead of Dictionary works for 'a Option -> 'b and () -> 'a too:
let memoize1 f =
let cache = ref Map.empty
fun x ->
match cache.Value.TryFind(x) with
| Some res -> res
| None ->
let res = f x
cache.Value <- cache.Value.Add(x, res)
res
Memoization having a pure function (not just of type unit -> 'a, but any other too) as a lookup key is impossible because functions in general do not have equality comparer for the reason.
It may seem that for this specific type of function unit -> 'a it would be possible coming up with a custom equality comparer. But the only approach for implementing such comparer beyond extremes (reflection, IL, etc.) would be invoking the lookup function as f1 = f2 iff f1() = f2(), which apparently nullifies any performance improvement expected from memoization.
So, perhaps, as it was already noted, for this case optimizations should be built around lazy pattern, but not memoization one.
UPDATE: Indeed, after second look at the question all talking above about functions missing equality comparer is correct, but not applicable, because memoization happens within each function's individual cache from the closure. On the other side, for this specific kind of functions with signature unit->'a, i.e. at most single value of argument, using Dictionary with most one entry is an overkill. The following similarly stateful, but simpler implementation with just one memoized value will do:
let memoize2 f =
let notFilled = ref true
let cache = ref Unchecked.defaultof<'a>
fun () ->
if !notFilled then
cache := f ()
notFilled := false
!cache
used as let foo = memoize2(fun () -> ...heavy on time and/or space calculation...)
with first use foo() performing and storing the result of calculation and all successive foo() just reusing the stored value.
Solution with mutable dictionary and single dictionary lookup call:
let memoize1 f =
// printfn "Dictionary"
let cache = System.Collections.Generic.Dictionary()
fun x ->
let result, value = cache.TryGetValue(x)
match result with
| true -> value
| false ->
// printfn "f x"
let res = f x
cache.Add(x, res)
res

Resources