From 2df0e6bccd0eba552655d43fc87cfcbb2411d5d0 Mon Sep 17 00:00:00 2001 From: symboliq Date: Thu, 15 Jul 2021 17:19:13 -0400 Subject: [PATCH 01/42] Fixed various build issies for local development / debugging. --- FSharp.Data.Npgsql.sln | 4 +- Tests.sln | 10 ++++- src/DesignTime/DesignTime.fsproj | 3 +- src/Runtime/Runtime.fsproj | 2 +- tests/NpgsqlConnectionTests.fs | 64 ++++++++++++++++---------------- 5 files changed, 44 insertions(+), 39 deletions(-) diff --git a/FSharp.Data.Npgsql.sln b/FSharp.Data.Npgsql.sln index 0807eba..de65170 100644 --- a/FSharp.Data.Npgsql.sln +++ b/FSharp.Data.Npgsql.sln @@ -1,7 +1,7 @@  Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio 15 -VisualStudioVersion = 15.0.27130.2010 +# Visual Studio Version 16 +VisualStudioVersion = 16.0.31129.286 MinimumVisualStudioVersion = 10.0.40219.1 Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = ".paket", ".paket", "{1600313A-B151-4B3A-A779-74820289D25B}" ProjectSection(SolutionItems) = preProject diff --git a/Tests.sln b/Tests.sln index acc01ca..8dcc226 100644 --- a/Tests.sln +++ b/Tests.sln @@ -1,7 +1,7 @@  Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio 15 -VisualStudioVersion = 15.0.27130.2010 +# Visual Studio Version 16 +VisualStudioVersion = 16.0.31129.286 MinimumVisualStudioVersion = 10.0.40219.1 Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = ".paket", ".paket", "{FD7B202A-3E0E-4295-87A6-F5917F361760}" ProjectSection(SolutionItems) = preProject @@ -10,6 +10,8 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = ".paket", ".paket", "{FD7B20 EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Tests", "tests\Tests.fsproj", "{D2EA4AE7-56F8-4E4B-9415-B4A3C4D243BB}" EndProject +Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "DesignTime", "src\DesignTime\DesignTime.fsproj", "{BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -20,6 +22,10 @@ Global {D2EA4AE7-56F8-4E4B-9415-B4A3C4D243BB}.Debug|Any CPU.Build.0 = Debug|Any CPU {D2EA4AE7-56F8-4E4B-9415-B4A3C4D243BB}.Release|Any CPU.ActiveCfg = Release|Any CPU {D2EA4AE7-56F8-4E4B-9415-B4A3C4D243BB}.Release|Any CPU.Build.0 = Release|Any CPU + {BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}.Debug|Any CPU.Build.0 = Debug|Any CPU + {BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}.Release|Any CPU.ActiveCfg = Release|Any CPU + {BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE diff --git a/src/DesignTime/DesignTime.fsproj b/src/DesignTime/DesignTime.fsproj index 7a21886..0aca126 100644 --- a/src/DesignTime/DesignTime.fsproj +++ b/src/DesignTime/DesignTime.fsproj @@ -10,8 +10,7 @@ true true true - true - 1182 + false preview diff --git a/src/Runtime/Runtime.fsproj b/src/Runtime/Runtime.fsproj index a108e4c..4b5b2af 100644 --- a/src/Runtime/Runtime.fsproj +++ b/src/Runtime/Runtime.fsproj @@ -9,7 +9,7 @@ true true true - true + false 101 preview diff --git a/tests/NpgsqlConnectionTests.fs b/tests/NpgsqlConnectionTests.fs index 31db387..e5e2418 100644 --- a/tests/NpgsqlConnectionTests.fs +++ b/tests/NpgsqlConnectionTests.fs @@ -1070,35 +1070,35 @@ let ``Manually mapped and cast composite type works`` () = Assert.Equal ("blah", res.SomeText) Assert.Equal ([| 1; 2 |], res.SomeArray) -[] -let ``NetTopology.Geometry roundtrip works`` () = - let input = Geometry.DefaultFactory.CreatePoint (Coordinate (55., 0.)) - use cmd = DvdRentalWithTypeReuse.CreateCommand<"select @p::geometry">(connectionString) - let res = cmd.Execute(input).Head.Value - - Assert.Equal (input.Coordinate.X, res.Coordinate.X) - -[] -let ``NetTopology.Geometry roundtrip works record`` () = - let input = Geometry.DefaultFactory.CreatePoint (Coordinate (55., 0.)) - use cmd = DvdRentalWithTypeReuse.CreateCommand<"select @p::geometry g, 0 blah, null::geometry gg">(connectionString) - let res = cmd.Execute(input).Head.g.Value - - Assert.Equal (input.Coordinate.X, res.Coordinate.X) - -[] -let ``NetTopology.Geometry roundtrip works record single row`` () = - let input = Geometry.DefaultFactory.CreatePoint (Coordinate (55., 0.)) - use cmd = DvdRentalWithTypeReuse.CreateCommand<"select @p::geometry g, 0 blah, null::geometry gg", SingleRow = true>(connectionString) - let res = cmd.Execute(input).Value - - Assert.Equal (input.Coordinate.X, res.g.Value.Coordinate.X) - Assert.Equal (None, res.gg) - -[] -let ``NetTopology.Geometry roundtrip works tuple`` () = - let input = Geometry.DefaultFactory.CreatePoint (Coordinate (55., 0.)) - use cmd = DvdRentalWithTypeReuse.CreateCommand<"select @p::geometry g, 0 blah, null::geometry gg", ResultType = ResultType.Tuples>(connectionString) - let res, _, _ = cmd.Execute(input).Head - - Assert.Equal (input.Coordinate.X, res.Value.Coordinate.X) +//[] +//let ``NetTopology.Geometry roundtrip works`` () = +// let input = Geometry.DefaultFactory.CreatePoint (Coordinate (55., 0.)) +// use cmd = DvdRentalWithTypeReuse.CreateCommand<"select @p::geometry">(connectionString) +// let res = cmd.Execute(input).Head.Value +// +// Assert.Equal (input.Coordinate.X, res.Coordinate.X) +// +//[] +//let ``NetTopology.Geometry roundtrip works record`` () = +// let input = Geometry.DefaultFactory.CreatePoint (Coordinate (55., 0.)) +// use cmd = DvdRentalWithTypeReuse.CreateCommand<"select @p::geometry g, 0 blah, null::geometry gg">(connectionString) +// let res = cmd.Execute(input).Head.g.Value +// +// Assert.Equal (input.Coordinate.X, res.Coordinate.X) +// +//[] +//let ``NetTopology.Geometry roundtrip works record single row`` () = +// let input = Geometry.DefaultFactory.CreatePoint (Coordinate (55., 0.)) +// use cmd = DvdRentalWithTypeReuse.CreateCommand<"select @p::geometry g, 0 blah, null::geometry gg", SingleRow = true>(connectionString) +// let res = cmd.Execute(input).Value +// +// Assert.Equal (input.Coordinate.X, res.g.Value.Coordinate.X) +// Assert.Equal (None, res.gg) +// +//[] +//let ``NetTopology.Geometry roundtrip works tuple`` () = +// let input = Geometry.DefaultFactory.CreatePoint (Coordinate (55., 0.)) +// use cmd = DvdRentalWithTypeReuse.CreateCommand<"select @p::geometry g, 0 blah, null::geometry gg", ResultType = ResultType.Tuples>(connectionString) +// let res, _, _ = cmd.Execute(input).Head +// +// Assert.Equal (input.Coordinate.X, res.Value.Coordinate.X) From 6809dba2dadc6b2300c07687af04fca1fc9a9d48 Mon Sep 17 00:00:00 2001 From: symboliq Date: Thu, 15 Jul 2021 17:22:40 -0400 Subject: [PATCH 02/42] Speculating on async-ifying and adding retries to setupConnection. --- src/Runtime/ISqlCommand.fs | 33 ++++++++++++++++++++++----------- 1 file changed, 22 insertions(+), 11 deletions(-) diff --git a/src/Runtime/ISqlCommand.fs b/src/Runtime/ISqlCommand.fs index 277c7cc..0cad701 100644 --- a/src/Runtime/ISqlCommand.fs +++ b/src/Runtime/ISqlCommand.fs @@ -109,15 +109,26 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design ||| if cfg.ResultType = ResultType.DataTable then CommandBehavior.KeyInfo else CommandBehavior.Default ||| match connection with Choice1Of2 _ -> CommandBehavior.CloseConnection | _ -> CommandBehavior.Default - static let setupConnection (cmd: NpgsqlCommand, connection) = - match connection with - | Choice2Of2 (conn, tx) -> - cmd.Connection <- conn - cmd.Transaction <- tx - System.Threading.Tasks.Task.CompletedTask - | Choice1Of2 connectionString -> - cmd.Connection <- new NpgsqlConnection (connectionString) - cmd.Connection.OpenAsync () + static let rec setupConnectionAsyncInternal (tries, exns, cmd: NpgsqlCommand, connection) = + async { + match connection with + | Choice2Of2 (conn, tx) -> + cmd.Connection <- conn + cmd.Transaction <- tx + | Choice1Of2 connectionString -> + cmd.Connection <- new NpgsqlConnection (connectionString) + let! choice = cmd.Connection.OpenAsync () |> Async.AwaitTask |> Async.Catch + match choice with + | Choice1Of2 () -> () + | Choice2Of2 exn -> + if tries < 10 then // TODO: get value from cfg + do! Async.Sleep 1000 // TODO: get value from cfg + do! setupConnectionAsyncInternal (tries+1, exn :: exns, cmd, connection) + else raise (AggregateException (Seq.rev exns)) } + + static let rec setupConnectionAsync (cmd, connection) = + async { + do! setupConnectionAsyncInternal (0, [], cmd, connection) } static let mapTask (t: Ply.Ply<_>, executionType) = let t = task { return! t } @@ -170,7 +181,7 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design static member internal AsyncExecuteDataReaderTask (cfg, cmd, connection, parameters) = Unsafe.uply { ISqlCommandImplementation.SetParameters (cmd, parameters) - do! setupConnection (cmd, connection) + do! setupConnectionAsync (cmd, connection) let readerBehavior = getReaderBehavior (connection, cfg) if cfg.Prepare then @@ -314,7 +325,7 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design static member internal AsyncExecuteNonQuery (cfg, cmd, connection, parameters, executionType) = let t = Unsafe.uply { ISqlCommandImplementation.SetParameters (cmd, parameters) - do! setupConnection (cmd, connection) + do! setupConnectionAsync (cmd, connection) let readerBehavior = getReaderBehavior (connection, cfg) use _ = if readerBehavior.HasFlag CommandBehavior.CloseConnection then cmd.Connection else null From 96640e70e3687af1a709eeb1b8bad995b1cf5d85 Mon Sep 17 00:00:00 2001 From: symboliq Date: Thu, 15 Jul 2021 18:09:46 -0400 Subject: [PATCH 03/42] More retry functions. Moved setup connection to Utils. --- src/Runtime/ISqlCommand.fs | 25 ++----------------- src/Runtime/Utils.fs | 51 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 53 insertions(+), 23 deletions(-) diff --git a/src/Runtime/ISqlCommand.fs b/src/Runtime/ISqlCommand.fs index 0cad701..979bd2e 100644 --- a/src/Runtime/ISqlCommand.fs +++ b/src/Runtime/ISqlCommand.fs @@ -109,27 +109,6 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design ||| if cfg.ResultType = ResultType.DataTable then CommandBehavior.KeyInfo else CommandBehavior.Default ||| match connection with Choice1Of2 _ -> CommandBehavior.CloseConnection | _ -> CommandBehavior.Default - static let rec setupConnectionAsyncInternal (tries, exns, cmd: NpgsqlCommand, connection) = - async { - match connection with - | Choice2Of2 (conn, tx) -> - cmd.Connection <- conn - cmd.Transaction <- tx - | Choice1Of2 connectionString -> - cmd.Connection <- new NpgsqlConnection (connectionString) - let! choice = cmd.Connection.OpenAsync () |> Async.AwaitTask |> Async.Catch - match choice with - | Choice1Of2 () -> () - | Choice2Of2 exn -> - if tries < 10 then // TODO: get value from cfg - do! Async.Sleep 1000 // TODO: get value from cfg - do! setupConnectionAsyncInternal (tries+1, exn :: exns, cmd, connection) - else raise (AggregateException (Seq.rev exns)) } - - static let rec setupConnectionAsync (cmd, connection) = - async { - do! setupConnectionAsyncInternal (0, [], cmd, connection) } - static let mapTask (t: Ply.Ply<_>, executionType) = let t = task { return! t } @@ -181,7 +160,7 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design static member internal AsyncExecuteDataReaderTask (cfg, cmd, connection, parameters) = Unsafe.uply { ISqlCommandImplementation.SetParameters (cmd, parameters) - do! setupConnectionAsync (cmd, connection) + do! Utils.SetupConnectionAsync (10, 1000, cmd, connection) // TODO: pull args from cfg. let readerBehavior = getReaderBehavior (connection, cfg) if cfg.Prepare then @@ -325,7 +304,7 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design static member internal AsyncExecuteNonQuery (cfg, cmd, connection, parameters, executionType) = let t = Unsafe.uply { ISqlCommandImplementation.SetParameters (cmd, parameters) - do! setupConnectionAsync (cmd, connection) + do! Utils.SetupConnectionAsync (10, 1000, cmd, connection) // TODO: pull args from cfg. let readerBehavior = getReaderBehavior (connection, cfg) use _ = if readerBehavior.HasFlag CommandBehavior.CloseConnection then cmd.Connection else null diff --git a/src/Runtime/Utils.fs b/src/Runtime/Utils.fs index d342857..b94dc93 100644 --- a/src/Runtime/Utils.fs +++ b/src/Runtime/Utils.fs @@ -5,6 +5,7 @@ open System.Data open System.Data.Common open System.Collections.Concurrent open System.ComponentModel +open System.Threading open Npgsql open NpgsqlTypes open FSharp.Control.Tasks.NonAffine @@ -14,6 +15,45 @@ open System.Linq.Expressions [] type Utils () = + + static let rec SetupConnectionAsync' (tries, exns, retries, wait, cmd: NpgsqlCommand, connection) = + async { + match connection with + | Choice1Of2 connectionString -> + cmd.Connection <- new NpgsqlConnection (connectionString) + let! choice = cmd.Connection.OpenAsync () |> Async.AwaitTask |> Async.Catch + match choice with + | Choice1Of2 () -> () + | Choice2Of2 exn -> + if retries < 1 || tries < retries then + do! Async.Sleep wait + do! SetupConnectionAsync' (tries+1, exn :: exns, retries, wait, cmd, connection) + else raise (AggregateException (Seq.rev exns)) + | Choice2Of2 (conn, tx) -> + cmd.Connection <- conn + cmd.Transaction <- tx } + + static let rec Read' (tries, exns, retries, wait: int, cursor: DbDataReader) = + try cursor.Read () + with exn -> + if retries < 1 || tries < retries then + Thread.Sleep wait + Read' (tries+1, exn :: exns, retries, wait, cursor) + else + raise (AggregateException (Seq.rev exns)) + + static let rec ReadAsync' (tries, exns, retries, wait, cursor: DbDataReader) = + async { + let! choice = cursor.ReadAsync () |> Async.AwaitTask |> Async.Catch + match choice with + | Choice1Of2 go -> return go + | Choice2Of2 exn -> + if tries < retries then // TODO: get value from cfg + do! Async.Sleep 1000 // TODO: get value from cfg + return! ReadAsync' (tries+1, exn :: exns, retries, wait, cursor) + else + return (raise (AggregateException (Seq.rev exns))) } + static let getColumnMapping = let cache = ConcurrentDictionary obj> () let factory = Func<_, _>(fun (typeParam: Type) -> @@ -78,6 +118,17 @@ type Utils () = cache.[resultSet.ExpectedColumns.GetHashCode ()] <- func func + static member SetupConnectionAsync (retris, wait, cmd, connection) = + async { + do! SetupConnectionAsync' (0, [], retris, wait, cmd, connection) } + + static member Read (retries, wait, cursor) = + Read' (0, [], retries, wait, cursor) + + static member ReadAsync (retries, wait, cursor) = + async { + return! ReadAsync' (0, [], retries, wait, cursor) } + static member ResizeArrayToList ra = let rec inner (ra: ResizeArray<'a>, index, acc) = if index = 0 then From addfea6f08fdc354d5ca0efa3a5f6079ba5eaa40 Mon Sep 17 00:00:00 2001 From: symboliq Date: Thu, 15 Jul 2021 18:25:15 -0400 Subject: [PATCH 04/42] More retry functions. --- src/Runtime/Utils.fs | 56 ++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 52 insertions(+), 4 deletions(-) diff --git a/src/Runtime/Utils.fs b/src/Runtime/Utils.fs index b94dc93..d9a5ebc 100644 --- a/src/Runtime/Utils.fs +++ b/src/Runtime/Utils.fs @@ -48,12 +48,48 @@ type Utils () = match choice with | Choice1Of2 go -> return go | Choice2Of2 exn -> - if tries < retries then // TODO: get value from cfg - do! Async.Sleep 1000 // TODO: get value from cfg + if retries < 1 || tries < retries then + do! Async.Sleep wait return! ReadAsync' (tries+1, exn :: exns, retries, wait, cursor) else return (raise (AggregateException (Seq.rev exns))) } + static let rec PrepareAsync' (tries, exns, retries, wait, cmd: NpgsqlCommand) = + async { + let! choice = cmd.PrepareAsync () |> Async.AwaitTask |> Async.Catch + match choice with + | Choice1Of2 () -> return () + | Choice2Of2 exn -> + if retries < 1 || tries < retries then + do! Async.Sleep wait + return! PrepareAsync' (tries+1, exn :: exns, retries, wait, cmd) + else + return (raise (AggregateException (Seq.rev exns))) } + + static let rec ExecuteReaderAsync' (tries, exns, retries, wait, cmd: NpgsqlCommand) = + async { + let! choice = cmd.ExecuteReaderAsync () |> Async.AwaitTask |> Async.Catch + match choice with + | Choice1Of2 task -> return task + | Choice2Of2 exn -> + if retries < 1 || tries < retries then + do! Async.Sleep wait + return! ExecuteReaderAsync' (tries+1, exn :: exns, retries, wait, cmd) + else + return (raise (AggregateException (Seq.rev exns))) } + + static let rec ExecuteNonQueryAsync' (tries, exns, retries, wait, cmd: NpgsqlCommand) = + async { + let! choice = cmd.ExecuteNonQueryAsync () |> Async.AwaitTask |> Async.Catch + match choice with + | Choice1Of2 rowsAffected -> return rowsAffected + | Choice2Of2 exn -> + if retries < 1 || tries < retries then + do! Async.Sleep wait + return! ExecuteNonQueryAsync' (tries+1, exn :: exns, retries, wait, cmd) + else + return (raise (AggregateException (Seq.rev exns))) } + static let getColumnMapping = let cache = ConcurrentDictionary obj> () let factory = Func<_, _>(fun (typeParam: Type) -> @@ -118,9 +154,9 @@ type Utils () = cache.[resultSet.ExpectedColumns.GetHashCode ()] <- func func - static member SetupConnectionAsync (retris, wait, cmd, connection) = + static member SetupConnectionAsync (retries, wait, cmd, connection) = async { - do! SetupConnectionAsync' (0, [], retris, wait, cmd, connection) } + do! SetupConnectionAsync' (0, [], retries, wait, cmd, connection) } static member Read (retries, wait, cursor) = Read' (0, [], retries, wait, cursor) @@ -129,6 +165,18 @@ type Utils () = async { return! ReadAsync' (0, [], retries, wait, cursor) } + static member PrepareAsync (retries, wait, cmd) = + async { + return! PrepareAsync' (0, [], retries, wait, cmd) } + + static member ExecuteReaderAsync (retries, wait, cmd) = + async { + return! ExecuteReaderAsync' (0, [], retries, wait, cmd) } + + static member ExecuteNonQueryAsync (retries, wait, cmd) = + async { + return! ExecuteNonQueryAsync' (0, [], retries, wait, cmd) } + static member ResizeArrayToList ra = let rec inner (ra: ResizeArray<'a>, index, acc) = if index = 0 then From 7e3d31fde3bf09c158e05ff2568aa4ad90c12aa7 Mon Sep 17 00:00:00 2001 From: symboliq Date: Thu, 15 Jul 2021 18:32:07 -0400 Subject: [PATCH 05/42] Using retry functions in Utils.fs. --- src/Runtime/Utils.fs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Runtime/Utils.fs b/src/Runtime/Utils.fs index d9a5ebc..15e1707 100644 --- a/src/Runtime/Utils.fs +++ b/src/Runtime/Utils.fs @@ -289,7 +289,7 @@ type Utils () = let results = ResizeArray<'TItem> () let rowReader = getRowToTupleReader resultSet (resultType = ResultType.Records) - let! go = cursor.ReadAsync () + let! go = Utils.ReadAsync (10, 1000, cursor) // TODO: pull args from cfg. let mutable go = go while go do @@ -297,7 +297,7 @@ type Utils () = |> unbox |> results.Add - let! cont = cursor.ReadAsync () + let! cont = Utils.ReadAsync (10, 1000, cursor) // TODO: pull args from cfg. go <- cont return results } @@ -306,7 +306,7 @@ type Utils () = seq { let rowReader = getRowToTupleReader resultSet (resultType = ResultType.Records) - while cursor.Read () do + while Utils.Read (10, 1000, cursor) do // TODO: pull args from cfg. rowReader.Invoke cursor |> unbox<'TItem> } @@ -317,7 +317,7 @@ type Utils () = let columnMapping = getColumnMapping resultSet.ExpectedColumns.[0] let results = ResizeArray<'TItem> () - let! go = cursor.ReadAsync () + let! go = Utils.ReadAsync (10, 1000, cursor) // TODO: pull args from cfg. let mutable go = go while go do @@ -326,7 +326,7 @@ type Utils () = |> unbox |> results.Add - let! cont = cursor.ReadAsync () + let! cont = Utils.ReadAsync (10, 1000, cursor) // TODO: pull args from cfg. go <- cont return results } @@ -335,7 +335,7 @@ type Utils () = seq { let columnMapping = getColumnMapping resultSet.ExpectedColumns.[0] - while cursor.Read () do + while Utils.Read (10, 1000, cursor) do // TODO: pull args from cfg. cursor.GetValue 0 |> columnMapping |> unbox<'TItem> From f470e733ee63dad82ad1b591b051a11f43ae2bda Mon Sep 17 00:00:00 2001 From: symboliq Date: Thu, 15 Jul 2021 18:43:12 -0400 Subject: [PATCH 06/42] More application of retry functions. --- src/Runtime/ISqlCommand.fs | 10 +++++----- src/Runtime/Utils.fs | 22 +++++++++++----------- 2 files changed, 16 insertions(+), 16 deletions(-) diff --git a/src/Runtime/ISqlCommand.fs b/src/Runtime/ISqlCommand.fs index 979bd2e..9eb9fa3 100644 --- a/src/Runtime/ISqlCommand.fs +++ b/src/Runtime/ISqlCommand.fs @@ -160,13 +160,13 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design static member internal AsyncExecuteDataReaderTask (cfg, cmd, connection, parameters) = Unsafe.uply { ISqlCommandImplementation.SetParameters (cmd, parameters) - do! Utils.SetupConnectionAsync (10, 1000, cmd, connection) // TODO: pull args from cfg. + do! Utils.SetupConnectionAsync (10, 1000, cmd, connection) (* TODO: pull args from cfg. *) let readerBehavior = getReaderBehavior (connection, cfg) if cfg.Prepare then - do! cmd.PrepareAsync () + do! Utils.PrepareAsync (10, 1000, cmd) (* TODO: pull args from cfg. *) - let! cursor = cmd.ExecuteReaderAsync readerBehavior + let! cursor = Utils.ExecuteReaderAsync (10, 1000, readerBehavior, cmd) (* TODO: pull args from cfg. *) return cursor :?> NpgsqlDataReader } static member internal AsyncExecuteReader (cfg, cmd, connection, parameters, executionType) = @@ -304,14 +304,14 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design static member internal AsyncExecuteNonQuery (cfg, cmd, connection, parameters, executionType) = let t = Unsafe.uply { ISqlCommandImplementation.SetParameters (cmd, parameters) - do! Utils.SetupConnectionAsync (10, 1000, cmd, connection) // TODO: pull args from cfg. + do! Utils.SetupConnectionAsync (10, 1000, cmd, connection) (* TODO: pull args from cfg. *) let readerBehavior = getReaderBehavior (connection, cfg) use _ = if readerBehavior.HasFlag CommandBehavior.CloseConnection then cmd.Connection else null if cfg.Prepare then do! cmd.PrepareAsync () - return! cmd.ExecuteNonQueryAsync () } + return! Utils.ExecuteNonQueryAsync (10, 1000, cmd) (* TODO: pull args from cfg. *)} mapTask (t, executionType) diff --git a/src/Runtime/Utils.fs b/src/Runtime/Utils.fs index 15e1707..940941a 100644 --- a/src/Runtime/Utils.fs +++ b/src/Runtime/Utils.fs @@ -66,15 +66,15 @@ type Utils () = else return (raise (AggregateException (Seq.rev exns))) } - static let rec ExecuteReaderAsync' (tries, exns, retries, wait, cmd: NpgsqlCommand) = + static let rec ExecuteReaderAsync' (tries, exns, retries, wait, behavior: CommandBehavior, cmd: NpgsqlCommand) = async { - let! choice = cmd.ExecuteReaderAsync () |> Async.AwaitTask |> Async.Catch + let! choice = cmd.ExecuteReaderAsync behavior |> Async.AwaitTask |> Async.Catch match choice with | Choice1Of2 task -> return task | Choice2Of2 exn -> if retries < 1 || tries < retries then do! Async.Sleep wait - return! ExecuteReaderAsync' (tries+1, exn :: exns, retries, wait, cmd) + return! ExecuteReaderAsync' (tries+1, exn :: exns, retries, wait, behavior, cmd) else return (raise (AggregateException (Seq.rev exns))) } @@ -169,9 +169,9 @@ type Utils () = async { return! PrepareAsync' (0, [], retries, wait, cmd) } - static member ExecuteReaderAsync (retries, wait, cmd) = + static member ExecuteReaderAsync (retries, wait, behavior, cmd) = async { - return! ExecuteReaderAsync' (0, [], retries, wait, cmd) } + return! ExecuteReaderAsync' (0, [], retries, wait, behavior, cmd) } static member ExecuteNonQueryAsync (retries, wait, cmd) = async { @@ -289,7 +289,7 @@ type Utils () = let results = ResizeArray<'TItem> () let rowReader = getRowToTupleReader resultSet (resultType = ResultType.Records) - let! go = Utils.ReadAsync (10, 1000, cursor) // TODO: pull args from cfg. + let! go = Utils.ReadAsync (10, 1000, cursor) (* TODO: pull args from cfg. *) let mutable go = go while go do @@ -297,7 +297,7 @@ type Utils () = |> unbox |> results.Add - let! cont = Utils.ReadAsync (10, 1000, cursor) // TODO: pull args from cfg. + let! cont = Utils.ReadAsync (10, 1000, cursor) (* TODO: pull args from cfg. *) go <- cont return results } @@ -306,7 +306,7 @@ type Utils () = seq { let rowReader = getRowToTupleReader resultSet (resultType = ResultType.Records) - while Utils.Read (10, 1000, cursor) do // TODO: pull args from cfg. + while Utils.Read (10, 1000, cursor) do (* TODO: pull args from cfg. *) rowReader.Invoke cursor |> unbox<'TItem> } @@ -317,7 +317,7 @@ type Utils () = let columnMapping = getColumnMapping resultSet.ExpectedColumns.[0] let results = ResizeArray<'TItem> () - let! go = Utils.ReadAsync (10, 1000, cursor) // TODO: pull args from cfg. + let! go = Utils.ReadAsync (10, 1000, cursor) (* TODO: pull args from cfg. *) let mutable go = go while go do @@ -326,7 +326,7 @@ type Utils () = |> unbox |> results.Add - let! cont = Utils.ReadAsync (10, 1000, cursor) // TODO: pull args from cfg. + let! cont = Utils.ReadAsync (10, 1000, cursor) (* TODO: pull args from cfg. *) go <- cont return results } @@ -335,7 +335,7 @@ type Utils () = seq { let columnMapping = getColumnMapping resultSet.ExpectedColumns.[0] - while Utils.Read (10, 1000, cursor) do // TODO: pull args from cfg. + while Utils.Read (10, 1000, cursor) do (* TODO: pull args from cfg. *) cursor.GetValue 0 |> columnMapping |> unbox<'TItem> From 90c2983f56235ab98419b37190fdafccc6d4f4ca Mon Sep 17 00:00:00 2001 From: symboliq Date: Thu, 15 Jul 2021 18:47:08 -0400 Subject: [PATCH 07/42] Applied final retry function. --- src/Runtime/ISqlCommand.fs | 2 +- src/Runtime/Utils.fs | 16 ++++++++++++++++ 2 files changed, 17 insertions(+), 1 deletion(-) diff --git a/src/Runtime/ISqlCommand.fs b/src/Runtime/ISqlCommand.fs index 9eb9fa3..67f896a 100644 --- a/src/Runtime/ISqlCommand.fs +++ b/src/Runtime/ISqlCommand.fs @@ -293,7 +293,7 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design let currentStatement = GetStatementIndex.Invoke cursor let! res = ISqlCommandImplementation.ReadResultSet (cursor, cfg.ResultSets.[currentStatement], cfg) results.[currentStatement] <- res - let! more = cursor.NextResultAsync () + let! more = Utils.NextResultAsync (10, 1000, cursor) (* TODO: pull args from cfg. *) go <- more ISqlCommandImplementation.SetNumberOfAffectedRows (results, cmd.Statements) diff --git a/src/Runtime/Utils.fs b/src/Runtime/Utils.fs index 940941a..3ba1978 100644 --- a/src/Runtime/Utils.fs +++ b/src/Runtime/Utils.fs @@ -54,6 +54,18 @@ type Utils () = else return (raise (AggregateException (Seq.rev exns))) } + static let rec NextResultAsync' (tries, exns, retries, wait, cursor: DbDataReader) = + async { + let! choice = cursor.NextResultAsync () |> Async.AwaitTask |> Async.Catch + match choice with + | Choice1Of2 go -> return go + | Choice2Of2 exn -> + if retries < 1 || tries < retries then + do! Async.Sleep wait + return! NextResultAsync' (tries+1, exn :: exns, retries, wait, cursor) + else + return (raise (AggregateException (Seq.rev exns))) } + static let rec PrepareAsync' (tries, exns, retries, wait, cmd: NpgsqlCommand) = async { let! choice = cmd.PrepareAsync () |> Async.AwaitTask |> Async.Catch @@ -165,6 +177,10 @@ type Utils () = async { return! ReadAsync' (0, [], retries, wait, cursor) } + static member NextResultAsync (retries, wait, cursor) = + async { + return! NextResultAsync' (0, [], retries, wait, cursor) } + static member PrepareAsync (retries, wait, cmd) = async { return! PrepareAsync' (0, [], retries, wait, cmd) } From 0cffde9ad4f11bde902ace7b3cbca74f3c6f4d2c Mon Sep 17 00:00:00 2001 From: symboliq Date: Thu, 15 Jul 2021 18:59:59 -0400 Subject: [PATCH 08/42] Forgot one! --- src/Runtime/ISqlCommand.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Runtime/ISqlCommand.fs b/src/Runtime/ISqlCommand.fs index 67f896a..0dced20 100644 --- a/src/Runtime/ISqlCommand.fs +++ b/src/Runtime/ISqlCommand.fs @@ -309,7 +309,7 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design use _ = if readerBehavior.HasFlag CommandBehavior.CloseConnection then cmd.Connection else null if cfg.Prepare then - do! cmd.PrepareAsync () + do! Utils.PrepareAsync (10, 1000, cmd) (* TODO: pull args from cfg. *) return! Utils.ExecuteNonQueryAsync (10, 1000, cmd) (* TODO: pull args from cfg. *)} From c35ddb9f58f570b7e90ba08aa6e182d784a754e3 Mon Sep 17 00:00:00 2001 From: symboliq Date: Thu, 15 Jul 2021 19:18:13 -0400 Subject: [PATCH 09/42] Checking for open connection before retrying where possible. --- src/Runtime/Utils.fs | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/src/Runtime/Utils.fs b/src/Runtime/Utils.fs index 3ba1978..939e13d 100644 --- a/src/Runtime/Utils.fs +++ b/src/Runtime/Utils.fs @@ -25,7 +25,8 @@ type Utils () = match choice with | Choice1Of2 () -> () | Choice2Of2 exn -> - if retries < 1 || tries < retries then + if (retries < 1 || tries < retries) && + (cmd.Connection.State &&& ConnectionState.Open = ConnectionState.Open) then do! Async.Sleep wait do! SetupConnectionAsync' (tries+1, exn :: exns, retries, wait, cmd, connection) else raise (AggregateException (Seq.rev exns)) @@ -36,7 +37,7 @@ type Utils () = static let rec Read' (tries, exns, retries, wait: int, cursor: DbDataReader) = try cursor.Read () with exn -> - if retries < 1 || tries < retries then + if (retries < 1 || tries < retries) then Thread.Sleep wait Read' (tries+1, exn :: exns, retries, wait, cursor) else @@ -48,7 +49,7 @@ type Utils () = match choice with | Choice1Of2 go -> return go | Choice2Of2 exn -> - if retries < 1 || tries < retries then + if (retries < 1 || tries < retries) then do! Async.Sleep wait return! ReadAsync' (tries+1, exn :: exns, retries, wait, cursor) else @@ -60,7 +61,7 @@ type Utils () = match choice with | Choice1Of2 go -> return go | Choice2Of2 exn -> - if retries < 1 || tries < retries then + if (retries < 1 || tries < retries) then do! Async.Sleep wait return! NextResultAsync' (tries+1, exn :: exns, retries, wait, cursor) else @@ -72,7 +73,8 @@ type Utils () = match choice with | Choice1Of2 () -> return () | Choice2Of2 exn -> - if retries < 1 || tries < retries then + if (retries < 1 || tries < retries) && + (cmd.Connection.State &&& ConnectionState.Open = ConnectionState.Open) then do! Async.Sleep wait return! PrepareAsync' (tries+1, exn :: exns, retries, wait, cmd) else @@ -84,7 +86,8 @@ type Utils () = match choice with | Choice1Of2 task -> return task | Choice2Of2 exn -> - if retries < 1 || tries < retries then + if (retries < 1 || tries < retries) && + (cmd.Connection.State &&& ConnectionState.Open = ConnectionState.Open) then do! Async.Sleep wait return! ExecuteReaderAsync' (tries+1, exn :: exns, retries, wait, behavior, cmd) else @@ -96,7 +99,8 @@ type Utils () = match choice with | Choice1Of2 rowsAffected -> return rowsAffected | Choice2Of2 exn -> - if retries < 1 || tries < retries then + if (retries < 1 || tries < retries) && + (cmd.Connection.State &&& ConnectionState.Open = ConnectionState.Open) then do! Async.Sleep wait return! ExecuteNonQueryAsync' (tries+1, exn :: exns, retries, wait, cmd) else From 936260fadedcca0d896999f97d6c1c2c31cd4117 Mon Sep 17 00:00:00 2001 From: symboliq Date: Fri, 16 Jul 2021 10:01:44 -0400 Subject: [PATCH 10/42] Implemented ShouldRetry function to follow specs in e-mail. --- src/Runtime/Utils.fs | 44 +++++++++++++++++++++++++++++++++++++------- 1 file changed, 37 insertions(+), 7 deletions(-) diff --git a/src/Runtime/Utils.fs b/src/Runtime/Utils.fs index 939e13d..2b268ad 100644 --- a/src/Runtime/Utils.fs +++ b/src/Runtime/Utils.fs @@ -13,9 +13,39 @@ open System.Linq.Expressions #nowarn "0025" +[] +module internal StringExtensions = + + type String with + member this.ErrorClass = + if this.Length >= 2 + then this.Substring 2 + else raise (InvalidOperationException ()) + [] type Utils () = + static let ShouldRetry (tries, retries, exn : Exception) = + let exceptionRetry = + match exn with + | :? PostgresException as pgexn -> + let sqlState = pgexn.SqlState + let errorClass = sqlState.ErrorClass + if errorClass = PostgresErrorCodes.ConnectionException.ErrorClass then true + elif errorClass = PostgresErrorCodes.InsufficientResources.ErrorClass then true + elif sqlState = PostgresErrorCodes.IoError then true + elif sqlState = PostgresErrorCodes.DeadlockDetected then true + elif sqlState = PostgresErrorCodes.LockNotAvailable then true + elif sqlState = PostgresErrorCodes.TransactionIntegrityConstraintViolation then true + elif sqlState = PostgresErrorCodes.InFailedSqlTransaction then true + else false + | :? NpgsqlException -> true + | _ -> false + if exceptionRetry then + retries < 1 || + tries < retries + else false + static let rec SetupConnectionAsync' (tries, exns, retries, wait, cmd: NpgsqlCommand, connection) = async { match connection with @@ -25,7 +55,7 @@ type Utils () = match choice with | Choice1Of2 () -> () | Choice2Of2 exn -> - if (retries < 1 || tries < retries) && + if ShouldRetry (tries, retries, exn) && (cmd.Connection.State &&& ConnectionState.Open = ConnectionState.Open) then do! Async.Sleep wait do! SetupConnectionAsync' (tries+1, exn :: exns, retries, wait, cmd, connection) @@ -37,7 +67,7 @@ type Utils () = static let rec Read' (tries, exns, retries, wait: int, cursor: DbDataReader) = try cursor.Read () with exn -> - if (retries < 1 || tries < retries) then + if ShouldRetry (tries, retries, exn) then Thread.Sleep wait Read' (tries+1, exn :: exns, retries, wait, cursor) else @@ -49,7 +79,7 @@ type Utils () = match choice with | Choice1Of2 go -> return go | Choice2Of2 exn -> - if (retries < 1 || tries < retries) then + if ShouldRetry (tries, retries, exn) then do! Async.Sleep wait return! ReadAsync' (tries+1, exn :: exns, retries, wait, cursor) else @@ -61,7 +91,7 @@ type Utils () = match choice with | Choice1Of2 go -> return go | Choice2Of2 exn -> - if (retries < 1 || tries < retries) then + if ShouldRetry (tries, retries, exn) then do! Async.Sleep wait return! NextResultAsync' (tries+1, exn :: exns, retries, wait, cursor) else @@ -73,7 +103,7 @@ type Utils () = match choice with | Choice1Of2 () -> return () | Choice2Of2 exn -> - if (retries < 1 || tries < retries) && + if ShouldRetry (tries, retries, exn) && (cmd.Connection.State &&& ConnectionState.Open = ConnectionState.Open) then do! Async.Sleep wait return! PrepareAsync' (tries+1, exn :: exns, retries, wait, cmd) @@ -86,7 +116,7 @@ type Utils () = match choice with | Choice1Of2 task -> return task | Choice2Of2 exn -> - if (retries < 1 || tries < retries) && + if ShouldRetry (tries, retries, exn) && (cmd.Connection.State &&& ConnectionState.Open = ConnectionState.Open) then do! Async.Sleep wait return! ExecuteReaderAsync' (tries+1, exn :: exns, retries, wait, behavior, cmd) @@ -99,7 +129,7 @@ type Utils () = match choice with | Choice1Of2 rowsAffected -> return rowsAffected | Choice2Of2 exn -> - if (retries < 1 || tries < retries) && + if ShouldRetry (tries, retries, exn) && (cmd.Connection.State &&& ConnectionState.Open = ConnectionState.Open) then do! Async.Sleep wait return! ExecuteNonQueryAsync' (tries+1, exn :: exns, retries, wait, cmd) From ce829c266a598d192ab1917355d0fa5cdae23182 Mon Sep 17 00:00:00 2001 From: symboliq Date: Fri, 16 Jul 2021 10:05:33 -0400 Subject: [PATCH 11/42] Bit of expression clean-up. --- src/Runtime/Utils.fs | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/src/Runtime/Utils.fs b/src/Runtime/Utils.fs index 2b268ad..4d4c207 100644 --- a/src/Runtime/Utils.fs +++ b/src/Runtime/Utils.fs @@ -31,19 +31,17 @@ type Utils () = | :? PostgresException as pgexn -> let sqlState = pgexn.SqlState let errorClass = sqlState.ErrorClass - if errorClass = PostgresErrorCodes.ConnectionException.ErrorClass then true - elif errorClass = PostgresErrorCodes.InsufficientResources.ErrorClass then true - elif sqlState = PostgresErrorCodes.IoError then true - elif sqlState = PostgresErrorCodes.DeadlockDetected then true - elif sqlState = PostgresErrorCodes.LockNotAvailable then true - elif sqlState = PostgresErrorCodes.TransactionIntegrityConstraintViolation then true - elif sqlState = PostgresErrorCodes.InFailedSqlTransaction then true - else false + sqlState = PostgresErrorCodes.IoError || + sqlState = PostgresErrorCodes.DeadlockDetected || + sqlState = PostgresErrorCodes.LockNotAvailable || + sqlState = PostgresErrorCodes.TransactionIntegrityConstraintViolation || + sqlState = PostgresErrorCodes.InFailedSqlTransaction || + errorClass = PostgresErrorCodes.ConnectionException.ErrorClass || + errorClass = PostgresErrorCodes.InsufficientResources.ErrorClass | :? NpgsqlException -> true | _ -> false - if exceptionRetry then - retries < 1 || - tries < retries + if exceptionRetry + then retries < 1 || tries < retries else false static let rec SetupConnectionAsync' (tries, exns, retries, wait, cmd: NpgsqlCommand, connection) = From d9b899bb7686b598f994a4935ca8a5c52e014778 Mon Sep 17 00:00:00 2001 From: symboliq Date: Fri, 16 Jul 2021 10:47:59 -0400 Subject: [PATCH 12/42] Implemented Async.CatchDb. --- src/Runtime/Utils.fs | 90 +++++++++++++++++++++++--------------------- 1 file changed, 48 insertions(+), 42 deletions(-) diff --git a/src/Runtime/Utils.fs b/src/Runtime/Utils.fs index 4d4c207..c3c476e 100644 --- a/src/Runtime/Utils.fs +++ b/src/Runtime/Utils.fs @@ -14,7 +14,7 @@ open System.Linq.Expressions #nowarn "0025" [] -module internal StringExtensions = +module internal LocalExtensions = type String with member this.ErrorClass = @@ -22,42 +22,51 @@ module internal StringExtensions = then this.Substring 2 else raise (InvalidOperationException ()) + module Async = + let CatchDb a = + async { + try + let! result = a + return Choice1Of2 result + with + | :? PostgresException as pgexn -> + let sqlState = pgexn.SqlState + let errorClass = sqlState.ErrorClass + if sqlState = PostgresErrorCodes.IoError || + sqlState = PostgresErrorCodes.DeadlockDetected || + sqlState = PostgresErrorCodes.LockNotAvailable || + sqlState = PostgresErrorCodes.TransactionIntegrityConstraintViolation || + sqlState = PostgresErrorCodes.InFailedSqlTransaction || + errorClass = PostgresErrorCodes.ConnectionException.ErrorClass || + errorClass = PostgresErrorCodes.InsufficientResources.ErrorClass then + return Choice2Of2 (pgexn :> Exception) + else return raise pgexn + | :? NpgsqlException as npgsexn -> return (Choice2Of2 (npgsexn :> Exception)) + | exn -> return raise exn } + [] type Utils () = - static let ShouldRetry (tries, retries, exn : Exception) = - let exceptionRetry = - match exn with - | :? PostgresException as pgexn -> - let sqlState = pgexn.SqlState - let errorClass = sqlState.ErrorClass - sqlState = PostgresErrorCodes.IoError || - sqlState = PostgresErrorCodes.DeadlockDetected || - sqlState = PostgresErrorCodes.LockNotAvailable || - sqlState = PostgresErrorCodes.TransactionIntegrityConstraintViolation || - sqlState = PostgresErrorCodes.InFailedSqlTransaction || - errorClass = PostgresErrorCodes.ConnectionException.ErrorClass || - errorClass = PostgresErrorCodes.InsufficientResources.ErrorClass - | :? NpgsqlException -> true - | _ -> false - if exceptionRetry - then retries < 1 || tries < retries - else false + static let ShouldRetry (tries, retries) = + retries < 1 || tries < retries + + static let ShouldRetryWithConnection (tries, retries, connection: NpgsqlConnection) = + ShouldRetry (tries, retries) && + (connection.State &&& ConnectionState.Open = ConnectionState.Open) static let rec SetupConnectionAsync' (tries, exns, retries, wait, cmd: NpgsqlCommand, connection) = async { match connection with | Choice1Of2 connectionString -> cmd.Connection <- new NpgsqlConnection (connectionString) - let! choice = cmd.Connection.OpenAsync () |> Async.AwaitTask |> Async.Catch + let! choice = cmd.Connection.OpenAsync () |> Async.AwaitTask |> Async.CatchDb match choice with | Choice1Of2 () -> () | Choice2Of2 exn -> - if ShouldRetry (tries, retries, exn) && - (cmd.Connection.State &&& ConnectionState.Open = ConnectionState.Open) then + if ShouldRetryWithConnection (tries, retries, cmd.Connection) then do! Async.Sleep wait do! SetupConnectionAsync' (tries+1, exn :: exns, retries, wait, cmd, connection) - else raise (AggregateException (Seq.rev exns)) + else return raise (AggregateException (Seq.rev exns)) | Choice2Of2 (conn, tx) -> cmd.Connection <- conn cmd.Transaction <- tx } @@ -65,7 +74,7 @@ type Utils () = static let rec Read' (tries, exns, retries, wait: int, cursor: DbDataReader) = try cursor.Read () with exn -> - if ShouldRetry (tries, retries, exn) then + if ShouldRetry (tries, retries) then Thread.Sleep wait Read' (tries+1, exn :: exns, retries, wait, cursor) else @@ -73,66 +82,63 @@ type Utils () = static let rec ReadAsync' (tries, exns, retries, wait, cursor: DbDataReader) = async { - let! choice = cursor.ReadAsync () |> Async.AwaitTask |> Async.Catch + let! choice = cursor.ReadAsync () |> Async.AwaitTask |> Async.CatchDb match choice with | Choice1Of2 go -> return go | Choice2Of2 exn -> - if ShouldRetry (tries, retries, exn) then + if ShouldRetry (tries, retries) then do! Async.Sleep wait return! ReadAsync' (tries+1, exn :: exns, retries, wait, cursor) else - return (raise (AggregateException (Seq.rev exns))) } + return raise (AggregateException (Seq.rev exns)) } static let rec NextResultAsync' (tries, exns, retries, wait, cursor: DbDataReader) = async { - let! choice = cursor.NextResultAsync () |> Async.AwaitTask |> Async.Catch + let! choice = cursor.NextResultAsync () |> Async.AwaitTask |> Async.CatchDb match choice with | Choice1Of2 go -> return go | Choice2Of2 exn -> - if ShouldRetry (tries, retries, exn) then + if ShouldRetry (tries, retries) then do! Async.Sleep wait return! NextResultAsync' (tries+1, exn :: exns, retries, wait, cursor) else - return (raise (AggregateException (Seq.rev exns))) } + return raise (AggregateException (Seq.rev exns)) } static let rec PrepareAsync' (tries, exns, retries, wait, cmd: NpgsqlCommand) = async { - let! choice = cmd.PrepareAsync () |> Async.AwaitTask |> Async.Catch + let! choice = cmd.PrepareAsync () |> Async.AwaitTask |> Async.CatchDb match choice with | Choice1Of2 () -> return () | Choice2Of2 exn -> - if ShouldRetry (tries, retries, exn) && - (cmd.Connection.State &&& ConnectionState.Open = ConnectionState.Open) then + if ShouldRetryWithConnection (tries, retries, cmd.Connection) then do! Async.Sleep wait return! PrepareAsync' (tries+1, exn :: exns, retries, wait, cmd) else - return (raise (AggregateException (Seq.rev exns))) } + return raise (AggregateException (Seq.rev exns)) } static let rec ExecuteReaderAsync' (tries, exns, retries, wait, behavior: CommandBehavior, cmd: NpgsqlCommand) = async { - let! choice = cmd.ExecuteReaderAsync behavior |> Async.AwaitTask |> Async.Catch + let! choice = cmd.ExecuteReaderAsync behavior |> Async.AwaitTask |> Async.CatchDb match choice with | Choice1Of2 task -> return task | Choice2Of2 exn -> - if ShouldRetry (tries, retries, exn) && - (cmd.Connection.State &&& ConnectionState.Open = ConnectionState.Open) then + if ShouldRetryWithConnection (tries, retries, cmd.Connection) then do! Async.Sleep wait return! ExecuteReaderAsync' (tries+1, exn :: exns, retries, wait, behavior, cmd) else - return (raise (AggregateException (Seq.rev exns))) } + return raise (AggregateException (Seq.rev exns)) } static let rec ExecuteNonQueryAsync' (tries, exns, retries, wait, cmd: NpgsqlCommand) = async { - let! choice = cmd.ExecuteNonQueryAsync () |> Async.AwaitTask |> Async.Catch + let! choice = cmd.ExecuteNonQueryAsync () |> Async.AwaitTask |> Async.CatchDb match choice with | Choice1Of2 rowsAffected -> return rowsAffected | Choice2Of2 exn -> - if ShouldRetry (tries, retries, exn) && - (cmd.Connection.State &&& ConnectionState.Open = ConnectionState.Open) then + if ShouldRetryWithConnection (tries, retries, cmd.Connection) then do! Async.Sleep wait return! ExecuteNonQueryAsync' (tries+1, exn :: exns, retries, wait, cmd) else - return (raise (AggregateException (Seq.rev exns))) } + return raise (AggregateException (Seq.rev exns)) } static let getColumnMapping = let cache = ConcurrentDictionary obj> () From cd1c770072794e9257112c4bc1e55f10491b0eb5 Mon Sep 17 00:00:00 2001 From: symboliq Date: Fri, 16 Jul 2021 11:05:39 -0400 Subject: [PATCH 13/42] Got rid of Read retry function. --- src/Runtime/Utils.fs | 74 +++++++++++++++++--------------------------- 1 file changed, 29 insertions(+), 45 deletions(-) diff --git a/src/Runtime/Utils.fs b/src/Runtime/Utils.fs index c3c476e..25af181 100644 --- a/src/Runtime/Utils.fs +++ b/src/Runtime/Utils.fs @@ -22,27 +22,28 @@ module internal LocalExtensions = then this.Substring 2 else raise (InvalidOperationException ()) - module Async = - let CatchDb a = - async { - try - let! result = a - return Choice1Of2 result - with - | :? PostgresException as pgexn -> - let sqlState = pgexn.SqlState - let errorClass = sqlState.ErrorClass - if sqlState = PostgresErrorCodes.IoError || - sqlState = PostgresErrorCodes.DeadlockDetected || - sqlState = PostgresErrorCodes.LockNotAvailable || - sqlState = PostgresErrorCodes.TransactionIntegrityConstraintViolation || - sqlState = PostgresErrorCodes.InFailedSqlTransaction || - errorClass = PostgresErrorCodes.ConnectionException.ErrorClass || - errorClass = PostgresErrorCodes.InsufficientResources.ErrorClass then - return Choice2Of2 (pgexn :> Exception) - else return raise pgexn - | :? NpgsqlException as npgsexn -> return (Choice2Of2 (npgsexn :> Exception)) - | exn -> return raise exn } +[] +module internal Async = + let CatchDb a = + async { + try + let! result = a + return Choice1Of2 result + with + | :? PostgresException as pgexn -> + let sqlState = pgexn.SqlState + let errorClass = sqlState.ErrorClass + if sqlState = PostgresErrorCodes.IoError || + sqlState = PostgresErrorCodes.DeadlockDetected || + sqlState = PostgresErrorCodes.LockNotAvailable || + sqlState = PostgresErrorCodes.TransactionIntegrityConstraintViolation || + sqlState = PostgresErrorCodes.InFailedSqlTransaction || + errorClass = PostgresErrorCodes.ConnectionException.ErrorClass || + errorClass = PostgresErrorCodes.InsufficientResources.ErrorClass then + return Choice2Of2 (pgexn :> Exception) + else return raise pgexn + | :? NpgsqlException as npgsexn -> return (Choice2Of2 (npgsexn :> Exception)) + | exn -> return raise exn } [] type Utils () = @@ -71,15 +72,6 @@ type Utils () = cmd.Connection <- conn cmd.Transaction <- tx } - static let rec Read' (tries, exns, retries, wait: int, cursor: DbDataReader) = - try cursor.Read () - with exn -> - if ShouldRetry (tries, retries) then - Thread.Sleep wait - Read' (tries+1, exn :: exns, retries, wait, cursor) - else - raise (AggregateException (Seq.rev exns)) - static let rec ReadAsync' (tries, exns, retries, wait, cursor: DbDataReader) = async { let! choice = cursor.ReadAsync () |> Async.AwaitTask |> Async.CatchDb @@ -89,8 +81,7 @@ type Utils () = if ShouldRetry (tries, retries) then do! Async.Sleep wait return! ReadAsync' (tries+1, exn :: exns, retries, wait, cursor) - else - return raise (AggregateException (Seq.rev exns)) } + else return raise (AggregateException (Seq.rev exns)) } static let rec NextResultAsync' (tries, exns, retries, wait, cursor: DbDataReader) = async { @@ -101,8 +92,7 @@ type Utils () = if ShouldRetry (tries, retries) then do! Async.Sleep wait return! NextResultAsync' (tries+1, exn :: exns, retries, wait, cursor) - else - return raise (AggregateException (Seq.rev exns)) } + else return raise (AggregateException (Seq.rev exns)) } static let rec PrepareAsync' (tries, exns, retries, wait, cmd: NpgsqlCommand) = async { @@ -113,8 +103,7 @@ type Utils () = if ShouldRetryWithConnection (tries, retries, cmd.Connection) then do! Async.Sleep wait return! PrepareAsync' (tries+1, exn :: exns, retries, wait, cmd) - else - return raise (AggregateException (Seq.rev exns)) } + else return raise (AggregateException (Seq.rev exns)) } static let rec ExecuteReaderAsync' (tries, exns, retries, wait, behavior: CommandBehavior, cmd: NpgsqlCommand) = async { @@ -125,8 +114,7 @@ type Utils () = if ShouldRetryWithConnection (tries, retries, cmd.Connection) then do! Async.Sleep wait return! ExecuteReaderAsync' (tries+1, exn :: exns, retries, wait, behavior, cmd) - else - return raise (AggregateException (Seq.rev exns)) } + else return raise (AggregateException (Seq.rev exns)) } static let rec ExecuteNonQueryAsync' (tries, exns, retries, wait, cmd: NpgsqlCommand) = async { @@ -137,8 +125,7 @@ type Utils () = if ShouldRetryWithConnection (tries, retries, cmd.Connection) then do! Async.Sleep wait return! ExecuteNonQueryAsync' (tries+1, exn :: exns, retries, wait, cmd) - else - return raise (AggregateException (Seq.rev exns)) } + else return raise (AggregateException (Seq.rev exns)) } static let getColumnMapping = let cache = ConcurrentDictionary obj> () @@ -208,9 +195,6 @@ type Utils () = async { do! SetupConnectionAsync' (0, [], retries, wait, cmd, connection) } - static member Read (retries, wait, cursor) = - Read' (0, [], retries, wait, cursor) - static member ReadAsync (retries, wait, cursor) = async { return! ReadAsync' (0, [], retries, wait, cursor) } @@ -360,7 +344,7 @@ type Utils () = seq { let rowReader = getRowToTupleReader resultSet (resultType = ResultType.Records) - while Utils.Read (10, 1000, cursor) do (* TODO: pull args from cfg. *) + while Utils.ReadAsync (10, 1000, cursor) |> Async.RunSynchronously do (* TODO: pull args from cfg. *) rowReader.Invoke cursor |> unbox<'TItem> } @@ -389,7 +373,7 @@ type Utils () = seq { let columnMapping = getColumnMapping resultSet.ExpectedColumns.[0] - while Utils.Read (10, 1000, cursor) do (* TODO: pull args from cfg. *) + while Utils.ReadAsync (10, 1000, cursor) |> Async.RunSynchronously do (* TODO: pull args from cfg. *) cursor.GetValue 0 |> columnMapping |> unbox<'TItem> From 4899cf3e53c521336fcbf37644eb07ebbf2200f7 Mon Sep 17 00:00:00 2001 From: symboliq Date: Fri, 16 Jul 2021 11:54:45 -0400 Subject: [PATCH 14/42] Parameterized NpgsqlConnection and NpgsqlCommand type providers with Retries and RetryWaitTime. --- src/DesignTime/NpgsqlConnectionProvider.fs | 23 +++++++++++++++------- src/Runtime/ISqlCommand.fs | 10 +++++++--- src/Runtime/Utils.fs | 5 ++--- 3 files changed, 25 insertions(+), 13 deletions(-) diff --git a/src/DesignTime/NpgsqlConnectionProvider.fs b/src/DesignTime/NpgsqlConnectionProvider.fs index 5cead74..fdb32f1 100644 --- a/src/DesignTime/NpgsqlConnectionProvider.fs +++ b/src/DesignTime/NpgsqlConnectionProvider.fs @@ -18,7 +18,8 @@ let schemaCache = ConcurrentDictionary () let addCreateCommandMethod(connectionString, rootType: ProvidedTypeDefinition, commands: ProvidedTypeDefinition, customTypes: Map, dbSchemaLookups: DbSchemaLookups, globalXCtor, globalPrepare: bool, - providedTypeReuse, methodTypes, globalCollectionType: CollectionType, globalCommandTimeout : int) = + providedTypeReuse, methodTypes, globalCollectionType: CollectionType, globalCommandTimeout: int, + globalRetries: int, globalRetryWaitTime: int) = let staticParams = [ @@ -31,15 +32,17 @@ let addCreateCommandMethod(connectionString, rootType: ProvidedTypeDefinition, if not globalXCtor then yield ProvidedStaticParameter("XCtor", typeof, false) yield ProvidedStaticParameter("Prepare", typeof, globalPrepare) yield ProvidedStaticParameter("CommandTimeout", typeof, globalCommandTimeout) + yield ProvidedStaticParameter("Retries", typeof, globalRetries) + yield ProvidedStaticParameter("RetryWaitTime", typeof, globalRetryWaitTime) ] let m = ProvidedMethod("CreateCommand", [], typeof, isStatic = true) m.DefineStaticParameters(staticParams, (fun methodName args -> - let sqlStatement, resultType, collectionType, singleRow, allParametersOptional, typename, xctor, (prepare: bool), (commandTimeout : int) = + let sqlStatement, resultType, collectionType, singleRow, allParametersOptional, typename, xctor, (prepare: bool), (commandTimeout: int), (retries: int), (retryWaitTime: int) = if not globalXCtor then - args.[0] :?> _ , args.[1] :?> _, args.[2] :?> _, args.[3] :?> _, args.[4] :?> _, args.[5] :?> _, args.[6] :?> _, args.[7] :?> _, args.[8] :?> _ + args.[0] :?> _ , args.[1] :?> _, args.[2] :?> _, args.[3] :?> _, args.[4] :?> _, args.[5] :?> _, args.[6] :?> _, args.[7] :?> _, args.[8] :?> _, args.[9] :?> _, args.[10] :?> _ else - args.[0] :?> _ , args.[1] :?> _, args.[2] :?> _, args.[3] :?> _, args.[4] :?> _, args.[5] :?> _, true, args.[6] :?> _, args.[7] :?> _ + args.[0] :?> _ , args.[1] :?> _, args.[2] :?> _, args.[3] :?> _, args.[4] :?> _, args.[5] :?> _, true, args.[6] :?> _, args.[7] :?> _, args.[8] :?> _, args.[9] :?> _ //let methodName = Regex.Replace(methodName, @"\s+", " ", RegexOptions.Multiline).Replace("\"", "").Replace("@", ":").Replace("CreateCommand,CommandText=", "").Trim() let commandTypeName = if typename <> "" then typename else methodName @@ -85,6 +88,8 @@ let addCreateCommandMethod(connectionString, rootType: ProvidedTypeDefinition, QuotationsFactory.BuildDataColumnsExpr (statements, resultType <> ResultType.DataTable) Expr.Value prepare Expr.Value commandTimeout + Expr.Value retries + Expr.Value retryWaitTime ])) let method = QuotationsFactory.GetCommandFactoryMethod (cmdProvidedType, designTimeConfig, xctor, commandTypeName) @@ -160,7 +165,7 @@ let createTableTypes(customTypes : Map, item: Db tables -let createRootType (assembly, nameSpace: string, typeName, connectionString, xctor, prepare, reuseProvidedTypes, methodTypes, collectionType, commandTimeout) = +let createRootType (assembly, nameSpace: string, typeName, connectionString, xctor, prepare, reuseProvidedTypes, methodTypes, collectionType, commandTimeout, retries, retryWaitTime) = if String.IsNullOrWhiteSpace connectionString then invalidArg "Connection" "Value is empty!" let databaseRootType = ProvidedTypeDefinition (assembly, nameSpace, typeName, baseType = Some typeof, hideObjectMethods = true) @@ -191,7 +196,7 @@ let createRootType (assembly, nameSpace: string, typeName, connectionString, xct let commands = ProvidedTypeDefinition("Commands", None) databaseRootType.AddMember commands let providedTypeReuse = if reuseProvidedTypes then WithCache typeCache else NoReuse - addCreateCommandMethod (connectionString, databaseRootType, commands, customTypes, schemaLookups, xctor, prepare, providedTypeReuse, methodTypes, collectionType, commandTimeout) + addCreateCommandMethod (connectionString, databaseRootType, commands, customTypes, schemaLookups, xctor, prepare, providedTypeReuse, methodTypes, collectionType, commandTimeout, retries, retryWaitTime) databaseRootType @@ -208,8 +213,10 @@ let internal getProviderType (assembly, nameSpace) = ProvidedStaticParameter("MethodTypes", typeof, MethodTypes.Sync ||| MethodTypes.Async) ProvidedStaticParameter("CollectionType", typeof, CollectionType.List) ProvidedStaticParameter("CommandTimeout", typeof, 0) + ProvidedStaticParameter("Retries", typeof, 10) + ProvidedStaticParameter("RetryWaitTime", typeof, 1000) ], - fun typeName args -> typeCache.GetOrAdd (typeName, fun typeName -> createRootType (assembly, nameSpace, typeName, unbox args.[0], unbox args.[1], unbox args.[2], unbox args.[3], unbox args.[4], unbox args.[5], unbox args.[6]))) + fun typeName args -> typeCache.GetOrAdd (typeName, fun typeName -> createRootType (assembly, nameSpace, 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]))) providerType.AddXmlDoc """ Typed access to PostgreSQL programmable objects, tables and functions. @@ -220,6 +227,8 @@ let internal getProviderType (assembly, nameSpace) = Indicates whether to generate Execute, AsyncExecute or both methods for commands. Indicates whether rows should be returned in a list, array or ResizeArray. The time to wait (in seconds) while trying to execute a command before terminating the attempt and generating an error. Set to zero for infinity. +The number of retries alotted for a database operation. Set to 0 for infinity. +The time to wait (in milliseconds) while waiting to retry a databased operation before terminating the attempt and generating an error. Set to zero for infinity. """ providerType diff --git a/src/Runtime/ISqlCommand.fs b/src/Runtime/ISqlCommand.fs index 0dced20..cf4216f 100644 --- a/src/Runtime/ISqlCommand.fs +++ b/src/Runtime/ISqlCommand.fs @@ -29,10 +29,12 @@ type DesignTimeConfig = { SingleRow: bool ResultSets: ResultSetDefinition[] Prepare: bool - CommandTimeout : int + CommandTimeout: int + Retries: int + RetryWaitTime: int } with - static member Create (sql, ps, resultType, collection, singleRow, (columns: DataColumn[][]), prepare, commandTimeout) = { + static member Create (sql, ps, resultType, collection, singleRow, (columns: DataColumn[][]), prepare, commandTimeout, retries, retryWaitTime) = { SqlStatement = sql Parameters = ps ResultType = resultType @@ -40,7 +42,9 @@ type DesignTimeConfig = { SingleRow = singleRow ResultSets = columns |> Array.map (fun r -> CreateResultSetDefinition (r, resultType)) Prepare = prepare - CommandTimeout = commandTimeout } + CommandTimeout = commandTimeout + Retries = retries + RetryWaitTime = retryWaitTime } [] type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> DesignTimeConfig, connection, commandTimeout) = diff --git a/src/Runtime/Utils.fs b/src/Runtime/Utils.fs index 25af181..2f8a5c8 100644 --- a/src/Runtime/Utils.fs +++ b/src/Runtime/Utils.fs @@ -5,11 +5,10 @@ open System.Data open System.Data.Common open System.Collections.Concurrent open System.ComponentModel -open System.Threading +open System.Linq.Expressions open Npgsql open NpgsqlTypes open FSharp.Control.Tasks.NonAffine -open System.Linq.Expressions #nowarn "0025" @@ -33,7 +32,7 @@ module internal Async = | :? PostgresException as pgexn -> let sqlState = pgexn.SqlState let errorClass = sqlState.ErrorClass - if sqlState = PostgresErrorCodes.IoError || + if sqlState = PostgresErrorCodes.IoError || sqlState = PostgresErrorCodes.DeadlockDetected || sqlState = PostgresErrorCodes.LockNotAvailable || sqlState = PostgresErrorCodes.TransactionIntegrityConstraintViolation || From 1a6b54f7de5cddbc0674437b585fca8bfa7a190d Mon Sep 17 00:00:00 2001 From: symboliq Date: Fri, 16 Jul 2021 12:21:25 -0400 Subject: [PATCH 15/42] Renamed Retries to Tries. Applied config to retry functions. --- src/DesignTime/NpgsqlConnectionProvider.fs | 18 ++-- src/Runtime/ISqlCommand.fs | 28 +++--- src/Runtime/Utils.fs | 102 ++++++++++----------- 3 files changed, 74 insertions(+), 74 deletions(-) diff --git a/src/DesignTime/NpgsqlConnectionProvider.fs b/src/DesignTime/NpgsqlConnectionProvider.fs index fdb32f1..cfc79f6 100644 --- a/src/DesignTime/NpgsqlConnectionProvider.fs +++ b/src/DesignTime/NpgsqlConnectionProvider.fs @@ -19,7 +19,7 @@ let addCreateCommandMethod(connectionString, rootType: ProvidedTypeDefinition, commands: ProvidedTypeDefinition, customTypes: Map, dbSchemaLookups: DbSchemaLookups, globalXCtor, globalPrepare: bool, providedTypeReuse, methodTypes, globalCollectionType: CollectionType, globalCommandTimeout: int, - globalRetries: int, globalRetryWaitTime: int) = + globalTries: int, globalRetryWaitTime: int) = let staticParams = [ @@ -32,13 +32,13 @@ let addCreateCommandMethod(connectionString, rootType: ProvidedTypeDefinition, if not globalXCtor then yield ProvidedStaticParameter("XCtor", typeof, false) yield ProvidedStaticParameter("Prepare", typeof, globalPrepare) yield ProvidedStaticParameter("CommandTimeout", typeof, globalCommandTimeout) - yield ProvidedStaticParameter("Retries", typeof, globalRetries) + yield ProvidedStaticParameter("Tries", typeof, globalTries) yield ProvidedStaticParameter("RetryWaitTime", typeof, globalRetryWaitTime) ] let m = ProvidedMethod("CreateCommand", [], typeof, isStatic = true) m.DefineStaticParameters(staticParams, (fun methodName args -> - let sqlStatement, resultType, collectionType, singleRow, allParametersOptional, typename, xctor, (prepare: bool), (commandTimeout: int), (retries: int), (retryWaitTime: int) = + let sqlStatement, resultType, collectionType, singleRow, allParametersOptional, typename, xctor, (prepare: bool), (commandTimeout: int), (tries: int), (retryWaitTime: int) = if not globalXCtor then args.[0] :?> _ , args.[1] :?> _, args.[2] :?> _, args.[3] :?> _, args.[4] :?> _, args.[5] :?> _, args.[6] :?> _, args.[7] :?> _, args.[8] :?> _, args.[9] :?> _, args.[10] :?> _ else @@ -88,7 +88,7 @@ let addCreateCommandMethod(connectionString, rootType: ProvidedTypeDefinition, QuotationsFactory.BuildDataColumnsExpr (statements, resultType <> ResultType.DataTable) Expr.Value prepare Expr.Value commandTimeout - Expr.Value retries + Expr.Value tries Expr.Value retryWaitTime ])) @@ -165,7 +165,7 @@ let createTableTypes(customTypes : Map, item: Db tables -let createRootType (assembly, nameSpace: string, typeName, connectionString, xctor, prepare, reuseProvidedTypes, methodTypes, collectionType, commandTimeout, retries, retryWaitTime) = +let createRootType (assembly, nameSpace: string, typeName, connectionString, xctor, prepare, reuseProvidedTypes, methodTypes, collectionType, commandTimeout, tries, retryWaitTime) = if String.IsNullOrWhiteSpace connectionString then invalidArg "Connection" "Value is empty!" let databaseRootType = ProvidedTypeDefinition (assembly, nameSpace, typeName, baseType = Some typeof, hideObjectMethods = true) @@ -196,7 +196,7 @@ let createRootType (assembly, nameSpace: string, typeName, connectionString, xct let commands = ProvidedTypeDefinition("Commands", None) databaseRootType.AddMember commands let providedTypeReuse = if reuseProvidedTypes then WithCache typeCache else NoReuse - addCreateCommandMethod (connectionString, databaseRootType, commands, customTypes, schemaLookups, xctor, prepare, providedTypeReuse, methodTypes, collectionType, commandTimeout, retries, retryWaitTime) + addCreateCommandMethod (connectionString, databaseRootType, commands, customTypes, schemaLookups, xctor, prepare, providedTypeReuse, methodTypes, collectionType, commandTimeout, tries, retryWaitTime) databaseRootType @@ -213,8 +213,8 @@ let internal getProviderType (assembly, nameSpace) = ProvidedStaticParameter("MethodTypes", typeof, MethodTypes.Sync ||| MethodTypes.Async) ProvidedStaticParameter("CollectionType", typeof, CollectionType.List) ProvidedStaticParameter("CommandTimeout", typeof, 0) - ProvidedStaticParameter("Retries", typeof, 10) - ProvidedStaticParameter("RetryWaitTime", typeof, 1000) + ProvidedStaticParameter("Tries", typeof, 1) + ProvidedStaticParameter("RetryWaitTime", typeof, 1000) // TODO: make sure this is a sensible default. ], fun typeName args -> typeCache.GetOrAdd (typeName, fun typeName -> createRootType (assembly, nameSpace, 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]))) @@ -227,7 +227,7 @@ let internal getProviderType (assembly, nameSpace) = Indicates whether to generate Execute, AsyncExecute or both methods for commands. Indicates whether rows should be returned in a list, array or ResizeArray. The time to wait (in seconds) while trying to execute a command before terminating the attempt and generating an error. Set to zero for infinity. -The number of retries alotted for a database operation. Set to 0 for infinity. +The number of attempts alotted for a database operation. Set to 0 for infinity. The time to wait (in milliseconds) while waiting to retry a databased operation before terminating the attempt and generating an error. Set to zero for infinity. """ providerType diff --git a/src/Runtime/ISqlCommand.fs b/src/Runtime/ISqlCommand.fs index cf4216f..454386a 100644 --- a/src/Runtime/ISqlCommand.fs +++ b/src/Runtime/ISqlCommand.fs @@ -30,11 +30,11 @@ type DesignTimeConfig = { ResultSets: ResultSetDefinition[] Prepare: bool CommandTimeout: int - Retries: int + Tries: int RetryWaitTime: int } with - static member Create (sql, ps, resultType, collection, singleRow, (columns: DataColumn[][]), prepare, commandTimeout, retries, retryWaitTime) = { + static member Create (sql, ps, resultType, collection, singleRow, (columns: DataColumn[][]), prepare, commandTimeout, tries, retryWaitTime) = { SqlStatement = sql Parameters = ps ResultType = resultType @@ -43,7 +43,7 @@ type DesignTimeConfig = { ResultSets = columns |> Array.map (fun r -> CreateResultSetDefinition (r, resultType)) Prepare = prepare CommandTimeout = commandTimeout - Retries = retries + Tries = tries RetryWaitTime = retryWaitTime } [] @@ -164,13 +164,13 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design static member internal AsyncExecuteDataReaderTask (cfg, cmd, connection, parameters) = Unsafe.uply { ISqlCommandImplementation.SetParameters (cmd, parameters) - do! Utils.SetupConnectionAsync (10, 1000, cmd, connection) (* TODO: pull args from cfg. *) + do! Utils.SetupConnectionAsync (cfg.Tries, cfg.RetryWaitTime, cmd, connection) let readerBehavior = getReaderBehavior (connection, cfg) if cfg.Prepare then - do! Utils.PrepareAsync (10, 1000, cmd) (* TODO: pull args from cfg. *) + do! Utils.PrepareAsync (cfg.Tries, cfg.RetryWaitTime, cmd) - let! cursor = Utils.ExecuteReaderAsync (10, 1000, readerBehavior, cmd) (* TODO: pull args from cfg. *) + let! cursor = Utils.ExecuteReaderAsync (cfg.Tries, cfg.RetryWaitTime, readerBehavior, cmd) return cursor :?> NpgsqlDataReader } static member internal AsyncExecuteReader (cfg, cmd, connection, parameters, executionType) = @@ -213,7 +213,7 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design // TODO output params static member internal ExecuteSingle<'TItem> () = Func<_, _, _, _>(fun reader resultSetDefinition cfg -> Unsafe.uply { - let! xs = MapRowValues<'TItem> (reader, cfg.ResultType, resultSetDefinition) + let! xs = MapRowValues<'TItem> (cfg.Tries, cfg.RetryWaitTime, reader, cfg.ResultType, resultSetDefinition) return if cfg.SingleRow then @@ -232,9 +232,9 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design let xs = if cfg.ResultSets.[0].ExpectedColumns.Length > 1 then - MapRowValuesOntoTupleLazy<'TItem> (reader, cfg.ResultType, cfg.ResultSets.[0]) + MapRowValuesOntoTupleLazy<'TItem> (cfg.Tries, cfg.RetryWaitTime, reader, cfg.ResultType, cfg.ResultSets.[0]) else - MapRowValuesLazy<'TItem> (reader, cfg.ResultSets.[0]) + MapRowValuesLazy<'TItem> (cfg.Tries, cfg.RetryWaitTime, reader, cfg.ResultSets.[0]) return new LazySeq<'TItem> (xs, reader, cmd) } @@ -242,7 +242,7 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design else let xs = Unsafe.uply { use! reader = ISqlCommandImplementation.AsyncExecuteDataReaderTask (cfg, cmd, connection, parameters) - return! MapRowValues<'TItem> (reader, cfg.ResultType, cfg.ResultSets.[0]) } + return! MapRowValues<'TItem> (cfg.Tries, cfg.RetryWaitTime, reader, cfg.ResultType, cfg.ResultSets.[0]) } if cfg.SingleRow then let t = Unsafe.uply { @@ -297,7 +297,7 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design let currentStatement = GetStatementIndex.Invoke cursor let! res = ISqlCommandImplementation.ReadResultSet (cursor, cfg.ResultSets.[currentStatement], cfg) results.[currentStatement] <- res - let! more = Utils.NextResultAsync (10, 1000, cursor) (* TODO: pull args from cfg. *) + let! more = Utils.NextResultAsync (cfg.Tries, cfg.RetryWaitTime, cursor) go <- more ISqlCommandImplementation.SetNumberOfAffectedRows (results, cmd.Statements) @@ -308,14 +308,14 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design static member internal AsyncExecuteNonQuery (cfg, cmd, connection, parameters, executionType) = let t = Unsafe.uply { ISqlCommandImplementation.SetParameters (cmd, parameters) - do! Utils.SetupConnectionAsync (10, 1000, cmd, connection) (* TODO: pull args from cfg. *) + do! Utils.SetupConnectionAsync (cfg.Tries, cfg.RetryWaitTime, cmd, connection) let readerBehavior = getReaderBehavior (connection, cfg) use _ = if readerBehavior.HasFlag CommandBehavior.CloseConnection then cmd.Connection else null if cfg.Prepare then - do! Utils.PrepareAsync (10, 1000, cmd) (* TODO: pull args from cfg. *) + do! Utils.PrepareAsync (cfg.Tries, cfg.RetryWaitTime, cmd) - return! Utils.ExecuteNonQueryAsync (10, 1000, cmd) (* TODO: pull args from cfg. *)} + return! Utils.ExecuteNonQueryAsync (cfg.Tries, cfg.RetryWaitTime, cmd) } mapTask (t, executionType) diff --git a/src/Runtime/Utils.fs b/src/Runtime/Utils.fs index 2f8a5c8..e8cba8d 100644 --- a/src/Runtime/Utils.fs +++ b/src/Runtime/Utils.fs @@ -47,14 +47,14 @@ module internal Async = [] type Utils () = - static let ShouldRetry (tries, retries) = - retries < 1 || tries < retries + static let ShouldRetry (triesCurrent, triesMax) = + triesMax <= 0 || triesCurrent < triesMax - static let ShouldRetryWithConnection (tries, retries, connection: NpgsqlConnection) = - ShouldRetry (tries, retries) && + static let ShouldRetryWithConnection (triesCurrent, triesMax, connection: NpgsqlConnection) = + ShouldRetry (triesCurrent, triesMax) && (connection.State &&& ConnectionState.Open = ConnectionState.Open) - static let rec SetupConnectionAsync' (tries, exns, retries, wait, cmd: NpgsqlCommand, connection) = + static let rec SetupConnectionAsync' (triesCurrent, exns, triesMax, retryWaitTime, cmd: NpgsqlCommand, connection) = async { match connection with | Choice1Of2 connectionString -> @@ -63,67 +63,67 @@ type Utils () = match choice with | Choice1Of2 () -> () | Choice2Of2 exn -> - if ShouldRetryWithConnection (tries, retries, cmd.Connection) then - do! Async.Sleep wait - do! SetupConnectionAsync' (tries+1, exn :: exns, retries, wait, cmd, connection) + if ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then + do! Async.Sleep retryWaitTime + do! SetupConnectionAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, cmd, connection) else return raise (AggregateException (Seq.rev exns)) | Choice2Of2 (conn, tx) -> cmd.Connection <- conn cmd.Transaction <- tx } - static let rec ReadAsync' (tries, exns, retries, wait, cursor: DbDataReader) = + static let rec ReadAsync' (triesCurrent, exns, triesMax, retryWaitTime, cursor: DbDataReader) = async { let! choice = cursor.ReadAsync () |> Async.AwaitTask |> Async.CatchDb match choice with | Choice1Of2 go -> return go | Choice2Of2 exn -> - if ShouldRetry (tries, retries) then - do! Async.Sleep wait - return! ReadAsync' (tries+1, exn :: exns, retries, wait, cursor) + if ShouldRetry (triesCurrent, triesMax) then + do! Async.Sleep retryWaitTime + return! ReadAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, cursor) else return raise (AggregateException (Seq.rev exns)) } - static let rec NextResultAsync' (tries, exns, retries, wait, cursor: DbDataReader) = + static let rec NextResultAsync' (triesCurrent, exns, triesMax, retryWaitTime, cursor: DbDataReader) = async { let! choice = cursor.NextResultAsync () |> Async.AwaitTask |> Async.CatchDb match choice with | Choice1Of2 go -> return go | Choice2Of2 exn -> - if ShouldRetry (tries, retries) then - do! Async.Sleep wait - return! NextResultAsync' (tries+1, exn :: exns, retries, wait, cursor) + if ShouldRetry (triesCurrent, triesMax) then + do! Async.Sleep retryWaitTime + return! NextResultAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, cursor) else return raise (AggregateException (Seq.rev exns)) } - static let rec PrepareAsync' (tries, exns, retries, wait, cmd: NpgsqlCommand) = + static let rec PrepareAsync' (triesCurrent, exns, triesMax, retryWaitTime, cmd: NpgsqlCommand) = async { let! choice = cmd.PrepareAsync () |> Async.AwaitTask |> Async.CatchDb match choice with | Choice1Of2 () -> return () | Choice2Of2 exn -> - if ShouldRetryWithConnection (tries, retries, cmd.Connection) then - do! Async.Sleep wait - return! PrepareAsync' (tries+1, exn :: exns, retries, wait, cmd) + if ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then + do! Async.Sleep retryWaitTime + return! PrepareAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, cmd) else return raise (AggregateException (Seq.rev exns)) } - static let rec ExecuteReaderAsync' (tries, exns, retries, wait, behavior: CommandBehavior, cmd: NpgsqlCommand) = + static let rec ExecuteReaderAsync' (triesCurrent, exns, triesMax, retryWaitTime, behavior: CommandBehavior, cmd: NpgsqlCommand) = async { let! choice = cmd.ExecuteReaderAsync behavior |> Async.AwaitTask |> Async.CatchDb match choice with | Choice1Of2 task -> return task | Choice2Of2 exn -> - if ShouldRetryWithConnection (tries, retries, cmd.Connection) then - do! Async.Sleep wait - return! ExecuteReaderAsync' (tries+1, exn :: exns, retries, wait, behavior, cmd) + if ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then + do! Async.Sleep retryWaitTime + return! ExecuteReaderAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, behavior, cmd) else return raise (AggregateException (Seq.rev exns)) } - static let rec ExecuteNonQueryAsync' (tries, exns, retries, wait, cmd: NpgsqlCommand) = + static let rec ExecuteNonQueryAsync' (triesCurrent, exns, triesMax, retryWaitTime, cmd: NpgsqlCommand) = async { let! choice = cmd.ExecuteNonQueryAsync () |> Async.AwaitTask |> Async.CatchDb match choice with | Choice1Of2 rowsAffected -> return rowsAffected | Choice2Of2 exn -> - if ShouldRetryWithConnection (tries, retries, cmd.Connection) then - do! Async.Sleep wait - return! ExecuteNonQueryAsync' (tries+1, exn :: exns, retries, wait, cmd) + if ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then + do! Async.Sleep retryWaitTime + return! ExecuteNonQueryAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, cmd) else return raise (AggregateException (Seq.rev exns)) } static let getColumnMapping = @@ -190,29 +190,29 @@ type Utils () = cache.[resultSet.ExpectedColumns.GetHashCode ()] <- func func - static member SetupConnectionAsync (retries, wait, cmd, connection) = + static member SetupConnectionAsync (tries, retryWaitTime, cmd, connection) = async { - do! SetupConnectionAsync' (0, [], retries, wait, cmd, connection) } + do! SetupConnectionAsync' (0, [], tries, retryWaitTime, cmd, connection) } - static member ReadAsync (retries, wait, cursor) = + static member ReadAsync (tries, retryWaitTime, cursor) = async { - return! ReadAsync' (0, [], retries, wait, cursor) } + return! ReadAsync' (0, [], tries, retryWaitTime, cursor) } - static member NextResultAsync (retries, wait, cursor) = + static member NextResultAsync (tries, retryWaitTime, cursor) = async { - return! NextResultAsync' (0, [], retries, wait, cursor) } + return! NextResultAsync' (0, [], tries, retryWaitTime, cursor) } - static member PrepareAsync (retries, wait, cmd) = + static member PrepareAsync (tries, retryWaitTime, cmd) = async { - return! PrepareAsync' (0, [], retries, wait, cmd) } + return! PrepareAsync' (0, [], tries, retryWaitTime, cmd) } - static member ExecuteReaderAsync (retries, wait, behavior, cmd) = + static member ExecuteReaderAsync (tries, retryWaitTime, behavior, cmd) = async { - return! ExecuteReaderAsync' (0, [], retries, wait, behavior, cmd) } + return! ExecuteReaderAsync' (0, [], tries, retryWaitTime, behavior, cmd) } - static member ExecuteNonQueryAsync (retries, wait, cmd) = + static member ExecuteNonQueryAsync (tries, retryWaitTime, cmd) = async { - return! ExecuteNonQueryAsync' (0, [], retries, wait, cmd) } + return! ExecuteNonQueryAsync' (0, [], tries, retryWaitTime, cmd) } static member ResizeArrayToList ra = let rec inner (ra: ResizeArray<'a>, index, acc) = @@ -322,11 +322,11 @@ type Utils () = let [| columnName; typeName; nullable |] = stringValues.Split '|' new DataColumn (columnName, Utils.GetType typeName, AllowDBNull = (nullable = "1")) - static member MapRowValuesOntoTuple<'TItem> (cursor: DbDataReader, resultType, resultSet) = Unsafe.uply { + static member MapRowValuesOntoTuple<'TItem> (tries, retryWaitTime, cursor: DbDataReader, resultType, resultSet) = Unsafe.uply { let results = ResizeArray<'TItem> () let rowReader = getRowToTupleReader resultSet (resultType = ResultType.Records) - let! go = Utils.ReadAsync (10, 1000, cursor) (* TODO: pull args from cfg. *) + let! go = Utils.ReadAsync (tries, retryWaitTime, cursor) let mutable go = go while go do @@ -334,27 +334,27 @@ type Utils () = |> unbox |> results.Add - let! cont = Utils.ReadAsync (10, 1000, cursor) (* TODO: pull args from cfg. *) + let! cont = Utils.ReadAsync (tries, retryWaitTime, cursor) go <- cont return results } - static member MapRowValuesOntoTupleLazy<'TItem> (cursor: DbDataReader, resultType, resultSet) = + static member MapRowValuesOntoTupleLazy<'TItem> (tries, retryWaitTime, cursor: DbDataReader, resultType, resultSet) = seq { let rowReader = getRowToTupleReader resultSet (resultType = ResultType.Records) - while Utils.ReadAsync (10, 1000, cursor) |> Async.RunSynchronously do (* TODO: pull args from cfg. *) + while Utils.ReadAsync (tries, retryWaitTime, cursor) |> Async.RunSynchronously do rowReader.Invoke cursor |> unbox<'TItem> } - static member MapRowValues<'TItem> (cursor: DbDataReader, resultType, resultSet: ResultSetDefinition) = + static member MapRowValues<'TItem> (tries, retryWaitTime, cursor: DbDataReader, resultType, resultSet: ResultSetDefinition) = if resultSet.ExpectedColumns.Length > 1 then - Utils.MapRowValuesOntoTuple<'TItem> (cursor, resultType, resultSet) + Utils.MapRowValuesOntoTuple<'TItem> (tries, retryWaitTime, cursor, resultType, resultSet) else Unsafe.uply { let columnMapping = getColumnMapping resultSet.ExpectedColumns.[0] let results = ResizeArray<'TItem> () - let! go = Utils.ReadAsync (10, 1000, cursor) (* TODO: pull args from cfg. *) + let! go = Utils.ReadAsync (tries, retryWaitTime, cursor) let mutable go = go while go do @@ -363,16 +363,16 @@ type Utils () = |> unbox |> results.Add - let! cont = Utils.ReadAsync (10, 1000, cursor) (* TODO: pull args from cfg. *) + let! cont = Utils.ReadAsync (tries, retryWaitTime, cursor) go <- cont return results } - static member MapRowValuesLazy<'TItem> (cursor: DbDataReader, resultSet) = + static member MapRowValuesLazy<'TItem> (tries, retryWaitTime, cursor: DbDataReader, resultSet) = seq { let columnMapping = getColumnMapping resultSet.ExpectedColumns.[0] - while Utils.ReadAsync (10, 1000, cursor) |> Async.RunSynchronously do (* TODO: pull args from cfg. *) + while Utils.ReadAsync (tries, retryWaitTime, cursor) |> Async.RunSynchronously do cursor.GetValue 0 |> columnMapping |> unbox<'TItem> From 2ed06e2956f173afb107834f8fe4039489a0910a Mon Sep 17 00:00:00 2001 From: symboliq Date: Fri, 16 Jul 2021 14:26:22 -0400 Subject: [PATCH 16/42] Placing retries around data table Load. --- src/Runtime/ISqlCommand.fs | 9 ++-- src/Runtime/Utils.fs | 77 +++++++++++++++++++++------------- tests/NpgsqlConnectionTests.fs | 8 ++++ 3 files changed, 62 insertions(+), 32 deletions(-) diff --git a/src/Runtime/ISqlCommand.fs b/src/Runtime/ISqlCommand.fs index 454386a..7cbed3d 100644 --- a/src/Runtime/ISqlCommand.fs +++ b/src/Runtime/ISqlCommand.fs @@ -176,13 +176,14 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design static member internal AsyncExecuteReader (cfg, cmd, connection, parameters, executionType) = mapTask (ISqlCommandImplementation.AsyncExecuteDataReaderTask (cfg, cmd, connection, parameters), executionType) - static member internal LoadDataTable (cursor: Common.DbDataReader) cmd (columns: DataColumn[]) = + static member internal LoadDataTable cfg (cursor: Common.DbDataReader) (cmd: NpgsqlCommand) (columns: DataColumn[]) = + let result = new FSharp.Data.Npgsql.DataTable(selectCommand = cmd) for c in columns do CloneDataColumn c |> result.Columns.Add - result.Load cursor + Utils.LoadDataTable (cfg.Tries, cfg.RetryWaitTime, cursor, cmd, result) result static member internal AsyncExecuteDataTables (cfg, cmd, connection, parameters, executionType) = @@ -197,7 +198,7 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design null else ISqlCommandImplementation.VerifyOutputColumns(cursor, resultSet.ExpectedColumns) - ISqlCommandImplementation.LoadDataTable cursor (cmd.Clone()) resultSet.ExpectedColumns |> box) + ISqlCommandImplementation.LoadDataTable cfg cursor (cmd.Clone()) resultSet.ExpectedColumns |> box) ISqlCommandImplementation.SetNumberOfAffectedRows (results, cmd.Statements) return results } @@ -207,7 +208,7 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design static member internal AsyncExecuteDataTable (cfg, cmd, connection, parameters, executionType) = let t = Unsafe.uply { use! reader = ISqlCommandImplementation.AsyncExecuteDataReaderTask (cfg, cmd, connection, parameters) - return ISqlCommandImplementation.LoadDataTable reader (cmd.Clone()) cfg.ResultSets.[0].ExpectedColumns } + return ISqlCommandImplementation.LoadDataTable cfg reader (cmd.Clone()) cfg.ResultSets.[0].ExpectedColumns } mapTask (t, executionType) diff --git a/src/Runtime/Utils.fs b/src/Runtime/Utils.fs index e8cba8d..40601f2 100644 --- a/src/Runtime/Utils.fs +++ b/src/Runtime/Utils.fs @@ -5,6 +5,7 @@ open System.Data open System.Data.Common open System.Collections.Concurrent open System.ComponentModel +open System.Threading open System.Linq.Expressions open Npgsql open NpgsqlTypes @@ -16,6 +17,7 @@ open FSharp.Control.Tasks.NonAffine module internal LocalExtensions = type String with + member this.ErrorClass = if this.Length >= 2 then this.Substring 2 @@ -23,36 +25,52 @@ module internal LocalExtensions = [] module internal Async = + + let ShouldRetry (triesCurrent, triesMax) = + triesMax <= 0 || triesCurrent < triesMax + + let ShouldRetryWithConnection (triesCurrent, triesMax, connection: NpgsqlConnection) = + ShouldRetry (triesCurrent, triesMax) && + (connection.State &&& ConnectionState.Open = ConnectionState.Open) + + let rec FilterDb (exn: Exception) = + match exn with + | :? PostgresException as pgexn -> + let sqlState = pgexn.SqlState + let errorClass = sqlState.ErrorClass + if sqlState = PostgresErrorCodes.IoError || + sqlState = PostgresErrorCodes.DeadlockDetected || + sqlState = PostgresErrorCodes.LockNotAvailable || + sqlState = PostgresErrorCodes.TransactionIntegrityConstraintViolation || + sqlState = PostgresErrorCodes.InFailedSqlTransaction || + sqlState = PostgresErrorCodes.TooManyConnections || + errorClass = PostgresErrorCodes.ConnectionException.ErrorClass || + errorClass = PostgresErrorCodes.InsufficientResources.ErrorClass then + true + else false + | :? NpgsqlException -> + true + | :? AggregateException as aggexn -> + Seq.forall FilterDb aggexn.InnerExceptions + let CatchDb a = async { try let! result = a return Choice1Of2 result - with - | :? PostgresException as pgexn -> - let sqlState = pgexn.SqlState - let errorClass = sqlState.ErrorClass - if sqlState = PostgresErrorCodes.IoError || - sqlState = PostgresErrorCodes.DeadlockDetected || - sqlState = PostgresErrorCodes.LockNotAvailable || - sqlState = PostgresErrorCodes.TransactionIntegrityConstraintViolation || - sqlState = PostgresErrorCodes.InFailedSqlTransaction || - errorClass = PostgresErrorCodes.ConnectionException.ErrorClass || - errorClass = PostgresErrorCodes.InsufficientResources.ErrorClass then - return Choice2Of2 (pgexn :> Exception) - else return raise pgexn - | :? NpgsqlException as npgsexn -> return (Choice2Of2 (npgsexn :> Exception)) - | exn -> return raise exn } + with exn when FilterDb exn -> + return Choice2Of2 exn } [] type Utils () = - static let ShouldRetry (triesCurrent, triesMax) = - triesMax <= 0 || triesCurrent < triesMax - - static let ShouldRetryWithConnection (triesCurrent, triesMax, connection: NpgsqlConnection) = - ShouldRetry (triesCurrent, triesMax) && - (connection.State &&& ConnectionState.Open = ConnectionState.Open) + static let rec LoadDataTable' (triesCurrent, exns, triesMax, (retryWaitTime: int), cursor, cmd: NpgsqlCommand, result: DataRow DataTable) = + try result.Load cursor + with exn when Async.FilterDb exn -> + if Async.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then + Thread.Sleep retryWaitTime + LoadDataTable' (triesCurrent + 1, exn :: exns, triesMax, retryWaitTime, cursor, cmd, result) + else raise (AggregateException (Seq.rev exns)) static let rec SetupConnectionAsync' (triesCurrent, exns, triesMax, retryWaitTime, cmd: NpgsqlCommand, connection) = async { @@ -63,7 +81,7 @@ type Utils () = match choice with | Choice1Of2 () -> () | Choice2Of2 exn -> - if ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then + if Async.ShouldRetry (triesCurrent, triesMax) then do! Async.Sleep retryWaitTime do! SetupConnectionAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, cmd, connection) else return raise (AggregateException (Seq.rev exns)) @@ -77,7 +95,7 @@ type Utils () = match choice with | Choice1Of2 go -> return go | Choice2Of2 exn -> - if ShouldRetry (triesCurrent, triesMax) then + if Async.ShouldRetry (triesCurrent, triesMax) then do! Async.Sleep retryWaitTime return! ReadAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, cursor) else return raise (AggregateException (Seq.rev exns)) } @@ -88,7 +106,7 @@ type Utils () = match choice with | Choice1Of2 go -> return go | Choice2Of2 exn -> - if ShouldRetry (triesCurrent, triesMax) then + if Async.ShouldRetry (triesCurrent, triesMax) then do! Async.Sleep retryWaitTime return! NextResultAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, cursor) else return raise (AggregateException (Seq.rev exns)) } @@ -99,7 +117,7 @@ type Utils () = match choice with | Choice1Of2 () -> return () | Choice2Of2 exn -> - if ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then + if Async.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then do! Async.Sleep retryWaitTime return! PrepareAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, cmd) else return raise (AggregateException (Seq.rev exns)) } @@ -108,9 +126,9 @@ type Utils () = async { let! choice = cmd.ExecuteReaderAsync behavior |> Async.AwaitTask |> Async.CatchDb match choice with - | Choice1Of2 task -> return task + | Choice1Of2 reader -> return reader | Choice2Of2 exn -> - if ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then + if Async.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then do! Async.Sleep retryWaitTime return! ExecuteReaderAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, behavior, cmd) else return raise (AggregateException (Seq.rev exns)) } @@ -121,7 +139,7 @@ type Utils () = match choice with | Choice1Of2 rowsAffected -> return rowsAffected | Choice2Of2 exn -> - if ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then + if Async.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then do! Async.Sleep retryWaitTime return! ExecuteNonQueryAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, cmd) else return raise (AggregateException (Seq.rev exns)) } @@ -190,6 +208,9 @@ type Utils () = cache.[resultSet.ExpectedColumns.GetHashCode ()] <- func func + static member LoadDataTable (tries, retryWaitTime, cursor, cmd, result) = + LoadDataTable' (0, [], tries, retryWaitTime, cursor, cmd, result) + static member SetupConnectionAsync (tries, retryWaitTime, cmd, connection) = async { do! SetupConnectionAsync' (0, [], tries, retryWaitTime, cmd, connection) } diff --git a/tests/NpgsqlConnectionTests.fs b/tests/NpgsqlConnectionTests.fs index e5e2418..b161451 100644 --- a/tests/NpgsqlConnectionTests.fs +++ b/tests/NpgsqlConnectionTests.fs @@ -151,6 +151,14 @@ let paramInLimit() = [] let getRentalById = "SELECT return_date FROM rental WHERE rental_id = @id" +[] +let retryWorks () = + seq { + for _ in 1 .. 20 do + let cmd = DvdRental.CreateCommand<"SELECT * FROM rental", ResultType.DataTable, Tries = 10>(connectionString) + yield cmd.AsyncExecute () } + |> Async.Parallel + [] let dateTableWithUpdate() = From 8026719e58d4952ea8f49420b9e64875220a68e1 Mon Sep 17 00:00:00 2001 From: symboliq Date: Fri, 16 Jul 2021 14:39:46 -0400 Subject: [PATCH 17/42] Fixed match failure exception. --- src/Runtime/Utils.fs | 3 ++- tests/NpgsqlConnectionTests.fs | 6 +++++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/src/Runtime/Utils.fs b/src/Runtime/Utils.fs index 40601f2..bb52b63 100644 --- a/src/Runtime/Utils.fs +++ b/src/Runtime/Utils.fs @@ -52,6 +52,7 @@ module internal Async = true | :? AggregateException as aggexn -> Seq.forall FilterDb aggexn.InnerExceptions + | _ -> false let CatchDb a = async { @@ -64,7 +65,7 @@ module internal Async = [] type Utils () = - static let rec LoadDataTable' (triesCurrent, exns, triesMax, (retryWaitTime: int), cursor, cmd: NpgsqlCommand, result: DataRow DataTable) = + static let rec LoadDataTable' (triesCurrent, exns, triesMax, retryWaitTime: int, cursor, cmd: NpgsqlCommand, result: DataRow DataTable) = try result.Load cursor with exn when Async.FilterDb exn -> if Async.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then diff --git a/tests/NpgsqlConnectionTests.fs b/tests/NpgsqlConnectionTests.fs index b161451..c3da350 100644 --- a/tests/NpgsqlConnectionTests.fs +++ b/tests/NpgsqlConnectionTests.fs @@ -156,7 +156,11 @@ let retryWorks () = seq { for _ in 1 .. 20 do let cmd = DvdRental.CreateCommand<"SELECT * FROM rental", ResultType.DataTable, Tries = 10>(connectionString) - yield cmd.AsyncExecute () } + yield + (async { + let! result = cmd.AsyncExecute () + (cmd :> IDisposable).Dispose () + return result }) } |> Async.Parallel [] From bc2a77047fe9eaf8f30978ba7a69487db05df402 Mon Sep 17 00:00:00 2001 From: symboliq Date: Fri, 16 Jul 2021 14:44:25 -0400 Subject: [PATCH 18/42] Minor code clean-up. --- tests/NpgsqlConnectionTests.fs | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/tests/NpgsqlConnectionTests.fs b/tests/NpgsqlConnectionTests.fs index c3da350..97bd1a7 100644 --- a/tests/NpgsqlConnectionTests.fs +++ b/tests/NpgsqlConnectionTests.fs @@ -156,11 +156,10 @@ let retryWorks () = seq { for _ in 1 .. 20 do let cmd = DvdRental.CreateCommand<"SELECT * FROM rental", ResultType.DataTable, Tries = 10>(connectionString) - yield - (async { - let! result = cmd.AsyncExecute () - (cmd :> IDisposable).Dispose () - return result }) } + yield async { + let! result = cmd.AsyncExecute () + (cmd :> IDisposable).Dispose () + return result } } |> Async.Parallel [] From 3bca52ce8b2c38c963dc8fe9fa529070a0938b26 Mon Sep 17 00:00:00 2001 From: symboliq Date: Fri, 16 Jul 2021 14:51:41 -0400 Subject: [PATCH 19/42] Created Retry module to hold retry algos. --- src/Runtime/Utils.fs | 29 ++++++++++++++++------------- 1 file changed, 16 insertions(+), 13 deletions(-) diff --git a/src/Runtime/Utils.fs b/src/Runtime/Utils.fs index bb52b63..f219f4d 100644 --- a/src/Runtime/Utils.fs +++ b/src/Runtime/Utils.fs @@ -24,8 +24,8 @@ module internal LocalExtensions = else raise (InvalidOperationException ()) [] -module internal Async = - +module internal Retry = + let ShouldRetry (triesCurrent, triesMax) = triesMax <= 0 || triesCurrent < triesMax @@ -33,7 +33,7 @@ module internal Async = ShouldRetry (triesCurrent, triesMax) && (connection.State &&& ConnectionState.Open = ConnectionState.Open) - let rec FilterDb (exn: Exception) = + let rec ShouldRetryException (exn: Exception) = match exn with | :? PostgresException as pgexn -> let sqlState = pgexn.SqlState @@ -51,15 +51,18 @@ module internal Async = | :? NpgsqlException -> true | :? AggregateException as aggexn -> - Seq.forall FilterDb aggexn.InnerExceptions + Seq.forall ShouldRetryException aggexn.InnerExceptions | _ -> false +[] +module internal Async = + let CatchDb a = async { try let! result = a return Choice1Of2 result - with exn when FilterDb exn -> + with exn when Retry.ShouldRetryException exn -> return Choice2Of2 exn } [] @@ -67,8 +70,8 @@ type Utils () = static let rec LoadDataTable' (triesCurrent, exns, triesMax, retryWaitTime: int, cursor, cmd: NpgsqlCommand, result: DataRow DataTable) = try result.Load cursor - with exn when Async.FilterDb exn -> - if Async.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then + with exn when Retry.ShouldRetryException exn -> + if Retry.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then Thread.Sleep retryWaitTime LoadDataTable' (triesCurrent + 1, exn :: exns, triesMax, retryWaitTime, cursor, cmd, result) else raise (AggregateException (Seq.rev exns)) @@ -82,7 +85,7 @@ type Utils () = match choice with | Choice1Of2 () -> () | Choice2Of2 exn -> - if Async.ShouldRetry (triesCurrent, triesMax) then + if Retry.ShouldRetry (triesCurrent, triesMax) then do! Async.Sleep retryWaitTime do! SetupConnectionAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, cmd, connection) else return raise (AggregateException (Seq.rev exns)) @@ -96,7 +99,7 @@ type Utils () = match choice with | Choice1Of2 go -> return go | Choice2Of2 exn -> - if Async.ShouldRetry (triesCurrent, triesMax) then + if Retry.ShouldRetry (triesCurrent, triesMax) then do! Async.Sleep retryWaitTime return! ReadAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, cursor) else return raise (AggregateException (Seq.rev exns)) } @@ -107,7 +110,7 @@ type Utils () = match choice with | Choice1Of2 go -> return go | Choice2Of2 exn -> - if Async.ShouldRetry (triesCurrent, triesMax) then + if Retry.ShouldRetry (triesCurrent, triesMax) then do! Async.Sleep retryWaitTime return! NextResultAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, cursor) else return raise (AggregateException (Seq.rev exns)) } @@ -118,7 +121,7 @@ type Utils () = match choice with | Choice1Of2 () -> return () | Choice2Of2 exn -> - if Async.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then + if Retry.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then do! Async.Sleep retryWaitTime return! PrepareAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, cmd) else return raise (AggregateException (Seq.rev exns)) } @@ -129,7 +132,7 @@ type Utils () = match choice with | Choice1Of2 reader -> return reader | Choice2Of2 exn -> - if Async.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then + if Retry.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then do! Async.Sleep retryWaitTime return! ExecuteReaderAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, behavior, cmd) else return raise (AggregateException (Seq.rev exns)) } @@ -140,7 +143,7 @@ type Utils () = match choice with | Choice1Of2 rowsAffected -> return rowsAffected | Choice2Of2 exn -> - if Async.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then + if Retry.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then do! Async.Sleep retryWaitTime return! ExecuteNonQueryAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, cmd) else return raise (AggregateException (Seq.rev exns)) } From 03998e3ba5ec891b54ccc9bc98fe775130127dd9 Mon Sep 17 00:00:00 2001 From: symboliq Date: Fri, 16 Jul 2021 16:38:41 -0400 Subject: [PATCH 20/42] Removed likely useless Thread.Sleep. --- src/Runtime/Utils.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Runtime/Utils.fs b/src/Runtime/Utils.fs index f219f4d..f328016 100644 --- a/src/Runtime/Utils.fs +++ b/src/Runtime/Utils.fs @@ -5,7 +5,6 @@ open System.Data open System.Data.Common open System.Collections.Concurrent open System.ComponentModel -open System.Threading open System.Linq.Expressions open Npgsql open NpgsqlTypes @@ -72,7 +71,8 @@ type Utils () = try result.Load cursor with exn when Retry.ShouldRetryException exn -> if Retry.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then - Thread.Sleep retryWaitTime + // NOTE: doing a Thread.Sleep here doesn't help. + // I am not convinced this code is meant to be run parallel. LoadDataTable' (triesCurrent + 1, exn :: exns, triesMax, retryWaitTime, cursor, cmd, result) else raise (AggregateException (Seq.rev exns)) From da9f66400c30ff6c9b71ad99b268a1b7278f60f1 Mon Sep 17 00:00:00 2001 From: symboliq Date: Mon, 19 Jul 2021 11:28:54 -0400 Subject: [PATCH 21/42] Got new test 'working'... --- tests/NpgsqlConnectionTests.fs | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/tests/NpgsqlConnectionTests.fs b/tests/NpgsqlConnectionTests.fs index 97bd1a7..d64f791 100644 --- a/tests/NpgsqlConnectionTests.fs +++ b/tests/NpgsqlConnectionTests.fs @@ -2,8 +2,9 @@ module NpgsqlConnectionTests open System open Xunit -open FSharp.Data.Npgsql open System.Reflection +open System.Threading.Tasks +open FSharp.Data.Npgsql open type Npgsql.NpgsqlNetTopologySuiteExtensions open NetTopologySuite.Geometries @@ -153,14 +154,17 @@ let getRentalById = "SELECT return_date FROM rental WHERE rental_id = @id" [] let retryWorks () = - seq { - for _ in 1 .. 20 do - let cmd = DvdRental.CreateCommand<"SELECT * FROM rental", ResultType.DataTable, Tries = 10>(connectionString) - yield async { - let! result = cmd.AsyncExecute () - (cmd :> IDisposable).Dispose () - return result } } - |> Async.Parallel + let op = + seq { + for _ in 1 .. 10 do + let connStrWithIncorrectPort = "Host=localhost;Username=postgres;Password=postgres;Database=dvdrental;Port=1313" + let cmd = DvdRental.CreateCommand<"SELECT * FROM rental", ResultType.DataTable, Tries = 5> connStrWithIncorrectPort + yield async { + let! result = cmd.AsyncExecute () + (cmd :> IDisposable).Dispose () + return result }} + |> Async.Parallel + Assert.ThrowsAsync (new Func<_> (fun () -> op |> Async.Ignore |> Async.StartAsTask |> fun t -> t :> Task)) // is this enough conversion boiler-plate for ya? [] let dateTableWithUpdate() = From 93e253c093cf3657c2a3c99a98afd138613f69ec Mon Sep 17 00:00:00 2001 From: symboliq Date: Mon, 19 Jul 2021 21:51:48 -0400 Subject: [PATCH 22/42] Trying to figure out how to implement a type provider property... not going so great. --- Tests.sln | 6 ++++++ src/DesignTime/QuotationsFactory.fs | 10 ++++++++-- tests/NpgsqlConnectionTests.fs | 6 +++--- 3 files changed, 17 insertions(+), 5 deletions(-) diff --git a/Tests.sln b/Tests.sln index 8dcc226..33390ef 100644 --- a/Tests.sln +++ b/Tests.sln @@ -12,6 +12,8 @@ Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Tests", "tests\Tests.fsproj EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "DesignTime", "src\DesignTime\DesignTime.fsproj", "{BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}" EndProject +Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Runtime", "src\Runtime\Runtime.fsproj", "{60EE6560-7903-4B15-8A7D-AF71B8093659}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -26,6 +28,10 @@ Global {BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}.Debug|Any CPU.Build.0 = Debug|Any CPU {BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}.Release|Any CPU.ActiveCfg = Release|Any CPU {BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}.Release|Any CPU.Build.0 = Release|Any CPU + {60EE6560-7903-4B15-8A7D-AF71B8093659}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {60EE6560-7903-4B15-8A7D-AF71B8093659}.Debug|Any CPU.Build.0 = Debug|Any CPU + {60EE6560-7903-4B15-8A7D-AF71B8093659}.Release|Any CPU.ActiveCfg = Release|Any CPU + {60EE6560-7903-4B15-8A7D-AF71B8093659}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE diff --git a/src/DesignTime/QuotationsFactory.fs b/src/DesignTime/QuotationsFactory.fs index bb1b791..9336294 100644 --- a/src/DesignTime/QuotationsFactory.fs +++ b/src/DesignTime/QuotationsFactory.fs @@ -483,5 +483,11 @@ type internal QuotationsFactory () = addRedirectToISqlCommandMethods resultSetsType None cmdProvidedType.AddMember resultSetsType - - + + cmdProvidedType.AddMember ( + ProvidedProperty ( + "RetryCallback", + typeof<(Exception -> unit) ref>, + getterCode = (fun args -> <@@ !(%%args.[0] : (Exception -> unit) ref) @@>), + setterCode = (fun args -> <@@ (%%args.[0] : (Exception -> unit) ref) := !(%%args.[1] : (Exception -> unit) ref) @@>), + isStatic = false)) diff --git a/tests/NpgsqlConnectionTests.fs b/tests/NpgsqlConnectionTests.fs index d64f791..3ac0ad4 100644 --- a/tests/NpgsqlConnectionTests.fs +++ b/tests/NpgsqlConnectionTests.fs @@ -72,7 +72,6 @@ let selectLiterals() = DvdRental.CreateCommand<" SELECT 42 AS Answer, current_date as today ">(connectionString) - let x = cmd.Execute() |> Seq.exactlyOne Assert.Equal(Some 42, x.answer) Assert.Equal(Some DateTime.Now.Date, x.today) @@ -157,8 +156,9 @@ let retryWorks () = let op = seq { for _ in 1 .. 10 do - let connStrWithIncorrectPort = "Host=localhost;Username=postgres;Password=postgres;Database=dvdrental;Port=1313" - let cmd = DvdRental.CreateCommand<"SELECT * FROM rental", ResultType.DataTable, Tries = 5> connStrWithIncorrectPort + let connectionStrWithIncorrectPort = "Host=localhost;Username=postgres;Password=postgres;Database=dvdrental;Port=1313" + let cmd = DvdRental.CreateCommand<"SELECT * FROM rental", ResultType.DataTable, Tries = 5> connectionStrWithIncorrectPort + cmd.RetryCallback <- ref (fun (exn : Exception) -> printfn "%A" exn) yield async { let! result = cmd.AsyncExecute () (cmd :> IDisposable).Dispose () From 90e5368e9e8236e7b1e418bf0b9df04ab8538854 Mon Sep 17 00:00:00 2001 From: symboliq Date: Mon, 19 Jul 2021 22:29:34 -0400 Subject: [PATCH 23/42] Attempted to improve property provider implementation... --- src/DesignTime/QuotationsFactory.fs | 12 +++++++++--- tests/NpgsqlConnectionTests.fs | 2 +- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/src/DesignTime/QuotationsFactory.fs b/src/DesignTime/QuotationsFactory.fs index 9336294..3f12173 100644 --- a/src/DesignTime/QuotationsFactory.fs +++ b/src/DesignTime/QuotationsFactory.fs @@ -483,11 +483,17 @@ type internal QuotationsFactory () = addRedirectToISqlCommandMethods resultSetsType None cmdProvidedType.AddMember resultSetsType + + let retryCallback = + ProvidedField ("retryCallback", typeof unit>) + + cmdProvidedType.AddMember ( + retryCallback) cmdProvidedType.AddMember ( ProvidedProperty ( "RetryCallback", - typeof<(Exception -> unit) ref>, - getterCode = (fun args -> <@@ !(%%args.[0] : (Exception -> unit) ref) @@>), - setterCode = (fun args -> <@@ (%%args.[0] : (Exception -> unit) ref) := !(%%args.[1] : (Exception -> unit) ref) @@>), + typeof unit>, + getterCode = (fun args -> <@@ retryCallback.GetValue (%%args.[0] : ISqlCommandImplementation) :?> (Exception -> unit) @@>), + setterCode = (fun args -> <@@ retryCallback.SetValue ((%%args.[0] : ISqlCommandImplementation), (%%args.[1] : Exception -> unit)) @@>), isStatic = false)) diff --git a/tests/NpgsqlConnectionTests.fs b/tests/NpgsqlConnectionTests.fs index 3ac0ad4..b1413f2 100644 --- a/tests/NpgsqlConnectionTests.fs +++ b/tests/NpgsqlConnectionTests.fs @@ -158,7 +158,7 @@ let retryWorks () = for _ in 1 .. 10 do let connectionStrWithIncorrectPort = "Host=localhost;Username=postgres;Password=postgres;Database=dvdrental;Port=1313" let cmd = DvdRental.CreateCommand<"SELECT * FROM rental", ResultType.DataTable, Tries = 5> connectionStrWithIncorrectPort - cmd.RetryCallback <- ref (fun (exn : Exception) -> printfn "%A" exn) + cmd.RetryCallback <- fun (exn : Exception) -> printfn "%A" exn yield async { let! result = cmd.AsyncExecute () (cmd :> IDisposable).Dispose () From 4b37d8320ecc07a8e6726975aa443b9b0d7eb6ac Mon Sep 17 00:00:00 2001 From: symboliq Date: Tue, 20 Jul 2021 11:51:41 -0400 Subject: [PATCH 24/42] Nothing works at all. --- src/DesignTime/QuotationsFactory.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/DesignTime/QuotationsFactory.fs b/src/DesignTime/QuotationsFactory.fs index 3f12173..b677247 100644 --- a/src/DesignTime/QuotationsFactory.fs +++ b/src/DesignTime/QuotationsFactory.fs @@ -494,6 +494,6 @@ type internal QuotationsFactory () = ProvidedProperty ( "RetryCallback", typeof unit>, - getterCode = (fun args -> <@@ retryCallback.GetValue (%%args.[0] : ISqlCommandImplementation) :?> (Exception -> unit) @@>), - setterCode = (fun args -> <@@ retryCallback.SetValue ((%%args.[0] : ISqlCommandImplementation), (%%args.[1] : Exception -> unit)) @@>), + getterCode = (fun [self] -> Expr.Coerce (Expr.FieldGet (self, retryCallback), typeof unit>)), + setterCode = (fun [self; value] -> Expr.FieldSet (self, retryCallback, value)), isStatic = false)) From 2abadbbabc0d5eaee7913ed93e448874e0988314 Mon Sep 17 00:00:00 2001 From: symboliq Date: Tue, 20 Jul 2021 13:21:18 -0400 Subject: [PATCH 25/42] Reverted retry callback feature. --- src/DesignTime/QuotationsFactory.fs | 14 -------------- tests/NpgsqlConnectionTests.fs | 1 - 2 files changed, 15 deletions(-) diff --git a/src/DesignTime/QuotationsFactory.fs b/src/DesignTime/QuotationsFactory.fs index b677247..46fa560 100644 --- a/src/DesignTime/QuotationsFactory.fs +++ b/src/DesignTime/QuotationsFactory.fs @@ -483,17 +483,3 @@ type internal QuotationsFactory () = addRedirectToISqlCommandMethods resultSetsType None cmdProvidedType.AddMember resultSetsType - - let retryCallback = - ProvidedField ("retryCallback", typeof unit>) - - cmdProvidedType.AddMember ( - retryCallback) - - cmdProvidedType.AddMember ( - ProvidedProperty ( - "RetryCallback", - typeof unit>, - getterCode = (fun [self] -> Expr.Coerce (Expr.FieldGet (self, retryCallback), typeof unit>)), - setterCode = (fun [self; value] -> Expr.FieldSet (self, retryCallback, value)), - isStatic = false)) diff --git a/tests/NpgsqlConnectionTests.fs b/tests/NpgsqlConnectionTests.fs index b1413f2..50f1590 100644 --- a/tests/NpgsqlConnectionTests.fs +++ b/tests/NpgsqlConnectionTests.fs @@ -158,7 +158,6 @@ let retryWorks () = for _ in 1 .. 10 do let connectionStrWithIncorrectPort = "Host=localhost;Username=postgres;Password=postgres;Database=dvdrental;Port=1313" let cmd = DvdRental.CreateCommand<"SELECT * FROM rental", ResultType.DataTable, Tries = 5> connectionStrWithIncorrectPort - cmd.RetryCallback <- fun (exn : Exception) -> printfn "%A" exn yield async { let! result = cmd.AsyncExecute () (cmd :> IDisposable).Dispose () From 812d9955bb66be9b05bb96529490884ea7c719a5 Mon Sep 17 00:00:00 2001 From: symboliq Date: Tue, 20 Jul 2021 20:14:17 -0400 Subject: [PATCH 26/42] First pass of implementing retry callback. --- src/DesignTime/QuotationsFactory.fs | 8 +++ src/Runtime/ISqlCommand.fs | 77 ++++++++++++++------------ src/Runtime/Utils.fs | 85 ++++++++++++++++------------- tests/NpgsqlConnectionTests.fs | 1 + 4 files changed, 96 insertions(+), 75 deletions(-) diff --git a/src/DesignTime/QuotationsFactory.fs b/src/DesignTime/QuotationsFactory.fs index 46fa560..7fff49b 100644 --- a/src/DesignTime/QuotationsFactory.fs +++ b/src/DesignTime/QuotationsFactory.fs @@ -455,6 +455,14 @@ type internal QuotationsFactory () = add (typedefof>.MakeGenericType outputType) "AsyncExecute" xmlDoc if methodTypes.HasFlag MethodTypes.Task then add (typedefof>.MakeGenericType outputType) "TaskAsyncExecute" xmlDoc + if methodTypes.HasFlag MethodTypes.Task then + let name = "GetRetryCallback" + let erasedType = cmdProvidedType.BaseType + let outputType = typeof unit> + let invokeCode (exprArgs : Expr list) = Expr.Call (Expr.Coerce (exprArgs.[0], erasedType), typeof.GetMethod name, []) + let m = ProvidedMethod(name, executeArgs, outputType, invokeCode) + Option.iter m.AddXmlDoc xmlDoc + cmdProvidedType.AddMember m match statements with | _ when resultType = ResultType.DataReader -> diff --git a/src/Runtime/ISqlCommand.fs b/src/Runtime/ISqlCommand.fs index 7cbed3d..0373a62 100644 --- a/src/Runtime/ISqlCommand.fs +++ b/src/Runtime/ISqlCommand.fs @@ -19,6 +19,7 @@ type ISqlCommand = abstract Execute: parameters: (string * obj)[] -> obj abstract AsyncExecute: parameters: (string * obj)[] -> obj abstract TaskAsyncExecute: parameters: (string * obj)[] -> obj + abstract GetRetryCallback: unit -> (Exception -> unit) [] type DesignTimeConfig = { @@ -107,6 +108,9 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design p.Clone () |> cmd.Parameters.Add |> ignore cmd + let mutable retryCallback = + fun (_ : Exception) -> () + static let getReaderBehavior (connection, cfg) = // Don't pass CommandBehavior.SingleRow to Npgsql, because it only applies to the first row of the first result set and all other result sets are completely ignored if cfg.SingleRow && cfg.ResultSets.Length = 1 then CommandBehavior.SingleRow else CommandBehavior.Default @@ -122,9 +126,10 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design | TaskAsync -> box t interface ISqlCommand with - member _.Execute parameters = execute (cfg, cmd, connection, parameters, Sync) - member _.AsyncExecute parameters = execute (cfg, cmd, connection, parameters, Async) - member _.TaskAsyncExecute parameters = execute (cfg, cmd, connection, parameters, TaskAsync) + member _.GetRetryCallback () = retryCallback + member _.Execute parameters = execute (retryCallback, cfg, cmd, connection, parameters, Sync) + member _.AsyncExecute parameters = execute (retryCallback, cfg, cmd, connection, parameters, Async) + member _.TaskAsyncExecute parameters = execute (retryCallback, cfg, cmd, connection, parameters, TaskAsync) interface IDisposable with member _.Dispose () = @@ -162,33 +167,33 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design cursor.Close() invalidOp message - static member internal AsyncExecuteDataReaderTask (cfg, cmd, connection, parameters) = Unsafe.uply { + static member internal AsyncExecuteDataReaderTask (retryCallback, cfg, cmd, connection, parameters) = Unsafe.uply { ISqlCommandImplementation.SetParameters (cmd, parameters) - do! Utils.SetupConnectionAsync (cfg.Tries, cfg.RetryWaitTime, cmd, connection) + do! Utils.SetupConnectionAsync (cfg.Tries, cfg.RetryWaitTime, retryCallback, cmd, connection) let readerBehavior = getReaderBehavior (connection, cfg) if cfg.Prepare then - do! Utils.PrepareAsync (cfg.Tries, cfg.RetryWaitTime, cmd) + do! Utils.PrepareAsync (cfg.Tries, cfg.RetryWaitTime, retryCallback, cmd) - let! cursor = Utils.ExecuteReaderAsync (cfg.Tries, cfg.RetryWaitTime, readerBehavior, cmd) + let! cursor = Utils.ExecuteReaderAsync (cfg.Tries, cfg.RetryWaitTime, retryCallback, readerBehavior, cmd) return cursor :?> NpgsqlDataReader } - static member internal AsyncExecuteReader (cfg, cmd, connection, parameters, executionType) = - mapTask (ISqlCommandImplementation.AsyncExecuteDataReaderTask (cfg, cmd, connection, parameters), executionType) + static member internal AsyncExecuteReader (retryCallback, cfg, cmd, connection, parameters, executionType) = + mapTask (ISqlCommandImplementation.AsyncExecuteDataReaderTask (retryCallback, cfg, cmd, connection, parameters), executionType) - static member internal LoadDataTable cfg (cursor: Common.DbDataReader) (cmd: NpgsqlCommand) (columns: DataColumn[]) = + static member internal LoadDataTable retryCallback cfg (cursor: Common.DbDataReader) (cmd: NpgsqlCommand) (columns: DataColumn[]) = let result = new FSharp.Data.Npgsql.DataTable(selectCommand = cmd) for c in columns do CloneDataColumn c |> result.Columns.Add - Utils.LoadDataTable (cfg.Tries, cfg.RetryWaitTime, cursor, cmd, result) + Utils.LoadDataTable (cfg.Tries, cfg.RetryWaitTime, retryCallback, cursor, cmd, result) result - static member internal AsyncExecuteDataTables (cfg, cmd, connection, parameters, executionType) = + static member internal AsyncExecuteDataTables (retryCallback, cfg, cmd, connection, parameters, executionType) = let t = Unsafe.uply { - use! cursor = ISqlCommandImplementation.AsyncExecuteDataReaderTask (cfg, cmd, connection, parameters) + use! cursor = ISqlCommandImplementation.AsyncExecuteDataReaderTask (retryCallback, cfg, cmd, connection, parameters) // No explicit NextResult calls, Load takes care of it let results = @@ -198,23 +203,23 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design null else ISqlCommandImplementation.VerifyOutputColumns(cursor, resultSet.ExpectedColumns) - ISqlCommandImplementation.LoadDataTable cfg cursor (cmd.Clone()) resultSet.ExpectedColumns |> box) + ISqlCommandImplementation.LoadDataTable retryCallback cfg cursor (cmd.Clone()) resultSet.ExpectedColumns |> box) ISqlCommandImplementation.SetNumberOfAffectedRows (results, cmd.Statements) return results } mapTask (t, executionType) - static member internal AsyncExecuteDataTable (cfg, cmd, connection, parameters, executionType) = + static member internal AsyncExecuteDataTable (retryCallback, cfg, cmd, connection, parameters, executionType) = let t = Unsafe.uply { - use! reader = ISqlCommandImplementation.AsyncExecuteDataReaderTask (cfg, cmd, connection, parameters) - return ISqlCommandImplementation.LoadDataTable cfg reader (cmd.Clone()) cfg.ResultSets.[0].ExpectedColumns } + use! reader = ISqlCommandImplementation.AsyncExecuteDataReaderTask (retryCallback, cfg, cmd, connection, parameters) + return ISqlCommandImplementation.LoadDataTable retryCallback cfg reader (cmd.Clone()) cfg.ResultSets.[0].ExpectedColumns } mapTask (t, executionType) // TODO output params - static member internal ExecuteSingle<'TItem> () = Func<_, _, _, _>(fun reader resultSetDefinition cfg -> Unsafe.uply { - let! xs = MapRowValues<'TItem> (cfg.Tries, cfg.RetryWaitTime, reader, cfg.ResultType, resultSetDefinition) + static member internal ExecuteSingle<'TItem> () = Func<_, _, _, _, _>(fun reader resultSetDefinition retryCallback cfg -> Unsafe.uply { + let! xs = MapRowValues<'TItem> (cfg.Tries, cfg.RetryWaitTime, retryCallback, reader, cfg.ResultType, resultSetDefinition) return if cfg.SingleRow then @@ -226,24 +231,24 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design else box xs }) - static member internal AsyncExecuteList<'TItem> () = fun (cfg, cmd, connection, parameters, executionType) -> + static member internal AsyncExecuteList<'TItem> () = fun (retryCallback, cfg, cmd, connection, parameters, executionType) -> if cfg.CollectionType = CollectionType.LazySeq && not cfg.SingleRow then let t = Unsafe.uply { - let! reader = ISqlCommandImplementation.AsyncExecuteDataReaderTask (cfg, cmd, connection, parameters) + let! reader = ISqlCommandImplementation.AsyncExecuteDataReaderTask (retryCallback, cfg, cmd, connection, parameters) let xs = if cfg.ResultSets.[0].ExpectedColumns.Length > 1 then - MapRowValuesOntoTupleLazy<'TItem> (cfg.Tries, cfg.RetryWaitTime, reader, cfg.ResultType, cfg.ResultSets.[0]) + MapRowValuesOntoTupleLazy<'TItem> (cfg.Tries, cfg.RetryWaitTime, retryCallback, reader, cfg.ResultType, cfg.ResultSets.[0]) else - MapRowValuesLazy<'TItem> (cfg.Tries, cfg.RetryWaitTime, reader, cfg.ResultSets.[0]) + MapRowValuesLazy<'TItem> (cfg.Tries, cfg.RetryWaitTime, retryCallback, reader, cfg.ResultSets.[0]) return new LazySeq<'TItem> (xs, reader, cmd) } mapTask (t, executionType) else let xs = Unsafe.uply { - use! reader = ISqlCommandImplementation.AsyncExecuteDataReaderTask (cfg, cmd, connection, parameters) - return! MapRowValues<'TItem> (cfg.Tries, cfg.RetryWaitTime, reader, cfg.ResultType, cfg.ResultSets.[0]) } + use! reader = ISqlCommandImplementation.AsyncExecuteDataReaderTask (retryCallback, cfg, cmd, connection, parameters) + return! MapRowValues<'TItem> (cfg.Tries, cfg.RetryWaitTime, retryCallback, reader, cfg.ResultType, cfg.ResultSets.[0]) } if cfg.SingleRow then let t = Unsafe.uply { @@ -266,7 +271,7 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design else mapTask (xs, executionType) - static member private ReadResultSet (cursor: Common.DbDataReader, resultSetDefinition, cfg) = + static member private ReadResultSet (cursor: Common.DbDataReader, resultSetDefinition, retryCallback, cfg) = ISqlCommandImplementation.VerifyOutputColumns(cursor, resultSetDefinition.ExpectedColumns) let func = @@ -278,16 +283,16 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design typeof .GetMethod(nameof ISqlCommandImplementation.ExecuteSingle, BindingFlags.NonPublic ||| BindingFlags.Static) .MakeGenericMethod(resultSetDefinition.ErasedRowType) - .Invoke(null, [||]) :?> Func<_, _, _, Ply.Ply> + .Invoke(null, [||]) :?> Func<_, _, _, _, Ply.Ply> executeSingleCache.[resultSetDefinition.ErasedRowType] <- func func - func.Invoke (cursor, resultSetDefinition, cfg) + func.Invoke (cursor, resultSetDefinition, retryCallback, cfg) - static member internal AsyncExecuteMulti (cfg, cmd, connection, parameters, executionType) = + static member internal AsyncExecuteMulti (retryCallback, cfg, cmd, connection, parameters, executionType) = let t = Unsafe.uply { - use! cursor = ISqlCommandImplementation.AsyncExecuteDataReaderTask (cfg, cmd, connection, parameters) + use! cursor = ISqlCommandImplementation.AsyncExecuteDataReaderTask (retryCallback, cfg, cmd, connection, parameters) let results = Array.zeroCreate cmd.Statements.Count // Command contains at least one query @@ -296,9 +301,9 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design while go do let currentStatement = GetStatementIndex.Invoke cursor - let! res = ISqlCommandImplementation.ReadResultSet (cursor, cfg.ResultSets.[currentStatement], cfg) + let! res = ISqlCommandImplementation.ReadResultSet (cursor, cfg.ResultSets.[currentStatement], retryCallback, cfg) results.[currentStatement] <- res - let! more = Utils.NextResultAsync (cfg.Tries, cfg.RetryWaitTime, cursor) + let! more = Utils.NextResultAsync (cfg.Tries, cfg.RetryWaitTime, retryCallback, cursor) go <- more ISqlCommandImplementation.SetNumberOfAffectedRows (results, cmd.Statements) @@ -306,17 +311,17 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design mapTask (t, executionType) - static member internal AsyncExecuteNonQuery (cfg, cmd, connection, parameters, executionType) = + static member internal AsyncExecuteNonQuery (retryCallback, cfg, cmd, connection, parameters, executionType) = let t = Unsafe.uply { ISqlCommandImplementation.SetParameters (cmd, parameters) - do! Utils.SetupConnectionAsync (cfg.Tries, cfg.RetryWaitTime, cmd, connection) + do! Utils.SetupConnectionAsync (cfg.Tries, cfg.RetryWaitTime, retryCallback, cmd, connection) let readerBehavior = getReaderBehavior (connection, cfg) use _ = if readerBehavior.HasFlag CommandBehavior.CloseConnection then cmd.Connection else null if cfg.Prepare then - do! Utils.PrepareAsync (cfg.Tries, cfg.RetryWaitTime, cmd) + do! Utils.PrepareAsync (cfg.Tries, cfg.RetryWaitTime, retryCallback, cmd) - return! Utils.ExecuteNonQueryAsync (cfg.Tries, cfg.RetryWaitTime, cmd) } + return! Utils.ExecuteNonQueryAsync (cfg.Tries, cfg.RetryWaitTime, retryCallback, cmd) } mapTask (t, executionType) diff --git a/src/Runtime/Utils.fs b/src/Runtime/Utils.fs index f328016..cf16198 100644 --- a/src/Runtime/Utils.fs +++ b/src/Runtime/Utils.fs @@ -67,16 +67,17 @@ module internal Async = [] type Utils () = - static let rec LoadDataTable' (triesCurrent, exns, triesMax, retryWaitTime: int, cursor, cmd: NpgsqlCommand, result: DataRow DataTable) = + static let rec LoadDataTable' (triesCurrent, exns, triesMax, retryWaitTime: int, retryCallback, cursor, cmd: NpgsqlCommand, result: DataRow DataTable) = try result.Load cursor with exn when Retry.ShouldRetryException exn -> if Retry.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then // NOTE: doing a Thread.Sleep here doesn't help. // I am not convinced this code is meant to be run parallel. - LoadDataTable' (triesCurrent + 1, exn :: exns, triesMax, retryWaitTime, cursor, cmd, result) + retryCallback exn + LoadDataTable' (triesCurrent + 1, exn :: exns, triesMax, retryWaitTime, retryCallback, cursor, cmd, result) else raise (AggregateException (Seq.rev exns)) - static let rec SetupConnectionAsync' (triesCurrent, exns, triesMax, retryWaitTime, cmd: NpgsqlCommand, connection) = + static let rec SetupConnectionAsync' (triesCurrent, exns, triesMax, retryWaitTime, retryCallback, cmd: NpgsqlCommand, connection) = async { match connection with | Choice1Of2 connectionString -> @@ -87,13 +88,14 @@ type Utils () = | Choice2Of2 exn -> if Retry.ShouldRetry (triesCurrent, triesMax) then do! Async.Sleep retryWaitTime - do! SetupConnectionAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, cmd, connection) + retryCallback exn + do! SetupConnectionAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, retryCallback, cmd, connection) else return raise (AggregateException (Seq.rev exns)) | Choice2Of2 (conn, tx) -> cmd.Connection <- conn cmd.Transaction <- tx } - static let rec ReadAsync' (triesCurrent, exns, triesMax, retryWaitTime, cursor: DbDataReader) = + static let rec ReadAsync' (triesCurrent, exns, triesMax, retryWaitTime, retryCallback, cursor: DbDataReader) = async { let! choice = cursor.ReadAsync () |> Async.AwaitTask |> Async.CatchDb match choice with @@ -101,10 +103,11 @@ type Utils () = | Choice2Of2 exn -> if Retry.ShouldRetry (triesCurrent, triesMax) then do! Async.Sleep retryWaitTime - return! ReadAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, cursor) + retryCallback exn + return! ReadAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, retryCallback, cursor) else return raise (AggregateException (Seq.rev exns)) } - static let rec NextResultAsync' (triesCurrent, exns, triesMax, retryWaitTime, cursor: DbDataReader) = + static let rec NextResultAsync' (triesCurrent, exns, triesMax, retryWaitTime, retryCallback, cursor: DbDataReader) = async { let! choice = cursor.NextResultAsync () |> Async.AwaitTask |> Async.CatchDb match choice with @@ -112,10 +115,11 @@ type Utils () = | Choice2Of2 exn -> if Retry.ShouldRetry (triesCurrent, triesMax) then do! Async.Sleep retryWaitTime - return! NextResultAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, cursor) + retryCallback exn + return! NextResultAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, retryCallback, cursor) else return raise (AggregateException (Seq.rev exns)) } - static let rec PrepareAsync' (triesCurrent, exns, triesMax, retryWaitTime, cmd: NpgsqlCommand) = + static let rec PrepareAsync' (triesCurrent, exns, triesMax, retryWaitTime, retryCallback, cmd: NpgsqlCommand) = async { let! choice = cmd.PrepareAsync () |> Async.AwaitTask |> Async.CatchDb match choice with @@ -123,10 +127,11 @@ type Utils () = | Choice2Of2 exn -> if Retry.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then do! Async.Sleep retryWaitTime - return! PrepareAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, cmd) + retryCallback exn + return! PrepareAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, retryCallback, cmd) else return raise (AggregateException (Seq.rev exns)) } - static let rec ExecuteReaderAsync' (triesCurrent, exns, triesMax, retryWaitTime, behavior: CommandBehavior, cmd: NpgsqlCommand) = + static let rec ExecuteReaderAsync' (triesCurrent, exns, triesMax, retryWaitTime, retryCallback, behavior: CommandBehavior, cmd: NpgsqlCommand) = async { let! choice = cmd.ExecuteReaderAsync behavior |> Async.AwaitTask |> Async.CatchDb match choice with @@ -134,10 +139,11 @@ type Utils () = | Choice2Of2 exn -> if Retry.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then do! Async.Sleep retryWaitTime - return! ExecuteReaderAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, behavior, cmd) + retryCallback exn + return! ExecuteReaderAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, retryCallback, behavior, cmd) else return raise (AggregateException (Seq.rev exns)) } - static let rec ExecuteNonQueryAsync' (triesCurrent, exns, triesMax, retryWaitTime, cmd: NpgsqlCommand) = + static let rec ExecuteNonQueryAsync' (triesCurrent, exns, triesMax, retryWaitTime, retryCallback, cmd: NpgsqlCommand) = async { let! choice = cmd.ExecuteNonQueryAsync () |> Async.AwaitTask |> Async.CatchDb match choice with @@ -145,7 +151,8 @@ type Utils () = | Choice2Of2 exn -> if Retry.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then do! Async.Sleep retryWaitTime - return! ExecuteNonQueryAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, cmd) + retryCallback exn + return! ExecuteNonQueryAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, retryCallback, cmd) else return raise (AggregateException (Seq.rev exns)) } static let getColumnMapping = @@ -212,32 +219,32 @@ type Utils () = cache.[resultSet.ExpectedColumns.GetHashCode ()] <- func func - static member LoadDataTable (tries, retryWaitTime, cursor, cmd, result) = - LoadDataTable' (0, [], tries, retryWaitTime, cursor, cmd, result) + static member LoadDataTable (tries, retryWaitTime, retryCallback, cursor, cmd, result) = + LoadDataTable' (0, [], tries, retryWaitTime, retryCallback, cursor, cmd, result) - static member SetupConnectionAsync (tries, retryWaitTime, cmd, connection) = + static member SetupConnectionAsync (tries, retryWaitTime, retryCallback, cmd, connection) = async { - do! SetupConnectionAsync' (0, [], tries, retryWaitTime, cmd, connection) } + do! SetupConnectionAsync' (0, [], tries, retryWaitTime, retryCallback, cmd, connection) } - static member ReadAsync (tries, retryWaitTime, cursor) = + static member ReadAsync (tries, retryWaitTime, retryCallback, cursor) = async { - return! ReadAsync' (0, [], tries, retryWaitTime, cursor) } + return! ReadAsync' (0, [], tries, retryWaitTime, retryCallback, cursor) } - static member NextResultAsync (tries, retryWaitTime, cursor) = + static member NextResultAsync (tries, retryWaitTime, retryCallback, cursor) = async { - return! NextResultAsync' (0, [], tries, retryWaitTime, cursor) } + return! NextResultAsync' (0, [], tries, retryWaitTime, retryCallback, cursor) } - static member PrepareAsync (tries, retryWaitTime, cmd) = + static member PrepareAsync (tries, retryWaitTime, retryCallback, cmd) = async { - return! PrepareAsync' (0, [], tries, retryWaitTime, cmd) } + return! PrepareAsync' (0, [], tries, retryWaitTime, retryCallback, cmd) } - static member ExecuteReaderAsync (tries, retryWaitTime, behavior, cmd) = + static member ExecuteReaderAsync (tries, retryWaitTime, retryCallback, behavior, cmd) = async { - return! ExecuteReaderAsync' (0, [], tries, retryWaitTime, behavior, cmd) } + return! ExecuteReaderAsync' (0, [], tries, retryWaitTime, retryCallback, behavior, cmd) } - static member ExecuteNonQueryAsync (tries, retryWaitTime, cmd) = + static member ExecuteNonQueryAsync (tries, retryWaitTime, retryCallback, cmd) = async { - return! ExecuteNonQueryAsync' (0, [], tries, retryWaitTime, cmd) } + return! ExecuteNonQueryAsync' (0, [], tries, retryWaitTime, retryCallback, cmd) } static member ResizeArrayToList ra = let rec inner (ra: ResizeArray<'a>, index, acc) = @@ -347,11 +354,11 @@ type Utils () = let [| columnName; typeName; nullable |] = stringValues.Split '|' new DataColumn (columnName, Utils.GetType typeName, AllowDBNull = (nullable = "1")) - static member MapRowValuesOntoTuple<'TItem> (tries, retryWaitTime, cursor: DbDataReader, resultType, resultSet) = Unsafe.uply { + static member MapRowValuesOntoTuple<'TItem> (tries, retryWaitTime, retryCallback, cursor: DbDataReader, resultType, resultSet) = Unsafe.uply { let results = ResizeArray<'TItem> () let rowReader = getRowToTupleReader resultSet (resultType = ResultType.Records) - let! go = Utils.ReadAsync (tries, retryWaitTime, cursor) + let! go = Utils.ReadAsync (tries, retryWaitTime, retryCallback, cursor) let mutable go = go while go do @@ -359,27 +366,27 @@ type Utils () = |> unbox |> results.Add - let! cont = Utils.ReadAsync (tries, retryWaitTime, cursor) + let! cont = Utils.ReadAsync (tries, retryWaitTime, retryCallback, cursor) go <- cont return results } - static member MapRowValuesOntoTupleLazy<'TItem> (tries, retryWaitTime, cursor: DbDataReader, resultType, resultSet) = + static member MapRowValuesOntoTupleLazy<'TItem> (tries, retryWaitTime, retryCallback, cursor: DbDataReader, resultType, resultSet) = seq { let rowReader = getRowToTupleReader resultSet (resultType = ResultType.Records) - while Utils.ReadAsync (tries, retryWaitTime, cursor) |> Async.RunSynchronously do + while Utils.ReadAsync (tries, retryWaitTime, retryCallback, cursor) |> Async.RunSynchronously do rowReader.Invoke cursor |> unbox<'TItem> } - static member MapRowValues<'TItem> (tries, retryWaitTime, cursor: DbDataReader, resultType, resultSet: ResultSetDefinition) = + static member MapRowValues<'TItem> (tries, retryWaitTime, retryCallback, cursor: DbDataReader, resultType, resultSet: ResultSetDefinition) = if resultSet.ExpectedColumns.Length > 1 then - Utils.MapRowValuesOntoTuple<'TItem> (tries, retryWaitTime, cursor, resultType, resultSet) + Utils.MapRowValuesOntoTuple<'TItem> (tries, retryWaitTime, retryCallback, cursor, resultType, resultSet) else Unsafe.uply { let columnMapping = getColumnMapping resultSet.ExpectedColumns.[0] let results = ResizeArray<'TItem> () - let! go = Utils.ReadAsync (tries, retryWaitTime, cursor) + let! go = Utils.ReadAsync (tries, retryWaitTime, retryCallback, cursor) let mutable go = go while go do @@ -388,16 +395,16 @@ type Utils () = |> unbox |> results.Add - let! cont = Utils.ReadAsync (tries, retryWaitTime, cursor) + let! cont = Utils.ReadAsync (tries, retryWaitTime, retryCallback, cursor) go <- cont return results } - static member MapRowValuesLazy<'TItem> (tries, retryWaitTime, cursor: DbDataReader, resultSet) = + static member MapRowValuesLazy<'TItem> (tries, retryWaitTime, retryCallback, cursor: DbDataReader, resultSet) = seq { let columnMapping = getColumnMapping resultSet.ExpectedColumns.[0] - while Utils.ReadAsync (tries, retryWaitTime, cursor) |> Async.RunSynchronously do + while Utils.ReadAsync (tries, retryWaitTime, retryCallback, cursor) |> Async.RunSynchronously do cursor.GetValue 0 |> columnMapping |> unbox<'TItem> diff --git a/tests/NpgsqlConnectionTests.fs b/tests/NpgsqlConnectionTests.fs index 50f1590..3a9b33f 100644 --- a/tests/NpgsqlConnectionTests.fs +++ b/tests/NpgsqlConnectionTests.fs @@ -158,6 +158,7 @@ let retryWorks () = for _ in 1 .. 10 do let connectionStrWithIncorrectPort = "Host=localhost;Username=postgres;Password=postgres;Database=dvdrental;Port=1313" let cmd = DvdRental.CreateCommand<"SELECT * FROM rental", ResultType.DataTable, Tries = 5> connectionStrWithIncorrectPort + cmd.GetRetryCallback () Unchecked.defaultof<_> //<- fun (exn : Exception) -> printfn "%A" exn yield async { let! result = cmd.AsyncExecute () (cmd :> IDisposable).Dispose () From 240e7f6d1a4fb456b3bf3c36aabb335229abae41 Mon Sep 17 00:00:00 2001 From: symboliq Date: Tue, 20 Jul 2021 20:26:39 -0400 Subject: [PATCH 27/42] Got initial design of retry working. --- src/DesignTime/QuotationsFactory.fs | 10 +++++++++- src/Runtime/ISqlCommand.fs | 2 ++ tests/NpgsqlConnectionTests.fs | 2 +- 3 files changed, 12 insertions(+), 2 deletions(-) diff --git a/src/DesignTime/QuotationsFactory.fs b/src/DesignTime/QuotationsFactory.fs index 7fff49b..3e0cbbd 100644 --- a/src/DesignTime/QuotationsFactory.fs +++ b/src/DesignTime/QuotationsFactory.fs @@ -460,7 +460,15 @@ type internal QuotationsFactory () = let erasedType = cmdProvidedType.BaseType let outputType = typeof unit> let invokeCode (exprArgs : Expr list) = Expr.Call (Expr.Coerce (exprArgs.[0], erasedType), typeof.GetMethod name, []) - let m = ProvidedMethod(name, executeArgs, outputType, invokeCode) + let m = ProvidedMethod(name, [], outputType, invokeCode) + Option.iter m.AddXmlDoc xmlDoc + cmdProvidedType.AddMember m + if methodTypes.HasFlag MethodTypes.Task then + let name = "SetRetryCallback" + let erasedType = cmdProvidedType.BaseType + let outputType = typeof + let invokeCode (exprArgs : Expr list) = Expr.Call (Expr.Coerce (exprArgs.[0], erasedType), typeof.GetMethod name, [Expr.Coerce (exprArgs.[1], typeof unit>)]) + let m = ProvidedMethod(name, [ProvidedParameter ("retryCallback", typeof unit>)], outputType, invokeCode) Option.iter m.AddXmlDoc xmlDoc cmdProvidedType.AddMember m diff --git a/src/Runtime/ISqlCommand.fs b/src/Runtime/ISqlCommand.fs index 0373a62..7ba77f2 100644 --- a/src/Runtime/ISqlCommand.fs +++ b/src/Runtime/ISqlCommand.fs @@ -20,6 +20,7 @@ type ISqlCommand = abstract AsyncExecute: parameters: (string * obj)[] -> obj abstract TaskAsyncExecute: parameters: (string * obj)[] -> obj abstract GetRetryCallback: unit -> (Exception -> unit) + abstract SetRetryCallback: (Exception -> unit) -> unit [] type DesignTimeConfig = { @@ -127,6 +128,7 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design interface ISqlCommand with member _.GetRetryCallback () = retryCallback + member _.SetRetryCallback retryCallback' = retryCallback <- retryCallback' member _.Execute parameters = execute (retryCallback, cfg, cmd, connection, parameters, Sync) member _.AsyncExecute parameters = execute (retryCallback, cfg, cmd, connection, parameters, Async) member _.TaskAsyncExecute parameters = execute (retryCallback, cfg, cmd, connection, parameters, TaskAsync) diff --git a/tests/NpgsqlConnectionTests.fs b/tests/NpgsqlConnectionTests.fs index 3a9b33f..146d0f4 100644 --- a/tests/NpgsqlConnectionTests.fs +++ b/tests/NpgsqlConnectionTests.fs @@ -158,7 +158,7 @@ let retryWorks () = for _ in 1 .. 10 do let connectionStrWithIncorrectPort = "Host=localhost;Username=postgres;Password=postgres;Database=dvdrental;Port=1313" let cmd = DvdRental.CreateCommand<"SELECT * FROM rental", ResultType.DataTable, Tries = 5> connectionStrWithIncorrectPort - cmd.GetRetryCallback () Unchecked.defaultof<_> //<- fun (exn : Exception) -> printfn "%A" exn + cmd.SetRetryCallback (fun (exn : Exception) -> printfn "%A" exn) yield async { let! result = cmd.AsyncExecute () (cmd :> IDisposable).Dispose () From 59c9a40489894caca900d831b7ccbde79d7ad332 Mon Sep 17 00:00:00 2001 From: symboliq Date: Wed, 21 Jul 2021 09:23:39 -0400 Subject: [PATCH 28/42] Removed unecessary conditionals. --- src/DesignTime/QuotationsFactory.fs | 32 ++++++++++++++--------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/DesignTime/QuotationsFactory.fs b/src/DesignTime/QuotationsFactory.fs index 3e0cbbd..ab6b1a8 100644 --- a/src/DesignTime/QuotationsFactory.fs +++ b/src/DesignTime/QuotationsFactory.fs @@ -455,22 +455,22 @@ type internal QuotationsFactory () = add (typedefof>.MakeGenericType outputType) "AsyncExecute" xmlDoc if methodTypes.HasFlag MethodTypes.Task then add (typedefof>.MakeGenericType outputType) "TaskAsyncExecute" xmlDoc - if methodTypes.HasFlag MethodTypes.Task then - let name = "GetRetryCallback" - let erasedType = cmdProvidedType.BaseType - let outputType = typeof unit> - let invokeCode (exprArgs : Expr list) = Expr.Call (Expr.Coerce (exprArgs.[0], erasedType), typeof.GetMethod name, []) - let m = ProvidedMethod(name, [], outputType, invokeCode) - Option.iter m.AddXmlDoc xmlDoc - cmdProvidedType.AddMember m - if methodTypes.HasFlag MethodTypes.Task then - let name = "SetRetryCallback" - let erasedType = cmdProvidedType.BaseType - let outputType = typeof - let invokeCode (exprArgs : Expr list) = Expr.Call (Expr.Coerce (exprArgs.[0], erasedType), typeof.GetMethod name, [Expr.Coerce (exprArgs.[1], typeof unit>)]) - let m = ProvidedMethod(name, [ProvidedParameter ("retryCallback", typeof unit>)], outputType, invokeCode) - Option.iter m.AddXmlDoc xmlDoc - cmdProvidedType.AddMember m + + let name = "GetRetryCallback" + let erasedType = cmdProvidedType.BaseType + let outputType = typeof unit> + let invokeCode (exprArgs : Expr list) = Expr.Call (Expr.Coerce (exprArgs.[0], erasedType), typeof.GetMethod name, []) + let m = ProvidedMethod(name, [], outputType, invokeCode) + Option.iter m.AddXmlDoc xmlDoc + cmdProvidedType.AddMember m + + let name = "SetRetryCallback" + let erasedType = cmdProvidedType.BaseType + let outputType = typeof + let invokeCode (exprArgs : Expr list) = Expr.Call (Expr.Coerce (exprArgs.[0], erasedType), typeof.GetMethod name, [Expr.Coerce (exprArgs.[1], typeof unit>)]) + let m = ProvidedMethod(name, [ProvidedParameter ("retryCallback", typeof unit>)], outputType, invokeCode) + Option.iter m.AddXmlDoc xmlDoc + cmdProvidedType.AddMember m match statements with | _ when resultType = ResultType.DataReader -> From f5fe356ffc20be48290600a1342740ab15e03e71 Mon Sep 17 00:00:00 2001 From: symboliq Date: Wed, 21 Jul 2021 11:58:15 -0400 Subject: [PATCH 29/42] Got actual retry event working. --- src/DesignTime/QuotationsFactory.fs | 18 ++++++ src/Runtime/ISqlCommand.fs | 75 ++++++++++++----------- src/Runtime/Utils.fs | 92 ++++++++++++++--------------- tests/NpgsqlConnectionTests.fs | 2 +- 4 files changed, 105 insertions(+), 82 deletions(-) diff --git a/src/DesignTime/QuotationsFactory.fs b/src/DesignTime/QuotationsFactory.fs index ab6b1a8..fd02ddd 100644 --- a/src/DesignTime/QuotationsFactory.fs +++ b/src/DesignTime/QuotationsFactory.fs @@ -456,6 +456,24 @@ type internal QuotationsFactory () = if methodTypes.HasFlag MethodTypes.Task then add (typedefof>.MakeGenericType outputType) "TaskAsyncExecute" xmlDoc + let evtName = "RetryEvent" + let evtType = typeof> + let erasedType = cmdProvidedType.BaseType + let evt = + ProvidedEvent ( + evtName, + evtType, + (fun args -> Expr.Call (Expr.Coerce (args.[0], erasedType), typeof.GetMethod ("add_" + evtName), [Expr.Coerce (args.[1], evtType)])), + (fun args -> Expr.Call (Expr.Coerce (args.[0], erasedType), typeof.GetMethod ("remove_" + evtName), [Expr.Coerce (args.[1], evtType)])), + false) + cmdProvidedType.AddMember evt + let evtGetter = + ProvidedProperty ( + evtName, + evtType, + (fun args -> Expr.Call (Expr.Coerce (args.Head, erasedType), typeof.GetMethod ("get_" + evtName), args.Tail))) + cmdProvidedType.AddMember evtGetter + let name = "GetRetryCallback" let erasedType = cmdProvidedType.BaseType let outputType = typeof unit> diff --git a/src/Runtime/ISqlCommand.fs b/src/Runtime/ISqlCommand.fs index 7ba77f2..5a5f58b 100644 --- a/src/Runtime/ISqlCommand.fs +++ b/src/Runtime/ISqlCommand.fs @@ -19,6 +19,7 @@ type ISqlCommand = abstract Execute: parameters: (string * obj)[] -> obj abstract AsyncExecute: parameters: (string * obj)[] -> obj abstract TaskAsyncExecute: parameters: (string * obj)[] -> obj + [] abstract RetryEvent: IEvent abstract GetRetryCallback: unit -> (Exception -> unit) abstract SetRetryCallback: (Exception -> unit) -> unit @@ -109,6 +110,9 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design p.Clone () |> cmd.Parameters.Add |> ignore cmd + let retryEvent = + Event () + let mutable retryCallback = fun (_ : Exception) -> () @@ -127,11 +131,12 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design | TaskAsync -> box t interface ISqlCommand with + member _.Execute parameters = execute (retryEvent, cfg, cmd, connection, parameters, Sync) + member _.AsyncExecute parameters = execute (retryEvent, cfg, cmd, connection, parameters, Async) + member _.TaskAsyncExecute parameters = execute (retryEvent, cfg, cmd, connection, parameters, TaskAsync) + [] member _.RetryEvent = retryEvent.Publish member _.GetRetryCallback () = retryCallback member _.SetRetryCallback retryCallback' = retryCallback <- retryCallback' - member _.Execute parameters = execute (retryCallback, cfg, cmd, connection, parameters, Sync) - member _.AsyncExecute parameters = execute (retryCallback, cfg, cmd, connection, parameters, Async) - member _.TaskAsyncExecute parameters = execute (retryCallback, cfg, cmd, connection, parameters, TaskAsync) interface IDisposable with member _.Dispose () = @@ -169,33 +174,33 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design cursor.Close() invalidOp message - static member internal AsyncExecuteDataReaderTask (retryCallback, cfg, cmd, connection, parameters) = Unsafe.uply { + static member internal AsyncExecuteDataReaderTask (retryEvent, cfg, cmd, connection, parameters) = Unsafe.uply { ISqlCommandImplementation.SetParameters (cmd, parameters) - do! Utils.SetupConnectionAsync (cfg.Tries, cfg.RetryWaitTime, retryCallback, cmd, connection) + do! Utils.SetupConnectionAsync (cfg.Tries, cfg.RetryWaitTime, retryEvent, cmd, connection) let readerBehavior = getReaderBehavior (connection, cfg) if cfg.Prepare then - do! Utils.PrepareAsync (cfg.Tries, cfg.RetryWaitTime, retryCallback, cmd) + do! Utils.PrepareAsync (cfg.Tries, cfg.RetryWaitTime, retryEvent, cmd) - let! cursor = Utils.ExecuteReaderAsync (cfg.Tries, cfg.RetryWaitTime, retryCallback, readerBehavior, cmd) + let! cursor = Utils.ExecuteReaderAsync (cfg.Tries, cfg.RetryWaitTime, retryEvent, readerBehavior, cmd) return cursor :?> NpgsqlDataReader } - static member internal AsyncExecuteReader (retryCallback, cfg, cmd, connection, parameters, executionType) = - mapTask (ISqlCommandImplementation.AsyncExecuteDataReaderTask (retryCallback, cfg, cmd, connection, parameters), executionType) + static member internal AsyncExecuteReader (retryEvent, cfg, cmd, connection, parameters, executionType) = + mapTask (ISqlCommandImplementation.AsyncExecuteDataReaderTask (retryEvent, cfg, cmd, connection, parameters), executionType) - static member internal LoadDataTable retryCallback cfg (cursor: Common.DbDataReader) (cmd: NpgsqlCommand) (columns: DataColumn[]) = + static member internal LoadDataTable retryEvent cfg (cursor: Common.DbDataReader) (cmd: NpgsqlCommand) (columns: DataColumn[]) = let result = new FSharp.Data.Npgsql.DataTable(selectCommand = cmd) for c in columns do CloneDataColumn c |> result.Columns.Add - Utils.LoadDataTable (cfg.Tries, cfg.RetryWaitTime, retryCallback, cursor, cmd, result) + Utils.LoadDataTable (cfg.Tries, cfg.RetryWaitTime, retryEvent, cursor, cmd, result) result - static member internal AsyncExecuteDataTables (retryCallback, cfg, cmd, connection, parameters, executionType) = + static member internal AsyncExecuteDataTables (retryEvent, cfg, cmd, connection, parameters, executionType) = let t = Unsafe.uply { - use! cursor = ISqlCommandImplementation.AsyncExecuteDataReaderTask (retryCallback, cfg, cmd, connection, parameters) + use! cursor = ISqlCommandImplementation.AsyncExecuteDataReaderTask (retryEvent, cfg, cmd, connection, parameters) // No explicit NextResult calls, Load takes care of it let results = @@ -205,23 +210,23 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design null else ISqlCommandImplementation.VerifyOutputColumns(cursor, resultSet.ExpectedColumns) - ISqlCommandImplementation.LoadDataTable retryCallback cfg cursor (cmd.Clone()) resultSet.ExpectedColumns |> box) + ISqlCommandImplementation.LoadDataTable retryEvent cfg cursor (cmd.Clone()) resultSet.ExpectedColumns |> box) ISqlCommandImplementation.SetNumberOfAffectedRows (results, cmd.Statements) return results } mapTask (t, executionType) - static member internal AsyncExecuteDataTable (retryCallback, cfg, cmd, connection, parameters, executionType) = + static member internal AsyncExecuteDataTable (retryEvent, cfg, cmd, connection, parameters, executionType) = let t = Unsafe.uply { - use! reader = ISqlCommandImplementation.AsyncExecuteDataReaderTask (retryCallback, cfg, cmd, connection, parameters) - return ISqlCommandImplementation.LoadDataTable retryCallback cfg reader (cmd.Clone()) cfg.ResultSets.[0].ExpectedColumns } + use! reader = ISqlCommandImplementation.AsyncExecuteDataReaderTask (retryEvent, cfg, cmd, connection, parameters) + return ISqlCommandImplementation.LoadDataTable retryEvent cfg reader (cmd.Clone()) cfg.ResultSets.[0].ExpectedColumns } mapTask (t, executionType) // TODO output params - static member internal ExecuteSingle<'TItem> () = Func<_, _, _, _, _>(fun reader resultSetDefinition retryCallback cfg -> Unsafe.uply { - let! xs = MapRowValues<'TItem> (cfg.Tries, cfg.RetryWaitTime, retryCallback, reader, cfg.ResultType, resultSetDefinition) + static member internal ExecuteSingle<'TItem> () = Func<_, _, _, _, _>(fun reader resultSetDefinition retryEvent cfg -> Unsafe.uply { + let! xs = MapRowValues<'TItem> (cfg.Tries, cfg.RetryWaitTime, retryEvent, reader, cfg.ResultType, resultSetDefinition) return if cfg.SingleRow then @@ -233,24 +238,24 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design else box xs }) - static member internal AsyncExecuteList<'TItem> () = fun (retryCallback, cfg, cmd, connection, parameters, executionType) -> + static member internal AsyncExecuteList<'TItem> () = fun (retryEvent, cfg, cmd, connection, parameters, executionType) -> if cfg.CollectionType = CollectionType.LazySeq && not cfg.SingleRow then let t = Unsafe.uply { - let! reader = ISqlCommandImplementation.AsyncExecuteDataReaderTask (retryCallback, cfg, cmd, connection, parameters) + let! reader = ISqlCommandImplementation.AsyncExecuteDataReaderTask (retryEvent, cfg, cmd, connection, parameters) let xs = if cfg.ResultSets.[0].ExpectedColumns.Length > 1 then - MapRowValuesOntoTupleLazy<'TItem> (cfg.Tries, cfg.RetryWaitTime, retryCallback, reader, cfg.ResultType, cfg.ResultSets.[0]) + MapRowValuesOntoTupleLazy<'TItem> (cfg.Tries, cfg.RetryWaitTime, retryEvent, reader, cfg.ResultType, cfg.ResultSets.[0]) else - MapRowValuesLazy<'TItem> (cfg.Tries, cfg.RetryWaitTime, retryCallback, reader, cfg.ResultSets.[0]) + MapRowValuesLazy<'TItem> (cfg.Tries, cfg.RetryWaitTime, retryEvent, reader, cfg.ResultSets.[0]) return new LazySeq<'TItem> (xs, reader, cmd) } mapTask (t, executionType) else let xs = Unsafe.uply { - use! reader = ISqlCommandImplementation.AsyncExecuteDataReaderTask (retryCallback, cfg, cmd, connection, parameters) - return! MapRowValues<'TItem> (cfg.Tries, cfg.RetryWaitTime, retryCallback, reader, cfg.ResultType, cfg.ResultSets.[0]) } + use! reader = ISqlCommandImplementation.AsyncExecuteDataReaderTask (retryEvent, cfg, cmd, connection, parameters) + return! MapRowValues<'TItem> (cfg.Tries, cfg.RetryWaitTime, retryEvent, reader, cfg.ResultType, cfg.ResultSets.[0]) } if cfg.SingleRow then let t = Unsafe.uply { @@ -273,7 +278,7 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design else mapTask (xs, executionType) - static member private ReadResultSet (cursor: Common.DbDataReader, resultSetDefinition, retryCallback, cfg) = + static member private ReadResultSet (cursor: Common.DbDataReader, resultSetDefinition, retryEvent, cfg) = ISqlCommandImplementation.VerifyOutputColumns(cursor, resultSetDefinition.ExpectedColumns) let func = @@ -290,11 +295,11 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design executeSingleCache.[resultSetDefinition.ErasedRowType] <- func func - func.Invoke (cursor, resultSetDefinition, retryCallback, cfg) + func.Invoke (cursor, resultSetDefinition, retryEvent, cfg) - static member internal AsyncExecuteMulti (retryCallback, cfg, cmd, connection, parameters, executionType) = + static member internal AsyncExecuteMulti (retryEvent, cfg, cmd, connection, parameters, executionType) = let t = Unsafe.uply { - use! cursor = ISqlCommandImplementation.AsyncExecuteDataReaderTask (retryCallback, cfg, cmd, connection, parameters) + use! cursor = ISqlCommandImplementation.AsyncExecuteDataReaderTask (retryEvent, cfg, cmd, connection, parameters) let results = Array.zeroCreate cmd.Statements.Count // Command contains at least one query @@ -303,9 +308,9 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design while go do let currentStatement = GetStatementIndex.Invoke cursor - let! res = ISqlCommandImplementation.ReadResultSet (cursor, cfg.ResultSets.[currentStatement], retryCallback, cfg) + let! res = ISqlCommandImplementation.ReadResultSet (cursor, cfg.ResultSets.[currentStatement], retryEvent, cfg) results.[currentStatement] <- res - let! more = Utils.NextResultAsync (cfg.Tries, cfg.RetryWaitTime, retryCallback, cursor) + let! more = Utils.NextResultAsync (cfg.Tries, cfg.RetryWaitTime, retryEvent, cursor) go <- more ISqlCommandImplementation.SetNumberOfAffectedRows (results, cmd.Statements) @@ -313,17 +318,17 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design mapTask (t, executionType) - static member internal AsyncExecuteNonQuery (retryCallback, cfg, cmd, connection, parameters, executionType) = + static member internal AsyncExecuteNonQuery (retryEvent, cfg, cmd, connection, parameters, executionType) = let t = Unsafe.uply { ISqlCommandImplementation.SetParameters (cmd, parameters) - do! Utils.SetupConnectionAsync (cfg.Tries, cfg.RetryWaitTime, retryCallback, cmd, connection) + do! Utils.SetupConnectionAsync (cfg.Tries, cfg.RetryWaitTime, retryEvent, cmd, connection) let readerBehavior = getReaderBehavior (connection, cfg) use _ = if readerBehavior.HasFlag CommandBehavior.CloseConnection then cmd.Connection else null if cfg.Prepare then - do! Utils.PrepareAsync (cfg.Tries, cfg.RetryWaitTime, retryCallback, cmd) + do! Utils.PrepareAsync (cfg.Tries, cfg.RetryWaitTime, retryEvent, cmd) - return! Utils.ExecuteNonQueryAsync (cfg.Tries, cfg.RetryWaitTime, retryCallback, cmd) } + return! Utils.ExecuteNonQueryAsync (cfg.Tries, cfg.RetryWaitTime, retryEvent, cmd) } mapTask (t, executionType) diff --git a/src/Runtime/Utils.fs b/src/Runtime/Utils.fs index cf16198..ca4c6fe 100644 --- a/src/Runtime/Utils.fs +++ b/src/Runtime/Utils.fs @@ -67,17 +67,17 @@ module internal Async = [] type Utils () = - static let rec LoadDataTable' (triesCurrent, exns, triesMax, retryWaitTime: int, retryCallback, cursor, cmd: NpgsqlCommand, result: DataRow DataTable) = + static let rec LoadDataTable' (triesCurrent, exns, triesMax, retryWaitTime: int, retryEvent: Event, cursor, cmd: NpgsqlCommand, result: DataRow DataTable) = try result.Load cursor with exn when Retry.ShouldRetryException exn -> if Retry.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then // NOTE: doing a Thread.Sleep here doesn't help. // I am not convinced this code is meant to be run parallel. - retryCallback exn - LoadDataTable' (triesCurrent + 1, exn :: exns, triesMax, retryWaitTime, retryCallback, cursor, cmd, result) + retryEvent.Trigger exn + LoadDataTable' (triesCurrent + 1, exn :: exns, triesMax, retryWaitTime, retryEvent, cursor, cmd, result) else raise (AggregateException (Seq.rev exns)) - static let rec SetupConnectionAsync' (triesCurrent, exns, triesMax, retryWaitTime, retryCallback, cmd: NpgsqlCommand, connection) = + static let rec SetupConnectionAsync' (triesCurrent, exns, triesMax, retryWaitTime, retryEvent: Event, cmd: NpgsqlCommand, connection) = async { match connection with | Choice1Of2 connectionString -> @@ -88,14 +88,14 @@ type Utils () = | Choice2Of2 exn -> if Retry.ShouldRetry (triesCurrent, triesMax) then do! Async.Sleep retryWaitTime - retryCallback exn - do! SetupConnectionAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, retryCallback, cmd, connection) + retryEvent.Trigger exn + do! SetupConnectionAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, retryEvent, cmd, connection) else return raise (AggregateException (Seq.rev exns)) | Choice2Of2 (conn, tx) -> cmd.Connection <- conn cmd.Transaction <- tx } - static let rec ReadAsync' (triesCurrent, exns, triesMax, retryWaitTime, retryCallback, cursor: DbDataReader) = + static let rec ReadAsync' (triesCurrent, exns, triesMax, retryWaitTime, retryEvent: Event, cursor: DbDataReader) = async { let! choice = cursor.ReadAsync () |> Async.AwaitTask |> Async.CatchDb match choice with @@ -103,11 +103,11 @@ type Utils () = | Choice2Of2 exn -> if Retry.ShouldRetry (triesCurrent, triesMax) then do! Async.Sleep retryWaitTime - retryCallback exn - return! ReadAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, retryCallback, cursor) + retryEvent.Trigger exn + return! ReadAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, retryEvent, cursor) else return raise (AggregateException (Seq.rev exns)) } - static let rec NextResultAsync' (triesCurrent, exns, triesMax, retryWaitTime, retryCallback, cursor: DbDataReader) = + static let rec NextResultAsync' (triesCurrent, exns, triesMax, retryWaitTime, retryEvent: Event, cursor: DbDataReader) = async { let! choice = cursor.NextResultAsync () |> Async.AwaitTask |> Async.CatchDb match choice with @@ -115,11 +115,11 @@ type Utils () = | Choice2Of2 exn -> if Retry.ShouldRetry (triesCurrent, triesMax) then do! Async.Sleep retryWaitTime - retryCallback exn - return! NextResultAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, retryCallback, cursor) + retryEvent.Trigger exn + return! NextResultAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, retryEvent, cursor) else return raise (AggregateException (Seq.rev exns)) } - static let rec PrepareAsync' (triesCurrent, exns, triesMax, retryWaitTime, retryCallback, cmd: NpgsqlCommand) = + static let rec PrepareAsync' (triesCurrent, exns, triesMax, retryWaitTime, retryEvent: Event, cmd: NpgsqlCommand) = async { let! choice = cmd.PrepareAsync () |> Async.AwaitTask |> Async.CatchDb match choice with @@ -127,11 +127,11 @@ type Utils () = | Choice2Of2 exn -> if Retry.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then do! Async.Sleep retryWaitTime - retryCallback exn - return! PrepareAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, retryCallback, cmd) + retryEvent.Trigger exn + return! PrepareAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, retryEvent, cmd) else return raise (AggregateException (Seq.rev exns)) } - static let rec ExecuteReaderAsync' (triesCurrent, exns, triesMax, retryWaitTime, retryCallback, behavior: CommandBehavior, cmd: NpgsqlCommand) = + static let rec ExecuteReaderAsync' (triesCurrent, exns, triesMax, retryWaitTime, retryEvent: Event, behavior: CommandBehavior, cmd: NpgsqlCommand) = async { let! choice = cmd.ExecuteReaderAsync behavior |> Async.AwaitTask |> Async.CatchDb match choice with @@ -139,11 +139,11 @@ type Utils () = | Choice2Of2 exn -> if Retry.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then do! Async.Sleep retryWaitTime - retryCallback exn - return! ExecuteReaderAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, retryCallback, behavior, cmd) + retryEvent.Trigger exn + return! ExecuteReaderAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, retryEvent, behavior, cmd) else return raise (AggregateException (Seq.rev exns)) } - static let rec ExecuteNonQueryAsync' (triesCurrent, exns, triesMax, retryWaitTime, retryCallback, cmd: NpgsqlCommand) = + static let rec ExecuteNonQueryAsync' (triesCurrent, exns, triesMax, retryWaitTime, retryEvent: Event, cmd: NpgsqlCommand) = async { let! choice = cmd.ExecuteNonQueryAsync () |> Async.AwaitTask |> Async.CatchDb match choice with @@ -151,8 +151,8 @@ type Utils () = | Choice2Of2 exn -> if Retry.ShouldRetryWithConnection (triesCurrent, triesMax, cmd.Connection) then do! Async.Sleep retryWaitTime - retryCallback exn - return! ExecuteNonQueryAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, retryCallback, cmd) + retryEvent.Trigger exn + return! ExecuteNonQueryAsync' (triesCurrent+1, exn :: exns, triesMax, retryWaitTime, retryEvent, cmd) else return raise (AggregateException (Seq.rev exns)) } static let getColumnMapping = @@ -219,32 +219,32 @@ type Utils () = cache.[resultSet.ExpectedColumns.GetHashCode ()] <- func func - static member LoadDataTable (tries, retryWaitTime, retryCallback, cursor, cmd, result) = - LoadDataTable' (0, [], tries, retryWaitTime, retryCallback, cursor, cmd, result) + static member LoadDataTable (tries, retryWaitTime, retryEvent, cursor, cmd, result) = + LoadDataTable' (0, [], tries, retryWaitTime, retryEvent, cursor, cmd, result) - static member SetupConnectionAsync (tries, retryWaitTime, retryCallback, cmd, connection) = + static member SetupConnectionAsync (tries, retryWaitTime, retryEvent, cmd, connection) = async { - do! SetupConnectionAsync' (0, [], tries, retryWaitTime, retryCallback, cmd, connection) } + do! SetupConnectionAsync' (0, [], tries, retryWaitTime, retryEvent, cmd, connection) } - static member ReadAsync (tries, retryWaitTime, retryCallback, cursor) = + static member ReadAsync (tries, retryWaitTime, retryEvent, cursor) = async { - return! ReadAsync' (0, [], tries, retryWaitTime, retryCallback, cursor) } + return! ReadAsync' (0, [], tries, retryWaitTime, retryEvent, cursor) } - static member NextResultAsync (tries, retryWaitTime, retryCallback, cursor) = + static member NextResultAsync (tries, retryWaitTime, retryEvent, cursor) = async { - return! NextResultAsync' (0, [], tries, retryWaitTime, retryCallback, cursor) } + return! NextResultAsync' (0, [], tries, retryWaitTime, retryEvent, cursor) } - static member PrepareAsync (tries, retryWaitTime, retryCallback, cmd) = + static member PrepareAsync (tries, retryWaitTime, retryEvent, cmd) = async { - return! PrepareAsync' (0, [], tries, retryWaitTime, retryCallback, cmd) } + return! PrepareAsync' (0, [], tries, retryWaitTime, retryEvent, cmd) } - static member ExecuteReaderAsync (tries, retryWaitTime, retryCallback, behavior, cmd) = + static member ExecuteReaderAsync (tries, retryWaitTime, retryEvent, behavior, cmd) = async { - return! ExecuteReaderAsync' (0, [], tries, retryWaitTime, retryCallback, behavior, cmd) } + return! ExecuteReaderAsync' (0, [], tries, retryWaitTime, retryEvent, behavior, cmd) } - static member ExecuteNonQueryAsync (tries, retryWaitTime, retryCallback, cmd) = + static member ExecuteNonQueryAsync (tries, retryWaitTime, retryEvent, cmd) = async { - return! ExecuteNonQueryAsync' (0, [], tries, retryWaitTime, retryCallback, cmd) } + return! ExecuteNonQueryAsync' (0, [], tries, retryWaitTime, retryEvent, cmd) } static member ResizeArrayToList ra = let rec inner (ra: ResizeArray<'a>, index, acc) = @@ -354,11 +354,11 @@ type Utils () = let [| columnName; typeName; nullable |] = stringValues.Split '|' new DataColumn (columnName, Utils.GetType typeName, AllowDBNull = (nullable = "1")) - static member MapRowValuesOntoTuple<'TItem> (tries, retryWaitTime, retryCallback, cursor: DbDataReader, resultType, resultSet) = Unsafe.uply { + static member MapRowValuesOntoTuple<'TItem> (tries, retryWaitTime, retryEvent, cursor: DbDataReader, resultType, resultSet) = Unsafe.uply { let results = ResizeArray<'TItem> () let rowReader = getRowToTupleReader resultSet (resultType = ResultType.Records) - let! go = Utils.ReadAsync (tries, retryWaitTime, retryCallback, cursor) + let! go = Utils.ReadAsync (tries, retryWaitTime, retryEvent, cursor) let mutable go = go while go do @@ -366,27 +366,27 @@ type Utils () = |> unbox |> results.Add - let! cont = Utils.ReadAsync (tries, retryWaitTime, retryCallback, cursor) + let! cont = Utils.ReadAsync (tries, retryWaitTime, retryEvent, cursor) go <- cont return results } - static member MapRowValuesOntoTupleLazy<'TItem> (tries, retryWaitTime, retryCallback, cursor: DbDataReader, resultType, resultSet) = + static member MapRowValuesOntoTupleLazy<'TItem> (tries, retryWaitTime, retryEvent, cursor: DbDataReader, resultType, resultSet) = seq { let rowReader = getRowToTupleReader resultSet (resultType = ResultType.Records) - while Utils.ReadAsync (tries, retryWaitTime, retryCallback, cursor) |> Async.RunSynchronously do + while Utils.ReadAsync (tries, retryWaitTime, retryEvent, cursor) |> Async.RunSynchronously do rowReader.Invoke cursor |> unbox<'TItem> } - static member MapRowValues<'TItem> (tries, retryWaitTime, retryCallback, cursor: DbDataReader, resultType, resultSet: ResultSetDefinition) = + static member MapRowValues<'TItem> (tries, retryWaitTime, retryEvent, cursor: DbDataReader, resultType, resultSet: ResultSetDefinition) = if resultSet.ExpectedColumns.Length > 1 then - Utils.MapRowValuesOntoTuple<'TItem> (tries, retryWaitTime, retryCallback, cursor, resultType, resultSet) + Utils.MapRowValuesOntoTuple<'TItem> (tries, retryWaitTime, retryEvent, cursor, resultType, resultSet) else Unsafe.uply { let columnMapping = getColumnMapping resultSet.ExpectedColumns.[0] let results = ResizeArray<'TItem> () - let! go = Utils.ReadAsync (tries, retryWaitTime, retryCallback, cursor) + let! go = Utils.ReadAsync (tries, retryWaitTime, retryEvent, cursor) let mutable go = go while go do @@ -395,16 +395,16 @@ type Utils () = |> unbox |> results.Add - let! cont = Utils.ReadAsync (tries, retryWaitTime, retryCallback, cursor) + let! cont = Utils.ReadAsync (tries, retryWaitTime, retryEvent, cursor) go <- cont return results } - static member MapRowValuesLazy<'TItem> (tries, retryWaitTime, retryCallback, cursor: DbDataReader, resultSet) = + static member MapRowValuesLazy<'TItem> (tries, retryWaitTime, retryEvent, cursor: DbDataReader, resultSet) = seq { let columnMapping = getColumnMapping resultSet.ExpectedColumns.[0] - while Utils.ReadAsync (tries, retryWaitTime, retryCallback, cursor) |> Async.RunSynchronously do + while Utils.ReadAsync (tries, retryWaitTime, retryEvent, cursor) |> Async.RunSynchronously do cursor.GetValue 0 |> columnMapping |> unbox<'TItem> diff --git a/tests/NpgsqlConnectionTests.fs b/tests/NpgsqlConnectionTests.fs index 146d0f4..e72f061 100644 --- a/tests/NpgsqlConnectionTests.fs +++ b/tests/NpgsqlConnectionTests.fs @@ -158,7 +158,7 @@ let retryWorks () = for _ in 1 .. 10 do let connectionStrWithIncorrectPort = "Host=localhost;Username=postgres;Password=postgres;Database=dvdrental;Port=1313" let cmd = DvdRental.CreateCommand<"SELECT * FROM rental", ResultType.DataTable, Tries = 5> connectionStrWithIncorrectPort - cmd.SetRetryCallback (fun (exn : Exception) -> printfn "%A" exn) + cmd.add_RetryEvent (fun _ (exn : Exception) -> printfn "%A" exn) yield async { let! result = cmd.AsyncExecute () (cmd :> IDisposable).Dispose () From fce1a14b146d2d88c280db14a323634380a69040 Mon Sep 17 00:00:00 2001 From: symboliq Date: Wed, 21 Jul 2021 12:06:07 -0400 Subject: [PATCH 30/42] Removed extraneous type provisions. --- src/DesignTime/QuotationsFactory.fs | 40 +++++++---------------------- src/Runtime/ISqlCommand.fs | 8 ++---- 2 files changed, 11 insertions(+), 37 deletions(-) diff --git a/src/DesignTime/QuotationsFactory.fs b/src/DesignTime/QuotationsFactory.fs index fd02ddd..4122cea 100644 --- a/src/DesignTime/QuotationsFactory.fs +++ b/src/DesignTime/QuotationsFactory.fs @@ -455,40 +455,18 @@ type internal QuotationsFactory () = add (typedefof>.MakeGenericType outputType) "AsyncExecute" xmlDoc if methodTypes.HasFlag MethodTypes.Task then add (typedefof>.MakeGenericType outputType) "TaskAsyncExecute" xmlDoc - + + let evt = let evtName = "RetryEvent" let evtType = typeof> let erasedType = cmdProvidedType.BaseType - let evt = - ProvidedEvent ( - evtName, - evtType, - (fun args -> Expr.Call (Expr.Coerce (args.[0], erasedType), typeof.GetMethod ("add_" + evtName), [Expr.Coerce (args.[1], evtType)])), - (fun args -> Expr.Call (Expr.Coerce (args.[0], erasedType), typeof.GetMethod ("remove_" + evtName), [Expr.Coerce (args.[1], evtType)])), - false) - cmdProvidedType.AddMember evt - let evtGetter = - ProvidedProperty ( - evtName, - evtType, - (fun args -> Expr.Call (Expr.Coerce (args.Head, erasedType), typeof.GetMethod ("get_" + evtName), args.Tail))) - cmdProvidedType.AddMember evtGetter - - let name = "GetRetryCallback" - let erasedType = cmdProvidedType.BaseType - let outputType = typeof unit> - let invokeCode (exprArgs : Expr list) = Expr.Call (Expr.Coerce (exprArgs.[0], erasedType), typeof.GetMethod name, []) - let m = ProvidedMethod(name, [], outputType, invokeCode) - Option.iter m.AddXmlDoc xmlDoc - cmdProvidedType.AddMember m - - let name = "SetRetryCallback" - let erasedType = cmdProvidedType.BaseType - let outputType = typeof - let invokeCode (exprArgs : Expr list) = Expr.Call (Expr.Coerce (exprArgs.[0], erasedType), typeof.GetMethod name, [Expr.Coerce (exprArgs.[1], typeof unit>)]) - let m = ProvidedMethod(name, [ProvidedParameter ("retryCallback", typeof unit>)], outputType, invokeCode) - Option.iter m.AddXmlDoc xmlDoc - cmdProvidedType.AddMember m + ProvidedEvent ( + evtName, + evtType, + (fun args -> Expr.Call (Expr.Coerce (args.[0], erasedType), typeof.GetMethod ("add_" + evtName), [Expr.Coerce (args.[1], evtType)])), + (fun args -> Expr.Call (Expr.Coerce (args.[0], erasedType), typeof.GetMethod ("remove_" + evtName), [Expr.Coerce (args.[1], evtType)])), + false) + cmdProvidedType.AddMember evt match statements with | _ when resultType = ResultType.DataReader -> diff --git a/src/Runtime/ISqlCommand.fs b/src/Runtime/ISqlCommand.fs index 5a5f58b..58ca643 100644 --- a/src/Runtime/ISqlCommand.fs +++ b/src/Runtime/ISqlCommand.fs @@ -16,12 +16,10 @@ type internal ExecutionType = [] type ISqlCommand = + [] abstract RetryEvent: IEvent abstract Execute: parameters: (string * obj)[] -> obj abstract AsyncExecute: parameters: (string * obj)[] -> obj abstract TaskAsyncExecute: parameters: (string * obj)[] -> obj - [] abstract RetryEvent: IEvent - abstract GetRetryCallback: unit -> (Exception -> unit) - abstract SetRetryCallback: (Exception -> unit) -> unit [] type DesignTimeConfig = { @@ -131,12 +129,10 @@ type ISqlCommandImplementation (commandNameHash: int, cfgBuilder: unit -> Design | TaskAsync -> box t interface ISqlCommand with + [] member _.RetryEvent = retryEvent.Publish member _.Execute parameters = execute (retryEvent, cfg, cmd, connection, parameters, Sync) member _.AsyncExecute parameters = execute (retryEvent, cfg, cmd, connection, parameters, Async) member _.TaskAsyncExecute parameters = execute (retryEvent, cfg, cmd, connection, parameters, TaskAsync) - [] member _.RetryEvent = retryEvent.Publish - member _.GetRetryCallback () = retryCallback - member _.SetRetryCallback retryCallback' = retryCallback <- retryCallback' interface IDisposable with member _.Dispose () = From 1547dd63f5f858707cd35d83da080bbe67a48928 Mon Sep 17 00:00:00 2001 From: symboliq Date: Wed, 21 Jul 2021 12:36:09 -0400 Subject: [PATCH 31/42] Changed to version numbers to custom. --- src/DesignTime/DesignTime.fsproj | 1 + src/Runtime/Runtime.fsproj | 1 + 2 files changed, 2 insertions(+) diff --git a/src/DesignTime/DesignTime.fsproj b/src/DesignTime/DesignTime.fsproj index 0aca126..4f5cba3 100644 --- a/src/DesignTime/DesignTime.fsproj +++ b/src/DesignTime/DesignTime.fsproj @@ -12,6 +12,7 @@ true false preview + 1.0.0-retry diff --git a/src/Runtime/Runtime.fsproj b/src/Runtime/Runtime.fsproj index 4b5b2af..4dbed5e 100644 --- a/src/Runtime/Runtime.fsproj +++ b/src/Runtime/Runtime.fsproj @@ -12,6 +12,7 @@ false 101 preview + 1.0.0-retry From 139892c7344041ebb9f26d5912c5cc9608bdd89f Mon Sep 17 00:00:00 2001 From: symboliq Date: Tue, 27 Jul 2021 09:02:23 -0400 Subject: [PATCH 32/42] Revert "Changed to version numbers to custom." This reverts commit 1547dd63f5f858707cd35d83da080bbe67a48928. --- src/DesignTime/DesignTime.fsproj | 1 - src/Runtime/Runtime.fsproj | 1 - 2 files changed, 2 deletions(-) diff --git a/src/DesignTime/DesignTime.fsproj b/src/DesignTime/DesignTime.fsproj index 4f5cba3..0aca126 100644 --- a/src/DesignTime/DesignTime.fsproj +++ b/src/DesignTime/DesignTime.fsproj @@ -12,7 +12,6 @@ true false preview - 1.0.0-retry diff --git a/src/Runtime/Runtime.fsproj b/src/Runtime/Runtime.fsproj index 4dbed5e..4b5b2af 100644 --- a/src/Runtime/Runtime.fsproj +++ b/src/Runtime/Runtime.fsproj @@ -12,7 +12,6 @@ false 101 preview - 1.0.0-retry From 1c6338a63fbf4ff2184418408c7e916703c8e8ee Mon Sep 17 00:00:00 2001 From: symboliq Date: Tue, 27 Jul 2021 17:04:42 -0400 Subject: [PATCH 33/42] Implemented AsyncChoice capability. --- src/DesignTime/NpgsqlConnectionProvider.fs | 15 +++++---- src/DesignTime/QuotationsFactory.fs | 39 ++++++++++++++++------ tests/NpgsqlConnectionTests.fs | 10 +++--- 3 files changed, 43 insertions(+), 21 deletions(-) diff --git a/src/DesignTime/NpgsqlConnectionProvider.fs b/src/DesignTime/NpgsqlConnectionProvider.fs index cfc79f6..fab4d71 100644 --- a/src/DesignTime/NpgsqlConnectionProvider.fs +++ b/src/DesignTime/NpgsqlConnectionProvider.fs @@ -19,7 +19,7 @@ let addCreateCommandMethod(connectionString, rootType: ProvidedTypeDefinition, commands: ProvidedTypeDefinition, customTypes: Map, dbSchemaLookups: DbSchemaLookups, globalXCtor, globalPrepare: bool, providedTypeReuse, methodTypes, globalCollectionType: CollectionType, globalCommandTimeout: int, - globalTries: int, globalRetryWaitTime: int) = + globalTries: int, globalRetryWaitTime: int, globalAsyncChoice: bool) = let staticParams = [ @@ -69,13 +69,15 @@ let addCreateCommandMethod(connectionString, rootType: ProvidedTypeDefinition, collectionType, singleRow, (if statements.Length > 1 then (i + 1).ToString () else ""), - providedTypeReuse)) + providedTypeReuse, + globalAsyncChoice)) let cmdProvidedType = ProvidedTypeDefinition (commandTypeName, Some typeof, hideObjectMethods = true) commands.AddMember cmdProvidedType QuotationsFactory.AddTopLevelTypes cmdProvidedType parameters resultType methodTypes customTypes statements (if resultType <> ResultType.Records || providedTypeReuse = NoReuse then cmdProvidedType else rootType) + globalAsyncChoice let designTimeConfig = Expr.Lambda (Var ("x", typeof), @@ -92,7 +94,7 @@ let addCreateCommandMethod(connectionString, rootType: ProvidedTypeDefinition, Expr.Value retryWaitTime ])) - let method = QuotationsFactory.GetCommandFactoryMethod (cmdProvidedType, designTimeConfig, xctor, commandTypeName) + let method = QuotationsFactory.GetCommandFactoryMethod (cmdProvidedType, designTimeConfig, xctor, commandTypeName, globalAsyncChoice) rootType.AddMember method method) )) @@ -165,7 +167,7 @@ let createTableTypes(customTypes : Map, item: Db tables -let createRootType (assembly, nameSpace: string, typeName, connectionString, xctor, prepare, reuseProvidedTypes, methodTypes, collectionType, commandTimeout, tries, retryWaitTime) = +let createRootType (assembly, nameSpace: string, typeName, connectionString, xctor, prepare, reuseProvidedTypes, methodTypes, collectionType, commandTimeout, tries, retryWaitTime, choiceAsync) = if String.IsNullOrWhiteSpace connectionString then invalidArg "Connection" "Value is empty!" let databaseRootType = ProvidedTypeDefinition (assembly, nameSpace, typeName, baseType = Some typeof, hideObjectMethods = true) @@ -196,7 +198,7 @@ let createRootType (assembly, nameSpace: string, typeName, connectionString, xct let commands = ProvidedTypeDefinition("Commands", None) databaseRootType.AddMember commands let providedTypeReuse = if reuseProvidedTypes then WithCache typeCache else NoReuse - addCreateCommandMethod (connectionString, databaseRootType, commands, customTypes, schemaLookups, xctor, prepare, providedTypeReuse, methodTypes, collectionType, commandTimeout, tries, retryWaitTime) + addCreateCommandMethod (connectionString, databaseRootType, commands, customTypes, schemaLookups, xctor, prepare, providedTypeReuse, methodTypes, collectionType, commandTimeout, tries, retryWaitTime, choiceAsync) databaseRootType @@ -215,8 +217,9 @@ let internal getProviderType (assembly, nameSpace) = ProvidedStaticParameter("CommandTimeout", typeof, 0) ProvidedStaticParameter("Tries", typeof, 1) ProvidedStaticParameter("RetryWaitTime", typeof, 1000) // TODO: make sure this is a sensible default. + ProvidedStaticParameter("AsyncChoice", typeof, false) ], - fun typeName args -> typeCache.GetOrAdd (typeName, fun typeName -> createRootType (assembly, nameSpace, 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]))) + fun typeName args -> typeCache.GetOrAdd (typeName, fun typeName -> createRootType (assembly, nameSpace, 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], unbox args.[9]))) providerType.AddXmlDoc """ Typed access to PostgreSQL programmable objects, tables and functions. diff --git a/src/DesignTime/QuotationsFactory.fs b/src/DesignTime/QuotationsFactory.fs index 4122cea..94bd687 100644 --- a/src/DesignTime/QuotationsFactory.fs +++ b/src/DesignTime/QuotationsFactory.fs @@ -5,7 +5,9 @@ open System.Data open System.Reflection open FSharp.Quotations open ProviderImplementation.ProvidedTypes +open ProviderImplementation.ProvidedTypes.UncheckedQuotations open Npgsql +open FSharp open FSharp.Data.Npgsql open InformationSchema open System.Collections.Concurrent @@ -14,6 +16,7 @@ open System.Threading.Tasks type internal ReturnType = { Single: Type RowProvidedType: Type option + ChoiceAsync: bool } type internal Statement = { @@ -82,7 +85,8 @@ type internal QuotationsFactory () = static member GetMapperFromOptionToObj (t: Type, value: Expr) = Expr.Call (typeof.GetMethod(nameof Utils.OptionToObj).MakeGenericMethod t, [ Expr.Coerce (value, typeof) ]) - static member AddGeneratedMethod (sqlParameters: Parameter list, executeArgs: ProvidedParameter list, erasedType, providedOutputType, name) = + static member AddGeneratedMethod (sqlParameters: Parameter list, executeArgs: ProvidedParameter list, erasedType, providedOutputType: Type, choiceAsync, name) = + let mappedInputParamValues (exprArgs: Expr list) = (exprArgs.Tail, sqlParameters) ||> List.map2 (fun expr param -> @@ -105,9 +109,21 @@ type internal QuotationsFactory () = let invokeCode exprArgs = let vals = mappedInputParamValues exprArgs let paramValues = if vals.IsEmpty then QuotationsFactory.ParamArrayEmptyExpr else Expr.NewArray (typeof, vals) - Expr.Call (Expr.Coerce (exprArgs.[0], erasedType), typeof.GetMethod name, [ paramValues ]) - - ProvidedMethod(name, executeArgs, providedOutputType, invokeCode) + let callWithoutChoice = Expr.Call (Expr.Coerce (exprArgs.[0], erasedType), typeof.GetMethod name, [ paramValues ]) + if choiceAsync && + providedOutputType.Name = (async { return () }).GetType().Name then + Expr.CallUnchecked (ProvidedTypeBuilder.MakeGenericMethod (typeof.GetMethod "Catch", [providedOutputType.GenericTypeArguments.[0]]), [callWithoutChoice]) + else callWithoutChoice + + let outputType = + if choiceAsync && + providedOutputType.Name = (async { return () }).GetType().Name then + let choiceType = ProvidedTypeBuilder.MakeGenericType (typedefof>, [providedOutputType.GenericTypeArguments.[0]; typeof]) + let asyncType = ProvidedTypeBuilder.MakeGenericType ((async { return () }).GetType().GetGenericTypeDefinition(), [choiceType]) + asyncType + else providedOutputType + + ProvidedMethod(name, executeArgs, outputType, invokeCode) static member GetRecordType (rootTypeName, columns: Column list, customTypes: Map, typeNameSuffix, providedTypeReuse) = columns @@ -321,14 +337,14 @@ type internal QuotationsFactory () = tableType - static member GetOutputTypes (rootTypeName, sql, statementType, customTypes: Map, resultType, collectionType, singleRow, typeNameSuffix, providedTypeReuse) = + static member GetOutputTypes (rootTypeName, sql, statementType, customTypes: Map, resultType, collectionType, singleRow, typeNameSuffix, providedTypeReuse, choiceAsync) = let returnType = match resultType, statementType with | ResultType.DataReader, _ | _, Control -> None | _, NonQuery -> - Some { Single = typeof; RowProvidedType = None } + Some { Single = typeof; RowProvidedType = None; ChoiceAsync = choiceAsync } | ResultType.DataTable, Query columns -> let dataRowType = QuotationsFactory.GetDataRowType (customTypes, columns) let dataTableType = @@ -340,7 +356,7 @@ type internal QuotationsFactory () = dataTableType.AddMember dataRowType - Some { Single = dataTableType; RowProvidedType = None } + Some { Single = dataTableType; RowProvidedType = None; ChoiceAsync = choiceAsync } | _, Query columns -> let providedRowType = if List.length columns = 1 then @@ -364,7 +380,8 @@ type internal QuotationsFactory () = ProvidedTypeBuilder.MakeGenericType (typedefof>, [ providedRowType ]) else ProvidedTypeBuilder.MakeGenericType (typedefof<_ list>, [ providedRowType ]) - RowProvidedType = Some providedRowType } + RowProvidedType = Some providedRowType + ChoiceAsync = choiceAsync } { Type = statementType; Sql = sql; ReturnType = returnType } @@ -399,7 +416,7 @@ type internal QuotationsFactory () = static member val ConnectionUcis = Reflection.FSharpType.GetUnionCases typeof> - static member GetCommandFactoryMethod (cmdProvidedType: ProvidedTypeDefinition, designTimeConfig, isExtended, methodName) = + static member GetCommandFactoryMethod (cmdProvidedType: ProvidedTypeDefinition, designTimeConfig, isExtended, methodName, choiceAsync) = let ctorImpl = typeof.GetConstructors() |> Array.exactlyOne if isExtended then @@ -440,12 +457,12 @@ type internal QuotationsFactory () = | _ -> QuotationsFactory.DataColumnArrayEmptyExpr)) - static member AddTopLevelTypes (cmdProvidedType: ProvidedTypeDefinition) parameters resultType (methodTypes: MethodTypes) customTypes statements typeToAttachTo = + static member AddTopLevelTypes (cmdProvidedType: ProvidedTypeDefinition) parameters resultType (methodTypes: MethodTypes) customTypes statements typeToAttachTo choiceAsync = let executeArgs = QuotationsFactory.GetExecuteArgs (parameters, customTypes) let addRedirectToISqlCommandMethods outputType xmlDoc = let add outputType name xmlDoc = - let m = QuotationsFactory.AddGeneratedMethod (parameters, executeArgs, cmdProvidedType.BaseType, outputType, name) + let m = QuotationsFactory.AddGeneratedMethod (parameters, executeArgs, cmdProvidedType.BaseType, outputType, choiceAsync, name) Option.iter m.AddXmlDoc xmlDoc cmdProvidedType.AddMember m diff --git a/tests/NpgsqlConnectionTests.fs b/tests/NpgsqlConnectionTests.fs index e72f061..bad4f35 100644 --- a/tests/NpgsqlConnectionTests.fs +++ b/tests/NpgsqlConnectionTests.fs @@ -151,20 +151,22 @@ let paramInLimit() = [] let getRentalById = "SELECT return_date FROM rental WHERE rental_id = @id" +type DvdRental' = NpgsqlConnection + [] let retryWorks () = let op = seq { for _ in 1 .. 10 do let connectionStrWithIncorrectPort = "Host=localhost;Username=postgres;Password=postgres;Database=dvdrental;Port=1313" - let cmd = DvdRental.CreateCommand<"SELECT * FROM rental", ResultType.DataTable, Tries = 5> connectionStrWithIncorrectPort + let cmd = DvdRental'.CreateCommand<"SELECT * FROM rental", ResultType.DataTable, Tries = 5> connectionStrWithIncorrectPort cmd.add_RetryEvent (fun _ (exn : Exception) -> printfn "%A" exn) yield async { let! result = cmd.AsyncExecute () (cmd :> IDisposable).Dispose () - return result }} + return match result with Choice1Of2 r -> r | Choice2Of2 _ -> raise (NotImplementedException ()) }} |> Async.Parallel - Assert.ThrowsAsync (new Func<_> (fun () -> op |> Async.Ignore |> Async.StartAsTask |> fun t -> t :> Task)) // is this enough conversion boiler-plate for ya? + Assert.ThrowsAsync (new Func<_> (fun () -> op |> Async.Ignore |> Async.StartAsTask |> fun t -> t :> Task)) // is this enough conversion boiler-plate for ya? [] let dateTableWithUpdate() = @@ -407,7 +409,7 @@ let selectEnumWithArray2() = DvdRental.``public``.Types.mpaa_rating.``PG-13`` DvdRental.``public``.Types.mpaa_rating.R |] - + Assert.Equal( Some( Some ratings), cmd.Execute(ratings)) [] From 8f44909f6bc0acd0224c77e8f3135cafe9563a25 Mon Sep 17 00:00:00 2001 From: symboliq Date: Wed, 28 Jul 2021 11:48:27 -0400 Subject: [PATCH 34/42] Fixed method cache issue. Variable name clean-up. Working on unit tests. --- src/DesignTime/NpgsqlConnectionProvider.fs | 11 ++++---- src/DesignTime/QuotationsFactory.fs | 20 ++++++------- tests/NpgsqlConnectionTests.fs | 33 ++++++++++++++++++++-- 3 files changed, 46 insertions(+), 18 deletions(-) diff --git a/src/DesignTime/NpgsqlConnectionProvider.fs b/src/DesignTime/NpgsqlConnectionProvider.fs index fab4d71..b4491fa 100644 --- a/src/DesignTime/NpgsqlConnectionProvider.fs +++ b/src/DesignTime/NpgsqlConnectionProvider.fs @@ -11,7 +11,7 @@ open System.Collections.Concurrent open System.Reflection let mutable cacheInstanceCount = 0 -let methodsCache = ConcurrentDictionary () +let methodsCache = ConcurrentDictionary () let typeCache = ConcurrentDictionary () let schemaCache = ConcurrentDictionary () @@ -48,7 +48,7 @@ let addCreateCommandMethod(connectionString, rootType: ProvidedTypeDefinition, let commandTypeName = if typename <> "" then typename else methodName methodsCache.GetOrAdd( - commandTypeName, + (commandTypeName, globalAsyncChoice), fun _ -> if singleRow && not (resultType = ResultType.Records || resultType = ResultType.Tuples) then invalidArg "SingleRow" "SingleRow can be set only for ResultType.Records or ResultType.Tuples." @@ -94,7 +94,7 @@ let addCreateCommandMethod(connectionString, rootType: ProvidedTypeDefinition, Expr.Value retryWaitTime ])) - let method = QuotationsFactory.GetCommandFactoryMethod (cmdProvidedType, designTimeConfig, xctor, commandTypeName, globalAsyncChoice) + let method = QuotationsFactory.GetCommandFactoryMethod (cmdProvidedType, designTimeConfig, xctor, commandTypeName) rootType.AddMember method method) )) @@ -167,7 +167,7 @@ let createTableTypes(customTypes : Map, item: Db tables -let createRootType (assembly, nameSpace: string, typeName, connectionString, xctor, prepare, reuseProvidedTypes, methodTypes, collectionType, commandTimeout, tries, retryWaitTime, choiceAsync) = +let createRootType (assembly, nameSpace: string, typeName, connectionString, xctor, prepare, reuseProvidedTypes, methodTypes, collectionType, commandTimeout, tries, retryWaitTime, asyncChoice) = if String.IsNullOrWhiteSpace connectionString then invalidArg "Connection" "Value is empty!" let databaseRootType = ProvidedTypeDefinition (assembly, nameSpace, typeName, baseType = Some typeof, hideObjectMethods = true) @@ -198,7 +198,7 @@ let createRootType (assembly, nameSpace: string, typeName, connectionString, xct let commands = ProvidedTypeDefinition("Commands", None) databaseRootType.AddMember commands let providedTypeReuse = if reuseProvidedTypes then WithCache typeCache else NoReuse - addCreateCommandMethod (connectionString, databaseRootType, commands, customTypes, schemaLookups, xctor, prepare, providedTypeReuse, methodTypes, collectionType, commandTimeout, tries, retryWaitTime, choiceAsync) + addCreateCommandMethod (connectionString, databaseRootType, commands, customTypes, schemaLookups, xctor, prepare, providedTypeReuse, methodTypes, collectionType, commandTimeout, tries, retryWaitTime, asyncChoice) databaseRootType @@ -232,6 +232,7 @@ let internal getProviderType (assembly, nameSpace) = The time to wait (in seconds) while trying to execute a command before terminating the attempt and generating an error. Set to zero for infinity. The number of attempts alotted for a database operation. Set to 0 for infinity. The time to wait (in milliseconds) while waiting to retry a databased operation before terminating the attempt and generating an error. Set to zero for infinity. +Whether Async functions perform Async.Catch implcity and return Choice<'a, Exception> rather than 'a. """ providerType diff --git a/src/DesignTime/QuotationsFactory.fs b/src/DesignTime/QuotationsFactory.fs index 94bd687..8cdb3eb 100644 --- a/src/DesignTime/QuotationsFactory.fs +++ b/src/DesignTime/QuotationsFactory.fs @@ -85,7 +85,7 @@ type internal QuotationsFactory () = static member GetMapperFromOptionToObj (t: Type, value: Expr) = Expr.Call (typeof.GetMethod(nameof Utils.OptionToObj).MakeGenericMethod t, [ Expr.Coerce (value, typeof) ]) - static member AddGeneratedMethod (sqlParameters: Parameter list, executeArgs: ProvidedParameter list, erasedType, providedOutputType: Type, choiceAsync, name) = + static member AddGeneratedMethod (sqlParameters: Parameter list, executeArgs: ProvidedParameter list, erasedType, providedOutputType: Type, asyncChoice, name) = let mappedInputParamValues (exprArgs: Expr list) = (exprArgs.Tail, sqlParameters) @@ -110,13 +110,13 @@ type internal QuotationsFactory () = let vals = mappedInputParamValues exprArgs let paramValues = if vals.IsEmpty then QuotationsFactory.ParamArrayEmptyExpr else Expr.NewArray (typeof, vals) let callWithoutChoice = Expr.Call (Expr.Coerce (exprArgs.[0], erasedType), typeof.GetMethod name, [ paramValues ]) - if choiceAsync && + if asyncChoice && providedOutputType.Name = (async { return () }).GetType().Name then Expr.CallUnchecked (ProvidedTypeBuilder.MakeGenericMethod (typeof.GetMethod "Catch", [providedOutputType.GenericTypeArguments.[0]]), [callWithoutChoice]) else callWithoutChoice let outputType = - if choiceAsync && + if asyncChoice && providedOutputType.Name = (async { return () }).GetType().Name then let choiceType = ProvidedTypeBuilder.MakeGenericType (typedefof>, [providedOutputType.GenericTypeArguments.[0]; typeof]) let asyncType = ProvidedTypeBuilder.MakeGenericType ((async { return () }).GetType().GetGenericTypeDefinition(), [choiceType]) @@ -337,14 +337,14 @@ type internal QuotationsFactory () = tableType - static member GetOutputTypes (rootTypeName, sql, statementType, customTypes: Map, resultType, collectionType, singleRow, typeNameSuffix, providedTypeReuse, choiceAsync) = + static member GetOutputTypes (rootTypeName, sql, statementType, customTypes: Map, resultType, collectionType, singleRow, typeNameSuffix, providedTypeReuse, asyncChoice) = let returnType = match resultType, statementType with | ResultType.DataReader, _ | _, Control -> None | _, NonQuery -> - Some { Single = typeof; RowProvidedType = None; ChoiceAsync = choiceAsync } + Some { Single = typeof; RowProvidedType = None; ChoiceAsync = asyncChoice } | ResultType.DataTable, Query columns -> let dataRowType = QuotationsFactory.GetDataRowType (customTypes, columns) let dataTableType = @@ -356,7 +356,7 @@ type internal QuotationsFactory () = dataTableType.AddMember dataRowType - Some { Single = dataTableType; RowProvidedType = None; ChoiceAsync = choiceAsync } + Some { Single = dataTableType; RowProvidedType = None; ChoiceAsync = asyncChoice } | _, Query columns -> let providedRowType = if List.length columns = 1 then @@ -381,7 +381,7 @@ type internal QuotationsFactory () = else ProvidedTypeBuilder.MakeGenericType (typedefof<_ list>, [ providedRowType ]) RowProvidedType = Some providedRowType - ChoiceAsync = choiceAsync } + ChoiceAsync = asyncChoice } { Type = statementType; Sql = sql; ReturnType = returnType } @@ -416,7 +416,7 @@ type internal QuotationsFactory () = static member val ConnectionUcis = Reflection.FSharpType.GetUnionCases typeof> - static member GetCommandFactoryMethod (cmdProvidedType: ProvidedTypeDefinition, designTimeConfig, isExtended, methodName, choiceAsync) = + static member GetCommandFactoryMethod (cmdProvidedType: ProvidedTypeDefinition, designTimeConfig, isExtended, methodName) = let ctorImpl = typeof.GetConstructors() |> Array.exactlyOne if isExtended then @@ -457,12 +457,12 @@ type internal QuotationsFactory () = | _ -> QuotationsFactory.DataColumnArrayEmptyExpr)) - static member AddTopLevelTypes (cmdProvidedType: ProvidedTypeDefinition) parameters resultType (methodTypes: MethodTypes) customTypes statements typeToAttachTo choiceAsync = + static member AddTopLevelTypes (cmdProvidedType: ProvidedTypeDefinition) parameters resultType (methodTypes: MethodTypes) customTypes statements typeToAttachTo asyncChoice = let executeArgs = QuotationsFactory.GetExecuteArgs (parameters, customTypes) let addRedirectToISqlCommandMethods outputType xmlDoc = let add outputType name xmlDoc = - let m = QuotationsFactory.AddGeneratedMethod (parameters, executeArgs, cmdProvidedType.BaseType, outputType, choiceAsync, name) + let m = QuotationsFactory.AddGeneratedMethod (parameters, executeArgs, cmdProvidedType.BaseType, outputType, asyncChoice, name) Option.iter m.AddXmlDoc xmlDoc cmdProvidedType.AddMember m diff --git a/tests/NpgsqlConnectionTests.fs b/tests/NpgsqlConnectionTests.fs index bad4f35..5d3fd08 100644 --- a/tests/NpgsqlConnectionTests.fs +++ b/tests/NpgsqlConnectionTests.fs @@ -151,10 +151,37 @@ let paramInLimit() = [] let getRentalById = "SELECT return_date FROM rental WHERE rental_id = @id" -type DvdRental' = NpgsqlConnection - [] -let retryWorks () = +let retry () = + let chc = + seq { + for _ in 1 .. 10 do + let connectionStrWithIncorrectPort = "Host=localhost;Username=postgres;Password=postgres;Database=dvdrental;Port=1313" + let cmd = DvdRental.CreateCommand<"SELECT * FROM rental", ResultType.DataTable, Tries = 5> connectionStrWithIncorrectPort + cmd.add_RetryEvent (fun _ (exn : Exception) -> printfn "%A" exn) + yield async { + let! result = cmd.AsyncExecute () + (cmd :> IDisposable).Dispose () + return result }} + |> Async.Parallel + |> Async.Catch + |> Async.RunSynchronously + let isExpectedExceptionTree = + match chc with + | Choice2Of2 exn -> + match exn with + | :? AggregateException as aggexn -> + match aggexn.InnerException with + | :? AggregateException as aggexn2 -> true + | _ -> false + | _ -> false + | Choice1Of2 _ -> false + Assert.True isExpectedExceptionTree + +type DvdRental' = NpgsqlConnection<"Host=localhost;Username=postgres;Password=postgres;Database=dvdrental;Port=5432", MethodTypes = methodTypes, AsyncChoice = true> + +[] +let retryAsyncChoice () = let op = seq { for _ in 1 .. 10 do From fa9be8a5b258dadc9184d18207be1b914c3be8dc Mon Sep 17 00:00:00 2001 From: symboliq Date: Wed, 28 Jul 2021 12:10:17 -0400 Subject: [PATCH 35/42] Implemented finer-grained unit tests. --- tests/NpgsqlConnectionTests.fs | 55 +++++++++++++++++++++++++++++----- 1 file changed, 47 insertions(+), 8 deletions(-) diff --git a/tests/NpgsqlConnectionTests.fs b/tests/NpgsqlConnectionTests.fs index 5d3fd08..10f1783 100644 --- a/tests/NpgsqlConnectionTests.fs +++ b/tests/NpgsqlConnectionTests.fs @@ -158,7 +158,6 @@ let retry () = for _ in 1 .. 10 do let connectionStrWithIncorrectPort = "Host=localhost;Username=postgres;Password=postgres;Database=dvdrental;Port=1313" let cmd = DvdRental.CreateCommand<"SELECT * FROM rental", ResultType.DataTable, Tries = 5> connectionStrWithIncorrectPort - cmd.add_RetryEvent (fun _ (exn : Exception) -> printfn "%A" exn) yield async { let! result = cmd.AsyncExecute () (cmd :> IDisposable).Dispose () @@ -166,34 +165,74 @@ let retry () = |> Async.Parallel |> Async.Catch |> Async.RunSynchronously - let isExpectedExceptionTree = + let isExpectedAggregateException = match chc with | Choice2Of2 exn -> match exn with | :? AggregateException as aggexn -> match aggexn.InnerException with - | :? AggregateException as aggexn2 -> true + | :? AggregateException as aggexn2 -> + match aggexn2.InnerException with + | :? AggregateException as aggexn3 -> + match aggexn3.InnerException with + | :? Npgsql.NpgsqlException -> true + | _ -> false + | _ -> false | _ -> false | _ -> false | Choice1Of2 _ -> false - Assert.True isExpectedExceptionTree + Assert.True isExpectedAggregateException + +exception ContrivedRetryException of unit + +[] +let retryEvent () = + let chc = + seq { + for _ in 1 .. 10 do + let connectionStrWithIncorrectPort = "Host=localhost;Username=postgres;Password=postgres;Database=dvdrental;Port=1313" + let cmd = DvdRental.CreateCommand<"SELECT * FROM rental", ResultType.DataTable, Tries = 5> connectionStrWithIncorrectPort + cmd.add_RetryEvent (fun _ _ -> raise (ContrivedRetryException ())) + yield async { + let! result = cmd.AsyncExecute () + (cmd :> IDisposable).Dispose () + return result }} + |> Async.Parallel + |> Async.Catch + |> Async.RunSynchronously + let isExpectedContrivedException = + match chc with + | Choice2Of2 exn -> + match exn with + | :? AggregateException as aggexn -> + match aggexn.InnerException with + | :? ContrivedRetryException -> true + | _ -> false + | _ -> false + | Choice1Of2 _ -> false + Assert.True isExpectedContrivedException type DvdRental' = NpgsqlConnection<"Host=localhost;Username=postgres;Password=postgres;Database=dvdrental;Port=5432", MethodTypes = methodTypes, AsyncChoice = true> [] let retryAsyncChoice () = - let op = + let chc = seq { for _ in 1 .. 10 do let connectionStrWithIncorrectPort = "Host=localhost;Username=postgres;Password=postgres;Database=dvdrental;Port=1313" let cmd = DvdRental'.CreateCommand<"SELECT * FROM rental", ResultType.DataTable, Tries = 5> connectionStrWithIncorrectPort - cmd.add_RetryEvent (fun _ (exn : Exception) -> printfn "%A" exn) yield async { let! result = cmd.AsyncExecute () (cmd :> IDisposable).Dispose () - return match result with Choice1Of2 r -> r | Choice2Of2 _ -> raise (NotImplementedException ()) }} + return match result with Choice1Of2 r -> r | Choice2Of2 _ -> raise (ContrivedRetryException ()) }} |> Async.Parallel - Assert.ThrowsAsync (new Func<_> (fun () -> op |> Async.Ignore |> Async.StartAsTask |> fun t -> t :> Task)) // is this enough conversion boiler-plate for ya? + |> Async.Catch + |> Async.RunSynchronously + let isExpectedContrivedException = + match chc with + | Choice2Of2 exn -> match exn with :? ContrivedRetryException -> true | _ -> false + | Choice1Of2 _ -> false + Assert.True isExpectedContrivedException [] let dateTableWithUpdate() = From f6117f734dad75fa0396908f71667321511f4b4b Mon Sep 17 00:00:00 2001 From: symboliq Date: Wed, 28 Jul 2021 13:59:05 -0400 Subject: [PATCH 36/42] Reverted unecessary changes for PR. Fixed ChoiceAsync name. --- FSharp.Data.Npgsql.sln | 6 +- Tests.sln | 18 +----- src/DesignTime/NpgsqlConnectionProvider.fs | 2 +- src/DesignTime/QuotationsFactory.fs | 8 +-- tests/NpgsqlConnectionTests.fs | 66 +++++++++++----------- 5 files changed, 44 insertions(+), 56 deletions(-) diff --git a/FSharp.Data.Npgsql.sln b/FSharp.Data.Npgsql.sln index de65170..760132b 100644 --- a/FSharp.Data.Npgsql.sln +++ b/FSharp.Data.Npgsql.sln @@ -1,7 +1,7 @@ - + Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio Version 16 -VisualStudioVersion = 16.0.31129.286 +# Visual Studio 15 +VisualStudioVersion = 15.0.27130.2010 MinimumVisualStudioVersion = 10.0.40219.1 Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = ".paket", ".paket", "{1600313A-B151-4B3A-A779-74820289D25B}" ProjectSection(SolutionItems) = preProject diff --git a/Tests.sln b/Tests.sln index 33390ef..8e8327f 100644 --- a/Tests.sln +++ b/Tests.sln @@ -1,7 +1,7 @@ - + Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio Version 16 -VisualStudioVersion = 16.0.31129.286 +# Visual Studio 15 +VisualStudioVersion = 15.0.27130.2010 MinimumVisualStudioVersion = 10.0.40219.1 Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = ".paket", ".paket", "{FD7B202A-3E0E-4295-87A6-F5917F361760}" ProjectSection(SolutionItems) = preProject @@ -10,10 +10,6 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = ".paket", ".paket", "{FD7B20 EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Tests", "tests\Tests.fsproj", "{D2EA4AE7-56F8-4E4B-9415-B4A3C4D243BB}" EndProject -Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "DesignTime", "src\DesignTime\DesignTime.fsproj", "{BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}" -EndProject -Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Runtime", "src\Runtime\Runtime.fsproj", "{60EE6560-7903-4B15-8A7D-AF71B8093659}" -EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -24,14 +20,6 @@ Global {D2EA4AE7-56F8-4E4B-9415-B4A3C4D243BB}.Debug|Any CPU.Build.0 = Debug|Any CPU {D2EA4AE7-56F8-4E4B-9415-B4A3C4D243BB}.Release|Any CPU.ActiveCfg = Release|Any CPU {D2EA4AE7-56F8-4E4B-9415-B4A3C4D243BB}.Release|Any CPU.Build.0 = Release|Any CPU - {BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}.Debug|Any CPU.Build.0 = Debug|Any CPU - {BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}.Release|Any CPU.ActiveCfg = Release|Any CPU - {BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}.Release|Any CPU.Build.0 = Release|Any CPU - {60EE6560-7903-4B15-8A7D-AF71B8093659}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {60EE6560-7903-4B15-8A7D-AF71B8093659}.Debug|Any CPU.Build.0 = Debug|Any CPU - {60EE6560-7903-4B15-8A7D-AF71B8093659}.Release|Any CPU.ActiveCfg = Release|Any CPU - {60EE6560-7903-4B15-8A7D-AF71B8093659}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE diff --git a/src/DesignTime/NpgsqlConnectionProvider.fs b/src/DesignTime/NpgsqlConnectionProvider.fs index b4491fa..1538f8b 100644 --- a/src/DesignTime/NpgsqlConnectionProvider.fs +++ b/src/DesignTime/NpgsqlConnectionProvider.fs @@ -216,7 +216,7 @@ let internal getProviderType (assembly, nameSpace) = ProvidedStaticParameter("CollectionType", typeof, CollectionType.List) ProvidedStaticParameter("CommandTimeout", typeof, 0) ProvidedStaticParameter("Tries", typeof, 1) - ProvidedStaticParameter("RetryWaitTime", typeof, 1000) // TODO: make sure this is a sensible default. + ProvidedStaticParameter("RetryWaitTime", typeof, 1000) ProvidedStaticParameter("AsyncChoice", typeof, false) ], fun typeName args -> typeCache.GetOrAdd (typeName, fun typeName -> createRootType (assembly, nameSpace, 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], unbox args.[9]))) diff --git a/src/DesignTime/QuotationsFactory.fs b/src/DesignTime/QuotationsFactory.fs index 8cdb3eb..c4ad8ca 100644 --- a/src/DesignTime/QuotationsFactory.fs +++ b/src/DesignTime/QuotationsFactory.fs @@ -16,7 +16,7 @@ open System.Threading.Tasks type internal ReturnType = { Single: Type RowProvidedType: Type option - ChoiceAsync: bool + AsyncChoice: bool } type internal Statement = { @@ -344,7 +344,7 @@ type internal QuotationsFactory () = | _, Control -> None | _, NonQuery -> - Some { Single = typeof; RowProvidedType = None; ChoiceAsync = asyncChoice } + Some { Single = typeof; RowProvidedType = None; AsyncChoice = asyncChoice } | ResultType.DataTable, Query columns -> let dataRowType = QuotationsFactory.GetDataRowType (customTypes, columns) let dataTableType = @@ -356,7 +356,7 @@ type internal QuotationsFactory () = dataTableType.AddMember dataRowType - Some { Single = dataTableType; RowProvidedType = None; ChoiceAsync = asyncChoice } + Some { Single = dataTableType; RowProvidedType = None; AsyncChoice = asyncChoice } | _, Query columns -> let providedRowType = if List.length columns = 1 then @@ -381,7 +381,7 @@ type internal QuotationsFactory () = else ProvidedTypeBuilder.MakeGenericType (typedefof<_ list>, [ providedRowType ]) RowProvidedType = Some providedRowType - ChoiceAsync = asyncChoice } + AsyncChoice = asyncChoice } { Type = statementType; Sql = sql; ReturnType = returnType } diff --git a/tests/NpgsqlConnectionTests.fs b/tests/NpgsqlConnectionTests.fs index 10f1783..d68d31f 100644 --- a/tests/NpgsqlConnectionTests.fs +++ b/tests/NpgsqlConnectionTests.fs @@ -475,7 +475,7 @@ let selectEnumWithArray2() = DvdRental.``public``.Types.mpaa_rating.``PG-13`` DvdRental.``public``.Types.mpaa_rating.R |] - + Assert.Equal( Some( Some ratings), cmd.Execute(ratings)) [] @@ -1153,35 +1153,35 @@ let ``Manually mapped and cast composite type works`` () = Assert.Equal ("blah", res.SomeText) Assert.Equal ([| 1; 2 |], res.SomeArray) -//[] -//let ``NetTopology.Geometry roundtrip works`` () = -// let input = Geometry.DefaultFactory.CreatePoint (Coordinate (55., 0.)) -// use cmd = DvdRentalWithTypeReuse.CreateCommand<"select @p::geometry">(connectionString) -// let res = cmd.Execute(input).Head.Value -// -// Assert.Equal (input.Coordinate.X, res.Coordinate.X) -// -//[] -//let ``NetTopology.Geometry roundtrip works record`` () = -// let input = Geometry.DefaultFactory.CreatePoint (Coordinate (55., 0.)) -// use cmd = DvdRentalWithTypeReuse.CreateCommand<"select @p::geometry g, 0 blah, null::geometry gg">(connectionString) -// let res = cmd.Execute(input).Head.g.Value -// -// Assert.Equal (input.Coordinate.X, res.Coordinate.X) -// -//[] -//let ``NetTopology.Geometry roundtrip works record single row`` () = -// let input = Geometry.DefaultFactory.CreatePoint (Coordinate (55., 0.)) -// use cmd = DvdRentalWithTypeReuse.CreateCommand<"select @p::geometry g, 0 blah, null::geometry gg", SingleRow = true>(connectionString) -// let res = cmd.Execute(input).Value -// -// Assert.Equal (input.Coordinate.X, res.g.Value.Coordinate.X) -// Assert.Equal (None, res.gg) -// -//[] -//let ``NetTopology.Geometry roundtrip works tuple`` () = -// let input = Geometry.DefaultFactory.CreatePoint (Coordinate (55., 0.)) -// use cmd = DvdRentalWithTypeReuse.CreateCommand<"select @p::geometry g, 0 blah, null::geometry gg", ResultType = ResultType.Tuples>(connectionString) -// let res, _, _ = cmd.Execute(input).Head -// -// Assert.Equal (input.Coordinate.X, res.Value.Coordinate.X) +[] +let ``NetTopology.Geometry roundtrip works`` () = + let input = Geometry.DefaultFactory.CreatePoint (Coordinate (55., 0.)) + use cmd = DvdRentalWithTypeReuse.CreateCommand<"select @p::geometry">(connectionString) + let res = cmd.Execute(input).Head.Value + + Assert.Equal (input.Coordinate.X, res.Coordinate.X) + +[] +let ``NetTopology.Geometry roundtrip works record`` () = + let input = Geometry.DefaultFactory.CreatePoint (Coordinate (55., 0.)) + use cmd = DvdRentalWithTypeReuse.CreateCommand<"select @p::geometry g, 0 blah, null::geometry gg">(connectionString) + let res = cmd.Execute(input).Head.g.Value + + Assert.Equal (input.Coordinate.X, res.Coordinate.X) + +[] +let ``NetTopology.Geometry roundtrip works record single row`` () = + let input = Geometry.DefaultFactory.CreatePoint (Coordinate (55., 0.)) + use cmd = DvdRentalWithTypeReuse.CreateCommand<"select @p::geometry g, 0 blah, null::geometry gg", SingleRow = true>(connectionString) + let res = cmd.Execute(input).Value + + Assert.Equal (input.Coordinate.X, res.g.Value.Coordinate.X) + Assert.Equal (None, res.gg) + +[] +let ``NetTopology.Geometry roundtrip works tuple`` () = + let input = Geometry.DefaultFactory.CreatePoint (Coordinate (55., 0.)) + use cmd = DvdRentalWithTypeReuse.CreateCommand<"select @p::geometry g, 0 blah, null::geometry gg", ResultType = ResultType.Tuples>(connectionString) + let res, _, _ = cmd.Execute(input).Head + + Assert.Equal (input.Coordinate.X, res.Value.Coordinate.X) From e9ccc85905b3aaa34d4eec72e3494bde8feaa436 Mon Sep 17 00:00:00 2001 From: symboliq Date: Wed, 28 Jul 2021 14:01:16 -0400 Subject: [PATCH 37/42] More work on reverting unecessary changes. --- FSharp.Data.Npgsql.sln | 1 - Tests.sln | 1 - 2 files changed, 2 deletions(-) diff --git a/FSharp.Data.Npgsql.sln b/FSharp.Data.Npgsql.sln index 760132b..86646a2 100644 --- a/FSharp.Data.Npgsql.sln +++ b/FSharp.Data.Npgsql.sln @@ -1,4 +1,3 @@ - Microsoft Visual Studio Solution File, Format Version 12.00 # Visual Studio 15 VisualStudioVersion = 15.0.27130.2010 diff --git a/Tests.sln b/Tests.sln index 8e8327f..2e2625d 100644 --- a/Tests.sln +++ b/Tests.sln @@ -1,4 +1,3 @@ - Microsoft Visual Studio Solution File, Format Version 12.00 # Visual Studio 15 VisualStudioVersion = 15.0.27130.2010 From a445763093d00aaad5997d24947df63bee9e881b Mon Sep 17 00:00:00 2001 From: symboliq Date: Wed, 28 Jul 2021 14:03:24 -0400 Subject: [PATCH 38/42] More work on reverting unecessary changes. --- FSharp.Data.Npgsql.sln | 1 + Tests.sln | 11 +++++++++-- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/FSharp.Data.Npgsql.sln b/FSharp.Data.Npgsql.sln index 86646a2..0807eba 100644 --- a/FSharp.Data.Npgsql.sln +++ b/FSharp.Data.Npgsql.sln @@ -1,3 +1,4 @@ + Microsoft Visual Studio Solution File, Format Version 12.00 # Visual Studio 15 VisualStudioVersion = 15.0.27130.2010 diff --git a/Tests.sln b/Tests.sln index 2e2625d..8dcc226 100644 --- a/Tests.sln +++ b/Tests.sln @@ -1,6 +1,7 @@ + Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio 15 -VisualStudioVersion = 15.0.27130.2010 +# Visual Studio Version 16 +VisualStudioVersion = 16.0.31129.286 MinimumVisualStudioVersion = 10.0.40219.1 Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = ".paket", ".paket", "{FD7B202A-3E0E-4295-87A6-F5917F361760}" ProjectSection(SolutionItems) = preProject @@ -9,6 +10,8 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = ".paket", ".paket", "{FD7B20 EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Tests", "tests\Tests.fsproj", "{D2EA4AE7-56F8-4E4B-9415-B4A3C4D243BB}" EndProject +Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "DesignTime", "src\DesignTime\DesignTime.fsproj", "{BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -19,6 +22,10 @@ Global {D2EA4AE7-56F8-4E4B-9415-B4A3C4D243BB}.Debug|Any CPU.Build.0 = Debug|Any CPU {D2EA4AE7-56F8-4E4B-9415-B4A3C4D243BB}.Release|Any CPU.ActiveCfg = Release|Any CPU {D2EA4AE7-56F8-4E4B-9415-B4A3C4D243BB}.Release|Any CPU.Build.0 = Release|Any CPU + {BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}.Debug|Any CPU.Build.0 = Debug|Any CPU + {BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}.Release|Any CPU.ActiveCfg = Release|Any CPU + {BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE From fa51b12d7a048dd16074708bf802a190894de598 Mon Sep 17 00:00:00 2001 From: symboliq Date: Wed, 28 Jul 2021 14:15:05 -0400 Subject: [PATCH 39/42] More work on reverting unecessary changes. --- Tests.sln | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/Tests.sln b/Tests.sln index 8dcc226..acc01ca 100644 --- a/Tests.sln +++ b/Tests.sln @@ -1,7 +1,7 @@  Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio Version 16 -VisualStudioVersion = 16.0.31129.286 +# Visual Studio 15 +VisualStudioVersion = 15.0.27130.2010 MinimumVisualStudioVersion = 10.0.40219.1 Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = ".paket", ".paket", "{FD7B202A-3E0E-4295-87A6-F5917F361760}" ProjectSection(SolutionItems) = preProject @@ -10,8 +10,6 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = ".paket", ".paket", "{FD7B20 EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Tests", "tests\Tests.fsproj", "{D2EA4AE7-56F8-4E4B-9415-B4A3C4D243BB}" EndProject -Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "DesignTime", "src\DesignTime\DesignTime.fsproj", "{BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}" -EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -22,10 +20,6 @@ Global {D2EA4AE7-56F8-4E4B-9415-B4A3C4D243BB}.Debug|Any CPU.Build.0 = Debug|Any CPU {D2EA4AE7-56F8-4E4B-9415-B4A3C4D243BB}.Release|Any CPU.ActiveCfg = Release|Any CPU {D2EA4AE7-56F8-4E4B-9415-B4A3C4D243BB}.Release|Any CPU.Build.0 = Release|Any CPU - {BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}.Debug|Any CPU.Build.0 = Debug|Any CPU - {BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}.Release|Any CPU.ActiveCfg = Release|Any CPU - {BDEE692A-B1FC-4DF5-A465-D4BBDDC9FD11}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE From 56673f8868bfd4c64c5320afaf78f8ecfc4efca2 Mon Sep 17 00:00:00 2001 From: symboliq Date: Wed, 28 Jul 2021 14:17:59 -0400 Subject: [PATCH 40/42] More work on reverting unecessary changes. --- src/DesignTime/QuotationsFactory.fs | 4 +++- tests/NpgsqlConnectionTests.fs | 1 + 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/src/DesignTime/QuotationsFactory.fs b/src/DesignTime/QuotationsFactory.fs index c4ad8ca..46afc95 100644 --- a/src/DesignTime/QuotationsFactory.fs +++ b/src/DesignTime/QuotationsFactory.fs @@ -1,4 +1,4 @@ -namespace FSharp.Data.Npgsql.DesignTime +namespace FSharp.Data.Npgsql.DesignTime open System open System.Data @@ -485,6 +485,8 @@ type internal QuotationsFactory () = false) cmdProvidedType.AddMember evt + + match statements with | _ when resultType = ResultType.DataReader -> addRedirectToISqlCommandMethods typeof None diff --git a/tests/NpgsqlConnectionTests.fs b/tests/NpgsqlConnectionTests.fs index d68d31f..0482c87 100644 --- a/tests/NpgsqlConnectionTests.fs +++ b/tests/NpgsqlConnectionTests.fs @@ -72,6 +72,7 @@ let selectLiterals() = DvdRental.CreateCommand<" SELECT 42 AS Answer, current_date as today ">(connectionString) + let x = cmd.Execute() |> Seq.exactlyOne Assert.Equal(Some 42, x.answer) Assert.Equal(Some DateTime.Now.Date, x.today) From a7a8ccaf942ef75cc9d05d0ddbdf2185447384cb Mon Sep 17 00:00:00 2001 From: symboliq Date: Wed, 28 Jul 2021 14:21:51 -0400 Subject: [PATCH 41/42] More work on reverting unecessary changes. --- src/DesignTime/QuotationsFactory.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/DesignTime/QuotationsFactory.fs b/src/DesignTime/QuotationsFactory.fs index 46afc95..fb06337 100644 --- a/src/DesignTime/QuotationsFactory.fs +++ b/src/DesignTime/QuotationsFactory.fs @@ -485,8 +485,6 @@ type internal QuotationsFactory () = false) cmdProvidedType.AddMember evt - - match statements with | _ when resultType = ResultType.DataReader -> addRedirectToISqlCommandMethods typeof None @@ -514,3 +512,5 @@ type internal QuotationsFactory () = addRedirectToISqlCommandMethods resultSetsType None cmdProvidedType.AddMember resultSetsType + + From 2ea114bab1b90a5ec254824a341a3bc57bcfb669 Mon Sep 17 00:00:00 2001 From: symboliq Date: Wed, 28 Jul 2021 14:24:19 -0400 Subject: [PATCH 42/42] More work on reverting unecessary changes. --- src/DesignTime/QuotationsFactory.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/DesignTime/QuotationsFactory.fs b/src/DesignTime/QuotationsFactory.fs index fb06337..30851bb 100644 --- a/src/DesignTime/QuotationsFactory.fs +++ b/src/DesignTime/QuotationsFactory.fs @@ -1,4 +1,4 @@ -namespace FSharp.Data.Npgsql.DesignTime +namespace FSharp.Data.Npgsql.DesignTime open System open System.Data