FSharp.Data.SqlClient/src/SqlClient.DesignTime/QuotationsFactory.fs at cb883a71a45a6f469e31d069add15e5314ef5ba5 · fsprojects/FSharp.Data.SqlClient · GitHub

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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
namespace FSharp.Data.SqlClient

open System
open System.Data
open System.Data.SqlClient
open System.Reflection
open System.Collections
open System.Diagnostics

open Microsoft.FSharp.Quotations

open FSharp.Data.SqlClient.Internals

type QuotationsFactory private() =

    static member internal GetBody(methodName, specialization, [<ParamArray>] bodyFactoryArgs : obj[]) =

        let bodyFactory =
            let mi = typeof<QuotationsFactory>.GetMethod(methodName, BindingFlags.NonPublic ||| BindingFlags.Static)
            if isNull mi then failwithf "QuotationsFactory: method '%s' not found. This is a bug in FSharp.Data.SqlClient." methodName
            mi.MakeGenericMethod([| specialization |])

        fun(args : Expr list) ->
            let parameters = Array.append [| box args |] bodyFactoryArgs
            bodyFactory.Invoke(null, parameters) |> unbox

    static member internal ToSqlParam(p : Parameter) =

        let name = p.Name
        let sqlDbType = p.TypeInfo.SqlDbType
        let isFixedLength = p.TypeInfo.IsFixedLength

        <@@
            let x = SqlParameter(name, sqlDbType, Direction = %%Expr.Value p.Direction)

            if not isFixedLength then x.Size <- %%Expr.Value p.Size

            x.Precision <- %%Expr.Value p.Precision
            x.Scale <- %%Expr.Value p.Scale

            if x.SqlDbType = SqlDbType.Structured
            then
                let typeName: string = sprintf "%s.%s" (%%Expr.Value p.TypeInfo.Schema) (%%Expr.Value p.TypeInfo.UdttName)
                //done via reflection because not implemented on Mono
                x.GetType().GetProperty("TypeName").SetValue(x, typeName, null)

            if %%Expr.Value p.TypeInfo.SqlEngineTypeId = 240
            then
                x.UdtTypeName <- %%Expr.Value p.TypeInfo.TypeName
            x
        @@>

    static member internal OptionToObj<'T> value = <@@ match %%value with Some (x : 'T) -> box x | None -> DbNull @@>

    static member internal MapArrayOptionItemToObj<'T>(arr, index) =
        <@
            let values : obj[] = %%arr
            values.[index] <- match unbox values.[index] with Some (x : 'T) -> box x | None -> null
        @>

    static member internal MapArrayObjItemToOption<'T>(arr, index) =
        <@
            let values : obj[] = %%arr
            values.[index] <- box <| if Convert.IsDBNull(values.[index]) then None else Some(unbox<'T> values.[index])
        @>

    static member internal MapArrayNullableItems(outputColumns : Column list, mapper : string) =
        let columnTypes, isNullableColumn = outputColumns |> List.map (fun c -> c.GetTypeInfoConsideringUDDT().ClrTypeFullName, c.Nullable) |> List.unzip
        let arr = Var("_", typeof<obj[]>)
        let body =
            (columnTypes, isNullableColumn)
            ||> List.zip
            |> List.mapi(fun index (typeName, isNullableColumn) ->
                if isNullableColumn
                then
                    typeof<QuotationsFactory>
                        .GetMethod(mapper, BindingFlags.NonPublic ||| BindingFlags.Static)
                        .MakeGenericMethod(Type.GetType(typeName, throwOnError = true))
                        .Invoke(null, [| box(Expr.Var arr); box index |])
                        |> unbox
                        |> Some
                else
                    None
            )
            |> List.choose id
            |> List.fold (fun acc x ->
                Expr.Sequential(acc, x)
            ) <@@ () @@>
        Expr.Lambda(arr, body)

    static member internal GetNullableValueFromDataRow<'T>(exprArgs : Expr list, name : string) =
        <@
            let row : DataRow = %%exprArgs.[0]
            if row.IsNull name then None else Some(unbox<'T> row.[name])
        @>

    static member internal SetNullableValueInDataRow<'T>(exprArgs : Expr list, name : string) =
        <@
            (%%exprArgs.[0] : DataRow).[name] <- match (%%exprArgs.[1] : option<'T>) with None -> DbNull | Some value -> box value
        @>

    static member private GetNonNullableValueFromDataRow<'T>(exprArgs : Expr list, name: string) =
        <@ (%%exprArgs.[0] : DataRow).[name] @>

    static member private SetNonNullableValueInDataRow<'T>(exprArgs : Expr list, name : string) =
        <@ (%%exprArgs.[0] : DataRow).[name] <- %%Expr.Coerce(exprArgs.[1], typeof<obj>) @>