├── .gitattributes ├── .github └── workflows │ └── build-and-test.yml ├── .gitignore ├── DbFun.Core.Tests ├── DbCallTests.fs ├── DbFun.Core.Tests.fsproj ├── DbSessionTests.fs ├── OutParamsTests.fs ├── ParamsTests.fs ├── Program.fs ├── QueryTests.fs ├── ResultTests.fs └── RowTests.fs ├── DbFun.Core ├── Any.fs ├── AssemblyInfo.fs ├── Connector.fs ├── DbCall.fs ├── DbFun.Core.fsproj ├── DbSession.fs ├── Diagnostics.fs ├── GenericGetters.fs ├── GenericSetters.fs ├── Models.fs ├── Naming.fs ├── OutParams.fs ├── Params.fs ├── Query.fs ├── Results.fs ├── Rows.fs ├── Sqlite.fs ├── Templating.fs └── Types.fs ├── DbFun.CrossDatabase.IntegrationTests ├── App.config ├── Commons.fs ├── DbFun.CrossDatabase.IntegrationTests.fsproj ├── Models.fs ├── Program.fs ├── TestQueries.fs └── Tests.fs ├── DbFun.Firebird.IntegrationTests ├── App.config ├── Commons.fs ├── DbFun.Firebird.IntegrationTests.fsproj ├── Models.fs ├── Program.fs ├── TestQueries.fs ├── Tests.fs └── database │ └── DBFUNTESTS.FDB ├── DbFun.Firebird ├── AssemblyInfo.fs ├── BatchCommand.fs └── DbFun.Firebird.fsproj ├── DbFun.MsSql.IntegrationTests ├── App.config ├── Commons.fs ├── Database │ └── DbFunTests.sql ├── DbFun.MsSql.IntegrationTests.fsproj ├── Models.fs ├── Program.fs ├── TestQueries.fs └── Tests.fs ├── DbFun.MsSql.Tests ├── DbFun.MsSql.Tests.fsproj ├── OutParamsTests.fs ├── ParamsTests.fs ├── Program.fs ├── QueryTests.fs └── TableValuedParamsTests.fs ├── DbFun.MsSql ├── AssemblyInfo.fs ├── DbFun.MsSql.fsproj ├── OutParams.fs ├── Params.fs ├── Query.fs └── TableValuedParams.fs ├── DbFun.MySql.IntegrationTests ├── App.config ├── Commons.fs ├── Database │ └── DbFunTests.sql ├── DbFun.MySql.IntegrationTests.fsproj ├── Models.fs ├── Program.fs ├── TestQueries.fs └── Tests.fs ├── DbFun.MySqlConnector.IntegrationTests ├── App.config ├── Commons.fs ├── Database │ └── DbFunTests.sql ├── DbFun.MySqlConnector.IntegrationTests.fsproj ├── Models.fs ├── Program.fs ├── TestQueries.fs ├── Tests.fs └── jacenty.jpg ├── DbFun.MySqlConnector ├── AssemblyInfo.fs ├── BulkCopy.fs └── DbFun.MySqlConnector.fsproj ├── DbFun.Npgsql.IntegrationTests ├── App.config ├── Commons.fs ├── Database │ └── DbFunTests.sql ├── DbFun.Npgsql.IntegrationTests.fsproj ├── Models.fs ├── Program.fs ├── TestQueries.fs ├── Tests.fs └── jacenty.jpg ├── DbFun.Npgsql ├── AssemblyInfo.fs ├── BulkImport.fs ├── DbFun.Npgsql.fsproj ├── Params.fs ├── PgArrayParams.fs ├── Query.fs └── Rows.fs ├── DbFun.OracleManaged.IntegrationTests ├── App.config ├── Commons.fs ├── DbFun.OracleManaged.IntegrationTests.fsproj ├── Models.fs ├── Program.fs ├── TestQueries.fs └── Tests.fs ├── DbFun.OracleManaged ├── AssemblyInfo.fs ├── BulkCopy.fs ├── DbFun.OracleManaged.fsproj ├── OracleArrayParams.fs ├── Params.fs └── Query.fs ├── DbFun.Sqlite.IntegrationTests ├── App.config ├── Commons.fs ├── DbFun.Sqlite.IntegrationTests.fsproj ├── Models.fs ├── Program.fs ├── TestQueries.fs ├── Tests.fs └── database │ └── DbFunTests.sqlite ├── DbFun.TestTools ├── DbFun.TestTools.fsproj ├── Mocks.fs ├── Models.fs └── Templating.fs ├── DbFun.sln ├── LICENSE.txt ├── README.md └── images └── dbfun.png /.gitattributes: -------------------------------------------------------------------------------- 1 | ############################################################################### 2 | # Set default behavior to automatically normalize line endings. 3 | ############################################################################### 4 | * text=auto 5 | 6 | ############################################################################### 7 | # Set default behavior for command prompt diff. 8 | # 9 | # This is need for earlier builds of msysgit that does not have it on by 10 | # default for csharp files. 11 | # Note: This is only used by command line 12 | ############################################################################### 13 | #*.cs diff=csharp 14 | 15 | ############################################################################### 16 | # Set the merge driver for project and solution files 17 | # 18 | # Merging from the command prompt will add diff markers to the files if there 19 | # are conflicts (Merging from VS is not affected by the settings below, in VS 20 | # the diff markers are never inserted). Diff markers may cause the following 21 | # file extensions to fail to load in VS. An alternative would be to treat 22 | # these files as binary and thus will always conflict and require user 23 | # intervention with every merge. To do so, just uncomment the entries below 24 | ############################################################################### 25 | #*.sln merge=binary 26 | #*.csproj merge=binary 27 | #*.vbproj merge=binary 28 | #*.vcxproj merge=binary 29 | #*.vcproj merge=binary 30 | #*.dbproj merge=binary 31 | #*.fsproj merge=binary 32 | #*.lsproj merge=binary 33 | #*.wixproj merge=binary 34 | #*.modelproj merge=binary 35 | #*.sqlproj merge=binary 36 | #*.wwaproj merge=binary 37 | 38 | ############################################################################### 39 | # behavior for image files 40 | # 41 | # image files are treated as binary by default. 42 | ############################################################################### 43 | #*.jpg binary 44 | #*.png binary 45 | #*.gif binary 46 | 47 | ############################################################################### 48 | # diff behavior for common document formats 49 | # 50 | # Convert binary document formats to text before diffing them. This feature 51 | # is only available from the command line. Turn it on by uncommenting the 52 | # entries below. 53 | ############################################################################### 54 | #*.doc diff=astextplain 55 | #*.DOC diff=astextplain 56 | #*.docx diff=astextplain 57 | #*.DOCX diff=astextplain 58 | #*.dot diff=astextplain 59 | #*.DOT diff=astextplain 60 | #*.pdf diff=astextplain 61 | #*.PDF diff=astextplain 62 | #*.rtf diff=astextplain 63 | #*.RTF diff=astextplain 64 | -------------------------------------------------------------------------------- /.github/workflows/build-and-test.yml: -------------------------------------------------------------------------------- 1 | # This workflow will build a .NET project 2 | # For more information see: https://docs.github.com/en/actions/automating-builds-and-tests/building-and-testing-net 3 | 4 | name: build 5 | 6 | on: 7 | push: 8 | branches: [ "master" ] 9 | pull_request: 10 | branches: [ "master" ] 11 | 12 | jobs: 13 | build: 14 | runs-on: ubuntu-latest 15 | steps: 16 | - uses: actions/checkout@v3 17 | - name: Setup .NET 18 | uses: actions/setup-dotnet@v3 19 | with: 20 | dotnet-version: 6.0.x 21 | - name: Restore dependencies 22 | run: dotnet restore 23 | - name: Build 24 | run: dotnet build --no-restore 25 | - name: Test 26 | run: dotnet test --no-build --verbosity normal --filter FullyQualifiedName!~IntegrationTests 27 | 28 | -------------------------------------------------------------------------------- /DbFun.Core.Tests/DbCallTests.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Core.Tests 2 | 3 | open Xunit 4 | open DbFun.Core 5 | open Moq 6 | open System.Data 7 | open System.Collections.Generic 8 | 9 | module DbCallTests = 10 | 11 | let run (f: DbCall<'T>) = 12 | let connection = Mock() 13 | let connector = new Connector((fun () -> failwith "Cloning is not supported"), ref [ (), connection.Object ], []) 14 | f(connector) 15 | 16 | let runWithMocks (connection: IDbConnection, transaction: IDbTransaction) (f: DbCall<'T>) = 17 | let connector = new Connector((fun () -> failwith "Cloning is not supported"), ref [ (), connection ], [ (), transaction ]) 18 | f(connector) 19 | 20 | let toDbCall x = dbsession { return x } 21 | 22 | 23 | [] 24 | let ``List toDbCall``() = 25 | 26 | let listOfDbCalls = [ toDbCall 1; toDbCall 3; toDbCall 12; toDbCall 4; toDbCall 7 ] 27 | 28 | let result = listOfDbCalls |> List.toDbCall |> run |> Async.RunSynchronously 29 | 30 | Assert.Equal>([ 1; 3; 12; 4; 7 ], result) 31 | 32 | 33 | [] 34 | let ``Array toDbCall``() = 35 | 36 | let arrayOfDbCalls = [| toDbCall 1; toDbCall 3; toDbCall 12; toDbCall 4; toDbCall 7 |] 37 | 38 | let result = arrayOfDbCalls |> Array.toDbCall |> run |> Async.RunSynchronously 39 | 40 | Assert.Equal>([| 1; 3; 12; 4; 7 |], result) 41 | 42 | 43 | [] 44 | let ``Option toDbCall Some``() = 45 | 46 | let optionOfDbCall = Some (toDbCall 1) 47 | 48 | let result = optionOfDbCall |> Option.toDbCall |> run |> Async.RunSynchronously 49 | 50 | Assert.Equal(Some 1, result) 51 | 52 | 53 | [] 54 | let ``Option toDbCall None``() = 55 | 56 | let result = None |> Option.toDbCall |> run |> Async.RunSynchronously 57 | 58 | Assert.Equal(None, result) 59 | 60 | 61 | [] 62 | let ``DbCall InTransaction creates and passes transaction``() = 63 | 64 | let connection = Mock() 65 | let transaction = Mock() 66 | connection.Setup(fun x -> x.BeginTransaction()).Returns(transaction.Object) |> ignore 67 | let txnExists = ref false 68 | 69 | let f (con: IConnector) = async { txnExists.Value <- con.GetTransaction() <> null } 70 | 71 | dbsession { 72 | do! f 73 | } |> DbCall.InTransaction |> runWithMocks(connection.Object, null) |> Async.RunSynchronously 74 | 75 | Assert.True(txnExists.Value) 76 | connection.Verify((fun x -> x.BeginTransaction()), Times.Once) 77 | transaction.Verify((fun x -> x.Commit()), Times.Once) 78 | 79 | 80 | [] 81 | let ``DbCall InTransaction doesn't create transaction if one already exists``() = 82 | 83 | let connection = Mock() 84 | let transaction = Mock() 85 | connection.Setup(fun x -> x.BeginTransaction()).Returns(transaction.Object) |> ignore 86 | let txnExists = ref false 87 | 88 | let f (con: IConnector) = async { txnExists.Value <- con.GetTransaction() <> null } 89 | 90 | dbsession { 91 | do! f 92 | } |> DbCall.InTransaction |> runWithMocks(connection.Object, transaction.Object) |> Async.RunSynchronously 93 | 94 | Assert.True(txnExists.Value) 95 | connection.Verify((fun x -> x.BeginTransaction()), Times.Never) 96 | transaction.Verify((fun x -> x.Commit()), Times.Never) 97 | 98 | 99 | [] 100 | let ``DbCall InTransactionWith creates and passes transaction``() = 101 | 102 | let connection = Mock() 103 | let transaction = Mock() 104 | connection.Setup(fun x -> x.BeginTransaction(IsolationLevel.RepeatableRead)).Returns(transaction.Object) |> ignore 105 | let txnExists = ref false 106 | 107 | let f (con: IConnector) = async { txnExists.Value <- con.GetTransaction() <> null } 108 | 109 | dbsession { 110 | do! f 111 | } |> DbCall.InTransaction IsolationLevel.RepeatableRead |> runWithMocks(connection.Object, null) |> Async.RunSynchronously 112 | 113 | Assert.True(txnExists.Value) 114 | connection.Verify((fun x -> x.BeginTransaction(IsolationLevel.RepeatableRead)), Times.Once) 115 | transaction.Verify((fun x -> x.Commit()), Times.Once) 116 | 117 | 118 | [] 119 | let ``DbCall InTransactionWith doesn't create transaction if one already exists``() = 120 | 121 | let connection = Mock() 122 | let transaction = Mock() 123 | connection.Setup(fun x -> x.BeginTransaction(IsolationLevel.RepeatableRead)).Returns(transaction.Object) |> ignore 124 | let txnExists = ref false 125 | 126 | let f (con: IConnector) = async { txnExists.Value <- con.GetTransaction() <> null } 127 | 128 | dbsession { 129 | do! f 130 | } |> DbCall.InTransaction IsolationLevel.RepeatableRead |> runWithMocks(connection.Object, transaction.Object) |> Async.RunSynchronously 131 | 132 | Assert.True(txnExists.Value) 133 | connection.Verify((fun x -> x.BeginTransaction()), Times.Never) 134 | transaction.Verify((fun x -> x.Commit()), Times.Never) 135 | 136 | 137 | [] 138 | let ``DbCall InTransaction in case of any exception transaction is not committed``() = 139 | 140 | let connection = Mock() 141 | let transaction = Mock() 142 | connection.Setup(fun x -> x.BeginTransaction()).Returns(transaction.Object) |> ignore 143 | 144 | let f (con: IConnector) = async { failwith "DbCall processing exception" } 145 | 146 | try 147 | dbsession { 148 | do! f 149 | } |> DbCall.InTransaction |> runWithMocks(connection.Object, null) |> Async.RunSynchronously 150 | with _ -> 151 | // Ignored intentionally 152 | 153 | transaction.Verify((fun x -> x.Commit()), Times.Never) 154 | 155 | 156 | [] 157 | let ``DbCall Catch returns exception``() = 158 | 159 | let f (con: IConnector) = async { failwith "DbCall processing exception" } 160 | 161 | let result = 162 | dbsession { 163 | do! f 164 | } |> DbCall.Catch |> run |> Async.RunSynchronously 165 | 166 | match result with 167 | | Choice1Of2 () -> Assert.True(false) 168 | | Choice2Of2 ex -> Assert.Equal("DbCall processing exception", ex.Message) 169 | 170 | 171 | [] 172 | let ``DbCall Catch returns result if no exception occured``() = 173 | 174 | let f (con: IConnector) = async { return 1 } 175 | 176 | let result = 177 | dbsession { 178 | return! f 179 | } |> DbCall.Catch |> run |> Async.RunSynchronously 180 | 181 | match result with 182 | | Choice1Of2 value -> Assert.Equal(1, value) 183 | | Choice2Of2 _ -> Assert.True(false) -------------------------------------------------------------------------------- /DbFun.Core.Tests/DbFun.Core.Tests.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | net6.0 5 | 6 | false 7 | false 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | runtime; build; native; contentfiles; analyzers; buildtransitive 29 | all 30 | 31 | 32 | runtime; build; native; contentfiles; analyzers; buildtransitive 33 | all 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | -------------------------------------------------------------------------------- /DbFun.Core.Tests/DbSessionTests.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Core.Tests 2 | 3 | open Xunit 4 | open DbFun.Core 5 | open Moq 6 | open System.Data 7 | open System 8 | open System.Collections.Generic 9 | 10 | module DbSessionTests = 11 | 12 | let run (f: DbCall<'T>) = 13 | let connection = Mock() 14 | let connector = new Connector((fun () -> failwith "Cloning is not supported"), ref [ (), connection.Object ], []) 15 | f(connector) 16 | 17 | [] 18 | let ``DbSessionBuilder Zero``() = 19 | 20 | let testVal = 0 21 | 22 | let f (_: IConnector) = async { return () } 23 | 24 | dbsession { 25 | if testVal > 0 then 26 | do! f 27 | } |> run |> Async.RunSynchronously 28 | 29 | 30 | [] 31 | let ``DbSessionBuilder ReturnFrom``() = 32 | 33 | let f (_: IConnector) = async { return 1 } 34 | 35 | let result = dbsession { return! f } |> run |> Async.RunSynchronously 36 | 37 | Assert.Equal(1, result) 38 | 39 | 40 | [] 41 | let ``DbSessionBuilder Combine and Delay``() = 42 | 43 | let calls = ref 0 44 | let f1 (_: IConnector) = async { calls.Value <- calls.Value + 1 } 45 | let f2 (_: IConnector) = async {calls.Value <- calls.Value + 1 } 46 | 47 | let result = 48 | dbsession { 49 | if calls.Value > 0 then 50 | do! f1 51 | return 0 52 | else 53 | do! f2 54 | return 1 55 | } |> run |> Async.RunSynchronously 56 | 57 | Assert.Equal(1, calls.Value) 58 | Assert.Equal(1, result) 59 | 60 | [] 61 | let ``DbSessionBuilder For``() = 62 | 63 | let calls = ref 0 64 | let f (_: IConnector) = async { calls.Value <- calls.Value + 1 } 65 | 66 | dbsession { 67 | for i in 1..5 do 68 | do! f 69 | } |> run |> Async.RunSynchronously 70 | 71 | Assert.Equal(5, calls.Value) 72 | 73 | 74 | [] 75 | let ``DbSessionBuilder Using``() = 76 | 77 | let calls = ref 0 78 | let fcall = ref 0 79 | let dispcall = ref 0 80 | let f (_: IConnector) = async { 81 | calls.Value <- calls.Value + 1 82 | fcall.Value <- calls.Value 83 | } 84 | let makeDisposable() = 85 | { new IDisposable with 86 | member __.Dispose() = 87 | calls.Value <- calls.Value + 1 88 | dispcall.Value <- calls.Value 89 | } 90 | 91 | dbsession { 92 | use disp = makeDisposable() 93 | do! f 94 | } |> run |> Async.RunSynchronously 95 | 96 | Assert.Equal(2, calls.Value) 97 | Assert.Equal(1, fcall.Value) 98 | Assert.Equal(2, dispcall.Value) -------------------------------------------------------------------------------- /DbFun.Core.Tests/OutParamsTests.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Core.Tests 2 | 3 | open System 4 | open Xunit 5 | open Microsoft.Data.SqlClient 6 | open DbFun.Core.Builders 7 | open DbFun.TestTools.Models 8 | open System.Data 9 | 10 | module OutParamsTests = 11 | 12 | let connection = new SqlConnection() 13 | let provider = GenericGetters.BaseGetterProvider(OutParamsImpl.getDefaultBuilders()) 14 | let builderParams = provider :> IOutParamGetterProvider, () 15 | 16 | [] 17 | let ``Simple types``() = 18 | 19 | let command = connection.CreateCommand() 20 | let getter = OutParams.Auto("id") builderParams 21 | 22 | getter.Create(command) 23 | command.Parameters.["id"].Value <- 5 24 | let value = getter.Get(command) 25 | 26 | Assert.Equal(5, value) 27 | 28 | 29 | [] 30 | let ``Char enum types``() = 31 | 32 | let command = connection.CreateCommand() 33 | let getter = OutParams.Auto("status") builderParams 34 | 35 | getter.Create(command) 36 | command.Parameters.["status"].Value <- 'A' 37 | let value = getter.Get(command) 38 | 39 | Assert.Equal(Status.Active, value) 40 | 41 | 42 | [] 43 | let ``Int enum types``() = 44 | 45 | let command = connection.CreateCommand() 46 | let getter = OutParams.Auto("role") builderParams 47 | 48 | getter.Create(command) 49 | command.Parameters.["role"].Value <- 1 50 | let value = getter.Get(command) 51 | 52 | Assert.Equal(Role.Guest, value) 53 | 54 | 55 | [] 56 | let ``Discriminated union types - simple``() = 57 | 58 | let command = connection.CreateCommand() 59 | let getter = OutParams.Union("access") builderParams 60 | 61 | getter.Create(command) 62 | command.Parameters.["access"].Value <- "RW" 63 | let value = getter.Get(command) 64 | 65 | Assert.Equal(Access.ReadWrite, value) 66 | 67 | 68 | [] 69 | let ``Simple type options - Some``() = 70 | 71 | let command = connection.CreateCommand() 72 | let getter = OutParams.Optional("id") builderParams 73 | 74 | getter.Create(command) 75 | command.Parameters.["id"].Value <- 1 76 | let value = getter.Get(command) 77 | 78 | Assert.Equal(Some 1, value) 79 | 80 | 81 | [] 82 | let ``Simple type options - None``() = 83 | 84 | let command = connection.CreateCommand() 85 | let getter = OutParams.Optional("id") builderParams 86 | 87 | getter.Create(command) 88 | command.Parameters.["id"].Value <- DBNull.Value 89 | let value = getter.Get(command) 90 | 91 | Assert.Equal(None, value) 92 | 93 | 94 | [] 95 | let ``Simple type tuples``() = 96 | 97 | let command = connection.CreateCommand() 98 | let getter = OutParams.Tuple("id", "name") builderParams 99 | 100 | getter.Create(command) 101 | command.Parameters.["id"].Value <- 2 102 | command.Parameters.["name"].Value <- "jacentino" 103 | let value = getter.Get(command) 104 | 105 | Assert.Equal((2, "jacentino"), value) 106 | 107 | 108 | [] 109 | let ``Flat records``() = 110 | 111 | let command = connection.CreateCommand() 112 | let getter = OutParams.Record() builderParams 113 | 114 | getter.Create(command) 115 | command.Parameters.["userId"].Value <- 2 116 | command.Parameters.["name"].Value <- "jacentino" 117 | command.Parameters.["email"].Value <- "jacentino@gmail.com" 118 | command.Parameters.["created"].Value <- DateTime.Today 119 | let value = getter.Get(command) 120 | 121 | let expected = 122 | { 123 | userId = 2 124 | name = "jacentino" 125 | email = "jacentino@gmail.com" 126 | created = DateTime.Today 127 | } 128 | Assert.Equal(expected, value) 129 | 130 | 131 | [] 132 | let ``Flat records - prefixed names``() = 133 | 134 | let command = connection.CreateCommand() 135 | let getter = OutParams.Record("user_", RecordNaming.Prefix) builderParams 136 | 137 | getter.Create(command) 138 | command.Parameters.["user_userId"].Value <- 2 139 | command.Parameters.["user_name"].Value <- "jacentino" 140 | command.Parameters.["user_email"].Value <- "jacentino@gmail.com" 141 | command.Parameters.["user_created"].Value <- DateTime.Today 142 | let value = getter.Get(command) 143 | 144 | let expected = 145 | { 146 | userId = 2 147 | name = "jacentino" 148 | email = "jacentino@gmail.com" 149 | created = DateTime.Today 150 | } 151 | Assert.Equal(expected, value) 152 | 153 | 154 | [] 155 | let ``Flat records - overrides``() = 156 | 157 | let command = connection.CreateCommand() 158 | let u = any 159 | let getter = OutParams.Record(overrides = [OutParamOverride(u.userId, OutParams.Auto("id"))]) builderParams 160 | 161 | getter.Create(command) 162 | command.Parameters.["id"].Value <- 2 163 | command.Parameters.["name"].Value <- "jacentino" 164 | command.Parameters.["email"].Value <- "jacentino@gmail.com" 165 | command.Parameters.["created"].Value <- DateTime.Today 166 | let value = getter.Get(command) 167 | 168 | let expected = 169 | { 170 | userId = 2 171 | name = "jacentino" 172 | email = "jacentino@gmail.com" 173 | created = DateTime.Today 174 | } 175 | Assert.Equal(expected, value) -------------------------------------------------------------------------------- /DbFun.Core.Tests/Program.fs: -------------------------------------------------------------------------------- 1 | module Program = let [] main _ = 0 2 | -------------------------------------------------------------------------------- /DbFun.Core/Any.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Core.Builders 2 | 3 | [] 4 | module Any = 5 | 6 | /// 7 | /// Function creating prototype objects used to specify property chains in joins and overrides. 8 | /// 9 | let any<'T> = Unchecked.defaultof<'T> 10 | -------------------------------------------------------------------------------- /DbFun.Core/AssemblyInfo.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Core.AssemblyInfo 2 | 3 | open System.Reflection 4 | open System.Runtime.InteropServices 5 | 6 | // General Information about an assembly is controlled through the following 7 | // set of attributes. Change these attribute values to modify the information 8 | // associated with an assembly. 9 | [] 10 | [] 11 | [] 12 | [] 13 | [] 14 | [] 15 | [] 16 | [] 17 | 18 | // Setting ComVisible to false makes the types in this assembly not visible 19 | // to COM components. If you need to access a type in this assembly from 20 | // COM, set the ComVisible attribute to true on that type. 21 | [] 22 | 23 | // The following GUID is for the ID of the typelib if this project is exposed to COM 24 | [] 25 | 26 | // Version information for an assembly consists of the following four values: 27 | // 28 | // Major Version 29 | // Minor Version 30 | // Build Number 31 | // Revision 32 | // 33 | // You can specify all the values or you can default the Build and Revision Numbers 34 | // by using the '*' as shown below: 35 | // [] 36 | [] 37 | [] 38 | 39 | do 40 | () -------------------------------------------------------------------------------- /DbFun.Core/Connector.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Core 2 | 3 | open System.Data 4 | open System 5 | 6 | /// 7 | /// Provides access to current database connection and transaction. 8 | /// 9 | type IConnector<'Key> = 10 | inherit IDisposable 11 | 12 | /// 13 | /// The database connection. 14 | /// 15 | abstract member GetConnection: 'Key -> IDbConnection 16 | 17 | /// 18 | /// The current transaction (null if there is no active transaction). 19 | /// 20 | abstract member GetTransaction: 'Key -> IDbTransaction 21 | 22 | /// 23 | /// Creates new connector instance with the specified transaction. 24 | /// 25 | abstract member With: 'Key * IDbTransaction -> IConnector<'Key> 26 | 27 | abstract member Clone: unit -> IConnector<'Key> 28 | 29 | /// 30 | /// The minimal IConnector implementation. 31 | /// 32 | type Connector<'Key when 'Key: comparison>( 33 | createConnection: 'Key -> IDbConnection, 34 | connections: ref>, 35 | transactions: list<'Key * IDbTransaction>) = 36 | 37 | new (createConnection: 'Key -> IDbConnection) = 38 | new Connector<'Key>(createConnection, ref [], []) 39 | 40 | interface IConnector<'Key> with 41 | member __.GetConnection(key: 'Key) = 42 | match connections.Value |> List.tryFind (fst >> (=) key) with 43 | | Some (_, connection) -> connection 44 | | None -> 45 | let connection = createConnection key 46 | connections.Value <- (key, connection) :: connections.Value 47 | connection.Open() 48 | connection 49 | 50 | member __.GetTransaction(key: 'Key) = transactions |> List.tryFind (fst >> (=) key) |> Option.map snd |> Option.defaultValue null 51 | member __.With(key: 'Key, transaction: IDbTransaction) = new Connector<'Key>(createConnection, connections, (key, transaction) :: transactions) 52 | member __.Clone() = new Connector<'Key>(createConnection) 53 | 54 | interface IDisposable with 55 | member __.Dispose(): unit = 56 | for _, con in connections.Value do 57 | con.Dispose() 58 | 59 | type IConnector = IConnector 60 | 61 | type Connector = Connector -------------------------------------------------------------------------------- /DbFun.Core/DbCall.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Core 2 | 3 | open System.Data 4 | 5 | /// 6 | /// Represents asynchronous database computation, that needs an open connection (provided by IConnector object) to be performed. 7 | /// 8 | /// 9 | /// DbCall can be considered as a combination of Async and Reader monads and is used such a way by dbsession computation expressions. 10 | /// 11 | type DbCall<'DbKey, 'Result> = IConnector<'DbKey> -> Async<'Result> 12 | 13 | type DbCall<'Result> = DbCall 14 | 15 | type DbCall() = 16 | 17 | static let wrapInTransaction (dbKey: 'DbKey, isolationLevel: IsolationLevel option) (f: IConnector<'DbKey> -> Async<'T>) (con: IConnector<'DbKey>) = 18 | async { 19 | if con.GetTransaction(dbKey) = null then 20 | use transaction = 21 | isolationLevel 22 | |> Option.map (con.GetConnection(dbKey).BeginTransaction) 23 | |> Option.defaultWith (con.GetConnection(dbKey).BeginTransaction) 24 | let! value = f(con.With(dbKey, transaction)) 25 | transaction.Commit() 26 | return value 27 | else 28 | return! f(con) 29 | } 30 | 31 | /// 32 | /// Transforms DbCall to another DbCall. 33 | /// 34 | /// 35 | /// Function performing transformation. 36 | /// 37 | /// 38 | /// The source dbCall value. 39 | /// 40 | static member Map (f: 'T -> 'U) (dbCall: DbCall<'DbKey, 'T>): DbCall<'DbKey, 'U> = 41 | fun (con : IConnector<'DbKey>) -> 42 | async { 43 | let! value = dbCall(con) 44 | return f(value) 45 | } 46 | 47 | /// 48 | /// Catches exception that occured inside dbsession workflow and returns Choice object containing either 49 | /// regular result or exception. 50 | /// 51 | /// 52 | /// The source dbCall value. 53 | /// 54 | static member Catch (dbCall: DbCall<'DbKey, 'T>): DbCall<'DbKey, Choice<'T, exn>> = 55 | fun (con: IConnector<'DbKey>) -> 56 | async { 57 | return! dbCall(con) 58 | } |> Async.Catch 59 | 60 | /// 61 | /// Lifts value wrapped in Async to DbCall. 62 | /// 63 | /// 64 | /// The async value. 65 | /// 66 | static member FromAsync<'T> (a: Async<'T>) (_: IConnector) = a 67 | 68 | /// 69 | /// Wraps database computation in a transaction. 70 | /// 71 | /// 72 | /// The source dbCall value. 73 | /// 74 | static member InTransaction (dbCall: DbCall): DbCall = 75 | wrapInTransaction ((), None) dbCall 76 | 77 | /// 78 | /// Wraps database computation in a transaction of a certain isolation level. 79 | /// 80 | /// 81 | /// The transaction isolation level. 82 | /// 83 | static member InTransaction (isolationLevel: IsolationLevel): DbCall -> DbCall = 84 | wrapInTransaction ((), Some isolationLevel) 85 | 86 | /// 87 | /// Wraps database computation in a transaction of a certain isolation level. 88 | /// 89 | /// 90 | /// Value determining a database. 91 | /// 92 | /// 93 | /// The transaction isolation level. 94 | /// 95 | static member InTransaction (dbKey: 'DbKey, ?isolationLevel: IsolationLevel): DbCall<'DbKey, 'T> -> DbCall<'DbKey, 'T> = 96 | wrapInTransaction (dbKey, isolationLevel) 97 | 98 | /// 99 | /// Creates a connection and executes a database computations on it. Disposes the connection when done. 100 | /// 101 | /// 102 | /// Creates a connection. 103 | /// 104 | /// 105 | /// Database computations to be executed. 106 | /// 107 | static member Run (createConnection: 'DbKey-> IDbConnection, dbCall: DbCall<'DbKey, 'Result>): Async<'Result> = 108 | async { 109 | use connector = new Connector<'DbKey>(createConnection) 110 | return! dbCall(connector) 111 | } 112 | 113 | /// 114 | /// Executes many database computations in parallel. 115 | /// 116 | /// 117 | /// Database computations to be executed in parallel. 118 | /// 119 | /// 120 | /// The database connector. 121 | /// 122 | static member Parallel (dbCalls: DbCall<'DbKey, 'Result> seq) (connector: IConnector<'DbKey>): Async<'Result array> = 123 | Async.Parallel 124 | [ for call in dbCalls do 125 | async { 126 | use clone = connector.Clone() 127 | return! call(clone) 128 | } 129 | ] 130 | 131 | 132 | module List = 133 | 134 | /// 135 | /// Transforms list of DbCall values to DbCall of list. 136 | /// 137 | /// 138 | /// The list of DbCall values. 139 | /// 140 | /// 141 | /// The connector. 142 | /// 143 | let toDbCall (items: DbCall<'DbKey, 't> list) (con: IConnector<'DbKey>): 't list Async = async { 144 | let mutable result = [] 145 | for dbCall in items do 146 | let! item = dbCall con 147 | result <- item :: result 148 | return result |> List.rev 149 | } 150 | 151 | module Array = 152 | 153 | /// 154 | /// Transforms array of DbCall values to DbCall of array. 155 | /// 156 | /// 157 | /// The array of DbCall values. 158 | /// 159 | /// 160 | /// The connector. 161 | /// 162 | let toDbCall (items: DbCall<'DbKey, 't> array) (con: IConnector<'DbKey>): 't array Async = async { 163 | let result = Array.zeroCreate items.Length 164 | for i in 0..items.Length - 1 do 165 | let! item = (items[i]) con 166 | result.[i] <- item 167 | return result 168 | } 169 | 170 | module Option = 171 | 172 | /// 173 | /// Transforms option of DbCall value to DbCall of option. 174 | /// 175 | /// 176 | /// The option of DbCall value. 177 | /// 178 | /// 179 | /// The connector. 180 | /// 181 | let toDbCall (value: DbCall<'DbKey, 't> option) (con: IConnector<'DbKey>): 't option Async = async { 182 | match value with 183 | | Some dbCall -> 184 | let! value = dbCall con 185 | return Some value 186 | | None -> 187 | return None 188 | } 189 | 190 | 191 | -------------------------------------------------------------------------------- /DbFun.Core/DbFun.Core.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | net6.0 5 | true 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | -------------------------------------------------------------------------------- /DbFun.Core/DbSession.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Core 2 | 3 | open System 4 | open FSharp.Control 5 | 6 | module ComputationBuilderImpl = 7 | 8 | /// 9 | /// The computation builder for database computations. 10 | /// 11 | type DbSessionBuilder() = 12 | member __.Source(value: seq<'t>): seq<'t> = value 13 | member __.Source(value: AsyncSeq<'t>): AsyncSeq<'t> = value 14 | member __.Source(value: DbCall<'k, 't>): DbCall<'k, 't> = value 15 | member __.Source(value: Async<'t>): DbCall<'k, 't> = fun _ -> value 16 | member __.Return(value: 't): DbCall<'k, 't> = fun _ -> async { return value } 17 | member __.ReturnFrom(value: DbCall<'k, 't>): DbCall<'k, 't> = value 18 | member __.Bind(rd: DbCall<'k, 't1>, f: 't1 -> DbCall<'k, 't2>): DbCall<'k, 't2> = 19 | fun env -> async { 20 | let! value = rd env 21 | return! (f value) env 22 | } 23 | member __.Zero(_) = fun _ -> async { return () } 24 | member this.Combine(value: DbCall<'k, 't1>, y: DbCall<'k, 't2>): DbCall<'k, 't2> = this.Bind(value, fun value' -> y) 25 | member __.Delay(f: unit-> 'Env -> 't Async) = fun env -> async { return! f () env } 26 | member __.For (items: seq<'t>, f: 't -> DbCall<'k, unit>): DbCall<'k, unit> = 27 | fun env -> async { 28 | for item in items do 29 | do! f item env 30 | } 31 | member __.For (items: AsyncSeq<'t>, f: 't -> DbCall<'k, unit>): DbCall<'k, unit> = 32 | fun env -> async { 33 | for item in items do 34 | do! f item env 35 | } 36 | member __.Using(value: 't, f: 't -> DbCall<'k, 'u> when 't :> IDisposable) = 37 | fun env -> async { 38 | try 39 | return! f value env 40 | finally 41 | value.Dispose() 42 | } 43 | 44 | [] 45 | module ComputationBuilder = 46 | 47 | /// 48 | /// Builds database workflow using computation expressions syntax. 49 | /// 50 | let dbsession = ComputationBuilderImpl.DbSessionBuilder() 51 | 52 | 53 | -------------------------------------------------------------------------------- /DbFun.Core/Diagnostics.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Core 2 | 3 | open System 4 | 5 | module Diagnostics = 6 | 7 | /// 8 | /// The exception occurring in the code generation phase. 9 | /// 10 | type CompileTimeException(message: string, innerException: Exception) = 11 | inherit Exception(message, innerException) 12 | 13 | /// 14 | /// The compile time error log entry. 15 | /// 16 | type CompileTimeErrorLog = list 17 | 18 | 19 | /// 20 | /// The exception occurring in the command execution phase. 21 | /// 22 | type RuntimeException(message: string, innerException: Exception) = 23 | inherit Exception(message, innerException) 24 | -------------------------------------------------------------------------------- /DbFun.Core/Models.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Core.Models 2 | 3 | open System 4 | 5 | /// 6 | /// An attribute allowing to specify string values, representing database values of enum literals. 7 | /// 8 | [] 9 | type UnionCaseTagAttribute(value: string) = 10 | inherit Attribute() 11 | member __.Value = value 12 | 13 | 14 | -------------------------------------------------------------------------------- /DbFun.Core/Naming.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Core.Builders 2 | 3 | open System 4 | 5 | /// 6 | /// Record naming conventions. 7 | /// 8 | type RecordNaming = 9 | | Fields 10 | | Prefix 11 | | Path 12 | 13 | /// 14 | /// Discriminated union naming conventions. 15 | /// 16 | [] 17 | type UnionNaming = 18 | | Fields = 0 19 | | Prefix = 1 20 | | Path = 2 21 | | CaseNames = 4 22 | -------------------------------------------------------------------------------- /DbFun.Core/OutParams.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Core.Builders 2 | 3 | open System 4 | open System.Data 5 | open DbFun.Core 6 | 7 | type IOutParamGetter<'Result> = GenericGetters.IGetter 8 | 9 | type IOutParamGetterProvider = GenericGetters.IGetterProvider 10 | 11 | type OutParamSpecifier<'Result> = IOutParamGetterProvider * unit -> IOutParamGetter<'Result> 12 | 13 | module OutParamsImpl = 14 | 15 | type IBuilder = GenericGetters.IBuilder 16 | 17 | 18 | type SimpleOutParamBuilder() = 19 | 20 | let dbTypes = 21 | [ 22 | typeof, DbType.Boolean 23 | typeof, DbType.Binary 24 | typeof, DbType.Byte 25 | typeof, DbType.DateTime 26 | typeof, DbType.Decimal 27 | typeof, DbType.Double 28 | typeof, DbType.Guid 29 | typeof, DbType.Int16 30 | typeof, DbType.Int32 31 | typeof, DbType.Int64 32 | typeof, DbType.String 33 | ] 34 | 35 | interface IBuilder with 36 | 37 | member __.CanBuild(argType: Type): bool = Types.isSimpleType argType 38 | 39 | member __.Build(name: string, _, ()): IOutParamGetter<'Result> = 40 | { new IOutParamGetter<'Result> with 41 | member __.Create (command: IDbCommand) = 42 | let param = command.CreateParameter() 43 | param.ParameterName <- name 44 | param.DbType <- dbTypes |> List.tryFind (fst >> (=) typeof<'Result>) |> Option.map snd |> Option.defaultValue DbType.Object 45 | param.Direction <- ParameterDirection.Output 46 | command.Parameters.Add param |> ignore 47 | member __.Get(command: IDbCommand): 'Result = 48 | let ordinal = command.Parameters.IndexOf(name) 49 | if ordinal = -1 then 50 | failwithf "Output parameter doesn't exist: %s" name 51 | let param = command.Parameters.[ordinal] :?> IDataParameter 52 | Convert.ChangeType(param.Value, typeof<'Result>) :?> 'Result 53 | member __.IsNull(command: IDbCommand): bool = 54 | let ordinal = command.Parameters.IndexOf(name) 55 | if ordinal = -1 then 56 | failwithf "Output parameter doesn't exist: %s" name 57 | let param = command.Parameters.[ordinal] :?> IDataParameter 58 | param.Value = DBNull.Value 59 | } 60 | 61 | 62 | type BaseGetterProvider = GenericGetters.BaseGetterProvider 63 | 64 | type InitialDerivedGetterProvider<'Config> = GenericGetters.InitialDerivedGetterProvider 65 | 66 | type DerivedGetterProvider<'Config> = GenericGetters.DerivedGetterProvider 67 | 68 | type UnitBuilder = GenericGetters.UnitBuilder 69 | 70 | type SequenceBuilder = GenericGetters.SequenceBuilder 71 | 72 | type OptionBuilder = GenericGetters.OptionBuilder 73 | 74 | type Converter<'Source, 'Target> = GenericGetters.Converter 75 | 76 | type EnumConverter<'Underlying> = GenericGetters.EnumConverter 77 | 78 | type UnionBuilder = GenericGetters.UnionBuilder 79 | 80 | type RecordBuilder = GenericGetters.RecordBuilder 81 | 82 | type TupleBuilder = GenericGetters.TupleBuilder 83 | 84 | type Configurator<'Config> = GenericGetters.Configurator 85 | 86 | 87 | let getDefaultBuilders(): IBuilder list = SimpleOutParamBuilder() :: GenericGetters.getDefaultBuilders() 88 | 89 | /// 90 | /// Provides methods creating various query output parameter builders of stored procedures. 91 | /// 92 | type OutParams() = 93 | inherit GenericGetters.GenericGetterBuilder() 94 | 95 | /// 96 | /// The field-to-parameter mapping override. 97 | /// 98 | type OutParamOverride<'Arg> = GenericGetters.Override 99 | -------------------------------------------------------------------------------- /DbFun.Core/Sqlite.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Core 2 | 3 | open System 4 | open DbFun.Core.Builders 5 | 6 | module Sqlite = 7 | 8 | type QueryConfig<'DbKey> with 9 | /// 10 | /// Adds converters between DateTime and String. 11 | /// 12 | member this.SqliteDateTimeAsString() = 13 | this.AddParamConverter(fun (v: DateTime) -> v.ToString("yyyy-MM-dd HH:mm:ss.ffffff")) 14 | .AddRowConverter(fun str -> DateTime.ParseExact(str, "yyyy-MM-dd HH:mm:ss.ffffff", null)) 15 | /// 16 | /// Adds converters between DateTime and Int. 17 | /// 18 | member this.SqliteDateTimeAsInt() = 19 | this.AddParamConverter(fun (v: DateTime) -> v.Subtract(DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc)).TotalSeconds |> int64) 20 | .AddRowConverter(fun (ts: int64) -> DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc).AddSeconds(float ts)) 21 | -------------------------------------------------------------------------------- /DbFun.Core/Templating.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Core 2 | 3 | module Templating = 4 | 5 | /// 6 | /// Expands some template placeholder with a value. 7 | /// 8 | /// 9 | /// If the expansion occurs for the first time, the clause is added before a value. 10 | /// Otherwise a value is followed by a separator. 11 | /// 12 | /// 13 | /// The placeholder to be replaced with a value. 14 | /// 15 | /// 16 | /// The clause (e.g. WHERE, ORDER BY, HAVING) to be added when the value is placed for the first time. 17 | /// 18 | /// 19 | /// The separator injected between subsequent occurrances of a value. 20 | /// 21 | /// 22 | /// The template to be expanded. 23 | /// 24 | /// 25 | /// The value to replace a placeholder. 26 | /// 27 | /// 28 | /// The template parameters. 29 | /// 30 | let expand (placeholder: string) (clause: string) (separator: string) (value: string) (template: string, parameters: 'Params) : string * 'Params = 31 | let expanded = 32 | if template.Contains("{{" + placeholder + "}}") 33 | then template.Replace("{{" + placeholder + "}}", clause + "{{" + placeholder + "!}}" + value) 34 | else template.Replace("{{" + placeholder + "!}}", "{{" + placeholder + "!}}" + value + separator) 35 | expanded, parameters 36 | 37 | /// 38 | /// Removes all remaining placeholders from an expanded template, making it valid sql command. 39 | /// 40 | /// 41 | /// The template to be cleaned-up. 42 | /// 43 | let cleanUp (template: string) = 44 | template.Split([| "{{"; "}}" |], System.StringSplitOptions.None) 45 | |> Seq.mapi (fun i s -> if i % 2 = 0 then s else "") 46 | |> String.concat "" 47 | 48 | /// 49 | /// Applies a template transformation when the guard condition is met or parameters is not specified (i.e. parameters is None). 50 | /// 51 | /// 52 | /// The template transformation condition. 53 | /// 54 | /// 55 | /// The template transformation function. 56 | /// 57 | /// 58 | /// The template. 59 | /// 60 | /// 61 | /// The query parameters object. 62 | /// 63 | let applyWhen (guard: 'Params -> bool) (expand: string * 'Params option-> string * 'Params option) (template: string, parameters: 'Params option) = 64 | if parameters |> Option.map guard |> Option.defaultValue true then 65 | expand(template, parameters) 66 | else 67 | template, parameters 68 | 69 | /// 70 | /// Applies a template transformation with a value extracted from query parameters (or default value if parameters object is None). 71 | /// 72 | /// 73 | /// The function extracting a value from query parameters. 74 | /// 75 | /// 76 | /// The template transformation function. 77 | /// 78 | /// 79 | /// The template. 80 | /// 81 | /// 82 | /// The query parameters object. 83 | /// 84 | let applyWith (getter: 'Params -> 'T) (expand: string * 'T option -> string * 'T option) (template: string, parameters: 'Params option) = 85 | expand (template, parameters |> Option.map getter) |> fst, parameters 86 | 87 | /// 88 | /// Enumarets over items and expands itemTemplate with indexes of subsequent items, concatenates expanded templates 89 | /// and replaces occurance of a placeholder in a parent template. 90 | /// 91 | /// 92 | /// The placeholder name of expanded items in a parent template. 93 | /// 94 | /// 95 | /// The item template. 96 | /// 97 | /// 98 | /// The separator used when concatenating expanded items. 99 | /// 100 | /// 101 | /// The parent template. 102 | /// 103 | /// 104 | /// The number of repetitions. 105 | /// 106 | let enumerate placeholder (itemTemplate: string) separator (template: string, count: int option) = 107 | let values = 108 | if count |> Option.defaultValue 0 > 0 then 109 | Seq.init (count |> Option.defaultValue 0) (fun i -> itemTemplate.Replace("{{IDX}}", i.ToString())) |> String.concat separator 110 | else 111 | itemTemplate.Replace("{{IDX}}", "") 112 | template.Replace(sprintf "{{%s}}" placeholder, values), count 113 | 114 | /// 115 | /// Defines a template transformation using template string and transformation function. 116 | /// 117 | /// 118 | /// The template. 119 | /// 120 | /// 121 | /// The template transformation function. 122 | /// 123 | /// 124 | /// The query parameters object. 125 | /// 126 | let define (template: string) (expand: string * 'Params option -> string * 'Params option) (parameters: 'Params option) = 127 | expand(template, parameters) 128 | |> fst 129 | |> cleanUp 130 | -------------------------------------------------------------------------------- /DbFun.Core/Types.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Core 2 | 3 | open System 4 | 5 | /// 6 | /// Reflection helper functions. 7 | /// 8 | module Types = 9 | 10 | /// 11 | /// Checks if a given type is a simple type i.e. whether it can be a column value. 12 | /// Includes .NET basic types, string, DateTime, TimeSpan, Guid and byte array. 13 | /// 14 | /// 15 | /// The type to be checked. 16 | /// 17 | let isSimpleType (typ: Type) = typ.IsPrimitive || List.contains typ [ typeof; typeof; typeof; typeof; typeof; typeof; typeof ] 18 | 19 | /// 20 | /// Checks if a given type is an option type. 21 | /// 22 | /// 23 | /// The type to be checked. 24 | /// 25 | let isOptionType (typ: Type) = typ.IsGenericType && typ.GetGenericTypeDefinition() = typedefof> 26 | 27 | /// 28 | /// Checks whether a given type is a collection type, i.e. array, sequence or its descendants, but not strig or byte array 29 | /// (they can be stored as simple column values). 30 | /// 31 | /// 32 | /// The type to be checked. 33 | /// 34 | let isCollectionType (typ: Type) = 35 | typ.IsArray || 36 | (typ.IsGenericType && 37 | typedefof>.MakeGenericType(typ.GetGenericArguments().[0]).IsAssignableFrom(typ) && 38 | typ <> typeof && 39 | typ <> typeof) 40 | 41 | /// 42 | /// Returns element type of a collection type 43 | /// 44 | /// 45 | /// The collection type. 46 | /// 47 | let getElementType(collectionType: Type) = 48 | if collectionType.IsArray then 49 | collectionType.GetElementType() 50 | else 51 | collectionType.GetGenericArguments().[0] 52 | -------------------------------------------------------------------------------- /DbFun.CrossDatabase.IntegrationTests/App.config: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | -------------------------------------------------------------------------------- /DbFun.CrossDatabase.IntegrationTests/Commons.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.CrossDatabase.IntegrationTests 2 | 3 | open Microsoft.Data.SqlClient 4 | open System.Configuration 5 | open DbFun.Core 6 | open System.Data 7 | open MySql.Data.MySqlClient 8 | 9 | module Commons = 10 | 11 | type Discriminator = 12 | | MsSqlServer 13 | | MySql 14 | | Postgres 15 | 16 | let config = ConfigurationManager.OpenExeConfiguration(System.Reflection.Assembly.GetExecutingAssembly().Location) 17 | let msSqlConnectionString = config.ConnectionStrings.ConnectionStrings.["MsSqlServer"].ConnectionString 18 | let mySqlConnectionString = config.ConnectionStrings.ConnectionStrings.["MySql"].ConnectionString 19 | let postgresConnectionString = config.ConnectionStrings.ConnectionStrings.["Postgres"].ConnectionString 20 | 21 | let createConnection = function 22 | | MsSqlServer -> new SqlConnection(msSqlConnectionString) :> IDbConnection 23 | | MySql -> new MySqlConnection(mySqlConnectionString) 24 | | Postgres -> new Npgsql.NpgsqlConnection(postgresConnectionString) 25 | 26 | 27 | let run dbCall = DbCall.Run(createConnection, dbCall) 28 | -------------------------------------------------------------------------------- /DbFun.CrossDatabase.IntegrationTests/DbFun.CrossDatabase.IntegrationTests.fsproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | net6.0 5 | 6 | false 7 | false 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | runtime; build; native; contentfiles; analyzers; buildtransitive 28 | all 29 | 30 | 31 | runtime; build; native; contentfiles; analyzers; buildtransitive 32 | all 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | -------------------------------------------------------------------------------- /DbFun.CrossDatabase.IntegrationTests/Models.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.CrossDatabase.IntegrationTests 2 | 3 | open System 4 | 5 | module Models = 6 | 7 | type Blog = { 8 | id: int 9 | name: string 10 | title: string 11 | description: string 12 | owner: string 13 | createdAt: DateTime 14 | modifiedAt: DateTime option 15 | modifiedBy: string option 16 | } 17 | -------------------------------------------------------------------------------- /DbFun.CrossDatabase.IntegrationTests/Program.fs: -------------------------------------------------------------------------------- 1 | module Program = let [] main _ = 0 2 | -------------------------------------------------------------------------------- /DbFun.CrossDatabase.IntegrationTests/TestQueries.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.CrossDatabase.IntegrationTests 2 | 3 | open DbFun.Core 4 | open Commons 5 | open Models 6 | 7 | module MsSqlQueries = 8 | 9 | open DbFun.MsSql.Builders 10 | 11 | let query = QueryBuilder(MsSqlServer, createConnection) 12 | 13 | let insertBlog = query.Sql( 14 | "insert into blog (name, title, description, owner, createdAt, modifiedAt, modifiedBy) 15 | values (@name, @title, @description, @owner, @createdAt, @modifiedAt, @modifiedBy)") 16 | 17 | let deleteAllButFirstBlog = 18 | query.Sql "delete from blog where id > 1" 19 | 20 | let getNumberOfBlogs = query.Sql "select count(*) from blog" 21 | 22 | 23 | module MySqlQueries = 24 | 25 | open DbFun.Core.Builders 26 | 27 | let query = QueryBuilder(MySql, createConnection) 28 | 29 | let insertBlog = query.Sql( 30 | "insert into blog (id, name, title, description, owner, createdAt, modifiedAt, modifiedBy) 31 | values (@id, @name, @title, @description, @owner, @createdAt, @modifiedAt, @modifiedBy)") 32 | 33 | let deleteAllButFirstBlog = 34 | query.Sql "delete from blog where id > 1" 35 | 36 | let getNumberOfBlogs = query.Sql "select count(*) from blog" 37 | 38 | 39 | module PostgresQueries = 40 | 41 | open DbFun.Core.Builders 42 | 43 | let query = QueryBuilder(Postgres, createConnection) 44 | 45 | let insertBlog = query.Sql( 46 | "insert into blog (blogid, name, title, description, owner, createdAt, modifiedAt, modifiedBy) 47 | values (@id, @name, @title, @description, @owner, @createdAt, @modifiedAt, @modifiedBy)") 48 | 49 | let deleteAllButFirstBlog = 50 | query.Sql "delete from blog where blogid > 1" 51 | 52 | let getNumberOfBlogs = query.Sql "select count(*) from blog" 53 | -------------------------------------------------------------------------------- /DbFun.CrossDatabase.IntegrationTests/Tests.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.CrossDatabase.IntegrationTests 2 | 3 | open System 4 | open Xunit 5 | open Commons 6 | open Models 7 | open DbFun.Core 8 | 9 | module Tests = 10 | 11 | let runSync f = run f |> Async.RunSynchronously 12 | 13 | [] 14 | let ``Inserts to different databases work as expected``() = 15 | 16 | MsSqlQueries.deleteAllButFirstBlog() |> runSync 17 | MySqlQueries.deleteAllButFirstBlog() |> runSync 18 | PostgresQueries.deleteAllButFirstBlog() |> runSync 19 | 20 | let blog = { 21 | id = 4 22 | name = "test-blog-4" 23 | title = "Testing simple insert 4" 24 | description = "Added to check if inserts work properly." 25 | owner = "jacentino" 26 | createdAt = DateTime.Now 27 | modifiedAt = None 28 | modifiedBy = None 29 | } 30 | 31 | dbsession { 32 | do! MsSqlQueries.insertBlog blog 33 | do! MySqlQueries.insertBlog blog 34 | do! PostgresQueries.insertBlog blog 35 | } |> runSync 36 | 37 | let msSqlNumOfBlogs = MsSqlQueries.getNumberOfBlogs() |> runSync 38 | let mySqlNumOfBlogs = MySqlQueries.getNumberOfBlogs() |> runSync 39 | let pgSqlNumOfBlogs = PostgresQueries.getNumberOfBlogs() |> runSync 40 | 41 | Assert.Equal(2, msSqlNumOfBlogs) 42 | Assert.Equal(2, mySqlNumOfBlogs) 43 | Assert.Equal(2, pgSqlNumOfBlogs) 44 | 45 | 46 | [] 47 | let ``Parallel inserts to the same database work as expected``() = 48 | 49 | MsSqlQueries.deleteAllButFirstBlog() |> runSync 50 | 51 | let inserts = [ 52 | for i in 4..6 do 53 | MsSqlQueries.insertBlog { 54 | id = i 55 | name = $"test-blog-{i}" 56 | title = $"Testing simple insert {i}" 57 | description = "Added to check if inserts work properly." 58 | owner = "jacentino" 59 | createdAt = DateTime.Now 60 | modifiedAt = None 61 | modifiedBy = None 62 | } 63 | ] 64 | 65 | let result = inserts |> DbCall.Parallel |> runSync 66 | 67 | let msSqlNumOfBlogs = MsSqlQueries.getNumberOfBlogs() |> runSync 68 | 69 | Assert.Equal(3, result.Length) 70 | Assert.Equal(4, msSqlNumOfBlogs) 71 | 72 | 73 | [] 74 | let ``Insert to certain database in transaction is committed``() = 75 | 76 | MsSqlQueries.deleteAllButFirstBlog() |> runSync 77 | 78 | let blog = { 79 | id = 4 80 | name = "test-blog-4" 81 | title = "Testing simple insert 4" 82 | description = "Added to check if inserts work properly." 83 | owner = "jacentino" 84 | createdAt = DateTime.Now 85 | modifiedAt = None 86 | modifiedBy = None 87 | } 88 | 89 | dbsession { 90 | do! MsSqlQueries.insertBlog blog 91 | } |> DbCall.InTransaction MsSqlServer |> runSync 92 | 93 | let msSqlNumOfBlogs = MsSqlQueries.getNumberOfBlogs() |> runSync 94 | 95 | Assert.Equal(2, msSqlNumOfBlogs) 96 | 97 | 98 | [] 99 | let ``Insert to certain database in transaction is rolled back in case of exception``() = 100 | 101 | MsSqlQueries.deleteAllButFirstBlog() |> runSync 102 | 103 | let blog = { 104 | id = 4 105 | name = "test-blog-4" 106 | title = "Testing simple insert 4" 107 | description = "Added to check if inserts work properly." 108 | owner = "jacentino" 109 | createdAt = DateTime.Now 110 | modifiedAt = None 111 | modifiedBy = None 112 | } 113 | 114 | try 115 | dbsession { 116 | do! MsSqlQueries.insertBlog blog 117 | failwith "Rollback" 118 | } |> DbCall.InTransaction MsSqlServer |> runSync 119 | with _ -> 120 | () // ignored intentionally 121 | 122 | let msSqlNumOfBlogs = MsSqlQueries.getNumberOfBlogs() |> runSync 123 | 124 | Assert.Equal(1, msSqlNumOfBlogs) 125 | -------------------------------------------------------------------------------- /DbFun.Firebird.IntegrationTests/App.config: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | 6 | 7 | -------------------------------------------------------------------------------- /DbFun.Firebird.IntegrationTests/Commons.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Firebird.IntegrationTests 2 | 3 | open System.Configuration 4 | open DbFun.Core 5 | open System.Data 6 | open FirebirdSql.Data.FirebirdClient 7 | open DbFun.Core.Builders 8 | open DbFun.Firebird.Builders 9 | 10 | 11 | module Commons = 12 | 13 | let connectionString = 14 | let config = ConfigurationManager.OpenExeConfiguration(System.Reflection.Assembly.GetExecutingAssembly().Location) 15 | config.ConnectionStrings.ConnectionStrings.["DbFunTests"].ConnectionString 16 | 17 | let createConnection(): IDbConnection = new FbConnection(connectionString) 18 | 19 | let config = QueryConfig.Default(createConnection) 20 | let query = QueryBuilder(config) 21 | 22 | let batch = BatchCommandBuilder() 23 | 24 | let run dbCall = DbCall.Run(createConnection, dbCall) 25 | 26 | 27 | 28 | -------------------------------------------------------------------------------- /DbFun.Firebird.IntegrationTests/DbFun.Firebird.IntegrationTests.fsproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | net6.0 5 | 6 | false 7 | false 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | runtime; build; native; contentfiles; analyzers; buildtransitive 26 | all 27 | 28 | 29 | runtime; build; native; contentfiles; analyzers; buildtransitive 30 | all 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | -------------------------------------------------------------------------------- /DbFun.Firebird.IntegrationTests/Models.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Firebird.IntegrationTests 2 | 3 | open System 4 | open Commons 5 | 6 | module Models = 7 | 8 | type Blog = { 9 | id: int 10 | name: string 11 | title: string 12 | description: string 13 | owner: string 14 | createdAt: DateTime 15 | modifiedAt: DateTime option 16 | modifiedBy: string option 17 | } 18 | 19 | module Tooling = 20 | 21 | let deleteAllButFirstBlog = 22 | query.Sql("delete from blog where id > 1") 23 | 24 | 25 | 26 | 27 | -------------------------------------------------------------------------------- /DbFun.Firebird.IntegrationTests/Program.fs: -------------------------------------------------------------------------------- 1 | module Program = let [] main _ = 0 2 | -------------------------------------------------------------------------------- /DbFun.Firebird.IntegrationTests/TestQueries.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Firebird.IntegrationTests 2 | 3 | open DbFun.Core 4 | open Commons 5 | open Models 6 | 7 | module TestQueries = 8 | 9 | let getBlog = query.Sql( 10 | "select id, name, title, description, owner, createdAt, modifiedAt, modifiedBy from blog where id = @id", "id") 11 | 12 | let insertBlog = query.Sql( 13 | "insert into blog (id, name, title, description, owner, createdAt, modifiedAt, modifiedBy) 14 | values (@id, @name, @title, @description, @owner, @createdAt, @modifiedAt, @modifiedBy)") 15 | 16 | let batchInsertBlogs = batch.Command( 17 | "insert into blog (id, name, title, description, owner, createdAt, modifiedAt, modifiedBy) 18 | values (@id, @name, @title, @description, @owner, @createdAt, @modifiedAt, @modifiedBy)") 19 | -------------------------------------------------------------------------------- /DbFun.Firebird.IntegrationTests/Tests.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Firebird.IntegrationTests 2 | 3 | open System 4 | open Xunit 5 | open Commons 6 | 7 | module Tests = 8 | 9 | let runSync f = run f |> Async.RunSynchronously 10 | 11 | [] 12 | let ``Simple queries to Firebird return valid results``() = 13 | let blog = TestQueries.getBlog 1 |> runSync 14 | Assert.Equal("functional-data-access-with-sqlfun", blog.name) 15 | 16 | [] 17 | let ``Inserts to Firebird work as expected``() = 18 | 19 | Tooling.deleteAllButFirstBlog() |> runSync 20 | 21 | TestQueries.insertBlog { 22 | id = 4 23 | name = "test-blog-4" 24 | title = "Testing simple insert 4" 25 | description = "Added to check if inserts work properly." 26 | owner = "jacentino" 27 | createdAt = DateTime.Now 28 | modifiedAt = None 29 | modifiedBy = None 30 | } |> runSync 31 | 32 | 33 | [] 34 | let ``Batch inserts to Firebird work as expected``() = 35 | 36 | Tooling.deleteAllButFirstBlog() |> runSync 37 | 38 | let results = 39 | TestQueries.batchInsertBlogs [ 40 | { 41 | id = 4 42 | name = "test-blog-4" 43 | title = "Testing batch insert 4" 44 | description = "Added to check if inserts work properly." 45 | owner = "jacentino" 46 | createdAt = DateTime.Now 47 | modifiedAt = None 48 | modifiedBy = None 49 | } 50 | { 51 | id = 5 52 | name = "test-blog-5" 53 | title = "Testing batch insert 5" 54 | description = "Added to check if inserts work properly." 55 | owner = "placentino" 56 | createdAt = DateTime.Now 57 | modifiedAt = None 58 | modifiedBy = None 59 | } 60 | ] |> runSync 61 | 62 | Assert.True(results.AllSuccess) 63 | 64 | -------------------------------------------------------------------------------- /DbFun.Firebird.IntegrationTests/database/DBFUNTESTS.FDB: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jacentino/DbFun/af519e95e7b5b68ddb11a5e5e17c2727c775b296/DbFun.Firebird.IntegrationTests/database/DBFUNTESTS.FDB -------------------------------------------------------------------------------- /DbFun.Firebird/AssemblyInfo.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Firebird.AssemblyInfo 2 | 3 | open System.Reflection 4 | open System.Runtime.InteropServices 5 | 6 | // General Information about an assembly is controlled through the following 7 | // set of attributes. Change these attribute values to modify the information 8 | // associated with an assembly. 9 | [] 10 | [] 11 | [] 12 | [] 13 | [] 14 | [] 15 | [] 16 | [] 17 | 18 | // Setting ComVisible to false makes the types in this assembly not visible 19 | // to COM components. If you need to access a type in this assembly from 20 | // COM, set the ComVisible attribute to true on that type. 21 | [] 22 | 23 | // The following GUID is for the ID of the typelib if this project is exposed to COM 24 | [] 25 | 26 | // Version information for an assembly consists of the following four values: 27 | // 28 | // Major Version 29 | // Minor Version 30 | // Build Number 31 | // Revision 32 | // 33 | // You can specify all the values or you can default the Build and Revision Numbers 34 | // by using the '*' as shown below: 35 | // [] 36 | [] 37 | [] 38 | 39 | do 40 | () -------------------------------------------------------------------------------- /DbFun.Firebird/BatchCommand.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Firebird.Builders 2 | 3 | open DbFun.Core.Builders 4 | open FirebirdSql.Data.FirebirdClient 5 | open System 6 | open DbFun.Core 7 | open System.Data 8 | 9 | 10 | type IBatchParamSetter<'Arg> = GenericSetters.ISetter 11 | 12 | type IBatchParamSetterProvider = GenericSetters.ISetterProvider 13 | 14 | type BatchParamSpecifier<'Arg> = IBatchParamSetterProvider * unit -> IBatchParamSetter<'Arg> 15 | 16 | module BatchParamsImpl = 17 | 18 | type IBuilder = GenericSetters.IBuilder 19 | 20 | type SimpleBuilder() = 21 | 22 | member __.FindOrCreateParam(batchParams: FbParameterCollection, name: string) = 23 | let index = batchParams.IndexOf(name) 24 | if index = -1 then 25 | let param = FbParameter() 26 | param.ParameterName <- name 27 | batchParams.Add param |> ignore 28 | param 29 | else 30 | batchParams.[index] 31 | 32 | member __.Update(param: IDbDataParameter, value: obj) = 33 | if param.Value = null || param.Value = DBNull.Value then 34 | param.Value <- value 35 | else 36 | failwithf "Duplicate parameter definition: %s" param.ParameterName 37 | 38 | member __.GetArtificialValue<'Type>(): obj = 39 | if typeof<'Type> = typeof then box "" 40 | elif typeof<'Type> = typeof then box DateTime.Now 41 | elif typeof<'Type> = typeof then box [||] 42 | elif typeof<'Type>.IsClass then null 43 | else box Unchecked.defaultof<'Type> 44 | 45 | interface IBuilder with 46 | 47 | member __.CanBuild (argType: Type) = Types.isSimpleType(argType) 48 | 49 | member this.Build<'Arg> (name: string, _, ()) = 50 | { new IBatchParamSetter<'Arg> with 51 | member __.SetValue (value: 'Arg, index: int option, batchParams: FbParameterCollection) = 52 | let param = this.FindOrCreateParam(batchParams, name) 53 | this.Update(param, value) 54 | member __.SetNull(index: int option, batchParams: FbParameterCollection) = 55 | let param = this.FindOrCreateParam(batchParams, name) 56 | this.Update(param, DBNull.Value) 57 | member __.SetArtificial(index: int option, batchParams: FbParameterCollection) = 58 | let param = this.FindOrCreateParam(batchParams, name) 59 | param.Value <- this.GetArtificialValue<'Arg>() 60 | } 61 | 62 | 63 | let getDefaultBuilders(): IBuilder list = 64 | SimpleBuilder() :: GenericSetters.getDefaultBuilders() 65 | 66 | type Converter<'Source, 'Target> = GenericSetters.Converter 67 | 68 | type Configurator<'Config> = GenericSetters.Configurator 69 | 70 | 71 | /// 72 | /// Provides methods creating various batch parameter builders. 73 | /// 74 | type BatchParams() = 75 | inherit GenericSetters.GenericSetterBuilder() 76 | 77 | /// 78 | /// The batch parameter mapping override. 79 | /// 80 | type BatchParamOverride<'Arg> = GenericSetters.Override 81 | 82 | 83 | /// 84 | /// Batch command config. 85 | /// 86 | type BatchCommandConfig = 87 | { 88 | ParamBuilders : BatchParamsImpl.IBuilder list 89 | } 90 | with 91 | /// 92 | /// Adds a converter mapping application values of a given type to ptoper database parameter values. 93 | /// 94 | /// 95 | /// Function converting application values to database parameter values. 96 | /// 97 | member this.AddConverter(convert: 'Source -> 'Target) = 98 | { this with 99 | ParamBuilders = 100 | BatchParamsImpl.Converter<'Source, 'Target>(convert) :: 101 | this.ParamBuilders 102 | } 103 | 104 | /// 105 | /// Adds a configurator for parameter builders of types determined by CanBuild function. 106 | /// 107 | /// 108 | /// Creates a configuration object. 109 | /// 110 | /// 111 | /// Function determining whether a given type is handled by the configurator. 112 | /// 113 | member this.AddConfigurator(getConfig: string -> 'Config, canBuild: Type -> bool) = 114 | { this with 115 | ParamBuilders = BatchParamsImpl.Configurator<'Config>(getConfig, canBuild) :: this.ParamBuilders 116 | } 117 | 118 | 119 | /// 120 | /// Provides methods creating batch processing functions. 121 | /// 122 | type BatchCommandBuilder<'DbKey>(dbKey: 'DbKey, ?config: BatchCommandConfig) = 123 | 124 | let builders = defaultArg (config |> Option.map (fun c -> c.ParamBuilders)) (BatchParamsImpl.getDefaultBuilders()) 125 | 126 | /// 127 | /// Generates a function performing batch processing. 128 | /// 129 | /// 130 | /// The SQL command. 131 | /// 132 | /// 133 | /// The parameter specifier. 134 | /// 135 | member __.Command(commandText: string, specifier: BatchParamSpecifier<'Record>): 'Record seq -> DbCall<'DbKey, FbBatchNonQueryResult> = 136 | let provider = GenericSetters.BaseSetterProvider(builders) 137 | let setter = specifier(provider, ()) 138 | fun (records: 'Record seq) (connector: IConnector<'DbKey>) -> 139 | async { 140 | use command = new FbBatchCommand(commandText) 141 | command.Connection <- connector.GetConnection(dbKey) :?> FbConnection 142 | command.Transaction <- connector.GetTransaction(dbKey) :?> FbTransaction 143 | for r in records do 144 | let batchParams = command.AddBatchParameters() 145 | setter.SetValue(r, None, batchParams) 146 | let! token = Async.CancellationToken 147 | return! command.ExecuteNonQueryAsync(token) |> Async.AwaitTask 148 | } 149 | 150 | /// 151 | /// Generates a function performing batch processing. 152 | /// 153 | /// 154 | /// The SQL command. 155 | /// 156 | member this.Command<'Record>(commandText: string): 'Record seq -> DbCall<'DbKey, FbBatchNonQueryResult> = 157 | this.Command(commandText, BatchParams.Auto<'Record>()) 158 | 159 | 160 | /// 161 | /// Provides methods creating batch processing functions. 162 | /// 163 | type BatchCommandBuilder(?config: BatchCommandConfig) = 164 | inherit BatchCommandBuilder((), ?config = config) 165 | 166 | -------------------------------------------------------------------------------- /DbFun.Firebird/DbFun.Firebird.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | net6.0 5 | true 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | -------------------------------------------------------------------------------- /DbFun.MsSql.IntegrationTests/App.config: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | 6 | 7 | -------------------------------------------------------------------------------- /DbFun.MsSql.IntegrationTests/Commons.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.MsSql.IntegrationTests 2 | 3 | open Microsoft.Data.SqlClient 4 | open System.Configuration 5 | open DbFun.Core 6 | open DbFun.MsSql.Builders 7 | open System.Data 8 | 9 | module Commons = 10 | 11 | let connectionString = 12 | let config = ConfigurationManager.OpenExeConfiguration(System.Reflection.Assembly.GetExecutingAssembly().Location) 13 | config.ConnectionStrings.ConnectionStrings.["DbFunTests"].ConnectionString 14 | 15 | let createConnection (): IDbConnection = new SqlConnection(connectionString) 16 | 17 | let defaultConfig = QueryConfig.Default(createConnection).UseTvpParams() 18 | 19 | let query = QueryBuilder(defaultConfig) 20 | 21 | let run dbCall = DbCall.Run(createConnection, dbCall) 22 | -------------------------------------------------------------------------------- /DbFun.MsSql.IntegrationTests/DbFun.MsSql.IntegrationTests.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | net6.0 5 | 6 | false 7 | false 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | runtime; build; native; contentfiles; analyzers; buildtransitive 27 | all 28 | 29 | 30 | runtime; build; native; contentfiles; analyzers; buildtransitive 31 | all 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | -------------------------------------------------------------------------------- /DbFun.MsSql.IntegrationTests/Models.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.MsSql.IntegrationTests 2 | 3 | open System 4 | open Commons 5 | 6 | module Models = 7 | 8 | type Comment = { 9 | id : int 10 | parentId : int option 11 | content : string 12 | author : string 13 | createdAt : DateTime 14 | replies : Comment list 15 | } 16 | 17 | type PostStatus = 18 | | New = 'N' 19 | | Published = 'P' 20 | | Archived = 'A' 21 | 22 | type Post = { 23 | id : int 24 | blogId : int 25 | name : string 26 | title : string 27 | content : string 28 | author : string 29 | createdAt : DateTime 30 | modifiedAt : DateTime option 31 | modifiedBy : string option 32 | status : PostStatus 33 | comments : Comment list 34 | tags : string list 35 | } 36 | 37 | type Blog = { 38 | id : int 39 | name : string 40 | title : string 41 | description : string 42 | owner : string 43 | createdAt : DateTime 44 | modifiedAt : DateTime option 45 | modifiedBy : string option 46 | posts : Post list 47 | } 48 | 49 | type BlogTZ = { 50 | id : int 51 | name : string 52 | title : string 53 | description : string 54 | owner : string 55 | createdAt : DateTimeOffset 56 | modifiedAt : DateTimeOffset option 57 | modifiedBy : string option 58 | posts : Post list 59 | } 60 | 61 | type SortField = 62 | | Name = 1 63 | | Title = 2 64 | | Author = 3 65 | | CreatedAt = 4 66 | | Status = 5 67 | 68 | type SortDirection = 69 | | Asc = 1 70 | | Desc = 2 71 | 72 | type SortOrder = 73 | { 74 | field : SortField 75 | direction : SortDirection 76 | } 77 | override this.ToString() = sprintf "%A %A" this.field this.direction 78 | 79 | type Criteria = 80 | { 81 | name : string option 82 | title : string option 83 | content : string option 84 | author : string option 85 | createdFrom : DateTime option 86 | createdTo : DateTime option 87 | modifiedFrom: DateTime option 88 | modifiedTo : DateTime option 89 | statuses : PostStatus list 90 | tags : string list 91 | sortOrder : SortOrder 92 | } 93 | static member Default = 94 | { 95 | name = None 96 | title = None 97 | content = None 98 | author = None 99 | createdFrom = None 100 | createdTo = None 101 | modifiedFrom= None 102 | modifiedTo = None 103 | statuses = [] 104 | tags = [] 105 | sortOrder = { field = SortField.CreatedAt; direction = SortDirection.Desc } 106 | } 107 | 108 | 109 | module Tooling = 110 | 111 | let getNumberOfBlogs = query.Sql("select count(*) from blog") 112 | 113 | let deleteAllButFirstBlog = query.Sql("delete from blog where id > 1") 114 | 115 | -------------------------------------------------------------------------------- /DbFun.MsSql.IntegrationTests/Program.fs: -------------------------------------------------------------------------------- 1 | module Program = let [] main _ = 0 2 | -------------------------------------------------------------------------------- /DbFun.MsSql.IntegrationTests/Tests.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.MsSql.IntegrationTests 2 | 3 | open System 4 | open FSharp.Control 5 | open Xunit 6 | open DbFun.Core 7 | open DbFun.MsSql.IntegrationTests.Models 8 | open Commons 9 | 10 | module Tests = 11 | 12 | [] 13 | let ``Query returning one row`` () = 14 | let blog = TestQueries.getBlog 1 |> run |> Async.RunSynchronously 15 | Assert.Equal(1, blog.id) 16 | 17 | [] 18 | let ``Query returning scalar`` () = 19 | let name = TestQueries.getBlogName 1 |> run |> Async.RunSynchronously 20 | Assert.Equal("functional-data-access-with-dbfun", name) 21 | 22 | [] 23 | let ``Query returning many rows`` () = 24 | Tooling.deleteAllButFirstBlog() 25 | |> run 26 | |> Async.RunSynchronously 27 | let blogs = TestQueries.getAllBlogs() |> run |> Async.RunSynchronously 28 | Assert.Equal(1, blogs |> Seq.length) 29 | 30 | [] 31 | let ``Query returning many rows in AsyncSeq`` () = 32 | Tooling.deleteAllButFirstBlog() 33 | |> run 34 | |> Async.RunSynchronously 35 | let length = 36 | dbsession { 37 | let! blogs = TestQueries.getAllBlogsAsync() 38 | return! blogs |> AsyncSeq.length |> DbCall.FromAsync 39 | } 40 | |> run 41 | |> Async.RunSynchronously 42 | Assert.Equal(1, int(length)) 43 | 44 | [] 45 | let ``Query returning many rows in AsyncSeq with autolifting async`` () = 46 | Tooling.deleteAllButFirstBlog() 47 | |> run 48 | |> Async.RunSynchronously 49 | let length = 50 | dbsession { 51 | let! blogs = TestQueries.getAllBlogsAsync() 52 | return! blogs |> AsyncSeq.length 53 | } 54 | |> run 55 | |> Async.RunSynchronously 56 | Assert.Equal(1, int(length)) 57 | 58 | [] 59 | let ``Query returning one row optionally - row exists`` () = 60 | let blog = TestQueries.getBlogOptional 1 |> run |> Async.RunSynchronously 61 | Assert.NotNull(blog) 62 | 63 | [] 64 | let ``Query returning one row optionally - row doesn't exist`` () = 65 | let blog = TestQueries.getBlogOptional 10 |> run |> Async.RunSynchronously 66 | Assert.Null(blog) 67 | 68 | [] 69 | let ``Query returning many results using join to combine them``() = 70 | let pl = TestQueries.getPostsWithTagsAndComments 1 |> run |> Async.RunSynchronously |> Seq.toList 71 | Assert.Equal(2, pl |> List.length) 72 | let p = pl |> List.head 73 | Assert.Equal(1, p.blogId) 74 | Assert.Equal(3, p.tags |> List.length) 75 | 76 | 77 | [] 78 | let ``Query returning many results using applicative functor to combine them``() = 79 | let p = TestQueries.getOnePostWithTagsAndComments 1 |> run |> Async.RunSynchronously 80 | Assert.Equal(1, p.blogId) 81 | Assert.Equal(3, p.tags |> List.length) 82 | 83 | 84 | [] 85 | let ``Template-based query returning one result``() = 86 | let criteria = 87 | { Criteria.Default with 88 | author = Some "jac" 89 | statuses = [ PostStatus.Published ] 90 | tags = [ "framework" ] 91 | sortOrder = { field = SortField.Name; direction = SortDirection.Asc } 92 | } 93 | let p = TestQueries.findPosts criteria |> run |> Async.RunSynchronously |> Seq.head 94 | Assert.Equal(1, p.blogId) 95 | 96 | 97 | [] 98 | let ``Query filtering by DateTimeOffset`` () = 99 | Tooling.deleteAllButFirstBlog() 100 | |> run 101 | |> Async.RunSynchronously 102 | let blogs = 103 | TestQueries.getBlogsBefore(DateTimeOffset.Now) 104 | |> run 105 | |> Async.RunSynchronously 106 | Assert.Equal(1, blogs |> Seq.length) 107 | 108 | 109 | [] 110 | let ``Queries utilizing TVP-s``() = 111 | let tags = [ 112 | (2, "Dapper") 113 | (2, "EntityFramework") 114 | (2, "FSharp.Data.SqlClient") 115 | ] 116 | TestQueries.updateTags 2 tags |> run |> Async.RunSynchronously 117 | let result = TestQueries.getTags 2 |> run |> Async.RunSynchronously 118 | Assert.Equal(tags |> List.map snd, result) 119 | 120 | 121 | [] 122 | let ``Stored procedure with transformed result``() = 123 | let pl = TestQueries.getAllPosts 1 |> run |> Async.RunSynchronously 124 | Assert.Equal(2, pl |> List.length) 125 | let p = pl |> List.head 126 | Assert.Equal(1, p.comments |> List.length) 127 | 128 | 129 | [] 130 | let ``Combining queries together with dbsession``() = 131 | let post1, post2 = 132 | dbsession { 133 | let! post1 = TestQueries.getOnePostWithTagsAndComments 1 134 | let! post2 = TestQueries.getOnePostWithTagsAndComments 2 135 | return post1, post2 136 | } |> run |> Async.RunSynchronously 137 | Assert.Equal("Yet another sql framework", post1.title) 138 | Assert.Equal("What's wrong with existing frameworks", post2.title) 139 | 140 | 141 | [] 142 | let ``Updating in transaction``() = 143 | let tags = [ 144 | (2, "Dapper") 145 | (2, "EntityFramework") 146 | (2, "FSharp.Data.SqlClient") 147 | ] 148 | TestQueries.updateTags 2 tags |> DbCall.InTransaction |> run |> Async.RunSynchronously 149 | let result = TestQueries.getTags 2 |> run |> Async.RunSynchronously 150 | Assert.Equal(tags |> List.map snd, result) 151 | 152 | 153 | [] 154 | let ``Using dbsession and transactions together``() = 155 | let post1, post2 = 156 | dbsession { 157 | let! post1 = TestQueries.getOnePostWithTagsAndComments 1 158 | let! post2 = TestQueries.getOnePostWithTagsAndComments 2 159 | return post1, post2 160 | } |> DbCall.InTransaction |> run |> Async.RunSynchronously 161 | Assert.Equal("Yet another sql framework", post1.title) 162 | Assert.Equal("What's wrong with existing frameworks", post2.title) 163 | 164 | 165 | [] 166 | let ``Compile-time errors - logging & derived QueryBuilder``() = 167 | 168 | TestQueries.invalidQuery |> ignore 169 | 170 | let lineNo, fileName, _ = TestQueries.query.CompileTimeErrors |> List.head 171 | 172 | Assert.Equal(TestQueries.invalidLine, lineNo) 173 | Assert.Contains("TestQueries.fs", fileName) 174 | 175 | [] 176 | let ``Query returning many results using join to combine them with disabled prototype calls``() = 177 | let pl = TestQueries.unsafeGetPostsWithTagsAndComments 1 |> run |> Async.RunSynchronously |> Seq.toList 178 | Assert.Equal(2, pl |> List.length) 179 | let p = pl |> List.head 180 | Assert.Equal(1, p.blogId) 181 | Assert.Equal(3, p.tags |> List.length) 182 | 183 | 184 | [] 185 | let ``Query returning many results using applicative functor to combine them with disabled prototype calls``() = 186 | let p = TestQueries.unsafeGetOnePostWithTagsAndComments 1 |> run |> Async.RunSynchronously 187 | Assert.Equal(1, p.blogId) 188 | Assert.Equal(3, p.tags |> List.length) 189 | -------------------------------------------------------------------------------- /DbFun.MsSql.Tests/DbFun.MsSql.Tests.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | net6.0 5 | 6 | false 7 | false 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | runtime; build; native; contentfiles; analyzers; buildtransitive 23 | all 24 | 25 | 26 | runtime; build; native; contentfiles; analyzers; buildtransitive 27 | all 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | -------------------------------------------------------------------------------- /DbFun.MsSql.Tests/OutParamsTests.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.MsSql.Tests 2 | 3 | open System 4 | open Xunit 5 | open Microsoft.Data.SqlClient 6 | open DbFun.Core.Builders 7 | open DbFun.MsSql.Builders 8 | open System.Data 9 | open DbFun.TestTools.Models 10 | 11 | module OutParamsTests = 12 | 13 | let connection = new SqlConnection() 14 | let provider = GenericGetters.BaseGetterProvider(OutParamsImpl.getDefaultBuilders()) 15 | let builderParams = provider :> IOutParamGetterProvider, () 16 | 17 | [] 18 | let ``Return alone``() = 19 | 20 | let command = connection.CreateCommand() 21 | let getter = OutParams.Return("ret_value") builderParams 22 | 23 | getter.Create(command) 24 | command.Parameters.["ret_value"].Value <- 5 25 | let value = getter.Get(command) 26 | 27 | Assert.Equal(ParameterDirection.ReturnValue, command.Parameters.["ret_value"].Direction) 28 | Assert.Equal(5, value) 29 | 30 | 31 | [] 32 | let ``Return and simple output``() = 33 | 34 | let command = connection.CreateCommand() 35 | let getter = OutParams.ReturnAnd("ret_value", "name") builderParams 36 | 37 | getter.Create(command) 38 | command.Parameters.["ret_value"].Value <- 5 39 | command.Parameters.["name"].Value <- "jacentino" 40 | let retVal, name = getter.Get(command) 41 | 42 | Assert.Equal(ParameterDirection.ReturnValue, command.Parameters.["ret_value"].Direction) 43 | Assert.Equal(5, retVal) 44 | Assert.Equal("jacentino", name) 45 | 46 | 47 | [] 48 | let ``Return and record output``() = 49 | 50 | let command = connection.CreateCommand() 51 | let getter = OutParams.ReturnAnd("ret_value", "user") builderParams 52 | 53 | getter.Create(command) 54 | command.Parameters.["ret_value"].Value <- 5 55 | command.Parameters.["userId"].Value <- 12 56 | command.Parameters.["name"].Value <- "jacentino" 57 | command.Parameters.["email"].Value <- "jacentino@gmail.com" 58 | command.Parameters.["created"].Value <- DateTime(2023, 1, 1) 59 | let retVal, user = getter.Get(command) 60 | 61 | let expected = 62 | { 63 | userId = 12 64 | name = "jacentino" 65 | email = "jacentino@gmail.com" 66 | created = DateTime(2023, 1, 1) 67 | } 68 | 69 | Assert.Equal(ParameterDirection.ReturnValue, command.Parameters.["ret_value"].Direction) 70 | Assert.Equal(5, retVal) 71 | Assert.Equal(expected, user) 72 | 73 | 74 | -------------------------------------------------------------------------------- /DbFun.MsSql.Tests/Program.fs: -------------------------------------------------------------------------------- 1 | module Program = let [] main _ = 0 -------------------------------------------------------------------------------- /DbFun.MsSql.Tests/QueryTests.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.MsSql.Tests 2 | 3 | open System 4 | open Xunit 5 | open DbFun.TestTools.Models 6 | open DbFun.TestTools.Mocks 7 | open DbFun.Core 8 | open DbFun.Core.Builders 9 | open DbFun.MsSql.Builders 10 | 11 | module QueryTests = 12 | 13 | 14 | [] 15 | let ``Procedures``() = 16 | 17 | let createConnection() = 18 | setupCommandOutParams 19 | [ "userId", box 1 20 | "name", box "jacentino" 21 | "email", box "jacentino@gmail.com" 22 | "created", box (DateTime(2023, 1, 1)) 23 | "ret_val", box 5 24 | ] 25 | 26 | let connector = new Connector(createConnection) 27 | 28 | let qb = QueryBuilder(QueryConfig.Default(createConnection)) 29 | 30 | let query = qb.Proc("getUser", Params.Auto "id", OutParams.ReturnAnd("ret_val", "user"), Results.Unit) 31 | 32 | let _, (retVal, user) = query 1 connector |> Async.RunSynchronously 33 | 34 | let expected = 35 | { 36 | userId = 1 37 | name = "jacentino" 38 | email = "jacentino@gmail.com" 39 | created = DateTime(2023, 1, 1) 40 | } 41 | 42 | Assert.Equal(5, retVal) 43 | Assert.Equal(expected, user) 44 | 45 | 46 | [] 47 | let ``Record seq - using TVP`` () = 48 | 49 | let createConnection () = 50 | createConnectionMock 51 | [] 52 | [ 53 | [ col "name"; col "typeName"; col "max_length"; col "precision"; col "scale"; col "is_nullable" ], 54 | [ 55 | [ "userId"; "int"; 4s; 10uy; 0uy; 0uy ] 56 | [ "name"; "nvarchar"; 20s; 0uy; 0uy; 0uy ] 57 | [ "email"; "nvarchar"; 100s; 0uy; 0uy; 0uy ] 58 | [ "created"; "datetime"; 8s; 0uy; 0uy; 0uy ] 59 | ] 60 | ] 61 | 62 | let connector = new Connector(createConnection) 63 | let qb = QueryBuilder(QueryConfig.Default(createConnection)).UseTvpParams() 64 | let query = qb.Timeout(30).Sql( 65 | "insert into User (userId, name, email, created) 66 | select userId, name, email, created from @users", 67 | Params.TableValuedSeq("users"), 68 | Results.Unit) 69 | 70 | 71 | let user = 72 | { 73 | userId = 3 74 | name = "jacentino" 75 | email = "jacentino@gmail.com" 76 | created = DateTime(2023, 1, 1) 77 | } 78 | 79 | query [user] connector |> Async.RunSynchronously 80 | 81 | 82 | [] 83 | let ``Custom converters procedure outparams``() = 84 | 85 | let createConnection() = 86 | setupCommandOutParams 87 | [ "userId", box 1 88 | "name", box "jacentino" 89 | "email", box "jacentino@gmail.com" 90 | "created", box (DateTime(2023, 1, 1)) 91 | "ret_val", box 5 92 | ] 93 | 94 | let connector = new Connector(createConnection) 95 | 96 | let config = QueryConfig.Default(createConnection).AddRowConverter(UserId) 97 | let qb = QueryBuilder(config) 98 | 99 | let query = qb.Proc( 100 | "getUser", 101 | Params.Auto "id", 102 | OutParams.Tuple(OutParams.Return("ret_val"), OutParams.Tuple("userId", "name", "email", "created")), 103 | Results.Unit) 104 | 105 | 106 | let _, (retVal, user) = query 1 connector |> Async.RunSynchronously 107 | 108 | let expected = (UserId 1, "jacentino", "jacentino@gmail.com", DateTime(2023, 1, 1)) 109 | 110 | Assert.Equal(box 5, retVal) 111 | Assert.Equal(expected, user) 112 | 113 | 114 | [] 115 | let ``Custom converters in TVP`` () = 116 | 117 | let createConnection () = 118 | createConnectionMock 119 | [] 120 | [ 121 | [ col "name"; col "typeName"; col "max_length"; col "precision"; col "scale"; col "is_nullable" ], 122 | [ 123 | [ "userId"; "int"; 4s; 10uy; 0uy; 0uy ] 124 | [ "name"; "nvarchar"; 20s; 0uy; 0uy; 0uy ] 125 | [ "email"; "nvarchar"; 100s; 0uy; 0uy; 0uy ] 126 | [ "created"; "datetime"; 8s; 0uy; 0uy; 0uy ] 127 | ] 128 | ] 129 | 130 | let connector = new Connector(createConnection) 131 | let config = QueryConfig.Default(createConnection).UseTvpParams().AddParamConverter(fun (UserId id) -> id) 132 | let qb = QueryBuilder(config) 133 | let query = qb.Timeout(30).Sql( 134 | "insert into User (userId, name, email, created) 135 | select userId, name, email, created from @users", 136 | Params.TableValuedSeq(TVParams.Tuple("userId", "name", "email", "created"), "users", "User"), 137 | Results.Unit) 138 | 139 | let user = (3, "jacentino", "jacentino@gmail.com", DateTime(2023, 1, 1)) 140 | 141 | query [user] connector |> Async.RunSynchronously 142 | -------------------------------------------------------------------------------- /DbFun.MsSql.Tests/TableValuedParamsTests.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.MsSql.Tests 2 | 3 | open System 4 | open System.Data 5 | open Microsoft.Data.SqlClient.Server 6 | open Xunit 7 | open DbFun.MsSql.Builders 8 | open DbFun.TestTools.Models 9 | open DbFun.Core.Builders.GenericSetters 10 | open DbFun.Core.Builders 11 | 12 | module TableValuedParamsTests = 13 | 14 | [] 15 | let ``Simple values``() = 16 | let tvpProvider = BaseSetterProvider(TableValuedParamsImpl.getDefaultBuilders()) 17 | let metadata = [| SqlMetaData("id", SqlDbType.Int) |] 18 | let record = SqlDataRecord(metadata) 19 | let setter = TVParams.Auto("id") (tvpProvider, record) 20 | setter.SetValue(5, None, record) 21 | Assert.Equal(5, record.GetInt32(0)) 22 | 23 | 24 | [] 25 | let ``Char enums``() = 26 | let tvpProvider = BaseSetterProvider(TableValuedParamsImpl.getDefaultBuilders()) 27 | let metadata = [| SqlMetaData("status", SqlDbType.Char, 1) |] 28 | let record = SqlDataRecord(metadata) 29 | let setter = TVParams.Auto("status") (tvpProvider, record) 30 | setter.SetValue(Status.Blocked, None, record) 31 | Assert.Equal("B", record.GetString(0)) 32 | 33 | 34 | [] 35 | let ``Int enums``() = 36 | let tvpProvider = BaseSetterProvider(TableValuedParamsImpl.getDefaultBuilders()) 37 | let metadata = [| SqlMetaData("role", SqlDbType.Int) |] 38 | let record = SqlDataRecord(metadata) 39 | let setter = TVParams.Auto("role") (tvpProvider, record) 40 | setter.SetValue(Role.Regular, None, record) 41 | Assert.Equal(2, record.GetInt32(0)) 42 | 43 | 44 | [] 45 | let ``String enums``() = 46 | let tvpProvider = BaseSetterProvider(TableValuedParamsImpl.getDefaultBuilders()) 47 | let metadata = [| SqlMetaData("access", SqlDbType.VarChar, 2) |] 48 | let record = SqlDataRecord(metadata) 49 | let setter = TVParams.Auto("access") (tvpProvider, record) 50 | setter.SetValue(Access.ReadWrite, None, record) 51 | Assert.Equal("RW", record.GetString(0)) 52 | 53 | 54 | [] 55 | let ``Records``() = 56 | let tvpProvider = BaseSetterProvider(TableValuedParamsImpl.getDefaultBuilders()) 57 | let metadata = 58 | [| 59 | SqlMetaData("userId", SqlDbType.Int) 60 | SqlMetaData("name", SqlDbType.VarChar, 20) 61 | SqlMetaData("email", SqlDbType.VarChar, 100) 62 | SqlMetaData("created", SqlDbType.DateTime) 63 | |] 64 | let record = SqlDataRecord(metadata) 65 | let setter = TVParams.Record() (tvpProvider, record) 66 | let user = 67 | { 68 | User.userId = 3 69 | name = "jacentino" 70 | email = "jacentino@gmail.com" 71 | created = DateTime(2023, 1, 1) 72 | } 73 | setter.SetValue(user, None, record) 74 | Assert.Equal(3, record.GetInt32(0)) 75 | Assert.Equal("jacentino", record.GetString(1)) 76 | Assert.Equal("jacentino@gmail.com", record.GetString(2)) 77 | Assert.Equal(DateTime(2023, 1, 1), record.GetDateTime(3)) 78 | 79 | 80 | [] 81 | let ``Records with overrides``() = 82 | let tvpProvider = BaseSetterProvider(TableValuedParamsImpl.getDefaultBuilders()) 83 | let metadata = 84 | [| 85 | SqlMetaData("id", SqlDbType.Int) 86 | SqlMetaData("name", SqlDbType.VarChar, 20) 87 | SqlMetaData("email", SqlDbType.VarChar, 100) 88 | SqlMetaData("created", SqlDbType.DateTime) 89 | |] 90 | let u = any 91 | let record = SqlDataRecord(metadata) 92 | let setter = TVParams.Record(overrides = [ TVParamOverride(u.userId, TVParams.Auto("id")) ]) (tvpProvider, record) 93 | let user = 94 | { 95 | User.userId = 3 96 | name = "jacentino" 97 | email = "jacentino@gmail.com" 98 | created = DateTime(2023, 1, 1) 99 | } 100 | setter.SetValue(user, None, record) 101 | Assert.Equal(3, record.GetInt32(0)) 102 | Assert.Equal("jacentino", record.GetString(1)) 103 | Assert.Equal("jacentino@gmail.com", record.GetString(2)) 104 | Assert.Equal(DateTime(2023, 1, 1), record.GetDateTime(3)) 105 | 106 | 107 | [] 108 | let ``Tuples``() = 109 | let tvpProvider = BaseSetterProvider(TableValuedParamsImpl.getDefaultBuilders()) 110 | let metadata = 111 | [| 112 | SqlMetaData("userId", SqlDbType.Int) 113 | SqlMetaData("name", SqlDbType.VarChar, 20) 114 | SqlMetaData("email", SqlDbType.VarChar, 100) 115 | |] 116 | let record = SqlDataRecord(metadata) 117 | let setter = TVParams.Tuple("userId", "name", "email") (tvpProvider, record) 118 | let user = 3, "jacentino", "jacentino@gmail.com" 119 | setter.SetValue(user, None, record) 120 | Assert.Equal(3, record.GetInt32(0)) 121 | Assert.Equal("jacentino", record.GetString(1)) 122 | Assert.Equal("jacentino@gmail.com", record.GetString(2)) 123 | -------------------------------------------------------------------------------- /DbFun.MsSql/AssemblyInfo.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.MsSql.AssemblyInfo 2 | 3 | open System.Reflection 4 | open System.Runtime.InteropServices 5 | 6 | // General Information about an assembly is controlled through the following 7 | // set of attributes. Change these attribute values to modify the information 8 | // associated with an assembly. 9 | [] 10 | [] 11 | [] 12 | [] 13 | [] 14 | [] 15 | [] 16 | [] 17 | 18 | // Setting ComVisible to false makes the types in this assembly not visible 19 | // to COM components. If you need to access a type in this assembly from 20 | // COM, set the ComVisible attribute to true on that type. 21 | [] 22 | 23 | // The following GUID is for the ID of the typelib if this project is exposed to COM 24 | [] 25 | 26 | // Version information for an assembly consists of the following four values: 27 | // 28 | // Major Version 29 | // Minor Version 30 | // Build Number 31 | // Revision 32 | // 33 | // You can specify all the values or you can default the Build and Revision Numbers 34 | // by using the '*' as shown below: 35 | // [] 36 | [] 37 | [] 38 | 39 | do 40 | () -------------------------------------------------------------------------------- /DbFun.MsSql/DbFun.MsSql.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | net6.0 5 | true 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | -------------------------------------------------------------------------------- /DbFun.MsSql/OutParams.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.MsSql.Builders 2 | 3 | open System 4 | open DbFun.Core 5 | open DbFun.Core.Builders 6 | open System.Data 7 | 8 | module OutParams = 9 | 10 | type ReturnBuilder() = 11 | 12 | interface OutParamsImpl.IBuilder with 13 | 14 | member __.CanBuild(argType: Type): bool = argType = typeof 15 | 16 | member __.Build(name: string, _, ()): IOutParamGetter<'Result> = 17 | { new IOutParamGetter<'Result> with 18 | member __.Create (command: IDbCommand) = 19 | let param = command.CreateParameter() 20 | param.ParameterName <- name 21 | param.DbType <- DbType.Int32 22 | param.Direction <- ParameterDirection.ReturnValue 23 | command.Parameters.Add param |> ignore 24 | member __.Get(command: IDbCommand): 'Result = 25 | let ordinal = command.Parameters.IndexOf(name) 26 | if ordinal = -1 then 27 | failwithf "Return parameter doesn't exist: %s" name 28 | let param = command.Parameters.[ordinal] :?> IDataParameter 29 | Convert.ChangeType(param.Value, typeof<'Result>) :?> 'Result 30 | member __.IsNull(command: IDbCommand): bool = 31 | let ordinal = command.Parameters.IndexOf(name) 32 | if ordinal = -1 then 33 | failwithf "Return parameter doesn't exist: %s" name 34 | let param = command.Parameters.[ordinal] :?> IDataParameter 35 | param.Value = DBNull.Value 36 | } 37 | 38 | /// 39 | /// Provides methods creating various output parameter builders. 40 | /// 41 | type OutParams() = 42 | inherit Builders.OutParams() 43 | 44 | // TODO: should be possible to solve it better way 45 | static let returnBuilder = OutParams.ReturnBuilder() :> OutParamsImpl.IBuilder 46 | 47 | /// 48 | /// Creates return parameter builder. 49 | /// 50 | /// 51 | /// The return parameter name. 52 | /// 53 | static member Return(name: string): OutParamSpecifier = 54 | fun (provider, _) -> returnBuilder.Build(name, provider, ()) 55 | 56 | /// 57 | /// Creates builder of set of output parameters specified as 'Arg type and return parameter. 58 | /// 59 | /// 60 | /// The retur parameter name. 61 | /// 62 | /// 63 | /// The name or record prefix of output parameters. 64 | /// 65 | static member ReturnAnd<'Arg>(retName: string, ?argName: string): OutParamSpecifier = 66 | fun (provider, _) -> 67 | let retp = fun (provider, ()) -> returnBuilder.Build(retName, provider, ()) 68 | let outp = OutParams.Auto(?name = argName) 69 | let createGetter = OutParams.Tuple(retp, outp) 70 | createGetter(provider, ()) 71 | 72 | 73 | 74 | -------------------------------------------------------------------------------- /DbFun.MsSql/TableValuedParams.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.MsSql.Builders 2 | 3 | open System 4 | open DbFun.Core 5 | open DbFun.Core.Builders 6 | open Microsoft.Data.SqlClient.Server 7 | open System.Linq.Expressions 8 | 9 | type ITVParamSetter<'Arg> = GenericSetters.ISetter 10 | 11 | type ITVParamSetterProvider = GenericSetters.ISetterProvider 12 | 13 | type TVParamSpecifier<'Arg> = ITVParamSetterProvider * SqlDataRecord -> ITVParamSetter<'Arg> 14 | 15 | module TableValuedParamsImpl = 16 | 17 | type IBuilder = GenericSetters.IBuilder 18 | 19 | type SimpleBuilder() = 20 | 21 | static let typedColAccessMethods = 22 | [ 23 | typeof, "SetBoolean" 24 | typeof, "SetByte" 25 | typeof, "SetChar" 26 | typeof, "SetDateTime" 27 | typeof, "SetDecimal" 28 | typeof, "SetDouble" 29 | typeof, "SetFloat" 30 | typeof, "SetGuid" 31 | typeof, "SetInt16" 32 | typeof, "SetInt32" 33 | typeof, "SetInt64" 34 | typeof, "SetString" 35 | ] 36 | |> List.map (fun (t, name) -> t, typeof.GetMethod(name)) 37 | 38 | static let setValueMethod = typeof.GetMethod("SetValue") 39 | 40 | 41 | member __.GetArtificialValue<'Type>(): obj = 42 | if typeof<'Type> = typeof then box "" 43 | elif typeof<'Type> = typeof then box DateTime.Now 44 | elif typeof<'Type> = typeof then box [||] 45 | elif typeof<'Type>.IsClass then null 46 | else box Unchecked.defaultof<'Type> 47 | 48 | interface IBuilder with 49 | 50 | member __.CanBuild (argType: Type) = Types.isSimpleType(argType) 51 | 52 | member this.Build<'Arg> (name: string, _, prototype: SqlDataRecord) = 53 | let ordinal = prototype.GetOrdinal(name) 54 | let fieldType = prototype.GetFieldType(ordinal) 55 | let colSetter = typedColAccessMethods |> List.tryFind (fst >> (=) fieldType) |> Option.map snd |> Option.defaultValue setValueMethod 56 | let recParam = Expression.Parameter(typeof) 57 | let valueParam = Expression.Parameter(typeof<'Arg>) 58 | let convertedValue = 59 | if typeof<'Arg> = typeof then 60 | Expression.New(typeof.GetConstructor([| typeof; typeof |]), valueParam, Expression.Constant(1)) :> Expression 61 | elif typeof<'Arg> <> fieldType then 62 | try 63 | Expression.Convert(valueParam, fieldType) :> Expression 64 | with :? InvalidOperationException as ex -> 65 | raise <| Exception(sprintf "Column type doesn't match field type: %s (%s -> %s)" name valueParam.Type.Name fieldType.Name, ex) 66 | else 67 | valueParam :> Expression 68 | let call = Expression.Call(recParam, colSetter, Expression.Constant(ordinal), convertedValue) 69 | let setter = Expression.Lambda>(call, recParam, valueParam).Compile() 70 | { new ITVParamSetter<'Arg> with 71 | member __.SetValue (value: 'Arg, index: int option, command: SqlDataRecord) = 72 | setter.Invoke(command, value) 73 | member __.SetNull(index: int option, command: SqlDataRecord) = 74 | command.SetDBNull(ordinal) 75 | member __.SetArtificial(index: int option, command: SqlDataRecord) = 76 | command.SetValue(ordinal, this.GetArtificialValue<'Arg>()) 77 | } 78 | 79 | let getDefaultBuilders(): IBuilder list = 80 | SimpleBuilder() :: GenericSetters.getDefaultBuilders() 81 | 82 | /// 83 | /// Provides methods creating various table-valued parameter builders. 84 | /// 85 | type TVParams() = 86 | inherit GenericSetters.GenericSetterBuilder() 87 | 88 | /// 89 | /// The field-to-column of SqlDataRecord mapping override. 90 | /// 91 | type TVParamOverride<'Arg> = GenericSetters.Override 92 | 93 | -------------------------------------------------------------------------------- /DbFun.MySql.IntegrationTests/App.config: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | 6 | -------------------------------------------------------------------------------- /DbFun.MySql.IntegrationTests/Commons.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.MySql.IntegrationTests 2 | 3 | open System.Configuration 4 | open DbFun.Core 5 | open DbFun.Core.Builders 6 | open System.Data 7 | open MySql.Data.MySqlClient 8 | 9 | module Commons = 10 | 11 | let connectionString = 12 | let config = ConfigurationManager.OpenExeConfiguration(System.Reflection.Assembly.GetExecutingAssembly().Location) 13 | config.ConnectionStrings.ConnectionStrings.["DbFunTests"].ConnectionString 14 | 15 | let createConnection (): IDbConnection = 16 | new MySqlConnection(connectionString) 17 | 18 | let config = QueryConfig.Default(createConnection) 19 | 20 | let query = QueryBuilder(config) 21 | 22 | let run dbCall = DbCall.Run(createConnection, dbCall) 23 | -------------------------------------------------------------------------------- /DbFun.MySql.IntegrationTests/Database/DbFunTests.sql: -------------------------------------------------------------------------------- 1 | CREATE DATABASE `dbfuntest` /*!40100 DEFAULT CHARACTER SET utf8mb4 COLLATE utf8mb4_0900_ai_ci */ /*!80016 DEFAULT ENCRYPTION='N' */; 2 | 3 | 4 | CREATE TABLE `blog` ( 5 | `id` int(11) NOT NULL AUTO_INCREMENT, 6 | `name` varchar(50) NOT NULL, 7 | `title` varchar(250) CHARACTER SET utf8 COLLATE utf8_general_ci NOT NULL, 8 | `description` varchar(1000) CHARACTER SET utf8 COLLATE utf8_general_ci DEFAULT NULL, 9 | `owner` varchar(20) NOT NULL, 10 | `createdat` datetime NOT NULL, 11 | `modifiedat` datetime DEFAULT NULL, 12 | `modifiedby` varchar(20) DEFAULT NULL, 13 | PRIMARY KEY (`id`), 14 | UNIQUE KEY `id_UNIQUE` (`id`), 15 | UNIQUE KEY `name_UNIQUE` (`name`), 16 | UNIQUE KEY `title_UNIQUE` (`title`) 17 | ) ENGINE=InnoDB AUTO_INCREMENT=7 DEFAULT CHARSET=utf8mb4 COLLATE=utf8mb4_0900_ai_ci; 18 | 19 | CREATE TABLE `userprofile` ( 20 | `id` varchar(20) CHARACTER SET utf8 COLLATE utf8_general_ci NOT NULL, 21 | `name` varchar(80) CHARACTER SET utf8 COLLATE utf8_general_ci NOT NULL, 22 | `email` varchar(200) CHARACTER SET utf8 COLLATE utf8_general_ci NOT NULL, 23 | `avatar` varbinary(4096) NOT NULL, 24 | PRIMARY KEY (`id`) 25 | ) ENGINE=InnoDB DEFAULT CHARSET=utf8mb4 COLLATE=utf8mb4_0900_ai_ci; 26 | 27 | 28 | DELIMITER $$ 29 | CREATE DEFINER=`root`@`localhost` PROCEDURE `addblog`( id int 30 | , name varchar(50) 31 | , title varchar(250) 32 | , description varchar(1024) 33 | , owner varchar(20) 34 | , createdAt datetime 35 | ) 36 | BEGIN 37 | insert into blog (id, name, title, description, owner, createdAt) 38 | values (id, name, title, description, owner, createdAt); 39 | END$$ 40 | DELIMITER ; 41 | 42 | 43 | DELIMITER $$ 44 | CREATE DEFINER=`root`@`localhost` PROCEDURE `getblog`(blogid int) 45 | BEGIN 46 | select id, name, title, description, owner, createdAt, modifiedAt, modifiedBy from blog where id = blogid; 47 | END$$ 48 | DELIMITER ; 49 | 50 | insert into blog (id, name, title, description, owner, createdAt) 51 | values (1, 'functional-data-access-with-sqlfun', 'Functional data access with SqlFun', 'Designing functional-relational mapper with F#', 'jacentino', '2017-05-28 21:35:00'); 52 | 53 | 54 | -------------------------------------------------------------------------------- /DbFun.MySql.IntegrationTests/DbFun.MySql.IntegrationTests.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | net6.0 5 | 6 | false 7 | false 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | runtime; build; native; contentfiles; analyzers; buildtransitive 26 | all 27 | 28 | 29 | runtime; build; native; contentfiles; analyzers; buildtransitive 30 | all 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | -------------------------------------------------------------------------------- /DbFun.MySql.IntegrationTests/Models.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.MySql.IntegrationTests 2 | 3 | open System 4 | open Commons 5 | 6 | module Models = 7 | 8 | type Comment = { 9 | id: int 10 | postId: int 11 | parentId: int option 12 | content: string 13 | author: string 14 | createdAt: DateTime 15 | replies: Comment list 16 | } 17 | 18 | type Tag = { 19 | postId: int 20 | name: string 21 | } 22 | 23 | type PostStatus = 24 | | New = 'N' 25 | | Published = 'P' 26 | | Archived = 'A' 27 | 28 | type Post = { 29 | id: int 30 | blogId: int 31 | name: string 32 | title: string 33 | content: string 34 | author: string 35 | createdAt: DateTime 36 | modifiedAt: DateTime option 37 | modifiedBy: string option 38 | status: PostStatus 39 | comments: Comment list 40 | tags: Tag list 41 | } 42 | 43 | type Blog = { 44 | id: int 45 | name: string 46 | title: string 47 | description: string 48 | owner: string 49 | createdAt: DateTime 50 | modifiedAt: DateTime option 51 | modifiedBy: string option 52 | posts: Post list 53 | } 54 | 55 | 56 | module Tooling = 57 | 58 | let getNumberOfBlogs = query.Sql("select count(*) from blog") 59 | 60 | let deleteAllButFirstBlog = query.Sql("delete from blog where id > 1") 61 | 62 | -------------------------------------------------------------------------------- /DbFun.MySql.IntegrationTests/Program.fs: -------------------------------------------------------------------------------- 1 | module Program = let [] main _ = 0 2 | -------------------------------------------------------------------------------- /DbFun.MySql.IntegrationTests/TestQueries.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.MySql.IntegrationTests 2 | 3 | open DbFun.Core 4 | open Commons 5 | open Models 6 | 7 | module TestQueries = 8 | 9 | let query = query.LogCompileTimeErrors() 10 | 11 | let getBlog = query.Sql( 12 | "select id, name, title, description, owner, createdAt, modifiedAt, modifiedBy from blog where id = @id", "id") 13 | 14 | let spInsertBlog = query.Proc("addblog", "") >> DbCall.Map fst 15 | 16 | let spGetBlog = query.Proc("getblog", "blogId") >> DbCall.Map fst 17 | 18 | let insertBlog = query.Sql( 19 | "insert into blog (id, name, title, description, owner, createdAt, modifiedAt, modifiedBy) 20 | values (@id, @name, @title, @description, @owner, @createdAt, @modifiedAt, @modifiedBy)") 21 | 22 | let insertBlogAutoInc = query.Sql( 23 | "insert into blog (name, title, description, owner, createdAt, modifiedAt, modifiedBy) 24 | values (@name, @title, @description, @owner, @createdAt, @modifiedAt, @modifiedBy); 25 | select last_insert_id()") 26 | 27 | 28 | -------------------------------------------------------------------------------- /DbFun.MySql.IntegrationTests/Tests.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.MySql.IntegrationTests 2 | 3 | 4 | open System 5 | open Xunit 6 | open Commons 7 | 8 | module Tests = 9 | 10 | let runSync f = run f |> Async.RunSynchronously 11 | 12 | [] 13 | let ``Simple queries to MySql return valid results``() = 14 | let b = TestQueries.getBlog 1 |> runSync 15 | Assert.Equal(1, b.id) 16 | 17 | [] 18 | let ``Stored procedure calls to MySql return valid results``() = 19 | let b = TestQueries.spGetBlog 1 |> runSync 20 | Assert.Equal(1, b.id) 21 | 22 | [] 23 | let ``Stored procedure calls to MySql work as expected``() = 24 | 25 | Tooling.deleteAllButFirstBlog() |> runSync 26 | 27 | TestQueries.spInsertBlog { 28 | id = 4 29 | name = "test-blog-4" 30 | title = "Testing simple insert 4" 31 | description = "Added to check if inserts work properly." 32 | owner = "jacentino" 33 | createdAt = DateTime.Now 34 | modifiedAt = None 35 | modifiedBy = None 36 | posts = [] 37 | } |> runSync 38 | 39 | 40 | [] 41 | let ``Inserts to MySql work as expected``() = 42 | 43 | Tooling.deleteAllButFirstBlog() |> runSync 44 | 45 | TestQueries.insertBlog { 46 | id = 4 47 | name = "test-blog-4" 48 | title = "Testing simple insert 4" 49 | description = "Added to check if inserts work properly." 50 | owner = "jacentino" 51 | createdAt = DateTime.Now 52 | modifiedAt = None 53 | modifiedBy = None 54 | posts = [] 55 | } |> runSync 56 | -------------------------------------------------------------------------------- /DbFun.MySqlConnector.IntegrationTests/App.config: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | 6 | -------------------------------------------------------------------------------- /DbFun.MySqlConnector.IntegrationTests/Commons.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.MySqlConnector.IntegrationTests 2 | 3 | open System.Configuration 4 | open DbFun.Core 5 | open DbFun.Core.Builders 6 | open System.Data 7 | open MySqlConnector 8 | open DbFun.MySqlConnector 9 | 10 | module Commons = 11 | 12 | let connectionString = 13 | let config = ConfigurationManager.OpenExeConfiguration(System.Reflection.Assembly.GetExecutingAssembly().Location) 14 | config.ConnectionStrings.ConnectionStrings.["DbFunTests"].ConnectionString 15 | 16 | let createConnection (): IDbConnection = 17 | new MySqlConnection(connectionString) 18 | 19 | let config = QueryConfig.Default(createConnection) 20 | 21 | let query = QueryBuilder(config) 22 | 23 | let bulkCopy = BulkCopyBuilder() 24 | 25 | let run dbCall = DbCall.Run(createConnection, dbCall) 26 | -------------------------------------------------------------------------------- /DbFun.MySqlConnector.IntegrationTests/Database/DbFunTests.sql: -------------------------------------------------------------------------------- 1 | CREATE DATABASE `dbfuntest` /*!40100 DEFAULT CHARACTER SET utf8mb4 COLLATE utf8mb4_0900_ai_ci */ /*!80016 DEFAULT ENCRYPTION='N' */; 2 | 3 | 4 | CREATE TABLE `blog` ( 5 | `id` int(11) NOT NULL AUTO_INCREMENT, 6 | `name` varchar(50) NOT NULL, 7 | `title` varchar(250) CHARACTER SET utf8 COLLATE utf8_general_ci NOT NULL, 8 | `description` varchar(1000) CHARACTER SET utf8 COLLATE utf8_general_ci DEFAULT NULL, 9 | `owner` varchar(20) NOT NULL, 10 | `createdat` datetime NOT NULL, 11 | `modifiedat` datetime DEFAULT NULL, 12 | `modifiedby` varchar(20) DEFAULT NULL, 13 | PRIMARY KEY (`id`), 14 | UNIQUE KEY `id_UNIQUE` (`id`), 15 | UNIQUE KEY `name_UNIQUE` (`name`), 16 | UNIQUE KEY `title_UNIQUE` (`title`) 17 | ) ENGINE=InnoDB AUTO_INCREMENT=7 DEFAULT CHARSET=utf8mb4 COLLATE=utf8mb4_0900_ai_ci; 18 | 19 | CREATE TABLE `userprofile` ( 20 | `id` varchar(20) CHARACTER SET utf8 COLLATE utf8_general_ci NOT NULL, 21 | `name` varchar(80) CHARACTER SET utf8 COLLATE utf8_general_ci NOT NULL, 22 | `email` varchar(200) CHARACTER SET utf8 COLLATE utf8_general_ci NOT NULL, 23 | `avatar` varbinary(4096) NOT NULL, 24 | PRIMARY KEY (`id`) 25 | ) ENGINE=InnoDB DEFAULT CHARSET=utf8mb4 COLLATE=utf8mb4_0900_ai_ci; 26 | 27 | DELIMITER $$ 28 | CREATE DEFINER=`root`@`localhost` PROCEDURE `addblog`( id int 29 | , name varchar(50) 30 | , title varchar(250) 31 | , description varchar(1024) 32 | , owner varchar(20) 33 | , createdAt datetime 34 | ) 35 | BEGIN 36 | insert into blog (id, name, title, description, owner, createdAt) 37 | values (id, name, title, description, owner, createdAt); 38 | END$$ 39 | DELIMITER ; 40 | 41 | 42 | DELIMITER $$ 43 | CREATE DEFINER=`root`@`localhost` PROCEDURE `getblog`(blogid int) 44 | BEGIN 45 | select id, name, title, description, owner, createdAt, modifiedAt, modifiedBy from blog where id = blogid; 46 | END$$ 47 | DELIMITER ; 48 | 49 | insert into blog (id, name, title, description, owner, createdAt) 50 | values (1, 'functional-data-access-with-sqlfun', 'Functional data access with SqlFun', 'Designing functional-relational mapper with F#', 'jacentino', '2017-05-28 21:35:00'); 51 | 52 | 53 | -------------------------------------------------------------------------------- /DbFun.MySqlConnector.IntegrationTests/DbFun.MySqlConnector.IntegrationTests.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | net6.0 5 | 6 | false 7 | false 8 | 9 | 10 | 11 | 12 | 13 | Always 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | runtime; build; native; contentfiles; analyzers; buildtransitive 30 | all 31 | 32 | 33 | runtime; build; native; contentfiles; analyzers; buildtransitive 34 | all 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | -------------------------------------------------------------------------------- /DbFun.MySqlConnector.IntegrationTests/Models.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.MySqlConnector.IntegrationTests 2 | 3 | open System 4 | open Commons 5 | 6 | module Models = 7 | 8 | type Comment = { 9 | id: int 10 | postId: int 11 | parentId: int option 12 | content: string 13 | author: string 14 | createdAt: DateTime 15 | replies: Comment list 16 | } 17 | 18 | type Tag = { 19 | postId: int 20 | name: string 21 | } 22 | 23 | type PostStatus = 24 | | New = 'N' 25 | | Published = 'P' 26 | | Archived = 'A' 27 | 28 | type Post = { 29 | id: int 30 | blogId: int 31 | name: string 32 | title: string 33 | content: string 34 | author: string 35 | createdAt: DateTime 36 | modifiedAt: DateTime option 37 | modifiedBy: string option 38 | status: PostStatus 39 | comments: Comment list 40 | tags: Tag list 41 | } 42 | 43 | type Blog = { 44 | id: int 45 | name: string 46 | title: string 47 | description: string 48 | owner: string 49 | createdAt: DateTime 50 | modifiedAt: DateTime option 51 | modifiedBy: string option 52 | posts: Post list 53 | } 54 | 55 | 56 | module Tooling = 57 | 58 | let getNumberOfBlogs = query.Sql("select count(*) from blog") 59 | 60 | let deleteAllButFirstBlog = query.Sql("delete from blog where id > 1") 61 | 62 | let deleteAllUsers = query.Sql "delete from userprofile" 63 | -------------------------------------------------------------------------------- /DbFun.MySqlConnector.IntegrationTests/Program.fs: -------------------------------------------------------------------------------- 1 | module Program = let [] main _ = 0 2 | -------------------------------------------------------------------------------- /DbFun.MySqlConnector.IntegrationTests/TestQueries.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.MySqlConnector.IntegrationTests 2 | 3 | open DbFun.Core 4 | open Commons 5 | open Models 6 | open DbFun.MySqlConnector 7 | 8 | module TestQueries = 9 | 10 | let query = query.LogCompileTimeErrors() 11 | 12 | let getBlog = query.Sql( 13 | "select id, name, title, description, owner, createdAt, modifiedAt, modifiedBy from blog where id = @id", "id") 14 | 15 | let spInsertBlog = query.Proc("addblog", "") >> DbCall.Map fst 16 | 17 | let spGetBlog = query.Proc("getblog", "blogId") >> DbCall.Map fst 18 | 19 | let insertBlog = query.Sql( 20 | "insert into blog (id, name, title, description, owner, createdAt, modifiedAt, modifiedBy) 21 | values (@id, @name, @title, @description, @owner, @createdAt, @modifiedAt, @modifiedBy)") 22 | 23 | let insertBlogAutoInc = query.Sql( 24 | "insert into blog (name, title, description, owner, createdAt, modifiedAt, modifiedBy) 25 | values (@name, @title, @description, @owner, @createdAt, @modifiedAt, @modifiedBy); 26 | select last_insert_id()") 27 | 28 | let bulkInsertBlogs = bulkCopy.WriteToServer() 29 | 30 | let bulkInsertUsers = bulkCopy.WriteToServer(BulkCopyParams.Tuple("id", "name", "email", "avatar"), "userprofile") 31 | -------------------------------------------------------------------------------- /DbFun.MySqlConnector.IntegrationTests/Tests.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.MySqlConnector.IntegrationTests 2 | 3 | 4 | open System 5 | open Xunit 6 | open Commons 7 | open System.Diagnostics 8 | open System.IO 9 | open Models 10 | 11 | module Tests = 12 | 13 | let runSync f = run f |> Async.RunSynchronously 14 | 15 | [] 16 | let ``Simple queries to MySql return valid results``() = 17 | let b = TestQueries.getBlog 1 |> runSync 18 | Assert.Equal(1, b.id) 19 | 20 | [] 21 | let ``Stored procedure calls to MySql return valid results``() = 22 | let b = TestQueries.spGetBlog 1 |> runSync 23 | Assert.Equal(1, b.id) 24 | 25 | [] 26 | let ``Stored procedure calls to MySql work as expected``() = 27 | 28 | Tooling.deleteAllButFirstBlog() |> runSync 29 | 30 | TestQueries.spInsertBlog { 31 | id = 4 32 | name = "test-blog-4" 33 | title = "Testing simple insert 4" 34 | description = "Added to check if inserts work properly." 35 | owner = "jacentino" 36 | createdAt = DateTime.Now 37 | modifiedAt = None 38 | modifiedBy = None 39 | posts = [] 40 | } |> runSync 41 | 42 | 43 | [] 44 | let ``Inserts to MySql work as expected``() = 45 | 46 | Tooling.deleteAllButFirstBlog() |> runSync 47 | 48 | TestQueries.insertBlog { 49 | id = 4 50 | name = "test-blog-4" 51 | title = "Testing simple insert 4" 52 | description = "Added to check if inserts work properly." 53 | owner = "jacentino" 54 | createdAt = DateTime.Now 55 | modifiedAt = None 56 | modifiedBy = None 57 | posts = [] 58 | } |> runSync 59 | 60 | [] 61 | let ``BulkCopy inserts records without subrecords``() = 62 | 63 | Tooling.deleteAllButFirstBlog() |> runSync 64 | 65 | let blogsToAdd = 66 | [ for i in 2..200 do 67 | { 68 | id = i 69 | name = sprintf "blog-%d" i 70 | title = sprintf "Blog no %d" i 71 | description = sprintf "Just another blog, added for test - %d" i 72 | owner = "jacenty" 73 | createdAt = System.DateTime.Now 74 | modifiedAt = None 75 | modifiedBy = None 76 | posts = [] 77 | } 78 | ] 79 | 80 | let sw = Stopwatch() 81 | sw.Start() 82 | TestQueries.bulkInsertBlogs blogsToAdd |> runSync |> ignore 83 | sw.Stop() 84 | printfn "Elapsed time %O" sw.Elapsed 85 | 86 | let numOfBlogs = Tooling.getNumberOfBlogs() |> runSync 87 | Tooling.deleteAllButFirstBlog() |> runSync 88 | Assert.Equal(200, numOfBlogs) 89 | 90 | [] 91 | let ``BulkCopy handles byte array fields properly``() = 92 | 93 | Tooling.deleteAllUsers() |> runSync 94 | 95 | let assemblyFolder = Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly().Location) 96 | let users = [ 97 | "jacirru", 98 | "Jacirru Placirru", 99 | "jacirru.placirru@pp.com", 100 | File.ReadAllBytes(Path.Combine(assemblyFolder, "jacenty.jpg")) 101 | ] 102 | TestQueries.bulkInsertUsers users |> runSync 103 | 104 | -------------------------------------------------------------------------------- /DbFun.MySqlConnector.IntegrationTests/jacenty.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jacentino/DbFun/af519e95e7b5b68ddb11a5e5e17c2727c775b296/DbFun.MySqlConnector.IntegrationTests/jacenty.jpg -------------------------------------------------------------------------------- /DbFun.MySqlConnector/AssemblyInfo.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.MySqlConnector.AssemblyInfo 2 | 3 | open System.Reflection 4 | open System.Runtime.InteropServices 5 | 6 | // General Information about an assembly is controlled through the following 7 | // set of attributes. Change these attribute values to modify the information 8 | // associated with an assembly. 9 | [] 10 | [] 11 | [] 12 | [] 13 | [] 14 | [] 15 | [] 16 | [] 17 | 18 | // Setting ComVisible to false makes the types in this assembly not visible 19 | // to COM components. If you need to access a type in this assembly from 20 | // COM, set the ComVisible attribute to true on that type. 21 | [] 22 | 23 | // The following GUID is for the ID of the typelib if this project is exposed to COM 24 | [] 25 | 26 | // Version information for an assembly consists of the following four values: 27 | // 28 | // Major Version 29 | // Minor Version 30 | // Build Number 31 | // Revision 32 | // 33 | // You can specify all the values or you can default the Build and Revision Numbers 34 | // by using the '*' as shown below: 35 | // [] 36 | [] 37 | [] 38 | 39 | do 40 | () -------------------------------------------------------------------------------- /DbFun.MySqlConnector/BulkCopy.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.MySqlConnector 2 | 3 | open DbFun.Core 4 | open DbFun.Core.Builders 5 | open MySqlConnector 6 | open System.Data 7 | open System 8 | 9 | module BulkCopyParamsImpl = 10 | 11 | type IParamSetter<'Arg> = GenericSetters.ISetter 12 | 13 | type IParamSetterProvider = GenericSetters.ISetterProvider 14 | 15 | type ParamSpecifier<'Arg> = IParamSetterProvider * DataTable -> IParamSetter<'Arg> 16 | 17 | type IBuilder = GenericSetters.IBuilder 18 | 19 | type SimpleBuilder() = 20 | 21 | interface IBuilder with 22 | 23 | member __.CanBuild(argType: System.Type): bool = 24 | Types.isSimpleType argType 25 | 26 | member __.Build(name: string, _: IParamSetterProvider, table: DataTable): IParamSetter<'Arg> = 27 | let ordinal = ref 0 28 | { new IParamSetter<'Arg> with 29 | member __.SetValue(value: 'Arg, _: int option, row: DataRow): unit = 30 | row.SetField(ordinal.Value, value) 31 | member __.SetNull(_: int option, row: DataRow): unit = 32 | row.[ordinal.Value] <- DBNull.Value 33 | member __.SetArtificial(_: int option, _: DataRow): unit = 34 | let column = table.Columns.Add(name, typeof<'Arg>) 35 | ordinal.Value <- column.Ordinal 36 | } 37 | 38 | let getDefaultBuilders(): IBuilder list = 39 | SimpleBuilder() :: GenericSetters.getDefaultBuilders() 40 | 41 | 42 | type Converter<'Source, 'Target> = GenericSetters.Converter 43 | 44 | type Configurator<'Config> = GenericSetters.Configurator 45 | 46 | 47 | open BulkCopyParamsImpl 48 | 49 | type BulkCopyParams() = 50 | inherit DbFun.Core.Builders.GenericSetters.GenericSetterBuilder() 51 | 52 | /// 53 | /// Bulk copy config. 54 | /// 55 | type BulkCopyConfig = 56 | { 57 | ParamBuilders : IBuilder list 58 | } 59 | with 60 | /// 61 | /// Adds a converter mapping application values of a given type to ptoper database parameter values. 62 | /// 63 | /// 64 | /// Function converting application values to database parameter values. 65 | /// 66 | member this.AddConverter(convert: 'Source -> 'Target) = 67 | { this with 68 | ParamBuilders = 69 | BulkCopyParamsImpl.Converter<'Source, 'Target>(convert) :: 70 | this.ParamBuilders 71 | } 72 | 73 | /// 74 | /// Adds a configurator for parameter builders of types determined by CanBuild function. 75 | /// 76 | /// 77 | /// Creates a configuration object. 78 | /// 79 | /// 80 | /// Function determining whether a given type is handled by the configurator. 81 | /// 82 | member this.AddConfigurator(getConfig: string -> 'Config, canBuild: Type -> bool) = 83 | { this with 84 | ParamBuilders = BulkCopyParamsImpl.Configurator<'Config>(getConfig, canBuild) :: this.ParamBuilders 85 | } 86 | 87 | 88 | /// 89 | /// Provides methods creating bulk import functions. 90 | /// 91 | type BulkCopyBuilder<'DbKey>(dbKey: 'DbKey, ?config: BulkCopyConfig) = 92 | 93 | let builders = defaultArg (config |> Option.map (fun c -> c.ParamBuilders)) (getDefaultBuilders()) 94 | 95 | /// 96 | /// Generates a function performing bulk import. 97 | /// 98 | /// 99 | /// The target table name. 100 | /// 101 | /// 102 | /// The parameter builder. 103 | /// 104 | member __.WriteToServer<'Record>(specifier: ParamSpecifier<'Record>, ?tableName: string): 'Record seq -> DbCall<'DbKey, MySqlBulkCopyResult> = 105 | let dataTable = new DataTable() 106 | let provider = GenericSetters.BaseSetterProvider(builders) 107 | let setter = specifier(provider, dataTable) 108 | setter.SetArtificial(None, null) 109 | fun (records: 'Record seq) (connector: IConnector<'DbKey>) -> 110 | let dataRow = dataTable.NewRow() 111 | async { 112 | let rows = 113 | seq { 114 | for r in records do 115 | setter.SetValue(r, None, dataRow) 116 | yield dataRow 117 | } 118 | let bulkCopy = new MySqlBulkCopy(connector.GetConnection(dbKey) :?> MySqlConnection, connector.GetTransaction(dbKey) :?> MySqlTransaction) 119 | bulkCopy.DestinationTableName <- defaultArg tableName typeof<'Record>.Name 120 | return bulkCopy.WriteToServer(rows, dataTable.Columns.Count) 121 | } 122 | 123 | /// 124 | /// Generates a function performing bulk import. 125 | /// 126 | /// 127 | /// The target table name. 128 | /// 129 | /// 130 | /// The builder name argument. 131 | /// 132 | member this.WriteToServer<'Record>(?name: string, ?tableName: string): 'Record seq -> DbCall<'DbKey, MySqlBulkCopyResult> = 133 | this.WriteToServer(BulkCopyParams.Auto<'Record>(?name = name), ?tableName = tableName) 134 | 135 | 136 | /// 137 | /// Provides methods creating bulk import functions. 138 | /// 139 | type BulkCopyBuilder(?config: BulkCopyConfig) = 140 | inherit BulkCopyBuilder((), ?config = config) 141 | -------------------------------------------------------------------------------- /DbFun.MySqlConnector/DbFun.MySqlConnector.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | net6.0 5 | true 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | -------------------------------------------------------------------------------- /DbFun.Npgsql.IntegrationTests/App.config: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | -------------------------------------------------------------------------------- /DbFun.Npgsql.IntegrationTests/Commons.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Npgsql.IntegrationTests 2 | 3 | open System.Configuration 4 | open DbFun.Core 5 | open DbFun.Npgsql.Builders 6 | open System.Data 7 | open Npgsql 8 | 9 | module Commons = 10 | 11 | let connectionString = 12 | let config = ConfigurationManager.OpenExeConfiguration(System.Reflection.Assembly.GetExecutingAssembly().Location) 13 | config.ConnectionStrings.ConnectionStrings.["DbFunTests"].ConnectionString 14 | 15 | let createConnection (): IDbConnection = new NpgsqlConnection(connectionString) 16 | 17 | let config = QueryConfig.Default(createConnection).UsePostgresArrays() 18 | 19 | let query = QueryBuilder(config) 20 | 21 | let bulkImport = BulkImportBuilder() 22 | 23 | let run dbCall = DbCall.Run(createConnection, dbCall) 24 | -------------------------------------------------------------------------------- /DbFun.Npgsql.IntegrationTests/DbFun.Npgsql.IntegrationTests.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | net6.0 5 | 6 | false 7 | false 8 | 9 | 10 | 11 | 12 | 13 | Always 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | runtime; build; native; contentfiles; analyzers; buildtransitive 30 | all 31 | 32 | 33 | runtime; build; native; contentfiles; analyzers; buildtransitive 34 | all 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | -------------------------------------------------------------------------------- /DbFun.Npgsql.IntegrationTests/Models.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Npgsql.IntegrationTests 2 | 3 | open System 4 | open Commons 5 | 6 | module Models = 7 | 8 | type PostStatus = 9 | | New = 'N' 10 | | Published = 'P' 11 | | Archived = 'A' 12 | 13 | type Post = { 14 | postId: int 15 | blogId: int 16 | name: string 17 | title: string 18 | content: string 19 | author: string 20 | createdAt: DateTime 21 | modifiedAt: DateTime option 22 | modifiedBy: string option 23 | status: PostStatus 24 | } 25 | 26 | type Blog = { 27 | blogId: int 28 | name: string 29 | title: string 30 | description: string 31 | owner: string 32 | createdAt: DateTime 33 | modifiedAt: DateTime option 34 | modifiedBy: string option 35 | posts: Post list 36 | } 37 | 38 | 39 | module Tooling = 40 | 41 | let getNumberOfBlogs = query.Sql "select count(*) from blog" 42 | 43 | let deleteAllButFirstBlog = 44 | query.Sql "delete from blog where blogid > 1" 45 | 46 | let deleteAllUsers = 47 | query.Sql "delete from userprofile" 48 | -------------------------------------------------------------------------------- /DbFun.Npgsql.IntegrationTests/Program.fs: -------------------------------------------------------------------------------- 1 | module Program = let [] main _ = 0 2 | -------------------------------------------------------------------------------- /DbFun.Npgsql.IntegrationTests/TestQueries.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Npgsql.IntegrationTests 2 | 3 | open System 4 | open DbFun.Core 5 | open DbFun.Npgsql.Builders 6 | open Commons 7 | open Models 8 | open DbFun.TestTools.Models 9 | open DbFun.Core.Builders 10 | 11 | module TestQueries = 12 | 13 | let query = query.LogCompileTimeErrors() 14 | 15 | let getBlog = query.Sql("select blogid, name, title, description, owner, createdAt, modifiedAt, modifiedBy from blog where blogid = @id", "id") 16 | 17 | let fnGetBlog = query.Sql("select * from getblog(@id)", "id") 18 | 19 | let getPosts= query.Sql( 20 | "select p.postid, p.blogId, p.name, p.title, p.content, p.author, p.createdAt, p.modifiedAt, p.modifiedBy, p.status 21 | from post p join unnest(@ids) ids on p.postid = ids", 22 | "ids") 23 | 24 | let insertBlog = query.Sql( 25 | "insert into blog (blogid, name, title, description, owner, createdAt, modifiedAt, modifiedBy) 26 | values (@blogId, @name, @title, @description, @owner, @createdAt, @modifiedAt, @modifiedBy)") 27 | 28 | let insertBlogAutoInc = query.Sql( 29 | "insert into blog (blogid, name, title, description, owner, createdAt, modifiedAt, modifiedBy) 30 | values (2, @name, @title, @description, @owner, @createdAt, @modifiedAt, @modifiedBy); 31 | select 2") 32 | 33 | let insertBlogs = query.Sql( 34 | "insert into blog (blogid, name, title, description, owner, createdAt, modifiedAt, modifiedBy) 35 | select * from unnest(@blogId, @name, @title, @description, @owner, @createdAt, @modifiedAt, @modifiedBy)") 36 | 37 | let bulkInsertBlogs = bulkImport.WriteToServer() 38 | 39 | let bulkInsertUsers = bulkImport.WriteToServer(BulkImportParams.Tuple("id", "name", "email", "avatar"), "userprofile") 40 | 41 | let getIntArray = query.Sql("select array[1, 2, 3]") 42 | 43 | let getCharArray = query.Sql("select array['A', 'B', 'C']") 44 | 45 | let getStringArray = query.Sql("select array['A', 'B', 'C']") 46 | 47 | let getDecimalArray = query.Sql("select array[1, 2, 3]") 48 | 49 | let getIntList = query.Sql("select array[1, 2, 3]") 50 | 51 | let getIntSeq = query.Sql("select array[1, 2, 3]") 52 | 53 | let getCharEnumList = query.Sql("select array['N', 'P', 'A']") 54 | 55 | let getUnionEnumList = query.Sql("select array['RD', 'WR']") 56 | 57 | let getDateOnlySeq = query.Sql("select array[TIMESTAMP '2004-10-19 00:00:00+02']") 58 | 59 | let getIntArrayExplicit = query.Sql("select array[1, 2, 3]", Params.Unit, Results.Single(Rows.PgArray(""))) 60 | 61 | let getIntListExplicit = query.Sql("select array[1, 2, 3]", Params.Unit, Results.Single(Rows.PgList(""))) 62 | 63 | let getIntArrayHalfExplicit = query.Sql("select array[1, 2, 3]", Params.Unit, Results.Single("")) 64 | 65 | let getIntListHalfExplicit = query.Sql("select array[1, 2, 3]", Params.Unit, Results.Single("")) 66 | -------------------------------------------------------------------------------- /DbFun.Npgsql.IntegrationTests/Tests.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Npgsql.IntegrationTests 2 | 3 | open System 4 | open System.IO 5 | open System.Diagnostics 6 | open Xunit 7 | open Commons 8 | open Models 9 | open DbFun.TestTools.Models 10 | 11 | module Tests = 12 | 13 | let runSync f = run f |> Async.RunSynchronously 14 | 15 | [] 16 | let ``TestQueries passes compile-time checks``() = 17 | Assert.True(TestQueries.query.CompileTimeErrors.IsEmpty, sprintf "%A" TestQueries.query.CompileTimeErrors) 18 | 19 | [] 20 | let ``Simple queries to PostgreSQL return valid results``() = 21 | let b = TestQueries.getBlog 1 |> runSync 22 | Assert.Equal(1, b.blogId) 23 | 24 | [] 25 | let ``Queries using PostgreSQL arrays return valid results``() = 26 | let posts = TestQueries.getPosts [ 1; 2 ] |> runSync 27 | Assert.Equal([ 1; 2 ], posts |> List.map (fun p -> p.postId)) 28 | 29 | [] 30 | let ``Function calls to PostgreSQL return valid results``() = 31 | let b = TestQueries.fnGetBlog 1 |> runSync 32 | Assert.Equal(1, b.blogId) 33 | 34 | [] 35 | let ``Inserts to PostgrSQL work as expected``() = 36 | 37 | Tooling.deleteAllButFirstBlog() |> runSync 38 | 39 | TestQueries.insertBlog { 40 | blogId = 4 41 | name = "test-blog-4" 42 | title = "Testing simple insert 4" 43 | description = "Added to check if inserts work properly." 44 | owner = "jacentino" 45 | createdAt = DateTime.Now 46 | modifiedAt = None 47 | modifiedBy = None 48 | posts = [] 49 | } |> runSync 50 | 51 | [] 52 | let ``BulkImport inserts records without subrecords``() = 53 | 54 | Tooling.deleteAllButFirstBlog() |> runSync 55 | 56 | let blogsToAdd = 57 | [ for i in 2..200 do 58 | { 59 | blogId = i 60 | name = sprintf "blog-%d" i 61 | title = sprintf "Blog no %d" i 62 | description = sprintf "Just another blog, added for test - %d" i 63 | owner = "jacenty" 64 | createdAt = System.DateTime.Now 65 | modifiedAt = None 66 | modifiedBy = None 67 | posts = [] 68 | } 69 | ] 70 | 71 | let sw = Stopwatch() 72 | sw.Start() 73 | TestQueries.bulkInsertBlogs blogsToAdd |> runSync 74 | sw.Stop() 75 | printfn "Elapsed time %O" sw.Elapsed 76 | 77 | let numOfBlogs = Tooling.getNumberOfBlogs() |> runSync 78 | Tooling.deleteAllButFirstBlog() |> runSync 79 | Assert.Equal(200, numOfBlogs) 80 | 81 | 82 | [] 83 | let ``PostgreSQL array can be used to insert records``() = 84 | 85 | Tooling.deleteAllButFirstBlog() |> runSync 86 | 87 | let blogsToAdd = 88 | [ for i in 2..200 do 89 | { 90 | blogId = i 91 | name = sprintf "blog-%d" i 92 | title = sprintf "Blog no %d" i 93 | description = sprintf "Just another blog, added for test - %d" i 94 | owner = "jacenty" 95 | createdAt = System.DateTime.Now 96 | modifiedAt = Some System.DateTime.Now 97 | modifiedBy = Some "jacenty" 98 | posts = [] 99 | } 100 | ] 101 | 102 | let sw = Stopwatch() 103 | sw.Start() 104 | TestQueries.insertBlogs blogsToAdd |> runSync 105 | sw.Stop() 106 | printfn "Elapsed time %O" sw.Elapsed 107 | 108 | let numOfBlogs = Tooling.getNumberOfBlogs() |> runSync 109 | Tooling.deleteAllButFirstBlog() |> runSync 110 | Assert.Equal(200, numOfBlogs) 111 | 112 | 113 | [] 114 | let ``BulkImport handles byte array fields properly``() = 115 | 116 | Tooling.deleteAllUsers() |> runSync 117 | 118 | let assemblyFolder = Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly().Location) 119 | let users = [ 120 | "jacirru", 121 | "Jacirru Placirru", 122 | "jacirru.placirru@pp.com", 123 | File.ReadAllBytes(Path.Combine(assemblyFolder, "jacenty.jpg")) 124 | ] 125 | TestQueries.bulkInsertUsers users |> runSync 126 | 127 | [] 128 | let ``Int array``() = 129 | let value = TestQueries.getIntArray() |> runSync 130 | Assert.Equal([[| 1; 2; 3 |]], value) 131 | 132 | [] 133 | let ``Char array``() = 134 | let value = TestQueries.getCharArray() |> runSync 135 | Assert.Equal([[| 'A'; 'B'; 'C' |]], value) 136 | 137 | [] 138 | let ``String array``() = 139 | let value = TestQueries.getStringArray() |> runSync 140 | Assert.Equal([[| "A"; "B"; "C" |]], value) 141 | 142 | [] 143 | let ``Decimal array``() = 144 | let value = TestQueries.getDecimalArray() |> runSync 145 | Assert.Equal([[| 1m; 2m; 3m |]], value) 146 | 147 | [] 148 | let ``Int list``() = 149 | let value = TestQueries.getIntList() |> runSync 150 | Assert.Equal([[ 1; 2; 3 ]], value) 151 | 152 | [] 153 | let ``Int seq``() = 154 | let value = TestQueries.getIntSeq() |> runSync 155 | Assert.Equal([seq{ 1; 2; 3 }], value) 156 | 157 | [] 158 | let ``Char enum list``() = 159 | let value = TestQueries.getCharEnumList() |> runSync 160 | Assert.Equal([[ PostStatus.New; PostStatus.Published; PostStatus.Archived ]], value) 161 | 162 | [] 163 | let ``Union enum list``() = 164 | let value = TestQueries.getUnionEnumList() |> runSync 165 | Assert.Equal([[ Access.Read; Access.Write ]], value) 166 | 167 | [] 168 | let ``DateOnly seq``() = 169 | let value = TestQueries.getDateOnlySeq() |> runSync 170 | Assert.Equal([seq { DateOnly(2004, 10, 19) }], value) 171 | 172 | [] 173 | let ``Int array explicit``() = 174 | let value = TestQueries.getIntArrayExplicit() |> runSync 175 | Assert.Equal([| 1; 2; 3 |], value) 176 | 177 | [] 178 | let ``Int list explicit``() = 179 | let value = TestQueries.getIntListExplicit() |> runSync 180 | Assert.Equal([ 1; 2; 3 ], value) 181 | 182 | [] 183 | let ``Int array half-explicit``() = 184 | let value = TestQueries.getIntArrayHalfExplicit() |> runSync 185 | Assert.Equal([| 1; 2; 3 |], value) 186 | 187 | [] 188 | let ``Int list half-explicit``() = 189 | let value = TestQueries.getIntListHalfExplicit() |> runSync 190 | Assert.Equal([ 1; 2; 3 ], value) 191 | 192 | 193 | [] 194 | let ``Array column type``() = 195 | use connection = createConnection() 196 | connection.Open() 197 | use command = connection.CreateCommand() 198 | command.CommandText <- "select array[TIMESTAMP '2004-10-19 10:23:54+02']" 199 | let param = command.CreateParameter() 200 | param.ParameterName <- "item" 201 | param.Value <- TimeSpan.FromHours(1.0) 202 | command.Parameters.Add(param) |> ignore 203 | use reader = command.ExecuteReader() 204 | let fieldType = reader.GetFieldType(0) 205 | let schema = reader.GetSchemaTable() 206 | let typeName = schema.Rows[0][24] 207 | reader.Read() |> ignore 208 | let value = reader.GetValue(0) 209 | let array = value :?> Array 210 | let display = sprintf "%A: %A" value fieldType 211 | Console.WriteLine(display) 212 | -------------------------------------------------------------------------------- /DbFun.Npgsql.IntegrationTests/jacenty.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jacentino/DbFun/af519e95e7b5b68ddb11a5e5e17c2727c775b296/DbFun.Npgsql.IntegrationTests/jacenty.jpg -------------------------------------------------------------------------------- /DbFun.Npgsql/AssemblyInfo.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Npgsql.AssemblyInfo 2 | 3 | open System.Reflection 4 | open System.Runtime.InteropServices 5 | 6 | // General Information about an assembly is controlled through the following 7 | // set of attributes. Change these attribute values to modify the information 8 | // associated with an assembly. 9 | [] 10 | [] 11 | [] 12 | [] 13 | [] 14 | [] 15 | [] 16 | [] 17 | 18 | // Setting ComVisible to false makes the types in this assembly not visible 19 | // to COM components. If you need to access a type in this assembly from 20 | // COM, set the ComVisible attribute to true on that type. 21 | [] 22 | 23 | // The following GUID is for the ID of the typelib if this project is exposed to COM 24 | [] 25 | 26 | // Version information for an assembly consists of the following four values: 27 | // 28 | // Major Version 29 | // Minor Version 30 | // Build Number 31 | // Revision 32 | // 33 | // You can specify all the values or you can default the Build and Revision Numbers 34 | // by using the '*' as shown below: 35 | // [] 36 | [] 37 | [] 38 | 39 | do 40 | () -------------------------------------------------------------------------------- /DbFun.Npgsql/BulkImport.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Npgsql.Builders 2 | 3 | open System 4 | open Npgsql 5 | open DbFun.Core 6 | open DbFun.Core.Builders 7 | 8 | module BulkImportParamsImpl = 9 | 10 | type IParamSetter<'Arg> = GenericSetters.ISetter 11 | 12 | type IParamSetterProvider = GenericSetters.ISetterProvider 13 | 14 | type ParamSpecifier<'Arg> = IParamSetterProvider * string list ref -> IParamSetter<'Arg> 15 | 16 | type IBuilder = GenericSetters.IBuilder 17 | 18 | type SimpleBuilder() = 19 | 20 | interface IBuilder with 21 | 22 | member __.CanBuild(argType: System.Type): bool = 23 | Types.isSimpleType argType 24 | 25 | member this.Build(name: string, _: IParamSetterProvider, names: string list ref): IParamSetter<'Arg> = 26 | { new IParamSetter<'Arg> with 27 | member __.SetValue(value: 'Arg, _: int option, importer: NpgsqlBinaryImporter): unit = 28 | importer.Write(value) 29 | member __.SetNull(_: int option, importer: NpgsqlBinaryImporter): unit = 30 | importer.WriteNull() 31 | member __.SetArtificial(_: int option, _: NpgsqlBinaryImporter): unit = 32 | names.Value <- name :: names.Value 33 | } 34 | 35 | let getDefaultBuilders(): IBuilder list = 36 | SimpleBuilder() :: GenericSetters.getDefaultBuilders() 37 | 38 | 39 | type Converter<'Source, 'Target> = GenericSetters.Converter 40 | 41 | type Configurator<'Config> = GenericSetters.Configurator 42 | 43 | 44 | open BulkImportParamsImpl 45 | 46 | type BulkImportParams() = 47 | inherit DbFun.Core.Builders.GenericSetters.GenericSetterBuilder() 48 | 49 | /// 50 | /// Bulk import config. 51 | /// 52 | type BulkImportConfig = 53 | { 54 | ParamBuilders : IBuilder list 55 | } 56 | with 57 | /// 58 | /// Adds a converter mapping application values of a given type to ptoper database parameter values. 59 | /// 60 | /// 61 | /// Function converting application values to database parameter values. 62 | /// 63 | member this.AddConverter(convert: 'Source -> 'Target) = 64 | { this with 65 | ParamBuilders = 66 | BulkImportParamsImpl.Converter<'Source, 'Target>(convert) :: 67 | this.ParamBuilders 68 | } 69 | 70 | /// 71 | /// Adds a configurator for parameter builders of types determined by canBuild function. 72 | /// 73 | /// 74 | /// Creates a configuration object. 75 | /// 76 | /// 77 | /// Function determining whether a given type is handled by the configurator. 78 | /// 79 | member this.AddConfigurator(getConfig: string -> 'Config, canBuild: Type -> bool) = 80 | { this with 81 | ParamBuilders = BulkImportParamsImpl.Configurator<'Config>(getConfig, canBuild) :: this.ParamBuilders 82 | } 83 | 84 | /// 85 | /// Provides methods creating bulk import functions. 86 | /// 87 | type BulkImportBuilder<'DbKey>(dbKey: 'DbKey, ?config: BulkImportConfig) = 88 | 89 | let builders = defaultArg (config |> Option.map (fun c -> c.ParamBuilders)) (getDefaultBuilders()) 90 | 91 | /// 92 | /// Generates a function performing bulk import. 93 | /// 94 | /// 95 | /// The target table name. 96 | /// 97 | /// 98 | /// The parameter builder. 99 | /// 100 | member __.WriteToServer<'Record>(specifier: ParamSpecifier<'Record>, ?tableName: string): 'Record seq -> DbCall<'DbKey, unit> = 101 | let fieldNames = ref List.empty 102 | let provider = GenericSetters.BaseSetterProvider(builders) 103 | let setter = specifier(provider, fieldNames) 104 | setter.SetArtificial(None, null) 105 | let copyCommand = 106 | sprintf "COPY %s (%s) FROM STDIN (FORMAT BINARY)" 107 | (defaultArg tableName (typeof<'Record>.Name.ToLower())) 108 | (fieldNames.Value |> List.rev |> String.concat ", ") 109 | fun (records: 'Record seq) (connector: IConnector<'DbKey>) -> 110 | let npgcon = connector.GetConnection(dbKey) :?> NpgsqlConnection 111 | async { 112 | let! token = Async.CancellationToken 113 | use importer = npgcon.BeginBinaryImport(copyCommand) 114 | for r in records do 115 | do! importer.StartRowAsync(token) |> Async.AwaitTask 116 | setter.SetValue(r, None, importer) 117 | do! importer.CompleteAsync(token).AsTask() |> Async.AwaitTask |> Async.Ignore 118 | } 119 | 120 | /// 121 | /// Generates a function performing bulk import. 122 | /// 123 | /// 124 | /// The target table name. 125 | /// 126 | /// 127 | /// The builder name argument. 128 | /// 129 | member this.WriteToServer<'Record>(?name: string, ?tableName: string): 'Record seq -> DbCall<'DbKey, unit> = 130 | this.WriteToServer(BulkImportParams.Auto<'Record>(?name = name), ?tableName = tableName) 131 | 132 | 133 | /// 134 | /// Provides methods creating bulk import functions. 135 | /// 136 | type BulkImportBuilder(?config: BulkImportConfig) = 137 | inherit BulkImportBuilder((), ?config = config) 138 | -------------------------------------------------------------------------------- /DbFun.Npgsql/DbFun.Npgsql.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | net6.0 5 | true 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | -------------------------------------------------------------------------------- /DbFun.Npgsql/PgArrayParams.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Npgsql.Builders 2 | 3 | open System 4 | open System.Collections.Generic 5 | open NpgsqlTypes 6 | open DbFun.Core 7 | open DbFun.Core.Builders 8 | 9 | type MultipleArrays = 10 | { 11 | ArraySize : int 12 | Data : IDictionary 13 | } 14 | 15 | type IArrayParamSetter<'Arg> = GenericSetters.ISetter 16 | 17 | type IArrayParamSetterProvider = GenericSetters.ISetterProvider 18 | 19 | type ArrayParamSpecifier<'Arg> = IArrayParamSetterProvider * unit -> IArrayParamSetter<'Arg> 20 | 21 | module PgArrayParamsImpl = 22 | 23 | type IBuilder = GenericSetters.IBuilder 24 | 25 | type SimpleBuilder() = 26 | 27 | let getNpgSqlDbType t = 28 | if t = typeof then NpgsqlDbType.Integer 29 | elif t = typeof then NpgsqlDbType.Bigint 30 | elif t = typeof then NpgsqlDbType.Smallint 31 | elif t = typeof then NpgsqlDbType.Boolean 32 | elif t = typeof then NpgsqlDbType.Numeric 33 | elif t = typeof then NpgsqlDbType.Timestamp 34 | elif t = typeof then NpgsqlDbType.Interval 35 | elif t = typeof then NpgsqlDbType.Uuid 36 | elif t = typeof then NpgsqlDbType.Char 37 | elif t = typeof then NpgsqlDbType.Varchar 38 | elif t = typeof then NpgsqlDbType.Double 39 | elif t = typeof then NpgsqlDbType.Bytea 40 | else failwith <| sprintf "Unmappable type: %O" t 41 | 42 | let getArray(arrays: MultipleArrays, name: string): 'Item array = 43 | match arrays.Data.TryGetValue(name) with 44 | | true, (_, array) -> 45 | array :?> 'Item array 46 | | false, _ -> 47 | let array = Array.zeroCreate arrays.ArraySize 48 | arrays.Data.Add(name, (getNpgSqlDbType typeof<'Item>, array)) 49 | array 50 | 51 | member __.GetArtificialValue<'Type>(): obj = 52 | if typeof<'Type> = typeof then box "" 53 | elif typeof<'Type> = typeof then box DateTime.Now 54 | elif typeof<'Type> = typeof then box [||] 55 | elif typeof<'Type>.IsClass then null 56 | else box Unchecked.defaultof<'Type> 57 | 58 | interface IBuilder with 59 | 60 | member __.CanBuild (argType: Type) = Types.isSimpleType(argType) 61 | 62 | member this.Build<'Arg> (name: string, _, _: unit) = 63 | { new IArrayParamSetter<'Arg> with 64 | member __.SetValue (value: 'Arg, index: int option, arrays: MultipleArrays) = 65 | let array = getArray(arrays, name) 66 | array[index.Value] <- value 67 | member __.SetNull(index: int option, arrays: MultipleArrays) = 68 | match index with 69 | | None -> arrays.Data[name] <- (getNpgSqlDbType typeof<'Arg>), DBNull.Value 70 | | Some _ -> failwithf "Null array items are not allowed: %s: %A" name typeof<'Arg> 71 | member __.SetArtificial(_: int option, arrays: MultipleArrays) = 72 | let array = getArray(arrays, name) 73 | array[0] <- this.GetArtificialValue<'Arg>() :?> 'Arg 74 | } 75 | 76 | let getDefaultBuilders(): IBuilder list = 77 | SimpleBuilder() :: GenericSetters.getDefaultBuilders() 78 | 79 | /// 80 | /// Provides methods creating various Postgres array parameter builders. 81 | /// 82 | type PgArrayParams() = 83 | inherit GenericSetters.GenericSetterBuilder() 84 | 85 | /// 86 | /// The field-to-array mapping override. 87 | /// 88 | type PgArrayParamOverride<'Arg> = GenericSetters.Override 89 | 90 | -------------------------------------------------------------------------------- /DbFun.OracleManaged.IntegrationTests/App.config: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | 6 | 7 | -------------------------------------------------------------------------------- /DbFun.OracleManaged.IntegrationTests/Commons.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.OracleManaged.IntegrationTests 2 | 3 | open System.Configuration 4 | open DbFun.Core 5 | open DbFun.OracleManaged.Builders 6 | open System.Data 7 | open Oracle.ManagedDataAccess.Client 8 | 9 | module Commons = 10 | 11 | let connectionString = 12 | let config = ConfigurationManager.OpenExeConfiguration(System.Reflection.Assembly.GetExecutingAssembly().Location) 13 | config.ConnectionStrings.ConnectionStrings.["DbFunTests"].ConnectionString 14 | 15 | let createConnection(): IDbConnection = new OracleConnection(connectionString) 16 | 17 | let config = QueryConfig.Default(createConnection).UseOracleArrayParams() 18 | let query = QueryBuilder(config) 19 | 20 | let bulkCopy = BulkCopyBuilder() 21 | 22 | let run dbCall = DbCall.Run(createConnection, dbCall) 23 | 24 | 25 | 26 | -------------------------------------------------------------------------------- /DbFun.OracleManaged.IntegrationTests/DbFun.OracleManaged.IntegrationTests.fsproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | net6.0 5 | 6 | false 7 | false 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | runtime; build; native; contentfiles; analyzers; buildtransitive 25 | all 26 | 27 | 28 | runtime; build; native; contentfiles; analyzers; buildtransitive 29 | all 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | -------------------------------------------------------------------------------- /DbFun.OracleManaged.IntegrationTests/Models.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.OracleManaged.IntegrationTests 2 | 3 | open System 4 | open Commons 5 | 6 | module Models = 7 | 8 | type Blog = { 9 | blogId: int 10 | name: string 11 | title: string 12 | description: string 13 | owner: string 14 | createdAt: DateTime 15 | modifiedAt: DateTime option 16 | modifiedBy: string option 17 | } 18 | 19 | module Tooling = 20 | 21 | let deleteAllButFirstBlog = 22 | query.Sql("delete from blog where blogid > 1") 23 | 24 | 25 | 26 | 27 | -------------------------------------------------------------------------------- /DbFun.OracleManaged.IntegrationTests/Program.fs: -------------------------------------------------------------------------------- 1 | module Program = let [] main _ = 0 2 | -------------------------------------------------------------------------------- /DbFun.OracleManaged.IntegrationTests/TestQueries.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.OracleManaged.IntegrationTests 2 | 3 | open System 4 | open DbFun.Core 5 | open DbFun.Core.Builders 6 | open Commons 7 | open Models 8 | 9 | module TestQueries = 10 | 11 | let getBlog = 12 | query.Sql("select blogid, name, title, description, owner, createdAt, modifiedAt, modifiedBy from blog where blogid = :blogid", "blogId") 13 | 14 | let insertBlog = 15 | query.DisablePrototypeCalls().Sql( 16 | "insert into blog (blogid, name, title, description, owner, createdAt, modifiedAt, modifiedBy) 17 | values (:blogId, :name, :title, :description, :owner, :createdAt, :modifiedAt, :modifiedBy)") 18 | 19 | let insertBlogsWithArrays = 20 | query.DisablePrototypeCalls().Sql( 21 | "insert into blog (blogid, name, title, description, owner, createdAt) 22 | values (:blogid, :name, :title, :description, :owner, :createdAt)") 23 | 24 | let insertBlogsWithBulkCopy = bulkCopy.WriteToServer() 25 | 26 | let insertBlogProc = 27 | query.DisablePrototypeCalls().Proc("sp_add_blog", 28 | Params.Int("blogId"), 29 | Params.Tuple("name", "title", "description", "owner", "createdAt"), 30 | OutParams.Unit, 31 | Results.Unit) 32 | >> (fun f id -> f id |> DbCall.Map fst) 33 | 34 | -------------------------------------------------------------------------------- /DbFun.OracleManaged.IntegrationTests/Tests.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.OracleManaged.IntegrationTests 2 | 3 | open System 4 | open Xunit 5 | open Commons 6 | 7 | module Tests = 8 | 9 | let runSync f = run f |> Async.RunSynchronously 10 | 11 | [] 12 | let ``Simple queries to Oracle return valid results``() = 13 | let blog = TestQueries.getBlog 1 |> runSync 14 | Assert.Equal("functional-data-access-with-sqlfun", blog.name) 15 | 16 | [] 17 | let ``Inserts to Oracle work as expected``() = 18 | 19 | Tooling.deleteAllButFirstBlog() |> runSync 20 | 21 | TestQueries.insertBlog { 22 | blogId = 4 23 | name = "test-blog-4" 24 | title = "Testing simple insert 4" 25 | description = "Added to check if inserts work properly." 26 | owner = "jacentino" 27 | createdAt = DateTime.Now 28 | modifiedAt = None 29 | modifiedBy = None 30 | } |> runSync 31 | 32 | [] 33 | let ``Array parameters allow to add multiple records``() = 34 | 35 | Tooling.deleteAllButFirstBlog() |> runSync 36 | 37 | TestQueries.insertBlogsWithArrays [ 38 | { blogId = 2; name = "test-blog-2"; title = "Testing array parameters 1"; description = "Add to check if VARRAY parameters work as expected (1)."; owner = "jacentino"; createdAt = DateTime.Now; modifiedAt = None; modifiedBy = None } 39 | { blogId = 3; name = "test-blog-3"; title = "Testing array parameters 2"; description = "Added to check if VARRAY parameters work as expected (2)."; owner = "placentino"; createdAt = DateTime.Now; modifiedAt = None; modifiedBy = None } 40 | ] 41 | |> runSync 42 | 43 | [] 44 | let ``BulkCopy allow to add multiple records``() = 45 | 46 | Tooling.deleteAllButFirstBlog() |> runSync 47 | 48 | TestQueries.insertBlogsWithBulkCopy [ 49 | { blogId = 2; name = "test-blog-2"; title = "Testing array parameters 1"; description = "Add to check if VARRAY parameters work as expected (1)."; owner = "jacentino"; createdAt = DateTime.Now; modifiedAt = None; modifiedBy = None } 50 | { blogId = 3; name = "test-blog-3"; title = "Testing array parameters 2"; description = "Added to check if VARRAY parameters work as expected (2)."; owner = "placentino"; createdAt = DateTime.Now; modifiedAt = None; modifiedBy = None } 51 | ] 52 | |> runSync 53 | 54 | [] 55 | let ``Insert to Oracle with stored procedures works as expected``() = 56 | 57 | Tooling.deleteAllButFirstBlog() |> runSync 58 | 59 | TestQueries.insertBlogProc 60 | 5 61 | ( "test-blog-5" 62 | , "Testing simple insert 5" 63 | , "Added to check if inserts work properly." 64 | , "jacentino" 65 | , DateTime.Now ) 66 | |> runSync -------------------------------------------------------------------------------- /DbFun.OracleManaged/AssemblyInfo.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.OracleManaged.AssemblyInfo 2 | 3 | open System.Reflection 4 | open System.Runtime.InteropServices 5 | 6 | // General Information about an assembly is controlled through the following 7 | // set of attributes. Change these attribute values to modify the information 8 | // associated with an assembly. 9 | [] 10 | [] 11 | [] 12 | [] 13 | [] 14 | [] 15 | [] 16 | [] 17 | 18 | // Setting ComVisible to false makes the types in this assembly not visible 19 | // to COM components. If you need to access a type in this assembly from 20 | // COM, set the ComVisible attribute to true on that type. 21 | [] 22 | 23 | // The following GUID is for the ID of the typelib if this project is exposed to COM 24 | [] 25 | 26 | // Version information for an assembly consists of the following four values: 27 | // 28 | // Major Version 29 | // Minor Version 30 | // Build Number 31 | // Revision 32 | // 33 | // You can specify all the values or you can default the Build and Revision Numbers 34 | // by using the '*' as shown below: 35 | // [] 36 | [] 37 | [] 38 | 39 | do 40 | () -------------------------------------------------------------------------------- /DbFun.OracleManaged/BulkCopy.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.OracleManaged.Builders 2 | 3 | open DbFun.Core 4 | open DbFun.Core.Builders 5 | open System.Data 6 | open System 7 | 8 | module BulkCopyParamsImpl = 9 | 10 | type IParamSetter<'Arg> = GenericSetters.ISetter 11 | 12 | type IParamSetterProvider = GenericSetters.ISetterProvider 13 | 14 | type ParamSpecifier<'Arg> = IParamSetterProvider * DataTable -> IParamSetter<'Arg> 15 | 16 | type IBuilder = GenericSetters.IBuilder 17 | 18 | type SimpleBuilder() = 19 | 20 | interface IBuilder with 21 | 22 | member __.CanBuild(argType: System.Type): bool = 23 | Types.isSimpleType argType 24 | 25 | member __.Build(name: string, _: IParamSetterProvider, table: DataTable): IParamSetter<'Arg> = 26 | let ordinal = ref 0 27 | { new IParamSetter<'Arg> with 28 | member __.SetValue(value: 'Arg, _: int option, row: DataRow): unit = 29 | row.SetField(ordinal.Value, value) 30 | member __.SetNull(_: int option, row: DataRow): unit = 31 | row.[ordinal.Value] <- DBNull.Value 32 | member __.SetArtificial(_: int option, _: DataRow): unit = 33 | let column = table.Columns.Add(name, typeof<'Arg>) 34 | ordinal.Value <- column.Ordinal 35 | } 36 | 37 | let getDefaultBuilders(): IBuilder list = 38 | SimpleBuilder() :: GenericSetters.getDefaultBuilders() 39 | 40 | 41 | type Converter<'Source, 'Target> = GenericSetters.Converter 42 | 43 | type Configurator<'Config> = GenericSetters.Configurator 44 | 45 | 46 | open BulkCopyParamsImpl 47 | open Oracle.ManagedDataAccess.Client 48 | 49 | type BulkCopyParams() = 50 | inherit DbFun.Core.Builders.GenericSetters.GenericSetterBuilder() 51 | 52 | /// 53 | /// Bulk copy config. 54 | /// 55 | type BulkCopyConfig = 56 | { 57 | ParamBuilders : IBuilder list 58 | } 59 | with 60 | /// 61 | /// Adds a converter mapping application values of a given type to ptoper database parameter values. 62 | /// 63 | /// 64 | /// Function converting application values to database parameter values. 65 | /// 66 | member this.AddConverter(convert: 'Source -> 'Target) = 67 | { this with 68 | ParamBuilders = 69 | BulkCopyParamsImpl.Converter<'Source, 'Target>(convert) :: 70 | this.ParamBuilders 71 | } 72 | 73 | /// 74 | /// Adds a configurator for parameter builders of types determined by CanBuild function. 75 | /// 76 | /// 77 | /// Creates a configuration object. 78 | /// 79 | /// 80 | /// Function determining whether a given type is handled by the configurator. 81 | /// 82 | member this.AddConfigurator(getConfig: string -> 'Config, canBuild: Type -> bool) = 83 | { this with 84 | ParamBuilders = BulkCopyParamsImpl.Configurator<'Config>(getConfig, canBuild) :: this.ParamBuilders 85 | } 86 | 87 | 88 | /// 89 | /// Provides methods creating bulk import functions. 90 | /// 91 | type BulkCopyBuilder<'DbKey>(dbKey: 'DbKey, ?config: BulkCopyConfig) = 92 | 93 | let builders = defaultArg (config |> Option.map (fun c -> c.ParamBuilders)) (getDefaultBuilders()) 94 | 95 | /// 96 | /// Generates a function performing bulk import. 97 | /// 98 | /// 99 | /// The parameter builder. 100 | /// 101 | /// 102 | /// The target table name. 103 | /// 104 | member __.WriteToServer<'Record>(specifier: ParamSpecifier<'Record>, ?tableName: string): 'Record seq -> DbCall<'DbKey, unit> = 105 | let dataTable = new DataTable() 106 | let provider = GenericSetters.BaseSetterProvider(builders) 107 | let setter = specifier(provider, dataTable) 108 | setter.SetArtificial(None, null) 109 | fun (records: 'Record seq) (connector: IConnector<'DbKey>) -> 110 | let dataRow = dataTable.NewRow() 111 | async { 112 | let rows = 113 | seq { 114 | for r in records do 115 | setter.SetValue(r, None, dataRow) 116 | yield dataRow 117 | } |> Seq.toArray 118 | let bulkCopy = new OracleBulkCopy(connector.GetConnection(dbKey) :?> OracleConnection) 119 | bulkCopy.DestinationTableName <- defaultArg tableName typeof<'Record>.Name 120 | bulkCopy.WriteToServer(rows) 121 | } 122 | 123 | /// 124 | /// Generates a function performing bulk import. 125 | /// 126 | /// 127 | /// The target table name. 128 | /// 129 | /// 130 | /// The builder name argument. 131 | /// 132 | member this.WriteToServer<'Record>(?name: string, ?tableName: string): 'Record seq -> DbCall<'DbKey, unit> = 133 | this.WriteToServer(BulkCopyParams.Auto<'Record>(?name = name), ?tableName = tableName) 134 | 135 | /// 136 | /// Provides methods creating bulk import functions. 137 | /// 138 | type BulkCopyBuilder(?config: BulkCopyConfig) = 139 | inherit BulkCopyBuilder((), ?config = config) 140 | -------------------------------------------------------------------------------- /DbFun.OracleManaged/DbFun.OracleManaged.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | net6.0 5 | true 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | -------------------------------------------------------------------------------- /DbFun.OracleManaged/OracleArrayParams.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.OracleManaged.Builders 2 | 3 | open System 4 | open System.Collections.Generic 5 | open DbFun.Core 6 | open DbFun.Core.Builders 7 | open Oracle.ManagedDataAccess.Client 8 | 9 | type MultipleArrays = 10 | { 11 | ArraySize : int 12 | Data : IDictionary 13 | } 14 | 15 | type IArrayParamSetter<'Arg> = GenericSetters.ISetter 16 | 17 | type IArrayParamSetterProvider = GenericSetters.ISetterProvider 18 | 19 | type ArrayParamSpecifier<'Arg> = IArrayParamSetterProvider * unit -> IArrayParamSetter<'Arg> 20 | 21 | module OracleArrayParamsImpl = 22 | 23 | type IBuilder = GenericSetters.IBuilder 24 | 25 | type SimpleBuilder() = 26 | 27 | let getOracleDbType t = 28 | if t = typeof then OracleDbType.Int32 29 | elif t = typeof then OracleDbType.Int64 30 | elif t = typeof then OracleDbType.Int16 31 | elif t = typeof then OracleDbType.Boolean 32 | elif t = typeof then OracleDbType.Decimal 33 | elif t = typeof then OracleDbType.TimeStamp 34 | //elif t = typeof then OracleDbType.IntervalDS // TODO: maybe OracleDbType.IntervalYM 35 | //elif t = typeof then OracleDbType. 36 | elif t = typeof then OracleDbType.Char 37 | elif t = typeof then OracleDbType.Varchar2 38 | elif t = typeof then OracleDbType.Double 39 | elif t = typeof then OracleDbType.Vector_Binary 40 | else failwith <| sprintf "Unmappable type: %O" t 41 | 42 | let getArray(arrays: MultipleArrays, name: string): 'Item array = 43 | match arrays.Data.TryGetValue(name) with 44 | | true, (_, array) -> 45 | array :?> 'Item array 46 | | false, _ -> 47 | let array = Array.zeroCreate arrays.ArraySize 48 | arrays.Data.Add(name, (getOracleDbType typeof<'Item>, array)) 49 | array 50 | 51 | member __.GetArtificialValue<'Type>(): obj = 52 | if typeof<'Type> = typeof then box "" 53 | elif typeof<'Type> = typeof then box DateTime.Now 54 | elif typeof<'Type> = typeof then box [||] 55 | elif typeof<'Type>.IsClass then null 56 | else box Unchecked.defaultof<'Type> 57 | 58 | interface IBuilder with 59 | 60 | member __.CanBuild (argType: Type) = Types.isSimpleType(argType) 61 | 62 | member this.Build<'Arg> (name: string, _, _: unit) = 63 | { new IArrayParamSetter<'Arg> with 64 | member __.SetValue (value: 'Arg, index: int option, arrays: MultipleArrays) = 65 | let array = getArray(arrays, name) 66 | array[index.Value] <- value 67 | member __.SetNull(index: int option, arrays: MultipleArrays) = 68 | match index with 69 | | None -> arrays.Data[name] <- (getOracleDbType typeof<'Arg>), DBNull.Value 70 | | Some _ -> 71 | let array = getArray(arrays, name) 72 | array[index.Value] <- Unchecked.defaultof<'Arg> 73 | member __.SetArtificial(_: int option, arrays: MultipleArrays) = 74 | let array = getArray(arrays, name) 75 | array[0] <- this.GetArtificialValue<'Arg>() :?> 'Arg 76 | } 77 | 78 | let getDefaultBuilders(): IBuilder list = 79 | SimpleBuilder() :: GenericSetters.getDefaultBuilders() 80 | 81 | /// 82 | /// Provides methods creating various Oracle array parameter builders. 83 | /// 84 | type OracleArrayParams() = 85 | inherit GenericSetters.GenericSetterBuilder() 86 | 87 | /// 88 | /// The field-to-array mapping override. 89 | /// 90 | type OracleArrayParamOverride<'Arg> = GenericSetters.Override 91 | 92 | -------------------------------------------------------------------------------- /DbFun.OracleManaged/Query.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.OracleManaged.Builders 2 | 3 | open DbFun.Core.Diagnostics 4 | open System.Data 5 | open Oracle.ManagedDataAccess.Client 6 | open System 7 | 8 | type QueryConfig<'DbKey> = 9 | { 10 | Common: DbFun.Core.Builders.QueryConfig<'DbKey> 11 | OracleArrayBuilders : OracleArrayParamsImpl.IBuilder list 12 | } 13 | with 14 | /// 15 | /// Creates default configuration. 16 | /// 17 | /// 18 | /// The function creating database connection (with proper connection string, but not open). 19 | /// 20 | static member Default(createConnection: 'DbKey -> IDbConnection) = 21 | let common = DbFun.Core.Builders.QueryConfig<'DbKey>.Default(createConnection) 22 | { Common = common; OracleArrayBuilders = OracleArrayParamsImpl.getDefaultBuilders() } 23 | 24 | 25 | /// 26 | /// Adds Oracle array support. 27 | /// 28 | member this.UseOracleArrayParams() = 29 | let oracleArrayProvider = ParamsImpl.BaseSetterProvider(OracleArrayParamsImpl.getDefaultBuilders()) 30 | let oracleArrayBuilder = ParamsImpl.OracleArrayBuilder(oracleArrayProvider) 31 | { this with Common = { this.Common with ParamBuilders = oracleArrayBuilder :: this.Common.ParamBuilders } } 32 | 33 | 34 | /// 35 | /// Adds builder for array parameters. 36 | /// 37 | /// 38 | /// The builder. 39 | /// 40 | member this.AddOracleArrayBuilder(builder: OracleArrayParamsImpl.IBuilder) = 41 | let pgArrayBuilders = builder :: this.OracleArrayBuilders 42 | let oracleArrayProvider = ParamsImpl.BaseSetterProvider(pgArrayBuilders) 43 | let arrayBuilder = ParamsImpl.OracleArrayBuilder(oracleArrayProvider) :> DbFun.Core.Builders.ParamsImpl.IBuilder 44 | let paramBuilders = this.Common.ParamBuilders |> List.map (function :? ParamsImpl.OracleArrayBuilder -> arrayBuilder | b -> b) 45 | { this with 46 | Common = { this.Common with ParamBuilders = paramBuilders } 47 | OracleArrayBuilders = pgArrayBuilders 48 | } 49 | 50 | /// 51 | /// Adds a converter mapping database values to application values. 52 | /// 53 | /// 54 | /// Function converting database column values to application values. 55 | /// 56 | member this.AddParamConverter(converter: 'Source -> 'Target) = 57 | let arrayBuilder = ParamsImpl.Converter<'Source, 'Target>(converter) 58 | { this with Common = this.Common.AddParamConverter(converter) } 59 | .AddOracleArrayBuilder(arrayBuilder) 60 | 61 | /// 62 | /// Adds a configurator for parameter builders of types determined by canBuild function. 63 | /// 64 | /// 65 | /// Creates a configuration object. 66 | /// 67 | /// 68 | /// Function determining whether a given type is handled by the configurator. 69 | /// 70 | member this.AddParamConfigurator(getConfig: string -> 'Config, canBuild: Type -> bool) = 71 | { this with Common = this.Common.AddRowConfigurator(getConfig, canBuild) } 72 | .AddOracleArrayBuilder(ParamsImpl.Configurator<'Config>(getConfig, canBuild)) 73 | 74 | 75 | /// 76 | /// Allows to handle collections by replicating parameters for each item with name modified by adding item index. 77 | /// 78 | member this.HandleCollectionParams() = 79 | { this with Common = this.Common.HandleCollectionParams() } 80 | 81 | 82 | type QueryConfig = QueryConfig 83 | 84 | /// 85 | /// Provides methods creating various query functions. 86 | /// 87 | type QueryBuilder<'DbKey>(dbKey: 'DbKey, config: QueryConfig<'DbKey>, ?compileTimeErrorLog: ref) = 88 | inherit DbFun.Core.Builders.QueryBuilder<'DbKey>(dbKey, config.Common, ?compileTimeErrorLog = compileTimeErrorLog) 89 | 90 | /// 91 | /// The configuration of the query builder. 92 | /// 93 | member __.Config = config 94 | 95 | override __.CreateCommand(connection: IDbConnection) = 96 | let command = connection.CreateCommand() 97 | (command :?> OracleCommand).BindByName <- true 98 | command 99 | 100 | /// 101 | /// Creates query builder object with default configuration 102 | /// 103 | /// 104 | /// Function creating connection, assigned with a proper connection string, but not open. 105 | /// 106 | new(dbKey: 'DbKey, createConnection: 'DbKey -> IDbConnection) = 107 | QueryBuilder<'DbKey>(dbKey, QueryConfig<'DbKey>.Default(createConnection)) 108 | 109 | /// 110 | /// Creates new builder with the specified command timeout. 111 | /// 112 | /// 113 | /// The timeout value in seconds. 114 | /// 115 | member this.Timeout(timeout: int) = 116 | QueryBuilder<'DbKey>(dbKey, { this.Config with Common = { this.Config.Common with Timeout = Some timeout } }, ?compileTimeErrorLog = this.RawCompileTimeErrorLog) 117 | 118 | /// 119 | /// Creates new builder with compile-time error logging and deferred exceptions. 120 | /// 121 | member this.LogCompileTimeErrors() = 122 | QueryBuilder<'DbKey>(dbKey, { this.Config with Common = { this.Config.Common with LogCompileTimeErrors = true } }, ?compileTimeErrorLog = this.RawCompileTimeErrorLog) 123 | 124 | /// 125 | /// Creates new builder generating query functions without discovering resultset structure using SchemaOnly calls. 126 | /// 127 | member this.DisablePrototypeCalls() = 128 | QueryBuilder<'DbKey>(dbKey, { this.Config with Common = this.Config.Common.DisablePrototypeCalls() }, ?compileTimeErrorLog = this.RawCompileTimeErrorLog) 129 | 130 | 131 | /// 132 | /// Handles collections as array parameters. 133 | /// 134 | member __.UseOracleArrayParamss() = 135 | QueryBuilder<'DbKey>(dbKey, config.UseOracleArrayParams(), ?compileTimeErrorLog = compileTimeErrorLog) 136 | 137 | /// 138 | /// Allows to handle collections by generating parameters for each item with name modified by adding item index. 139 | /// 140 | member __.HandleCollectionParams() = 141 | QueryBuilder<'DbKey>(dbKey, config.HandleCollectionParams(), ?compileTimeErrorLog = compileTimeErrorLog) 142 | 143 | 144 | /// 145 | /// Provides methods creating various query functions. 146 | /// 147 | type QueryBuilder(config: QueryConfig, ?compileTimeErrorLog: ref) = 148 | inherit QueryBuilder((), config, ?compileTimeErrorLog = compileTimeErrorLog) 149 | 150 | new(createConnection: unit -> IDbConnection) = 151 | QueryBuilder(QueryConfig.Default(createConnection)) -------------------------------------------------------------------------------- /DbFun.Sqlite.IntegrationTests/App.config: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | -------------------------------------------------------------------------------- /DbFun.Sqlite.IntegrationTests/Commons.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Sqlite.IntegrationTests 2 | 3 | open System.IO 4 | open System.Configuration 5 | open System.Reflection 6 | open System.Data 7 | open System.Data.SQLite 8 | open DbFun.Core 9 | open DbFun.Core.Builders 10 | open DbFun.Core.Sqlite 11 | 12 | module Commons = 13 | 14 | let connectionString = 15 | let config = ConfigurationManager.OpenExeConfiguration(System.Reflection.Assembly.GetExecutingAssembly().Location) 16 | config.ConnectionStrings.ConnectionStrings.["DbFunTests"].ConnectionString 17 | .Replace("{dir}", Path.GetDirectoryName(Assembly.GetExecutingAssembly().Location)) 18 | 19 | let createConnection (): IDbConnection = new SQLiteConnection(connectionString) 20 | 21 | let config = QueryConfig.Default(createConnection).SqliteDateTimeAsString() 22 | 23 | let query = QueryBuilder(config) 24 | 25 | let run dbCall = DbCall.Run(createConnection, dbCall) 26 | 27 | -------------------------------------------------------------------------------- /DbFun.Sqlite.IntegrationTests/DbFun.Sqlite.IntegrationTests.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | net6.0 5 | 6 | false 7 | false 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | runtime; build; native; contentfiles; analyzers; buildtransitive 27 | all 28 | 29 | 30 | runtime; build; native; contentfiles; analyzers; buildtransitive 31 | all 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | -------------------------------------------------------------------------------- /DbFun.Sqlite.IntegrationTests/Models.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Sqlite.IntegrationTests 2 | 3 | open System 4 | open Commons 5 | 6 | module Models = 7 | 8 | type PostStatus = 9 | | New = 'N' 10 | | Published = 'P' 11 | | Archived = 'A' 12 | 13 | 14 | type Blog = { 15 | id: int 16 | name: string 17 | title: string 18 | description: string 19 | owner: string 20 | createdAt: DateTime 21 | modifiedAt: DateTime option 22 | modifiedBy: string option 23 | } 24 | 25 | type Post = { 26 | id: int 27 | blogId: int 28 | name: string 29 | title: string 30 | content: string 31 | author: string 32 | createdAt: DateTime 33 | modifiedAt: DateTime option 34 | modifiedBy: string option 35 | status: PostStatus 36 | } 37 | 38 | 39 | 40 | module Tooling = 41 | 42 | let deleteAllButFirstBlog = query.Sql("delete from blog where id <> 1") 43 | 44 | let deleteAllPosts = query.Sql("delete from post") 45 | 46 | 47 | -------------------------------------------------------------------------------- /DbFun.Sqlite.IntegrationTests/Program.fs: -------------------------------------------------------------------------------- 1 | module Program = let [] main _ = 0 2 | -------------------------------------------------------------------------------- /DbFun.Sqlite.IntegrationTests/TestQueries.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Sqlite.IntegrationTests 2 | 3 | open Commons 4 | open Models 5 | 6 | module TestQueries = 7 | 8 | let getBlog = query.Sql("select id, name, title, description, owner, createdAt, modifiedAt, modifiedBy from blog where id = @blogid", "blogid") 9 | 10 | let insertBlog = query.Sql( 11 | "insert into blog (id, name, title, description, owner, createdAt, modifiedAt, modifiedBy) 12 | values (@id, @name, @title, @description, @owner, @createdAt, @modifiedAt, @modifiedBy)") 13 | 14 | let insertPost = query.Sql( 15 | "insert into post (id, blogId, name, title, content, author, createdAt, modifiedAt, modifiedBy, status) 16 | values (@id, @blogId, @name, @title, @content, @author, @createdAt, @modifiedAt, @modifiedBy, @status)") 17 | 18 | 19 | -------------------------------------------------------------------------------- /DbFun.Sqlite.IntegrationTests/Tests.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.Sqlite.IntegrationTests 2 | 3 | open System 4 | open Xunit 5 | open Commons 6 | open Models 7 | 8 | module Tests = 9 | 10 | let runSync f = run f |> Async.RunSynchronously 11 | 12 | [] 13 | let ``Simple queries to Sqlite return valid results``() = 14 | let blog = TestQueries.getBlog 1 |> runSync 15 | Assert.Equal("functional-data-access-with-sqlfun", blog.name) 16 | 17 | [] 18 | let ``Inserts to sqlite work as expected``() = 19 | 20 | Tooling.deleteAllButFirstBlog() |> runSync 21 | 22 | TestQueries.insertBlog { 23 | id = 4 24 | name = "test-blog-4" 25 | title = "Testing simple insert 4" 26 | description = "Added to check if inserts work properly." 27 | owner = "jacentino" 28 | createdAt = System.DateTime.Now 29 | modifiedAt = None 30 | modifiedBy = None 31 | } |> run 32 | 33 | [] 34 | let ``Inserts to tables with foregin keys work as expected``() = 35 | 36 | Tooling.deleteAllPosts() |> runSync 37 | 38 | TestQueries.insertPost { 39 | id = 1 40 | blogId = 1 41 | name = "test-post-1" 42 | title = "Checking inserts to tables with foreign key constraints" 43 | content = "Just checking" 44 | author = "jacentino" 45 | createdAt = System.DateTime.Now 46 | modifiedAt = None 47 | modifiedBy = None 48 | status = PostStatus.New 49 | } |> runSync 50 | 51 | 52 | -------------------------------------------------------------------------------- /DbFun.Sqlite.IntegrationTests/database/DbFunTests.sqlite: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jacentino/DbFun/af519e95e7b5b68ddb11a5e5e17c2727c775b296/DbFun.Sqlite.IntegrationTests/database/DbFunTests.sqlite -------------------------------------------------------------------------------- /DbFun.TestTools/DbFun.TestTools.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | net6.0 5 | true 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | -------------------------------------------------------------------------------- /DbFun.TestTools/Models.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.TestTools.Models 2 | 3 | open System 4 | open DbFun.Core.Models 5 | 6 | type Status = 7 | | New = 'N' 8 | | Active = 'A' 9 | | Blocked = 'B' 10 | | Deleted = 'D' 11 | 12 | type Role = 13 | | Guest = 1 14 | | Regular = 2 15 | | Admin = 3 16 | 17 | type Access = 18 | | [] NoAccess 19 | | [] Read 20 | | [] Write 21 | | [] ReadWrite 22 | 23 | type PaymentType = 24 | | [] NoPayment 25 | | [] Cash of string 26 | | [] CreditCard of number: string * cvc: string 27 | 28 | type User = 29 | { 30 | userId : int 31 | name : string 32 | email : string 33 | created : DateTime 34 | } 35 | 36 | type UserWithRoles = 37 | { 38 | userId : int 39 | name : string 40 | email : string 41 | created : DateTime 42 | roles : string list 43 | } 44 | 45 | type UserId = UserId of int 46 | 47 | type Signature = 48 | { 49 | createdAt : DateTime 50 | createdBy : string 51 | updatedAt : DateTime 52 | updatedBy : string 53 | } 54 | 55 | type Account = 56 | { 57 | userId : string 58 | password : string 59 | signature : Signature 60 | } -------------------------------------------------------------------------------- /DbFun.TestTools/Templating.fs: -------------------------------------------------------------------------------- 1 | namespace DbFun.TestTools 2 | 3 | open DbFun.Core 4 | 5 | module Templating = 6 | 7 | let where condition = Templating.expand "WHERE-CLAUSE" " where " " and " condition 8 | let orderBy defVal (template, parameters) = Templating.expand "ORDER-BY-CLAUSE" " order by " ", " (parameters |> Option.defaultValue defVal |> string) (template, parameters) 9 | let join spec = Templating.expand "JOIN-CLAUSES" " " " " spec 10 | let groupBy field = Templating.expand "GROUP-BY-CLAUSE" "group by " ", " field 11 | let having condition = Templating.expand "HAVING-CLAUSE" "having " " and " condition 12 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) [year] [fullname] 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /images/dbfun.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jacentino/DbFun/af519e95e7b5b68ddb11a5e5e17c2727c775b296/images/dbfun.png --------------------------------------------------------------------------------