11 people like it.

Extending the standard query builder

The example shows how to extend F# 3.0 'query' builder with a new custom operation that will work with standard lists, but also with queries that are translated using LINQ expressiont trees (such as databases).

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
open System.Linq

// Extend the standard QueryBuilder type with an additional 
// custom operation (that must be expressed in terms of other
// query operations) and marked with ReflectedDefinition
type Linq.QueryBuilder with
  [<ReflectedDefinition; CustomOperation("exactlyOneOrNone")>]
  member __.ExactlyOneOrNone (source : Linq.QuerySource<'T, 'U>) : 'T option =
    query.ExactlyOneOrDefault(query.Select(source, fun x -> Some x))

  [<ReflectedDefinition; CustomOperation("headOrNone")>]
  member __.HeadOrNone (source : Linq.QuerySource<'T, 'U>) : 'T option =
    query.HeadOrDefault(query.Select(source, fun x -> Some x))

  [<ReflectedDefinition; CustomOperation("lastOrNone")>]
  member __.LastOrNone (source : Linq.QuerySource<'T, 'U>) : 'T option =
    query.LastOrDefault(query.Select(source, fun x -> Some x))

[<AutoOpen>]
module QueryExtensions = 
  open Microsoft.FSharp.Quotations

  /// Traverse a quotation and replace expressions according to 'f'
  /// (see also http://fssnip.net/1i)
  let rec traverseQuotation f q = 
    let q = defaultArg (f q) q
    match q with
    | ExprShape.ShapeCombination(a, args) -> 
        let nargs = args |> List.map (traverseQuotation f)
        ExprShape.RebuildShapeCombination(a, nargs)
    | ExprShape.ShapeLambda(v, body)  -> 
        Expr.Lambda(v, traverseQuotation f body)
    | ExprShape.ShapeVar(v) ->
        Expr.Var(v)

  /// Store the original query.Run operation
  let oldRun (e:Expr<'T>) = query.Run(e)

  /// Add a new 'Run' method that first replaces 'exactlyOneOrNone' 
  /// (and other extensions) with their definition and then runs
  /// the new quotation using previous 'oldRun' method
  type Linq.QueryBuilder with
    [<CompiledName("RunQueryAsValue")>]
    member this.Run (q: Microsoft.FSharp.Quotations.Expr<'T option>) : 'T option = 
      let q : Expr<'T option> = 
        q |> traverseQuotation (function
          // Detects a call to an (instance) method that has the ReflectedDefinition attribute
          // and replaces it with the body of the method (taken from Query.fs of FSharp.Core.dll)
          | Patterns.Call(Some inst, DerivedPatterns.MethodWithReflectedDefinition(DerivedPatterns.Lambdas(vs, body)), args) -> 
              let args = inst::args
              let tab = 
                List.map2 (fun (vs:Var list) arg -> 
                  match vs, arg with 
                  | [v], arg -> [(v, arg)] | vs, Patterns.NewTuple(args) -> List.zip vs args 
                  | _ -> List.zip vs [arg]) vs args
                |> List.concat
                |> Map.ofSeq
              let body = body.Substitute tab.TryFind 
              Some body
          | _ -> None) |> Expr.Cast
      oldRun(q)

// Example - now we can use 'exactlyOneOrNone'!                                       
let data = List.empty<int>
let value = query { for v in data do
                    select v
                    exactlyOneOrNone }  

match value with
| Some a -> printf "Some value %A" a
| None -> printf "None"
namespace System
namespace System.Linq
namespace Microsoft.FSharp.Linq
Multiple items
type QueryBuilder =
  new : unit -> QueryBuilder
  member All : source:QuerySource<'T,'Q> * predicate:('T -> bool) -> bool
  member AverageBy : source:QuerySource<'T,'Q> * projection:('T -> 'Value) -> 'Value (requires member ( + ) and member DivideByInt and member get_Zero)
  member AverageByNullable : source:QuerySource<'T,'Q> * projection:('T -> Nullable<'Value>) -> Nullable<'Value> (requires member ( + ) and member DivideByInt and member get_Zero and default constructor and value type and 'Value :> ValueType)
  member Contains : source:QuerySource<'T,'Q> * key:'T -> bool
  member Count : source:QuerySource<'T,'Q> -> int
  member Distinct : source:QuerySource<'T,'Q> -> QuerySource<'T,'Q> (requires equality)
  member ExactlyOne : source:QuerySource<'T,'Q> -> 'T
  member ExactlyOneOrDefault : source:QuerySource<'T,'Q> -> 'T
  member Exists : source:QuerySource<'T,'Q> * predicate:('T -> bool) -> bool
  ...

Full name: Microsoft.FSharp.Linq.QueryBuilder

--------------------
new : unit -> Linq.QueryBuilder
Multiple items
type ReflectedDefinitionAttribute =
  inherit Attribute
  new : unit -> ReflectedDefinitionAttribute

Full name: Microsoft.FSharp.Core.ReflectedDefinitionAttribute

--------------------
new : unit -> ReflectedDefinitionAttribute
Multiple items
type CustomOperationAttribute =
  inherit Attribute
  new : name:string -> CustomOperationAttribute
  member AllowIntoPattern : bool
  member IsLikeGroupJoin : bool
  member IsLikeJoin : bool
  member IsLikeZip : bool
  member JoinConditionWord : string
  member MaintainsVariableSpace : bool
  member MaintainsVariableSpaceUsingBind : bool
  member Name : string
  ...

Full name: Microsoft.FSharp.Core.CustomOperationAttribute

--------------------
new : name:string -> CustomOperationAttribute
member Linq.QueryBuilder.ExactlyOneOrNone : source:Linq.QuerySource<'T,'U> -> 'T option

Full name: Script.ExactlyOneOrNone
val source : Linq.QuerySource<'T,'U>
Multiple items
type QuerySource<'T,'Q> =
  new : seq<'T> -> QuerySource<'T,'Q>
  member Source : seq<'T>

Full name: Microsoft.FSharp.Linq.QuerySource<_,_>

--------------------
new : seq<'T> -> Linq.QuerySource<'T,'Q>
type 'T option = Option<'T>

Full name: Microsoft.FSharp.Core.option<_>
val query : Linq.QueryBuilder

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.query
member Linq.QueryBuilder.ExactlyOneOrDefault : source:Linq.QuerySource<'T,'Q> -> 'T
member Linq.QueryBuilder.Select : source:Linq.QuerySource<'T,'Q> * projection:('T -> 'Result) -> Linq.QuerySource<'Result,'Q>
val x : 'T
union case Option.Some: Value: 'T -> Option<'T>
val __ : Linq.QueryBuilder
member Linq.QueryBuilder.HeadOrNone : source:Linq.QuerySource<'T,'U> -> 'T option

Full name: Script.HeadOrNone
member Linq.QueryBuilder.HeadOrDefault : source:Linq.QuerySource<'T,'Q> -> 'T
member Linq.QueryBuilder.LastOrNone : source:Linq.QuerySource<'T,'U> -> 'T option

Full name: Script.LastOrNone
member Linq.QueryBuilder.LastOrDefault : source:Linq.QuerySource<'T,'Q> -> 'T
Multiple items
type AutoOpenAttribute =
  inherit Attribute
  new : unit -> AutoOpenAttribute
  new : path:string -> AutoOpenAttribute
  member Path : string

Full name: Microsoft.FSharp.Core.AutoOpenAttribute

--------------------
new : unit -> AutoOpenAttribute
new : path:string -> AutoOpenAttribute
namespace Microsoft
namespace Microsoft.FSharp
namespace Microsoft.FSharp.Quotations
val traverseQuotation : f:(Expr -> Expr option) -> q:Expr -> Expr

Full name: Script.QueryExtensions.traverseQuotation


 Traverse a quotation and replace expressions according to 'f'
 (see also http://fssnip.net/1i)
val f : (Expr -> Expr option)
val q : Expr
val defaultArg : arg:'T option -> defaultValue:'T -> 'T

Full name: Microsoft.FSharp.Core.Operators.defaultArg
module ExprShape

from Microsoft.FSharp.Quotations
active recognizer ShapeCombination: Expr -> Choice<Var,(Var * Expr),(obj * Expr list)>

Full name: Microsoft.FSharp.Quotations.ExprShape.( |ShapeVar|ShapeLambda|ShapeCombination| )
val a : obj
val args : Expr list
val nargs : Expr list
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val map : mapping:('T -> 'U) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.map
val RebuildShapeCombination : shape:obj * arguments:Expr list -> Expr

Full name: Microsoft.FSharp.Quotations.ExprShape.RebuildShapeCombination
active recognizer ShapeLambda: Expr -> Choice<Var,(Var * Expr),(obj * Expr list)>

Full name: Microsoft.FSharp.Quotations.ExprShape.( |ShapeVar|ShapeLambda|ShapeCombination| )
val v : Var
val body : Expr
Multiple items
type Expr =
  override Equals : obj:obj -> bool
  member GetFreeVars : unit -> seq<Var>
  member Substitute : substitution:(Var -> Expr option) -> Expr
  member ToString : full:bool -> string
  member CustomAttributes : Expr list
  member Type : Type
  static member AddressOf : target:Expr -> Expr
  static member AddressSet : target:Expr * value:Expr -> Expr
  static member Application : functionExpr:Expr * argument:Expr -> Expr
  static member Applications : functionExpr:Expr * arguments:Expr list list -> Expr
  ...

Full name: Microsoft.FSharp.Quotations.Expr

--------------------
type Expr<'T> =
  inherit Expr
  member Raw : Expr

Full name: Microsoft.FSharp.Quotations.Expr<_>
static member Expr.Lambda : parameter:Var * body:Expr -> Expr
active recognizer ShapeVar: Expr -> Choice<Var,(Var * Expr),(obj * Expr list)>

Full name: Microsoft.FSharp.Quotations.ExprShape.( |ShapeVar|ShapeLambda|ShapeCombination| )
static member Expr.Var : variable:Var -> Expr
val oldRun : e:Expr<'T> -> 'T

Full name: Script.QueryExtensions.oldRun


 Store the original query.Run operation
val e : Expr<'T>
member Linq.QueryBuilder.Run : Expr<'T> -> 'T
member Linq.QueryBuilder.Run : Expr<Linq.QuerySource<'T,System.Collections.IEnumerable>> -> seq<'T>
member Linq.QueryBuilder.Run : Expr<Linq.QuerySource<'T,IQueryable>> -> IQueryable<'T>
Multiple items
type CompiledNameAttribute =
  inherit Attribute
  new : compiledName:string -> CompiledNameAttribute
  member CompiledName : string

Full name: Microsoft.FSharp.Core.CompiledNameAttribute

--------------------
new : compiledName:string -> CompiledNameAttribute
val this : Linq.QueryBuilder
member Linq.QueryBuilder.Run : q:Expr<'T option> -> 'T option

Full name: Script.QueryExtensions.Run
val q : Expr<'T option>
module Patterns

from Microsoft.FSharp.Quotations
active recognizer Call: Expr -> (Expr option * System.Reflection.MethodInfo * Expr list) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |Call|_| )
val inst : Expr
module DerivedPatterns

from Microsoft.FSharp.Quotations
active recognizer MethodWithReflectedDefinition: System.Reflection.MethodBase -> Expr option

Full name: Microsoft.FSharp.Quotations.DerivedPatterns.( |MethodWithReflectedDefinition|_| )
active recognizer Lambdas: Expr -> (Var list list * Expr) option

Full name: Microsoft.FSharp.Quotations.DerivedPatterns.( |Lambdas|_| )
val vs : Var list list
val tab : Map<Var,Expr>
val map2 : mapping:('T1 -> 'T2 -> 'U) -> list1:'T1 list -> list2:'T2 list -> 'U list

Full name: Microsoft.FSharp.Collections.List.map2
val vs : Var list
Multiple items
type Var =
  interface IComparable
  new : name:string * typ:Type * ?isMutable:bool -> Var
  member IsMutable : bool
  member Name : string
  member Type : Type
  static member Global : name:string * typ:Type -> Var

Full name: Microsoft.FSharp.Quotations.Var

--------------------
new : name:string * typ:System.Type * ?isMutable:bool -> Var
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
val arg : Expr
active recognizer NewTuple: Expr -> Expr list option

Full name: Microsoft.FSharp.Quotations.Patterns.( |NewTuple|_| )
val zip : list1:'T1 list -> list2:'T2 list -> ('T1 * 'T2) list

Full name: Microsoft.FSharp.Collections.List.zip
val concat : lists:seq<'T list> -> 'T list

Full name: Microsoft.FSharp.Collections.List.concat
Multiple items
module Map

from Microsoft.FSharp.Collections

--------------------
type Map<'Key,'Value (requires comparison)> =
  interface IEnumerable
  interface IComparable
  interface IEnumerable<KeyValuePair<'Key,'Value>>
  interface ICollection<KeyValuePair<'Key,'Value>>
  interface IDictionary<'Key,'Value>
  new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
  member Add : key:'Key * value:'Value -> Map<'Key,'Value>
  member ContainsKey : key:'Key -> bool
  override Equals : obj -> bool
  member Remove : key:'Key -> Map<'Key,'Value>
  ...

Full name: Microsoft.FSharp.Collections.Map<_,_>

--------------------
new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
val ofSeq : elements:seq<'Key * 'T> -> Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.ofSeq
member Expr.Substitute : substitution:(Var -> Expr option) -> Expr
member Map.TryFind : key:'Key -> 'Value option
union case Option.None: Option<'T>
static member Expr.Cast : source:Expr -> Expr<'T>
val data : int list

Full name: Script.data
val empty<'T> : 'T list

Full name: Microsoft.FSharp.Collections.List.empty
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
val value : int option

Full name: Script.value
val v : int
custom operation: select ('Result)

Calls Linq.QueryBuilder.Select
custom operation: exactlyOneOrNone

Calls Linq.QueryBuilder.ExactlyOneOrNone
val a : int
val printf : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printf

More information

Link:http://fssnip.net/go
Posted:11 years ago
Author:Tomas Petricek
Tags: query , querybuilder , quotation , run , database , list