SqlProvider recursively composing queries - f#

Using the SqlProvider type provider, I'm trying to do something whereby I recursively fold up a list of 'query criterions',
type Criterion = {
Column : string
Operator : string
Value : string
}
such that the expression tree gets only gets compiled to SQL once, and I don't hit the database multiple times. I've tried a few approaches, the most successful of which is something like this
let rec eval (acc : IQueryable<SourceEntity> option) (qrys : Criterion list) =
match qrys with
|[] -> acc
|x :: xs -> let acc' = let op,valu = translateOpnValu x
match acc with
|Some acc' -> query {
for elem in acc' do
where (elem.GetColumn x.Column op valu)
select elem
} |> Some
|None -> query {
for elem in ctx.Dbo.Source do
where (elem.GetColumn x.Column op valu)
select elem
} |> Some
eval acc' xs
Where the function translateOpnValu is
let translateOpnValu (c:Criterion) =
match c.Operator with
|"%=%" -> (=%), sprintf "%%%s%%" c.Value
|_ -> (=), c.Value
I am getting this excpetion
System.Exception: Unsupported expression. Ensure all server-side objects appear on the left hand side of predicates. The In and Not In operators only support the inline array syntax. InvokeFast(elem.GetColumn("Source Code"), value(FSI_0006+acc'#38-2), "%BEN%")
at Microsoft.FSharp.Linq.RuntimeHelpers.LeafExpressionConverter.EvaluateQuotation(FSharpExpr e)
at Microsoft.FSharp.Linq.QueryModule.EvalNonNestedInner(CanEliminate canElim, FSharpExpr queryProducingSequence)
at Microsoft.FSharp.Linq.QueryModule.EvalNonNestedOuter(CanEliminate canElim, FSharpExpr tm)
at Microsoft.FSharp.Linq.QueryModule.clo#1735-1.Microsoft-FSharp-Linq-ForwardDeclarations-IQueryMethods-Execute[a,b](FSharpExpr`1 )
at FSI_0006.evaluate(FSharpOption`1 acc, FSharpList`1 qrys) in F:\code_root\vs2015\F\CAMS\CAMS\scratch.fsx:line 47
at <StartupCode$FSI_0007>.$FSI_0007.main#() in F:\code_root\vs2015\F\CAMS\CAMS\scratch.fsx:line 60
If I replace the 'op' returned from translateOpnValu with an implicit operator (= / =%), it works fine.
I have a feeling it is to do with the fact the type of the operator returned is getting constrained to (string -> string -> bool), whereas the implicit operators are more generic. How could I get the translateOpnValu function to return more generic operators ? Or perhaps that's not the problem at all ...

#Fyodor is right -- for the SQL provider to pick up your function properly, you need to wrap it in a quotation and splice it into the query expression. Something like this should work:
let translateOpnValu (c:Criterion) =
match c.Operator with
|"%=%" -> <# (=%) #>, sprintf "%%%s%%" c.Value
|_ -> <# (=) #>, c.Value
// ...
query {
for elem in acc' do
where ((%op) (elem.GetColumn x.Column) valu)
select elem
}

Related

F# folding gracefully without the first or last element?

Say you have a list of strings: [ "a"; "b"; "c" ] and you want to transform it to a single string like so: "a,b,c" notice that the last comma is missing.
I find this case comes up again and again for me, think of all the programming languages that do not allow the trailing comma to be there, and you are building some kind of code generator.
I usually end up with something like:
let listOfThings = ["a";"b";"c"]
let folded =
listOfThings
|> List.map (fun i -> i + ",")
|> List.fold (+) ""
|> (fun s -> s.Substring(0, s.Length - 1))
I feel like there is some fold like function already because this seems such a basic use case, and I just can't figure out what would be it's name, or by what name to search for it.
A fold applies your folding function recursively over all values of the list, starting with an initial state, which you don't particularly want in this case.
It's simpler to use a reduce which uses the list's head as its starting state:
listOfThings |> List.reduce (fun sum cur -> sum + "," + cur) // "a,b,c"
A minor drawback is that since it uses the list head, calling reduce with an empty list would fail. You can mitigate that with a check for an empty list.
Without any built-ins, as you have described, we skip the addition of the trailing comma for the last element:
let rec join = function
| [] -> ""
| [x] -> x
| x::xs -> x + "," + join xs
["a"; "b"; "c"] |> join // a,b,c
However, the most efficient method would be to use String.Join which internally uses a StringBuilder, while reduce allocates a new string for every call:
String.Join(",", listOfThings) // "a,b,c"
A reduction applied to the elements of a list is necessarily of the same type as these are. In contrast, the accumulator (also called state) of a fold can be of a different type, which is more versatile. The signatures make it apparent:
val reduce: ('a -> 'a -> 'a) -> 'a list -> 'a
val fold: ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
A possible approach might consist in provision of a different folding function for the first element of the list (or for the last, in the case of foldBack). Here it is also prudent to check for an empty list, as it is with reduce.
let fold1 folderN folder0 state = function
| [] -> state
| x::xs -> List.fold folderN (folder0 state x) xs
// val fold1 :
// folderN:('a -> 'b -> 'a) ->
// folder0:('a -> 'b -> 'a) -> state:'a -> _arg1:'b list -> 'a
Now we can fold into a list, or even use a StringBuilder:
([], ["a";"b";"c"])
||> fold1
(fun s t -> t::", "::s)
(fun s t -> t::s)
|> List.rev
// val it : string list = ["a"; ", "; "b"; ", "; "c"]
(System.Text.StringBuilder(), ["a";"b";"c"])
||> fold1
(fun s t -> s.Append(", ").Append t)
(fun s t -> s.Append t)
|> string
// val it : string = "a, b, c"
Indeed, there is a built in function that does this:
let s = [ "a"; "b"; "c" ]
String.concat ", " s // "a, b, c"

Can I make return type vary with parameter a bit like sprintf in F#?

In the F# core libraries there are functions whose signature seemingly changes based on the parameter at compile-time:
> sprintf "Hello %i" ;;
val it : (int -> string) = <fun:it#1>
> sprintf "Hello %s" ;;
val it : (string -> string) = <fun:it#2-1>
Is it possible to implement my own functions that have this property?
For example, could I design a function that matches strings with variable components:
matchPath "/products/:string/:string" (fun (category : string) (sku : string) -> ())
matchPath "/tickets/:int" (fun (id : int) -> ())
Ideally, I would like to do avoid dynamic casts.
There are two relevant F# features that make it possible to do something like this.
Printf format strings. The compiler handles format strings like "hi %s" in a special way. They are not limited just to printf and it's possible to use those in your library in a somewhat different way. This does not let you change the syntax, but if you were happy to specify your paths using e.g. "/products/%s/%d", then you could use this. The Giraffe library defines routef function, which uses this trick for request routing:
let webApp =
choose [
routef "/foo/%s/%s/%i" fooHandler
routef "/bar/%O" (fun guid -> text (guid.ToString()))
]
Type providers. Another option is to use F# type providers. With parameterized type providers, you can write a type that is parameterized by a literal string and has members with types that are generated by some F# code you write based on the literal string parameter. An example is the Regex type provider:
type TempRegex = Regex< #"^(?<Temperature>[\d\.]+)\s*°C$", noMethodPrefix = true >
TempRegex().Match("21.3°C").Temperature.TryValue
Here, the regular expression on the first line is static parameter of the Regex type provider. The type provider generates a Match method which returns an object with properties like Temperature that are based on the literal string. You would likely be able to use this and write something like:
MatchPath<"/products/:category/:sku">.Match(fun r ->
printfn "Got category %s and sku %s" r.Category r.Sku)
I tweaked your example so that r is an object with properties that have names matching to those in the string, but you could use a lambda with multiple parameters too. Although, if you wanted to specify types of those matches, you might need a fancier syntax like "/product/[category:int]/[sku:string]" - this is just a string you have to parse in the type provider, so it's completely up to you.
1st: Tomas's answer is the right answer.
But ... I had the same question.
And while I could understand it conceptually as "it has to be 'the string format thing' or 'the provider stuff'"
I could not tell my self that I got until I tried an implementation
... And it took me a bit .
I used FSharp.Core's printfs and Giraffe's FormatExpressions.fs as guidelines
And came up with this naive gist/implementation, inspired by Giraffe FormatExpressions.fs
BTW The trick is in this bit of magic fun (format: PrintfFormat<_, _, _, _, 'T>) (handle: 'T -> 'R)
open System.Text.RegularExpressions
// convert format pattern to Regex Pattern
let rec toRegexPattern =
function
| '%' :: c :: tail ->
match c with
| 'i' ->
let x, rest = toRegexPattern tail
"(\d+)" + x, rest
| 's' ->
let x, rest = toRegexPattern tail
"(\w+)" + x, rest
| x ->
failwithf "'%%%c' is Not Implemented\n" x
| c :: tail ->
let x, rest = toRegexPattern tail
let r = c.ToString() |> Regex.Escape
r + x, rest
| [] -> "", []
// Handler Factory
let inline Handler (format: PrintfFormat<_, _, _, _, 'T>) (handle: 'T -> string) (decode: string list -> 'T) =
format.Value.ToCharArray()
|> List.ofArray
|> toRegexPattern
|> fst, handle, decode
// Active Patterns
let (|RegexMatch|_|) pattern input =
let m = Regex.Match(input, pattern)
if m.Success then
let values =
[ for g in Regex(pattern).Match(input).Groups do
if g.Success && g.Name <> "0" then yield g.Value ]
Some values
else
None
let getPattern (pattern, _, _) = pattern
let gethandler (_, handle, _) = handle
let getDecoder (_, _, decode) = decode
let Router path =
let route1 =
Handler "/xyz/%s/%i"
(fun (category, id) ->
// process request
sprintf "handled: route1: %s/%i" category id)
(fun values ->
// convert matches
values |> List.item 0,
values
|> List.item 1
|> int32)
let route2 =
Handler "/xyz/%i"
(fun (id) -> sprintf "handled: route2: id: %i" id) // handle
(fun values -> values|> List.head |> int32) // decode
// Router
(match path with
| RegexMatch (getPattern route2) values ->
values
|> getDecoder route2
|> gethandler route2
| RegexMatch (getPattern route1) values ->
values
|> getDecoder route1
|> gethandler route1
| _ -> failwith "No Match")
|> printf "routed: %A\n"
let main argv =
try
let arg = argv |> Array.skip 1 |> Array.head
Router arg
0 // return an integer exit code
with
| Failure msg ->
eprintf "Error: %s\n" msg
-1

Different Expressions being generated for "roughly" the same code quotation

given the following type
type Foo = { foo: string; bar: int };;
and the following code quotation
<#fun v x -> { x with foo = v; bar = 99 } #>;;
this will result in
val it : Quotations.Expr<(string -> Foo -> Foo)> =
Lambda (v, Lambda (x, NewRecord (Foo, v, Value (99))))
Which is expected. Also the following code quotation
<#fun v x -> { x with bar = v;foo = "foo" } #>;;
yields the expected result.
val it : Quotations.Expr<(int -> Foo -> Foo)> =
Lambda (v, Lambda (x, NewRecord (Foo, Value ("foo"), v)))
However this (changing the order and assigning the value to the second field)
<#fun v x -> { x with bar = 66;foo = v } #>;;
yields
val it : Quotations.Expr<(string -> Foo -> Foo)> =
Lambda (v, Lambda (x, Let (bar, Value (66), NewRecord (Foo, v, bar))))
a let. But there is no let in the code. Why is this?
Quotations only guarantee that they'll generate expressions with the correct behaviour, not any specific shape.
For example the quotation <## 1 = 2 || 2 = 3 ##> will generate an expression comprising of an if statement (i.e. if 1 = 2 then true else 2 = 3).
Normalising the resulting expressions is a pretty deep rabbit hole, but you can see some basic normalisers here: https://github.com/mavnn/Algebra.Boolean/blob/master/Algebra.Boolean/Transforms.fs
Specifically, check unbind at the end of the file.
let unbind quote =
let rec findLet q =
match q with
| Let (var, value, body) ->
findLet (replaceVar var.Name value body)
| ShapeLambda (v, e) ->
Expr.Lambda(v, findLet e)
| ShapeVar v ->
Expr.Var v
| ShapeCombination (o, es) ->
RebuildShapeCombination(o, es |> List.map findLet)
and replaceVar name value q =
match q with
| Let (v, e, e') ->
if v.Name = name then
findLet (Expr.Let(v, e, e'))
else
Expr.Let(v, replaceVar name value e, replaceVar name value e')
| ShapeLambda (v, e) ->
Expr.Lambda(v, replaceVar name value e)
| ShapeVar v ->
if v.Name = name then
value
else
Expr.Var v
| ShapeCombination (o, es) ->
RebuildShapeCombination(o, es |> List.map (replaceVar name value))
findLet quote
As to why these specific expressions are different? No idea, I'm afraid!
I believe what you are seeing here is a particular case of de-sugaring of the with syntax on records. I think what is happening here it is using the v to capture the value to ensure that the expressions are evaluated in the correct order of the fields. So in this case the let binding is introduce as the passed in parameter is the 2nd value being utilised.
This is from the F# language spec.
Primitive record constructions are an elaborated form in which the
fields appear in the same order as in the record type definition.
Record expressions themselves elaborate to a form that may introduce
local value definitions to ensure that expressions are evaluated in
the same order that the field definitions appear in the original
expression

The type 'List<int>' does not match the type 'string'

In F#
"Hello"+"World" gives "HelloWorld". I mean the + operator can concatenate the strings.
Given this code:
let iprint list:List<int> =
let stringList=int2String4List list //convert the int list to string list
List.foldBack (fun acc elem -> acc+elem+',' ) stringList ""
but i faced with the error:
The type 'List<int>' does not match the type 'string'
It seems to me the F# interpreted the datatype of stringList as int meanwhile it is a List<string>. but i do not know how does it happen?
List.foldBack : ('T -> 'State -> 'State) -> 'T list -> 'State -> 'State
This means, the datatype of first parameter of function and the list must be the same, but why it is insisting to accept + as an int operator, but not a string operator?
You missed parenthesis in your function declaration, so the type annotation (List<int>) was applied to the function return value. This will compile:
let iprint (list:List<int>) =
let stringList=int2String4List list
List.foldBack (fun acc elem -> acc+elem+",") stringList ""
By the way, isn't your int2String4List simply List.map string?
Also, the parameters of fun acc elem -> ... are in the wrong order. If you check the type of the function expected by List.foldBack you will see it's 'T -> 'State -> 'State - the first parameter is an element of the list, the second one is the accumulator. There is not much difference in the sample you posted (both 'T and 'State are string), but there is a difference if you want to shorten it:
let iprint list =
List.foldBack (fun elem acc -> (string elem) + "," + acc ) list ""
As #JoelMueller noticed in his comment, the shortest and fastest way to achieve this result is
let iprint =
List.map string >> String.concat ","

How do I write a computation expression builder that accumulates a value and also allows standard language constructs?

I have a computation expression builder that builds up a value as you go, and has many custom operations. However, it does not allow for standard F# language constructs, and I'm having a lot of trouble figuring out how to add this support.
To give a stand-alone example, here's a dead-simple and fairly pointless computation expression that builds F# lists:
type Items<'a> = Items of 'a list
type ListBuilder() =
member x.Yield(()) = Items []
[<CustomOperation("add")>]
member x.Add(Items current, item:'a) =
Items [ yield! current; yield item ]
[<CustomOperation("addMany")>]
member x.AddMany(Items current, items: seq<'a>) =
Items [ yield! current; yield! items ]
let listBuilder = ListBuilder()
let build (Items items) = items
I can use this to build lists just fine:
let stuff =
listBuilder {
add 1
add 5
add 7
addMany [ 1..10 ]
add 42
}
|> build
However, this is a compiler error:
listBuilder {
let x = 5 * 39
add x
}
// This expression was expected to have type unit, but
// here has type int.
And so is this:
listBuilder {
for x = 1 to 50 do
add x
}
// This control construct may only be used if the computation expression builder
// defines a For method.
I've read all the documentation and examples I can find, but there's something I'm just not getting. Every .Bind() or .For() method signature I try just leads to more and more confusing compiler errors. Most of the examples I can find either build up a value as you go along, or allow for regular F# language constructs, but I haven't been able to find one that does both.
If someone could point me in the right direction by showing me how to take this example and add support in the builder for let bindings and for loops (at minimum - using, while and try/catch would be great, but I can probably figure those out if someone gets me started) then I'll be able to gratefully apply the lesson to my actual problem.
The best place to look is the spec. For example,
b {
let x = e
op x
}
gets translated to
T(let x = e in op x, [], fun v -> v, true)
=> T(op x, {x}, fun v -> let x = e in v, true)
=> [| op x, let x = e in b.Yield(x) |]{x}
=> b.Op(let x = e in in b.Yield(x), x)
So this shows where things have gone wrong, though it doesn't present an obvious solution. Clearly, Yield needs to be generalized since it needs to take arbitrary tuples (based on how many variables are in scope). Perhaps more subtly, it also shows that x is not in scope in the call to add (see that unbound x as the second argument to b.Op?). To allow your custom operators to use bound variables, their arguments need to have the [<ProjectionParameter>] attribute (and take functions from arbitrary variables as arguments), and you'll also need to set MaintainsVariableSpace to true if you want bound variables to be available to later operators. This will change the final translation to:
b.Op(let x = e in b.Yield(x), fun x -> x)
Building up from this, it seems that there's no way to avoid passing the set of bound values along to and from each operation (though I'd love to be proven wrong) - this will require you to add a Run method to strip those values back off at the end. Putting it all together, you'll get a builder which looks like this:
type ListBuilder() =
member x.Yield(vars) = Items [],vars
[<CustomOperation("add",MaintainsVariableSpace=true)>]
member x.Add((Items current,vars), [<ProjectionParameter>]f) =
Items (current # [f vars]),vars
[<CustomOperation("addMany",MaintainsVariableSpace=true)>]
member x.AddMany((Items current, vars), [<ProjectionParameter>]f) =
Items (current # f vars),vars
member x.Run(l,_) = l
The most complete examples I've seen are in §6.3.10 of the spec, especially this one:
/// Computations that can cooperatively yield by returning a continuation
type Eventually<'T> =
| Done of 'T
| NotYetDone of (unit -> Eventually<'T>)
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module Eventually =
/// The bind for the computations. Stitch 'k' on to the end of the computation.
/// Note combinators like this are usually written in the reverse way,
/// for example,
/// e |> bind k
let rec bind k e =
match e with
| Done x -> NotYetDone (fun () -> k x)
| NotYetDone work -> NotYetDone (fun () -> bind k (work()))
/// The return for the computations.
let result x = Done x
type OkOrException<'T> =
| Ok of 'T
| Exception of System.Exception
/// The catch for the computations. Stitch try/with throughout
/// the computation and return the overall result as an OkOrException.
let rec catch e =
match e with
| Done x -> result (Ok x)
| NotYetDone work ->
NotYetDone (fun () ->
let res = try Ok(work()) with | e -> Exception e
match res with
| Ok cont -> catch cont // note, a tailcall
| Exception e -> result (Exception e))
/// The delay operator.
let delay f = NotYetDone (fun () -> f())
/// The stepping action for the computations.
let step c =
match c with
| Done _ -> c
| NotYetDone f -> f ()
// The rest of the operations are boilerplate.
/// The tryFinally operator.
/// This is boilerplate in terms of "result", "catch" and "bind".
let tryFinally e compensation =
catch (e)
|> bind (fun res -> compensation();
match res with
| Ok v -> result v
| Exception e -> raise e)
/// The tryWith operator.
/// This is boilerplate in terms of "result", "catch" and "bind".
let tryWith e handler =
catch e
|> bind (function Ok v -> result v | Exception e -> handler e)
/// The whileLoop operator.
/// This is boilerplate in terms of "result" and "bind".
let rec whileLoop gd body =
if gd() then body |> bind (fun v -> whileLoop gd body)
else result ()
/// The sequential composition operator
/// This is boilerplate in terms of "result" and "bind".
let combine e1 e2 =
e1 |> bind (fun () -> e2)
/// The using operator.
let using (resource: #System.IDisposable) f =
tryFinally (f resource) (fun () -> resource.Dispose())
/// The forLoop operator.
/// This is boilerplate in terms of "catch", "result" and "bind".
let forLoop (e:seq<_>) f =
let ie = e.GetEnumerator()
tryFinally (whileLoop (fun () -> ie.MoveNext())
(delay (fun () -> let v = ie.Current in f v)))
(fun () -> ie.Dispose())
// Give the mapping for F# computation expressions.
type EventuallyBuilder() =
member x.Bind(e,k) = Eventually.bind k e
member x.Return(v) = Eventually.result v
member x.ReturnFrom(v) = v
member x.Combine(e1,e2) = Eventually.combine e1 e2
member x.Delay(f) = Eventually.delay f
member x.Zero() = Eventually.result ()
member x.TryWith(e,handler) = Eventually.tryWith e handler
member x.TryFinally(e,compensation) = Eventually.tryFinally e compensation
member x.For(e:seq<_>,f) = Eventually.forLoop e f
member x.Using(resource,e) = Eventually.using resource e
The tutorial at "F# for fun and profit" is first class in this regard.
http://fsharpforfunandprofit.com/posts/computation-expressions-intro/
Following a similar struggle to Joel's (and not finding §6.3.10 of the spec that helpful) my issue with getting the For construct to generate a list came down to getting types to line up properly (no special attributes required). In particular I was slow to realise that For would build a list of lists, and therefore need flattening, despite the best efforts of the compiler to put me right. Examples that I found on the web were always wrappers around seq{}, using the yield keyword, repeated use of which invokes a call to Combine, which does the flattening. In case a concrete example helps, the following excerpt uses for to build a list of integers - my ultimate aim being to create lists of components for rendering in a GUI (with some additional laziness thrown in). Also In depth talk on CE here which elaborates on kvb's points above.
module scratch
type Dispatcher = unit -> unit
type viewElement = int
type lazyViews = Lazy<list<viewElement>>
type ViewElementsBuilder() =
member x.Return(views: lazyViews) : list<viewElement> = views.Value
member x.Yield(v: viewElement) : list<viewElement> = [v]
member x.ReturnFrom(viewElements: list<viewElement>) = viewElements
member x.Zero() = list<viewElement>.Empty
member x.Combine(listA:list<viewElement>, listB: list<viewElement>) = List.concat [listA; listB]
member x.Delay(f) = f()
member x.For(coll:seq<'a>, forBody: 'a -> list<viewElement>) : list<viewElement> =
// seq {for v in coll do yield! f v} |> List.ofSeq
Seq.map forBody coll |> Seq.collect id |> List.ofSeq
let ve = new ViewElementsBuilder()
let makeComponent(m: int, dispatch: Dispatcher) : viewElement = m
let makeComponents() : list<viewElement> = [77; 33]
let makeViewElements() : list<viewElement> =
let model = {| Scores = [33;23;22;43;] |> Seq.ofList; Trainer = "John" |}
let d:Dispatcher = fun() -> () // Does nothing here, but will be used to raise messages from UI
ve {
for score in model.Scores do
yield makeComponent (score, d)
yield makeComponent (score * 100 / 50 , d)
if model.Trainer = "John" then
return lazy
[ makeComponent (12, d)
makeComponent (13, d)
]
else
return lazy
[ makeComponent (14, d)
makeComponent (15, d)
]
yield makeComponent (33, d)
return! makeComponents()
}

Resources