From 8a9bbffa110a70ecc77e2e05ae09afffac897fec Mon Sep 17 00:00:00 2001 From: David Teasdale Date: Thu, 16 Nov 2017 14:32:18 +0000 Subject: [PATCH 01/18] Add TempTableDefinitions and TableVarMapping --- src/SqlClient.Tests/TVPTests.fs | 48 ++++++++++++++++++++++++++ src/SqlClient/DesignTime.fs | 53 +++++++++++++++++++++++++++++ src/SqlClient/SqlCommandProvider.fs | 19 ++++++++--- 3 files changed, 116 insertions(+), 4 deletions(-) diff --git a/src/SqlClient.Tests/TVPTests.fs b/src/SqlClient.Tests/TVPTests.fs index 090d0439..4c005677 100644 --- a/src/SqlClient.Tests/TVPTests.fs +++ b/src/SqlClient.Tests/TVPTests.fs @@ -138,3 +138,51 @@ let UsingTVPInQuery() = |> Seq.toList Assert.Equal<_ list>(expected, actual) + + +type MappedTVP = + SqlCommandProvider<" + SELECT * from @input + ", ConnectionStrings.AdventureWorksNamed, TableVarMapping = "@input=dbo.MyTableType"> +[] +let UsingMappedTVPInQuery() = + use cmd = new MappedTVP(ConnectionStrings.AdventureWorksNamed) + let expected = [ + 1, Some "monkey" + 2, Some "donkey" + ] + + let actual = + cmd.Execute(input = [ for id, name in expected -> MappedTVP.MyTableType(id, name) ]) + |> Seq.map(fun x -> x.myId, x.myName) + |> Seq.toList + + Assert.Equal<_ list>(expected, actual) + + +[] +let UsingTempTable() = + use conn = new SqlConnection(ConnectionStrings.AdventureWorks) + conn.Open() + use cmd = new SqlCommand(" + CREATE TABLE #Temp(Id INT NOT NULL, Name NVARCHAR(100) NULL); + INSERT #Temp(Id, Name) + VALUES (1, 'monkey'), + (2, 'donkey') + ", conn) + + use cmd = new SqlCommandProvider<" + SELECT Id, Name from #Temp + ", ConnectionStrings.AdventureWorksNamed, TempTableDefinitions = "CREATE TABLE #Temp(Id INT NOT NULL, Name NVARCHAR(100) NULL)">(conn) + + let expected = [ + 1, Some "monkey" + 2, Some "donkey" + ] + + let actual = + cmd.Execute() + |> Seq.map(fun x -> x.Id, x.Name) + |> Seq.toList + + Assert.Equal<_ list>(expected, actual) \ No newline at end of file diff --git a/src/SqlClient/DesignTime.fs b/src/SqlClient/DesignTime.fs index 14ce04e9..8e98468b 100644 --- a/src/SqlClient/DesignTime.fs +++ b/src/SqlClient/DesignTime.fs @@ -10,6 +10,7 @@ open System.Diagnostics open Microsoft.FSharp.Quotations open ProviderImplementation.ProvidedTypes open FSharp.Data +open System.Text.RegularExpressions type internal RowType = { Provided: Type @@ -40,6 +41,10 @@ module internal SharedLogic = // add .Table returnType.Single |> cmdProvidedType.AddMember +module Prefixes = + let tempTable = "##SQLCOMMANDPROVIDER_" + let tableVar = "@SQLCOMMANDPROVIDER_" + type DesignTime private() = static member internal AddGeneratedMethod (sqlParameters: Parameter list, hasOutputParameters, executeArgs: ProvidedParameter list, erasedType, providedOutputType, name) = @@ -600,3 +605,51 @@ type DesignTime private() = then yield upcast ProvidedMethod(factoryMethodName.Value, parameters2, returnType = cmdProvidedType, IsStaticMethod = true, InvokeCode = body2) ] + + static member internal SubstituteTempTables(connection, commandText: string, tempTableDefinitions : string) = + let tempTableRegex = Regex("#([a-z0-9\-_]+)", RegexOptions.IgnoreCase) + + let tempTableNames = + tempTableRegex.Matches(tempTableDefinitions) + |> Seq.cast + |> Seq.map (fun m -> m.Groups.[1].Value) + |> Seq.toList + + match tempTableNames with + | [] -> commandText, [] + | _ -> + use cmd = new SqlCommand(tempTableRegex.Replace(tempTableDefinitions, Prefixes.tempTable+"$1"), connection) + cmd.ExecuteScalar() |> ignore + + // Only replace temp tables we find in our list. + tempTableRegex.Replace(commandText, MatchEvaluator(fun m -> + match tempTableNames |> List.tryFind((=) m.Groups.[1].Value) with + | Some name -> Prefixes.tempTable + name + | None -> m.Groups.[0].Value)), + + tempTableNames + + static member internal RemoveSubstitutedTempTables(connection, tempTableNames : string list) = + if not tempTableNames.IsEmpty then + use cmd = new SqlCommand(tempTableNames |> List.map(fun name -> sprintf "DROP TABLE [%s%s]" Prefixes.tempTable name) |> String.concat ";", connection) + cmd.ExecuteScalar() |> ignore + + static member internal SubstituteTableVar(commandText: string, tableVarMapping : string) = + let varRegex = Regex("@([a-z0-9_]+)", RegexOptions.IgnoreCase) + + let vars = + tableVarMapping.Split([|';'|], System.StringSplitOptions.RemoveEmptyEntries) + |> Array.choose(fun (x : string) -> + match x.Split([|'='|]) with + | [|name;typ|] -> Some(name.TrimStart('@'), typ) + | _ -> None) + + // Only replace table vars we find in our list. + let commandText = + varRegex.Replace(commandText, MatchEvaluator(fun m -> + match vars |> Array.tryFind(fun (n,_) -> n = m.Groups.[1].Value) with + | Some (name, _) -> Prefixes.tableVar + name + | None -> m.Groups.[0].Value)) + + (vars |> Array.map(fun (name,typ) -> sprintf "DECLARE %s%s %s = @%s" Prefixes.tableVar name typ name) |> String.concat "; ") + "; " + commandText + diff --git a/src/SqlClient/SqlCommandProvider.fs b/src/SqlClient/SqlCommandProvider.fs index 41320d25..0a29b381 100644 --- a/src/SqlClient/SqlCommandProvider.fs +++ b/src/SqlClient/SqlCommandProvider.fs @@ -18,6 +18,7 @@ open Microsoft.FSharp.Quotations open FSharp.Data.SqlClient open ProviderImplementation.ProvidedTypes +open System.Text.RegularExpressions [] #if DEBUG @@ -53,9 +54,11 @@ type SqlCommandProvider(config : TypeProviderConfig) as this = ProvidedStaticParameter("ConfigFile", typeof, "") ProvidedStaticParameter("AllParametersOptional", typeof, false) ProvidedStaticParameter("DataDirectory", typeof, "") + ProvidedStaticParameter("TempTableDefinitions", typeof, "") + ProvidedStaticParameter("TableVarMapping", typeof, "") ], instantiationFunction = (fun typeName args -> - let value = lazy this.CreateRootType(typeName, unbox args.[0], unbox args.[1], unbox args.[2], unbox args.[3], unbox args.[4], unbox args.[5], unbox args.[6]) + let value = lazy this.CreateRootType(typeName, unbox args.[0], unbox args.[1], unbox args.[2], unbox args.[3], unbox args.[4], unbox args.[5], unbox args.[6], unbox args.[7], unbox args.[8]) cache.GetOrAdd(typeName, value) ) ) @@ -70,6 +73,8 @@ type SqlCommandProvider(config : TypeProviderConfig) as this = If set all parameters become optional. NULL input values must be handled inside T-SQL. A folder to be used to resolve relative file paths to *.sql script files at compile time. The default value is the folder that contains the project or script. The name of the data directory that replaces |DataDirectory| in connection strings. The default value is the project or script directory. +Temp tables create command. +List table-valued parameters in the format of "@tvp1=[dbo].[TVP_IDs]; @tvp2=[dbo].[TVP_IDs]" """ this.AddNamespace(nameSpace, [ providerType ]) @@ -81,7 +86,7 @@ type SqlCommandProvider(config : TypeProviderConfig) as this = |> defaultArg <| base.ResolveAssembly args - member internal this.CreateRootType(typeName, sqlStatement, connectionStringOrName: string, resultType, singleRow, configFile, allParametersOptional, dataDirectory) = + member internal this.CreateRootType(typeName, sqlStatement, connectionStringOrName: string, resultType, singleRow, configFile, allParametersOptional, dataDirectory, tempTableDefinitions, tableVarMapping) = if singleRow && not (resultType = ResultType.Records || resultType = ResultType.Tuples) then @@ -104,13 +109,19 @@ type SqlCommandProvider(config : TypeProviderConfig) as this = conn.CheckVersion() conn.LoadDataTypesMap() - let parameters = DesignTime.ExtractParameters(conn, sqlStatement, allParametersOptional) + let designTimeSqlStatement, tempTableNames = + let sql, tempTableNames = DesignTime.SubstituteTempTables(conn, sqlStatement, tempTableDefinitions) + DesignTime.SubstituteTableVar(sql, tableVarMapping), tempTableNames + + let parameters = DesignTime.ExtractParameters(conn, designTimeSqlStatement, allParametersOptional) let outputColumns = if resultType <> ResultType.DataReader - then DesignTime.GetOutputColumns(conn, sqlStatement, parameters, isStoredProcedure = false) + then DesignTime.GetOutputColumns(conn, designTimeSqlStatement, parameters, isStoredProcedure = false) else [] + DesignTime.RemoveSubstitutedTempTables(conn, tempTableNames) + let rank = if singleRow then ResultRank.SingleRow else ResultRank.Sequence let returnType = DesignTime.GetOutputTypes(outputColumns, resultType, rank, hasOutputParameters = false) From 921ca59d681a7476c70e66bfbb194ef211cef2f1 Mon Sep 17 00:00:00 2001 From: David Teasdale Date: Thu, 16 Nov 2017 15:33:59 +0000 Subject: [PATCH 02/18] try and get the build working --- build.fsx | 2 +- src/SqlClient.Tests/Lib/Lib.fsproj | 7 ++++--- src/SqlClient.Tests/Lib/packages.config | 4 ++++ .../SqlClient.Tests.NET40.fsproj | 7 ++++--- .../SqlClient.Tests.NET40/packages.config | 4 ++++ src/SqlClient.Tests/SqlClient.Tests.fsproj | 10 +++++----- src/SqlClient.Tests/TVPTests.fs | 15 +++++++++------ src/SqlClient.Tests/app.config | 2 +- src/SqlClient.Tests/packages.config | 1 + src/SqlClient/SqlClient.fsproj | 4 ++-- src/SqlClient/packages.config | 1 + 11 files changed, 36 insertions(+), 21 deletions(-) create mode 100644 src/SqlClient.Tests/Lib/packages.config create mode 100644 src/SqlClient.Tests/SqlClient.Tests.NET40/packages.config diff --git a/build.fsx b/build.fsx index 8e0bc494..635edbef 100644 --- a/build.fsx +++ b/build.fsx @@ -35,7 +35,7 @@ let release = let version = release.AssemblyVersion let releaseNotes = release.Notes |> String.concat "\n" -let testDir = "bin" +let testDir = "Build/Tests" // -------------------------------------------------------------------------------------- // Generate assembly info files with the right version & up-to-date information diff --git a/src/SqlClient.Tests/Lib/Lib.fsproj b/src/SqlClient.Tests/Lib/Lib.fsproj index 02376c26..173dcb2d 100644 --- a/src/SqlClient.Tests/Lib/Lib.fsproj +++ b/src/SqlClient.Tests/Lib/Lib.fsproj @@ -53,8 +53,12 @@ + + + ..\..\..\packages\FSharp.Core.4.2.3\lib\net45\FSharp.Core.dll + ..\..\..\bin\FSharp.Data.SqlClient.dll @@ -62,9 +66,6 @@ ..\..\..\..\..\..\..\..\Program Files (x86)\Microsoft SQL Server\120\SDK\Assemblies\Microsoft.SqlServer.Types.dll - - True - diff --git a/src/SqlClient.Tests/Lib/packages.config b/src/SqlClient.Tests/Lib/packages.config new file mode 100644 index 00000000..b7a5c04b --- /dev/null +++ b/src/SqlClient.Tests/Lib/packages.config @@ -0,0 +1,4 @@ + + + + \ No newline at end of file diff --git a/src/SqlClient.Tests/SqlClient.Tests.NET40/SqlClient.Tests.NET40.fsproj b/src/SqlClient.Tests/SqlClient.Tests.NET40/SqlClient.Tests.NET40.fsproj index b671ddea..89c79c61 100644 --- a/src/SqlClient.Tests/SqlClient.Tests.NET40/SqlClient.Tests.NET40.fsproj +++ b/src/SqlClient.Tests/SqlClient.Tests.NET40/SqlClient.Tests.NET40.fsproj @@ -66,15 +66,16 @@ + + + ..\..\..\packages\FSharp.Core.4.0.0.1\lib\net40\FSharp.Core.dll + ..\..\..\bin\FSharp.Data.SqlClient.dll - - True - diff --git a/src/SqlClient.Tests/SqlClient.Tests.NET40/packages.config b/src/SqlClient.Tests/SqlClient.Tests.NET40/packages.config new file mode 100644 index 00000000..729e9d63 --- /dev/null +++ b/src/SqlClient.Tests/SqlClient.Tests.NET40/packages.config @@ -0,0 +1,4 @@ + + + + \ No newline at end of file diff --git a/src/SqlClient.Tests/SqlClient.Tests.fsproj b/src/SqlClient.Tests/SqlClient.Tests.fsproj index 6e913a4c..990a4705 100644 --- a/src/SqlClient.Tests/SqlClient.Tests.fsproj +++ b/src/SqlClient.Tests/SqlClient.Tests.fsproj @@ -25,7 +25,7 @@ full false false - ..\..\bin\ + ..\..\Build\Tests DEBUG;TRACE 3 @@ -39,10 +39,10 @@ pdbonly true true - ..\..\bin\ + ..\..\Build\Tests TRACE 3 - ..\..\bin\SqlClient.Tests.XML + ..\..\Build\Tests\SqlClient.Tests.XML --warnon:1182 101 @@ -101,8 +101,8 @@ ..\..\packages\FSharp.Configuration.0.5.3\lib\net40\FSharp.Configuration.dll True - - True + + ..\..\packages\FSharp.Core.4.2.1\lib\net45\FSharp.Core.dll ..\..\bin\FSharp.Data.SqlClient.dll diff --git a/src/SqlClient.Tests/TVPTests.fs b/src/SqlClient.Tests/TVPTests.fs index 4c005677..5b06b60c 100644 --- a/src/SqlClient.Tests/TVPTests.fs +++ b/src/SqlClient.Tests/TVPTests.fs @@ -142,11 +142,12 @@ let UsingTVPInQuery() = type MappedTVP = SqlCommandProvider<" - SELECT * from @input - ", ConnectionStrings.AdventureWorksNamed, TableVarMapping = "@input=dbo.MyTableType"> + SELECT myId, myName from @input + ", ConnectionStrings.AdventureWorksLiteral, TableVarMapping = "@input=dbo.MyTableType"> [] let UsingMappedTVPInQuery() = - use cmd = new MappedTVP(ConnectionStrings.AdventureWorksNamed) + printfn "%s" ConnectionStrings.AdventureWorksLiteral + use cmd = new MappedTVP(ConnectionStrings.AdventureWorksLiteral) let expected = [ 1, Some "monkey" 2, Some "donkey" @@ -162,18 +163,20 @@ let UsingMappedTVPInQuery() = [] let UsingTempTable() = - use conn = new SqlConnection(ConnectionStrings.AdventureWorks) + use conn = new SqlConnection(ConnectionStrings.AdventureWorksLiteral) conn.Open() - use cmd = new SqlCommand(" + use create = new SqlCommand(" CREATE TABLE #Temp(Id INT NOT NULL, Name NVARCHAR(100) NULL); INSERT #Temp(Id, Name) VALUES (1, 'monkey'), (2, 'donkey') ", conn) + create.ExecuteScalar() |> ignore + use cmd = new SqlCommandProvider<" SELECT Id, Name from #Temp - ", ConnectionStrings.AdventureWorksNamed, TempTableDefinitions = "CREATE TABLE #Temp(Id INT NOT NULL, Name NVARCHAR(100) NULL)">(conn) + ", ConnectionStrings.AdventureWorksLiteral, TempTableDefinitions = "CREATE TABLE #Temp(Id INT NOT NULL, Name NVARCHAR(100) NULL)">(conn) let expected = [ 1, Some "monkey" diff --git a/src/SqlClient.Tests/app.config b/src/SqlClient.Tests/app.config index b262685f..0c43c826 100644 --- a/src/SqlClient.Tests/app.config +++ b/src/SqlClient.Tests/app.config @@ -7,7 +7,7 @@ - + diff --git a/src/SqlClient.Tests/packages.config b/src/SqlClient.Tests/packages.config index 0dd4c34f..487b0a85 100644 --- a/src/SqlClient.Tests/packages.config +++ b/src/SqlClient.Tests/packages.config @@ -1,6 +1,7 @@  + diff --git a/src/SqlClient/SqlClient.fsproj b/src/SqlClient/SqlClient.fsproj index 9075642a..885d853d 100644 --- a/src/SqlClient/SqlClient.fsproj +++ b/src/SqlClient/SqlClient.fsproj @@ -51,8 +51,8 @@ --warnon:1182 - - True + + ..\..\packages\FSharp.Core.4.0.0.1\lib\net40\FSharp.Core.dll ..\..\lib\Microsoft.SqlServer.TransactSql.ScriptDom.dll diff --git a/src/SqlClient/packages.config b/src/SqlClient/packages.config index a1b76a64..68052518 100644 --- a/src/SqlClient/packages.config +++ b/src/SqlClient/packages.config @@ -1,4 +1,5 @@  + \ No newline at end of file From a85d2b867d3fcd0a66efd00ac0d04a4df1570f73 Mon Sep 17 00:00:00 2001 From: David Teasdale Date: Thu, 16 Nov 2017 16:05:38 +0000 Subject: [PATCH 03/18] Add config --- src/SqlClient.Tests/connectionStrings.Azure.config | 5 +++++ 1 file changed, 5 insertions(+) create mode 100644 src/SqlClient.Tests/connectionStrings.Azure.config diff --git a/src/SqlClient.Tests/connectionStrings.Azure.config b/src/SqlClient.Tests/connectionStrings.Azure.config new file mode 100644 index 00000000..bf7df50c --- /dev/null +++ b/src/SqlClient.Tests/connectionStrings.Azure.config @@ -0,0 +1,5 @@ + + + + + From 635b365044d68836367f37701d164e081f432cb6 Mon Sep 17 00:00:00 2001 From: David Teasdale Date: Tue, 21 Nov 2017 15:46:36 +0000 Subject: [PATCH 04/18] Add loadTempTablesMethod --- SqlClient.sln | 7 +- src/SqlClient/DesignTime.fs | 110 ++++++++++++++++++++++++++-- src/SqlClient/SqlClient.fsproj | 7 +- src/SqlClient/SqlCommandProvider.fs | 16 ++-- 4 files changed, 124 insertions(+), 16 deletions(-) diff --git a/SqlClient.sln b/SqlClient.sln index 266919db..21c772b8 100644 --- a/SqlClient.sln +++ b/SqlClient.sln @@ -1,7 +1,7 @@  Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio 14 -VisualStudioVersion = 14.0.24720.0 +# Visual Studio 15 +VisualStudioVersion = 15.0.27004.2006 MinimumVisualStudioVersion = 10.0.40219.1 Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = ".nuget", ".nuget", "{7ECDF2A7-A71C-43B5-AFF2-64468098B7B6}" ProjectSection(SolutionItems) = preProject @@ -70,4 +70,7 @@ Global {573DBBFB-0F97-4327-8614-6A4151CD70BF} = {61AC061E-5824-41B7-8E09-8D3A73D564E5} {CB79269B-025B-4D6A-AF84-0AD821F6A602} = {573DBBFB-0F97-4327-8614-6A4151CD70BF} EndGlobalSection + GlobalSection(ExtensibilityGlobals) = postSolution + SolutionGuid = {8ADC7AFF-DF1C-4FAD-B3AD-63B3A8ED9F99} + EndGlobalSection EndGlobal diff --git a/src/SqlClient/DesignTime.fs b/src/SqlClient/DesignTime.fs index 8e98468b..06b55f32 100644 --- a/src/SqlClient/DesignTime.fs +++ b/src/SqlClient/DesignTime.fs @@ -516,7 +516,7 @@ type DesignTime private() = rowType - + static member internal GetExecuteArgs(cmdProvidedType: ProvidedTypeDefinition, sqlParameters: Parameter list, udttsPerSchema: Dictionary<_, ProvidedTypeDefinition>, ?unitsOfMeasurePerSchema) = [ for p in sqlParameters do @@ -606,6 +606,30 @@ type DesignTime private() = yield upcast ProvidedMethod(factoryMethodName.Value, parameters2, returnType = cmdProvidedType, IsStaticMethod = true, InvokeCode = body2) ] + static member private CreateTempTableRecord(name, cols) = + let rowType = ProvidedTypeDefinition(name, Some typeof, HideObjectMethods = true) + + let parameters = + [ + for (p : Column) in cols do + let name = p.Name + let param = ProvidedParameter( name, p.GetProvidedType(), ?optionalValue = if p.Nullable then Some null else None) + yield param + ] + + let ctor = ProvidedConstructor( parameters) + ctor.InvokeCode <- fun args -> + let optionsToNulls = QuotationsFactory.MapArrayNullableItems(cols, "MapArrayOptionItemToObj") + + <@@ let values: obj[] = %%Expr.NewArray(typeof, [ for a in args -> Expr.Coerce(a, typeof) ]) + (%%optionsToNulls) values + values @@> + + rowType.AddMember ctor + rowType.AddXmlDoc "Type Table Type" + + rowType + static member internal SubstituteTempTables(connection, commandText: string, tempTableDefinitions : string) = let tempTableRegex = Regex("#([a-z0-9\-_]+)", RegexOptions.IgnoreCase) @@ -616,8 +640,82 @@ type DesignTime private() = |> Seq.toList match tempTableNames with - | [] -> commandText, [] + | [] -> commandText, None | _ -> + let tableTypes = + use create = new SqlCommand(tempTableDefinitions, connection) + create.ExecuteScalar() |> ignore + + tempTableNames + |> List.map(fun name -> + let cols = DesignTime.GetOutputColumns(connection, "SELECT * FROM #"+name, [], isStoredProcedure = false) + use drop = new SqlCommand("DROP TABLE #"+name, connection) + drop.ExecuteScalar() |> ignore + DesignTime.CreateTempTableRecord(name, cols), cols) + + let parameters = + tableTypes + |> List.map (fun (typ, _) -> + ProvidedParameter(typ.Name, parameterType = ProvidedTypeBuilder.MakeGenericType(typedefof<_ seq>, [ typ ]))) + + let loadValues (exprArgs: Expr list) (connection) = + (exprArgs.Tail, tableTypes) + ||> List.map2 (fun expr (typ, cols) -> + let dest = typ.Name + + let columnsNames, columnsTypeNames = + cols + |> List.map(fun c -> c.Name, c.TypeInfo.TypeName) + |> List.toArray + |> Array.unzip + + <@@ (%%expr : _ seq) + |> Seq.chunkBySize 5000 + |> Seq.iter(fun rows -> + use table = new DataTable("Items"); + + (columnsNames, columnsTypeNames) + ||> Array.iter2(fun name typeName -> + + let typ = + match typeName with + | "int" -> typedefof + | "string" -> typedefof + | "bool" -> typedefof + | _ -> invalidOp typeName + + table.Columns.Add(name, typ) |> ignore + ) + + rows + |> Array.iter(fun row -> + let row : obj[] = unbox row + table.Rows.Add(row) |> ignore + ) + + use bulkCopy = new SqlBulkCopy((%%connection : SqlConnection)) + bulkCopy.DestinationTableName <- "#" + dest + bulkCopy.WriteToServer(table) + ) @@> + ) + |> List.fold (fun acc x -> Expr.Sequential(acc, x)) <@@ () @@> + + let loadTempTablesMethod = ProvidedMethod("LoadTempTables", parameters, typeof) + + loadTempTablesMethod.InvokeCode <- fun exprArgs -> + + let command = Expr.Coerce(exprArgs.[0], typedefof) + + let connection = + <@@ let cmd = (%%command : ISqlCommand) + cmd.Raw.Connection @@> + + <@@ use create = new SqlCommand(tempTableDefinitions, (%%connection : SqlConnection)) + create.ExecuteScalar() |> ignore + + (%%loadValues exprArgs connection) + ignore() @@> + use cmd = new SqlCommand(tempTableRegex.Replace(tempTableDefinitions, Prefixes.tempTable+"$1"), connection) cmd.ExecuteScalar() |> ignore @@ -627,11 +725,11 @@ type DesignTime private() = | Some name -> Prefixes.tempTable + name | None -> m.Groups.[0].Value)), - tempTableNames + Some(loadTempTablesMethod, tableTypes |> List.unzip |> fst) - static member internal RemoveSubstitutedTempTables(connection, tempTableNames : string list) = - if not tempTableNames.IsEmpty then - use cmd = new SqlCommand(tempTableNames |> List.map(fun name -> sprintf "DROP TABLE [%s%s]" Prefixes.tempTable name) |> String.concat ";", connection) + static member internal RemoveSubstitutedTempTables(connection, tempTables : ProvidedTypeDefinition list) = + if not tempTables.IsEmpty then + use cmd = new SqlCommand(tempTables |> List.map(fun tempTable -> sprintf "DROP TABLE [%s%s]" Prefixes.tempTable tempTable.Name) |> String.concat ";", connection) cmd.ExecuteScalar() |> ignore static member internal SubstituteTableVar(commandText: string, tableVarMapping : string) = diff --git a/src/SqlClient/SqlClient.fsproj b/src/SqlClient/SqlClient.fsproj index 885d853d..6bf3b629 100644 --- a/src/SqlClient/SqlClient.fsproj +++ b/src/SqlClient/SqlClient.fsproj @@ -27,12 +27,13 @@ Program - C:\Program Files (x86)\Microsoft Visual Studio 14.0\Common7\IDE\devenv.exe - ..\Tests.sln + C:\Program Files (x86)\Microsoft Visual Studio\2017\Professional\Common7\IDE\devenv.exe + Test.fsx 101 --warnon:1182 - true + false + C:\dev\Dare2 pdbonly diff --git a/src/SqlClient/SqlCommandProvider.fs b/src/SqlClient/SqlCommandProvider.fs index 0a29b381..b2c37880 100644 --- a/src/SqlClient/SqlCommandProvider.fs +++ b/src/SqlClient/SqlCommandProvider.fs @@ -109,9 +109,9 @@ type SqlCommandProvider(config : TypeProviderConfig) as this = conn.CheckVersion() conn.LoadDataTypesMap() - let designTimeSqlStatement, tempTableNames = - let sql, tempTableNames = DesignTime.SubstituteTempTables(conn, sqlStatement, tempTableDefinitions) - DesignTime.SubstituteTableVar(sql, tableVarMapping), tempTableNames + let designTimeSqlStatement, tempTableTypes = + let sql, types = DesignTime.SubstituteTempTables(conn, sqlStatement, tempTableDefinitions) + DesignTime.SubstituteTableVar(sql, tableVarMapping), types let parameters = DesignTime.ExtractParameters(conn, designTimeSqlStatement, allParametersOptional) @@ -120,12 +120,18 @@ type SqlCommandProvider(config : TypeProviderConfig) as this = then DesignTime.GetOutputColumns(conn, designTimeSqlStatement, parameters, isStoredProcedure = false) else [] - DesignTime.RemoveSubstitutedTempTables(conn, tempTableNames) - let rank = if singleRow then ResultRank.SingleRow else ResultRank.Sequence let returnType = DesignTime.GetOutputTypes(outputColumns, resultType, rank, hasOutputParameters = false) let cmdProvidedType = ProvidedTypeDefinition(assembly, nameSpace, typeName, Some typeof<``ISqlCommand Implementation``>, HideObjectMethods = true) + + do + match tempTableTypes with + | Some (loadTempTables, types) -> + DesignTime.RemoveSubstitutedTempTables(conn, types) + cmdProvidedType.AddMember(loadTempTables) + types |> List.iter(fun t -> cmdProvidedType.AddMember(t)) + | _ -> () do cmdProvidedType.AddMember(ProvidedProperty("ConnectionStringOrName", typeof, [], IsStatic = true, GetterCode = fun _ -> <@@ connectionStringOrName @@>)) From d344274b31098c1c66e206247e45e936265e5bba Mon Sep 17 00:00:00 2001 From: David Teasdale Date: Tue, 21 Nov 2017 16:37:28 +0000 Subject: [PATCH 05/18] Version bump --- RELEASE_NOTES.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md index 34414702..074cd921 100644 --- a/RELEASE_NOTES.md +++ b/RELEASE_NOTES.md @@ -1,3 +1,6 @@ +#### 1.8.3.1 - Nov 21, 2017 + * Temp Table + #### 1.8.3 - Aug 12, 2016 * Issue #224 - TVP generated type implicitly from SqlDataRecord. * Issue #232 - BREAKING CHANGE! SqlFile type provider is a new way to feed external sql files into SqlCommandProvider/CreateCommand From 69f6a8e4a2560ecb737ce069f404cf80d3403221 Mon Sep 17 00:00:00 2001 From: David Teasdale Date: Tue, 21 Nov 2017 16:45:34 +0000 Subject: [PATCH 06/18] bool -> bit --- src/SqlClient/DesignTime.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/SqlClient/DesignTime.fs b/src/SqlClient/DesignTime.fs index 06b55f32..9e9310e3 100644 --- a/src/SqlClient/DesignTime.fs +++ b/src/SqlClient/DesignTime.fs @@ -681,7 +681,7 @@ type DesignTime private() = match typeName with | "int" -> typedefof | "string" -> typedefof - | "bool" -> typedefof + | "bit" -> typedefof | _ -> invalidOp typeName table.Columns.Add(name, typ) |> ignore From 0f0112da9cc46ddeb4eca849e927bd28bac3ca49 Mon Sep 17 00:00:00 2001 From: David Teasdale Date: Wed, 22 Nov 2017 11:21:58 +0000 Subject: [PATCH 07/18] add binary --- src/SqlClient/DesignTime.fs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/SqlClient/DesignTime.fs b/src/SqlClient/DesignTime.fs index 9e9310e3..acd47a1e 100644 --- a/src/SqlClient/DesignTime.fs +++ b/src/SqlClient/DesignTime.fs @@ -682,6 +682,7 @@ type DesignTime private() = | "int" -> typedefof | "string" -> typedefof | "bit" -> typedefof + | "binary" -> typedefof | _ -> invalidOp typeName table.Columns.Add(name, typ) |> ignore From 19622196ff53a3f0f2cfe4735f8c0b734b7ad4f5 Mon Sep 17 00:00:00 2001 From: David Teasdale Date: Tue, 12 Dec 2017 17:06:28 +0000 Subject: [PATCH 08/18] Add TempTableLoader --- src/SqlClient/DesignTime.fs | 101 +++++++++++++++++++++++------------- 1 file changed, 64 insertions(+), 37 deletions(-) diff --git a/src/SqlClient/DesignTime.fs b/src/SqlClient/DesignTime.fs index acd47a1e..cd1dec65 100644 --- a/src/SqlClient/DesignTime.fs +++ b/src/SqlClient/DesignTime.fs @@ -45,6 +45,48 @@ module Prefixes = let tempTable = "##SQLCOMMANDPROVIDER_" let tableVar = "@SQLCOMMANDPROVIDER_" +type TempTableLoader(fieldCount, items: obj seq) = + let enumerator = items.GetEnumerator() + + interface IDataReader with + member this.FieldCount: int = fieldCount + member this.Read(): bool = enumerator.MoveNext() + member this.GetValue(i: int): obj = + let row : obj[] = unbox enumerator.Current + row.[i] + member this.Dispose(): unit = () + + member __.Close(): unit = invalidOp "NotImplementedException" + member __.Depth: int = invalidOp "NotImplementedException" + member __.GetBoolean(i: int): bool = invalidOp "NotImplementedException" + member __.GetByte(i: int): byte = invalidOp "NotImplementedException" + member __.GetBytes(i: int, fieldOffset: int64, buffer: byte [], bufferoffset: int, length: int): int64 = invalidOp "NotImplementedException" + member __.GetChar(i: int): char = invalidOp "NotImplementedException" + member __.GetChars(i: int, fieldoffset: int64, buffer: char [], bufferoffset: int, length: int): int64 = invalidOp "NotImplementedException" + member __.GetData(i: int): IDataReader = invalidOp "NotImplementedException" + member __.GetDataTypeName(i: int): string = invalidOp "NotImplementedException" + member __.GetDateTime(i: int): System.DateTime = invalidOp "NotImplementedException" + member __.GetDecimal(i: int): decimal = invalidOp "NotImplementedException" + member __.GetDouble(i: int): float = invalidOp "NotImplementedException" + member __.GetFieldType(i: int): System.Type = invalidOp "NotImplementedException" + member __.GetFloat(i: int): float32 = invalidOp "NotImplementedException" + member __.GetGuid(i: int): System.Guid = invalidOp "NotImplementedException" + member __.GetInt16(i: int): int16 = invalidOp "NotImplementedException" + member __.GetInt32(i: int): int = invalidOp "NotImplementedException" + member __.GetInt64(i: int): int64 = invalidOp "NotImplementedException" + member __.GetName(i: int): string = invalidOp "NotImplementedException" + member __.GetOrdinal(name: string): int = invalidOp "NotImplementedException" + member __.GetSchemaTable(): DataTable = invalidOp "NotImplementedException" + member __.GetString(i: int): string = invalidOp "NotImplementedException" + member __.GetValues(values: obj []): int = invalidOp "NotImplementedException" + member __.IsClosed: bool = invalidOp "NotImplementedException" + member __.IsDBNull(i: int): bool = invalidOp "NotImplementedException" + member __.Item with get (i: int): obj = invalidOp "NotImplementedException" + member __.Item with get (name: string): obj = invalidOp "NotImplementedException" + member __.NextResult(): bool = invalidOp "NotImplementedException" + member __.RecordsAffected: int = invalidOp "NotImplementedException" + + type DesignTime private() = static member internal AddGeneratedMethod (sqlParameters: Parameter list, hasOutputParameters, executeArgs: ProvidedParameter list, erasedType, providedOutputType, name) = @@ -663,41 +705,25 @@ type DesignTime private() = ||> List.map2 (fun expr (typ, cols) -> let dest = typ.Name - let columnsNames, columnsTypeNames = - cols - |> List.map(fun c -> c.Name, c.TypeInfo.TypeName) - |> List.toArray - |> Array.unzip - - <@@ (%%expr : _ seq) - |> Seq.chunkBySize 5000 - |> Seq.iter(fun rows -> - use table = new DataTable("Items"); - - (columnsNames, columnsTypeNames) - ||> Array.iter2(fun name typeName -> - - let typ = - match typeName with - | "int" -> typedefof - | "string" -> typedefof - | "bit" -> typedefof - | "binary" -> typedefof - | _ -> invalidOp typeName - - table.Columns.Add(name, typ) |> ignore - ) - - rows - |> Array.iter(fun row -> - let row : obj[] = unbox row - table.Rows.Add(row) |> ignore - ) - - use bulkCopy = new SqlBulkCopy((%%connection : SqlConnection)) - bulkCopy.DestinationTableName <- "#" + dest - bulkCopy.WriteToServer(table) - ) @@> + //let columnsNames, columnsTypeNames = + // cols + // |> List.map(fun c -> c.Name, c.TypeInfo.TypeName) + // |> List.toArray + // |> Array.unzip + + let len = cols.Length + + <@@ + let items = (%%expr : obj seq) + use reader = new TempTableLoader(len, items) + + use bulkCopy = new SqlBulkCopy((%%connection : SqlConnection)) + bulkCopy.BulkCopyTimeout <- 0 + bulkCopy.BatchSize <- 5000 + bulkCopy.DestinationTableName <- "#" + dest + bulkCopy.WriteToServer(reader) + + @@> ) |> List.fold (fun acc x -> Expr.Sequential(acc, x)) <@@ () @@> @@ -711,8 +737,9 @@ type DesignTime private() = <@@ let cmd = (%%command : ISqlCommand) cmd.Raw.Connection @@> - <@@ use create = new SqlCommand(tempTableDefinitions, (%%connection : SqlConnection)) - create.ExecuteScalar() |> ignore + <@@ do + use create = new SqlCommand(tempTableDefinitions, (%%connection : SqlConnection)) + create.ExecuteNonQuery() |> ignore (%%loadValues exprArgs connection) ignore() @@> From d60ead73493b28d58eb496778b7f1b937a92eb62 Mon Sep 17 00:00:00 2001 From: David Teasdale Date: Fri, 18 May 2018 14:21:43 +0100 Subject: [PATCH 09/18] Clean up --- src/SqlClient.Tests/SqlClient.Tests.fsproj | 1 + src/SqlClient.Tests/TVPTests.fs | 28 -- src/SqlClient/AssemblyInfo.fs | 8 +- src/SqlClient/DesignTime.fs | 388 ++++++++++----------- src/SqlClient/SqlClient.fsproj | 5 +- src/SqlClient/SqlCommandProvider.fs | 104 +++--- 6 files changed, 257 insertions(+), 277 deletions(-) diff --git a/src/SqlClient.Tests/SqlClient.Tests.fsproj b/src/SqlClient.Tests/SqlClient.Tests.fsproj index 990a4705..bd8ec60b 100644 --- a/src/SqlClient.Tests/SqlClient.Tests.fsproj +++ b/src/SqlClient.Tests/SqlClient.Tests.fsproj @@ -82,6 +82,7 @@ + diff --git a/src/SqlClient.Tests/TVPTests.fs b/src/SqlClient.Tests/TVPTests.fs index 5b06b60c..9e3c00d6 100644 --- a/src/SqlClient.Tests/TVPTests.fs +++ b/src/SqlClient.Tests/TVPTests.fs @@ -161,31 +161,3 @@ let UsingMappedTVPInQuery() = Assert.Equal<_ list>(expected, actual) -[] -let UsingTempTable() = - use conn = new SqlConnection(ConnectionStrings.AdventureWorksLiteral) - conn.Open() - use create = new SqlCommand(" - CREATE TABLE #Temp(Id INT NOT NULL, Name NVARCHAR(100) NULL); - INSERT #Temp(Id, Name) - VALUES (1, 'monkey'), - (2, 'donkey') - ", conn) - - create.ExecuteScalar() |> ignore - - use cmd = new SqlCommandProvider<" - SELECT Id, Name from #Temp - ", ConnectionStrings.AdventureWorksLiteral, TempTableDefinitions = "CREATE TABLE #Temp(Id INT NOT NULL, Name NVARCHAR(100) NULL)">(conn) - - let expected = [ - 1, Some "monkey" - 2, Some "donkey" - ] - - let actual = - cmd.Execute() - |> Seq.map(fun x -> x.Id, x.Name) - |> Seq.toList - - Assert.Equal<_ list>(expected, actual) \ No newline at end of file diff --git a/src/SqlClient/AssemblyInfo.fs b/src/SqlClient/AssemblyInfo.fs index e3d6c29d..f132e051 100644 --- a/src/SqlClient/AssemblyInfo.fs +++ b/src/SqlClient/AssemblyInfo.fs @@ -5,13 +5,13 @@ open System.Reflection [] [] [] -[] -[] +[] +[] do () module internal AssemblyVersionInformation = let [] AssemblyTitle = "SqlClient" let [] AssemblyProduct = "FSharp.Data.SqlClient" let [] AssemblyDescription = "SqlClient F# type providers" - let [] AssemblyVersion = "1.8.3" - let [] AssemblyFileVersion = "1.8.3" + let [] AssemblyVersion = "1.8.3.1" + let [] AssemblyFileVersion = "1.8.3.1" diff --git a/src/SqlClient/DesignTime.fs b/src/SqlClient/DesignTime.fs index cd1dec65..bbd45334 100644 --- a/src/SqlClient/DesignTime.fs +++ b/src/SqlClient/DesignTime.fs @@ -21,12 +21,12 @@ type internal RowType = { type internal ReturnType = { Single: Type PerRow: RowType option -} with - member this.RowMapping = +} with + member this.RowMapping = match this.PerRow with | Some x -> x.Mapping - | None -> Expr.Value Unchecked.defaultof - member this.RowTypeName = + | None -> Expr.Value Unchecked.defaultof + member this.RowTypeName = match this.PerRow with | Some x -> Expr.Value( x.ErasedTo.AssemblyQualifiedName) | None -> <@@ null: string @@> @@ -51,7 +51,7 @@ type TempTableLoader(fieldCount, items: obj seq) = interface IDataReader with member this.FieldCount: int = fieldCount member this.Read(): bool = enumerator.MoveNext() - member this.GetValue(i: int): obj = + member this.GetValue(i: int): obj = let row : obj[] = unbox enumerator.Current row.[i] member this.Dispose(): unit = () @@ -87,18 +87,18 @@ type TempTableLoader(fieldCount, items: obj seq) = member __.RecordsAffected: int = invalidOp "NotImplementedException" -type DesignTime private() = +type DesignTime private() = static member internal AddGeneratedMethod (sqlParameters: Parameter list, hasOutputParameters, executeArgs: ProvidedParameter list, erasedType, providedOutputType, name) = - let mappedInputParamValues (exprArgs: Expr list) = + let mappedInputParamValues (exprArgs: Expr list) = (exprArgs.Tail, sqlParameters) ||> List.map2 (fun expr param -> - let value = + let value = if param.Direction = ParameterDirection.Input - then - if param.Optional && not param.TypeInfo.TableType - then + then + if param.Optional && not param.TypeInfo.TableType + then typeof .GetMethod("OptionToObj", BindingFlags.NonPublic ||| BindingFlags.Static) .MakeGenericMethod(param.TypeInfo.ClrType) @@ -117,31 +117,31 @@ type DesignTime private() = ) let m = ProvidedMethod(name, executeArgs, providedOutputType) - + m.InvokeCode <- fun exprArgs -> let methodInfo = typeof.GetMethod(name) let vals = mappedInputParamValues(exprArgs) let paramValues = Expr.NewArray( typeof, elements = vals) if not hasOutputParameters - then - Expr.Call( Expr.Coerce( exprArgs.[0], erasedType), methodInfo, [ paramValues ]) + then + Expr.Call( Expr.Coerce( exprArgs.[0], erasedType), methodInfo, [ paramValues ]) else - let mapOutParamValues = + let mapOutParamValues = let arr = Var("parameters", typeof<(string * obj)[]>) - let body = + let body = (sqlParameters, exprArgs.Tail) ||> List.zip |> List.mapi (fun index (sqlParam, argExpr) -> if sqlParam.Direction.HasFlag( ParameterDirection.Output) - then - let mi = + then + let mi = typeof .GetMethod("SetRef") .MakeGenericMethod( sqlParam.TypeInfo.ClrType) Expr.Call(mi, [ argExpr; Expr.Var arr; Expr.Value index ]) |> Some - else + else None - ) + ) |> List.choose id |> List.fold (fun acc x -> Expr.Sequential(acc, x)) <@@ () @@> @@ -156,7 +156,7 @@ type DesignTime private() = result @@> - let xmlDoc = + let xmlDoc = sqlParameters |> Seq.choose (fun p -> if String.IsNullOrWhiteSpace p.Description @@ -165,36 +165,36 @@ type DesignTime private() = let defaultConstrain = if p.DefaultValue.IsSome then sprintf " Default value: %O." p.DefaultValue.Value else "" Some( sprintf "%O%s" p.Name p.Description defaultConstrain) ) - |> String.concat "\n" + |> String.concat "\n" if not(String.IsNullOrWhiteSpace xmlDoc) then m.AddXmlDoc xmlDoc m - static member SetRef<'t>(r : byref<'t>, arr: (string * obj)[], i) = + static member SetRef<'t>(r : byref<'t>, arr: (string * obj)[], i) = r <- arr.[i] |> snd |> unbox static member internal GetRecordType(columns: Column list, ?unitsOfMeasurePerSchema) = - - columns - |> Seq.groupBy (fun x -> x.Name) + + columns + |> Seq.groupBy (fun x -> x.Name) |> Seq.tryFind (fun (_, xs) -> Seq.length xs > 1) |> Option.iter (fun (name, _) -> failwithf "Non-unique column name %s is illegal for ResultType.Records." name) - + let recordType = ProvidedTypeDefinition("Record", baseType = Some typeof, HideObjectMethods = true) - let properties, ctorParameters = + let properties, ctorParameters = columns |> List.mapi ( fun i col -> let propertyName = col.Name if propertyName = "" then failwithf "Column #%i doesn't have name. Only columns with names accepted. Use explicit alias." (i + 1) - + let propType = col.GetProvidedType(?unitsOfMeasurePerSchema = unitsOfMeasurePerSchema) let property = ProvidedProperty(propertyName, propType) property.GetterCode <- fun args -> <@@ (unbox %%args.[0]).[propertyName] @@> - let ctorParameter = ProvidedParameter(propertyName, propType) + let ctorParameter = ProvidedParameter(propertyName, propType) property, ctorParameter ) @@ -210,9 +210,9 @@ type DesignTime private() = <@@ let pairs : (string * obj) [] = %%Expr.NewArray(typeof, pairs) DynamicRecord (dict pairs) - @@> + @@> recordType.AddMember ctor - + recordType static member internal GetDataRowPropertyGetterAndSetterCode (column: Column) = @@ -226,7 +226,7 @@ type DesignTime private() = let setter = QuotationsFactory.GetBody("SetNonNullableValueInDataRow", column.TypeInfo.ClrType, name) getter, setter - static member internal GetDataRowType (columns: Column list, ?unitsOfMeasurePerSchema) = + static member internal GetDataRowType (columns: Column list, ?unitsOfMeasurePerSchema) = let rowType = ProvidedTypeDefinition("Row", Some typeof) columns |> List.mapi(fun i col -> @@ -240,7 +240,7 @@ type DesignTime private() = if not col.ReadOnly then property.SetterCode <- setter - + property ) |> rowType.AddMembers @@ -250,28 +250,28 @@ type DesignTime private() = static member internal GetDataTableType(typeName, dataRowType: ProvidedTypeDefinition, outputColumns: Column list) = let tableType = ProvidedTypeBuilder.MakeGenericType(typedefof<_ DataTable>, [ dataRowType ]) let tableProvidedType = ProvidedTypeDefinition(typeName, Some tableType) - + let columnsType = ProvidedTypeDefinition("Columns", Some typeof) let columnsProperty = ProvidedProperty("Columns", columnsType) tableProvidedType.AddMember columnsType - + columnsProperty.GetterCode <- - fun args -> + fun args -> <@@ let table : DataTable = %%args.[0] table.Columns @@> tableProvidedType.AddMember columnsProperty - + for column in outputColumns do let propertyType = ProvidedTypeDefinition(column.Name, Some typeof) let property = ProvidedProperty(column.Name, propertyType) - - property.GetterCode <- fun args -> + + property.GetterCode <- fun args -> let columnName = column.Name - <@@ + <@@ let columns: DataColumnCollection = %%args.[0] columns.[columnName] @@> @@ -284,7 +284,7 @@ type DesignTime private() = ProvidedProperty( "Table" , tableProvidedType - , GetterCode = + , GetterCode = fun args -> <@@ let row : DataRow = %%args.[0] @@ -296,14 +296,14 @@ type DesignTime private() = tableProvidedType - static member internal GetOutputTypes (outputColumns: Column list, resultType, rank: ResultRank, hasOutputParameters, ?unitsOfMeasurePerSchema) = - if resultType = ResultType.DataReader - then + static member internal GetOutputTypes (outputColumns: Column list, resultType, rank: ResultRank, hasOutputParameters, ?unitsOfMeasurePerSchema) = + if resultType = ResultType.DataReader + then { Single = typeof; PerRow = None } elif outputColumns.IsEmpty - then + then { Single = typeof; PerRow = None } - elif resultType = ResultType.DataTable + elif resultType = ResultType.DataTable then let dataRowType = DesignTime.GetDataRowType(outputColumns, ?unitsOfMeasurePerSchema = unitsOfMeasurePerSchema) let dataTableType = DesignTime.GetDataTableType("Table", dataRowType, outputColumns) @@ -311,8 +311,8 @@ type DesignTime private() = { Single = dataTableType; PerRow = None } - else - let providedRowType, erasedToRowType, rowMapping = + else + let providedRowType, erasedToRowType, rowMapping = if List.length outputColumns = 1 then let column0 = outputColumns.Head @@ -320,30 +320,30 @@ type DesignTime private() = let provided = column0.GetProvidedType(?unitsOfMeasurePerSchema = unitsOfMeasurePerSchema) let values = Var("values", typeof) let indexGet = Expr.Call(Expr.Var values, typeof.GetMethod("GetValue",[|typeof|]), [Expr.Value 0]) - provided, erasedTo, Expr.Lambda(values, indexGet) + provided, erasedTo, Expr.Lambda(values, indexGet) - elif resultType = ResultType.Records - then + elif resultType = ResultType.Records + then let provided = DesignTime.GetRecordType(outputColumns, ?unitsOfMeasurePerSchema = unitsOfMeasurePerSchema) - let names = Expr.NewArray(typeof, outputColumns |> List.map (fun x -> Expr.Value(x.Name))) - let mapping = - <@@ - fun (values: obj[]) -> + let names = Expr.NewArray(typeof, outputColumns |> List.map (fun x -> Expr.Value(x.Name))) + let mapping = + <@@ + fun (values: obj[]) -> let data = Dictionary() let names: string[] = %%names - for i = 0 to names.Length - 1 do + for i = 0 to names.Length - 1 do data.Add(names.[i], values.[i]) - DynamicRecord( data) |> box + DynamicRecord( data) |> box @@> upcast provided, typeof, mapping - else - let erasedToTupleType = + else + let erasedToTupleType = match outputColumns with | [ x ] -> x.ErasedToType | xs -> Microsoft.FSharp.Reflection.FSharpType.MakeTupleType [| for x in xs -> x.ErasedToType |] - let providedType = + let providedType = match outputColumns with | [ x ] -> x.GetProvidedType() | xs -> Microsoft.FSharp.Reflection.FSharpType.MakeTupleType [| for x in xs -> x.GetProvidedType(?unitsOfMeasurePerSchema = unitsOfMeasurePerSchema) |] @@ -351,94 +351,94 @@ type DesignTime private() = let clrTypeName = erasedToTupleType.FullName let mapping = <@@ Microsoft.FSharp.Reflection.FSharpValue.PreComputeTupleConstructor (Type.GetType(clrTypeName, throwOnError = true)) @@> providedType, erasedToTupleType, mapping - - let nullsToOptions = QuotationsFactory.MapArrayNullableItems(outputColumns, "MapArrayObjItemToOption") - let combineWithNullsToOptions = typeof.GetMethod("GetMapperWithNullsToOptions") - - { - Single = + + let nullsToOptions = QuotationsFactory.MapArrayNullableItems(outputColumns, "MapArrayObjItemToOption") + let combineWithNullsToOptions = typeof.GetMethod("GetMapperWithNullsToOptions") + + { + Single = match rank with | ResultRank.ScalarValue -> providedRowType | ResultRank.SingleRow -> ProvidedTypeBuilder.MakeGenericType(typedefof<_ option>, [ providedRowType ]) - | ResultRank.Sequence -> + | ResultRank.Sequence -> let collectionType = if hasOutputParameters then typedefof<_ list> else typedefof<_ seq> ProvidedTypeBuilder.MakeGenericType( collectionType, [ providedRowType ]) | unexpected -> failwithf "Unexpected ResultRank value: %A" unexpected - PerRow = Some { + PerRow = Some { Provided = providedRowType ErasedTo = erasedToRowType - Mapping = Expr.Call( combineWithNullsToOptions, [ nullsToOptions; rowMapping ]) - } + Mapping = Expr.Call( combineWithNullsToOptions, [ nullsToOptions; rowMapping ]) + } } - static member internal GetOutputColumns (connection: SqlConnection, commandText, parameters: Parameter list, isStoredProcedure) = + static member internal GetOutputColumns (connection: SqlConnection, commandText, parameters: Parameter list, isStoredProcedure) = try - connection.GetFullQualityColumnInfo(commandText) + connection.GetFullQualityColumnInfo(commandText) with :? SqlException as why -> - try + try let commandType = if isStoredProcedure then CommandType.StoredProcedure else CommandType.Text - connection.FallbackToSETFMONLY(commandText, commandType, parameters) + connection.FallbackToSETFMONLY(commandText, commandType, parameters) with :? SqlException -> raise why - static member internal ParseParameterInfo(cmd: SqlCommand) = + static member internal ParseParameterInfo(cmd: SqlCommand) = cmd.ExecuteQuery(fun cursor -> - string cursor.["name"], - unbox cursor.["suggested_system_type_id"], + string cursor.["name"], + unbox cursor.["suggested_system_type_id"], cursor.TryGetValue "suggested_user_type_id", unbox cursor.["suggested_is_output"], unbox cursor.["suggested_is_input"], cursor.["suggested_max_length"] |> unbox |> int, unbox cursor.["suggested_precision"] |> unbox, unbox cursor.["suggested_scale"] |> unbox - ) + ) + + static member internal ExtractParameters(connection, commandText: string, allParametersOptional) = - static member internal ExtractParameters(connection, commandText: string, allParametersOptional) = - use cmd = new SqlCommand("sys.sp_describe_undeclared_parameters", connection, CommandType = CommandType.StoredProcedure) cmd.Parameters.AddWithValue("@tsql", commandText) |> ignore - let parameters = + let parameters = try DesignTime.ParseParameterInfo( cmd) |> Seq.toArray - with + with | :? SqlException as why when why.Class = 16uy && why.Number = 11508 && why.State = 1uy && why.ErrorCode = -2146232060 -> match DesignTime.RewriteSqlStatementToEnableMoreThanOneParameterDeclaration(cmd, why) with | Some x -> x | None -> reraise() - | _ -> + | _ -> reraise() parameters |> Seq.map(fun (name, sqlEngineTypeId, userTypeId, is_output, is_input, max_length, precision, scale) -> - let direction = + let direction = if is_output - then + then invalidArg name "Output parameters are not supported" - else + else assert(is_input) - ParameterDirection.Input - + ParameterDirection.Input + let typeInfo = findTypeInfoBySqlEngineTypeId(connection.ConnectionString, sqlEngineTypeId, userTypeId) - { + { Name = name - TypeInfo = typeInfo - Direction = direction - MaxLength = max_length - Precision = precision - Scale = scale + TypeInfo = typeInfo + Direction = direction + MaxLength = max_length + Precision = precision + Scale = scale DefaultValue = None - Optional = allParametersOptional - Description = null + Optional = allParametersOptional + Description = null } ) |> Seq.toList - static member internal RewriteSqlStatementToEnableMoreThanOneParameterDeclaration(cmd: SqlCommand, why: SqlException) = - - let getVariables tsql = + static member internal RewriteSqlStatementToEnableMoreThanOneParameterDeclaration(cmd: SqlCommand, why: SqlException) = + + let getVariables tsql = let parser = Microsoft.SqlServer.TransactSql.ScriptDom.TSql120Parser( true) let tsqlReader = new System.IO.StringReader(tsql) let errors = ref Unchecked.defaultof<_> @@ -449,20 +449,20 @@ type DesignTime private() = fragment.Accept { new Microsoft.SqlServer.TransactSql.ScriptDom.TSqlFragmentVisitor() with - member __.Visit(node : Microsoft.SqlServer.TransactSql.ScriptDom.VariableReference) = + member __.Visit(node : Microsoft.SqlServer.TransactSql.ScriptDom.VariableReference) = base.Visit node allVars.Add(node.Name, node.StartOffset, node.FragmentLength) - member __.Visit(node : Microsoft.SqlServer.TransactSql.ScriptDom.DeclareVariableElement) = + member __.Visit(node : Microsoft.SqlServer.TransactSql.ScriptDom.DeclareVariableElement) = base.Visit node declaredVars.Add(node.VariableName.Value) } - let unboundVars = - allVars + let unboundVars = + allVars |> Seq.groupBy (fun (name, _, _) -> name) - |> Seq.choose (fun (name, xs) -> - if declaredVars.Contains name - then None - else Some(name, xs |> Seq.mapi (fun i (_, start, length) -> sprintf "%s%i" name i, start, length)) + |> Seq.choose (fun (name, xs) -> + if declaredVars.Contains name + then None + else Some(name, xs |> Seq.mapi (fun i (_, start, length) -> sprintf "%s%i" name i, start, length)) ) |> dict @@ -471,11 +471,11 @@ type DesignTime private() = let mutable tsql = cmd.Parameters.["@tsql"].Value.ToString() let unboundVars, parseErrors = getVariables tsql if parseErrors.Count = 0 - then - let usedMoreThanOnceVariable = + then + let usedMoreThanOnceVariable = why.Message.Replace("The undeclared parameter '", "").Replace("' is used more than once in the batch being analyzed.", "") Debug.Assert( - unboundVars.Keys.Contains( usedMoreThanOnceVariable), + unboundVars.Keys.Contains( usedMoreThanOnceVariable), sprintf "Could not find %s among extracted unbound vars: %O" usedMoreThanOnceVariable (List.ofSeq unboundVars.Keys) ) let mutable startAdjustment = 0 @@ -489,12 +489,12 @@ type DesignTime private() = cmd.Parameters.["@tsql"].Value <- tsql let altered = DesignTime.ParseParameterInfo cmd let mapBack = unboundVars |> Seq.collect(fun (KeyValue(name, xs)) -> [ for newName, _, _ in xs -> newName, name ]) |> dict - let tryUnify = + let tryUnify = altered - |> Seq.map (fun (name, sqlEngineTypeId, userTypeId, suggested_is_output, suggested_is_input, max_length, precision, scale) -> - let oldName = - match mapBack.TryGetValue name with - | true, original -> original + |> Seq.map (fun (name, sqlEngineTypeId, userTypeId, suggested_is_output, suggested_is_input, max_length, precision, scale) -> + let oldName = + match mapBack.TryGetValue name with + | true, original -> original | false, _ -> name oldName, (sqlEngineTypeId, userTypeId, suggested_is_output, suggested_is_input, max_length, precision, scale) ) @@ -503,11 +503,11 @@ type DesignTime private() = |> Seq.toArray if tryUnify |> Array.exists( fun (_, xs) -> xs.Length > 1) - then + then None else - tryUnify - |> Array.map (fun (name, xs) -> + tryUnify + |> Array.map (fun (name, xs) -> let sqlEngineTypeId, userTypeId, suggested_is_output, suggested_is_input, max_length, precision, scale = xs.[0] //|> Seq.exactlyOne name, sqlEngineTypeId, userTypeId, suggested_is_output, suggested_is_input, max_length, precision, scale ) @@ -515,29 +515,29 @@ type DesignTime private() = else None - static member internal CreateUDTT(t: TypeInfo) = + static member internal CreateUDTT(t: TypeInfo) = assert(t.TableType) let rowType = ProvidedTypeDefinition(t.UdttName, Some typeof, HideObjectMethods = true) - let parameters, sqlMetas = - List.unzip [ + let parameters, sqlMetas = + List.unzip [ for p in t.TableTypeColumns.Value do let name = p.Name - let param = ProvidedParameter( name, p.GetProvidedType(), ?optionalValue = if p.Nullable then Some null else None) + let param = ProvidedParameter( name, p.GetProvidedType(), ?optionalValue = if p.Nullable then Some null else None) let sqlMeta = let dbType = p.TypeInfo.SqlDbType if p.TypeInfo.IsFixedLength then <@@ SqlMetaData(name, dbType) @@> - else + else let maxLength = p.MaxLength <@@ SqlMetaData(name, dbType, int64 maxLength) @@> yield param, sqlMeta - ] + ] let ctor = ProvidedConstructor( parameters) - ctor.InvokeCode <- fun args -> - let optionsToNulls = QuotationsFactory.MapArrayNullableItems(List.ofArray t.TableTypeColumns.Value, "MapArrayOptionItemToObj") + ctor.InvokeCode <- fun args -> + let optionsToNulls = QuotationsFactory.MapArrayNullableItems(List.ofArray t.TableTypeColumns.Value, "MapArrayOptionItemToObj") <@@ let values: obj[] = %%Expr.NewArray(typeof, [ for a in args -> Expr.Coerce(a, typeof) ]) @@ -555,37 +555,37 @@ type DesignTime private() = @@> rowType.AddMember ctor rowType.AddXmlDoc "User-Defined Table Type" - + rowType - static member internal GetExecuteArgs(cmdProvidedType: ProvidedTypeDefinition, sqlParameters: Parameter list, udttsPerSchema: Dictionary<_, ProvidedTypeDefinition>, ?unitsOfMeasurePerSchema) = + static member internal GetExecuteArgs(cmdProvidedType: ProvidedTypeDefinition, sqlParameters: Parameter list, udttsPerSchema: Dictionary<_, ProvidedTypeDefinition>, ?unitsOfMeasurePerSchema) = [ for p in sqlParameters do assert p.Name.StartsWith("@") let parameterName = p.Name.Substring 1 - yield - if not p.TypeInfo.TableType + yield + if not p.TypeInfo.TableType then - if p.Optional - then + if p.Optional + then assert(p.Direction = ParameterDirection.Input) ProvidedParameter(parameterName, parameterType = typedefof<_ option>.MakeGenericType( p.TypeInfo.ClrType) , optionalValue = null) else if p.Direction.HasFlag(ParameterDirection.Output) then ProvidedParameter(parameterName, parameterType = p.TypeInfo.ClrType.MakeByRefType(), isOut = true) - else + else ProvidedParameter(parameterName, parameterType = p.GetProvidedType(?unitsOfMeasurePerSchema = unitsOfMeasurePerSchema), ?optionalValue = p.DefaultValue) else assert(p.Direction = ParameterDirection.Input) - let userDefinedTableTypeRow = + let userDefinedTableTypeRow = if udttsPerSchema = null then //SqlCommandProvider case - match cmdProvidedType.GetNestedType(p.TypeInfo.UdttName) with - | null -> + match cmdProvidedType.GetNestedType(p.TypeInfo.UdttName) with + | null -> let rowType = DesignTime.CreateUDTT(p.TypeInfo) cmdProvidedType.AddMember rowType rowType @@ -595,73 +595,73 @@ type DesignTime private() = downcast udtt ProvidedParameter( - parameterName, + parameterName, parameterType = ProvidedTypeBuilder.MakeGenericType(typedefof<_ seq>, [ userDefinedTableTypeRow ]) ) ] - static member internal GetCommandCtors(cmdProvidedType: ProvidedTypeDefinition, designTimeConfig, (designTimeConnectionString:DesignTimeConnectionString), isHostedExecution, ?factoryMethodName) = + static member internal GetCommandCtors(cmdProvidedType: ProvidedTypeDefinition, designTimeConfig, (designTimeConnectionString:DesignTimeConnectionString), isHostedExecution, ?factoryMethodName) = [ let ctorImpl = typeof<``ISqlCommand Implementation``>.GetConstructor [| typeof; typeof; typeof |] - let parameters1 = [ - ProvidedParameter("connectionString", typeof) - ProvidedParameter("commandTimeout", typeof, optionalValue = SqlCommand.DefaultTimeout) + let parameters1 = [ + ProvidedParameter("connectionString", typeof) + ProvidedParameter("commandTimeout", typeof, optionalValue = SqlCommand.DefaultTimeout) ] - let body1 (args: _ list) = + let body1 (args: _ list) = Expr.NewObject(ctorImpl, designTimeConfig :: <@@ Connection.Choice1Of3 %%args.Head @@> :: args.Tail) yield ProvidedConstructor(parameters1, InvokeCode = body1) :> MemberInfo - + if factoryMethodName.IsSome - then + then yield upcast ProvidedMethod(factoryMethodName.Value, parameters1, returnType = cmdProvidedType, IsStaticMethod = true, InvokeCode = body1) - - let parameters2 = - [ + + let parameters2 = + [ ProvidedParameter( - "connection", + "connection", typeof, ?optionalValue = if designTimeConnectionString.IsDefinedByLiteral then None else Some null - ) - ProvidedParameter("transaction", typeof, optionalValue = null) - ProvidedParameter("commandTimeout", typeof, optionalValue = SqlCommand.DefaultTimeout) + ) + ProvidedParameter("transaction", typeof, optionalValue = null) + ProvidedParameter("commandTimeout", typeof, optionalValue = SqlCommand.DefaultTimeout) ] let connectionStringExpr = designTimeConnectionString.RunTimeValueExpr(isHostedExecution) let body2 (args: _ list) = - let connArg = - <@@ - if box (%%args.[1]: SqlTransaction) <> null + let connArg = + <@@ + if box (%%args.[1]: SqlTransaction) <> null then Connection.Choice3Of3 %%args.[1] - elif box (%%args.[0]: SqlConnection) <> null - then Connection.Choice2Of3 %%args.Head + elif box (%%args.[0]: SqlConnection) <> null + then Connection.Choice2Of3 %%args.Head else Connection.Choice1Of3( %%connectionStringExpr) @@> Expr.NewObject(ctorImpl, [ designTimeConfig ; connArg; args.[2] ]) - + yield upcast ProvidedConstructor(parameters2, InvokeCode = body2) if factoryMethodName.IsSome - then + then yield upcast ProvidedMethod(factoryMethodName.Value, parameters2, returnType = cmdProvidedType, IsStaticMethod = true, InvokeCode = body2) ] static member private CreateTempTableRecord(name, cols) = let rowType = ProvidedTypeDefinition(name, Some typeof, HideObjectMethods = true) - let parameters = - [ + let parameters = + [ for (p : Column) in cols do let name = p.Name - let param = ProvidedParameter( name, p.GetProvidedType(), ?optionalValue = if p.Nullable then Some null else None) + let param = ProvidedParameter( name, p.GetProvidedType(), ?optionalValue = if p.Nullable then Some null else None) yield param - ] + ] let ctor = ProvidedConstructor( parameters) - ctor.InvokeCode <- fun args -> - let optionsToNulls = QuotationsFactory.MapArrayNullableItems(cols, "MapArrayOptionItemToObj") + ctor.InvokeCode <- fun args -> + let optionsToNulls = QuotationsFactory.MapArrayNullableItems(cols, "MapArrayOptionItemToObj") <@@ let values: obj[] = %%Expr.NewArray(typeof, [ for a in args -> Expr.Coerce(a, typeof) ]) (%%optionsToNulls) values @@ -669,12 +669,13 @@ type DesignTime private() = rowType.AddMember ctor rowType.AddXmlDoc "Type Table Type" - + rowType - static member internal SubstituteTempTables(connection, commandText: string, tempTableDefinitions : string) = + // Changes any temp tables in to a global temp table (##name) then creates them on the open connection. + static member internal SubstituteTempTables(connection, commandText: string, tempTableDefinitions : string, connectionId) = + // Extract and temp tables let tempTableRegex = Regex("#([a-z0-9\-_]+)", RegexOptions.IgnoreCase) - let tempTableNames = tempTableRegex.Matches(tempTableDefinitions) |> Seq.cast @@ -683,8 +684,9 @@ type DesignTime private() = match tempTableNames with | [] -> commandText, None - | _ -> - let tableTypes = + | _ -> + // Create temp table(s), extracts the columns then drop it. + let tableTypes = use create = new SqlCommand(tempTableDefinitions, connection) create.ExecuteScalar() |> ignore @@ -695,35 +697,29 @@ type DesignTime private() = drop.ExecuteScalar() |> ignore DesignTime.CreateTempTableRecord(name, cols), cols) - let parameters = + let parameters = tableTypes |> List.map (fun (typ, _) -> ProvidedParameter(typ.Name, parameterType = ProvidedTypeBuilder.MakeGenericType(typedefof<_ seq>, [ typ ]))) - let loadValues (exprArgs: Expr list) (connection) = + // Build the values load method. + let loadValues (exprArgs: Expr list) (connection) = (exprArgs.Tail, tableTypes) ||> List.map2 (fun expr (typ, cols) -> - let dest = typ.Name - - //let columnsNames, columnsTypeNames = - // cols - // |> List.map(fun c -> c.Name, c.TypeInfo.TypeName) - // |> List.toArray - // |> Array.unzip - - let len = cols.Length + let destinationTableName = typ.Name + let colsLength = cols.Length - <@@ + <@@ let items = (%%expr : obj seq) - use reader = new TempTableLoader(len, items) + use reader = new TempTableLoader(colsLength, items) - use bulkCopy = new SqlBulkCopy((%%connection : SqlConnection)) + use bulkCopy = new SqlBulkCopy((%%connection : SqlConnection)) bulkCopy.BulkCopyTimeout <- 0 bulkCopy.BatchSize <- 5000 - bulkCopy.DestinationTableName <- "#" + dest + bulkCopy.DestinationTableName <- "#" + destinationTableName bulkCopy.WriteToServer(reader) - @@> + @@> ) |> List.fold (fun acc x -> Expr.Sequential(acc, x)) <@@ () @@> @@ -744,35 +740,37 @@ type DesignTime private() = (%%loadValues exprArgs connection) ignore() @@> - use cmd = new SqlCommand(tempTableRegex.Replace(tempTableDefinitions, Prefixes.tempTable+"$1"), connection) + // Create the temp table(s) but as a global temp table with a unique name. This can be used later down stream on the open connection. + use cmd = new SqlCommand(tempTableRegex.Replace(tempTableDefinitions, Prefixes.tempTable+connectionId+"$1"), connection) cmd.ExecuteScalar() |> ignore // Only replace temp tables we find in our list. - tempTableRegex.Replace(commandText, MatchEvaluator(fun m -> + tempTableRegex.Replace(commandText, MatchEvaluator(fun m -> match tempTableNames |> List.tryFind((=) m.Groups.[1].Value) with - | Some name -> Prefixes.tempTable + name + | Some name -> Prefixes.tempTable + connectionId + name | None -> m.Groups.[0].Value)), Some(loadTempTablesMethod, tableTypes |> List.unzip |> fst) - static member internal RemoveSubstitutedTempTables(connection, tempTables : ProvidedTypeDefinition list) = + static member internal RemoveSubstitutedTempTables(connection, tempTables : ProvidedTypeDefinition list, connectionId) = if not tempTables.IsEmpty then - use cmd = new SqlCommand(tempTables |> List.map(fun tempTable -> sprintf "DROP TABLE [%s%s]" Prefixes.tempTable tempTable.Name) |> String.concat ";", connection) + use cmd = new SqlCommand(tempTables |> List.map(fun tempTable -> sprintf "DROP TABLE [%s%s%s]" Prefixes.tempTable connectionId tempTable.Name) |> String.concat ";", connection) cmd.ExecuteScalar() |> ignore + // tableVarMapping(s) is converted into DECLARE statements then prepended to the command text. static member internal SubstituteTableVar(commandText: string, tableVarMapping : string) = let varRegex = Regex("@([a-z0-9_]+)", RegexOptions.IgnoreCase) - let vars = + let vars = tableVarMapping.Split([|';'|], System.StringSplitOptions.RemoveEmptyEntries) - |> Array.choose(fun (x : string) -> + |> Array.choose(fun (x : string) -> match x.Split([|'='|]) with | [|name;typ|] -> Some(name.TrimStart('@'), typ) | _ -> None) // Only replace table vars we find in our list. - let commandText = - varRegex.Replace(commandText, MatchEvaluator(fun m -> + let commandText = + varRegex.Replace(commandText, MatchEvaluator(fun m -> match vars |> Array.tryFind(fun (n,_) -> n = m.Groups.[1].Value) with | Some (name, _) -> Prefixes.tableVar + name | None -> m.Groups.[0].Value)) diff --git a/src/SqlClient/SqlClient.fsproj b/src/SqlClient/SqlClient.fsproj index 6bf3b629..897eb7df 100644 --- a/src/SqlClient/SqlClient.fsproj +++ b/src/SqlClient/SqlClient.fsproj @@ -27,13 +27,12 @@ Program - C:\Program Files (x86)\Microsoft Visual Studio\2017\Professional\Common7\IDE\devenv.exe - Test.fsx + C:\Program Files (x86)\Microsoft Visual Studio 14.0\Common7\IDE\devenv.exe + ..\Tests.sln 101 --warnon:1182 false - C:\dev\Dare2 pdbonly diff --git a/src/SqlClient/SqlCommandProvider.fs b/src/SqlClient/SqlCommandProvider.fs index b2c37880..2289d684 100644 --- a/src/SqlClient/SqlCommandProvider.fs +++ b/src/SqlClient/SqlCommandProvider.fs @@ -28,7 +28,7 @@ do() [] [] -type SqlCommandProvider(config : TypeProviderConfig) as this = +type SqlCommandProvider(config : TypeProviderConfig) as this = inherit TypeProviderForNamespaces() let nameSpace = this.GetType().Namespace @@ -37,34 +37,34 @@ type SqlCommandProvider(config : TypeProviderConfig) as this = let cache = new MemoryCache(name = this.GetType().Name) - do + do this.Disposing.Add <| fun _ -> - try + try cache.Dispose() clearDataTypesMap() with _ -> () - do + do providerType.DefineStaticParameters( - parameters = [ - ProvidedStaticParameter("CommandText", typeof) - ProvidedStaticParameter("ConnectionStringOrName", typeof) - ProvidedStaticParameter("ResultType", typeof, ResultType.Records) - ProvidedStaticParameter("SingleRow", typeof, false) - ProvidedStaticParameter("ConfigFile", typeof, "") - ProvidedStaticParameter("AllParametersOptional", typeof, false) - ProvidedStaticParameter("DataDirectory", typeof, "") - ProvidedStaticParameter("TempTableDefinitions", typeof, "") - ProvidedStaticParameter("TableVarMapping", typeof, "") - ], + parameters = [ + ProvidedStaticParameter("CommandText", typeof) + ProvidedStaticParameter("ConnectionStringOrName", typeof) + ProvidedStaticParameter("ResultType", typeof, ResultType.Records) + ProvidedStaticParameter("SingleRow", typeof, false) + ProvidedStaticParameter("ConfigFile", typeof, "") + ProvidedStaticParameter("AllParametersOptional", typeof, false) + ProvidedStaticParameter("DataDirectory", typeof, "") + ProvidedStaticParameter("TempTableDefinitions", typeof, "") + ProvidedStaticParameter("TableVarMapping", typeof, "") + ], instantiationFunction = (fun typeName args -> let value = lazy this.CreateRootType(typeName, unbox args.[0], unbox args.[1], unbox args.[2], unbox args.[3], unbox args.[4], unbox args.[5], unbox args.[6], unbox args.[7], unbox args.[8]) cache.GetOrAdd(typeName, value) - ) + ) ) providerType.AddXmlDoc """ -Typed representation of a T-SQL statement to execute against a SQL Server database. +Typed representation of a T-SQL statement to execute against a SQL Server database. Transact-SQL statement to execute at the data source. String used to open a SQL Server database or the name of the connection string in the configuration file in the form of “name=<connection string name>”. A value that defines structure of result: Records, Tuples, DataTable, or SqlDataReader. @@ -79,25 +79,25 @@ type SqlCommandProvider(config : TypeProviderConfig) as this = this.AddNamespace(nameSpace, [ providerType ]) - override this.ResolveAssembly args = - config.ReferencedAssemblies - |> Array.tryFind (fun x -> AssemblyName.ReferenceMatchesDefinition(AssemblyName.GetAssemblyName x, AssemblyName args.Name)) + override this.ResolveAssembly args = + config.ReferencedAssemblies + |> Array.tryFind (fun x -> AssemblyName.ReferenceMatchesDefinition(AssemblyName.GetAssemblyName x, AssemblyName args.Name)) |> Option.map Assembly.LoadFrom - |> defaultArg + |> defaultArg <| base.ResolveAssembly args - member internal this.CreateRootType(typeName, sqlStatement, connectionStringOrName: string, resultType, singleRow, configFile, allParametersOptional, dataDirectory, tempTableDefinitions, tableVarMapping) = + member internal this.CreateRootType(typeName, sqlStatement, connectionStringOrName: string, resultType, singleRow, configFile, allParametersOptional, dataDirectory, tempTableDefinitions, tableVarMapping) = if singleRow && not (resultType = ResultType.Records || resultType = ResultType.Tuples) - then + then invalidArg "singleRow" "SingleRow can be set only for ResultType.Records or ResultType.Tuples." - + if connectionStringOrName.Trim() = "" - then invalidArg "ConnectionStringOrName" "Value is empty!" + then invalidArg "ConnectionStringOrName" "Value is empty!" let designTimeConnectionString = DesignTimeConnectionString.Parse(connectionStringOrName, config.ResolutionFolder, configFile) - let dataDirectoryFullPath = + let dataDirectoryFullPath = if dataDirectory = "" then config.ResolutionFolder elif Path.IsPathRooted dataDirectory then dataDirectory else Path.Combine (config.ResolutionFolder, dataDirectory) @@ -109,41 +109,51 @@ type SqlCommandProvider(config : TypeProviderConfig) as this = conn.CheckVersion() conn.LoadDataTypesMap() - let designTimeSqlStatement, tempTableTypes = - let sql, types = DesignTime.SubstituteTempTables(conn, sqlStatement, tempTableDefinitions) - DesignTime.SubstituteTableVar(sql, tableVarMapping), types + let connectionId = Guid.NewGuid().ToString().Substring(0, 8) + + let designTimeSqlStatement, tempTableTypes = + if String.IsNullOrWhiteSpace(tempTableDefinitions) then + sqlStatement, None + else + DesignTime.SubstituteTempTables(conn, sqlStatement, tempTableDefinitions, connectionId) + + let designTimeSqlStatement = + if String.IsNullOrWhiteSpace(tableVarMapping) then + designTimeSqlStatement + else + DesignTime.SubstituteTableVar(designTimeSqlStatement, tableVarMapping) let parameters = DesignTime.ExtractParameters(conn, designTimeSqlStatement, allParametersOptional) - let outputColumns = + let outputColumns = if resultType <> ResultType.DataReader then DesignTime.GetOutputColumns(conn, designTimeSqlStatement, parameters, isStoredProcedure = false) else [] let rank = if singleRow then ResultRank.SingleRow else ResultRank.Sequence let returnType = DesignTime.GetOutputTypes(outputColumns, resultType, rank, hasOutputParameters = false) - + let cmdProvidedType = ProvidedTypeDefinition(assembly, nameSpace, typeName, Some typeof<``ISqlCommand Implementation``>, HideObjectMethods = true) - + do match tempTableTypes with - | Some (loadTempTables, types) -> - DesignTime.RemoveSubstitutedTempTables(conn, types) + | Some (loadTempTables, types) -> + DesignTime.RemoveSubstitutedTempTables(conn, types, connectionId) cmdProvidedType.AddMember(loadTempTables) types |> List.iter(fun t -> cmdProvidedType.AddMember(t)) | _ -> () - do + do cmdProvidedType.AddMember(ProvidedProperty("ConnectionStringOrName", typeof, [], IsStatic = true, GetterCode = fun _ -> <@@ connectionStringOrName @@>)) do SharedLogic.alterReturnTypeAccordingToResultType returnType cmdProvidedType resultType do //ctors - let designTimeConfig = - let expectedDataReaderColumns = + let designTimeConfig = + let expectedDataReaderColumns = Expr.NewArray( - typeof, + typeof, [ for c in outputColumns -> Expr.NewTuple [ Expr.Value c.Name; Expr.Value c.TypeInfo.ClrTypeFullName ] ] ) @@ -160,9 +170,9 @@ type SqlCommandProvider(config : TypeProviderConfig) as this = do DesignTime.GetCommandCtors( - cmdProvidedType, - designTimeConfig, - designTimeConnectionString, + cmdProvidedType, + designTimeConfig, + designTimeConnectionString, config.IsHostedExecution, factoryMethodName = "Create" ) @@ -173,15 +183,15 @@ type SqlCommandProvider(config : TypeProviderConfig) as this = let executeArgs = DesignTime.GetExecuteArgs(cmdProvidedType, parameters, udttsPerSchema = null) let hasOutputParameters = false - let addRedirectToISqlCommandMethod outputType name = - DesignTime.AddGeneratedMethod(parameters, hasOutputParameters, executeArgs, cmdProvidedType.BaseType, outputType, name) + let addRedirectToISqlCommandMethod outputType name = + DesignTime.AddGeneratedMethod(parameters, hasOutputParameters, executeArgs, cmdProvidedType.BaseType, outputType, name) |> cmdProvidedType.AddMember - addRedirectToISqlCommandMethod returnType.Single "Execute" - + addRedirectToISqlCommandMethod returnType.Single "Execute" + let asyncReturnType = ProvidedTypeBuilder.MakeGenericType(typedefof<_ Async>, [ returnType.Single ]) - addRedirectToISqlCommandMethod asyncReturnType "AsyncExecute" + addRedirectToISqlCommandMethod asyncReturnType "AsyncExecute" - addRedirectToISqlCommandMethod typeof "ToTraceString" + addRedirectToISqlCommandMethod typeof "ToTraceString" cmdProvidedType From a7496859cc93f14b592c4d7039bd1102c6c7cb6f Mon Sep 17 00:00:00 2001 From: David Teasdale Date: Fri, 18 May 2018 14:46:47 +0100 Subject: [PATCH 10/18] Clean up whitespace changes --- src/SqlClient/AssemblyInfo.fs | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/src/SqlClient/AssemblyInfo.fs b/src/SqlClient/AssemblyInfo.fs index 9cc5187c..e3d6c29d 100644 --- a/src/SqlClient/AssemblyInfo.fs +++ b/src/SqlClient/AssemblyInfo.fs @@ -1,20 +1,17 @@ // Auto-Generated by FAKE; do not edit namespace System open System.Reflection -open System.Runtime.CompilerServices [] [] [] -[] -[] -[] +[] +[] do () module internal AssemblyVersionInformation = let [] AssemblyTitle = "SqlClient" let [] AssemblyProduct = "FSharp.Data.SqlClient" let [] AssemblyDescription = "SqlClient F# type providers" - let [] AssemblyVersion = "1.8.4" - let [] AssemblyFileVersion = "1.8.4" - let [] InternalsVisibleTo = "SqlClient.Tests" + let [] AssemblyVersion = "1.8.3" + let [] AssemblyFileVersion = "1.8.3" From 5ecc01a6279e0cbc15c29d25abcdde561dcb2132 Mon Sep 17 00:00:00 2001 From: David Teasdale Date: Fri, 18 May 2018 14:53:08 +0100 Subject: [PATCH 11/18] More white space --- src/SqlClient/DesignTime.fs | 326 ++++++++++++++-------------- src/SqlClient/SqlCommandProvider.fs | 78 +++---- 2 files changed, 202 insertions(+), 202 deletions(-) diff --git a/src/SqlClient/DesignTime.fs b/src/SqlClient/DesignTime.fs index befe339b..faaa5449 100644 --- a/src/SqlClient/DesignTime.fs +++ b/src/SqlClient/DesignTime.fs @@ -21,12 +21,12 @@ type internal RowType = { type internal ReturnType = { Single: Type PerRow: RowType option -} with - member this.RowMapping = +} with + member this.RowMapping = match this.PerRow with | Some x -> x.Mapping - | None -> Expr.Value Unchecked.defaultof - member this.RowTypeName = + | None -> Expr.Value Unchecked.defaultof + member this.RowTypeName = match this.PerRow with | Some x -> Expr.Value( x.ErasedTo.AssemblyQualifiedName) | None -> <@@ null: string @@> @@ -90,14 +90,14 @@ type DesignTime private() = static member internal AddGeneratedMethod (sqlParameters: Parameter list, hasOutputParameters, executeArgs: ProvidedParameter list, erasedType, providedOutputType, name) = - let mappedInputParamValues (exprArgs: Expr list) = + let mappedInputParamValues (exprArgs: Expr list) = (exprArgs.Tail, sqlParameters) ||> List.map2 (fun expr param -> - let value = + let value = if param.Direction = ParameterDirection.Input - then - if param.Optional && not param.TypeInfo.TableType - then + then + if param.Optional && not param.TypeInfo.TableType + then typeof .GetMethod("OptionToObj", BindingFlags.NonPublic ||| BindingFlags.Static) .MakeGenericMethod(param.TypeInfo.ClrType) @@ -116,31 +116,31 @@ type DesignTime private() = ) let m = ProvidedMethod(name, executeArgs, providedOutputType) - + m.InvokeCode <- fun exprArgs -> let methodInfo = typeof.GetMethod(name) let vals = mappedInputParamValues(exprArgs) let paramValues = Expr.NewArray( typeof, elements = vals) if not hasOutputParameters - then - Expr.Call( Expr.Coerce( exprArgs.[0], erasedType), methodInfo, [ paramValues ]) + then + Expr.Call( Expr.Coerce( exprArgs.[0], erasedType), methodInfo, [ paramValues ]) else - let mapOutParamValues = + let mapOutParamValues = let arr = Var("parameters", typeof<(string * obj)[]>) - let body = + let body = (sqlParameters, exprArgs.Tail) ||> List.zip |> List.mapi (fun index (sqlParam, argExpr) -> if sqlParam.Direction.HasFlag( ParameterDirection.Output) - then - let mi = + then + let mi = typeof .GetMethod("SetRef") .MakeGenericMethod( sqlParam.TypeInfo.ClrType) Expr.Call(mi, [ argExpr; Expr.Var arr; Expr.Value index ]) |> Some - else + else None - ) + ) |> List.choose id |> List.fold (fun acc x -> Expr.Sequential(acc, x)) <@@ () @@> @@ -155,7 +155,7 @@ type DesignTime private() = result @@> - let xmlDoc = + let xmlDoc = sqlParameters |> Seq.choose (fun p -> if String.IsNullOrWhiteSpace p.Description @@ -164,36 +164,36 @@ type DesignTime private() = let defaultConstrain = if p.DefaultValue.IsSome then sprintf " Default value: %O." p.DefaultValue.Value else "" Some( sprintf "%O%s" p.Name p.Description defaultConstrain) ) - |> String.concat "\n" + |> String.concat "\n" if not(String.IsNullOrWhiteSpace xmlDoc) then m.AddXmlDoc xmlDoc m - static member SetRef<'t>(r : byref<'t>, arr: (string * obj)[], i) = + static member SetRef<'t>(r : byref<'t>, arr: (string * obj)[], i) = r <- arr.[i] |> snd |> unbox static member internal GetRecordType(columns: Column list, ?unitsOfMeasurePerSchema) = - - columns - |> Seq.groupBy (fun x -> x.Name) + + columns + |> Seq.groupBy (fun x -> x.Name) |> Seq.tryFind (fun (_, xs) -> Seq.length xs > 1) |> Option.iter (fun (name, _) -> failwithf "Non-unique column name %s is illegal for ResultType.Records." name) - + let recordType = ProvidedTypeDefinition("Record", baseType = Some typeof, HideObjectMethods = true) - let properties, ctorParameters = + let properties, ctorParameters = columns |> List.mapi ( fun i col -> let propertyName = col.Name if propertyName = "" then failwithf "Column #%i doesn't have name. Only columns with names accepted. Use explicit alias." (i + 1) - + let propType = col.GetProvidedType(?unitsOfMeasurePerSchema = unitsOfMeasurePerSchema) let property = ProvidedProperty(propertyName, propType) property.GetterCode <- fun args -> <@@ (unbox %%args.[0]).[propertyName] @@> - let ctorParameter = ProvidedParameter(propertyName, propType) + let ctorParameter = ProvidedParameter(propertyName, propType) property, ctorParameter ) @@ -209,9 +209,9 @@ type DesignTime private() = <@@ let pairs : (string * obj) [] = %%Expr.NewArray(typeof, pairs) DynamicRecord (dict pairs) - @@> + @@> recordType.AddMember ctor - + recordType static member internal GetDataRowPropertyGetterAndSetterCode (column: Column) = @@ -225,7 +225,7 @@ type DesignTime private() = let setter = QuotationsFactory.GetBody("SetNonNullableValueInDataRow", column.TypeInfo.ClrType, name) getter, setter - static member internal GetDataRowType (columns: Column list, ?unitsOfMeasurePerSchema) = + static member internal GetDataRowType (columns: Column list, ?unitsOfMeasurePerSchema) = let rowType = ProvidedTypeDefinition("Row", Some typeof) columns |> List.mapi(fun i col -> @@ -239,7 +239,7 @@ type DesignTime private() = if not col.ReadOnly then property.SetterCode <- setter - + property ) |> rowType.AddMembers @@ -249,28 +249,28 @@ type DesignTime private() = static member internal GetDataTableType(typeName, dataRowType: ProvidedTypeDefinition, outputColumns: Column list) = let tableType = ProvidedTypeBuilder.MakeGenericType(typedefof<_ DataTable>, [ dataRowType ]) let tableProvidedType = ProvidedTypeDefinition(typeName, Some tableType) - + let columnsType = ProvidedTypeDefinition("Columns", Some typeof) let columnsProperty = ProvidedProperty("Columns", columnsType) tableProvidedType.AddMember columnsType - + columnsProperty.GetterCode <- - fun args -> + fun args -> <@@ let table : DataTable = %%args.[0] table.Columns @@> tableProvidedType.AddMember columnsProperty - + for column in outputColumns do let propertyType = ProvidedTypeDefinition(column.Name, Some typeof) let property = ProvidedProperty(column.Name, propertyType) - - property.GetterCode <- fun args -> + + property.GetterCode <- fun args -> let columnName = column.Name - <@@ + <@@ let columns: DataColumnCollection = %%args.[0] columns.[columnName] @@> @@ -281,14 +281,14 @@ type DesignTime private() = , [ProvidedParameter("row", dataRowType)] , column.ErasedToType ) - + let getter, setter = DesignTime.GetDataRowPropertyGetterAndSetterCode(column) - getValueMethod.InvokeCode <- - fun args -> + getValueMethod.InvokeCode <- + fun args -> // we don't care of args.[0] (the DataColumn) because getter code is already made for that column getter args.Tail - + let setValueMethod = ProvidedMethod( "SetValue" @@ -298,7 +298,7 @@ type DesignTime private() = ] , typeof ) - + setValueMethod.InvokeCode <- fun args -> // we don't care of args.[0] (the DataColumn) because setter code is already made for that column @@ -315,7 +315,7 @@ type DesignTime private() = ProvidedProperty( "Table" , tableProvidedType - , GetterCode = + , GetterCode = fun args -> <@@ let row : DataRow = %%args.[0] @@ -327,14 +327,14 @@ type DesignTime private() = tableProvidedType - static member internal GetOutputTypes (outputColumns: Column list, resultType, rank: ResultRank, hasOutputParameters, ?unitsOfMeasurePerSchema) = - if resultType = ResultType.DataReader - then + static member internal GetOutputTypes (outputColumns: Column list, resultType, rank: ResultRank, hasOutputParameters, ?unitsOfMeasurePerSchema) = + if resultType = ResultType.DataReader + then { Single = typeof; PerRow = None } elif outputColumns.IsEmpty - then + then { Single = typeof; PerRow = None } - elif resultType = ResultType.DataTable + elif resultType = ResultType.DataTable then let dataRowType = DesignTime.GetDataRowType(outputColumns, ?unitsOfMeasurePerSchema = unitsOfMeasurePerSchema) let dataTableType = DesignTime.GetDataTableType("Table", dataRowType, outputColumns) @@ -342,8 +342,8 @@ type DesignTime private() = { Single = dataTableType; PerRow = None } - else - let providedRowType, erasedToRowType, rowMapping = + else + let providedRowType, erasedToRowType, rowMapping = if List.length outputColumns = 1 then let column0 = outputColumns.Head @@ -351,30 +351,30 @@ type DesignTime private() = let provided = column0.GetProvidedType(?unitsOfMeasurePerSchema = unitsOfMeasurePerSchema) let values = Var("values", typeof) let indexGet = Expr.Call(Expr.Var values, typeof.GetMethod("GetValue",[|typeof|]), [Expr.Value 0]) - provided, erasedTo, Expr.Lambda(values, indexGet) + provided, erasedTo, Expr.Lambda(values, indexGet) - elif resultType = ResultType.Records - then + elif resultType = ResultType.Records + then let provided = DesignTime.GetRecordType(outputColumns, ?unitsOfMeasurePerSchema = unitsOfMeasurePerSchema) - let names = Expr.NewArray(typeof, outputColumns |> List.map (fun x -> Expr.Value(x.Name))) - let mapping = - <@@ - fun (values: obj[]) -> + let names = Expr.NewArray(typeof, outputColumns |> List.map (fun x -> Expr.Value(x.Name))) + let mapping = + <@@ + fun (values: obj[]) -> let data = Dictionary() let names: string[] = %%names - for i = 0 to names.Length - 1 do + for i = 0 to names.Length - 1 do data.Add(names.[i], values.[i]) - DynamicRecord( data) |> box + DynamicRecord( data) |> box @@> upcast provided, typeof, mapping - else - let erasedToTupleType = + else + let erasedToTupleType = match outputColumns with | [ x ] -> x.ErasedToType | xs -> Microsoft.FSharp.Reflection.FSharpType.MakeTupleType [| for x in xs -> x.ErasedToType |] - let providedType = + let providedType = match outputColumns with | [ x ] -> x.GetProvidedType() | xs -> Microsoft.FSharp.Reflection.FSharpType.MakeTupleType [| for x in xs -> x.GetProvidedType(?unitsOfMeasurePerSchema = unitsOfMeasurePerSchema) |] @@ -382,94 +382,94 @@ type DesignTime private() = let clrTypeName = erasedToTupleType.FullName let mapping = <@@ Microsoft.FSharp.Reflection.FSharpValue.PreComputeTupleConstructor (Type.GetType(clrTypeName, throwOnError = true)) @@> providedType, erasedToTupleType, mapping - - let nullsToOptions = QuotationsFactory.MapArrayNullableItems(outputColumns, "MapArrayObjItemToOption") - let combineWithNullsToOptions = typeof.GetMethod("GetMapperWithNullsToOptions") - - { - Single = + + let nullsToOptions = QuotationsFactory.MapArrayNullableItems(outputColumns, "MapArrayObjItemToOption") + let combineWithNullsToOptions = typeof.GetMethod("GetMapperWithNullsToOptions") + + { + Single = match rank with | ResultRank.ScalarValue -> providedRowType | ResultRank.SingleRow -> ProvidedTypeBuilder.MakeGenericType(typedefof<_ option>, [ providedRowType ]) - | ResultRank.Sequence -> + | ResultRank.Sequence -> let collectionType = if hasOutputParameters then typedefof<_ list> else typedefof<_ seq> ProvidedTypeBuilder.MakeGenericType( collectionType, [ providedRowType ]) | unexpected -> failwithf "Unexpected ResultRank value: %A" unexpected - PerRow = Some { + PerRow = Some { Provided = providedRowType ErasedTo = erasedToRowType - Mapping = Expr.Call( combineWithNullsToOptions, [ nullsToOptions; rowMapping ]) - } + Mapping = Expr.Call( combineWithNullsToOptions, [ nullsToOptions; rowMapping ]) + } } - static member internal GetOutputColumns (connection: SqlConnection, commandText, parameters: Parameter list, isStoredProcedure) = + static member internal GetOutputColumns (connection: SqlConnection, commandText, parameters: Parameter list, isStoredProcedure) = try - connection.GetFullQualityColumnInfo(commandText) + connection.GetFullQualityColumnInfo(commandText) with :? SqlException as why -> - try + try let commandType = if isStoredProcedure then CommandType.StoredProcedure else CommandType.Text - connection.FallbackToSETFMONLY(commandText, commandType, parameters) + connection.FallbackToSETFMONLY(commandText, commandType, parameters) with :? SqlException -> raise why - static member internal ParseParameterInfo(cmd: SqlCommand) = + static member internal ParseParameterInfo(cmd: SqlCommand) = cmd.ExecuteQuery(fun cursor -> - string cursor.["name"], - unbox cursor.["suggested_system_type_id"], + string cursor.["name"], + unbox cursor.["suggested_system_type_id"], cursor.TryGetValue "suggested_user_type_id", unbox cursor.["suggested_is_output"], unbox cursor.["suggested_is_input"], cursor.["suggested_max_length"] |> unbox |> int, unbox cursor.["suggested_precision"] |> unbox, unbox cursor.["suggested_scale"] |> unbox - ) - - static member internal ExtractParameters(connection, commandText: string, allParametersOptional) = + ) + static member internal ExtractParameters(connection, commandText: string, allParametersOptional) = + use cmd = new SqlCommand("sys.sp_describe_undeclared_parameters", connection, CommandType = CommandType.StoredProcedure) cmd.Parameters.AddWithValue("@tsql", commandText) |> ignore - let parameters = + let parameters = try DesignTime.ParseParameterInfo( cmd) |> Seq.toArray - with + with | :? SqlException as why when why.Class = 16uy && why.Number = 11508 && why.State = 1uy && why.ErrorCode = -2146232060 -> match DesignTime.RewriteSqlStatementToEnableMoreThanOneParameterDeclaration(cmd, why) with | Some x -> x | None -> reraise() - | _ -> + | _ -> reraise() parameters |> Seq.map(fun (name, sqlEngineTypeId, userTypeId, is_output, is_input, max_length, precision, scale) -> - let direction = + let direction = if is_output - then + then invalidArg name "Output parameters are not supported" - else + else assert(is_input) - ParameterDirection.Input - + ParameterDirection.Input + let typeInfo = findTypeInfoBySqlEngineTypeId(connection.ConnectionString, sqlEngineTypeId, userTypeId) - { + { Name = name - TypeInfo = typeInfo - Direction = direction - MaxLength = max_length - Precision = precision - Scale = scale + TypeInfo = typeInfo + Direction = direction + MaxLength = max_length + Precision = precision + Scale = scale DefaultValue = None - Optional = allParametersOptional - Description = null + Optional = allParametersOptional + Description = null } ) |> Seq.toList - static member internal RewriteSqlStatementToEnableMoreThanOneParameterDeclaration(cmd: SqlCommand, why: SqlException) = - - let getVariables tsql = + static member internal RewriteSqlStatementToEnableMoreThanOneParameterDeclaration(cmd: SqlCommand, why: SqlException) = + + let getVariables tsql = let parser = Microsoft.SqlServer.TransactSql.ScriptDom.TSql140Parser( true) let tsqlReader = new System.IO.StringReader(tsql) let errors = ref Unchecked.defaultof<_> @@ -480,20 +480,20 @@ type DesignTime private() = fragment.Accept { new Microsoft.SqlServer.TransactSql.ScriptDom.TSqlFragmentVisitor() with - member __.Visit(node : Microsoft.SqlServer.TransactSql.ScriptDom.VariableReference) = + member __.Visit(node : Microsoft.SqlServer.TransactSql.ScriptDom.VariableReference) = base.Visit node allVars.Add(node.Name, node.StartOffset, node.FragmentLength) - member __.Visit(node : Microsoft.SqlServer.TransactSql.ScriptDom.DeclareVariableElement) = + member __.Visit(node : Microsoft.SqlServer.TransactSql.ScriptDom.DeclareVariableElement) = base.Visit node declaredVars.Add(node.VariableName.Value) } - let unboundVars = - allVars + let unboundVars = + allVars |> Seq.groupBy (fun (name, _, _) -> name) - |> Seq.choose (fun (name, xs) -> - if declaredVars.Contains name - then None - else Some(name, xs |> Seq.mapi (fun i (_, start, length) -> sprintf "%s%i" name i, start, length)) + |> Seq.choose (fun (name, xs) -> + if declaredVars.Contains name + then None + else Some(name, xs |> Seq.mapi (fun i (_, start, length) -> sprintf "%s%i" name i, start, length)) ) |> dict @@ -502,11 +502,11 @@ type DesignTime private() = let mutable tsql = cmd.Parameters.["@tsql"].Value.ToString() let unboundVars, parseErrors = getVariables tsql if parseErrors.Count = 0 - then - let usedMoreThanOnceVariable = + then + let usedMoreThanOnceVariable = why.Message.Replace("The undeclared parameter '", "").Replace("' is used more than once in the batch being analyzed.", "") Debug.Assert( - unboundVars.Keys.Contains( usedMoreThanOnceVariable), + unboundVars.Keys.Contains( usedMoreThanOnceVariable), sprintf "Could not find %s among extracted unbound vars: %O" usedMoreThanOnceVariable (List.ofSeq unboundVars.Keys) ) let mutable startAdjustment = 0 @@ -520,12 +520,12 @@ type DesignTime private() = cmd.Parameters.["@tsql"].Value <- tsql let altered = DesignTime.ParseParameterInfo cmd let mapBack = unboundVars |> Seq.collect(fun (KeyValue(name, xs)) -> [ for newName, _, _ in xs -> newName, name ]) |> dict - let tryUnify = + let tryUnify = altered - |> Seq.map (fun (name, sqlEngineTypeId, userTypeId, suggested_is_output, suggested_is_input, max_length, precision, scale) -> - let oldName = - match mapBack.TryGetValue name with - | true, original -> original + |> Seq.map (fun (name, sqlEngineTypeId, userTypeId, suggested_is_output, suggested_is_input, max_length, precision, scale) -> + let oldName = + match mapBack.TryGetValue name with + | true, original -> original | false, _ -> name oldName, (sqlEngineTypeId, userTypeId, suggested_is_output, suggested_is_input, max_length, precision, scale) ) @@ -534,11 +534,11 @@ type DesignTime private() = |> Seq.toArray if tryUnify |> Array.exists( fun (_, xs) -> xs.Length > 1) - then + then None else - tryUnify - |> Array.map (fun (name, xs) -> + tryUnify + |> Array.map (fun (name, xs) -> let sqlEngineTypeId, userTypeId, suggested_is_output, suggested_is_input, max_length, precision, scale = xs.[0] //|> Seq.exactlyOne name, sqlEngineTypeId, userTypeId, suggested_is_output, suggested_is_input, max_length, precision, scale ) @@ -546,29 +546,29 @@ type DesignTime private() = else None - static member internal CreateUDTT(t: TypeInfo) = + static member internal CreateUDTT(t: TypeInfo) = assert(t.TableType) let rowType = ProvidedTypeDefinition(t.UdttName, Some typeof, HideObjectMethods = true) - let parameters, sqlMetas = - List.unzip [ + let parameters, sqlMetas = + List.unzip [ for p in t.TableTypeColumns.Value do let name = p.Name - let param = ProvidedParameter( name, p.GetProvidedType(), ?optionalValue = if p.Nullable then Some null else None) + let param = ProvidedParameter( name, p.GetProvidedType(), ?optionalValue = if p.Nullable then Some null else None) let sqlMeta = let dbType = p.TypeInfo.SqlDbType if p.TypeInfo.IsFixedLength then <@@ SqlMetaData(name, dbType) @@> - else + else let maxLength = p.MaxLength <@@ SqlMetaData(name, dbType, int64 maxLength) @@> yield param, sqlMeta - ] + ] let ctor = ProvidedConstructor( parameters) - ctor.InvokeCode <- fun args -> - let optionsToNulls = QuotationsFactory.MapArrayNullableItems(List.ofArray t.TableTypeColumns.Value, "MapArrayOptionItemToObj") + ctor.InvokeCode <- fun args -> + let optionsToNulls = QuotationsFactory.MapArrayNullableItems(List.ofArray t.TableTypeColumns.Value, "MapArrayOptionItemToObj") <@@ let values: obj[] = %%Expr.NewArray(typeof, [ for a in args -> Expr.Coerce(a, typeof) ]) @@ -586,37 +586,37 @@ type DesignTime private() = @@> rowType.AddMember ctor rowType.AddXmlDoc "User-Defined Table Type" - + rowType - - static member internal GetExecuteArgs(cmdProvidedType: ProvidedTypeDefinition, sqlParameters: Parameter list, udttsPerSchema: Dictionary<_, ProvidedTypeDefinition>, ?unitsOfMeasurePerSchema) = + + static member internal GetExecuteArgs(cmdProvidedType: ProvidedTypeDefinition, sqlParameters: Parameter list, udttsPerSchema: Dictionary<_, ProvidedTypeDefinition>, ?unitsOfMeasurePerSchema) = [ for p in sqlParameters do assert p.Name.StartsWith("@") let parameterName = p.Name.Substring 1 - yield - if not p.TypeInfo.TableType + yield + if not p.TypeInfo.TableType then - if p.Optional - then + if p.Optional + then assert(p.Direction = ParameterDirection.Input) ProvidedParameter(parameterName, parameterType = typedefof<_ option>.MakeGenericType( p.TypeInfo.ClrType) , optionalValue = null) else if p.Direction.HasFlag(ParameterDirection.Output) then ProvidedParameter(parameterName, parameterType = p.TypeInfo.ClrType.MakeByRefType(), isOut = true) - else + else ProvidedParameter(parameterName, parameterType = p.GetProvidedType(?unitsOfMeasurePerSchema = unitsOfMeasurePerSchema), ?optionalValue = p.DefaultValue) else assert(p.Direction = ParameterDirection.Input) - let userDefinedTableTypeRow = + let userDefinedTableTypeRow = if udttsPerSchema = null then //SqlCommandProvider case - match cmdProvidedType.GetNestedType(p.TypeInfo.UdttName) with - | null -> + match cmdProvidedType.GetNestedType(p.TypeInfo.UdttName) with + | null -> let rowType = DesignTime.CreateUDTT(p.TypeInfo) cmdProvidedType.AddMember rowType rowType @@ -626,56 +626,56 @@ type DesignTime private() = downcast udtt ProvidedParameter( - parameterName, + parameterName, parameterType = ProvidedTypeBuilder.MakeGenericType(typedefof<_ seq>, [ userDefinedTableTypeRow ]) ) ] - static member internal GetCommandCtors(cmdProvidedType: ProvidedTypeDefinition, designTimeConfig, (designTimeConnectionString:DesignTimeConnectionString), isHostedExecution, ?factoryMethodName) = + static member internal GetCommandCtors(cmdProvidedType: ProvidedTypeDefinition, designTimeConfig, (designTimeConnectionString:DesignTimeConnectionString), isHostedExecution, ?factoryMethodName) = [ let ctorImpl = typeof<``ISqlCommand Implementation``>.GetConstructor [| typeof; typeof; typeof |] - let parameters1 = [ - ProvidedParameter("connectionString", typeof) - ProvidedParameter("commandTimeout", typeof, optionalValue = SqlCommand.DefaultTimeout) + let parameters1 = [ + ProvidedParameter("connectionString", typeof) + ProvidedParameter("commandTimeout", typeof, optionalValue = SqlCommand.DefaultTimeout) ] - let body1 (args: _ list) = + let body1 (args: _ list) = Expr.NewObject(ctorImpl, designTimeConfig :: <@@ Connection.Choice1Of3 %%args.Head @@> :: args.Tail) yield ProvidedConstructor(parameters1, InvokeCode = body1) :> MemberInfo - + if factoryMethodName.IsSome - then + then yield upcast ProvidedMethod(factoryMethodName.Value, parameters1, returnType = cmdProvidedType, IsStaticMethod = true, InvokeCode = body1) - - let parameters2 = - [ + + let parameters2 = + [ ProvidedParameter( - "connection", + "connection", typeof, ?optionalValue = if designTimeConnectionString.IsDefinedByLiteral then None else Some null - ) - ProvidedParameter("transaction", typeof, optionalValue = null) - ProvidedParameter("commandTimeout", typeof, optionalValue = SqlCommand.DefaultTimeout) + ) + ProvidedParameter("transaction", typeof, optionalValue = null) + ProvidedParameter("commandTimeout", typeof, optionalValue = SqlCommand.DefaultTimeout) ] let connectionStringExpr = designTimeConnectionString.RunTimeValueExpr(isHostedExecution) let body2 (args: _ list) = - let connArg = - <@@ - if box (%%args.[1]: SqlTransaction) <> null + let connArg = + <@@ + if box (%%args.[1]: SqlTransaction) <> null then Connection.Choice3Of3 %%args.[1] - elif box (%%args.[0]: SqlConnection) <> null - then Connection.Choice2Of3 %%args.Head + elif box (%%args.[0]: SqlConnection) <> null + then Connection.Choice2Of3 %%args.Head else Connection.Choice1Of3( %%connectionStringExpr) @@> Expr.NewObject(ctorImpl, [ designTimeConfig ; connArg; args.[2] ]) - + yield upcast ProvidedConstructor(parameters2, InvokeCode = body2) if factoryMethodName.IsSome - then + then yield upcast ProvidedMethod(factoryMethodName.Value, parameters2, returnType = cmdProvidedType, IsStaticMethod = true, InvokeCode = body2) ] diff --git a/src/SqlClient/SqlCommandProvider.fs b/src/SqlClient/SqlCommandProvider.fs index 998b2173..32c3fc65 100644 --- a/src/SqlClient/SqlCommandProvider.fs +++ b/src/SqlClient/SqlCommandProvider.fs @@ -27,7 +27,7 @@ do() [] [] -type SqlCommandProvider(config : TypeProviderConfig) as this = +type SqlCommandProvider(config : TypeProviderConfig) as this = inherit TypeProviderForNamespaces() let nameSpace = this.GetType().Namespace @@ -36,34 +36,34 @@ type SqlCommandProvider(config : TypeProviderConfig) as this = let cache = new MemoryCache(name = this.GetType().Name) - do + do this.Disposing.Add <| fun _ -> - try + try cache.Dispose() clearDataTypesMap() with _ -> () - do + do providerType.DefineStaticParameters( - parameters = [ - ProvidedStaticParameter("CommandText", typeof) - ProvidedStaticParameter("ConnectionStringOrName", typeof) - ProvidedStaticParameter("ResultType", typeof, ResultType.Records) - ProvidedStaticParameter("SingleRow", typeof, false) - ProvidedStaticParameter("ConfigFile", typeof, "") - ProvidedStaticParameter("AllParametersOptional", typeof, false) - ProvidedStaticParameter("DataDirectory", typeof, "") + parameters = [ + ProvidedStaticParameter("CommandText", typeof) + ProvidedStaticParameter("ConnectionStringOrName", typeof) + ProvidedStaticParameter("ResultType", typeof, ResultType.Records) + ProvidedStaticParameter("SingleRow", typeof, false) + ProvidedStaticParameter("ConfigFile", typeof, "") + ProvidedStaticParameter("AllParametersOptional", typeof, false) + ProvidedStaticParameter("DataDirectory", typeof, "") ProvidedStaticParameter("TempTableDefinitions", typeof, "") ProvidedStaticParameter("TableVarMapping", typeof, "") ], instantiationFunction = (fun typeName args -> - let value = lazy this.CreateRootType(typeName, unbox args.[0], unbox args.[1], unbox args.[2], unbox args.[3], unbox args.[4], unbox args.[5], unbox args.[6], unbox args.[7], unbox args.[8]) + let value = lazy this.CreateRootType(typeName, unbox args.[0], unbox args.[1], unbox args.[2], unbox args.[3], unbox args.[4], unbox args.[5], unbox args.[6]) cache.GetOrAdd(typeName, value) - ) + ) ) providerType.AddXmlDoc """ -Typed representation of a T-SQL statement to execute against a SQL Server database. +Typed representation of a T-SQL statement to execute against a SQL Server database. Transact-SQL statement to execute at the data source. String used to open a SQL Server database or the name of the connection string in the configuration file in the form of “name=<connection string name>”. A value that defines structure of result: Records, Tuples, DataTable, or SqlDataReader. @@ -78,25 +78,25 @@ type SqlCommandProvider(config : TypeProviderConfig) as this = this.AddNamespace(nameSpace, [ providerType ]) - override this.ResolveAssembly args = - config.ReferencedAssemblies - |> Array.tryFind (fun x -> AssemblyName.ReferenceMatchesDefinition(AssemblyName.GetAssemblyName x, AssemblyName args.Name)) + override this.ResolveAssembly args = + config.ReferencedAssemblies + |> Array.tryFind (fun x -> AssemblyName.ReferenceMatchesDefinition(AssemblyName.GetAssemblyName x, AssemblyName args.Name)) |> Option.map Assembly.LoadFrom - |> defaultArg + |> defaultArg <| base.ResolveAssembly args - member internal this.CreateRootType(typeName, sqlStatement, connectionStringOrName: string, resultType, singleRow, configFile, allParametersOptional, dataDirectory, tempTableDefinitions, tableVarMapping) = + member internal this.CreateRootType(typeName, sqlStatement, connectionStringOrName: string, resultType, singleRow, configFile, allParametersOptional, dataDirectory) = if singleRow && not (resultType = ResultType.Records || resultType = ResultType.Tuples) - then + then invalidArg "singleRow" "SingleRow can be set only for ResultType.Records or ResultType.Tuples." - + if connectionStringOrName.Trim() = "" - then invalidArg "ConnectionStringOrName" "Value is empty!" + then invalidArg "ConnectionStringOrName" "Value is empty!" let designTimeConnectionString = DesignTimeConnectionString.Parse(connectionStringOrName, config.ResolutionFolder, configFile) - let dataDirectoryFullPath = + let dataDirectoryFullPath = if dataDirectory = "" then config.ResolutionFolder elif Path.IsPathRooted dataDirectory then dataDirectory else Path.Combine (config.ResolutionFolder, dataDirectory) @@ -124,17 +124,17 @@ type SqlCommandProvider(config : TypeProviderConfig) as this = let parameters = DesignTime.ExtractParameters(conn, designTimeSqlStatement, allParametersOptional) - let outputColumns = + let outputColumns = if resultType <> ResultType.DataReader then DesignTime.GetOutputColumns(conn, designTimeSqlStatement, parameters, isStoredProcedure = false) else [] let rank = if singleRow then ResultRank.SingleRow else ResultRank.Sequence let returnType = DesignTime.GetOutputTypes(outputColumns, resultType, rank, hasOutputParameters = false) - + let cmdProvidedType = ProvidedTypeDefinition(assembly, nameSpace, typeName, Some typeof<``ISqlCommand Implementation``>, HideObjectMethods = true) - do + do match tempTableTypes with | Some (loadTempTables, types) -> DesignTime.RemoveSubstitutedTempTables(conn, types, connectionId) @@ -149,10 +149,10 @@ type SqlCommandProvider(config : TypeProviderConfig) as this = SharedLogic.alterReturnTypeAccordingToResultType returnType cmdProvidedType resultType do //ctors - let designTimeConfig = - let expectedDataReaderColumns = + let designTimeConfig = + let expectedDataReaderColumns = Expr.NewArray( - typeof, + typeof, [ for c in outputColumns -> Expr.NewTuple [ Expr.Value c.Name; Expr.Value c.TypeInfo.ClrTypeFullName ] ] ) @@ -169,9 +169,9 @@ type SqlCommandProvider(config : TypeProviderConfig) as this = do DesignTime.GetCommandCtors( - cmdProvidedType, - designTimeConfig, - designTimeConnectionString, + cmdProvidedType, + designTimeConfig, + designTimeConnectionString, config.IsHostedExecution, factoryMethodName = "Create" ) @@ -182,15 +182,15 @@ type SqlCommandProvider(config : TypeProviderConfig) as this = let executeArgs = DesignTime.GetExecuteArgs(cmdProvidedType, parameters, udttsPerSchema = null) let hasOutputParameters = false - let addRedirectToISqlCommandMethod outputType name = - DesignTime.AddGeneratedMethod(parameters, hasOutputParameters, executeArgs, cmdProvidedType.BaseType, outputType, name) + let addRedirectToISqlCommandMethod outputType name = + DesignTime.AddGeneratedMethod(parameters, hasOutputParameters, executeArgs, cmdProvidedType.BaseType, outputType, name) |> cmdProvidedType.AddMember - addRedirectToISqlCommandMethod returnType.Single "Execute" - + addRedirectToISqlCommandMethod returnType.Single "Execute" + let asyncReturnType = ProvidedTypeBuilder.MakeGenericType(typedefof<_ Async>, [ returnType.Single ]) - addRedirectToISqlCommandMethod asyncReturnType "AsyncExecute" + addRedirectToISqlCommandMethod asyncReturnType "AsyncExecute" - addRedirectToISqlCommandMethod typeof "ToTraceString" + addRedirectToISqlCommandMethod typeof "ToTraceString" cmdProvidedType From 0b90ac1b5f3dc2e247da9deab3510070b6ecc3ea Mon Sep 17 00:00:00 2001 From: David Teasdale Date: Fri, 18 May 2018 14:58:26 +0100 Subject: [PATCH 12/18] Add missing file --- src/SqlClient.Tests/TempTableTests.fs | 106 ++++++++++++++++++++++++++ 1 file changed, 106 insertions(+) create mode 100644 src/SqlClient.Tests/TempTableTests.fs diff --git a/src/SqlClient.Tests/TempTableTests.fs b/src/SqlClient.Tests/TempTableTests.fs new file mode 100644 index 00000000..afe39753 --- /dev/null +++ b/src/SqlClient.Tests/TempTableTests.fs @@ -0,0 +1,106 @@ +module FSharp.Data.TempTableTests + +open FSharp.Data +open Xunit +open System.Data.SqlClient + +type TempTable = + SqlCommandProvider< + TempTableDefinitions = " + CREATE TABLE #Temp ( + Id INT NOT NULL, + Name NVARCHAR(100) NULL)", + CommandText = " + SELECT Id, Name FROM #Temp", + ConnectionStringOrName = + ConnectionStrings.AdventureWorksLiteral> + +[] +let usingTempTable() = + use conn = new SqlConnection(ConnectionStrings.AdventureWorksLiteral) + conn.Open() + + use cmd = new TempTable(conn) + + cmd.LoadTempTables( + Temp = + [ TempTable.Temp(Id = 1, Name = Some "monkey") + TempTable.Temp(Id = 2, Name = Some "donkey") ]) + + let actual = + cmd.Execute() + |> Seq.map(fun x -> x.Id, x.Name) + |> Seq.toList + + let expected = [ + 1, Some "monkey" + 2, Some "donkey" + ] + + Assert.Equal<_ list>(expected, actual) + +[] +let queryWithHash() = + // We shouldn't mangle the statement when it's run + use cmd = + new SqlCommandProvider< + CommandText = " + SELECT Id, Name + FROM + ( + SELECT 1 AS Id, '#name' AS Name UNION + SELECT 2, 'some other value' + ) AS a + WHERE Name = '#name'", + ConnectionStringOrName = + ConnectionStrings.AdventureWorksLiteral>(ConnectionStrings.AdventureWorksLiteral) + + let actual = + cmd.Execute() + |> Seq.map(fun x -> x.Id, x.Name) + |> Seq.toList + + let expected = [ + 1, "#name" + ] + + Assert.Equal<_ list>(expected, actual) + +type TempTableHash = + SqlCommandProvider< + TempTableDefinitions = " + CREATE TABLE #Temp ( + Id INT NOT NULL)", + CommandText = " + SELECT a.Id, a.Name + FROM + ( + SELECT 1 AS Id, '#Temp' AS Name UNION + SELECT 2, 'some other value' + ) AS a + INNER JOIN #Temp t ON t.Id = a.Id", + ConnectionStringOrName = + ConnectionStrings.AdventureWorksLiteral> + +[] +let queryWithHashAndTempTable() = + // We shouldn't mangle the statement when it's run + use conn = new SqlConnection(ConnectionStrings.AdventureWorksLiteral) + conn.Open() + + use cmd = new TempTableHash(conn) + + cmd.LoadTempTables( + Temp = + [ TempTableHash.Temp(Id = 1) ]) + + let actual = + cmd.Execute() + |> Seq.map(fun x -> x.Id, x.Name) + |> Seq.toList + + let expected = [ + 1, "#Temp" + ] + + Assert.Equal<_ list>(expected, actual) \ No newline at end of file From 68b5fe0351db525d01770b04aa8909b0169efc8a Mon Sep 17 00:00:00 2001 From: David Teasdale Date: Fri, 18 May 2018 15:16:11 +0100 Subject: [PATCH 13/18] Fix more merge fall out --- src/SqlClient/SqlCommandProvider.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/SqlClient/SqlCommandProvider.fs b/src/SqlClient/SqlCommandProvider.fs index 32c3fc65..22935f51 100644 --- a/src/SqlClient/SqlCommandProvider.fs +++ b/src/SqlClient/SqlCommandProvider.fs @@ -57,7 +57,7 @@ type SqlCommandProvider(config : TypeProviderConfig) as this = ProvidedStaticParameter("TableVarMapping", typeof, "") ], instantiationFunction = (fun typeName args -> - let value = lazy this.CreateRootType(typeName, unbox args.[0], unbox args.[1], unbox args.[2], unbox args.[3], unbox args.[4], unbox args.[5], unbox args.[6]) + let value = lazy this.CreateRootType(typeName, unbox args.[0], unbox args.[1], unbox args.[2], unbox args.[3], unbox args.[4], unbox args.[5], unbox args.[6], unbox args.[7], unbox args.[8]) cache.GetOrAdd(typeName, value) ) ) @@ -85,7 +85,7 @@ type SqlCommandProvider(config : TypeProviderConfig) as this = |> defaultArg <| base.ResolveAssembly args - member internal this.CreateRootType(typeName, sqlStatement, connectionStringOrName: string, resultType, singleRow, configFile, allParametersOptional, dataDirectory) = + member internal this.CreateRootType(typeName, sqlStatement, connectionStringOrName: string, resultType, singleRow, configFile, allParametersOptional, dataDirectory, tempTableDefinitions, tableVarMapping) = if singleRow && not (resultType = ResultType.Records || resultType = ResultType.Tuples) then From 9f6a4d52c8aa8007cc84efa6ff88745383ef0b38 Mon Sep 17 00:00:00 2001 From: David Teasdale Date: Fri, 18 May 2018 15:44:03 +0100 Subject: [PATCH 14/18] pin fake in build.sh --- build.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/build.sh b/build.sh index 3b84b3c0..85ed8958 100755 --- a/build.sh +++ b/build.sh @@ -1,6 +1,6 @@ #!/bin/bash if [ ! -f packages/FAKE/tools/FAKE.exe ]; then - mono .nuget/NuGet.exe install FAKE -OutputDirectory packages -ExcludeVersion + mono .nuget/NuGet.exe install FAKE -OutputDirectory packages -ExcludeVersion -Version 4.1.2 fi #workaround assembly resolution issues in build.fsx mono packages/FAKE/tools/FAKE.exe build.fsx $@ From 622834eb0eca2cc8908a5909f45e14b8e6f2633a Mon Sep 17 00:00:00 2001 From: David Teasdale Date: Fri, 18 May 2018 16:10:10 +0100 Subject: [PATCH 15/18] FSharp.Core.4.0.0.1 --- src/SqlClient.Tests/Lib/Lib.fsproj | 7 ++++--- .../SqlClient.Tests.NET40/SqlClient.Tests.NET40.fsproj | 7 ++++--- src/SqlClient.Tests/SqlClient.Tests.fsproj | 4 ++-- src/SqlClient.Tests/packages.config | 1 + src/SqlClient/SqlClient.fsproj | 4 ++-- src/SqlClient/packages.config | 1 + 6 files changed, 14 insertions(+), 10 deletions(-) diff --git a/src/SqlClient.Tests/Lib/Lib.fsproj b/src/SqlClient.Tests/Lib/Lib.fsproj index 02376c26..45fe7288 100644 --- a/src/SqlClient.Tests/Lib/Lib.fsproj +++ b/src/SqlClient.Tests/Lib/Lib.fsproj @@ -53,8 +53,12 @@ + + + ..\..\..\packages\FSharp.Core.4.0.0.1\lib\net40\FSharp.Core.dll + ..\..\..\bin\FSharp.Data.SqlClient.dll @@ -62,9 +66,6 @@ ..\..\..\..\..\..\..\..\Program Files (x86)\Microsoft SQL Server\120\SDK\Assemblies\Microsoft.SqlServer.Types.dll - - True - diff --git a/src/SqlClient.Tests/SqlClient.Tests.NET40/SqlClient.Tests.NET40.fsproj b/src/SqlClient.Tests/SqlClient.Tests.NET40/SqlClient.Tests.NET40.fsproj index b671ddea..89c79c61 100644 --- a/src/SqlClient.Tests/SqlClient.Tests.NET40/SqlClient.Tests.NET40.fsproj +++ b/src/SqlClient.Tests/SqlClient.Tests.NET40/SqlClient.Tests.NET40.fsproj @@ -66,15 +66,16 @@ + + + ..\..\..\packages\FSharp.Core.4.0.0.1\lib\net40\FSharp.Core.dll + ..\..\..\bin\FSharp.Data.SqlClient.dll - - True - diff --git a/src/SqlClient.Tests/SqlClient.Tests.fsproj b/src/SqlClient.Tests/SqlClient.Tests.fsproj index 4f514426..a89bf8a8 100644 --- a/src/SqlClient.Tests/SqlClient.Tests.fsproj +++ b/src/SqlClient.Tests/SqlClient.Tests.fsproj @@ -102,8 +102,8 @@ ..\..\packages\FSharp.Configuration.0.5.3\lib\net40\FSharp.Configuration.dll True - - True + + ..\..\packages\FSharp.Core.4.0.0.1\lib\net40\FSharp.Core.dll ..\..\bin\FSharp.Data.SqlClient.dll diff --git a/src/SqlClient.Tests/packages.config b/src/SqlClient.Tests/packages.config index 0dd4c34f..65988de3 100644 --- a/src/SqlClient.Tests/packages.config +++ b/src/SqlClient.Tests/packages.config @@ -1,6 +1,7 @@  + diff --git a/src/SqlClient/SqlClient.fsproj b/src/SqlClient/SqlClient.fsproj index e5ed407f..ad3bcc69 100644 --- a/src/SqlClient/SqlClient.fsproj +++ b/src/SqlClient/SqlClient.fsproj @@ -51,8 +51,8 @@ --warnon:1182 - - True + + ..\..\packages\FSharp.Core.4.0.0.1\lib\net40\FSharp.Core.dll ..\..\packages\Microsoft.SqlServer.TransactSql.ScriptDom.14.0.3811.1\lib\net40\Microsoft.SqlServer.TransactSql.ScriptDom.dll diff --git a/src/SqlClient/packages.config b/src/SqlClient/packages.config index ac41745b..175de096 100644 --- a/src/SqlClient/packages.config +++ b/src/SqlClient/packages.config @@ -1,5 +1,6 @@  + \ No newline at end of file From 73ea1fadd9563239e4d57f320f66c2d4cf6067f8 Mon Sep 17 00:00:00 2001 From: David Teasdale Date: Fri, 18 May 2018 16:27:52 +0100 Subject: [PATCH 16/18] update bindingRedirect --- src/SqlClient.Tests/app.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/SqlClient.Tests/app.config b/src/SqlClient.Tests/app.config index b262685f..447c8c76 100644 --- a/src/SqlClient.Tests/app.config +++ b/src/SqlClient.Tests/app.config @@ -7,7 +7,7 @@ - + From 85e1839bc95d86b9ef1d21b2f527d644262811ab Mon Sep 17 00:00:00 2001 From: David Teasdale Date: Fri, 18 May 2018 19:47:24 +0100 Subject: [PATCH 17/18] try get the mono build working --- src/SqlClient/ISqlCommand.fs | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/SqlClient/ISqlCommand.fs b/src/SqlClient/ISqlCommand.fs index e2e0239b..22f7d24e 100644 --- a/src/SqlClient/ISqlCommand.fs +++ b/src/SqlClient/ISqlCommand.fs @@ -8,6 +8,7 @@ open System.Configuration open System.Collections.Specialized open FSharp.Data.SqlClient +open System.Linq [] type ISqlCommand = @@ -185,10 +186,16 @@ type ``ISqlCommand Implementation``(cfg: DesignTimeConfig, connection: Connectio | _ -> match p.SqlDbType with | SqlDbType.Structured -> + // TODO: Maybe make this lazy? //done via reflection because not implemented on Mono let sqlDataRecordType = typeof.Assembly.GetType("Microsoft.SqlServer.Server.SqlDataRecord", throwOnError = true) - let records = typeof.GetMethod("Cast").MakeGenericMethod(sqlDataRecordType).Invoke(null, [| value |]) :?> seq - p.Value <- if Seq.isEmpty records then null else records + let records = typeof.GetMethod("Cast").MakeGenericMethod(sqlDataRecordType).Invoke(null, [| value |]) + let hasAny = typeof + .GetMethods(BindingFlags.Static ||| BindingFlags.Public) + .First(fun m -> m.Name = "Any" && m.GetParameters().Count() = 1) + .MakeGenericMethod(sqlDataRecordType).Invoke(null, [| records |]) :?> bool + + p.Value <- if not hasAny then null else records | _ -> p.Value <- value elif p.Direction.HasFlag(ParameterDirection.Output) && value :? Array then From 6ad7dd76384c7456e6d005cdae8591348cf14c29 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sun, 20 May 2018 14:48:01 +0300 Subject: [PATCH 18/18] paket install --- src/SqlClient.Tests/Lib/Lib.fsproj | 3 --- .../SqlClient.Tests.NET40/SqlClient.Tests.NET40.fsproj | 3 --- src/SqlClient.Tests/SqlClient.Tests.fsproj | 7 ------- src/SqlClient/AssemblyInfo.fs | 10 ++++++++-- src/SqlClient/SqlClient.fsproj | 7 ------- 5 files changed, 8 insertions(+), 22 deletions(-) diff --git a/src/SqlClient.Tests/Lib/Lib.fsproj b/src/SqlClient.Tests/Lib/Lib.fsproj index a557e558..ad6a20c6 100644 --- a/src/SqlClient.Tests/Lib/Lib.fsproj +++ b/src/SqlClient.Tests/Lib/Lib.fsproj @@ -56,9 +56,6 @@ - - ..\..\..\packages\FSharp.Core.4.0.0.1\lib\net40\FSharp.Core.dll - ..\..\..\bin\FSharp.Data.SqlClient.dll diff --git a/src/SqlClient.Tests/SqlClient.Tests.NET40/SqlClient.Tests.NET40.fsproj b/src/SqlClient.Tests/SqlClient.Tests.NET40/SqlClient.Tests.NET40.fsproj index b86eb841..3df52d8a 100644 --- a/src/SqlClient.Tests/SqlClient.Tests.NET40/SqlClient.Tests.NET40.fsproj +++ b/src/SqlClient.Tests/SqlClient.Tests.NET40/SqlClient.Tests.NET40.fsproj @@ -61,9 +61,6 @@ - - ..\..\..\packages\FSharp.Core.4.0.0.1\lib\net40\FSharp.Core.dll - ..\..\..\bin\FSharp.Data.SqlClient.dll diff --git a/src/SqlClient.Tests/SqlClient.Tests.fsproj b/src/SqlClient.Tests/SqlClient.Tests.fsproj index 11751205..531c7154 100644 --- a/src/SqlClient.Tests/SqlClient.Tests.fsproj +++ b/src/SqlClient.Tests/SqlClient.Tests.fsproj @@ -103,13 +103,6 @@ - - ..\..\packages\FSharp.Configuration.0.5.3\lib\net40\FSharp.Configuration.dll - True - - - ..\..\packages\FSharp.Core.4.0.0.1\lib\net40\FSharp.Core.dll - ..\..\bin\FSharp.Data.SqlClient.dll diff --git a/src/SqlClient/AssemblyInfo.fs b/src/SqlClient/AssemblyInfo.fs index a61e0367..9cc5187c 100644 --- a/src/SqlClient/AssemblyInfo.fs +++ b/src/SqlClient/AssemblyInfo.fs @@ -1,4 +1,5 @@ -namespace System +// Auto-Generated by FAKE; do not edit +namespace System open System.Reflection open System.Runtime.CompilerServices @@ -11,4 +12,9 @@ open System.Runtime.CompilerServices do () module internal AssemblyVersionInformation = - let [] Version = "1.8.4" + let [] AssemblyTitle = "SqlClient" + let [] AssemblyProduct = "FSharp.Data.SqlClient" + let [] AssemblyDescription = "SqlClient F# type providers" + let [] AssemblyVersion = "1.8.4" + let [] AssemblyFileVersion = "1.8.4" + let [] InternalsVisibleTo = "SqlClient.Tests" diff --git a/src/SqlClient/SqlClient.fsproj b/src/SqlClient/SqlClient.fsproj index 3cd2a4f4..abb701f0 100644 --- a/src/SqlClient/SqlClient.fsproj +++ b/src/SqlClient/SqlClient.fsproj @@ -50,13 +50,6 @@ --warnon:1182 - - ..\..\packages\FSharp.Core.4.0.0.1\lib\net40\FSharp.Core.dll - - - ..\..\packages\Microsoft.SqlServer.TransactSql.ScriptDom.14.0.3811.1\lib\net40\Microsoft.SqlServer.TransactSql.ScriptDom.dll - True -