From 758fc1905b598f417b2e0385685985bee05fb33d Mon Sep 17 00:00:00 2001 From: Pim Brouwers Date: Thu, 2 Feb 2023 15:57:10 -0500 Subject: [PATCH 01/13] removed monadic error handling, replaced with clr exceptions --- README.md | 75 ++++++------------ src/Donald/Core.fs | 66 ++++++++-------- src/Donald/Db.fs | 66 +++++++--------- src/Donald/Extensions.fs | 133 ++++++++------------------------ test/Donald.Tests/Script.fsx | 46 ++++++++++++ test/Donald.Tests/Tests.fs | 142 +++++++++++++++++++---------------- 6 files changed, 239 insertions(+), 289 deletions(-) create mode 100644 test/Donald.Tests/Script.fsx diff --git a/README.md b/README.md index aea640d..cd94119 100644 --- a/README.md +++ b/README.md @@ -50,7 +50,7 @@ module Author = let ofDataReader (rd : IDataReader) : Author = { FullName = rd.ReadString "full_name" } -let authors : Result = +let authors : Author list = let sql = " SELECT full_name FROM author @@ -94,12 +94,12 @@ let sql = "SELECT author_id, full_name FROM author" conn |> Db.newCommand sql -|> Db.query Author.ofDataReader // Result +|> Db.query Author.ofDataReader // Author list // Async conn |> Db.newCommand sql -|> Db.Async.query Author.ofDataReader // Task> +|> Db.Async.query Author.ofDataReader // Task ``` ### Query for a single strongly-typed result @@ -110,13 +110,13 @@ let sql = "SELECT author_id, full_name FROM author" conn |> Db.newCommand sql |> Db.setParams [ "author_id", SqlType.Int 1 ] -|> Db.querySingle Author.ofDataReader // Result +|> Db.querySingle Author.ofDataReader // Author option // Async conn |> Db.newCommand sql |> Db.setParams [ "author_id", SqlType.Int 1 ] -|> Db.Async.querySingle Author.ofDataReader // Task> +|> Db.Async.querySingle Author.ofDataReader // Task ``` ### Execute a statement @@ -130,13 +130,13 @@ let param = [ "full_name", SqlType.String "John Doe" ] conn |> Db.newCommand sql |> Db.setParams param -|> Db.exec // Result +|> Db.exec // unit // Async conn |> Db.newCommand sql |> Db.setParams param -|> Db.Async.exec // Task> +|> Db.Async.exec // Task ``` ### Execute a statement many times @@ -166,13 +166,13 @@ let param = [ "full_name", SqlType.String "John Doe" ] conn |> Db.newCommand sql |> Db.setParams param -|> Db.exec // Result +|> Db.exec // unit // Async conn |> Db.newCommand sql |> Db.setParams param -|> Db.Async.exec // Task> +|> Db.Async.exec // Task ``` ### Execute statements within an explicit transaction @@ -254,53 +254,26 @@ rd.ReadBytesOption "some_field" // string -> byte[] option ## Exceptions -Donald exposes `DbError` type to represent failure at different points in the execution-cycle, all of which are encapsulated within a general `DbFailureException`. - -```fsharp -type DbError = - | DbConnectionError of DbConnectionError - | DbTransactionError of DbTransactionError - | DbExecutionError of DbExecutionError - | DataReaderCastError of DataReaderCastError - | DataReaderOutOfRangeError of DataReaderOutOfRangeError - -exception DbFailureException of DbError -``` - -During command execution failures the `Error` case of `Result` contains one of `DbError` union cases with relevant data. +Donald exposes several custom exceptions which interleave the exceptions thrown by ADO.NET with contextually relevant metadata. ```fsharp /// Details of failure to connection to a database/server. -type DbConnectionError = - { ConnectionString : string - Error : exn } - -/// Details the steps of database a transaction. -type DbTransactionStep = TxBegin | TxCommit | TxRollback - -/// Details of transaction failure. -type DbTransactionError = - { Step : DbTransactionStep - Error : exn } - -/// Details of failure to execute database command. -type DbExecutionError = - { Statement : string - Error : DbException } - -/// Details of failure to cast a IDataRecord field. -type DataReaderCastError = - { FieldName : string - Error : InvalidCastException } - -/// Details of failure to access a IDataRecord column by name. -type DataReaderOutOfRangeError = - { FieldName : string - Error : IndexOutOfRangeException } +type DbConnectionException = + inherit Exception + val ConnectionString : string option + +/// Details of failure to execute database command or transaction. +type DbExecutionException = + inherit Exception + val Statement : string option + val Step : DbTransactionStep option + +/// Details of failure to access and/or cast an IDataRecord field. +type DbReaderException = + inherit Exception + val FieldName : string option ``` -> It's important to note that Donald will only raise exceptions in _exceptional_ situations. - ## Performance By default, Donald will consume `IDataReader` using `CommandBehavior.SequentialAccess`. This allows the rows and columns to be read in chunks (i.e., streamed), but forward-only. As opposed to being completely read into memory all at once, and readable in any direction. The benefits of this are particular felt when reading large CLOB (string) and BLOB (binary) data. But is also a measureable performance gain for standard query results as well. diff --git a/src/Donald/Core.fs b/src/Donald/Core.fs index d4a54ac..ee24808 100644 --- a/src/Donald/Core.fs +++ b/src/Donald/Core.fs @@ -2,7 +2,7 @@ namespace Donald open System open System.Data -open System.Data.Common +open System.Runtime.Serialization open System.Threading /// Represents a configurable database command. @@ -17,42 +17,42 @@ type DbUnit (cmd : IDbCommand) = member x.Dispose () = x.Command.Dispose () - -/// Details of failure to connection to a database/server. -type DbConnectionError = - { ConnectionString : string - Error : exn } - /// Details the steps of database a transaction. type DbTransactionStep = TxBegin | TxCommit | TxRollback -/// Details of transaction failure. -type DbTransactionError = - { Step : DbTransactionStep - Error : exn } - -/// Details of failure to execute database command. -type DbExecutionError = - { Statement : string - Error : DbException } - -/// Details of failure to cast a IDataRecord field. -type DataReaderCastError = - { FieldName : string - Error : InvalidCastException } - -type DataReaderOutOfRangeError = - { FieldName : string - Error : IndexOutOfRangeException } - -type DbError = - | DbConnectionError of DbConnectionError - | DbTransactionError of DbTransactionError - | DbExecutionError of DbExecutionError - | DataReaderCastError of DataReaderCastError - | DataReaderOutOfRangeError of DataReaderOutOfRangeError +/// Details of failure to connection to a database/server. +type DbConnectionException = + inherit Exception + val ConnectionString : string option + new() = { inherit Exception(); ConnectionString = None } + new(message : string) = { inherit Exception(message); ConnectionString = None } + new(message : string, inner : Exception) = { inherit Exception(message, inner); ConnectionString = None } + new(info : SerializationInfo, context : StreamingContext) = { inherit Exception(info, context); ConnectionString = None } + new(connection : IDbConnection, inner : Exception) = { inherit Exception("Failed to establish database connection", inner); ConnectionString = Some connection.ConnectionString} + +/// Details of failure to execute database command or transaction. +type DbExecutionException = + inherit Exception + val Statement : string option + val Step : DbTransactionStep option + new() = { inherit Exception(); Statement = None; Step = None } + new(message : string) = { inherit Exception(message); Statement = None; Step = None } + new(message : string, inner : Exception) = { inherit Exception(message, inner); Statement = None; Step = None } + new(info : SerializationInfo, context : StreamingContext) = { inherit Exception(info, context); Statement = None; Step = None } + new(cmd : IDbCommand, inner : Exception) = { inherit Exception("Failed to process database command", inner); Statement = Some cmd.CommandText; Step = None } + new(step : DbTransactionStep, inner : Exception) = { inherit Exception("Failed to process transaction", inner); Statement = None; Step = Some step } + +/// Details of failure to access and/or cast an IDataRecord field. +type DbReaderException = + inherit Exception + val FieldName : string option + new() = { inherit Exception(); FieldName = None } + new(message : string) = { inherit Exception(message); FieldName = None } + new(message : string, inner : Exception) = { inherit Exception(message, inner); FieldName = None } + new(info : SerializationInfo, context : StreamingContext) = { inherit Exception(info, context); FieldName = None } + new(fieldName : string, inner : IndexOutOfRangeException) = { inherit Exception($"Failed to read database field: '{fieldName}'", inner); FieldName = Some fieldName } + new(fieldName : string, inner : InvalidCastException) = { inherit Exception($"Failed to read database field: '{fieldName}'", inner); FieldName = Some fieldName } -exception DbFailureException of DbError /// Represents the supported data types for database IO. [] diff --git a/src/Donald/Db.fs b/src/Donald/Db.fs index 4700e69..240e4b3 100644 --- a/src/Donald/Db.fs +++ b/src/Donald/Db.fs @@ -47,74 +47,62 @@ module Db = // // Execution model - let private tryDo (dbUnit : DbUnit) (fn : IDbCommand -> 'a) : Result<'a, DbError> = - try - dbUnit.Command.Connection.TryOpenConnection () - let result = fn dbUnit.Command - (dbUnit :> IDisposable).Dispose () - Ok result - with - | DbFailureException e -> Error e + let private tryDo (dbUnit : DbUnit) (fn : IDbCommand -> 'a) = + dbUnit.Command.Connection.TryOpenConnection () + let result = fn dbUnit.Command + (dbUnit :> IDisposable).Dispose () + result /// Execute parameterized query with no results. - let exec (dbUnit : DbUnit) : Result = - tryDo dbUnit (fun cmd -> - cmd.Exec ()) + let exec (dbUnit : DbUnit) : unit = + tryDo dbUnit (fun cmd -> cmd.Exec ()) /// Execute parameterized query many times with no results. - let execMany (param : RawDbParams list) (dbUnit : DbUnit) : Result = - try - dbUnit.Command.Connection.TryOpenConnection () - for p in param do - let dbParams = DbParams.create p - dbUnit.Command.SetDbParams(dbParams).Exec () |> ignore - - Ok () - with - | DbFailureException e -> Error e + let execMany (param : RawDbParams list) (dbUnit : DbUnit) : unit = + dbUnit.Command.Connection.TryOpenConnection () + for p in param do + let dbParams = DbParams.create p + dbUnit.Command.SetDbParams(dbParams).Exec () /// Execute scalar query and box the result. - let scalar (convert : obj -> 'a) (dbUnit : DbUnit) : Result<'a, DbError> = + let scalar (convert : obj -> 'a) (dbUnit : DbUnit) : 'a = tryDo dbUnit (fun cmd -> let value = cmd.ExecScalar () convert value) /// Execute paramterized query and return IDataReader - let read (fn : 'reader -> 'a when 'reader :> IDataReader) (dbUnit : DbUnit) : Result<'a, DbError> = + let read (fn : 'reader -> 'a when 'reader :> IDataReader) (dbUnit : DbUnit) : 'a = tryDo dbUnit (fun cmd -> use rd = cmd.ExecReader (dbUnit.CommandBehavior) :?> 'reader fn rd) /// Execute parameterized query, enumerate all records and apply mapping. - let query (map : 'reader -> 'a when 'reader :> IDataReader) (dbUnit : DbUnit) : Result<'a list, DbError> = + let query (map : 'reader -> 'a when 'reader :> IDataReader) (dbUnit : DbUnit) : 'a list = read (fun rd -> [ while rd.Read () do yield map rd ]) dbUnit /// Execute paramterized query, read only first record and apply mapping. - let querySingle (map : 'reader -> 'a when 'reader :> IDataReader) (dbUnit : DbUnit) : Result<'a option, DbError> = + let querySingle (map : 'reader -> 'a when 'reader :> IDataReader) (dbUnit : DbUnit) : 'a option = read (fun rd -> if rd.Read () then Some(map rd) else None) dbUnit module Async = - let private tryDoAsync (dbUnit : DbUnit) (fn : DbCommand -> Task<'a>) : Task> = + let private tryDoAsync (dbUnit : DbUnit) (fn : DbCommand -> Task<'a>) : Task<'a> = task { - try - do! dbUnit.Command.Connection.TryOpenConnectionAsync(dbUnit.CancellationToken) - let! result = fn (dbUnit.Command :?> DbCommand) - (dbUnit :> IDisposable).Dispose () - return (Ok result) - with - | DbFailureException e -> return Error e + do! dbUnit.Command.Connection.TryOpenConnectionAsync(dbUnit.CancellationToken) + let! result = fn (dbUnit.Command :?> DbCommand) + (dbUnit :> IDisposable).Dispose () + return result } /// Asynchronously execute parameterized query with no results. - let exec (dbUnit : DbUnit) : Task> = + let exec (dbUnit : DbUnit) : Task = tryDoAsync dbUnit (fun (cmd : DbCommand) -> task { let! _ = cmd.ExecAsync(dbUnit.CancellationToken) return () }) /// Asynchronously execute parameterized query many times with no results - let execMany (param : RawDbParams list) (dbUnit : DbUnit) : Task> = + let execMany (param : RawDbParams list) (dbUnit : DbUnit) : Task = tryDoAsync dbUnit (fun (cmd : DbCommand) -> task { for p in param do let dbParams = DbParams.create p @@ -125,23 +113,23 @@ module Db = }) /// Execute scalar query and box the result. - let scalar (convert : obj -> 'a) (dbUnit : DbUnit) : Task> = + let scalar (convert : obj -> 'a) (dbUnit : DbUnit) : Task<'a> = tryDoAsync dbUnit (fun (cmd : DbCommand) -> task { let! value = cmd.ExecScalarAsync (dbUnit.CancellationToken) return convert value }) /// Asynchronously execute paramterized query and return IDataReader - let read (fn : 'reader -> 'a when 'reader :> IDataReader) (dbUnit : DbUnit) : Task> = + let read (fn : 'reader -> 'a when 'reader :> IDataReader) (dbUnit : DbUnit) : Task<'a> = tryDoAsync dbUnit (fun (cmd : DbCommand) -> task { use! rd = cmd.ExecReaderAsync(dbUnit.CommandBehavior, dbUnit.CancellationToken) return fn (rd :?> 'reader) }) /// Asynchronously execute parameterized query, enumerate all records and apply mapping. - let query (map : 'reader -> 'a when 'reader :> IDataReader) (dbUnit : DbUnit) : Task> = + let query (map : 'reader -> 'a when 'reader :> IDataReader) (dbUnit : DbUnit) : Task<'a list> = read (fun rd -> [ while rd.Read () do map rd ]) dbUnit /// Asynchronously execute paramterized query, read only first record and apply mapping. - let querySingle (map : 'reader -> 'a when 'reader :> IDataReader) (dbUnit : DbUnit) : Task> = + let querySingle (map : 'reader -> 'a when 'reader :> IDataReader) (dbUnit : DbUnit) : Task<'a option> = read (fun rd -> if rd.Read () then Some(map rd) else None) dbUnit \ No newline at end of file diff --git a/src/Donald/Extensions.fs b/src/Donald/Extensions.fs index 94bbb4b..51ecc2a 100644 --- a/src/Donald/Extensions.fs +++ b/src/Donald/Extensions.fs @@ -16,11 +16,7 @@ module Extensions = if x.State = ConnectionState.Closed then x.Open() with ex -> - let error = DbConnectionError { - ConnectionString = x.ConnectionString - Error = ex } - - raise (DbFailureException error) + raise (DbConnectionException(x, ex)) /// Safely attempt to open a new IDbTransaction or /// return FailedOpenConnectionException. @@ -34,11 +30,7 @@ module Extensions = ct.ThrowIfCancellationRequested() x.Open() with ex -> - let error = DbConnectionError { - ConnectionString = x.ConnectionString - Error = ex } - - return raise (DbFailureException error) + return raise (DbConnectionException(x, ex)) } /// Safely attempt to create a new IDbTransaction or @@ -47,13 +39,8 @@ module Extensions = try x.TryOpenConnection() x.BeginTransaction() - with - | ex -> - let error = DbTransactionError { - Step = TxBegin - Error = ex } - - raise (DbFailureException error) + with ex -> + raise (DbExecutionException(TxBegin, ex)) /// Safely attempt to create a new IDbTransaction or /// return CouldNotBeginTransactionException. @@ -68,13 +55,8 @@ module Extensions = | _ -> ct.ThrowIfCancellationRequested() return x.BeginTransaction() - with - | ex -> - let error = DbTransactionError { - Step = TxBegin - Error = ex } - - return raise (DbFailureException error) + with ex -> + return raise (DbExecutionException(TxBegin, ex)) } type IDbTransaction with @@ -83,11 +65,7 @@ module Extensions = try if not(isNull x) && not(isNull x.Connection) then x.Rollback() with ex -> - let error = DbTransactionError { - Step = TxRollback - Error = ex } - - raise (DbFailureException error) + raise (DbExecutionException(TxRollback, ex)) /// Safely attempt to rollback an IDbTransaction. member x.TryRollbackAsync(?cancellationToken : CancellationToken) = task { @@ -100,11 +78,7 @@ module Extensions = ct.ThrowIfCancellationRequested() x.Rollback() with ex -> - let error = DbTransactionError { - Step = TxRollback - Error = ex } - - return raise (DbFailureException error) + return raise (DbExecutionException(TxRollback, ex)) } /// Safely attempt to commit an IDbTransaction. @@ -113,16 +87,12 @@ module Extensions = try if not(isNull x) && not(isNull x.Connection) then x.Commit() with ex -> - /// Is supposed to throw System.InvalidOperationException - /// when commmited or rolled back already, but most - /// implementations do not. So in all cases try rolling back + // Is supposed to throw System.InvalidOperationException + // when commmited or rolled back already, but most + // implementations do not. So in all cases try rolling back x.TryRollback() - let error = DbTransactionError { - Step = TxCommit - Error = ex } - - raise (DbFailureException error) + raise (DbExecutionException(TxCommit, ex)) /// Safely attempt to commit an IDbTransaction. /// Will rollback in the case of Exception. @@ -137,16 +107,12 @@ module Extensions = ct.ThrowIfCancellationRequested() x.Commit() with ex -> - /// Is supposed to throw System.InvalidOperationException - /// when commmited or rolled back already, but most - /// implementations do not. So in all cases try rolling back + // Is supposed to throw System.InvalidOperationException + // when commmited or rolled back already, but most + // implementations do not. So in all cases try rolling back do! x.TryRollbackAsync(ct) - let error = DbTransactionError { - Step = TxCommit - Error = ex } - - raise (DbFailureException error) + return raise (DbExecutionException(TxCommit, ex)) } type IDbCommand with @@ -232,34 +198,19 @@ module Extensions = try x.ExecuteNonQuery() |> ignore with - | :? DbException as ex -> - let error = DbExecutionError { - Statement = x.CommandText - Error = ex } - - raise (DbFailureException error) + | :? DbException as ex -> raise (DbExecutionException(x, ex)) member internal x.ExecReader (cmdBehavior : CommandBehavior) = try x.ExecuteReader(cmdBehavior) with - | :? DbException as ex -> - let error = DbExecutionError { - Statement = x.CommandText - Error = ex } - - raise (DbFailureException error) + | :? DbException as ex -> raise (DbExecutionException(x, ex)) member internal x.ExecScalar () = try x.ExecuteScalar() with - | :? DbException as ex -> - let error = DbExecutionError { - Statement = x.CommandText - Error = ex } - - raise (DbFailureException error) + | :? DbException as ex -> raise (DbExecutionException(x, ex)) type DbCommand with member internal x.SetDbParams(param : DbParams) = @@ -269,66 +220,42 @@ module Extensions = try return! x.ExecuteNonQueryAsync(cancellationToken = defaultArg ct CancellationToken.None) with - | :? DbException as ex -> - let error = DbExecutionError { - Statement = x.CommandText - Error = ex } - - return raise (DbFailureException error) + | :? DbException as ex -> return raise (DbExecutionException(x, ex)) } member internal x.ExecReaderAsync(cmdBehavior : CommandBehavior, ?ct: CancellationToken) = task { try return! x.ExecuteReaderAsync(cmdBehavior, cancellationToken = defaultArg ct CancellationToken.None ) with - | :? DbException as ex -> - let error = DbExecutionError { - Statement = x.CommandText - Error = ex } - - return raise (DbFailureException error) + | :? DbException as ex -> return raise (DbExecutionException(x, ex)) } member internal x.ExecScalarAsync(?ct: CancellationToken) = task { try return! x.ExecuteScalarAsync(cancellationToken = defaultArg ct CancellationToken.None ) with - | :? DbException as ex -> - let error = DbExecutionError { - Statement = x.CommandText - Error = ex } - - return raise (DbFailureException error) + | :? DbException as ex -> return raise (DbExecutionException(x, ex)) } /// IDataReader extensions type IDataReader with member private x.GetOrdinalOption (name : string) = try - let i = x.GetOrdinal(name) - - match x.IsDBNull(i) with - | true -> None - | false -> Some(i) + // Some vendors will return a -1 index instead of throwing an + // IndexOfOutRangeException + match x.GetOrdinal name with + | i when i < 0 -> raise (IndexOutOfRangeException(name + " is not a valid field name")) + | i when x.IsDBNull(i) -> None + | i -> Some i with - | :? IndexOutOfRangeException as ex -> - let error = DataReaderOutOfRangeError { - FieldName = name - Error = ex } - - raise (DbFailureException error) + | :? IndexOutOfRangeException as ex -> raise (DbReaderException(name, ex)) member private x.GetOption (map : int -> 'a when 'a : struct) (name : string) = let fn v = try map v with - | :? InvalidCastException as ex -> - let error = DataReaderCastError { - FieldName = name - Error = ex } - - raise (DbFailureException error) + | :? InvalidCastException as ex -> raise (DbReaderException(name, ex)) x.GetOrdinalOption(name) |> Option.map fn diff --git a/test/Donald.Tests/Script.fsx b/test/Donald.Tests/Script.fsx new file mode 100644 index 0000000..97a739e --- /dev/null +++ b/test/Donald.Tests/Script.fsx @@ -0,0 +1,46 @@ +#r "nuget: System.Data.SQLite" + +open System +open System.Data + +type DbReaderException = + inherit Exception + val FieldName : string option + new() = { inherit Exception(); FieldName = None } + new(message : string) = { inherit Exception(message); FieldName = None } + new(message : string, inner : Exception) = { inherit Exception(message, inner); FieldName = None } + new(fieldName : string, inner : IndexOutOfRangeException) = { inherit Exception($"Failed to read database field: '{fieldName}'", inner); FieldName = Some fieldName } + new(fieldName : string, inner : InvalidCastException) = { inherit Exception($"Failed to read database field: '{fieldName}'", inner); FieldName = Some fieldName } + +type IDataReader with + member private x.GetOrdinalOption (name : string) = + try + let i = x.GetOrdinal(name) + + if i < 0 then raise (IndexOutOfRangeException(name + " is not a valid field name")) + + match x.IsDBNull(i) with + | true -> None + | false -> Some(i) + with + | :? IndexOutOfRangeException as ex -> raise (DbReaderException(name, ex)) + +open System.Data.SQLite + +let conn = new SQLiteConnection("Data Source=:memory:;Version=3;New=true;") +conn.Open () + +let sql = " + WITH author AS ( + SELECT 1 AS author_id, 'pim brouwers' AS full_name + ) + SELECT author_id, full_name + FROM author + WHERE 1 = 2" + +let cmd = conn.CreateCommand () +cmd.CommandText <- sql + +let rd = cmd.ExecuteReader () +[ while rd.Read () do rd.GetOrdinalOption "email" ] +|> printfn "%A" \ No newline at end of file diff --git a/test/Donald.Tests/Tests.fs b/test/Donald.Tests/Tests.fs index 4d9c78d..68549ec 100644 --- a/test/Donald.Tests/Tests.fs +++ b/test/Donald.Tests/Tests.fs @@ -9,18 +9,17 @@ open Donald open FsUnit.Xunit open System.Threading -let connectionString = "Data Source=:memory:;Version=3;New=true;" -let conn = new SQLiteConnection(connectionString) +let conn = new SQLiteConnection("Data Source=:memory:;Version=3;New=true;") -let shouldNotBeError pred (result : Result<'a, DbError>) = - match result with - | Ok result' -> pred result' - | Error e -> sprintf "DbResult should not be Error: %A" e |> should equal false +// let shouldNotBeError pred (result : Result<'a, DbError>) = +// match result with +// | Ok result' -> pred result' +// | Error e -> sprintf "DbResult should not be Error: %A" e |> should equal false -let shouldNotBeOk (result : Result<'a, DbError>) = - match result with - | Error ex -> ex |> should be instanceOfType - | _ -> "DbResult should not be Ok" |> should equal false +// let shouldNotBeOk (result : Result<'a, DbError>) = +// match result with +// | Error ex -> ex |> should be instanceOfType +// | _ -> "DbResult should not be Ok" |> should equal false type Author = { AuthorId : int @@ -115,7 +114,7 @@ type ExecutionTests() = p_int64 = rd.ReadInt64 "p_int64" p_date_time = rd.ReadDateTime "p_date_time" |}) - |> shouldNotBeError (fun result -> + |> fun result -> result.IsSome |> should equal true result.Value.p_null |> should equal "" result.Value.p_string |> should equal "p_string" @@ -131,7 +130,7 @@ type ExecutionTests() = result.Value.p_int16 |> should equal 16s result.Value.p_int32 |> should equal 32 result.Value.p_int64 |> should equal 64L - result.Value.p_date_time |> should equal dateTimeParam) + result.Value.p_date_time |> should equal dateTimeParam [] member _.``DbUnit dispose`` () = @@ -140,9 +139,9 @@ type ExecutionTests() = dbUnit |> Db.setParams [ "p", SqlType.Int32 1 ] |> Db.querySingle (fun rd -> rd.ReadInt32 "p") - |> shouldNotBeError (fun result -> + |> fun result -> result.IsSome |> should equal true - result.Value |> should equal 1) + result.Value |> should equal 1 [] member _.``SELECT records`` () = @@ -154,10 +153,10 @@ type ExecutionTests() = conn |> Db.newCommand sql |> Db.query Author.FromReader - |> shouldNotBeError (fun result -> + |> fun result -> result.Length |> should equal 2 result[0].FullName |> should equal "Pim Brouwers" - result[1].FullName |> should equal "John Doe") + result[1].FullName |> should equal "John Doe" [] member _.``SELECT records async`` () = @@ -171,22 +170,40 @@ type ExecutionTests() = |> Db.Async.query Author.FromReader |> Async.AwaitTask |> Async.RunSynchronously - |> shouldNotBeError (fun result -> + |> fun result -> result.Length |> should equal 2 result[0].FullName |> should equal "Pim Brouwers" - result[1].FullName |> should equal "John Doe") + result[1].FullName |> should equal "John Doe" [] - member _.``SELECT records should fail and create DbError`` () = + member _.``SELECT records should fail`` () = let sql = " SELECT author_id, full_name FROM fake_author" - conn - |> Db.newCommand sql - |> Db.query Author.FromReader - |> shouldNotBeOk + let query () = + conn + |> Db.newCommand sql + |> Db.query Author.FromReader + |> ignore + + query |> should throw typeof + + [] + member _.``SELECT records with invalid field name should fail`` () = + let sql = " + SELECT author_id, full_name + FROM author" + + let query () = + conn + |> Db.newCommand sql + |> Db.query (fun rd -> rd.ReadString "email") + |> ignore + + query |> should throw typeof + [] member _.``SELECT NULL`` () = @@ -199,10 +216,10 @@ type ExecutionTests() = FullName = rd.ReadStringOption "full_name" |> Option.defaultValue null Age = rd.ReadInt32Option "age" |> Option.toNullable |}) - |> shouldNotBeError (fun result -> + |> fun result -> result.IsSome |> should equal true result.Value.FullName |> should equal null - result.Value.Age |> should equal null) + result.Value.Age |> should equal null [] member _.``SELECT scalar value`` () = @@ -211,8 +228,7 @@ type ExecutionTests() = conn |> Db.newCommand sql |> Db.scalar Convert.ToInt32 - |> shouldNotBeError (fun result -> - result |> should equal 1) + |> should equal 1 [] member _.``SELECT scalar value async`` () = @@ -223,8 +239,7 @@ type ExecutionTests() = |> Db.Async.scalar Convert.ToInt32 |> Async.AwaitTask |> Async.RunSynchronously - |> shouldNotBeError (fun result -> - result |> should equal 1) + |> should equal 1 [] member _.``SELECT single record`` () = @@ -239,9 +254,9 @@ type ExecutionTests() = |> Db.querySingle (fun rd -> { FullName = rd.ReadString "full_name" AuthorId = rd.ReadInt32 "author_id" }) - |> shouldNotBeError (fun result -> + |> fun result -> result.IsSome |> should equal true - result.Value.AuthorId |> should equal 1) + result.Value.AuthorId |> should equal 1 [] member _.``SELECT single record async`` () = @@ -258,9 +273,9 @@ type ExecutionTests() = AuthorId = rd.ReadInt32 "author_id" }) |> Async.AwaitTask |> Async.RunSynchronously - |> shouldNotBeError (fun result -> + |> fun result -> result.IsSome |> should equal true - result.Value.AuthorId |> should equal 1) + result.Value.AuthorId |> should equal 1 [] member _.``INSERT author then retrieve to verify`` () = @@ -279,14 +294,14 @@ type ExecutionTests() = |> Db.newCommand sql |> Db.setParams param |> Db.querySingle Author.FromReader - |> shouldNotBeError (fun result -> + |> fun result -> result.IsSome |> should equal true match result with | Some author -> author.FullName |> should equal fullName | None -> - ()) + () [] member _.``INSERT author with NULL birth_date`` () = @@ -305,10 +320,10 @@ type ExecutionTests() = |> Db.newCommand sql |> Db.setParams param |> Db.exec - |> shouldNotBeError (fun result -> ()) + |> should equal () [] - member _.``INSERT author should fail and create DbError`` () = + member _.``INSERT author should fail`` () = let fullName = "Jane Doe" let sql = " @@ -317,11 +332,13 @@ type ExecutionTests() = let param = [ "full_name", SqlType.String fullName ] - conn - |> Db.newCommand sql - |> Db.setParams param - |> Db.exec - |> shouldNotBeOk + let query () = + conn + |> Db.newCommand sql + |> Db.setParams param + |> Db.exec + + query |> should throw typeof [] member _.``INSERT MANY authors then count to verify`` () = @@ -343,8 +360,7 @@ type ExecutionTests() = conn |> Db.newCommand sql |> Db.query Author.FromReader - |> shouldNotBeError (fun result -> - result.Length |> should equal 2) + |> fun result -> result.Length |> should equal 2 [] member _.``INSERT TRAN MANY authors then count to verify async`` () = @@ -377,21 +393,22 @@ type ExecutionTests() = |> Db.Async.query Author.FromReader |> Async.AwaitTask |> Async.RunSynchronously - |> shouldNotBeError (fun result -> - result.Length |> should equal 2) + |> fun result -> result.Length |> should equal 2 [] - member _.``INSERT MANY should fail and create DbError`` () = + member _.``INSERT MANY should fail`` () = let sql = " INSERT INTO fake_author (full_name) VALUES (@full_name);" - conn - |> Db.newCommand sql - |> Db.execMany - [ [ "full_name", SqlType.String "Bugs Bunny" ] - [ "full_name", SqlType.String "Donald Duck" ] ] - |> shouldNotBeOk + let query () = + conn + |> Db.newCommand sql + |> Db.execMany + [ [ "full_name", SqlType.String "Bugs Bunny" ] + [ "full_name", SqlType.String "Donald Duck" ] ] + + query |> should throw typeof [] member _.``INSERT+SELECT binary should work`` () = @@ -408,13 +425,13 @@ type ExecutionTests() = |> Db.newCommand sql |> Db.setParams param |> Db.querySingle (fun rd -> rd.ReadBytes "data") - |> shouldNotBeError (fun result -> + |> fun result -> match result with | Some b -> let str = Text.Encoding.UTF8.GetString(b) b |> should equal bytes str |> should equal testString - | None -> true |> should equal "Invalid bytes returned") + | None -> true |> should equal "Invalid bytes returned" [] member _.``INSERT TRAN author then retrieve to verify`` () = @@ -444,9 +461,9 @@ type ExecutionTests() = |> Db.newCommand sql |> Db.setParams param |> Db.querySingle Author.FromReader - |> shouldNotBeError (fun result -> + |> fun result -> result.IsSome |> should equal true - result.Value.FullName |> should equal "Janet Doe") + result.Value.FullName |> should equal "Janet Doe" [] member _.``IDataReader via read`` () = @@ -459,10 +476,10 @@ type ExecutionTests() = |> Db.newCommand sql |> Db.read (fun rd -> [ while rd.Read() do Author.FromReader rd ]) - |> shouldNotBeError (fun result -> + |> fun result -> result.Length |> should equal 2 result[0].FullName |> should equal "Pim Brouwers" - result[1].FullName |> should equal "John Doe") + result[1].FullName |> should equal "John Doe" [] member _.``Returning Task via async read`` () = @@ -477,10 +494,10 @@ type ExecutionTests() = [ while rd.Read() do Author.FromReader rd ]) |> Async.AwaitTask |> Async.RunSynchronously - |> shouldNotBeError (fun result -> + |> fun result -> result.Length |> should equal 2 result[0].FullName |> should equal "Pim Brouwers" - result[1].FullName |> should equal "John Doe") + result[1].FullName |> should equal "John Doe" [] member _.``SELECT scalar Canceled request should be canceled`` () = @@ -564,8 +581,7 @@ type ExecutionTests() = |> Db.Async.read (fun _ -> ()) |> Async.AwaitTask |> Async.RunSynchronously - |> shouldNotBeError (fun _ -> ()) - () + |> should equal () action |> should throw typeof From 7799da230d767b5c93542324854e726604311e08 Mon Sep 17 00:00:00 2001 From: Pim Brouwers Date: Thu, 2 Feb 2023 16:00:13 -0500 Subject: [PATCH 02/13] readme --- README.md | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/README.md b/README.md index cd94119..3cc235f 100644 --- a/README.md +++ b/README.md @@ -50,7 +50,7 @@ module Author = let ofDataReader (rd : IDataReader) : Author = { FullName = rd.ReadString "full_name" } -let authors : Author list = +let authors (conn : IDbConnection) : Author list = let sql = " SELECT full_name FROM author @@ -58,8 +58,6 @@ let authors : Author list = let param = [ "author_id", SqlType.Int 1 ] - use conn = new SQLiteConnection "{your connection string}" - conn |> Db.newCommand sql |> Db.setParams param From 21f5e1602da5efd3b672e4e3df560be9457249a0 Mon Sep 17 00:00:00 2001 From: Pim Brouwers Date: Thu, 2 Feb 2023 20:30:34 -0500 Subject: [PATCH 03/13] code formatting --- src/Donald/Core.fs | 7 +- src/Donald/Db.fs | 43 ++++----- src/Donald/Extensions.fs | 196 +++++++++++++-------------------------- 3 files changed, 85 insertions(+), 161 deletions(-) diff --git a/src/Donald/Core.fs b/src/Donald/Core.fs index ee24808..4850e8e 100644 --- a/src/Donald/Core.fs +++ b/src/Donald/Core.fs @@ -17,9 +17,6 @@ type DbUnit (cmd : IDbCommand) = member x.Dispose () = x.Command.Dispose () -/// Details the steps of database a transaction. -type DbTransactionStep = TxBegin | TxCommit | TxRollback - /// Details of failure to connection to a database/server. type DbConnectionException = inherit Exception @@ -30,6 +27,9 @@ type DbConnectionException = new(info : SerializationInfo, context : StreamingContext) = { inherit Exception(info, context); ConnectionString = None } new(connection : IDbConnection, inner : Exception) = { inherit Exception("Failed to establish database connection", inner); ConnectionString = Some connection.ConnectionString} +/// Details the steps of database a transaction. +type DbTransactionStep = TxBegin | TxCommit | TxRollback + /// Details of failure to execute database command or transaction. type DbExecutionException = inherit Exception @@ -53,7 +53,6 @@ type DbReaderException = new(fieldName : string, inner : IndexOutOfRangeException) = { inherit Exception($"Failed to read database field: '{fieldName}'", inner); FieldName = Some fieldName } new(fieldName : string, inner : InvalidCastException) = { inherit Exception($"Failed to read database field: '{fieldName}'", inner); FieldName = Some fieldName } - /// Represents the supported data types for database IO. [] type SqlType = diff --git a/src/Donald/Db.fs b/src/Donald/Db.fs index 240e4b3..176a5de 100644 --- a/src/Donald/Db.fs +++ b/src/Donald/Db.fs @@ -48,58 +48,55 @@ module Db = // Execution model let private tryDo (dbUnit : DbUnit) (fn : IDbCommand -> 'a) = - dbUnit.Command.Connection.TryOpenConnection () + dbUnit.Command.Connection.TryOpenConnection() let result = fn dbUnit.Command - (dbUnit :> IDisposable).Dispose () + (dbUnit :> IDisposable).Dispose() result /// Execute parameterized query with no results. let exec (dbUnit : DbUnit) : unit = - tryDo dbUnit (fun cmd -> cmd.Exec ()) + tryDo dbUnit (fun cmd -> cmd.Exec()) /// Execute parameterized query many times with no results. let execMany (param : RawDbParams list) (dbUnit : DbUnit) : unit = - dbUnit.Command.Connection.TryOpenConnection () + dbUnit.Command.Connection.TryOpenConnection() for p in param do let dbParams = DbParams.create p - dbUnit.Command.SetDbParams(dbParams).Exec () + dbUnit.Command.SetDbParams(dbParams).Exec() /// Execute scalar query and box the result. let scalar (convert : obj -> 'a) (dbUnit : DbUnit) : 'a = tryDo dbUnit (fun cmd -> - let value = cmd.ExecScalar () + let value = cmd.ExecScalar() convert value) /// Execute paramterized query and return IDataReader let read (fn : 'reader -> 'a when 'reader :> IDataReader) (dbUnit : DbUnit) : 'a = tryDo dbUnit (fun cmd -> - use rd = cmd.ExecReader (dbUnit.CommandBehavior) :?> 'reader + use rd = cmd.ExecReader(dbUnit.CommandBehavior) :?> 'reader fn rd) /// Execute parameterized query, enumerate all records and apply mapping. let query (map : 'reader -> 'a when 'reader :> IDataReader) (dbUnit : DbUnit) : 'a list = - read (fun rd -> [ while rd.Read () do yield map rd ]) dbUnit - + read (fun rd -> [ while rd.Read() do yield map rd ]) dbUnit /// Execute paramterized query, read only first record and apply mapping. let querySingle (map : 'reader -> 'a when 'reader :> IDataReader) (dbUnit : DbUnit) : 'a option = - read (fun rd -> if rd.Read () then Some(map rd) else None) dbUnit + read (fun rd -> if rd.Read() then Some(map rd) else None) dbUnit module Async = let private tryDoAsync (dbUnit : DbUnit) (fn : DbCommand -> Task<'a>) : Task<'a> = task { do! dbUnit.Command.Connection.TryOpenConnectionAsync(dbUnit.CancellationToken) let! result = fn (dbUnit.Command :?> DbCommand) - (dbUnit :> IDisposable).Dispose () - return result - } + (dbUnit :> IDisposable).Dispose() + return result } /// Asynchronously execute parameterized query with no results. let exec (dbUnit : DbUnit) : Task = tryDoAsync dbUnit (fun (cmd : DbCommand) -> task { let! _ = cmd.ExecAsync(dbUnit.CancellationToken) - return () - }) + return () }) /// Asynchronously execute parameterized query many times with no results let execMany (param : RawDbParams list) (dbUnit : DbUnit) : Task = @@ -108,28 +105,24 @@ module Db = let dbParams = DbParams.create p let! _ = cmd.SetDbParams(dbParams).ExecAsync(dbUnit.CancellationToken) () - - return () - }) + return () }) /// Execute scalar query and box the result. let scalar (convert : obj -> 'a) (dbUnit : DbUnit) : Task<'a> = tryDoAsync dbUnit (fun (cmd : DbCommand) -> task { - let! value = cmd.ExecScalarAsync (dbUnit.CancellationToken) - return convert value - }) + let! value = cmd.ExecScalarAsync(dbUnit.CancellationToken) + return convert value }) /// Asynchronously execute paramterized query and return IDataReader let read (fn : 'reader -> 'a when 'reader :> IDataReader) (dbUnit : DbUnit) : Task<'a> = tryDoAsync dbUnit (fun (cmd : DbCommand) -> task { use! rd = cmd.ExecReaderAsync(dbUnit.CommandBehavior, dbUnit.CancellationToken) - return fn (rd :?> 'reader) - }) + return fn (rd :?> 'reader) }) /// Asynchronously execute parameterized query, enumerate all records and apply mapping. let query (map : 'reader -> 'a when 'reader :> IDataReader) (dbUnit : DbUnit) : Task<'a list> = - read (fun rd -> [ while rd.Read () do map rd ]) dbUnit + read (fun rd -> [ while rd.Read() do map rd ]) dbUnit /// Asynchronously execute paramterized query, read only first record and apply mapping. let querySingle (map : 'reader -> 'a when 'reader :> IDataReader) (dbUnit : DbUnit) : Task<'a option> = - read (fun rd -> if rd.Read () then Some(map rd) else None) dbUnit \ No newline at end of file + read (fun rd -> if rd.Read() then Some(map rd) else None) dbUnit \ No newline at end of file diff --git a/src/Donald/Extensions.fs b/src/Donald/Extensions.fs index 51ecc2a..498dcf5 100644 --- a/src/Donald/Extensions.fs +++ b/src/Donald/Extensions.fs @@ -11,7 +11,7 @@ module Extensions = type IDbConnection with /// Safely attempt to open a new IDbTransaction or /// return FailedOpenConnectionException. - member x.TryOpenConnection() = + member x.TryOpenConnection() = try if x.State = ConnectionState.Closed then x.Open() @@ -91,7 +91,6 @@ module Extensions = // when commmited or rolled back already, but most // implementations do not. So in all cases try rolling back x.TryRollback() - raise (DbExecutionException(TxCommit, ex)) /// Safely attempt to commit an IDbTransaction. @@ -111,13 +110,31 @@ module Extensions = // when commmited or rolled back already, but most // implementations do not. So in all cases try rolling back do! x.TryRollbackAsync(ct) - return raise (DbExecutionException(TxCommit, ex)) } type IDbCommand with + member internal x.Exec() = + try + x.ExecuteNonQuery() |> ignore + with + | :? DbException as ex -> raise (DbExecutionException(x, ex)) + + member internal x.ExecReader(cmdBehavior : CommandBehavior) = + try + x.ExecuteReader(cmdBehavior) + with + | :? DbException as ex -> raise (DbExecutionException(x, ex)) + + member internal x.ExecScalar() = + try + x.ExecuteScalar() + with + | :? DbException as ex -> raise (DbExecutionException(x, ex)) + member internal x.SetDbParams(dbParams : DbParams) = - let setParamValue (p : IDbDataParameter) (v : obj) = + let setParamValue (dbType : DbType) (p : IDbDataParameter) (v : obj) = + p.DbType <- dbType if isNull v then p.Value <- DBNull.Value else p.Value <- v @@ -128,90 +145,29 @@ module Extensions = p.ParameterName <- param.Name match param.Value with - | SqlType.Null -> - p.Value <- DBNull.Value - - | SqlType.String v -> - p.DbType <- DbType.String - setParamValue p v - - | SqlType.AnsiString v -> - p.DbType <- DbType.AnsiString - setParamValue p v - - | SqlType.Boolean v -> - p.DbType <- DbType.Boolean - setParamValue p v - - | SqlType.Byte v -> - p.DbType <- DbType.Byte - setParamValue p v - - | SqlType.Char v -> - p.DbType <- DbType.AnsiString - setParamValue p v - - | SqlType.AnsiChar v -> - p.DbType <- DbType.String - setParamValue p v - - | SqlType.Decimal v -> - p.DbType <- DbType.Decimal - setParamValue p v - + | SqlType.Null -> p.Value <- DBNull.Value + | SqlType.String v -> setParamValue DbType.String p v + | SqlType.AnsiString v -> setParamValue DbType.AnsiString p v + | SqlType.Boolean v -> setParamValue DbType.Boolean p v + | SqlType.Byte v -> setParamValue DbType.Byte p v + | SqlType.Char v -> setParamValue DbType.AnsiString p v + | SqlType.AnsiChar v -> setParamValue DbType.String p v + | SqlType.Decimal v -> setParamValue DbType.Decimal p v | SqlType.Double v - | SqlType.Float v -> - p.DbType <- DbType.Double - setParamValue p v - - | SqlType.Int16 v -> - p.DbType <- DbType.Int16 - setParamValue p v - + | SqlType.Float v -> setParamValue DbType.Double p v + | SqlType.Int16 v -> setParamValue DbType.Int16 p v | SqlType.Int32 v - | SqlType.Int v -> - p.DbType <- DbType.Int32 - setParamValue p v - - | SqlType.Int64 v -> - p.DbType <- DbType.Int64 - setParamValue p v - - | SqlType.Guid v -> - p.DbType <- DbType.Guid - setParamValue p v - - | SqlType.DateTime v -> - p.DbType <- DbType.DateTime - setParamValue p v - - | SqlType.Bytes v -> - p.DbType <- DbType.Binary - setParamValue p v + | SqlType.Int v -> setParamValue DbType.Int32 p v + | SqlType.Int64 v -> setParamValue DbType.Int64 p v + | SqlType.Guid v -> setParamValue DbType.Guid p v + | SqlType.DateTime v -> setParamValue DbType.DateTime p v + | SqlType.Bytes v -> setParamValue DbType.Binary p v x.Parameters.Add(p) |> ignore x - member internal x.Exec () = - try - x.ExecuteNonQuery() |> ignore - with - | :? DbException as ex -> raise (DbExecutionException(x, ex)) - - member internal x.ExecReader (cmdBehavior : CommandBehavior) = - try - x.ExecuteReader(cmdBehavior) - with - | :? DbException as ex -> raise (DbExecutionException(x, ex)) - - member internal x.ExecScalar () = - try - x.ExecuteScalar() - with - | :? DbException as ex -> raise (DbExecutionException(x, ex)) - type DbCommand with member internal x.SetDbParams(param : DbParams) = (x :> IDbCommand).SetDbParams(param) :?> DbCommand @@ -239,7 +195,7 @@ module Extensions = /// IDataReader extensions type IDataReader with - member private x.GetOrdinalOption (name : string) = + member private x.GetOrdinalOption(name : string) = try // Some vendors will return a -1 index instead of throwing an // IndexOfOutRangeException @@ -250,7 +206,7 @@ module Extensions = with | :? IndexOutOfRangeException as ex -> raise (DbReaderException(name, ex)) - member private x.GetOption (map : int -> 'a when 'a : struct) (name : string) = + member private x.GetOption(map : int -> 'a when 'a : struct) (name : string) = let fn v = try map v @@ -261,107 +217,83 @@ module Extensions = |> Option.map fn /// Safely retrieve String Option - member x.ReadStringOption (name : string) = - name |> x.GetOrdinalOption |> Option.map (fun i -> x.GetString(i)) + member x.ReadStringOption(name : string) = name |> x.GetOrdinalOption |> Option.map(fun i -> x.GetString(i)) /// Safely retrieve Boolean Option - member x.ReadBooleanOption (name : string) = - name |> x.GetOption (fun i -> x.GetBoolean(i)) + member x.ReadBooleanOption(name : string) = name |> x.GetOption(fun i -> x.GetBoolean(i)) /// Safely retrieve Byte Option - member x.ReadByteOption (name : string) = - name |> x.GetOption (fun i -> x.GetByte(i)) + member x.ReadByteOption(name : string) = name |> x.GetOption(fun i -> x.GetByte(i)) /// Safely retrieve Char Option - member x.ReadCharOption (name : string) = - name |> x.GetOption (fun i -> x.GetString(i).[0]) + member x.ReadCharOption(name : string) = name |> x.GetOption(fun i -> x.GetString(i).[0]) /// Safely retrieve DateTime Option - member x.ReadDateTimeOption (name : string) = - name |> x.GetOption (fun i -> x.GetDateTime(i)) + member x.ReadDateTimeOption(name : string) = name |> x.GetOption(fun i -> x.GetDateTime(i)) /// Safely retrieve Decimal Option - member x.ReadDecimalOption (name : string) = - name |> x.GetOption (fun i -> x.GetDecimal(i)) + member x.ReadDecimalOption(name : string) = name |> x.GetOption(fun i -> x.GetDecimal(i)) /// Safely retrieve Double Option - member x.ReadDoubleOption (name : string) = - name |> x.GetOption (fun i -> x.GetDouble(i)) + member x.ReadDoubleOption(name : string) = name |> x.GetOption(fun i -> x.GetDouble(i)) /// Safely retrieve Float Option - member x.ReadFloatOption (name : string) = - x.ReadDoubleOption name + member x.ReadFloatOption(name : string) = x.ReadDoubleOption name /// Safely retrieve Guid Option - member x.ReadGuidOption (name : string) = - name |> x.GetOption (fun i -> x.GetGuid(i)) + member x.ReadGuidOption(name : string) = name |> x.GetOption(fun i -> x.GetGuid(i)) /// Safely retrieve Int16 Option - member x.ReadInt16Option (name : string) = - name |> x.GetOption (fun i -> x.GetInt16(i)) + member x.ReadInt16Option (name : string) = name |> x.GetOption(fun i -> x.GetInt16(i)) /// Safely retrieve Int32 Option - member x.ReadInt32Option (name : string) = - name |> x.GetOption (fun i -> x.GetInt32(i)) + member x.ReadInt32Option (name : string) = name |> x.GetOption(fun i -> x.GetInt32(i)) /// Safely retrieve Int64 Option - member x.ReadInt64Option (name : string) = - name |> x.GetOption (fun i -> x.GetInt64(i)) + member x.ReadInt64Option (name : string) = name |> x.GetOption(fun i -> x.GetInt64(i)) // ------------ // Defaults // ------------ /// Safely retrieve String or return provided default - member x.ReadString (name : string) = - x.ReadStringOption name |> Option.defaultValue String.Empty + member x.ReadString(name : string) = x.ReadStringOption name |> Option.defaultValue String.Empty /// Safely retrieve Boolean or return provided default - member x.ReadBoolean (name : string) = - x.ReadBooleanOption name |> Option.defaultValue false + member x.ReadBoolean(name : string) = x.ReadBooleanOption name |> Option.defaultValue false /// Safely retrieve Byte or return provided default - member x.ReadByte (name : string) = - x.ReadByteOption name |> Option.defaultValue Byte.MinValue + member x.ReadByte(name : string) = x.ReadByteOption name |> Option.defaultValue Byte.MinValue /// Safely retrieve Char or return provided default - member x.ReadChar (name : string) = - x.ReadCharOption name |> Option.defaultValue Char.MinValue + member x.ReadChar(name : string) = x.ReadCharOption name |> Option.defaultValue Char.MinValue /// Safely retrieve DateTime or return provided default - member x.ReadDateTime (name : string) = - x.ReadDateTimeOption name |> Option.defaultValue DateTime.MinValue + member x.ReadDateTime(name : string) = x.ReadDateTimeOption name |> Option.defaultValue DateTime.MinValue /// Safely retrieve Decimal or return provided default - member x.ReadDecimal (name : string) = - x.ReadDecimalOption name |> Option.defaultValue 0.0M + member x.ReadDecimal(name : string) = x.ReadDecimalOption name |> Option.defaultValue 0.0M /// Safely retrieve Double or return provided default - member x.ReadDouble (name : string) = - x.ReadDoubleOption name |> Option.defaultValue 0.0 + member x.ReadDouble(name : string) = x.ReadDoubleOption name |> Option.defaultValue 0.0 /// Safely retrieve Float or return provided default - member x.ReadFloat (name : string) = - x.ReadFloatOption name |> Option.defaultValue 0.0 + member x.ReadFloat(name : string) = x.ReadFloatOption name |> Option.defaultValue 0.0 /// Safely retrieve Guid or return provided default - member x.ReadGuid (name : string) = - x.ReadGuidOption name |> Option.defaultValue Guid.Empty + member x.ReadGuid(name : string) = x.ReadGuidOption name |> Option.defaultValue Guid.Empty /// Safely retrieve Int16 or return provided default - member x.ReadInt16 (name : string) = - x.ReadInt16Option name |> Option.defaultValue 0s + member x.ReadInt16 (name : string) = x.ReadInt16Option name |> Option.defaultValue 0s /// Safely retrieve Int32 or return provided default - member x.ReadInt32 (name : string) = - x.ReadInt32Option name |> Option.defaultValue 0 + member x.ReadInt32 (name : string) = x.ReadInt32Option name |> Option.defaultValue 0 /// Safely retrieve Int64 or return provided default - member x.ReadInt64 (name : string) = - x.ReadInt64Option name |> Option.defaultValue 0L + member x.ReadInt64 (name : string) = x.ReadInt64Option name |> Option.defaultValue 0L /// Safely retrieve byte[] - member x.ReadBytesOption (name : string) : byte[] option = + member x.ReadBytesOption(name : string) : byte[] option = match name |> x.GetOrdinalOption with | None -> None | Some i -> @@ -379,7 +311,7 @@ module Extensions = Some (ms.ToArray()) /// Safely retrieve byte[] or return provided default - member x.ReadBytes (name : string) : byte[] = + member x.ReadBytes(name : string) : byte[] = match x.ReadBytesOption name with | None -> Array.zeroCreate 0 | Some bytes -> bytes From fa4406c2fec034ff6b10e6432a849218f9cc2973 Mon Sep 17 00:00:00 2001 From: Pim Brouwers Date: Fri, 3 Feb 2023 07:36:34 -0500 Subject: [PATCH 04/13] sqltype helpers dbunit todetailstring separate extension files --- src/Donald/Core.fs | 67 +++++++- src/Donald/Donald.fsproj | 5 +- src/Donald/Extensions.fs | 317 ----------------------------------- src/Donald/IDataReader.fs | 129 ++++++++++++++ src/Donald/IDbCommand.fs | 88 ++++++++++ src/Donald/IDbConnection.fs | 58 +++++++ src/Donald/IDbTransaction.fs | 61 +++++++ test/Donald.Tests/Script.fsx | 46 ----- test/Donald.Tests/Tests.fs | 24 +-- 9 files changed, 418 insertions(+), 377 deletions(-) delete mode 100644 src/Donald/Extensions.fs create mode 100644 src/Donald/IDataReader.fs create mode 100644 src/Donald/IDbCommand.fs create mode 100644 src/Donald/IDbConnection.fs create mode 100644 src/Donald/IDbTransaction.fs delete mode 100644 test/Donald.Tests/Script.fsx diff --git a/src/Donald/Core.fs b/src/Donald/Core.fs index 4850e8e..a73475c 100644 --- a/src/Donald/Core.fs +++ b/src/Donald/Core.fs @@ -2,6 +2,7 @@ namespace Donald open System open System.Data +open System.Data.Common open System.Runtime.Serialization open System.Threading @@ -89,4 +90,68 @@ type DbParams = DbParam list module DbParams = /// Create a new DbParam list from raw inputs. let create (lst : RawDbParams) = - [ for k, v in lst -> { Name = k; Value = v } ] \ No newline at end of file + [ for k, v in lst -> { Name = k; Value = v } ] + + +// +// Helpers + +module internal DbUnit = + let toDetailString (dbUnit : DbUnit) = + let cmd = dbUnit.Command :?> DbCommand + let param = + [ for i in 0 .. cmd.Parameters.Count - 1 -> + let p = cmd.Parameters.[i] + let pName = p.ParameterName + let pValue = if isNull p.Value || p.Value = DBNull.Value then "NULL" else string p.Value + String.Concat [ "@"; pName; " = "; pValue ] ] + |> String.concat ", " + |> fun str -> if (String.IsNullOrWhiteSpace str) then "--" else str + + String.Concat [ "\n"; "Parameters:\n"; param; "\n\nCommand Text:\n"; cmd.CommandText ] + +[] +module SqlType = + let inline sqlType (valueFn : 'a -> SqlType) (input : 'a option) = + match input with + | Some x -> x |> valueFn + | None -> SqlType.Null + + let inline sqlBoolean input = SqlType.Boolean input + let inline sqlBooleanOrNull input = sqlType sqlBoolean input + + let inline sqlByte input = SqlType.Byte (byte input) + let inline sqlByteOrNull input = sqlType sqlByte input + + let inline sqlBytes input = SqlType.Bytes input + let inline sqlBytesOrNull input = sqlType sqlBytes input + + let inline sqlChar input = SqlType.Char (char input) + let inline sqlCharOrNull input = sqlType sqlChar input + + let inline sqlDateTime input = SqlType.DateTime input + let inline sqlDateTimeOrNull input = sqlType sqlDateTime input + + let inline sqlDecimal input = SqlType.Decimal (decimal input) + let inline sqlDecimalOrNull input = sqlType sqlDecimal input + + let inline sqlDouble input = SqlType.Double (double input) + let inline sqlDoubleOrNull input = sqlType sqlDouble input + + let inline sqlFloat input = SqlType.Float (float input) + let inline sqlFloatOrNull input = sqlType sqlFloat input + + let inline sqlGuid input = SqlType.Guid input + let inline sqlGuidOrNull input = sqlType sqlGuid input + + let inline sqlInt16 input = SqlType.Int16 (int16 input) + let inline sqlInt16OrNull input = sqlType sqlInt16 input + + let inline sqlInt32 input = SqlType.Int32 (int32 input) + let inline sqlInt32OrNull input = sqlType sqlInt32 input + + let inline sqlInt64 input = SqlType.Int64 (int64 input) + let inline sqlInt64OrNull input = sqlType sqlInt64 input + + let inline sqlString input = SqlType.String (string input) + let inline sqlStringOrNull input = sqlType sqlString input diff --git a/src/Donald/Donald.fsproj b/src/Donald/Donald.fsproj index 64fafe9..9e676f2 100644 --- a/src/Donald/Donald.fsproj +++ b/src/Donald/Donald.fsproj @@ -40,7 +40,10 @@ - + + + + diff --git a/src/Donald/Extensions.fs b/src/Donald/Extensions.fs deleted file mode 100644 index 498dcf5..0000000 --- a/src/Donald/Extensions.fs +++ /dev/null @@ -1,317 +0,0 @@ -namespace Donald - -open System -open System.Data -open System.Data.Common -open System.IO -open System.Threading - -[] -module Extensions = - type IDbConnection with - /// Safely attempt to open a new IDbTransaction or - /// return FailedOpenConnectionException. - member x.TryOpenConnection() = - try - if x.State = ConnectionState.Closed then - x.Open() - with ex -> - raise (DbConnectionException(x, ex)) - - /// Safely attempt to open a new IDbTransaction or - /// return FailedOpenConnectionException. - member x.TryOpenConnectionAsync(?cancellationToken : CancellationToken) = task { - try - let ct = defaultArg cancellationToken CancellationToken.None - if x.State = ConnectionState.Closed then - match x with - | :? DbConnection as c -> do! c.OpenAsync(ct) - | _ -> - ct.ThrowIfCancellationRequested() - x.Open() - with ex -> - return raise (DbConnectionException(x, ex)) - } - - /// Safely attempt to create a new IDbTransaction or - /// return CouldNotBeginTransactionException. - member x.TryBeginTransaction() = - try - x.TryOpenConnection() - x.BeginTransaction() - with ex -> - raise (DbExecutionException(TxBegin, ex)) - - /// Safely attempt to create a new IDbTransaction or - /// return CouldNotBeginTransactionException. - member x.TryBeginTransactionAsync(?cancellationToken : CancellationToken) = task { - try - let ct = defaultArg cancellationToken CancellationToken.None - do! x.TryOpenConnectionAsync(ct) - match x with - | :? DbConnection as c -> - let! dbTransaction = c.BeginTransactionAsync(ct) - return dbTransaction :> IDbTransaction - | _ -> - ct.ThrowIfCancellationRequested() - return x.BeginTransaction() - with ex -> - return raise (DbExecutionException(TxBegin, ex)) - } - - type IDbTransaction with - /// Safely attempt to rollback an IDbTransaction. - member x.TryRollback() = - try - if not(isNull x) && not(isNull x.Connection) then x.Rollback() - with ex -> - raise (DbExecutionException(TxRollback, ex)) - - /// Safely attempt to rollback an IDbTransaction. - member x.TryRollbackAsync(?cancellationToken : CancellationToken) = task { - try - if not(isNull x) && not(isNull x.Connection) then - let ct = defaultArg cancellationToken CancellationToken.None - match x with - | :? DbTransaction as t-> do! t.RollbackAsync(ct) - | _ -> - ct.ThrowIfCancellationRequested() - x.Rollback() - with ex -> - return raise (DbExecutionException(TxRollback, ex)) - } - - /// Safely attempt to commit an IDbTransaction. - /// Will rollback in the case of Exception. - member x.TryCommit() = - try - if not(isNull x) && not(isNull x.Connection) then x.Commit() - with ex -> - // Is supposed to throw System.InvalidOperationException - // when commmited or rolled back already, but most - // implementations do not. So in all cases try rolling back - x.TryRollback() - raise (DbExecutionException(TxCommit, ex)) - - /// Safely attempt to commit an IDbTransaction. - /// Will rollback in the case of Exception. - member x.TryCommitAsync(?cancellationToken : CancellationToken) = task { - let ct = defaultArg cancellationToken CancellationToken.None - try - if not(isNull x) && not(isNull x.Connection) then - - match x with - | :? DbTransaction as t -> do! t.CommitAsync(ct) - | _ -> - ct.ThrowIfCancellationRequested() - x.Commit() - with ex -> - // Is supposed to throw System.InvalidOperationException - // when commmited or rolled back already, but most - // implementations do not. So in all cases try rolling back - do! x.TryRollbackAsync(ct) - return raise (DbExecutionException(TxCommit, ex)) - } - - type IDbCommand with - member internal x.Exec() = - try - x.ExecuteNonQuery() |> ignore - with - | :? DbException as ex -> raise (DbExecutionException(x, ex)) - - member internal x.ExecReader(cmdBehavior : CommandBehavior) = - try - x.ExecuteReader(cmdBehavior) - with - | :? DbException as ex -> raise (DbExecutionException(x, ex)) - - member internal x.ExecScalar() = - try - x.ExecuteScalar() - with - | :? DbException as ex -> raise (DbExecutionException(x, ex)) - - member internal x.SetDbParams(dbParams : DbParams) = - let setParamValue (dbType : DbType) (p : IDbDataParameter) (v : obj) = - p.DbType <- dbType - if isNull v then p.Value <- DBNull.Value - else p.Value <- v - - x.Parameters.Clear() // clear to ensure a clean working set - - for param in dbParams do - let p = x.CreateParameter() - p.ParameterName <- param.Name - - match param.Value with - | SqlType.Null -> p.Value <- DBNull.Value - | SqlType.String v -> setParamValue DbType.String p v - | SqlType.AnsiString v -> setParamValue DbType.AnsiString p v - | SqlType.Boolean v -> setParamValue DbType.Boolean p v - | SqlType.Byte v -> setParamValue DbType.Byte p v - | SqlType.Char v -> setParamValue DbType.AnsiString p v - | SqlType.AnsiChar v -> setParamValue DbType.String p v - | SqlType.Decimal v -> setParamValue DbType.Decimal p v - | SqlType.Double v - | SqlType.Float v -> setParamValue DbType.Double p v - | SqlType.Int16 v -> setParamValue DbType.Int16 p v - | SqlType.Int32 v - | SqlType.Int v -> setParamValue DbType.Int32 p v - | SqlType.Int64 v -> setParamValue DbType.Int64 p v - | SqlType.Guid v -> setParamValue DbType.Guid p v - | SqlType.DateTime v -> setParamValue DbType.DateTime p v - | SqlType.Bytes v -> setParamValue DbType.Binary p v - - x.Parameters.Add(p) - |> ignore - - x - - type DbCommand with - member internal x.SetDbParams(param : DbParams) = - (x :> IDbCommand).SetDbParams(param) :?> DbCommand - - member internal x.ExecAsync(?ct: CancellationToken) = task { - try - return! x.ExecuteNonQueryAsync(cancellationToken = defaultArg ct CancellationToken.None) - with - | :? DbException as ex -> return raise (DbExecutionException(x, ex)) - } - - member internal x.ExecReaderAsync(cmdBehavior : CommandBehavior, ?ct: CancellationToken) = task { - try - return! x.ExecuteReaderAsync(cmdBehavior, cancellationToken = defaultArg ct CancellationToken.None ) - with - | :? DbException as ex -> return raise (DbExecutionException(x, ex)) - } - - member internal x.ExecScalarAsync(?ct: CancellationToken) = task { - try - return! x.ExecuteScalarAsync(cancellationToken = defaultArg ct CancellationToken.None ) - with - | :? DbException as ex -> return raise (DbExecutionException(x, ex)) - } - - /// IDataReader extensions - type IDataReader with - member private x.GetOrdinalOption(name : string) = - try - // Some vendors will return a -1 index instead of throwing an - // IndexOfOutRangeException - match x.GetOrdinal name with - | i when i < 0 -> raise (IndexOutOfRangeException(name + " is not a valid field name")) - | i when x.IsDBNull(i) -> None - | i -> Some i - with - | :? IndexOutOfRangeException as ex -> raise (DbReaderException(name, ex)) - - member private x.GetOption(map : int -> 'a when 'a : struct) (name : string) = - let fn v = - try - map v - with - | :? InvalidCastException as ex -> raise (DbReaderException(name, ex)) - - x.GetOrdinalOption(name) - |> Option.map fn - - /// Safely retrieve String Option - member x.ReadStringOption(name : string) = name |> x.GetOrdinalOption |> Option.map(fun i -> x.GetString(i)) - - /// Safely retrieve Boolean Option - member x.ReadBooleanOption(name : string) = name |> x.GetOption(fun i -> x.GetBoolean(i)) - - /// Safely retrieve Byte Option - member x.ReadByteOption(name : string) = name |> x.GetOption(fun i -> x.GetByte(i)) - - /// Safely retrieve Char Option - member x.ReadCharOption(name : string) = name |> x.GetOption(fun i -> x.GetString(i).[0]) - - /// Safely retrieve DateTime Option - member x.ReadDateTimeOption(name : string) = name |> x.GetOption(fun i -> x.GetDateTime(i)) - - /// Safely retrieve Decimal Option - member x.ReadDecimalOption(name : string) = name |> x.GetOption(fun i -> x.GetDecimal(i)) - - /// Safely retrieve Double Option - member x.ReadDoubleOption(name : string) = name |> x.GetOption(fun i -> x.GetDouble(i)) - - /// Safely retrieve Float Option - member x.ReadFloatOption(name : string) = x.ReadDoubleOption name - - /// Safely retrieve Guid Option - member x.ReadGuidOption(name : string) = name |> x.GetOption(fun i -> x.GetGuid(i)) - - /// Safely retrieve Int16 Option - member x.ReadInt16Option (name : string) = name |> x.GetOption(fun i -> x.GetInt16(i)) - - /// Safely retrieve Int32 Option - member x.ReadInt32Option (name : string) = name |> x.GetOption(fun i -> x.GetInt32(i)) - - /// Safely retrieve Int64 Option - member x.ReadInt64Option (name : string) = name |> x.GetOption(fun i -> x.GetInt64(i)) - - // ------------ - // Defaults - // ------------ - - /// Safely retrieve String or return provided default - member x.ReadString(name : string) = x.ReadStringOption name |> Option.defaultValue String.Empty - - /// Safely retrieve Boolean or return provided default - member x.ReadBoolean(name : string) = x.ReadBooleanOption name |> Option.defaultValue false - - /// Safely retrieve Byte or return provided default - member x.ReadByte(name : string) = x.ReadByteOption name |> Option.defaultValue Byte.MinValue - - /// Safely retrieve Char or return provided default - member x.ReadChar(name : string) = x.ReadCharOption name |> Option.defaultValue Char.MinValue - - /// Safely retrieve DateTime or return provided default - member x.ReadDateTime(name : string) = x.ReadDateTimeOption name |> Option.defaultValue DateTime.MinValue - - /// Safely retrieve Decimal or return provided default - member x.ReadDecimal(name : string) = x.ReadDecimalOption name |> Option.defaultValue 0.0M - - /// Safely retrieve Double or return provided default - member x.ReadDouble(name : string) = x.ReadDoubleOption name |> Option.defaultValue 0.0 - - /// Safely retrieve Float or return provided default - member x.ReadFloat(name : string) = x.ReadFloatOption name |> Option.defaultValue 0.0 - - /// Safely retrieve Guid or return provided default - member x.ReadGuid(name : string) = x.ReadGuidOption name |> Option.defaultValue Guid.Empty - - /// Safely retrieve Int16 or return provided default - member x.ReadInt16 (name : string) = x.ReadInt16Option name |> Option.defaultValue 0s - - /// Safely retrieve Int32 or return provided default - member x.ReadInt32 (name : string) = x.ReadInt32Option name |> Option.defaultValue 0 - - /// Safely retrieve Int64 or return provided default - member x.ReadInt64 (name : string) = x.ReadInt64Option name |> Option.defaultValue 0L - - /// Safely retrieve byte[] - member x.ReadBytesOption(name : string) : byte[] option = - match name |> x.GetOrdinalOption with - | None -> None - | Some i -> - use ms = new MemoryStream() - let bufferSize = 1024 - let buffer = Array.zeroCreate bufferSize - let rec chunkValue (position: int64) (str : Stream) (rd : IDataReader) = - match rd.GetBytes(i, position, buffer, 0, buffer.Length) with - | 0L -> () - | read -> - ms.Write(buffer, 0, int read) - chunkValue (position + read) str rd - - chunkValue 0L ms x |> ignore - Some (ms.ToArray()) - - /// Safely retrieve byte[] or return provided default - member x.ReadBytes(name : string) : byte[] = - match x.ReadBytesOption name with - | None -> Array.zeroCreate 0 - | Some bytes -> bytes diff --git a/src/Donald/IDataReader.fs b/src/Donald/IDataReader.fs new file mode 100644 index 0000000..1b7547f --- /dev/null +++ b/src/Donald/IDataReader.fs @@ -0,0 +1,129 @@ +namespace Donald + +open System +open System.Data +open System.IO + +[] +module IDataReaderExtensions = + type IDataReader with + member private x.GetOrdinalOption(name : string) = + try + // Some vendors will return a -1 index instead of throwing an + // IndexOfOutRangeException + match x.GetOrdinal name with + | i when i < 0 -> raise (IndexOutOfRangeException(name + " is not a valid field name")) + | i when x.IsDBNull(i) -> None + | i -> Some i + with + | :? IndexOutOfRangeException as ex -> raise (DbReaderException(name, ex)) + + member private x.GetOption(map : int -> 'a when 'a : struct) (name : string) = + let fn v = + try + map v + with + | :? InvalidCastException as ex -> raise (DbReaderException(name, ex)) + + x.GetOrdinalOption(name) + |> Option.map fn + + /// Safely retrieve String Option + member x.ReadStringOption(name : string) = name |> x.GetOrdinalOption |> Option.map(fun i -> x.GetString(i)) + + /// Safely retrieve Boolean Option + member x.ReadBooleanOption(name : string) = name |> x.GetOption(fun i -> x.GetBoolean(i)) + + /// Safely retrieve Byte Option + member x.ReadByteOption(name : string) = name |> x.GetOption(fun i -> x.GetByte(i)) + + /// Safely retrieve Char Option + member x.ReadCharOption(name : string) = name |> x.GetOption(fun i -> x.GetString(i).[0]) + + /// Safely retrieve DateTime Option + member x.ReadDateTimeOption(name : string) = name |> x.GetOption(fun i -> x.GetDateTime(i)) + + /// Safely retrieve Decimal Option + member x.ReadDecimalOption(name : string) = name |> x.GetOption(fun i -> x.GetDecimal(i)) + + /// Safely retrieve Double Option + member x.ReadDoubleOption(name : string) = name |> x.GetOption(fun i -> x.GetDouble(i)) + + /// Safely retrieve Float Option + member x.ReadFloatOption(name : string) = x.ReadDoubleOption name + + /// Safely retrieve Guid Option + member x.ReadGuidOption(name : string) = name |> x.GetOption(fun i -> x.GetGuid(i)) + + /// Safely retrieve Int16 Option + member x.ReadInt16Option (name : string) = name |> x.GetOption(fun i -> x.GetInt16(i)) + + /// Safely retrieve Int32 Option + member x.ReadInt32Option (name : string) = name |> x.GetOption(fun i -> x.GetInt32(i)) + + /// Safely retrieve Int64 Option + member x.ReadInt64Option (name : string) = name |> x.GetOption(fun i -> x.GetInt64(i)) + + // ------------ + // Defaults + // ------------ + + /// Safely retrieve String or return provided default + member x.ReadString(name : string) = x.ReadStringOption name |> Option.defaultValue String.Empty + + /// Safely retrieve Boolean or return provided default + member x.ReadBoolean(name : string) = x.ReadBooleanOption name |> Option.defaultValue false + + /// Safely retrieve Byte or return provided default + member x.ReadByte(name : string) = x.ReadByteOption name |> Option.defaultValue Byte.MinValue + + /// Safely retrieve Char or return provided default + member x.ReadChar(name : string) = x.ReadCharOption name |> Option.defaultValue Char.MinValue + + /// Safely retrieve DateTime or return provided default + member x.ReadDateTime(name : string) = x.ReadDateTimeOption name |> Option.defaultValue DateTime.MinValue + + /// Safely retrieve Decimal or return provided default + member x.ReadDecimal(name : string) = x.ReadDecimalOption name |> Option.defaultValue 0.0M + + /// Safely retrieve Double or return provided default + member x.ReadDouble(name : string) = x.ReadDoubleOption name |> Option.defaultValue 0.0 + + /// Safely retrieve Float or return provided default + member x.ReadFloat(name : string) = x.ReadFloatOption name |> Option.defaultValue 0.0 + + /// Safely retrieve Guid or return provided default + member x.ReadGuid(name : string) = x.ReadGuidOption name |> Option.defaultValue Guid.Empty + + /// Safely retrieve Int16 or return provided default + member x.ReadInt16 (name : string) = x.ReadInt16Option name |> Option.defaultValue 0s + + /// Safely retrieve Int32 or return provided default + member x.ReadInt32 (name : string) = x.ReadInt32Option name |> Option.defaultValue 0 + + /// Safely retrieve Int64 or return provided default + member x.ReadInt64 (name : string) = x.ReadInt64Option name |> Option.defaultValue 0L + + /// Safely retrieve byte[] + member x.ReadBytesOption(name : string) : byte[] option = + match name |> x.GetOrdinalOption with + | None -> None + | Some i -> + use ms = new MemoryStream() + let bufferSize = 1024 + let buffer = Array.zeroCreate bufferSize + let rec chunkValue (position: int64) (str : Stream) (rd : IDataReader) = + match rd.GetBytes(i, position, buffer, 0, buffer.Length) with + | 0L -> () + | read -> + ms.Write(buffer, 0, int read) + chunkValue (position + read) str rd + + chunkValue 0L ms x |> ignore + Some (ms.ToArray()) + + /// Safely retrieve byte[] or return provided default + member x.ReadBytes(name : string) : byte[] = + match x.ReadBytesOption name with + | None -> Array.zeroCreate 0 + | Some bytes -> bytes diff --git a/src/Donald/IDbCommand.fs b/src/Donald/IDbCommand.fs new file mode 100644 index 0000000..387abfc --- /dev/null +++ b/src/Donald/IDbCommand.fs @@ -0,0 +1,88 @@ +namespace Donald + +open System +open System.Data +open System.Data.Common +open System.Threading + +[] +module IDbCommandExtensions = + type IDbCommand with + member internal x.Exec() = + try + x.ExecuteNonQuery() |> ignore + with + | :? DbException as ex -> raise (DbExecutionException(x, ex)) + + member internal x.ExecReader(cmdBehavior : CommandBehavior) = + try + x.ExecuteReader(cmdBehavior) + with + | :? DbException as ex -> raise (DbExecutionException(x, ex)) + + member internal x.ExecScalar() = + try + x.ExecuteScalar() + with + | :? DbException as ex -> raise (DbExecutionException(x, ex)) + + member internal x.SetDbParams(dbParams : DbParams) = + let setParamValue (dbType : DbType) (p : IDbDataParameter) (v : obj) = + p.DbType <- dbType + if isNull v then p.Value <- DBNull.Value + else p.Value <- v + + x.Parameters.Clear() // clear to ensure a clean working set + + for param in dbParams do + let p = x.CreateParameter() + p.ParameterName <- param.Name + + match param.Value with + | SqlType.Null -> p.Value <- DBNull.Value + | SqlType.String v -> setParamValue DbType.String p v + | SqlType.AnsiString v -> setParamValue DbType.AnsiString p v + | SqlType.Boolean v -> setParamValue DbType.Boolean p v + | SqlType.Byte v -> setParamValue DbType.Byte p v + | SqlType.Char v -> setParamValue DbType.AnsiString p v + | SqlType.AnsiChar v -> setParamValue DbType.String p v + | SqlType.Decimal v -> setParamValue DbType.Decimal p v + | SqlType.Double v + | SqlType.Float v -> setParamValue DbType.Double p v + | SqlType.Int16 v -> setParamValue DbType.Int16 p v + | SqlType.Int32 v + | SqlType.Int v -> setParamValue DbType.Int32 p v + | SqlType.Int64 v -> setParamValue DbType.Int64 p v + | SqlType.Guid v -> setParamValue DbType.Guid p v + | SqlType.DateTime v -> setParamValue DbType.DateTime p v + | SqlType.Bytes v -> setParamValue DbType.Binary p v + + x.Parameters.Add(p) + |> ignore + + x + + type DbCommand with + member internal x.SetDbParams(param : DbParams) = + (x :> IDbCommand).SetDbParams(param) :?> DbCommand + + member internal x.ExecAsync(?ct: CancellationToken) = task { + try + return! x.ExecuteNonQueryAsync(cancellationToken = defaultArg ct CancellationToken.None) + with + | :? DbException as ex -> return raise (DbExecutionException(x, ex)) + } + + member internal x.ExecReaderAsync(cmdBehavior : CommandBehavior, ?ct: CancellationToken) = task { + try + return! x.ExecuteReaderAsync(cmdBehavior, cancellationToken = defaultArg ct CancellationToken.None ) + with + | :? DbException as ex -> return raise (DbExecutionException(x, ex)) + } + + member internal x.ExecScalarAsync(?ct: CancellationToken) = task { + try + return! x.ExecuteScalarAsync(cancellationToken = defaultArg ct CancellationToken.None ) + with + | :? DbException as ex -> return raise (DbExecutionException(x, ex)) + } diff --git a/src/Donald/IDbConnection.fs b/src/Donald/IDbConnection.fs new file mode 100644 index 0000000..50c43dc --- /dev/null +++ b/src/Donald/IDbConnection.fs @@ -0,0 +1,58 @@ +namespace Donald + +open System.Data +open System.Data.Common +open System.Threading + +[] +module IDbConnectionExtensions = + type IDbConnection with + /// Safely attempt to open a new IDbTransaction or + /// return FailedOpenConnectionException. + member x.TryOpenConnection() = + try + if x.State = ConnectionState.Closed then + x.Open() + with ex -> + raise (DbConnectionException(x, ex)) + + /// Safely attempt to open a new IDbTransaction or + /// return FailedOpenConnectionException. + member x.TryOpenConnectionAsync(?cancellationToken : CancellationToken) = task { + try + let ct = defaultArg cancellationToken CancellationToken.None + if x.State = ConnectionState.Closed then + match x with + | :? DbConnection as c -> do! c.OpenAsync(ct) + | _ -> + ct.ThrowIfCancellationRequested() + x.Open() + with ex -> + return raise (DbConnectionException(x, ex)) + } + + /// Safely attempt to create a new IDbTransaction or + /// return CouldNotBeginTransactionException. + member x.TryBeginTransaction() = + try + x.TryOpenConnection() + x.BeginTransaction() + with ex -> + raise (DbExecutionException(TxBegin, ex)) + + /// Safely attempt to create a new IDbTransaction or + /// return CouldNotBeginTransactionException. + member x.TryBeginTransactionAsync(?cancellationToken : CancellationToken) = task { + try + let ct = defaultArg cancellationToken CancellationToken.None + do! x.TryOpenConnectionAsync(ct) + match x with + | :? DbConnection as c -> + let! dbTransaction = c.BeginTransactionAsync(ct) + return dbTransaction :> IDbTransaction + | _ -> + ct.ThrowIfCancellationRequested() + return x.BeginTransaction() + with ex -> + return raise (DbExecutionException(TxBegin, ex)) + } diff --git a/src/Donald/IDbTransaction.fs b/src/Donald/IDbTransaction.fs new file mode 100644 index 0000000..0b2fc77 --- /dev/null +++ b/src/Donald/IDbTransaction.fs @@ -0,0 +1,61 @@ +namespace Donald + +open System.Data +open System.Data.Common +open System.Threading + +[] +module IDbTransactionExtensions = + type IDbTransaction with + /// Safely attempt to rollback an IDbTransaction. + member x.TryRollback() = + try + if not(isNull x) && not(isNull x.Connection) then x.Rollback() + with ex -> + raise (DbExecutionException(TxRollback, ex)) + + /// Safely attempt to rollback an IDbTransaction. + member x.TryRollbackAsync(?cancellationToken : CancellationToken) = task { + try + if not(isNull x) && not(isNull x.Connection) then + let ct = defaultArg cancellationToken CancellationToken.None + match x with + | :? DbTransaction as t-> do! t.RollbackAsync(ct) + | _ -> + ct.ThrowIfCancellationRequested() + x.Rollback() + with ex -> + return raise (DbExecutionException(TxRollback, ex)) + } + + /// Safely attempt to commit an IDbTransaction. + /// Will rollback in the case of Exception. + member x.TryCommit() = + try + if not(isNull x) && not(isNull x.Connection) then x.Commit() + with ex -> + // Is supposed to throw System.InvalidOperationException + // when commmited or rolled back already, but most + // implementations do not. So in all cases try rolling back + x.TryRollback() + raise (DbExecutionException(TxCommit, ex)) + + /// Safely attempt to commit an IDbTransaction. + /// Will rollback in the case of Exception. + member x.TryCommitAsync(?cancellationToken : CancellationToken) = task { + let ct = defaultArg cancellationToken CancellationToken.None + try + if not(isNull x) && not(isNull x.Connection) then + + match x with + | :? DbTransaction as t -> do! t.CommitAsync(ct) + | _ -> + ct.ThrowIfCancellationRequested() + x.Commit() + with ex -> + // Is supposed to throw System.InvalidOperationException + // when commmited or rolled back already, but most + // implementations do not. So in all cases try rolling back + do! x.TryRollbackAsync(ct) + return raise (DbExecutionException(TxCommit, ex)) + } diff --git a/test/Donald.Tests/Script.fsx b/test/Donald.Tests/Script.fsx deleted file mode 100644 index 97a739e..0000000 --- a/test/Donald.Tests/Script.fsx +++ /dev/null @@ -1,46 +0,0 @@ -#r "nuget: System.Data.SQLite" - -open System -open System.Data - -type DbReaderException = - inherit Exception - val FieldName : string option - new() = { inherit Exception(); FieldName = None } - new(message : string) = { inherit Exception(message); FieldName = None } - new(message : string, inner : Exception) = { inherit Exception(message, inner); FieldName = None } - new(fieldName : string, inner : IndexOutOfRangeException) = { inherit Exception($"Failed to read database field: '{fieldName}'", inner); FieldName = Some fieldName } - new(fieldName : string, inner : InvalidCastException) = { inherit Exception($"Failed to read database field: '{fieldName}'", inner); FieldName = Some fieldName } - -type IDataReader with - member private x.GetOrdinalOption (name : string) = - try - let i = x.GetOrdinal(name) - - if i < 0 then raise (IndexOutOfRangeException(name + " is not a valid field name")) - - match x.IsDBNull(i) with - | true -> None - | false -> Some(i) - with - | :? IndexOutOfRangeException as ex -> raise (DbReaderException(name, ex)) - -open System.Data.SQLite - -let conn = new SQLiteConnection("Data Source=:memory:;Version=3;New=true;") -conn.Open () - -let sql = " - WITH author AS ( - SELECT 1 AS author_id, 'pim brouwers' AS full_name - ) - SELECT author_id, full_name - FROM author - WHERE 1 = 2" - -let cmd = conn.CreateCommand () -cmd.CommandText <- sql - -let rd = cmd.ExecuteReader () -[ while rd.Read () do rd.GetOrdinalOption "email" ] -|> printfn "%A" \ No newline at end of file diff --git a/test/Donald.Tests/Tests.fs b/test/Donald.Tests/Tests.fs index 68549ec..88e2bce 100644 --- a/test/Donald.Tests/Tests.fs +++ b/test/Donald.Tests/Tests.fs @@ -77,20 +77,20 @@ type ExecutionTests() = let param = [ "p_null", SqlType.Null - "p_string", SqlType.String "p_string" + "p_string", sqlString "p_string" "p_ansi_string", SqlType.AnsiString "p_ansi_string" - "p_boolean", SqlType.Boolean false - "p_byte", SqlType.Byte Byte.MinValue - "p_char", SqlType.Char 'a' + "p_boolean", sqlBoolean false + "p_byte", sqlByte Byte.MinValue + "p_char", sqlChar 'a' "p_ansi_char", SqlType.AnsiChar Char.MinValue - "p_decimal", SqlType.Decimal 0.0M - "p_double", SqlType.Double 0.0 - "p_float", SqlType.Float 0.0 - "p_guid", SqlType.Guid guidParam - "p_int16", SqlType.Int16 16s - "p_int32", SqlType.Int32 32 - "p_int64", SqlType.Int64 64L - "p_date_time", SqlType.DateTime dateTimeParam + "p_decimal", sqlDecimal 0.0M + "p_double", sqlDouble 0.0 + "p_float", sqlFloat 0.0 + "p_guid", sqlGuid guidParam + "p_int16", sqlInt16 16s + "p_int32", sqlInt32 32 + "p_int64", sqlInt64 64L + "p_date_time", sqlDateTime dateTimeParam ] conn From 127134b8799e7fcefebc9ea0a17809c7e9e1312a Mon Sep 17 00:00:00 2001 From: Pim Brouwers Date: Fri, 3 Feb 2023 09:50:08 -0500 Subject: [PATCH 05/13] type annotations --- src/Donald/Db.fs | 16 ++++++++-------- src/Donald/IDataReader.fs | 9 +++------ 2 files changed, 11 insertions(+), 14 deletions(-) diff --git a/src/Donald/Db.fs b/src/Donald/Db.fs index 176a5de..f5e59ab 100644 --- a/src/Donald/Db.fs +++ b/src/Donald/Db.fs @@ -9,45 +9,45 @@ open System.Threading [] module Db = /// Create a new DbUnit instance using the provided IDbConnection. - let newCommand (commandText : string) (conn : IDbConnection) = + let newCommand (commandText : string) (conn : IDbConnection) : DbUnit = let cmd = conn.CreateCommand() cmd.CommandText <- commandText new DbUnit(cmd) /// Configure the CancellationToken for the provided DbUnit - let setCancellationToken (cancellationToken : CancellationToken) (dbunit : DbUnit) = + let setCancellationToken (cancellationToken : CancellationToken) (dbunit : DbUnit) : DbUnit = dbunit.CancellationToken <- cancellationToken dbunit /// Configure the CommandBehavior for the provided DbUnit - let setCommandBehavior (commandBehavior : CommandBehavior) (dbUnit : DbUnit) = + let setCommandBehavior (commandBehavior : CommandBehavior) (dbUnit : DbUnit) : DbUnit = dbUnit.CommandBehavior <- commandBehavior dbUnit /// Configure the CommandType for the provided DbUnit - let setCommandType (commandType : CommandType) (dbUnit : DbUnit) = + let setCommandType (commandType : CommandType) (dbUnit : DbUnit) : DbUnit = dbUnit.Command.CommandType <- commandType dbUnit /// Configure the command parameters for the provided DbUnit - let setParams (param : RawDbParams) (dbUnit : DbUnit) = + let setParams (param : RawDbParams) (dbUnit : DbUnit) : DbUnit = dbUnit.Command.SetDbParams(DbParams.create param) |> ignore dbUnit /// Configure the timeout for the provided DbUnit - let setTimeout (commandTimeout : int) (dbUnit : DbUnit) = + let setTimeout (commandTimeout : int) (dbUnit : DbUnit) : DbUnit = dbUnit.Command.CommandTimeout <- commandTimeout dbUnit /// Configure the transaction for the provided DbUnit - let setTransaction (tran : IDbTransaction) (dbUnit : DbUnit) = + let setTransaction (tran : IDbTransaction) (dbUnit : DbUnit) : DbUnit = dbUnit.Command.Transaction <- tran dbUnit // // Execution model - let private tryDo (dbUnit : DbUnit) (fn : IDbCommand -> 'a) = + let private tryDo (dbUnit : DbUnit) (fn : IDbCommand -> 'a) : 'a = dbUnit.Command.Connection.TryOpenConnection() let result = fn dbUnit.Command (dbUnit :> IDisposable).Dispose() diff --git a/src/Donald/IDataReader.fs b/src/Donald/IDataReader.fs index 1b7547f..b9ae169 100644 --- a/src/Donald/IDataReader.fs +++ b/src/Donald/IDataReader.fs @@ -20,13 +20,10 @@ module IDataReaderExtensions = member private x.GetOption(map : int -> 'a when 'a : struct) (name : string) = let fn v = - try - map v - with - | :? InvalidCastException as ex -> raise (DbReaderException(name, ex)) + try map v + with | :? InvalidCastException as ex -> raise (DbReaderException(name, ex)) - x.GetOrdinalOption(name) - |> Option.map fn + x.GetOrdinalOption(name) |> Option.map fn /// Safely retrieve String Option member x.ReadStringOption(name : string) = name |> x.GetOrdinalOption |> Option.map(fun i -> x.GetString(i)) From 54c24eb9df18b5fc02203320bb5e06d1f860c40f Mon Sep 17 00:00:00 2001 From: Pim Brouwers Date: Fri, 3 Feb 2023 09:51:56 -0500 Subject: [PATCH 06/13] additional sql helpers --- src/Donald/Core.fs | 80 +++++++++++++++++++++++++--------------------- 1 file changed, 44 insertions(+), 36 deletions(-) diff --git a/src/Donald/Core.fs b/src/Donald/Core.fs index a73475c..11565ce 100644 --- a/src/Donald/Core.fs +++ b/src/Donald/Core.fs @@ -18,42 +18,6 @@ type DbUnit (cmd : IDbCommand) = member x.Dispose () = x.Command.Dispose () -/// Details of failure to connection to a database/server. -type DbConnectionException = - inherit Exception - val ConnectionString : string option - new() = { inherit Exception(); ConnectionString = None } - new(message : string) = { inherit Exception(message); ConnectionString = None } - new(message : string, inner : Exception) = { inherit Exception(message, inner); ConnectionString = None } - new(info : SerializationInfo, context : StreamingContext) = { inherit Exception(info, context); ConnectionString = None } - new(connection : IDbConnection, inner : Exception) = { inherit Exception("Failed to establish database connection", inner); ConnectionString = Some connection.ConnectionString} - -/// Details the steps of database a transaction. -type DbTransactionStep = TxBegin | TxCommit | TxRollback - -/// Details of failure to execute database command or transaction. -type DbExecutionException = - inherit Exception - val Statement : string option - val Step : DbTransactionStep option - new() = { inherit Exception(); Statement = None; Step = None } - new(message : string) = { inherit Exception(message); Statement = None; Step = None } - new(message : string, inner : Exception) = { inherit Exception(message, inner); Statement = None; Step = None } - new(info : SerializationInfo, context : StreamingContext) = { inherit Exception(info, context); Statement = None; Step = None } - new(cmd : IDbCommand, inner : Exception) = { inherit Exception("Failed to process database command", inner); Statement = Some cmd.CommandText; Step = None } - new(step : DbTransactionStep, inner : Exception) = { inherit Exception("Failed to process transaction", inner); Statement = None; Step = Some step } - -/// Details of failure to access and/or cast an IDataRecord field. -type DbReaderException = - inherit Exception - val FieldName : string option - new() = { inherit Exception(); FieldName = None } - new(message : string) = { inherit Exception(message); FieldName = None } - new(message : string, inner : Exception) = { inherit Exception(message, inner); FieldName = None } - new(info : SerializationInfo, context : StreamingContext) = { inherit Exception(info, context); FieldName = None } - new(fieldName : string, inner : IndexOutOfRangeException) = { inherit Exception($"Failed to read database field: '{fieldName}'", inner); FieldName = Some fieldName } - new(fieldName : string, inner : InvalidCastException) = { inherit Exception($"Failed to read database field: '{fieldName}'", inner); FieldName = Some fieldName } - /// Represents the supported data types for database IO. [] type SqlType = @@ -92,6 +56,44 @@ module DbParams = let create (lst : RawDbParams) = [ for k, v in lst -> { Name = k; Value = v } ] +// +// Exceptions + +/// Details of failure to connection to a database/server. +type DbConnectionException = + inherit Exception + val ConnectionString : string option + new() = { inherit Exception(); ConnectionString = None } + new(message : string) = { inherit Exception(message); ConnectionString = None } + new(message : string, inner : Exception) = { inherit Exception(message, inner); ConnectionString = None } + new(info : SerializationInfo, context : StreamingContext) = { inherit Exception(info, context); ConnectionString = None } + new(connection : IDbConnection, inner : Exception) = { inherit Exception("Failed to establish database connection", inner); ConnectionString = Some connection.ConnectionString} + +/// Details the steps of database a transaction. +type DbTransactionStep = TxBegin | TxCommit | TxRollback + +/// Details of failure to execute database command or transaction. +type DbExecutionException = + inherit Exception + val Statement : string option + val Step : DbTransactionStep option + new() = { inherit Exception(); Statement = None; Step = None } + new(message : string) = { inherit Exception(message); Statement = None; Step = None } + new(message : string, inner : Exception) = { inherit Exception(message, inner); Statement = None; Step = None } + new(info : SerializationInfo, context : StreamingContext) = { inherit Exception(info, context); Statement = None; Step = None } + new(cmd : IDbCommand, inner : Exception) = { inherit Exception("Failed to process database command", inner); Statement = Some cmd.CommandText; Step = None } + new(step : DbTransactionStep, inner : Exception) = { inherit Exception("Failed to process transaction", inner); Statement = None; Step = Some step } + +/// Details of failure to access and/or cast an IDataRecord field. +type DbReaderException = + inherit Exception + val FieldName : string option + new() = { inherit Exception(); FieldName = None } + new(message : string) = { inherit Exception(message); FieldName = None } + new(message : string, inner : Exception) = { inherit Exception(message, inner); FieldName = None } + new(info : SerializationInfo, context : StreamingContext) = { inherit Exception(info, context); FieldName = None } + new(fieldName : string, inner : IndexOutOfRangeException) = { inherit Exception($"Failed to read database field: '{fieldName}'", inner); FieldName = Some fieldName } + new(fieldName : string, inner : InvalidCastException) = { inherit Exception($"Failed to read database field: '{fieldName}'", inner); FieldName = Some fieldName } // // Helpers @@ -117,6 +119,12 @@ module SqlType = | Some x -> x |> valueFn | None -> SqlType.Null + let inline sqlAnsiChar input = SqlType.AnsiChar (char input) + let inline sqlAnsiCharOrNull input = sqlType sqlAnsiChar input + + let inline sqlAnsiString input = SqlType.AnsiString (string input) + let inline sqlAnsiStringOrNull input = sqlType sqlAnsiString input + let inline sqlBoolean input = SqlType.Boolean input let inline sqlBooleanOrNull input = sqlType sqlBoolean input From 696188b164fd0b2129d6457e3b86f6e4567d2fda Mon Sep 17 00:00:00 2001 From: Pim Brouwers Date: Fri, 3 Feb 2023 09:58:47 -0500 Subject: [PATCH 07/13] ansi sqltype helpers --- src/Donald/Core.fs | 2 +- src/Donald/Db.fs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Donald/Core.fs b/src/Donald/Core.fs index 11565ce..49a9d79 100644 --- a/src/Donald/Core.fs +++ b/src/Donald/Core.fs @@ -162,4 +162,4 @@ module SqlType = let inline sqlInt64OrNull input = sqlType sqlInt64 input let inline sqlString input = SqlType.String (string input) - let inline sqlStringOrNull input = sqlType sqlString input + let inline sqlStringOrNull input = sqlType sqlString input \ No newline at end of file diff --git a/src/Donald/Db.fs b/src/Donald/Db.fs index f5e59ab..3279db3 100644 --- a/src/Donald/Db.fs +++ b/src/Donald/Db.fs @@ -125,4 +125,4 @@ module Db = /// Asynchronously execute paramterized query, read only first record and apply mapping. let querySingle (map : 'reader -> 'a when 'reader :> IDataReader) (dbUnit : DbUnit) : Task<'a option> = - read (fun rd -> if rd.Read() then Some(map rd) else None) dbUnit \ No newline at end of file + read (fun rd -> if rd.Read() then Some(map rd) else None) dbUnit From 9c2793d37da9c3c7f2625d805a5d7f922d050eb6 Mon Sep 17 00:00:00 2001 From: Pim Brouwers Date: Fri, 3 Feb 2023 10:06:36 -0500 Subject: [PATCH 08/13] readme --- README.md | 2 +- test/Donald.Tests/Tests.fs | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/README.md b/README.md index 3cc235f..2b86b0e 100644 --- a/README.md +++ b/README.md @@ -22,9 +22,9 @@ Donald is a well-tested library that aims to make working with [ADO.NET](https:/ - Support all ADO implementations - Provide a succinct, type-safe API for interacting with databases - Enable asynchronuos workflows -- Provide explicit error flow control - Make object mapping easier - Improve data access performance +- Provide additional context during exceptions ## Getting Started diff --git a/test/Donald.Tests/Tests.fs b/test/Donald.Tests/Tests.fs index 88e2bce..1a30050 100644 --- a/test/Donald.Tests/Tests.fs +++ b/test/Donald.Tests/Tests.fs @@ -217,9 +217,9 @@ type ExecutionTests() = Age = rd.ReadInt32Option "age" |> Option.toNullable |}) |> fun result -> - result.IsSome |> should equal true + result.IsSome |> should equal true result.Value.FullName |> should equal null - result.Value.Age |> should equal null + result.Value.Age |> should equal null [] member _.``SELECT scalar value`` () = @@ -274,7 +274,7 @@ type ExecutionTests() = |> Async.AwaitTask |> Async.RunSynchronously |> fun result -> - result.IsSome |> should equal true + result.IsSome |> should equal true result.Value.AuthorId |> should equal 1 [] @@ -431,7 +431,7 @@ type ExecutionTests() = let str = Text.Encoding.UTF8.GetString(b) b |> should equal bytes str |> should equal testString - | None -> true |> should equal "Invalid bytes returned" + | None -> true |> should equal "Invalid bytes returned" [] member _.``INSERT TRAN author then retrieve to verify`` () = From 6b88b7995325f75a3fb25f4d2eaab186a6d9e19a Mon Sep 17 00:00:00 2001 From: Pim Brouwers Date: Fri, 3 Feb 2023 10:21:49 -0500 Subject: [PATCH 09/13] removed internal specifier for dbunit todetailstring --- src/Donald/Core.fs | 2 +- test/Donald.Tests/Tests.fs | 13 +++++++++++++ 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/src/Donald/Core.fs b/src/Donald/Core.fs index 49a9d79..a0e8dd1 100644 --- a/src/Donald/Core.fs +++ b/src/Donald/Core.fs @@ -98,7 +98,7 @@ type DbReaderException = // // Helpers -module internal DbUnit = +module DbUnit = let toDetailString (dbUnit : DbUnit) = let cmd = dbUnit.Command :?> DbCommand let param = diff --git a/test/Donald.Tests/Tests.fs b/test/Donald.Tests/Tests.fs index 1a30050..14f4f0f 100644 --- a/test/Donald.Tests/Tests.fs +++ b/test/Donald.Tests/Tests.fs @@ -143,6 +143,19 @@ type ExecutionTests() = result.IsSome |> should equal true result.Value |> should equal 1 + [] + member _.``DbUnit.toDetailString`` () = + let sql = " + SELECT author_id, full_name + FROM author + WHERE author_id IN (1,2)" + + conn + |> Db.newCommand sql + |> DbUnit.toDetailString + |> fun str -> + str.Length |> should greaterThan 0 + [] member _.``SELECT records`` () = let sql = " From b6c2d82b27d3b02b4e20c0cb25a58ce22677250b Mon Sep 17 00:00:00 2001 From: Pim Brouwers Date: Sat, 4 Feb 2023 08:53:03 -0500 Subject: [PATCH 10/13] dbcommand todetailstring --- src/Donald/Core.fs | 53 ++++++++++++++++++++++-------------- src/Donald/Db.fs | 23 ++++++++++++++++ src/Donald/IDbCommand.fs | 13 +++++++++ src/Donald/IDbConnection.fs | 12 ++++---- src/Donald/IDbTransaction.fs | 8 +++--- test/Donald.Tests/Tests.fs | 6 ++-- 6 files changed, 81 insertions(+), 34 deletions(-) diff --git a/src/Donald/Core.fs b/src/Donald/Core.fs index a0e8dd1..c46be24 100644 --- a/src/Donald/Core.fs +++ b/src/Donald/Core.fs @@ -6,6 +6,21 @@ open System.Data.Common open System.Runtime.Serialization open System.Threading +[] +module DbCommandExtensions = + type DbCommand with + member internal x.ToDetailString() = + let param = + [ for i in 0 .. x.Parameters.Count - 1 -> + let p = x.Parameters.[i] + let pName = p.ParameterName + let pValue = if isNull p.Value || p.Value = DBNull.Value then "NULL" else string p.Value + String.Concat("@", pName, " = ", pValue) ] + |> fun str -> String.Join(", ", str) + |> fun str -> if (String.IsNullOrWhiteSpace(str)) then "--" else str + + String.Join("\n\n", param, x.CommandText) + /// Represents a configurable database command. type DbUnit (cmd : IDbCommand) = let commandBehavior = CommandBehavior.SequentialAccess @@ -14,6 +29,8 @@ type DbUnit (cmd : IDbCommand) = member val CommandBehavior = CommandBehavior.SequentialAccess with get, set member val CancellationToken = CancellationToken.None with get,set + member x.ToDetailString() = (x.Command :?> DbCommand).ToDetailString() + interface IDisposable with member x.Dispose () = x.Command.Dispose () @@ -72,17 +89,25 @@ type DbConnectionException = /// Details the steps of database a transaction. type DbTransactionStep = TxBegin | TxCommit | TxRollback -/// Details of failure to execute database command or transaction. +/// Details of failure to process a database command. type DbExecutionException = inherit Exception val Statement : string option + new() = { inherit Exception(); Statement = None } + new(message : string) = { inherit Exception(message); Statement = None } + new(message : string, inner : Exception) = { inherit Exception(message, inner); Statement = None } + new(info : SerializationInfo, context : StreamingContext) = { inherit Exception(info, context); Statement = None } + new(cmd : IDbCommand, inner : Exception) = { inherit Exception("Failed to process database command", inner); Statement = Some ((cmd :?> DbCommand).ToDetailString()) } + +/// Details of failure to process a database transaction. +type DbTransactionException = + inherit Exception val Step : DbTransactionStep option - new() = { inherit Exception(); Statement = None; Step = None } - new(message : string) = { inherit Exception(message); Statement = None; Step = None } - new(message : string, inner : Exception) = { inherit Exception(message, inner); Statement = None; Step = None } - new(info : SerializationInfo, context : StreamingContext) = { inherit Exception(info, context); Statement = None; Step = None } - new(cmd : IDbCommand, inner : Exception) = { inherit Exception("Failed to process database command", inner); Statement = Some cmd.CommandText; Step = None } - new(step : DbTransactionStep, inner : Exception) = { inherit Exception("Failed to process transaction", inner); Statement = None; Step = Some step } + new() = { inherit Exception(); Step = None } + new(message : string) = { inherit Exception(message); Step = None } + new(message : string, inner : Exception) = { inherit Exception(message, inner); Step = None } + new(info : SerializationInfo, context : StreamingContext) = { inherit Exception(info, context); Step = None } + new(step : DbTransactionStep, inner : Exception) = { inherit Exception("Failed to process transaction", inner); Step = Some step } /// Details of failure to access and/or cast an IDataRecord field. type DbReaderException = @@ -98,20 +123,6 @@ type DbReaderException = // // Helpers -module DbUnit = - let toDetailString (dbUnit : DbUnit) = - let cmd = dbUnit.Command :?> DbCommand - let param = - [ for i in 0 .. cmd.Parameters.Count - 1 -> - let p = cmd.Parameters.[i] - let pName = p.ParameterName - let pValue = if isNull p.Value || p.Value = DBNull.Value then "NULL" else string p.Value - String.Concat [ "@"; pName; " = "; pValue ] ] - |> String.concat ", " - |> fun str -> if (String.IsNullOrWhiteSpace str) then "--" else str - - String.Concat [ "\n"; "Parameters:\n"; param; "\n\nCommand Text:\n"; cmd.CommandText ] - [] module SqlType = let inline sqlType (valueFn : 'a -> SqlType) (input : 'a option) = diff --git a/src/Donald/Db.fs b/src/Donald/Db.fs index 3279db3..ce163b2 100644 --- a/src/Donald/Db.fs +++ b/src/Donald/Db.fs @@ -44,6 +44,10 @@ module Db = dbUnit.Command.Transaction <- tran dbUnit + /// Create a new DbUnit instance using the provided IDbTransaction. + let newCommandForTransaction (commandText : string) (tran : IDbTransaction) : DbUnit = + tran.Connection |> newCommand commandText |> setTransaction tran + // // Execution model @@ -84,6 +88,15 @@ module Db = let querySingle (map : 'reader -> 'a when 'reader :> IDataReader) (dbUnit : DbUnit) : 'a option = read (fun rd -> if rd.Read() then Some(map rd) else None) dbUnit + /// Execute an all or none batch of commands. + let batch (fn : IDbTransaction -> 'a) (conn : IDbConnection) = + use tran = conn.TryBeginTransaction() + try + fn tran + with _ -> + tran.TryRollback() + reraise () + module Async = let private tryDoAsync (dbUnit : DbUnit) (fn : DbCommand -> Task<'a>) : Task<'a> = task { @@ -126,3 +139,13 @@ module Db = /// Asynchronously execute paramterized query, read only first record and apply mapping. let querySingle (map : 'reader -> 'a when 'reader :> IDataReader) (dbUnit : DbUnit) : Task<'a option> = read (fun rd -> if rd.Read() then Some(map rd) else None) dbUnit + + /// Execute an all or none batch of commands asynchronously. + let batch (fn : IDbTransaction -> Task) (conn : IDbConnection) = + task { + use! tran = conn.TryBeginTransactionAsync() + try + return! fn tran + with _ -> + do! tran.TryRollbackAsync() + } \ No newline at end of file diff --git a/src/Donald/IDbCommand.fs b/src/Donald/IDbCommand.fs index 387abfc..1a9a48c 100644 --- a/src/Donald/IDbCommand.fs +++ b/src/Donald/IDbCommand.fs @@ -8,6 +8,19 @@ open System.Threading [] module IDbCommandExtensions = type IDbCommand with + member internal x.ToDetailString() = + let cmd = x :?> DbCommand + let param = + [ for i in 0 .. cmd.Parameters.Count - 1 -> + let p = cmd.Parameters.[i] + let pName = p.ParameterName + let pValue = if isNull p.Value || p.Value = DBNull.Value then "NULL" else string p.Value + String.Concat("@", pName, " = ", pValue) ] + |> fun str -> String.Join(", ", str) + |> fun str -> if (String.IsNullOrWhiteSpace(str)) then "--" else str + + String.Join("\n\n", param, cmd.CommandText) + member internal x.Exec() = try x.ExecuteNonQuery() |> ignore diff --git a/src/Donald/IDbConnection.fs b/src/Donald/IDbConnection.fs index 50c43dc..7fbb44b 100644 --- a/src/Donald/IDbConnection.fs +++ b/src/Donald/IDbConnection.fs @@ -34,18 +34,20 @@ module IDbConnectionExtensions = /// Safely attempt to create a new IDbTransaction or /// return CouldNotBeginTransactionException. member x.TryBeginTransaction() = + x.TryOpenConnection() + try - x.TryOpenConnection() x.BeginTransaction() with ex -> - raise (DbExecutionException(TxBegin, ex)) + raise (DbTransactionException(TxBegin, ex)) /// Safely attempt to create a new IDbTransaction or /// return CouldNotBeginTransactionException. member x.TryBeginTransactionAsync(?cancellationToken : CancellationToken) = task { + let ct = defaultArg cancellationToken CancellationToken.None + do! x.TryOpenConnectionAsync(ct) + try - let ct = defaultArg cancellationToken CancellationToken.None - do! x.TryOpenConnectionAsync(ct) match x with | :? DbConnection as c -> let! dbTransaction = c.BeginTransactionAsync(ct) @@ -54,5 +56,5 @@ module IDbConnectionExtensions = ct.ThrowIfCancellationRequested() return x.BeginTransaction() with ex -> - return raise (DbExecutionException(TxBegin, ex)) + return raise (DbTransactionException(TxBegin, ex)) } diff --git a/src/Donald/IDbTransaction.fs b/src/Donald/IDbTransaction.fs index 0b2fc77..66d5a1a 100644 --- a/src/Donald/IDbTransaction.fs +++ b/src/Donald/IDbTransaction.fs @@ -12,7 +12,7 @@ module IDbTransactionExtensions = try if not(isNull x) && not(isNull x.Connection) then x.Rollback() with ex -> - raise (DbExecutionException(TxRollback, ex)) + raise (DbTransactionException(TxRollback, ex)) /// Safely attempt to rollback an IDbTransaction. member x.TryRollbackAsync(?cancellationToken : CancellationToken) = task { @@ -25,7 +25,7 @@ module IDbTransactionExtensions = ct.ThrowIfCancellationRequested() x.Rollback() with ex -> - return raise (DbExecutionException(TxRollback, ex)) + return raise (DbTransactionException(TxRollback, ex)) } /// Safely attempt to commit an IDbTransaction. @@ -38,7 +38,7 @@ module IDbTransactionExtensions = // when commmited or rolled back already, but most // implementations do not. So in all cases try rolling back x.TryRollback() - raise (DbExecutionException(TxCommit, ex)) + raise (DbTransactionException(TxCommit, ex)) /// Safely attempt to commit an IDbTransaction. /// Will rollback in the case of Exception. @@ -57,5 +57,5 @@ module IDbTransactionExtensions = // when commmited or rolled back already, but most // implementations do not. So in all cases try rolling back do! x.TryRollbackAsync(ct) - return raise (DbExecutionException(TxCommit, ex)) + return raise (DbTransactionException(TxCommit, ex)) } diff --git a/test/Donald.Tests/Tests.fs b/test/Donald.Tests/Tests.fs index 14f4f0f..90fa622 100644 --- a/test/Donald.Tests/Tests.fs +++ b/test/Donald.Tests/Tests.fs @@ -152,9 +152,8 @@ type ExecutionTests() = conn |> Db.newCommand sql - |> DbUnit.toDetailString - |> fun str -> - str.Length |> should greaterThan 0 + |> fun dbUnit -> + dbUnit.ToDetailString().Length |> should greaterThan 0 [] member _.``SELECT records`` () = @@ -188,7 +187,6 @@ type ExecutionTests() = result[0].FullName |> should equal "Pim Brouwers" result[1].FullName |> should equal "John Doe" - [] member _.``SELECT records should fail`` () = let sql = " From 6b0e6c95e8167c98cb8762346226681e7c6431d1 Mon Sep 17 00:00:00 2001 From: Pim Brouwers Date: Thu, 9 Feb 2023 10:25:53 -0500 Subject: [PATCH 11/13] better exception messages --- src/Donald/Core.fs | 12 ++++++++---- src/Donald/Donald.fsproj | 2 +- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/src/Donald/Core.fs b/src/Donald/Core.fs index c46be24..42f3875 100644 --- a/src/Donald/Core.fs +++ b/src/Donald/Core.fs @@ -21,6 +21,10 @@ module DbCommandExtensions = String.Join("\n\n", param, x.CommandText) + type IDbCommand with + member internal x.ToDetailString() = + (x :?> DbCommand).ToDetailString() + /// Represents a configurable database command. type DbUnit (cmd : IDbCommand) = let commandBehavior = CommandBehavior.SequentialAccess @@ -29,7 +33,7 @@ type DbUnit (cmd : IDbCommand) = member val CommandBehavior = CommandBehavior.SequentialAccess with get, set member val CancellationToken = CancellationToken.None with get,set - member x.ToDetailString() = (x.Command :?> DbCommand).ToDetailString() + member x.ToDetailString() = x.Command.ToDetailString() interface IDisposable with member x.Dispose () = @@ -84,7 +88,7 @@ type DbConnectionException = new(message : string) = { inherit Exception(message); ConnectionString = None } new(message : string, inner : Exception) = { inherit Exception(message, inner); ConnectionString = None } new(info : SerializationInfo, context : StreamingContext) = { inherit Exception(info, context); ConnectionString = None } - new(connection : IDbConnection, inner : Exception) = { inherit Exception("Failed to establish database connection", inner); ConnectionString = Some connection.ConnectionString} + new(connection : IDbConnection, inner : Exception) = { inherit Exception($"Failed to establish database connection: {connection.ConnectionString}", inner); ConnectionString = Some connection.ConnectionString} /// Details the steps of database a transaction. type DbTransactionStep = TxBegin | TxCommit | TxRollback @@ -97,7 +101,7 @@ type DbExecutionException = new(message : string) = { inherit Exception(message); Statement = None } new(message : string, inner : Exception) = { inherit Exception(message, inner); Statement = None } new(info : SerializationInfo, context : StreamingContext) = { inherit Exception(info, context); Statement = None } - new(cmd : IDbCommand, inner : Exception) = { inherit Exception("Failed to process database command", inner); Statement = Some ((cmd :?> DbCommand).ToDetailString()) } + new(cmd : IDbCommand, inner : Exception) = { inherit Exception($"Failed to process database command:\n{cmd.ToDetailString()}", inner); Statement = Some (cmd.ToDetailString()) } /// Details of failure to process a database transaction. type DbTransactionException = @@ -107,7 +111,7 @@ type DbTransactionException = new(message : string) = { inherit Exception(message); Step = None } new(message : string, inner : Exception) = { inherit Exception(message, inner); Step = None } new(info : SerializationInfo, context : StreamingContext) = { inherit Exception(info, context); Step = None } - new(step : DbTransactionStep, inner : Exception) = { inherit Exception("Failed to process transaction", inner); Step = Some step } + new(step : DbTransactionStep, inner : Exception) = { inherit Exception($"Failed to process transaction at step {step}", inner); Step = Some step } /// Details of failure to access and/or cast an IDataRecord field. type DbReaderException = diff --git a/src/Donald/Donald.fsproj b/src/Donald/Donald.fsproj index 9e676f2..ccfd731 100644 --- a/src/Donald/Donald.fsproj +++ b/src/Donald/Donald.fsproj @@ -2,7 +2,7 @@ Donald - 9.0.0 + 10.0.0-alpha2 Functional F# interface for ADO.NET. From 1cf3dbb09c1eb9575e41f354f1251165e543ba67 Mon Sep 17 00:00:00 2001 From: Pim Brouwers Date: Sat, 8 Jul 2023 07:32:28 -0400 Subject: [PATCH 12/13] readme --- README.md | 65 ++++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 50 insertions(+), 15 deletions(-) diff --git a/README.md b/README.md index 2b86b0e..547606d 100644 --- a/README.md +++ b/README.md @@ -13,9 +13,7 @@ This library is named after him. ## Key Features -Donald is a well-tested library that aims to make working with [ADO.NET](https://docs.microsoft.com/en-us/dotnet/framework/data/adonet/ado-net-overview) safer and *a lot more* succinct. It is an entirely generic abstraction, and will work with all ADO.NET implementations. - -> If you came looking for an ORM (object-relational mapper), this is not the library for you. And may the force be with you. +Donald is a generic library that aims to make working with [ADO.NET](https://docs.microsoft.com/en-us/dotnet/framework/data/adonet/ado-net-overview) safer and more succinct. It is an entirely generic abstraction, and will work with all ADO.NET implementations. ## Design Goals @@ -56,7 +54,7 @@ let authors (conn : IDbConnection) : Author list = FROM author WHERE author_id = @author_id" - let param = [ "author_id", SqlType.Int 1 ] + let param = [ "author_id", sqlInt32 1 ] conn |> Db.newCommand sql @@ -107,13 +105,13 @@ let sql = "SELECT author_id, full_name FROM author" conn |> Db.newCommand sql -|> Db.setParams [ "author_id", SqlType.Int 1 ] +|> Db.setParams [ "author_id", sqlInt32 1 ] |> Db.querySingle Author.ofDataReader // Author option // Async conn |> Db.newCommand sql -|> Db.setParams [ "author_id", SqlType.Int 1 ] +|> Db.setParams [ "author_id", sqlInt32 1 ] |> Db.Async.querySingle Author.ofDataReader // Task ``` @@ -123,7 +121,7 @@ conn let sql = "INSERT INTO author (full_name)" // Strongly typed input parameters -let param = [ "full_name", SqlType.String "John Doe" ] +let param = [ "full_name", sqlString "John Doe" ] conn |> Db.newCommand sql @@ -143,8 +141,8 @@ conn let sql = "INSERT INTO author (full_name)" let param = - [ "full_name", SqlType.String "John Doe" - "full_name", SqlType.String "Jane Doe" ] + [ "full_name", sqlString "John Doe" + "full_name", sqlString "Jane Doe" ] conn |> Db.newCommand sql @@ -159,7 +157,7 @@ conn ```fsharp let sql = "INSERT INTO author (full_name)" -let param = [ "full_name", SqlType.String "John Doe" ] +let param = [ "full_name", sqlString "John Doe" ] conn |> Db.newCommand sql @@ -186,7 +184,7 @@ Donald exposes most of it's functionality through the `Db` module. But three `ID use tran = conn.TryBeginTransaction() let insertSql = "INSERT INTO author (full_name)" -let param = [ "full_name", SqlType.String "John Doe" ] +let param = [ "full_name", sqlString "John Doe" ] let insertResult = conn @@ -210,14 +208,49 @@ match insertResult with tran.TryRollback () Error e ``` + +## Command Parameters + +Command parameters are represented by `SqlType` which contains a case for all relevant types. + +```fsharp +type SqlType = + | Null + | String of string + | AnsiString of string + | Boolean of bool + | Byte of byte + | Char of char + | AnsiChar of char + | Decimal of decimal + | Double of double + | Float of float + | Guid of Guid + | Int16 of int16 + | Int32 of int32 + | Int of int32 + | Int64 of int64 + | DateTime of DateTime + | Bytes of byte[] + +let p1 : SqlType = SqlType.Null +let p2 : SqlType = SqlType.Int32 1 +``` + +Helpers also exist which implicitly call the respective F# conversion function. Which are especially useful when you are working with value types in your program. + +```fsharp +let p1 : SqlType = sqlInt32 "1" // equivalent to SqlType.Int32 (int "1") +``` + +> `string` is used here **only** for demonstration purposes. + ## Reading Values To make obtaining values from reader more straight-forward, 2 sets of extension methods are available for: 1. Get value, automatically defaulted 2. Get value as `option<'a>` -> If you need an explicit `Nullable<'a>` you can use `Option.asNullable`. - Assuming we have an active `IDataReader` called `rd` and are currently reading a row, the following extension methods are available to simplify reading values: ```fsharp @@ -250,9 +283,11 @@ rd.ReadInt64Option "some_field" // string -> int64 option rd.ReadBytesOption "some_field" // string -> byte[] option ``` +> If you need an explicit `Nullable<'a>` you can use `Option.asNullable`. + ## Exceptions -Donald exposes several custom exceptions which interleave the exceptions thrown by ADO.NET with contextually relevant metadata. +Several custom exceptions exist which interleave the exceptions thrown by ADO.NET with contextually relevant metadata. ```fsharp /// Details of failure to connection to a database/server. @@ -274,7 +309,7 @@ type DbReaderException = ## Performance -By default, Donald will consume `IDataReader` using `CommandBehavior.SequentialAccess`. This allows the rows and columns to be read in chunks (i.e., streamed), but forward-only. As opposed to being completely read into memory all at once, and readable in any direction. The benefits of this are particular felt when reading large CLOB (string) and BLOB (binary) data. But is also a measureable performance gain for standard query results as well. +By default, the `IDataReader` is consumed using `CommandBehavior.SequentialAccess`. This allows the rows and columns to be read in chunks (i.e., streamed), but forward-only. As opposed to being completely read into memory all at once, and readable in any direction. The benefits of this are particular felt when reading large CLOB (string) and BLOB (binary) data. But is also a measureable performance gain for standard query results as well. The only nuance to sequential access is that **columns must be read in the same order found in the `SELECT` clause**. Aside from that, there is no noticeable difference from the perspective of a library consumer. From 2519123267829c643008de2ba349fc975ef6a6e2 Mon Sep 17 00:00:00 2001 From: Pim Brouwers Date: Sat, 8 Jul 2023 07:38:07 -0400 Subject: [PATCH 13/13] proj file --- src/Donald/Donald.fsproj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Donald/Donald.fsproj b/src/Donald/Donald.fsproj index ccfd731..73bddfe 100644 --- a/src/Donald/Donald.fsproj +++ b/src/Donald/Donald.fsproj @@ -2,7 +2,7 @@ Donald - 10.0.0-alpha2 + 10.0.0 Functional F# interface for ADO.NET.