article; insert articleUser; selectWhere<> "whatever"] db // -> Result --> 13 | 14 | fun context -> 15 | fun connection -> 16 | fun transaction -> 17 | fun querys -> 18 | let cmds = querys |> Seq.map toCmd 19 | let mutable errored = false 20 | seq { for cmd in cmds do 21 | if not errored 22 | then 23 | match cmd.Execute() with 24 | | Ok state -> 25 | yield Ok state 26 | | Error e -> 27 | errored <- true 28 | transaction.Rollback() 29 | yield Error e 30 | 31 | [Ok 1; Ok IDataReader; Error e] 32 | } 33 | type QueryReturn = 34 | | int 35 | | IDataReader 36 | 37 | |> Seq.takeWhile 38 | match query with 39 | | str -> buildCommand(str) 40 | | cmd -> () 41 | |> fun cmd -> cmd.Execute 42 | |> function 43 | | Ok _ -> true 44 | | Error _ -> 45 | transaction.Rollback() 46 | false 47 | |> Seq.fold ( 48 | fun element state -> 49 | match state with 50 | | Ok state -> 51 | state @ element.Execute() |> Ok 52 | | Error e -> 53 | transaction.Rollback 54 | Error e 55 | [Ok 1; Ok IDataReader; Error exn; Error exn] 56 | ) (Ok 0) 57 | 58 | 59 | consumeReaders : seq -> seq<> 60 | match input with 61 | | IDataReader -> 62 | consume it 63 | | int -> 64 | Error exn "Can't consume int" 65 | [Ok 1] 66 | type QueryResult = 67 | | Int of int 68 | | DataReader of IDataReader * Type 69 | | Thing of obj * Type 70 | batch seq {insert user db; selectWhere "id = 1" db, User; delete user db} // [Int 1; (DataReader dr, User); (DataReader dr, Article); Int 1] 71 | |> map 72 | function 73 | | Ok el -> 74 | match el with 75 | | Int i -> Int i 76 | | DataReader (dr,type_) -> Thing <| consumeReader dr, type_ 77 | 78 | match Unbatchable.selectAll db with 79 | | Ok result -> 80 | match result with 81 | | Int i -> 82 | | Reader reader -> consumeReader reader 83 | | Error e -> Error e 84 | 85 | Batchable.selectAll db --> 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | [] 95 | type UserInfo = 96 | { 97 | userId : string 98 | otherThing : string 99 | name : string 100 | email : string 101 | phone : string 102 | } 103 | 104 | [] 105 | type UserSecrets = 106 | { 107 | userId : string 108 | password : string 109 | } 110 | [] 111 | type User = 112 | { 113 | [, "userId", DbContext.Default)>] 114 | [, "userId", DbContext.Default)>] 115 | id : string // User 116 | [, "otherThing", DbContext.Default)>] 117 | secondaryKey: int 118 | // [, JoinDirection.Left, DbContext.Default)>] 119 | // info : UserInfo 120 | [, JoinDirection.Left, DbContext.Default)>] 121 | name : string // UserInfo 122 | [, JoinDirection.Left, DbContext.Default)>] 123 | email : string // UserInfo 124 | [, JoinDirection.Left, DbContext.Default)>] 125 | phone : string 126 | [, JoinDirection.Left, DbContext.Default)>] 127 | secrets : UserSecrets // Passwords 128 | } 129 | 130 | 131 | ``` 132 | 133 | 134 | 135 | -------------------------------------------------------------------------------- /Attributes/Library.fs: -------------------------------------------------------------------------------- 1 | namespace Form.Attributes 2 | 3 | open System 4 | open System.Reflection 5 | open Microsoft.FSharp.Core.LanguagePrimitives 6 | 7 | 8 | type DbContext = 9 | | Default = 99 10 | 11 | type FKProperty = 12 | | Cascade 13 | | SetNull 14 | | SetValue of string 15 | 16 | type FKType = 17 | | Update of FKProperty 18 | | Delete of FKProperty 19 | 20 | type ContextInfo = ( string * DbContext ) array 21 | 22 | [] 23 | type DbAttribute( ) = 24 | inherit Attribute( ) 25 | abstract Value : ( string * int ) 26 | 27 | ///An attribute type which specifies a schema name 28 | ///Not Implemented, don't bother using yet... 29 | [] 30 | type SchemaAttribute( alias : string, context : obj ) = 31 | inherit DbAttribute( ) 32 | override _.Value = ( alias, ( box( context ) :?> DbContext ) |> EnumToValue ) 33 | 34 | ///An attribute type which specifies a table name 35 | [] 36 | type TableAttribute( alias : string , context : obj ) = 37 | inherit DbAttribute( ) 38 | override _.Value = ( alias, ( context :?> DbContext ) |> EnumToValue ) 39 | member _.Context = ( context :?> DbContext ) |> EnumToValue 40 | 41 | 42 | ///An attribute type which specifies a Column name 43 | [] 44 | type ColumnAttribute( alias : string, context : obj ) = 45 | inherit DbAttribute( ) 46 | override _.Value = ( alias, ( context :?> DbContext ) |> EnumToValue ) 47 | 48 | ///An attribute type which specifies a Column name 49 | [] 50 | type PrimaryKeyAttribute( name : string, context : obj ) = 51 | inherit DbAttribute( ) 52 | override _.Value = name, ( context :?> DbContext ) |> EnumToValue 53 | 54 | [] 55 | type ConstraintAttribute( definition : string, context : obj ) = 56 | inherit DbAttribute( ) 57 | override _.Value = ( definition, ( context :?> DbContext ) |> EnumToValue ) 58 | 59 | [] 60 | type IdAttribute(context : obj ) = 61 | inherit DbAttribute( ) 62 | override _.Value = ( "index", ( context :?> DbContext ) |> EnumToValue ) 63 | 64 | [] 65 | type SQLTypeAttribute( definition : string, context : obj ) = 66 | inherit DbAttribute( ) 67 | override _.Value = ( definition, ( context :?> DbContext ) |> EnumToValue ) 68 | 69 | [] 70 | type UniqueAttribute( group : string,context : obj ) = 71 | inherit DbAttribute( ) 72 | override _.Value = (group, ( context :?> DbContext ) |> EnumToValue) 73 | 74 | [] 75 | type LazyAttribute() = 76 | inherit DbAttribute( ) 77 | override _.Value = ("lazy", -1) 78 | 79 | ///An attribute type which specifies a Column name 80 | [] 81 | type ForeignKeyAttribute( table : obj, column : string, properties : obj, field: string, context : obj ) = 82 | inherit DbAttribute( ) 83 | override _.Value = ( column, ( box( context ) :?> DbContext ) |> EnumToValue ) 84 | member _.table = table 85 | member _.column = column 86 | 87 | 88 | type JoinDirection = 89 | | Left = 0 90 | | Right = 1 91 | | Inner = 2 92 | | Outer = 3 93 | 94 | ///An attribute type which allows the specification of some FSharp Record Type fields being sourced via joinery 95 | [] 96 | type ByJoinAttribute ( table : Type, context : obj ) = 97 | inherit DbAttribute( ) 98 | override _.Value = ( table.Name, ( box( context ) :?> DbContext ) |> EnumToValue ) 99 | member _.table = table 100 | 101 | 102 | ///An attribute type which allows the specification of what fields/columns to join on to bring in ByJoin fields/columns... see ByJoinAttribute 103 | [] 104 | type OnAttribute (table : Type, on : string, kind : JoinDirection, context : obj ) = 105 | inherit DbAttribute( ) 106 | override _.Value = ( table.Name, ( box( context ) :?> DbContext ) |> EnumToValue) 107 | member _.key = 108 | table.GetProperties() 109 | // |> Array.map ( fun field -> field :?> PropertyInfo ) 110 | |> Array.filter (fun field -> field.Name = on) 111 | |> Array.head 112 | member _.kind = kind 113 | 114 | ///A record type which holds the information required to map across BE And DB. 115 | type SqlMapping = { 116 | Index : int 117 | IsKey : bool 118 | IsIndex : bool 119 | JoinOn : ( string * string ) option 120 | Source : string 121 | QuotedSource : string 122 | SqlName : string 123 | QuotedSqlName : string 124 | FSharpName : string 125 | Type : Type 126 | PropertyInfo: PropertyInfo 127 | } 128 | 129 | ///Stores the flavor And context used for a particular connection. 130 | /// Takes the connection string and context. 131 | /// 132 | type OrmState = 133 | | MSSQL of ( string * Enum ) 134 | | MySQL of ( string * Enum ) 135 | | PSQL of ( string * Enum ) 136 | | SQLite of ( string * Enum ) 137 | | ODBC of ( string * Enum ) // SQL Driver = SQL Server Native 11.0 138 | -------------------------------------------------------------------------------- /docs/basics.md: -------------------------------------------------------------------------------- 1 | # The Basics 2 | 3 | We said in the overview that FORM aims to be ergonomic. Staying true to this goal, we tried to make setting it up as easy as possible. However, FORM adds one layer of complexity that's, sometimes, lacking in other ORMs -- first-class support for multiple data sources. 4 | 5 | Form was bred from the need to quickly build bespoke data pipelines. Because of this, we have developed a strategy where the same record can represent the table layout for multiple databases and also have the ability to have database-specific identifiers for things like tables and column names. But, before we get into all that, let's do the minimal setup. 6 | 7 | ## Definitions 8 | 9 | ```fs 10 | let connectionString = "DataSource=./data.db" 11 | 12 | type Context = 13 | | Primary = 1 14 | 15 | let state = Form.Attributes.OrmState.SQLite( connectionString, Context.Primary ) 16 | 17 | (* 18 | Even though this looks like a union type, it's actually an Enum. This is because 19 | there is a limitation with Attributes and that you can only pass constants to them. 20 | *) 21 | 22 | let createTable = 23 | """ 24 | drop table if exists; 25 | create table user ( 26 | id int not null, 27 | "first" varchar(32) not null, 28 | "last" varchar(32) not null 29 | )""" 30 | 31 | type User = { 32 | id: int 33 | first: string 34 | last: string 35 | } 36 | 37 | (* 38 | This is a very basic setup. As of right now, we don't support a code-first, 39 | however it's on the roadmap. 40 | *) 41 | 42 | 43 | (* ! WARNING ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 44 | This function, along with Form.Orm.executeReader, can be dangerous. 45 | Never allow sql generate from user input to be executed by these two 46 | functions without meticulously sanitizing it first. Since we are in 47 | full control of this statement, it's perfectly fine to use in this 48 | fashion. 49 | *) 50 | Form.Orm.execute state None createTable 51 | |> printfn "%A" 52 | ``` 53 | 54 | Ok, you defined your data, setup the connection, even created the tables... now what? Let's create some fake data and insert it. 55 | 56 | ```fs 57 | let myUsers = [ 58 | { id = 1; first = "Clarice"; last = "Johanssen" } 59 | { id = 2; first = "Jimothy"; last = "MacDermont" } 60 | { id = 3; first = "Michael"; last = "McDoesn'tExist" } 61 | ] 62 | 63 | myUsers 64 | |> Seq.map ( Form.Orm.insert state None true ) 65 | |> printfn "%A" 66 | 67 | Form.Orm.selectAll state None 68 | |> printfn "%A" 69 | 70 | ``` 71 | 72 | But, as you develop, requirements change, you forgot you needed keys, maybe a few columns, and {some other thing here}. Let's fix our schema real quick. 73 | 74 | ```fs 75 | (* 76 | Replace the User type above with this. And let's modify the table. 77 | *) 78 | type User = { 79 | [] 80 | id: int 81 | [] 82 | first: string 83 | [] 84 | last: string 85 | email: string option 86 | } 87 | 88 | let createTable = 89 | """ 90 | drop table if exists user; 91 | create table user ( 92 | id int not null, 93 | "firstName" varchar(32) not null, 94 | "lastName" varchar(32) not null, 95 | email varchar(64) null 96 | )""" 97 | 98 | Form.Orm.execute state None createTable 99 | |> printfn "%A" 100 | 101 | let myUsers = [ 102 | { id = 1; first = "Clarice"; last = "Johanssen"; email = None } 103 | { id = 2; first = "Jimothy"; last = "MacDermont"; email = None } 104 | { id = 3; first = "Michael"; last = "McDoesn'tExist"; email = Some "doesexist@doesntexist.com" } 105 | ] 106 | 107 | (* 108 | Note the change here in the 3rd parameter. This is a flag to allow FORM 109 | to insert the keys into the table. If your database generates your keys, 110 | simply set the field to some dummy data and set this flag to false and 111 | the next time you read it from the db, you'll have your keys. 112 | *) 113 | Form.Orm.insertMany state None true myUsers 114 | |> printfn "%A" 115 | 116 | Form.Orm.selectAll state None 117 | |> printfn "%A" 118 | ``` 119 | 120 | As you're looking this over, you might see some patterns in the API. This is by-design. Parameter ordering tries to keep the same pattern: 121 | 122 | ```fsharp 123 | OrmState -> DbTransaction -> {BehaviorFlags} -> {^T State} 124 | ``` 125 | > Where BehaviorFlags and "^T State", here, are only required for a subset of the functions. 126 | 127 | Beyond keeping the parameter ordering the same, we also kept the naming conventions the same: 128 | 129 | ```fs 130 | Form.Orm.insert 131 | Form.Orm.update 132 | Form.Orm.delete 133 | Form.Orm.selectWhere 134 | Form.Orm.insertWhere 135 | Form.Orm.updateWhere 136 | Form.Orm.deleteWhere 137 | Form.Orm.insertMany 138 | Form.Orm.updateMany 139 | Form.Orm.deleteMany 140 | ``` 141 | 142 | These names stay true to their SQL equivalents. 143 | 144 | Let's try getting a single record from the db. 145 | 146 | ```fs 147 | Form.Orm.selectWhere state None ( """"id"=:1""", [| "3" |] ) 148 | ``` 149 | 150 | Here, we are using the selectWhere function and passing arbitrary string to the where clause of the query. When we call the *Where functions, we need to separate out the string format and the data so that form is able to do some escaping to prevent sql injection. You can tell the formatter to place items based on preceding which element of the list it is with a colon. IE ":1" for the first element of the array, which, in this case, gets replaced by "3". 151 | 152 | Now, let's do something a bit more complex. Let's take this record, update it, save it back to the db, and then read it back just to be sure. 153 | 154 | ```fs 155 | Form.Orm.selectWhere state None ( """"id"=:1""", [| "3" |] ) 156 | |> Result.map ( Seq.head >> fun x -> { x with first = "Michelle" } ) 157 | |> Result.bind ( Form.Orm.update state None ) 158 | |> printfn "%A" 159 | 160 | Form.Orm.selectWhere state None ( """"id"=:1""", [| "3" |] ) 161 | |> printfn "%A" 162 | (* 163 | Ok (seq [{ id = 3 164 | first = "Michelle" 165 | last = "McDoesn'tExist" 166 | email = Some "doesexist@doesntexist.com" }]) 167 | *) 168 | ``` 169 | 170 | That's great, but what if I want to make sure nothing affects my data until all changes are set? Well, we have support for transactions! See that `None`? That's a `DbTransaction Option`. So we simply need to call `Form.Orm.beginTransaction`. 171 | 172 | Note, because the transactions take a DbTransaction Option, the return of this method is a DbTransaction Option. 173 | 174 | 175 | ```fs 176 | let transaction = Form.Orm.beginTransaction state 177 | 178 | Form.Orm.selectWhere state transaction ( """"id"=:1""", [| "3" |] ) 179 | |> Result.map ( Seq.head >> fun x -> { x with first = "Michelle" } ) 180 | |> Result.bind ( Form.Orm.update state transaction ) 181 | |> printfn "%A" 182 | 183 | Form.Orm.commitTransaction transaction 184 | |> printfn "%A" 185 | 186 | Form.Orm.selectWhere state None ( """"id"=:1""", [| "3" |] ) 187 | |> printfn "%A" 188 | ``` 189 | 190 | It's also important to know that the delete, insert, and update functions establish their own transactions that are automatically committed once they're done executing when passing None as the DbTransaction Option's state. If passing in a Some DbTransaction, then it wont auto-commit the transaction and it need to be explicitly committed by calling `Form.Orm.commitTransaction` function. 191 | 192 | With this info, you can get started using FORM. There's just one more thing to cover around batch-style commands [here](./advanced.md) if you'd like to read it. -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | ## Ignore Visual Studio temporary files, build results, and 2 | ## files generated by popular Visual Studio add-ons. 3 | ## 4 | ## Get latest from https://github.com/github/gitignore/blob/master/VisualStudio.gitignore 5 | 6 | **bin/ 7 | **obj/ 8 | **/*.env 9 | 10 | 11 | # User-specific files 12 | *.rsuser 13 | *.suo 14 | *.user 15 | *.userosscache 16 | *.sln.docstates 17 | 18 | # User-specific files (MonoDevelop/Xamarin Studio) 19 | *.userprefs 20 | 21 | # Mono auto generated files 22 | mono_crash.* 23 | 24 | # Build results 25 | [Dd]ebug/ 26 | [Dd]ebugPublic/ 27 | [Rr]elease/ 28 | [Rr]eleases/ 29 | x64/ 30 | x86/ 31 | [Ww][Ii][Nn]32/ 32 | [Aa][Rr][Mm]/ 33 | [Aa][Rr][Mm]64/ 34 | bld/ 35 | [Bb]in/ 36 | [Oo]bj/ 37 | [Ll]og/ 38 | [Ll]ogs/ 39 | 40 | # Visual Studio 2015/2017 cache/options directory 41 | .vs/ 42 | # Uncomment if you have tasks that create the project's static files in wwwroot 43 | #wwwroot/ 44 | 45 | # Visual Studio 2017 auto generated files 46 | Generated\ Files/ 47 | 48 | # MSTest test Results 49 | # [Tt]est[Rr]esult*/ 50 | [Bb]uild[Ll]og.* 51 | 52 | # NUnit 53 | *.VisualState.xml 54 | TestResult.xml 55 | nunit-*.xml 56 | 57 | # Build Results of an ATL Project 58 | [Dd]ebugPS/ 59 | [Rr]eleasePS/ 60 | dlldata.c 61 | 62 | # Benchmark Results 63 | BenchmarkDotNet.Artifacts/ 64 | 65 | # .NET Core 66 | project.lock.json 67 | project.fragment.lock.json 68 | artifacts/ 69 | 70 | # Tye 71 | .tye/ 72 | 73 | # ASP.NET Scaffolding 74 | ScaffoldingReadMe.txt 75 | 76 | # StyleCop 77 | StyleCopReport.xml 78 | 79 | # Files built by Visual Studio 80 | *_i.c 81 | *_p.c 82 | *_h.h 83 | *.ilk 84 | *.meta 85 | *.obj 86 | *.iobj 87 | *.pch 88 | *.pdb 89 | *.ipdb 90 | *.pgc 91 | *.pgd 92 | *.rsp 93 | *.sbr 94 | *.tlb 95 | *.tli 96 | *.tlh 97 | *.tmp 98 | *.tmp_proj 99 | *_wpftmp.csproj 100 | *.log 101 | *.vspscc 102 | *.vssscc 103 | .builds 104 | *.pidb 105 | *.svclog 106 | *.scc 107 | 108 | # Chutzpah Test files 109 | _Chutzpah* 110 | 111 | # Visual C++ cache files 112 | ipch/ 113 | *.aps 114 | *.ncb 115 | *.opendb 116 | *.opensdf 117 | *.sdf 118 | *.cachefile 119 | *.VC.db 120 | *.VC.VC.opendb 121 | 122 | # Visual Studio profiler 123 | *.psess 124 | *.vsp 125 | *.vspx 126 | *.sap 127 | 128 | # Visual Studio Trace Files 129 | *.e2e 130 | 131 | # TFS 2012 Local Workspace 132 | $tf/ 133 | 134 | # Guidance Automation Toolkit 135 | *.gpState 136 | 137 | # ReSharper is a .NET coding add-in 138 | _ReSharper*/ 139 | *.[Rr]e[Ss]harper 140 | *.DotSettings.user 141 | 142 | # TeamCity is a build add-in 143 | _TeamCity* 144 | 145 | # DotCover is a Code Coverage Tool 146 | *.dotCover 147 | 148 | # AxoCover is a Code Coverage Tool 149 | .axoCover/* 150 | !.axoCover/settings.json 151 | 152 | # Coverlet is a free, cross platform Code Coverage Tool 153 | coverage*.json 154 | coverage*.xml 155 | coverage*.info 156 | 157 | # Visual Studio code coverage results 158 | *.coverage 159 | *.coveragexml 160 | 161 | # NCrunch 162 | _NCrunch_* 163 | .*crunch*.local.xml 164 | nCrunchTemp_* 165 | 166 | # MightyMoose 167 | *.mm.* 168 | AutoTest.Net/ 169 | 170 | # Web workbench (sass) 171 | .sass-cache/ 172 | 173 | # Installshield output folder 174 | [Ee]xpress/ 175 | 176 | # DocProject is a documentation generator add-in 177 | DocProject/buildhelp/ 178 | DocProject/Help/*.HxT 179 | DocProject/Help/*.HxC 180 | DocProject/Help/*.hhc 181 | DocProject/Help/*.hhk 182 | DocProject/Help/*.hhp 183 | DocProject/Help/Html2 184 | DocProject/Help/html 185 | 186 | # Click-Once directory 187 | publish/ 188 | 189 | # Publish Web Output 190 | *.[Pp]ublish.xml 191 | *.azurePubxml 192 | # Note: Comment the next line if you want to checkin your web deploy settings, 193 | # but database connection strings (with potential passwords) will be unencrypted 194 | *.pubxml 195 | *.publishproj 196 | 197 | # Microsoft Azure Web App publish settings. Comment the next line if you want to 198 | # checkin your Azure Web App publish settings, but sensitive information contained 199 | # in these scripts will be unencrypted 200 | PublishScripts/ 201 | 202 | # NuGet Packages 203 | **/*.nupkg 204 | # NuGet Symbol Packages 205 | **/*.snupkg 206 | # The packages folder can be ignored because of Package Restore 207 | **/[Pp]ackages/* 208 | # except build/, which is used as an MSBuild target. 209 | !**/[Pp]ackages/build/ 210 | # Uncomment if necessary however generally it will be regenerated when needed 211 | #!**/[Pp]ackages/repositories.config 212 | # NuGet v3's project.json files produces more ignorable files 213 | **/*.nuget.props 214 | **/*.nuget.targets 215 | 216 | # Microsoft Azure Build Output 217 | csx/ 218 | *.build.csdef 219 | 220 | # Microsoft Azure Emulator 221 | ecf/ 222 | rcf/ 223 | 224 | # Windows Store app package directories and files 225 | AppPackages/ 226 | BundleArtifacts/ 227 | Package.StoreAssociation.xml 228 | _pkginfo.txt 229 | *.appx 230 | *.appxbundle 231 | *.appxupload 232 | 233 | # Visual Studio cache files 234 | # files ending in .cache can be ignored 235 | *.[Cc]ache 236 | # but keep track of directories ending in .cache 237 | !?*.[Cc]ache/ 238 | 239 | # Others 240 | ClientBin/ 241 | ~$* 242 | *~ 243 | *.dbmdl 244 | *.dbproj.schemaview 245 | *.jfm 246 | *.pfx 247 | *.publishsettings 248 | orleans.codegen.cs 249 | 250 | # Including strong name files can present a security risk 251 | # (https://github.com/github/gitignore/pull/2483#issue-259490424) 252 | #*.snk 253 | 254 | # Since there are multiple workflows, uncomment next line to ignore bower_components 255 | # (https://github.com/github/gitignore/pull/1529#issuecomment-104372622) 256 | #bower_components/ 257 | 258 | # RIA/Silverlight projects 259 | Generated_Code/ 260 | 261 | # Backup & report files from converting an old project file 262 | # to a newer Visual Studio version. Backup files are not needed, 263 | # because we have git ;-) 264 | _UpgradeReport_Files/ 265 | Backup*/ 266 | UpgradeLog*.XML 267 | UpgradeLog*.htm 268 | ServiceFabricBackup/ 269 | *.rptproj.bak 270 | 271 | # SQL Server files 272 | *.mdf 273 | *.ldf 274 | *.ndf 275 | 276 | # Business Intelligence projects 277 | *.rdl.data 278 | *.bim.layout 279 | *.bim_*.settings 280 | *.rptproj.rsuser 281 | *- [Bb]ackup.rdl 282 | *- [Bb]ackup ([0-9]).rdl 283 | *- [Bb]ackup ([0-9][0-9]).rdl 284 | 285 | # Microsoft Fakes 286 | FakesAssemblies/ 287 | 288 | # GhostDoc plugin setting file 289 | *.GhostDoc.xml 290 | 291 | # Node.js Tools for Visual Studio 292 | .ntvs_analysis.dat 293 | node_modules/ 294 | 295 | # Visual Studio 6 build log 296 | *.plg 297 | 298 | # Visual Studio 6 workspace options file 299 | *.opt 300 | 301 | # Visual Studio 6 auto-generated workspace file (contains which files were open etc.) 302 | *.vbw 303 | 304 | # Visual Studio LightSwitch build output 305 | **/*.HTMLClient/GeneratedArtifacts 306 | **/*.DesktopClient/GeneratedArtifacts 307 | **/*.DesktopClient/ModelManifest.xml 308 | **/*.Server/GeneratedArtifacts 309 | **/*.Server/ModelManifest.xml 310 | _Pvt_Extensions 311 | 312 | # Paket dependency manager 313 | .paket/paket.exe 314 | paket-files/ 315 | 316 | # FAKE - F# Make 317 | .fake/ 318 | 319 | # CodeRush personal settings 320 | .cr/personal 321 | 322 | # Python Tools for Visual Studio (PTVS) 323 | __pycache__/ 324 | *.pyc 325 | 326 | # Cake - Uncomment if you are using it 327 | # tools/** 328 | # !tools/packages.config 329 | 330 | # Tabs Studio 331 | *.tss 332 | 333 | # Telerik's JustMock configuration file 334 | *.jmconfig 335 | 336 | # BizTalk build output 337 | *.btp.cs 338 | *.btm.cs 339 | *.odx.cs 340 | *.xsd.cs 341 | 342 | # OpenCover UI analysis results 343 | OpenCover/ 344 | 345 | # Azure Stream Analytics local run output 346 | ASALocalRun/ 347 | 348 | # MSBuild Binary and Structured Log 349 | *.binlog 350 | 351 | # NVidia Nsight GPU debugger configuration file 352 | *.nvuser 353 | 354 | # MFractors (Xamarin productivity tool) working folder 355 | .mfractor/ 356 | 357 | # Local History for Visual Studio 358 | .localhistory/ 359 | 360 | # BeatPulse healthcheck temp database 361 | healthchecksdb 362 | 363 | # Backup folder for Package Reference Convert tool in Visual Studio 2017 364 | MigrationBackup/ 365 | 366 | # Ionide (cross platform F# VS Code tools) working folder 367 | .ionide/ 368 | 369 | # Fody - auto-generated XML schema 370 | FodyWeavers.xsd 371 | 372 | ## 373 | ## Visual studio for Mac 374 | ## 375 | 376 | 377 | # globs 378 | Makefile.in 379 | *.userprefs 380 | *.usertasks 381 | config.make 382 | config.status 383 | aclocal.m4 384 | install-sh 385 | autom4te.cache/ 386 | *.tar.gz 387 | tarballs/ 388 | test-results/ 389 | 390 | # Mac bundle stuff 391 | *.dmg 392 | *.app 393 | 394 | # content below from: https://github.com/github/gitignore/blob/master/Global/macOS.gitignore 395 | # General 396 | .DS_Store 397 | .AppleDouble 398 | .LSOverride 399 | 400 | # Icon must end with two \r 401 | Icon 402 | 403 | 404 | # Thumbnails 405 | ._* 406 | 407 | # Files that might appear in the root of a volume 408 | .DocumentRevisions-V100 409 | .fseventsd 410 | .Spotlight-V100 411 | .TemporaryItems 412 | .Trashes 413 | .VolumeIcon.icns 414 | .com.apple.timemachine.donotpresent 415 | 416 | # Directories potentially created on remote AFP share 417 | .AppleDB 418 | .AppleDesktop 419 | Network Trash Folder 420 | Temporary Items 421 | .apdisk 422 | 423 | # content below from: https://github.com/github/gitignore/blob/master/Global/Windows.gitignore 424 | # Windows thumbnail cache files 425 | Thumbs.db 426 | ehthumbs.db 427 | ehthumbs_vista.db 428 | 429 | # Dump file 430 | *.stackdump 431 | 432 | # Folder config file 433 | [Dd]esktop.ini 434 | 435 | # Recycle Bin used on file shares 436 | $RECYCLE.BIN/ 437 | 438 | # Windows Installer files 439 | *.cab 440 | *.msi 441 | *.msix 442 | *.msm 443 | *.msp 444 | 445 | # Windows shortcuts 446 | *.lnk 447 | 448 | # JetBrains Rider 449 | .idea/ 450 | *.sln.iml 451 | 452 | ## 453 | ## Visual Studio Code 454 | ## 455 | .vscode/* 456 | !.vscode/settings.json 457 | !.vscode/tasks.json 458 | !.vscode/launch.json 459 | !.vscode/extensions.json 460 | -------------------------------------------------------------------------------- /Performance/Program.fs: -------------------------------------------------------------------------------- 1 | namespace Benchmarks 2 | 3 | open System 4 | open Form 5 | open Form.Attributes 6 | open System.Data.SQLite 7 | open Dapper 8 | open BenchmarkDotNet.Attributes 9 | open BenchmarkDotNet.Running 10 | open BenchmarkDotNet.Diagnostics.dotTrace 11 | open Configs 12 | 13 | 14 | 15 | [< 16 | MemoryDiagnoser; 17 | Config(typeof); 18 | RPlotExporter; 19 | DotTraceDiagnoser 20 | >] 21 | type InsertBenchmark() = 22 | 23 | let _sqliteState = SQLite( Data.sqliteConnectionString (), Data.Context.SQLite ) 24 | let mutable _data = Array.empty 25 | 26 | static member public DataValues = Data.collections 27 | 28 | [] 29 | member public _.Data 30 | with get() = _data 31 | and set (value) = _data <- value 32 | 33 | 34 | [] 35 | member _.Setup() = 36 | SqlMapper.AddTypeHandler (Utilities.OptionHandler()) 37 | SqlMapper.AddTypeHandler (Utilities.OptionHandler()) 38 | Orm.execute _sqliteState None Utilities.drop |> ignore 39 | Orm.execute _sqliteState None Utilities.create |> ignore 40 | 41 | [] 42 | member _.Form () = 43 | let transaction = Orm.beginTransaction _sqliteState 44 | Array.map ( Orm.insert _sqliteState transaction true ) _data 45 | |> ignore 46 | Orm.commitTransaction transaction 47 | 48 | [] 49 | member _.FormMany () = 50 | let transaction = Orm.beginTransaction _sqliteState 51 | Orm.insertMany _sqliteState transaction true _data 52 | |> ignore 53 | Orm.commitTransaction transaction 54 | 55 | [] 56 | member _.Dapper () = 57 | use connection = new SQLiteConnection( Data.sqliteConnectionString() ) 58 | connection.Open() 59 | use transaction = connection.BeginTransaction() 60 | connection.Execute("insert into \"Sanic\" values (@id, @name, @optional, @modified)", _data, transaction) |> ignore 61 | transaction.Commit() 62 | connection.Close() 63 | 64 | 65 | [] 66 | member _.ADO () = 67 | use connection = new SQLiteConnection( Data.sqliteConnectionString() ) 68 | connection.Open() 69 | use transaction = connection.BeginTransaction() 70 | use cmd = new SQLiteCommand( "insert into \"Sanic\" values (@id, @name, @optional, @modified)", connection ) 71 | cmd.Transaction <- transaction 72 | let paramId = SQLiteParameter() 73 | paramId.ParameterName <- "@id" 74 | let paramName = SQLiteParameter() 75 | paramName.ParameterName <- "@name" 76 | let paramOptional = SQLiteParameter() 77 | paramOptional.ParameterName <- "@optional" 78 | paramOptional.IsNullable <- true 79 | let paramModified = SQLiteParameter() 80 | paramModified.ParameterName <- "@modified" 81 | cmd.Parameters.Add(paramId) |> ignore 82 | cmd.Parameters.Add(paramName) |> ignore 83 | cmd.Parameters.Add(paramOptional) |> ignore 84 | cmd.Parameters.Add(paramModified) |> ignore 85 | Array.iter ( fun ( item : Data.Sanic ) -> 86 | paramId.Value <- item.id 87 | paramName.Value <- item.name 88 | match item.optional with 89 | | Some i -> paramOptional.Value <- i 90 | | None -> paramOptional.Value <- DBNull.Value 91 | paramModified.Value <- item.modified 92 | cmd.ExecuteNonQuery() |> ignore 93 | ) _data 94 | transaction.Commit() 95 | connection.Close() 96 | 97 | [< 98 | MemoryDiagnoser; 99 | Config(typeof); 100 | RPlotExporter; 101 | DotTraceDiagnoser 102 | >] 103 | type UpdateBenchmark() = 104 | 105 | let _sqliteState = SQLite( Data.sqliteConnectionString (), Data.Context.SQLite ) 106 | let mutable _data = Array.empty 107 | 108 | static member public DataValues = Data.collections 109 | 110 | [] 111 | member public _.Data 112 | with get() = _data 113 | and set (value) = _data <- value 114 | 115 | [] 116 | member _.Setup () = 117 | SqlMapper.AddTypeHandler (Utilities.OptionHandler()) 118 | SqlMapper.AddTypeHandler (Utilities.OptionHandler()) 119 | Orm.execute _sqliteState None Utilities.drop |> ignore 120 | Orm.execute _sqliteState None Utilities.create |> ignore 121 | let transaction = Orm.beginTransaction _sqliteState 122 | Orm.insertMany _sqliteState transaction true _data |> ignore 123 | Orm.commitTransaction transaction |> ignore 124 | () 125 | 126 | [] 127 | member _.Form () = 128 | let transaction = Orm.beginTransaction _sqliteState 129 | _data 130 | |> Orm.updateMany _sqliteState transaction 131 | |> ignore 132 | Orm.commitTransaction transaction 133 | 134 | [] 135 | member _.Dapper () = 136 | use connection = new SQLiteConnection( Data.sqliteConnectionString() ) 137 | connection.Open() 138 | use transaction = connection.BeginTransaction() 139 | connection.Execute("update \"Sanic\" set name = @name, optional = @optional, modified = @modified where id = @id", _data, transaction) |> ignore 140 | transaction.Commit() 141 | connection.Close() 142 | 143 | [] 144 | member _.ADO () = 145 | use connection = new SQLiteConnection( Data.sqliteConnectionString() ) 146 | connection.Open() 147 | use transaction = connection.BeginTransaction() 148 | use cmd = new SQLiteCommand( "update \"Sanic\" set name = @name, optional = @optional, modified = @modified where id = @id", connection ) 149 | cmd.Transaction <- transaction 150 | let paramId = SQLiteParameter() 151 | paramId.ParameterName <- "@id" 152 | let paramName = SQLiteParameter() 153 | paramName.ParameterName <- "@name" 154 | let paramOptional = SQLiteParameter() 155 | paramOptional.ParameterName <- "@optional" 156 | paramOptional.IsNullable <- true 157 | let paramModified = SQLiteParameter() 158 | paramModified.ParameterName <- "@modified" 159 | cmd.Parameters.Add(paramId) |> ignore 160 | cmd.Parameters.Add(paramName) |> ignore 161 | cmd.Parameters.Add(paramOptional) |> ignore 162 | cmd.Parameters.Add(paramModified) |> ignore 163 | Array.iter ( fun ( item : Data.Sanic ) -> 164 | paramId.Value <- item.id 165 | paramName.Value <- item.name 166 | match item.optional with 167 | | Some i -> paramOptional.Value <- i 168 | | None -> paramOptional.Value <- DBNull.Value 169 | paramModified.Value <- item.modified 170 | cmd.ExecuteNonQuery() |> ignore 171 | ) _data 172 | transaction.Commit() 173 | connection.Close() 174 | 175 | 176 | [< 177 | MemoryDiagnoser; 178 | Config(typeof); 179 | RPlotExporter; 180 | DotTraceDiagnoser 181 | >] 182 | type SelectBenchmark() = 183 | 184 | let _sqliteState = SQLite( Data.sqliteConnectionString (), Data.Context.SQLite ) 185 | let mutable _data = 0 186 | static member public DataValues = [| Data.small; Data.big |] 187 | 188 | [] 189 | member public _.Data 190 | with get() = _data 191 | and set (value) = _data <- value 192 | 193 | 194 | [] 195 | member _.Setup () = 196 | SqlMapper.AddTypeHandler (Utilities.OptionHandler()) 197 | SqlMapper.AddTypeHandler (Utilities.OptionHandler()) 198 | Orm.execute _sqliteState None Utilities.drop |> ignore 199 | Orm.execute _sqliteState None Utilities.create |> ignore 200 | let transaction = Orm.beginTransaction _sqliteState 201 | Orm.insertMany _sqliteState transaction true ( [| yield! Data.collectionSmall; yield! Data.collectionBig |] ) |> ignore 202 | Orm.commitTransaction transaction |> ignore 203 | () 204 | 205 | 206 | [] 207 | member _.Form () = 208 | Orm.selectLimit _sqliteState None _data 209 | |> Seq.iter ( ignore ) 210 | 211 | [] 212 | member _.Dapper () = 213 | use connection = new SQLiteConnection( Data.sqliteConnectionString() ) 214 | for _ in connection.Query($"select * from Sanic limit {_data};") do () 215 | 216 | [] 217 | member _.ADO () = 218 | use connection = new SQLiteConnection( Data.sqliteConnectionString() ) 219 | connection.Open() 220 | use cmd = new SQLiteCommand( $"select * from \"Sanic\" limit {_data}", connection ) 221 | let reader = cmd.ExecuteReader() 222 | seq { 223 | while (reader.Read()) do 224 | { 225 | id = reader.GetValue(0) :?> int //104abc3e 226 | name = reader.GetValue(1) :?> string 227 | optional = 228 | reader.GetValue(2) |> function 229 | | :? int as i -> Some i 230 | | _ -> None 231 | modified = reader.GetValue(3) :?> string 232 | } : Data.Sanic 233 | } |> Seq.iter ignore 234 | 235 | module Main = 236 | [] 237 | let main _ = 238 | DotNetEnv.Env.Load "../" |> printfn "%A" 239 | // BenchmarkRunner.Run() |> ignore 240 | // BenchmarkRunner.Run() |> ignore 241 | BenchmarkRunner.Run() |> ignore 242 | 243 | 0 244 | -------------------------------------------------------------------------------- /Test/Orm.fs: -------------------------------------------------------------------------------- 1 | module Test.Orm 2 | 3 | open Form 4 | open Form.Attributes 5 | open Form.Utilities 6 | open NUnit.Framework 7 | open HCRD.FORM.Tests.Setup 8 | 9 | 10 | type FixtureArgs = 11 | static member Source : obj seq = 12 | seq { 13 | // [| sqliteState |] 14 | [| psqlState |] 15 | // [| odbcState |] 16 | } 17 | 18 | [] 19 | type OrmSetup () = 20 | [] 21 | member _.Setup () = 22 | printfn "sqlite - %A" (System.Environment.GetEnvironmentVariable("sqlite_connection_string")) 23 | printfn "postgres - %A" (System.Environment.GetEnvironmentVariable("postgres_connection_string")) 24 | printfn "odbc - %A" (System.Environment.GetEnvironmentVariable("odbc_connection_string")) 25 | 26 | [, "Source")>] 27 | type Orm (_testingState) = 28 | let testingState = _testingState 29 | let tableName = "\"Fact\"" 30 | let testGuid1 = System.Guid.NewGuid().ToString() 31 | let testGuid2 = System.Guid.NewGuid().ToString() 32 | let testGuid3 = System.Guid.NewGuid().ToString() 33 | let testGuid4 = System.Guid.NewGuid().ToString() 34 | 35 | let nameCol = 36 | match testingState with 37 | | SQLite _ -> "sqliteName" 38 | | PSQL _ -> "psqlName" 39 | | _ -> "sqliteName" 40 | 41 | let intType = 42 | match testingState with 43 | | SQLite _ -> "integer" 44 | | PSQL _ -> "bigint" 45 | | _ -> "bigint" 46 | let transaction = 47 | None// Orm.beginTransaction testingState 48 | 49 | [] 50 | member _.Setup () = 51 | let createTable = 52 | $"DROP TABLE IF EXISTS {tableName}; 53 | DROP TABLE IF EXISTS \"SubFact\"; 54 | CREATE TABLE {tableName} ( 55 | \"indexId\" {intType} not null, 56 | \"id\" text primary key, 57 | \"{nameCol}\" text null, 58 | \"timeStamp\" text, 59 | \"specialChar\" text, 60 | \"maybeSomething\" text, 61 | \"sometimesNothing\" {intType} null, 62 | \"biteSize\" text 63 | ); 64 | CREATE TABLE \"SubFact\" ( 65 | \"factId\" {intType} not null, 66 | \"subFact\" text not null 67 | ); 68 | " 69 | 70 | Orm.execute testingState None createTable |> printfn "Create Table Returns: %A" 71 | 72 | [] 73 | [] 74 | member _.Connect () = 75 | printfn "Contest: %A\n\n\n\n\n" (System.Environment.GetEnvironmentVariable("sqlite_connection_string")) 76 | match Orm.connect testingState with 77 | | Ok _ -> Assert.Pass() 78 | | Error e -> Assert.Fail(e.ToString()) 79 | 80 | 81 | [] 82 | [] 83 | member _.Insert () = 84 | match Orm.insert< Fact > testingState None true ( Fact.init() ) with 85 | | Ok _ -> Assert.Pass() 86 | | Error e -> Assert.Fail(e.ToString()) 87 | 88 | [] 89 | [] 90 | member _.InsertMany () = 91 | let str8Facts = [{ Fact.init() with id = testGuid1}; { Fact.init() with id = testGuid2; sometimesNothing = None }; { Fact.init() with id = testGuid3}; Fact.init()] 92 | match Orm.insertMany< Fact > testingState None true ( str8Facts ) with 93 | | Ok _ -> Assert.Pass() 94 | | Error e -> Assert.Fail(e.ToString()) 95 | 96 | [] 97 | [] 98 | member _.AsyncInsertMany () = 99 | async { 100 | let str8Facts = [{ Fact.init() with id = testGuid1}; { Fact.init() with id = testGuid2; sometimesNothing = None }; { Fact.init() with id = testGuid3}; Fact.init()] 101 | match Orm.insertMany< Fact > testingState None true ( str8Facts ) with 102 | | Ok _ -> 103 | System.Threading.Thread.Sleep(10000) 104 | Assert.Pass() 105 | | Error e -> Assert.Fail(e.ToString()) 106 | } 107 | |> Async.RunSynchronously 108 | 109 | 110 | [] 111 | [] 112 | member _.QueryBuild () = 113 | printfn "%A" (queryBase< Fact > testingState) 114 | Assert.Pass() 115 | 116 | 117 | [] 118 | [] 119 | member _.Select () = 120 | printfn "Selecting All..." 121 | match Orm.selectAll< Fact > testingState None with 122 | | Ok facts -> 123 | Seq.iter ( printfn "%A") facts 124 | Assert.Pass(sprintf "facts: %A" facts) 125 | | Error e -> Assert.Fail(e.ToString()) 126 | 127 | [] 128 | [] 129 | member _.AsyncSelect () = 130 | printfn "Asynchronously Selecting All..." 131 | async { 132 | match Orm.selectAll< Fact > testingState None with 133 | | Ok facts -> 134 | // let newFacts = Seq.toList facts 135 | Seq.iter ( printfn "%A") facts 136 | match testingState with 137 | | SQLite _ -> () 138 | | _ -> System.Threading.Thread.Sleep(10000) 139 | Assert.Pass(sprintf "facts: %A" facts) 140 | | Error e -> Assert.Fail(e.ToString()) 141 | } 142 | |> Async.RunSynchronously 143 | 144 | [] 145 | [] 146 | member _.SelectLimit () = 147 | printfn "Selecting All..." 148 | match Orm.selectLimit< Fact > testingState None 5 with 149 | | Ok facts -> 150 | Seq.iter ( printfn "%A") facts 151 | Assert.Pass(sprintf "facts: %A" facts) 152 | | Error e -> Assert.Fail(e.ToString()) 153 | 154 | [] 155 | [] 156 | member _.SelectWhere () = 157 | printfn "Selecting Where..." 158 | match Orm.selectWhere< Fact > testingState None "\"maybeSomething\" = 'true'" with 159 | | Ok facts -> 160 | Assert.Pass(sprintf "facts: %A" (facts)) 161 | | Error e -> Assert.Fail(e.ToString()) 162 | 163 | 164 | [] 165 | [] 166 | member _.Update () = 167 | printfn "Updating..." 168 | let initial = { Fact.init() with id = testGuid1 } 169 | let changed = { initial with name = "Evan Towlett"} 170 | match Orm.update< Fact > testingState None changed with 171 | | Ok inserted -> 172 | Assert.Pass(sprintf "facts: %A" inserted) 173 | | Error e -> Assert.Fail(e.ToString()) 174 | 175 | 176 | [] 177 | [] 178 | member _.UpdateMany () = 179 | printfn "Updating many..." 180 | let initial = Fact.init() 181 | let changed = { initial with name = "Evan Mowlett"; id = testGuid3 ; subFact= None} 182 | let changed2 = { initial with name = "Mac Flibby"; id = testGuid2; subFact = None} 183 | Orm.updateMany< Fact > testingState None [changed;changed2] |> printf "%A" 184 | 185 | let evan = Orm.selectWhere testingState None $"id = '{testGuid3}'" 186 | let mac = Orm.selectWhere testingState None $"id = '{testGuid2}'" 187 | 188 | match evan, mac with 189 | | Ok e, Ok m -> 190 | if Seq.head e = changed && Seq.head m = changed2 191 | then Assert.Pass() 192 | else Assert.Fail("Failed comparison.") 193 | | _, _ -> 194 | Assert.Fail("Couldn't verify update happened") 195 | 196 | 197 | 198 | // [] 199 | // [] 200 | // member _.UpdateManyWithTransaction () = 201 | // printfn "Updating many with transaction..." 202 | // let initial = Fact.init() 203 | // let changed = { initial with name = "Evan Mowlett"; id = testGuid3} 204 | // let changed2 = { initial with name = "Mac Flibby"; id = testGuid2} 205 | // Orm.updateMany< Fact > testingState [changed;changed2] transaction 206 | // |> printf "%A" 207 | 208 | // Assert.Pass() 209 | 210 | [] 211 | [] 212 | member _.UpdateWhere () = 213 | printfn "Updating..." 214 | let initial = Fact.init () 215 | let changed = { initial with name = "Evan Howlett"} 216 | match Orm.updateWhere< Fact > testingState None "\"indexId\" = 1" changed with 217 | | Ok inserted -> 218 | Assert.Pass(sprintf "facts: %A" inserted) 219 | | Error e -> Assert.Fail(e.ToString()) 220 | 221 | 222 | [] 223 | [] 224 | member _.Delete () = 225 | printfn "Deleting..." 226 | let initial = Fact.init () 227 | let changed = { initial with name = "Evan Howlett"} 228 | match Orm.delete< Fact > testingState None changed with 229 | | Ok inserted -> 230 | Assert.Pass(sprintf "facts: %A" inserted) 231 | | Error e -> Assert.Fail(e.ToString()) 232 | 233 | 234 | 235 | [] 236 | [] 237 | member _.DeleteWhere () = 238 | printfn "Deleting Where..." 239 | match Orm.deleteWhere< Fact > testingState None "\"indexId\" = 1" with 240 | | Ok inserted -> 241 | Assert.Pass(sprintf "facts: %A" inserted) 242 | | Error e -> Assert.Fail(e.ToString()) 243 | 244 | 245 | [] 246 | [] 247 | member _.DeleteMany () = 248 | printfn "Deleting Many..." 249 | let initial = Fact.init() 250 | let changed = { initial with name = "Evan Mowlett"; id = testGuid3} 251 | let changed2 = { initial with name = "Mac Flibby"; id = testGuid2} 252 | Orm.deleteMany< Fact > testingState None [changed;changed2] 253 | |> function 254 | | Ok i -> Assert.Pass(sprintf "%A" i ) 255 | | Error e -> Assert.Fail(sprintf "%A" e) 256 | 257 | 258 | 259 | [] 260 | [] 261 | member _.Reader () = 262 | printfn "Reading..." 263 | Orm.consumeReader testingState 264 | |> fun reader -> Orm.executeWithReader testingState None "select * from \"Fact\"" reader 265 | |> function 266 | | Ok facts -> Assert.Pass(sprintf "%A" facts) 267 | | Error e -> Assert.Fail(sprintf "%A" e) 268 | 269 | 270 | 271 | // [] 272 | // [] 273 | // member _.ReaderWithTransaction () = 274 | // printfn "Reading..." 275 | // Orm.consumeReader testingState 276 | // |> fun reader -> Orm.executeWithReader testingState "select * from \"Fact\"" reader transaction 277 | // |> function 278 | // | Ok facts -> Assert.Pass(sprintf "%A" facts) 279 | // | Error e -> Assert.Fail(sprintf "%A" e) 280 | 281 | 282 | // [] 283 | [] 284 | [] 285 | member _.TearDown () = 286 | transaction 287 | |> Option.map ( Orm.commitTransaction ) 288 | |> sprintf "Transaction: %A" 289 | |> Assert.Pass 290 | 291 | [, "Source")>] 292 | type OrmTransaction ( _testingState ) = 293 | let testingState = _testingState 294 | let tableName = "\"Fact\"" 295 | let testGuid1 = System.Guid.NewGuid().ToString() 296 | let testGuid2 = System.Guid.NewGuid().ToString() 297 | let testGuid3 = System.Guid.NewGuid().ToString() 298 | let testGuid4 = System.Guid.NewGuid().ToString() 299 | 300 | let nameCol = 301 | match testingState with 302 | | SQLite _ -> "sqliteName" 303 | | PSQL _ -> "psqlName" 304 | | _ -> "sqliteName" 305 | 306 | let intType = 307 | match testingState with 308 | | SQLite _ -> "integer" 309 | | PSQL _ -> "bigint" 310 | | _ -> "bigint" 311 | 312 | let sleep () = System.Threading.Thread.Sleep(500) 313 | 314 | let commit transaction x = Orm.tryCommit transaction |> ignore; x 315 | 316 | [] 317 | member _.Setup () = 318 | let createTable = 319 | $"DROP TABLE IF EXISTS {tableName}; 320 | DROP TABLE IF EXISTS \"SubFact\"; 321 | CREATE TABLE {tableName} ( 322 | \"indexId\" {intType} not null, 323 | \"id\" text primary key, 324 | \"{nameCol}\" text null, 325 | \"timeStamp\" text, 326 | \"specialChar\" text, 327 | \"maybeSomething\" text, 328 | \"sometimesNothing\" {intType} null, 329 | \"biteSize\" text 330 | ); 331 | CREATE TABLE \"SubFact\" ( 332 | \"factId\" {intType} not null, 333 | \"subFact\" text not null 334 | );" 335 | 336 | 337 | Orm.execute testingState None createTable |> printfn "Create Table Returns: %A" 338 | 339 | 340 | [] 341 | [] 342 | member _.InsertSelect () = 343 | // sleep () 344 | let transaction = Orm.beginTransaction testingState 345 | let theFact = {Fact.init() with subFact = None} 346 | let mutable theBackFact = Fact.init() 347 | printfn "Do we have a transaction? %A" transaction 348 | // Orm.insert< SubFact > testingState true ({factId = theFact.indexId; subFact = "woooo"}) transaction |> ignore 349 | Orm.insert< Fact > testingState transaction true ( theFact ) 350 | |> Result.bind ( fun _ -> 351 | printfn "We have inserted" 352 | Orm.selectWhere< Fact > testingState transaction $"id = '{theFact.id}'" 353 | |> fun x -> printfn "We have the facts: %A" x; x 354 | |> function 355 | | Ok facts when Seq.length facts > 0 -> 356 | theBackFact <- Seq.head facts 357 | Ok facts 358 | | Error e -> Error e 359 | | _ -> Error (exn "No data returned by select, you forgot the facts!") 360 | ) 361 | |> Result.map ( fun _ -> Orm.commitTransaction transaction ) 362 | |> Result.mapError ( fun _ -> Orm.rollbackTransaction transaction ) 363 | |> function 364 | | Ok _ -> 365 | if theFact = theBackFact 366 | then Assert.Pass() 367 | else Assert.Fail(sprintf "%A %A %A" testingState theFact theBackFact) 368 | | Error error -> Assert.Fail(sprintf "%A %A" testingState (error.ToString())) 369 | 370 | 371 | 372 | [] 373 | [] 374 | member _.InsertDeleteSelect () = 375 | // sleep () 376 | let transaction = Orm.beginTransaction testingState 377 | let theFact = Fact.init() 378 | let mutable theBackFact = Fact.init() 379 | let err = exn "No data returned by select, you forgot the facts!" 380 | printfn "Do we have a transaction? %A" transaction 381 | // Orm.insert< SubFact > testingState true ({factId = theFact.indexId; subFact = "woooo"}) transaction |> ignore 382 | Orm.insert< Fact > testingState transaction true ( theFact ) 383 | |> Result.bind ( fun _ -> Orm.delete< Fact > testingState transaction theFact ) 384 | |> Result.bind ( fun _ -> 385 | Orm.selectWhere< Fact > testingState transaction $"id = '{theFact.id}'" 386 | |> function 387 | | Ok facts when Seq.length facts > 0 -> 388 | theBackFact <- Seq.head facts 389 | Ok facts 390 | | Error e -> Error e 391 | | _ -> Error err 392 | ) 393 | |> commit transaction 394 | |> function 395 | | Ok _ -> Assert.Fail(sprintf "%A %A" theFact theBackFact) 396 | | Error error -> 397 | if err = error 398 | then Assert.Pass() 399 | else Assert.Fail(error.ToString()) 400 | 401 | 402 | [] 403 | [] 404 | member _.InsertUpdateSelect () = 405 | // sleep () 406 | let transaction = Orm.beginTransaction testingState 407 | let theFact = Fact.init() 408 | let theNewFact = { theFact with name = "All Facts, All the Time"; subFact = None } 409 | let mutable theBackFact = Fact.init() 410 | let err = exn "No data returned by select, you forgot the facts!" 411 | printfn "Do we have a transaction? %A" transaction 412 | 413 | Orm.insert< Fact > testingState transaction true ( theFact ) 414 | |> Result.bind ( fun _ -> Orm.update< Fact > testingState transaction theNewFact ) 415 | |> Result.bind ( fun _ -> 416 | Orm.selectWhere< Fact > testingState transaction $"id = '{theFact.id}'" 417 | |> function 418 | | Ok facts when Seq.length facts > 0 -> 419 | theBackFact <- Seq.head facts 420 | Ok facts 421 | | Error e -> Error e 422 | | _ -> Error err 423 | ) 424 | |> commit transaction 425 | |> function 426 | | Ok facts -> 427 | if theNewFact = theBackFact 428 | then 429 | Assert.Pass(sprintf "You remembered the facts: %A - %A | %A" theFact theBackFact facts) 430 | else 431 | Assert.Fail(sprintf "Look at all these facts: %A - %A | %A" theFact theBackFact facts) 432 | | Error error -> 433 | Assert.Fail(error.ToString()) 434 | 435 | [] 436 | [] 437 | member _.ReaderWithTransaction () = 438 | printfn "Reading..." 439 | let transaction = Orm.beginTransaction testingState 440 | Orm.consumeReader testingState 441 | |> fun reader -> Orm.executeWithReader testingState transaction "select * from \"Fact\"" reader 442 | |> commit transaction 443 | |> function 444 | | Ok facts -> Assert.Pass(sprintf "%A" facts) 445 | | Error e -> Assert.Fail(sprintf "%A" e) 446 | 447 | 448 | // // [] 449 | // [] 450 | // [] 451 | // member _.TearDown () = 452 | // transaction 453 | // |> Option.map ( Orm.commitTransaction ) 454 | // |> sprintf "Transaction: %A" 455 | // |> Assert.Pass 456 | -------------------------------------------------------------------------------- /Test/Program.fs: -------------------------------------------------------------------------------- 1 | namespace HCRD.FORM.Tests 2 | 3 | 4 | module Main = 5 | open Setup 6 | open Form 7 | open Form.Attributes 8 | open Expecto 9 | open System.IO 10 | 11 | let outputPath = "./console.log" 12 | let constructTest name message f = 13 | test name { 14 | Expect.wantOk ( f () |> Result.map ( fun _ -> () )) message 15 | } 16 | 17 | let constructFailureTest name message f = 18 | test name { 19 | Expect.wantError ( f () |> Result.mapError ( fun _ -> () )) message 20 | } 21 | 22 | let tableName = "\"Fact\"" 23 | let nameCol = function 24 | | SQLite _ -> "sqliteName" 25 | | PSQL _ -> "psqlName" 26 | | ODBC _ -> "psqlName" 27 | | _ -> "idk" 28 | let intType = function 29 | | SQLite _ -> "integer" 30 | | _ -> "bigint" 31 | 32 | let orm testingState = 33 | let testGuid1 = System.Guid.NewGuid().ToString() 34 | let testGuid2 = System.Guid.NewGuid().ToString() 35 | let testGuid3 = System.Guid.NewGuid().ToString() 36 | let testGuid4 = System.Guid.NewGuid().ToString() 37 | 38 | let transaction = 39 | None// Orm.beginTransaction testingState 40 | 41 | 42 | let setup () = 43 | constructTest 44 | "" 45 | "" 46 | ( fun _ -> 47 | let createTable = 48 | $"DROP TABLE IF EXISTS {tableName}; 49 | DROP TABLE IF EXISTS \"SubFact\"; 50 | CREATE TABLE {tableName} ( 51 | \"indexId\" {intType testingState} not null, 52 | \"id\" text primary key, 53 | \"{nameCol testingState}\" text null, 54 | \"timeStamp\" text, 55 | \"specialChar\" text, 56 | \"maybeSomething\" text, 57 | \"sometimesNothing\" {intType testingState} null, 58 | \"biteSize\" text 59 | ); 60 | CREATE TABLE \"SubFact\" ( 61 | \"factId\" {intType testingState} not null, 62 | \"subFact\" text not null 63 | ); 64 | " 65 | 66 | Orm.execute testingState None createTable 67 | |> fun x -> printfn "Setup: %A" x; x 68 | ) 69 | 70 | let connect () = 71 | constructTest "Connect" "Successfully connected." ( fun _ -> Orm.connect testingState ) 72 | 73 | let insert () = 74 | constructTest "Insert" "Fact inserted." ( fun _ -> Orm.insert< Fact > testingState None true ( Fact.init() ) ) 75 | 76 | let insertMany () = 77 | constructTest 78 | "InsertMany" 79 | "Inserted many facts." 80 | ( fun _ -> 81 | let str8Facts = [{ Fact.init() with id = testGuid1}; { Fact.init() with id = testGuid2; sometimesNothing = None }; { Fact.init() with id = testGuid3}; Fact.init()] 82 | Orm.insertMany< Fact > testingState None true ( str8Facts ) 83 | ) 84 | 85 | // let asyncInsertMany () = 86 | // constructTest 87 | // "InsertMany-Async" 88 | // "Inserted many facts asynchronously." 89 | // (fun _ -> 90 | // let str8Facts = [{ Fact.init() with id = testGuid1}; { Fact.init() with id = testGuid2; sometimesNothing = None }; { Fact.init() with id = testGuid3}; Fact.init()] 91 | // Orm.insertMany< Fact > testingState None true ( str8Facts ) 92 | // ) 93 | 94 | let select () = 95 | constructTest 96 | "Select" 97 | "Select" 98 | ( fun _ -> Orm.selectAll< Fact > testingState None |> Orm.toResultSeq ) 99 | 100 | // let asyncSelect () = 101 | // constructTest 102 | // "Select-Async" 103 | // "Select-Async" 104 | // (fun _ -> Orm.selectAll< Fact > testingState None) 105 | 106 | let selectLimit () = 107 | constructTest 108 | "SelectLimit" 109 | "SelectLimit" 110 | (fun _ -> Orm.selectLimit< Fact > testingState None 5 |> Orm.toResultSeq) 111 | 112 | let selectWhere () = 113 | constructTest 114 | "SelectWhere" 115 | "SelectWhere" 116 | (fun _ -> Orm.selectWhere< Fact > testingState None ( "\"maybeSomething\" = ':1'", [| "true" |]) |> Orm.toResultSeq ) 117 | 118 | let selectWhereWithIn () = 119 | constructTest 120 | "SelectWhereWithIn" 121 | "SelectWhereWithIn" 122 | (fun _ -> Orm.selectWhere< Fact > testingState None ( """("id" in (:1) and "maybeSomething" = ':2') or "indexId" in (:3)""", [| [ testGuid1; testGuid2; testGuid3 ]; "false"; [ 1.4; 2.2; 3.5 ] |]) |> Orm.toResultSeq ) 123 | 124 | let selectWhereWithInFailure () = 125 | test "SelectWhereWithInFailure" { 126 | Expect.wantError ( 127 | Orm.selectWhere< Fact > testingState None ( """("id" in (:1) and "maybeSomething" = ':2') or "indexId" in (:3)""", [| [ testGuid1; testGuid2; testGuid3 ]; "false"; [ Fact.init(); Fact.init(); Fact.init() ] |]) 128 | |> Orm.toResultSeq ) "SelectWhereWithInFailure" 129 | |> ignore 130 | } 131 | let update () = 132 | constructTest 133 | "Update" 134 | "Update" 135 | (fun _ -> 136 | let initial = { Fact.init() with id = testGuid1 } 137 | let changed = { initial with name = "Evan Towlett"} 138 | Orm.update< Fact > testingState None changed 139 | ) 140 | 141 | let updateMany () = 142 | constructTest 143 | "UpdateMany" 144 | "UpdateMany" 145 | ( fun _ -> 146 | let initial = Fact.init() 147 | // let str8Facts = [{ Fact.init() with id = testGuid1}; { Fact.init() with id = testGuid2; sometimesNothing = None }; { Fact.init() with id = testGuid3}; Fact.init()] 148 | // Orm.insertMany< Fact > testingState None true ( str8Facts ) 149 | // |> printfn "insert %A" 150 | let changed = { initial with name = "Evan Mowlett"; id = testGuid3 ; subFact= None} 151 | let changed2 = { initial with name = "Mac Flibby"; id = testGuid2; subFact = None} 152 | printfn "ids: %A" [testGuid2; testGuid3] 153 | Orm.updateMany< Fact > testingState None [changed;changed2] |> printf "%A" 154 | 155 | let evan = Orm.selectWhere testingState None ( "id = ':1'", [| testGuid3 |] ) |> Orm.toResultSeq 156 | let mac = Orm.selectWhere testingState None ( "id = ':1'", [| testGuid2 |] ) |> Orm.toResultSeq 157 | printfn "evan: %A" evan 158 | printfn "mac: %A" mac 159 | match evan, mac with 160 | | Ok e, Ok m -> 161 | if Seq.head e = changed && Seq.head m = changed2 162 | then Ok () 163 | else Result.Error "Update not applied." 164 | | Result.Error ex, _ 165 | | _, Result.Error ex -> Result.Error ex.Message 166 | 167 | ) 168 | 169 | 170 | 171 | let updateWhere () = 172 | constructTest 173 | "UpdateWhere" 174 | "UpdateWhere" 175 | (fun _ -> 176 | let initial = Fact.init () 177 | let changed = { initial with name = "Evan Howlett"} 178 | Orm.updateWhere< Fact > testingState None ( "\"indexId\" = :1", [| "1" |] ) changed 179 | ) 180 | 181 | let delete () = 182 | constructTest 183 | "Delete" 184 | "Delete" 185 | ( fun _ -> 186 | let initial = Fact.init () 187 | let changed = { initial with name = "Evan Howlett"} 188 | Orm.delete< Fact > testingState None changed 189 | ) 190 | let deleteWhere () = 191 | constructTest 192 | "DeleteWhere" 193 | "DeleteWhere" 194 | (fun _ -> Orm.deleteWhere< Fact > testingState None ( "\"indexId\" = :1", [| "1" |] ) ) 195 | 196 | let deleteMany () = 197 | constructTest 198 | "DeleteMany" 199 | "DeleteMany" 200 | (fun _ -> 201 | let initial = Fact.init() 202 | let changed = { initial with name = "Evan Mowlett"; id = testGuid3} 203 | let changed2 = { initial with name = "Mac Flibby"; id = testGuid2} 204 | Orm.deleteMany< Fact > testingState None [changed;changed2] 205 | ) 206 | let reader () = 207 | constructTest 208 | "Reader" 209 | "Reader" 210 | (fun _ -> 211 | Orm.consumeReader testingState 212 | |> fun reader -> Orm.executeWithReader testingState None "select * from \"Fact\"" reader |> Orm.toResultSeq 213 | ) 214 | 215 | // 216 | // 217 | // let readerWithTransaction () = 218 | // printfn "Reading..." 219 | // Orm.consumeReader testingState 220 | // |> fun reader -> Orm.executeWithReader testingState "select * from \"Fact\"" reader transaction 221 | // |> function 222 | // | Ok facts -> Assert.Pass(sprintf "%A" facts) 223 | // | Result.Error e -> Assert.Fail(sprintf "%A" e) 224 | 225 | 226 | // 227 | 228 | 229 | let tearDown () = 230 | constructTest 231 | "Teardown" 232 | "Teardown" 233 | ( fun _ -> 234 | transaction 235 | |> Option.map ( Orm.commitTransaction ) 236 | |> function 237 | | Some o -> Result.Error "" 238 | | None -> Ok () 239 | ) 240 | 241 | testSequenced <| testList "Base ORM tests" [ 242 | connect () 243 | setup () 244 | testSequenced <| testList "Tests" [ 245 | insert () 246 | insertMany () 247 | // // asyncInsertMany () 248 | select () 249 | // asyncSelect () 250 | selectLimit () 251 | selectWhere () 252 | selectWhereWithIn () 253 | selectWhereWithInFailure () 254 | update () 255 | updateMany () 256 | updateWhere () 257 | delete () 258 | deleteWhere () 259 | deleteMany () 260 | reader () 261 | ] 262 | tearDown () 263 | ] 264 | 265 | 266 | 267 | let transaction testingState = 268 | let tableName = "\"Fact\"" 269 | let testGuid1 = System.Guid.NewGuid().ToString() 270 | let testGuid2 = System.Guid.NewGuid().ToString() 271 | let testGuid3 = System.Guid.NewGuid().ToString() 272 | let testGuid4 = System.Guid.NewGuid().ToString() 273 | 274 | let sleep () = System.Threading.Thread.Sleep(500) 275 | 276 | let commit transaction x = Orm.tryCommit transaction |> ignore; x 277 | 278 | let setup () = 279 | constructTest 280 | "" 281 | "" 282 | ( fun _ -> 283 | let createTable = 284 | $"DROP TABLE IF EXISTS {tableName}; 285 | DROP TABLE IF EXISTS \"SubFact\"; 286 | CREATE TABLE {tableName} ( 287 | \"indexId\" {intType testingState} not null, 288 | \"id\" text primary key, 289 | \"{nameCol testingState}\" text null, 290 | \"timeStamp\" text, 291 | \"specialChar\" text, 292 | \"maybeSomething\" text, 293 | \"sometimesNothing\" {intType testingState} null, 294 | \"biteSize\" text 295 | ); 296 | CREATE TABLE \"SubFact\" ( 297 | \"factId\" {intType testingState} not null, 298 | \"subFact\" text not null 299 | ); 300 | " 301 | 302 | Orm.execute testingState None createTable 303 | ) 304 | 305 | let insertSelect () = 306 | constructTest 307 | "InsertSelect" 308 | "InsertSelect" 309 | (fun _ -> 310 | let transaction = Orm.beginTransaction testingState 311 | let theFact = {Fact.init() with subFact = None} 312 | let mutable theBackFact = Fact.init() 313 | Orm.insert< Fact > testingState transaction true ( theFact ) 314 | |> Result.bind ( fun _ -> 315 | printfn "We have inserted" 316 | Orm.selectWhere< Fact > testingState transaction ("id = ':1'", [|theFact.id|]) 317 | |> Orm.toResultSeq 318 | |> fun x -> printfn "We have the facts: %A" x; x 319 | |> function 320 | | Ok facts when Seq.length facts > 0 -> 321 | theBackFact <- Seq.head facts 322 | Ok facts 323 | | Result.Error e -> Result.Error e 324 | | _ -> Result.Error (exn "No data returned by select, you forgot the facts!") 325 | ) 326 | |> Result.map ( fun _ -> Orm.commitTransaction transaction ) 327 | |> Result.mapError ( fun _ -> Orm.rollbackTransaction transaction ) 328 | |> function 329 | | Ok _ -> 330 | if theFact = theBackFact 331 | then Ok () 332 | else Result.Error (sprintf "%A %A %A" testingState theFact theBackFact) 333 | | Result.Error error -> Result.Error (sprintf "%A %A" testingState (error.ToString())) 334 | ) 335 | 336 | let insertDeleteSelect () = 337 | constructTest 338 | "InsertDeleteSelect" 339 | "InsertDeleteSelect" 340 | ( fun _ -> 341 | let transaction = Orm.beginTransaction testingState 342 | let theFact = Fact.init() 343 | let mutable theBackFact = Fact.init() 344 | let err = exn "No data returned by select, you forgot the facts!" 345 | // Orm.insert< SubFact > testingState true ({factId = theFact.indexId; subFact = "woooo"}) transaction |> ignore 346 | Orm.insert< Fact > testingState transaction true ( theFact ) 347 | |> Result.bind ( fun _ -> Orm.delete< Fact > testingState transaction theFact ) 348 | |> Result.bind ( fun _ -> 349 | Orm.selectWhere< Fact > testingState transaction ("id = ':1'", [|theFact.id|]) 350 | |> Orm.toResultSeq 351 | |> function 352 | | Ok facts when Seq.length facts > 0 -> 353 | theBackFact <- Seq.head facts 354 | Ok facts 355 | | Result.Error e -> Result.Error e 356 | | _ -> Result.Error err 357 | ) 358 | |> commit transaction 359 | |> function 360 | | Ok _ -> Result.Error (sprintf "%A %A" theFact theBackFact) 361 | | Result.Error error -> 362 | if err = error 363 | then Ok () 364 | else Result.Error(error.ToString()) 365 | ) 366 | 367 | let insertUpdateSelect () = 368 | constructTest 369 | "InsertUpdateSelect" 370 | "InsertUpdateSelect" 371 | (fun _ -> 372 | let transaction = Orm.beginTransaction testingState 373 | let theFact = Fact.init() 374 | let theNewFact = { theFact with name = "All Facts, All the Time"; subFact = None } 375 | let mutable theBackFact = Fact.init() 376 | let err = exn "No data returned by select, you forgot the facts!" 377 | 378 | Orm.insert< Fact > testingState transaction true ( theFact ) 379 | |> Result.bind ( fun _ -> Orm.update< Fact > testingState transaction theNewFact ) 380 | |> Result.bind ( fun _ -> 381 | Orm.selectWhere< Fact > testingState transaction ("id = ':1'", [|theFact.id|]) 382 | |> Orm.toResultSeq 383 | |> function 384 | | Ok facts when Seq.length facts > 0 -> 385 | theBackFact <- Seq.head facts 386 | Ok facts 387 | | Result.Error e -> Result.Error e 388 | | _ -> Result.Error err 389 | ) 390 | |> commit transaction 391 | |> function 392 | | Ok facts -> 393 | if theNewFact = theBackFact 394 | then 395 | Ok(sprintf "You remembered the facts: %A - %A | %A" theFact theBackFact facts) 396 | else 397 | Result.Error(sprintf "Look at all these facts: %A - %A | %A" theFact theBackFact facts) 398 | | Result.Error error -> 399 | Result.Error(error.ToString()) 400 | ) 401 | 402 | let readerWithTransaction () = 403 | constructTest 404 | "Reader-Transaction" 405 | "Reader with Transaction" 406 | (fun _ -> 407 | let transaction = Orm.beginTransaction testingState 408 | Orm.consumeReader testingState 409 | |> fun reader -> Orm.executeWithReader testingState transaction "select * from \"Fact\"" reader 410 | |> Orm.toResultSeq 411 | |> commit transaction 412 | ) 413 | 414 | testSequenced <| testList "Base ORM tests" [ 415 | setup () 416 | testSequenced <| testList "Tests" [ 417 | insertSelect () 418 | insertDeleteSelect () 419 | insertUpdateSelect () 420 | readerWithTransaction () 421 | ] 422 | ] 423 | 424 | 425 | [] 426 | let main argv = 427 | System.IO.File.ReadAllLines("../.env") 428 | |> Array.iter( fun line -> 429 | let chunks = line.Split("=") 430 | let variable = chunks[0] 431 | let value = System.String.Join("=", chunks[1..]) 432 | printfn "%A %A" variable value 433 | System.Environment.SetEnvironmentVariable(variable, value) 434 | ) 435 | 436 | 437 | let psqlConnectionString = System.Environment.GetEnvironmentVariable("postgres_connection_string") 438 | let odbcConnectionString = System.Environment.GetEnvironmentVariable("odbc_connection_string") 439 | let mysqlConnectionString = "" 440 | let mssqlConnectionString = "" 441 | let sqliteConnectionString = System.Environment.GetEnvironmentVariable("sqlite_connection_string") 442 | 443 | let psqlState = PSQL( psqlConnectionString , Contexts.PSQL ) 444 | let mysqlState = MySQL( mysqlConnectionString , Contexts.MySQL ) 445 | let mssqlState = MSSQL( mssqlConnectionString , Contexts.MSSQL ) 446 | let sqliteState = SQLite( sqliteConnectionString , Contexts.SQLite ) 447 | let odbcState = ODBC( odbcConnectionString , Contexts.ODBC ) 448 | 449 | let states = 450 | [ 451 | odbcState 452 | psqlState 453 | sqliteState 454 | // ; mysqlState 455 | // ; mssqlstate 456 | ] 457 | 458 | // use fs = new FileStream(outputPath, FileMode.Create) 459 | // use writer = new StreamWriter( fs, System.Text.Encoding.UTF8 ) 460 | 461 | // writer.AutoFlush <- true 462 | 463 | // System.Console.SetOut(writer) 464 | // System.Console.SetError(writer) 465 | 466 | states 467 | |> List.map ( 468 | orm 469 | >> runTestsWithCLIArgs [] argv 470 | ) 471 | |> printfn "%A" 472 | 473 | // states 474 | // |> List.map ( 475 | // transaction 476 | // >> runTestsWithCLIArgs [] argv 477 | // ) 478 | // |> printfn "%A" 479 | // let testGuid1 = System.Guid.NewGuid().ToString() 480 | // let testGuid2 = System.Guid.NewGuid().ToString() 481 | // let testGuid3 = System.Guid.NewGuid().ToString() 482 | // Orm.selectWhere< Fact > sqliteState None ( """("id" in (:1) and "maybeSomething" = ':2') or "indexId" in (:3)""", [| [ testGuid1; testGuid2; testGuid3 ]; "false"; [ Fact.init(); Fact.init(); Fact.init() ] |]) |> Orm.toResultSeq 483 | // |> printfn "Direct: %A" 484 | 485 | 0 486 | -------------------------------------------------------------------------------- /Lib/ORM.fs: -------------------------------------------------------------------------------- 1 | namespace Form 2 | 3 | 4 | module Orm = 5 | open System 6 | open System.Data 7 | open FSharp.Reflection 8 | open Npgsql 9 | open System.Data.SQLite 10 | open MySqlConnector 11 | open System.Data.Common 12 | open Form.Attributes 13 | open Utilities 14 | open Logging 15 | 16 | ///Stores the flavor And context used for a particular connection. 17 | let inline connect ( state : OrmState ) = Utilities.connect state 18 | 19 | let inline beginTransaction ( state : OrmState ) = 20 | match connect state with 21 | | Ok connection -> 22 | try 23 | Some ( connection.BeginTransaction() ) 24 | with 25 | | exn -> 26 | // log ( sprintf "Exception when beginning transaction: %A" exn ) 27 | None 28 | | Error e -> 29 | // log ( sprintf "Error when beginning transaction: %A" e ) 30 | None 31 | 32 | let commitTransaction = 33 | Option.map ( fun ( transaction : DbTransaction ) -> transaction.Commit() ) 34 | let rollbackTransaction = 35 | Option.map ( fun ( transaction : DbTransaction ) -> transaction.Rollback() ) 36 | 37 | let tryCommit (transaction : DbTransaction option) = // option -> Result 38 | try 39 | commitTransaction transaction |> Ok 40 | with 41 | | exn -> 42 | rollbackTransaction transaction |> ignore 43 | exn |> Error 44 | 45 | let inline consumeReader<^T > ( state : OrmState ) ( reader : IDataReader ) = Utilities.consumeReader<^T> state reader 46 | 47 | ///WARNING! Execute takes a raw string literal to execute against the specified DB state, which is inherently unsafe and vulnerable to SQL injection, do not use this in a context where strings aren't being escaped properly before hand. 48 | let inline execute ( state : OrmState ) ( transaction : DbTransaction option ) sql = 49 | transaction 50 | |> withTransaction 51 | state 52 | ( fun transaction -> 53 | use cmd = makeCommand state sql ( transaction.Connection ) 54 | cmd.Transaction <- transaction 55 | seq { 56 | try cmd.ExecuteNonQuery( ) |> Ok 57 | with exn -> Error exn 58 | } 59 | ) 60 | ( fun connection -> 61 | let transaction = connection.BeginTransaction() 62 | try 63 | seq { 64 | use cmd = makeCommand state sql connection 65 | // printfn "Execute Cmd: %A" cmd.CommandText 66 | yield! seq {cmd.ExecuteNonQuery( ) |> Ok} 67 | } 68 | |> Seq.map (fun x -> x) 69 | |> fun x -> transaction.Commit(); x 70 | with exn -> 71 | transaction.Rollback() 72 | seq { Error exn } 73 | ) 74 | |> Seq.head 75 | 76 | ///

77 | /// Takes a function of IDataReader -> Result< 't seq, exn> (see FORMs consumeReader function as example) to 78 | /// transfer the results of executing the specified sql against the specified database given by state into an 79 | /// arbitrary type 't, defined by you in the readerFunction. 80 | ///

81 | let inline generateReader state sql = 82 | match connect state with 83 | | Ok conn -> 84 | try 85 | use cmd = makeCommand state (sql) conn 86 | cmd.ExecuteReader( ) 87 | |> Ok 88 | with 89 | | exn -> Error exn 90 | | Error e -> Error e 91 | 92 | let inline executeWithReader ( state : OrmState ) ( transaction : DbTransaction option ) sql ( readerFunction : IDataReader -> 't ) = //Result<'t, exn> 93 | transaction 94 | |> withTransaction 95 | state 96 | ( fun transaction -> 97 | seq { 98 | use cmd = makeCommand state (sql) <| transaction.Connection 99 | cmd.Transaction <- transaction 100 | try 101 | use reader = cmd.ExecuteReader( ) 102 | yield! readerFunction reader 103 | with exn -> Error exn 104 | } 105 | ) 106 | ( fun connection -> 107 | seq { 108 | 109 | use cmd = makeCommand state (sql) connection 110 | try 111 | use reader = cmd.ExecuteReader( ) 112 | yield! readerFunction reader 113 | with exn -> Error exn 114 | } 115 | ) 116 | 117 | ///

Select records from the table @ .

118 | /// 119 | /// 120 | /// 121 | ///The record type representation of the table being acted on. 122 | /// 123 | /// 124 | /// selectlimit<^T> someState None 5 125 | /// 126 | /// 127 | let inline selectLimit< ^T > ( state : OrmState ) ( transaction : DbTransaction option ) ( limit : int ) = 128 | selectHelper< ^T > state transaction ( fun x -> 129 | match state with 130 | | MSSQL _ -> $"select top {limit} {x}" 131 | | MySQL _ 132 | | PSQL _ 133 | | SQLite _ 134 | | ODBC _ -> $"select {x} limit {limit} " 135 | // | ODBC _ -> $"select {x} order by 1 fetch first {limit} rows only" 136 | ) 137 | 138 | ///

Select all records from the table @ using the conditional .

139 | /// 140 | /// 141 | /// 142 | ///The record type representation of the table being acted on. 143 | /// 144 | /// 145 | /// 146 | /// selectWhere<^T> someState None where 147 | /// 148 | let inline selectWhere< ^T > ( state : OrmState ) ( transaction : DbTransaction option ) (where) = 149 | selectHelper< ^T > state transaction ( fun x -> $"select {x} where {escape where}" ) 150 | 151 | ///

Select all records from the table @

152 | /// 153 | /// 154 | /// 155 | /// 156 | ///The record type representation of the table being acted on. 157 | /// 158 | /// 159 | /// 160 | /// selectAll<^T> someState None 161 | /// 162 | let inline selectAll< ^T > ( state : OrmState ) ( transaction : DbTransaction option ) = 163 | selectHelper< ^T > state transaction ( fun x -> $"select {x}" ) 164 | 165 | ///

Insert an of into the table @ .

166 | /// 167 | /// 168 | /// 169 | /// 170 | ///The record type representation of the table being acted on. 171 | ///Using = true will likely be the default behavior desired in most instances - it should be set to false only in circumstances where you have default behavior on the table generating keys for you. 172 | /// 173 | /// 174 | /// insert<^T> someState None true anInstanceOfT 175 | /// 176 | let inline insert< ^T > ( state : OrmState ) ( transaction : DbTransaction option ) includeKeys ( instance : ^T ) = 177 | let query = insertBase< ^T > state includeKeys 178 | // log $"Insert Query Generated: {query}" 179 | transaction 180 | |> withTransaction 181 | state 182 | ( fun transaction -> 183 | use command = parameterizeCommand state query transaction includeKeys Insert instance //makeCommand query conn state 184 | // log ( 185 | // sprintf "Param count: %A" command.Parameters.Count :: 186 | // [ for i in [0..command.Parameters.Count-1] do 187 | // yield sprintf "Param %d - %A: %A" i command.Parameters[i].ParameterName command.Parameters[i].Value 188 | // ] 189 | // |> String.concat "\n" 190 | // ) 191 | command.Transaction <- transaction 192 | seq { 193 | try command.ExecuteNonQuery ( ) |> Ok 194 | with exn -> Error exn 195 | } 196 | ) 197 | ( fun connection -> 198 | let transaction = connection.BeginTransaction() 199 | let command = parameterizeCommand state query transaction includeKeys Insert instance //makeCommand query connection state 200 | try 201 | seq { 202 | // log ( 203 | // sprintf "Param count: %A" command.Parameters.Count :: 204 | // [ for i in [0..command.Parameters.Count-1] do 205 | // yield sprintf "Param %d - %A: %A" i command.Parameters[i].ParameterName command.Parameters[i].Value 206 | // ] |> String.concat "\n" 207 | // ) 208 | command.ExecuteNonQuery ( ) |> Ok 209 | } 210 | |> fun x -> 211 | transaction.Commit() 212 | x 213 | with exn -> 214 | transaction.Rollback() 215 | seq { Error exn } 216 | ) 217 | |> Seq.head 218 | 219 | ///

Insert a seq<> into the table @ .

220 | /// 221 | /// 222 | /// 223 | /// 224 | ///The record type representation of the table being acted on. 225 | ///Using = true will likely be the default behavior desired in most instances - it should be set to false only in circumstances where you have default behavior on the table generating keys for you. 226 | /// 227 | /// 228 | /// insertMany<^T> someState None true instancesOfT 229 | /// 230 | let inline insertMany< ^T > ( state : OrmState ) ( transaction : DbTransaction option ) includeKeys ( instances : ^T seq ) = 231 | let query = insertBase< ^T > state includeKeys 232 | transaction 233 | |> withTransaction 234 | state 235 | ( fun transaction -> 236 | let cmd = makeCommand state query transaction.Connection 237 | seq { 238 | yield parameterizeSeqAndExecuteCommand state query cmd includeKeys Insert instances //makeCommand query connection state 239 | } 240 | ) 241 | ( fun connection -> 242 | let transaction = connection.BeginTransaction() 243 | // printfn "%A" transaction 244 | try 245 | let cmd = makeCommand state query connection 246 | seq { 247 | yield parameterizeSeqAndExecuteCommand< ^T > state query cmd includeKeys Insert instances 248 | } 249 | |> Seq.map (fun x -> x) 250 | |> fun x -> transaction.Commit(); x 251 | with exn -> 252 | transaction.Rollback() 253 | seq { Error exn } 254 | ) 255 | |> Seq.head 256 | 257 | 258 | ///

Update a record of in the table @ using the keys/identity attribute(s) of .

259 | /// 260 | /// 261 | /// 262 | ///The record type representation of the table being acted on. 263 | ///There must be atleast one PrimaryKeyAttribute or IdAttribute on for an update call to succeed. 264 | /// 265 | /// 266 | /// update<^T> someState None instanceOfT 267 | /// 268 | let inline update< ^T > ( state : OrmState ) ( transaction : DbTransaction option ) ( instance: ^T ) = 269 | let table = table< ^T > state 270 | let paramChar = getParamChar state 271 | 272 | ensureId< ^T > state 273 | |> Result.bind (fun sqlMapping -> 274 | sqlMapping 275 | |> Array.filter (fun mappedInstance -> mappedInstance.QuotedSource = tableName< ^T > state ) //! Filter out joins for non-select queries 276 | |> Array.map ( fun x -> 277 | match state with 278 | | ODBC _ -> sprintf "%s.%s = %s" table x.QuotedSqlName paramChar 279 | | _ -> sprintf "%s.%s = %s%s" table x.QuotedSqlName paramChar x.FSharpName 280 | ) 281 | |> String.concat " and " 282 | |> fun idConditional -> updateHelper< ^T > state transaction ( sprintf " where %s" idConditional ) instance 283 | ) 284 | 285 | ///

Update a seq<> of in the table @ using the keys/identity attribute(s) of .

286 | /// 287 | /// 288 | /// 289 | /// 290 | ///The record type representation of the table being acted on. 291 | ///There must be atleast one PrimaryKeyAttribute or IdAttribute on for an update call to succeed. 292 | /// 293 | /// 294 | /// updateMany<^T> someState None instancesOfT 295 | /// 296 | let inline updateMany< ^T > ( state : OrmState ) ( transaction : DbTransaction option ) ( instances: ^T seq ) = 297 | let tableName = table<^T> state 298 | let paramChar = getParamChar state 299 | 300 | ensureId< ^T > state 301 | |> Result.bind (fun sqlMapping -> 302 | sqlMapping 303 | |> Array.filter (fun mappedInstance -> mappedInstance.QuotedSource = tableName ) //! Filter out joins for non-select queries 304 | |> Array.map ( fun x -> 305 | match state with 306 | | ODBC _ -> sprintf "%s.%s = %s" tableName x.QuotedSqlName paramChar 307 | | _ -> sprintf "%s.%s = %s%s" tableName x.QuotedSqlName paramChar x.FSharpName 308 | ) 309 | |> String.concat " and " 310 | |> fun idConditional -> updateManyHelper< ^T > state transaction ( sprintf " where %s" idConditional ) instances 311 | ) 312 | 313 | ///

Update an of in the table @ using the conditional .

314 | /// 315 | /// 316 | /// 317 | /// 318 | ///The record type representation of the table being acted on. 319 | /// 320 | /// While update and updateMany require key/id attributes on the record types of interest, this function uses conditionals to perform the update. Be careful to fully qualify your where clause to avoid undesired data mutation! 321 | /// While the clause is handled to avoid the possibility of sql injection, it is always a good idea to escape any user input you are passing into your conditions. 322 | /// 323 | /// 324 | /// updateWhere<^T> someState None where instancesOfT 325 | /// 326 | let inline updateWhere< ^T > ( state : OrmState ) transaction ( where ) ( instance: ^T ) = 327 | updateHelper< ^T > state transaction ( sprintf " where %s" (escape where) ) instance 328 | 329 | ///

Delete an of in the table @ using the key/id attributes on .

330 | /// 331 | /// 332 | /// 333 | ///The record type representation of the table being acted on. 334 | /// 335 | /// Just like with delete statements in plain SQL, be careful when using this - it deletes stuff! 336 | /// There must be atleast one PrimaryKeyAttribute or IdAttribute on for a delete call to succeed. 337 | /// 338 | /// 339 | /// delete<^T> someState None instanceOfT 340 | /// 341 | let inline delete< ^T > state ( transaction : DbTransaction option ) instance = 342 | ensureId< ^T > state 343 | |> Result.bind ( fun sqlMapping -> 344 | let tableName = table< ^T > state 345 | let paramChar = getParamChar state 346 | sqlMapping 347 | |> Array.filter ( fun mappedInstance -> mappedInstance.QuotedSource = tableName ) //! Filter out joins for non-select queries 348 | |> Array.map ( fun x -> 349 | match state with 350 | | ODBC _ -> sprintf "%s.%s = %s" tableName x.QuotedSqlName paramChar 351 | | _ -> sprintf "%s.%s = %s%s" tableName x.QuotedSqlName paramChar x.FSharpName 352 | ) 353 | |> String.concat " and " 354 | |> fun where -> deleteHelper< ^T > state transaction where instance 355 | ) 356 | 357 | ///

Delete a seq<> of in the table @ using the keys/identity attribute(s) of .

358 | /// 359 | /// 360 | /// 361 | /// 362 | ///The record type representation of the table being acted on. 363 | ///There must be atleast one PrimaryKeyAttribute or IdAttribute on for a delete call to succeed. 364 | /// 365 | /// 366 | /// deleteMany<^T> someState None instancesOfT 367 | /// 368 | let inline deleteMany< ^T > state ( transaction : DbTransaction option ) instances = 369 | ensureId< ^T > state 370 | |> Result.bind ( fun sqlMapping -> 371 | let tableName = table< ^T > state 372 | let paramChar = getParamChar state 373 | sqlMapping 374 | |> Array.filter (fun mappedInstance -> mappedInstance.QuotedSource = tableName ) //! Filter out joins for non-select queries 375 | |> Array.map ( fun x -> 376 | match state with 377 | | ODBC _ -> sprintf "%s.%s = %s" tableName x.QuotedSqlName paramChar 378 | | _ -> sprintf "%s.%s = %s%s" tableName x.QuotedSqlName paramChar x.FSharpName 379 | ) 380 | |> String.concat " and " // id1 = @id1 AND id2 = @id2 381 | |> fun where -> deleteManyHelper< ^T > state transaction where instances 382 | ) 383 | 384 | ///

Delete an of in the table @ using the conditional .

385 | /// 386 | /// 387 | /// 388 | ///The record type representation of the table being acted on. 389 | /// 390 | /// While delete and deleteMany require key/id attributes on the record types of interest, this function uses conditionals to perform the delete. Be careful to fully qualify your where clause to avoid undesired data loss! 391 | /// While the clause is handled to avoid the possibility of sql injection, it is always a good idea to escape any user input you are passing into your conditions. 392 | /// Other opWhere functions in FORM also take an instance of the desired type (i.e. updateWhere), the difference comes from the fact that we don't need any reference data here, where as in the update we need to know what we are updating stuff to. 393 | /// 394 | /// 395 | /// deleteWhere<^T> someState None where 396 | /// 397 | let inline deleteWhere< ^T > ( state : OrmState ) ( transaction : DbTransaction option ) ( where : (string * obj seq) ) = 398 | let query = $"{deleteBase< ^T > state} {escape where}" 399 | transaction 400 | |> withTransaction 401 | state 402 | ( fun transaction -> 403 | use cmd = makeCommand state query ( transaction.Connection ) 404 | cmd.Transaction <- transaction 405 | seq { cmd.ExecuteNonQuery ( ) |> Ok } 406 | ) 407 | ( fun connection -> 408 | let transaction = connection.BeginTransaction() 409 | let cmd = makeCommand state query connection 410 | try 411 | seq { 412 | yield cmd.ExecuteNonQuery ( ) |> Ok 413 | } 414 | |> Seq.map (fun x -> x) 415 | |> fun x -> 416 | transaction.Commit() 417 | x 418 | with exn -> 419 | transaction.Rollback() 420 | seq{ Error exn } 421 | ) 422 | |> Seq.head 423 | 424 | 425 | 426 | // {Ok a; Ok b; Ok c} -> Ok {a; b; c} 427 | // {Ok a; Ok b; Ok c; Error e} -> Error e 428 | 429 | ///

A utility function which takes a query result and returns a result of Ok seq<'a> or Error e, where 'a would be the static type parameter ^T fed to a previously called query function (e.g. selectAll, selectWhere, etc)

430 | /// 431 | /// 432 | let inline toResultSeq (results : seq>) = 433 | Seq.fold 434 | ( fun accumulator item -> 435 | match accumulator, item with 436 | | Ok state, Ok i -> Ok ( seq { yield! state; yield i } ) 437 | | Error e, _ 438 | | _, Error e -> Error e 439 | ) 440 | ( Ok Seq.empty ) 441 | results 442 | 443 | 444 | ///

A utility function which takes a query result and returns a sequence of the unwrapped Ok results.

445 | /// 446 | /// 447 | let inline toSeq (results : seq>) = 448 | results 449 | |> Seq.takeWhile ( Result.isOk ) 450 | |> Seq.map ( Result.defaultValue Unchecked.defaultof<'a> ) 451 | 452 | 453 | ///

A utility function which takes a query result and returns a tuple whose first element is the unwrapped Ok results and second element is the unwrapped Error results

454 | /// 455 | /// 456 | let inline toSeqs (results : seq>) : (seq<'a> * seq<'b>) = 457 | Seq.fold 458 | ( fun (okAcc, errAcc) item -> 459 | match item with 460 | | Ok i -> ( seq { yield! okAcc; yield i } , errAcc) 461 | | Error e -> ( okAcc , seq { yield! errAcc; yield e}) 462 | ) 463 | ( Seq.empty, Seq.empty ) 464 | results -------------------------------------------------------------------------------- /Lib/Utilities.fs: -------------------------------------------------------------------------------- 1 | namespace Form 2 | 3 | module Utilities = 4 | open Form.Attributes 5 | open System.Collections.Generic 6 | open Microsoft.FSharp.Reflection 7 | open Microsoft.FSharp.Core.LanguagePrimitives 8 | open NpgsqlTypes 9 | open System 10 | open System.Data 11 | open System.Data.SQLite 12 | open Npgsql 13 | open MySqlConnector 14 | open System.Data.SqlClient 15 | open System.Reflection 16 | open System.Data.Common 17 | open Logging 18 | open System.Data.Odbc 19 | 20 | open System.Text.RegularExpressions 21 | 22 | type Behavior = 23 | | Update 24 | | Insert 25 | | Delete 26 | 27 | /// **Do not use.** This is internal to Form and cannot be hidden due to inlining. 28 | /// We make no promises your code won't break in the future if you use this. 29 | let mutable _tableNames = Dictionary() 30 | /// **Do not use.** This is internal to Form and cannot be hidden due to inlining. 31 | /// We make no promises your code won't break in the future if you use this. 32 | let mutable _constructors = Dictionary< Type, obj[] -> obj>() 33 | /// **Do not use.** This is internal to Form and cannot be hidden due to inlining. 34 | /// We make no promises your code won't break in the future if you use this. 35 | let mutable _mappings = Dictionary<(Type * OrmState), SqlMapping []>() 36 | /// **Do not use.** This is internal to Form and cannot be hidden due to inlining. 37 | /// We make no promises your code won't break in the future if you use this. 38 | let mutable _toOptions = Dictionary obj>() 39 | /// **Do not use.** This is internal to Form and cannot be hidden due to inlining. 40 | /// We make no promises your code won't break in the future if you use this. 41 | let mutable _options = Dictionary() 42 | 43 | let inline connect ( state : OrmState ) : Result< DbConnection, exn > = 44 | try 45 | let connection = 46 | match state with 47 | | MSSQL ( str, _ ) -> new SqlConnection( str ) :> DbConnection 48 | | MySQL ( str, _ ) -> new MySqlConnection( str ) :> DbConnection 49 | | PSQL ( str, _ ) -> new NpgsqlConnection( str ) :> DbConnection 50 | | SQLite ( str, _ ) -> new SQLiteConnection( str ) :> DbConnection 51 | | ODBC ( str, _ ) -> new OdbcConnection( str ) :> DbConnection 52 | connection.Open() 53 | Ok connection 54 | with 55 | | exn -> Error exn 56 | 57 | let inline sqlQuote ( state : OrmState ) str = 58 | match state with 59 | | MSSQL _ -> $"[{str}]" 60 | | MySQL _ -> $"`{str}`" 61 | | PSQL _ 62 | | SQLite _ 63 | | ODBC _ -> $"\"{str}\"" 64 | 65 | let pattern = fun t -> Regex.Replace(t, @"'", @"''" ) 66 | // function 67 | // | t when t :?> string -> Regex.Replace(t, @"'", @"''" ) 68 | // | t when t :?> seq -> t 69 | // [| ("customerType = %s", "retail"); ( "and (hasSaleWithinPastYear = %s", "true" ); ( "or boughtTiresAYearAgo = %s)", "true" ) |] 70 | 71 | // "customerType = :1 and (hasSaleWithinPastYear = :2 or boughtTiresAYearAgo = :2)" [| "retail"; "true" |] 72 | let inline escape( where : string * obj seq )= 73 | let format, values = where 74 | let mutable i = 0 75 | values 76 | |> Seq.fold 77 | (fun accumulator item -> 78 | i <- i+1 79 | 80 | let sanitizedInput = 81 | match item with 82 | | :? seq as t -> 83 | System.String.Join( ", ", Seq.map ( fun innerItem -> $"'{pattern innerItem}'" ) t ) 84 | | :? string as t -> pattern <| t.ToString() 85 | | :? System.Collections.IEnumerable as t -> //seq of non string type (for numeric sequences, and any others that will behave in an interpolated string. May need to adjust to get desirable behavior generically) 86 | System.String.Join( ", ", Seq.map (fun innerItem -> $"{innerItem}") [for i in t do yield i] ) 87 | | _ -> pattern <| item.ToString() 88 | 89 | Regex.Replace(accumulator, $":{i}", sanitizedInput) 90 | ) 91 | format 92 | let inline context< ^T > ( state : OrmState ) = 93 | match state with 94 | | MSSQL ( _, c ) -> c 95 | | MySQL ( _, c ) -> c 96 | | PSQL ( _, c ) -> c 97 | | SQLite ( _, c ) -> c 98 | | ODBC ( _, c ) -> c 99 | 100 | let inline attrFold ( attrs : DbAttribute array ) ( ctx : Enum ) = 101 | Array.fold ( fun s ( x : DbAttribute ) -> 102 | if snd x.Value = ( ( box( ctx ) :?> DbContext ) |> EnumToValue ) 103 | then fst x.Value 104 | else s 105 | ) "" attrs 106 | 107 | let inline attrJoinFold ( attrs : OnAttribute array ) ( ctx : Enum ) = 108 | Array.fold ( fun s ( x : OnAttribute ) -> 109 | if snd x.Value = ( ( box( ctx ) :?> DbContext ) |> EnumToValue ) 110 | then (fst x.Value, x.key.Name) 111 | else s 112 | ) ("", "") attrs 113 | 114 | let inline tableName< ^T > ( state : OrmState ) = 115 | let reifiedType = typeof< ^T > 116 | let mutable name = "" 117 | if _tableNames.TryGetValue( (reifiedType, state), &name ) 118 | then name 119 | else 120 | let attrs = 121 | typedefof< ^T >.GetCustomAttributes( typeof< TableAttribute >, false ) 122 | |> Array.map ( fun x -> x :?> DbAttribute ) 123 | 124 | let tName = 125 | if attrs = Array.empty 126 | then typedefof< ^T >.Name 127 | else attrFold attrs ( context< ^T > state ) 128 | |> fun x -> x.Split( "." ) 129 | |> Array.map ( fun x -> sqlQuote state x ) 130 | |> String.concat "." 131 | 132 | _tableNames[(reifiedType, state)] <- tName 133 | tName 134 | 135 | 136 | let inline mappingHelper< ^T, ^A > state (propertyInfo : PropertyInfo) = 137 | propertyInfo.GetCustomAttributes( typeof< ^A >, false ) 138 | |> Array.map ( fun y -> y :?> DbAttribute ) 139 | |> fun y -> attrFold y ( context< ^T > state ) 140 | 141 | let inline columnMapping< ^T > ( state : OrmState ) = 142 | let reifiedType = typeof< ^T > 143 | let mutable outMapping = Array.empty 144 | if _mappings.TryGetValue((reifiedType, state), &outMapping) 145 | then outMapping 146 | else 147 | let mapping = 148 | FSharpType.GetRecordFields typedefof< ^T > 149 | |> Array.mapi ( fun i x -> 150 | let source = 151 | let tmp = mappingHelper< ^T, ByJoinAttribute > state x 152 | if tmp = "" then tableName< ^T > state else sqlQuote state tmp 153 | let sqlName = 154 | let tmp = mappingHelper< ^T, ColumnAttribute > state x 155 | if tmp = "" then x.Name else tmp 156 | { 157 | Index = i 158 | IsKey = if (mappingHelper< ^T, PrimaryKeyAttribute > state x) = "" then false else true 159 | IsIndex = if (mappingHelper< ^T, IdAttribute > state x) = "" then false else true 160 | JoinOn = 161 | x.GetCustomAttributes( typeof< OnAttribute >, false ) 162 | |> Array.map ( fun y -> y :?> OnAttribute ) 163 | |> fun y -> attrJoinFold y ( context< ^T > state ) //attributes< ^T, ColumnAttribute> state 164 | |> fun (y : (string * string)) -> if y = ("", "") then None else Some y 165 | Source = source 166 | QuotedSource = source 167 | SqlName = sqlName 168 | QuotedSqlName = sqlQuote state sqlName 169 | FSharpName = x.Name 170 | Type = x.PropertyType 171 | PropertyInfo = x 172 | } 173 | ) 174 | _mappings[(reifiedType, state)] <- mapping 175 | mapping 176 | 177 | let inline table< ^T > ( state : OrmState ) = 178 | tableName< ^T > state 179 | 180 | let inline mapping< ^T > ( state : OrmState ) = 181 | columnMapping< ^T > state 182 | 183 | let inline columns< ^T > ( state : OrmState ) = 184 | mapping< ^T > state 185 | |> Array.map ( fun x -> $"{x.QuotedSource}.{x.QuotedSqlName}" ) 186 | 187 | let inline fields< ^T > ( state : OrmState ) = 188 | mapping< ^T > state 189 | |> Array.map ( fun x -> x.FSharpName ) 190 | 191 | 192 | let inline toOption ( type_: Type ) ( value: obj ) : obj = 193 | let constructor = 194 | if _toOptions.ContainsKey( type_ ) 195 | then _toOptions[type_] 196 | else 197 | let info = FSharpType.GetUnionCases( typedefof>.MakeGenericType( [|type_|] ) ) 198 | _toOptions[type_] <- FSharpValue.PreComputeUnionConstructor(info[1]) 199 | _toOptions[type_] 200 | 201 | 202 | if DBNull.Value.Equals( value ) 203 | then None 204 | else constructor [|value|] 205 | 206 | 207 | let inline optionType ( type_ : Type ) = 208 | let mutable opt = None 209 | if _options.TryGetValue( type_, &opt ) 210 | then opt 211 | else 212 | let tmp = 213 | if type_.IsGenericType && type_.GetGenericTypeDefinition( ) = typedefof> 214 | then Some ( type_.GetGenericArguments( ) |> Array.head ) // optionType Option -> User 215 | else None 216 | _options[type_] <- tmp 217 | tmp 218 | 219 | let inline makeParameter ( state : OrmState ) : DbParameter = 220 | match state with 221 | | MSSQL _ -> SqlParameter( ) 222 | | MySQL _ -> MySqlParameter( ) 223 | | PSQL _ -> NpgsqlParameter( ) 224 | | SQLite _ -> SQLiteParameter( ) 225 | | ODBC _ -> OdbcParameter( ) 226 | 227 | let toDbType ( typeCode : TypeCode ) = 228 | match typeCode with 229 | | TypeCode.Byte -> DbType.Byte 230 | | TypeCode.Char -> DbType.StringFixedLength // ??? 231 | | TypeCode.Int16 -> DbType.Int16 232 | | TypeCode.Int32 -> DbType.Int32 233 | | TypeCode.Int64 -> DbType.Int64 234 | | TypeCode.SByte -> DbType.SByte 235 | | TypeCode.Double -> DbType.Double 236 | | TypeCode.Single -> DbType.Single 237 | | TypeCode.String -> DbType.String 238 | | TypeCode.UInt16 -> DbType.UInt16 239 | | TypeCode.UInt32 -> DbType.UInt32 240 | | TypeCode.UInt64 -> DbType.UInt64 241 | | TypeCode.Boolean -> DbType.Boolean 242 | | TypeCode.Decimal -> DbType.Decimal 243 | | TypeCode.DateTime -> DbType.DateTime // Used for Date, DateTime and DateTime2 DbTypes DbType.DateTime 244 | | _ -> DbType.Object 245 | 246 | let inline unwrapOption ( tmp : DbParameter ) ( opt : obj ) ( ) = 247 | match opt with 248 | | :? Option as t -> tmp.Value <- t |> Option.get 249 | | :? Option as t -> tmp.Value <- t |> Option.get 250 | | :? Option as t -> tmp.Value <- t |> Option.get //Int8 251 | | :? Option as t -> tmp.Value <- t |> Option.get 252 | | :? Option as t -> tmp.Value <- t |> Option.get 253 | | :? Option as t -> tmp.Value <- t |> Option.get 254 | #if NET7_0_OR_GREATER 255 | | :? Option as t -> tmp.Value <- t |> Option.get 256 | #endif 257 | | :? Option as t -> tmp.Value <- t |> Option.get 258 | | :? Option as t -> tmp.Value <- t |> Option.get 259 | | :? Option as t -> tmp.Value <- t |> Option.get 260 | | :? Option as t -> tmp.Value <- t |> Option.get 261 | | :? Option as t -> tmp.Value <- t |> Option.get 262 | | :? Option as t -> tmp.Value <- t |> Option.get 263 | #if NET7_0_OR_GREATER 264 | | :? Option as t -> tmp.Value <- t |> Option.get 265 | #endif 266 | | :? Option as t -> tmp.Value <- t |> Option.get 267 | | :? Option as t -> tmp.Value <- t |> Option.get 268 | | :? Option as t -> tmp.Value <- t |> Option.get 269 | | _ -> () 270 | 271 | let inline getParamChar state = 272 | match state with 273 | | ODBC _ -> "?" 274 | | _ -> "@" 275 | 276 | 277 | /// Takes a reader of type IDataReader and a state of type OrmState -> consumes the reader and returns a sequence of type ^T. 278 | let inline consumeReader< ^T > ( state : OrmState ) ( reader : IDataReader ) = 279 | let reifiedType = typeof< ^T > 280 | let constructor = 281 | let mutable tmp = fun _ -> obj() 282 | if _constructors.TryGetValue(reifiedType, &tmp) 283 | then () 284 | else 285 | tmp <- FSharpValue.PreComputeRecordConstructor(reifiedType) 286 | _constructors[reifiedType] <- tmp 287 | tmp 288 | let mutable options = 289 | [| for fld in ( columnMapping< ^T > state ) do 290 | match optionType fld.Type with //handle option type, i.e. option if record field is optional, else T 291 | | Some _type -> toOption _type 292 | | None -> id 293 | |] 294 | seq { 295 | try 296 | while reader.Read( ) do 297 | constructor 298 | [| for i in 0..reader.FieldCount-1 do 299 | options[i] <| reader.GetValue( i ) 300 | |] 301 | :?> ^T // dang ol' class factory man 302 | |> Ok 303 | 304 | with exn -> 305 | Error exn 306 | } 307 | 308 | let inline insertBase< ^T > ( state : OrmState ) insertKeys = 309 | let paramChar = getParamChar state 310 | let tableName = ( table< ^T > state ) 311 | let cols = 312 | mapping< ^T > state 313 | |> Array.filter (fun mappedInstance -> mappedInstance.QuotedSource = tableName ) //! Filter out joins for non-select queries 314 | |> Array.filter (fun col -> not col.IsKey || insertKeys ) 315 | let placeHolders = 316 | cols 317 | |> Array.map ( fun col -> 318 | match state with 319 | | ODBC _ -> paramChar 320 | | _ -> sprintf "%s%s" paramChar col.FSharpName 321 | ) 322 | |> String.concat ", " 323 | let columnNames = 324 | cols 325 | |> Array.map ( fun x -> x.QuotedSqlName ) 326 | |> String.concat ", " 327 | 328 | sprintf "insert into %s ( %s ) values ( %s )" tableName columnNames placeHolders 329 | 330 | let inline makeCommand ( state : OrmState ) ( query : string ) ( connection : DbConnection ) : DbCommand = 331 | // log ( sprintf "Query being generated:\n\n%s\n\n" <| query ) 332 | match state with 333 | | MSSQL _ -> new SqlCommand ( query, connection :?> SqlConnection ) 334 | | MySQL _ -> new MySqlCommand ( query, connection :?> MySqlConnection ) 335 | | PSQL _ -> new NpgsqlCommand ( query, connection :?> NpgsqlConnection ) 336 | | SQLite _ -> new SQLiteCommand ( query, connection :?> SQLiteConnection ) 337 | | ODBC _ -> new OdbcCommand ( query, connection :?> OdbcConnection ) 338 | 339 | let inline withTransaction state transactionFunction (noneFunction : DbConnection -> Result<'a, exn> seq) transaction : Result<'a, exn> seq = 340 | match transaction with 341 | | Some ( transaction : DbTransaction ) -> transactionFunction transaction 342 | | None -> 343 | seq { 344 | match connect state with 345 | | Ok conn -> 346 | yield! noneFunction conn 347 | | Error exn -> yield Error exn 348 | } 349 | 350 | let rec genericTypeName full ( _type : Type ) = 351 | if not _type.IsGenericType 352 | then _type.Name 353 | else 354 | let typeName = 355 | let mutable tmp = _type.GetGenericTypeDefinition().Name 356 | tmp <- tmp.Substring(0, tmp.IndexOf('`')) 357 | tmp 358 | if not full 359 | then typeName 360 | else 361 | let args = 362 | _type.GetGenericArguments() 363 | |> Array.map (genericTypeName full) 364 | |> String.concat "," 365 | 366 | sprintf "%s<%s>" typeName args 367 | 368 | let inline parameterizeCommand< ^T > state query (transaction : DbTransaction) includeKeys behavior ( instance : ^T ) = 369 | let cmd = makeCommand state query transaction.Connection 370 | cmd.Transaction <- transaction 371 | let paramChar = getParamChar state 372 | let allColumns = 373 | mapping< ^T > state 374 | |> Array.filter (fun mappedInstance -> mappedInstance.QuotedSource = (tableName< ^T > state) ) //! Filter out joins for non-select queries 375 | 376 | match behavior with 377 | | Insert -> allColumns |> Array.filter (fun col -> not col.IsKey || includeKeys ) 378 | | Update -> allColumns |> Array.filter (fun col -> not col.IsKey || includeKeys ) |> fun x -> Array.append x ( Array.filter (fun col -> col.IsKey ) allColumns ) 379 | | Delete -> allColumns |> Array.filter (fun col -> col.IsKey ) 380 | |> Array.iteri ( fun i mappedInstance -> 381 | // log (sprintf "binding value %s(%A) to position %i - " mappedInstance.FSharpName (mappedInstance.PropertyInfo.GetValue( instance )) i ) 382 | let param = 383 | let mutable tmp = cmd.CreateParameter( ) 384 | let mappedValue = mappedInstance.PropertyInfo.GetValue( instance ) 385 | match state with 386 | | ODBC _ -> () 387 | | _ -> tmp.ParameterName <- sprintf "%s%s" paramChar mappedInstance.FSharpName 388 | if 389 | mappedValue = null 390 | then 391 | tmp.IsNullable <- true 392 | tmp.Value <- DBNull.Value 393 | else 394 | if 395 | genericTypeName false mappedInstance.Type = "FSharpOption" 396 | then 397 | tmp.IsNullable <- true 398 | unwrapOption tmp (mappedValue) () 399 | else 400 | tmp.Value <- mappedValue // Some 1 401 | tmp 402 | 403 | cmd.Parameters.Add ( param ) |> ignore 404 | ) 405 | 406 | cmd 407 | 408 | let inline parameterizeSeqAndExecuteCommand< ^T > state query (cmd : DbCommand) includeKeys behavior ( instances : ^T seq ) = 409 | 410 | 411 | let mapp = 412 | let tmp = 413 | mapping< ^T > state 414 | |> Array.filter (fun mappedInstance -> mappedInstance.QuotedSource = tableName< ^T > state ) //! Filter out joins for non-select queries 415 | 416 | match behavior with 417 | | Insert -> tmp |> Array.filter (fun col -> not col.IsKey || includeKeys ) 418 | | Update -> tmp |> Array.filter (fun col -> not col.IsKey || includeKeys ) |> fun x -> Array.append x ( Array.filter (fun col -> col.IsKey ) tmp ) 419 | | Delete -> tmp |> Array.filter (fun col -> col.IsKey ) 420 | 421 | let paramChar = getParamChar state 422 | let mutable cmdParams = 423 | mapp 424 | |> Array.map ( 425 | fun (mappedInstance : SqlMapping ) -> 426 | let mutable tmp = cmd.CreateParameter( ) 427 | match state with 428 | | ODBC _ -> () 429 | | _ -> tmp.ParameterName <- sprintf "%s%s" paramChar mappedInstance.FSharpName 430 | cmd.Parameters.Add ( tmp ) |> ignore 431 | tmp 432 | ) 433 | 434 | instances 435 | |> Seq.mapi ( fun index instance -> 436 | mapp 437 | |> Array.iteri ( fun jindex mappedInstance -> 438 | let thing = mappedInstance.PropertyInfo.GetValue( instance ) 439 | if 440 | thing = null 441 | then 442 | cmdParams[jindex].IsNullable <- true 443 | cmdParams[jindex].Value <- DBNull.Value 444 | else 445 | if genericTypeName false mappedInstance.Type = "FSharpOption" 446 | then 447 | cmdParams[jindex].IsNullable <- true 448 | unwrapOption cmdParams[jindex] (thing) () 449 | 450 | else 451 | cmdParams[jindex].Value <- thing // Some 1 452 | ) 453 | 454 | // log ( 455 | // sprintf "Param count: %A" cmd.Parameters.Count :: 456 | // [ for i in [0..cmd.Parameters.Count-1] do 457 | // yield sprintf "Param %d - %A: %A" i cmd.Parameters[i].ParameterName cmd.Parameters[i].Value 458 | // ] 459 | // |> String.concat "\n" 460 | // ) 461 | try cmd.ExecuteNonQuery() |> Ok 462 | with exn -> Error exn 463 | ) 464 | |> Seq.fold ( fun accumulator item -> 465 | match accumulator, item with 466 | | Ok a, Ok i -> Ok ( a + i ) 467 | | Error e, _ 468 | | _, Error e -> Error e 469 | ) ( Ok 0 ) 470 | 471 | let inline joins< ^T > (state : OrmState) = 472 | let qoute = sqlQuote state 473 | mapping< ^T > state 474 | |> Array.filter (fun sqlMap -> Option.isSome sqlMap.JoinOn) 475 | |> Array.groupBy (fun x -> x.JoinOn |> Option.get |> fst) 476 | |> Array.map (fun (source, maps) -> 477 | Array.map (fun map -> 478 | let secCol = map.JoinOn |> Option.get |> snd 479 | $"{qoute source}.{qoute secCol} = {map.QuotedSource}.{map.QuotedSqlName}" 480 | ) maps 481 | |> String.concat " and " 482 | |> fun onString -> $"left join {qoute source} on {onString}" 483 | ) 484 | |> String.concat "\n" 485 | 486 | let inline queryBase< ^T > ( state : OrmState ) = 487 | let cols = columns< ^T > state 488 | let joins = joins<^T> state 489 | ( String.concat ", " cols ) + " from " + table< ^T > state 490 | + " " + joins 491 | 492 | let inline selectHelper< ^T > ( state : OrmState ) ( transaction : DbTransaction option ) f = 493 | let query = queryBase< ^T > state |> f 494 | 495 | transaction 496 | |> withTransaction 497 | state 498 | ( fun (transaction : DbTransaction) -> 499 | seq { 500 | use cmd = makeCommand state query ( transaction.Connection ) 501 | cmd.Transaction <- transaction 502 | try 503 | use reader = cmd.ExecuteReader( ) 504 | yield! consumeReader< ^T > state reader 505 | with exn -> Error exn 506 | } 507 | ) 508 | ( fun ( connection : DbConnection ) -> 509 | seq { 510 | use cmd = makeCommand state query connection 511 | try 512 | use reader = cmd.ExecuteReader( ) 513 | yield! consumeReader< ^T > state reader 514 | with exn -> yield Error exn 515 | } 516 | ) 517 | 518 | let inline updateBase< ^T > ( state : OrmState ) = 519 | let paramChar = getParamChar state 520 | let cols = 521 | mapping< ^T > state 522 | |> Array.filter (fun mappedInstance -> mappedInstance.QuotedSource = tableName< ^T > state ) //! Filter out joins for non-select queries 523 | |> Array.filter (fun col -> not col.IsKey) //Can't update keys 524 | // log ( sprintf "columns to update: %A" cols ) 525 | let queryParams = 526 | cols 527 | |> Array.map (fun col -> 528 | match state with 529 | | ODBC _ -> paramChar 530 | | _ -> sprintf "%s%s" paramChar col.FSharpName ) // @col1, @col2, @col3 531 | 532 | 533 | let table = table< ^T > state 534 | let set = 535 | Array.zip cols queryParams 536 | |> Array.map ( fun x -> sprintf "%s = %s" (fst x).QuotedSqlName (snd x) ) 537 | |> String.concat ", " 538 | 539 | "update " + table + " set " + set 540 | 541 | let inline ensureId< ^T > ( state: OrmState ) = 542 | mapping< ^T > state 543 | |> Array.filter (fun mappedInstance -> mappedInstance.QuotedSource = tableName< ^T > state ) //! Filter out joins for non-select queries 544 | |> Array.filter ( fun x -> x.IsKey ) 545 | |> fun x -> if Array.length x = 0 then "Record must have at least one ID attribute specified..." |> exn |> Error else Ok x 546 | 547 | let inline updateHelper<^T> ( state : OrmState ) ( transaction : DbTransaction option ) ( whereClause : string ) ( instance : ^T ) = 548 | let query = ( updateBase< ^T > state ) + (whereClause) 549 | transaction 550 | |> withTransaction 551 | state 552 | ( fun transaction -> 553 | use command = parameterizeCommand< ^T > state query transaction false Update instance 554 | command.Transaction <- transaction 555 | seq { 556 | try 557 | command.ExecuteNonQuery ( ) |> Ok 558 | with exn -> 559 | // log ( sprintf "%A" exn ) 560 | Error exn 561 | } 562 | ) 563 | ( fun connection -> 564 | let transaction = connection.BeginTransaction() 565 | let command = parameterizeCommand< ^T > state query transaction false Update instance 566 | try 567 | seq { 568 | yield! seq {command.ExecuteNonQuery( ) |> Ok} 569 | } 570 | |> Seq.map (fun x -> x) 571 | |> fun x -> transaction.Commit(); x 572 | with exn -> 573 | transaction.Rollback() 574 | seq { Error exn } 575 | ) 576 | |> Seq.head 577 | 578 | let inline updateManyHelper<^T> ( state : OrmState ) ( transaction : DbTransaction option ) ( whereClause : string ) ( instances : ^T seq ) = 579 | let query = ( updateBase< ^T > state ) + (whereClause) 580 | transaction 581 | |> withTransaction 582 | state 583 | ( fun transaction -> 584 | let cmd = makeCommand state query transaction.Connection 585 | seq { parameterizeSeqAndExecuteCommand< ^T > state query ( cmd ) false Update instances } 586 | ) 587 | ( fun connection -> 588 | let transaction = connection.BeginTransaction() 589 | let cmd = makeCommand state query connection 590 | try 591 | seq { 592 | yield! seq {parameterizeSeqAndExecuteCommand< ^T > state query cmd false Update instances } 593 | } 594 | |> Seq.map (fun x -> x) 595 | |> fun x -> transaction.Commit(); x 596 | with exn -> 597 | transaction.Rollback() 598 | seq { Error exn } 599 | ) 600 | |> Seq.head 601 | 602 | let inline deleteBase< ^T > state = 603 | table< ^T > state 604 | |> sprintf "delete from %s where " 605 | 606 | let inline deleteHelper< ^T > ( state : OrmState ) ( transaction : DbTransaction option ) ( whereClause : string ) ( instance : ^T ) = 607 | let query = deleteBase< ^T > state + (whereClause) 608 | transaction 609 | |> withTransaction 610 | state 611 | ( fun transaction -> 612 | use command = parameterizeCommand< ^T > state query transaction false Delete instance 613 | command.Transaction <- transaction 614 | seq { 615 | try command.ExecuteNonQuery ( ) |> Ok 616 | with exn -> 617 | // log ( sprintf "%A" exn ) 618 | Error exn 619 | } 620 | ) 621 | ( fun connection -> 622 | let transaction = connection.BeginTransaction() 623 | let command = parameterizeCommand< ^T > state query transaction false Delete instance 624 | try 625 | seq { 626 | yield! seq {command.ExecuteNonQuery( ) |> Ok} 627 | } 628 | |> Seq.map (fun x -> x) 629 | |> fun x -> transaction.Commit(); x 630 | with exn -> 631 | transaction.Rollback() 632 | seq { Error exn } 633 | ) 634 | |> Seq.head 635 | 636 | 637 | let inline deleteManyHelper< ^T > ( state : OrmState ) ( transaction : DbTransaction option ) ( whereClause : string ) ( instances : ^T seq ) = 638 | let query = deleteBase< ^T > state + (whereClause) 639 | transaction 640 | |> withTransaction 641 | state 642 | ( fun transaction -> 643 | let cmd = makeCommand state query transaction.Connection 644 | seq { parameterizeSeqAndExecuteCommand< ^T > state query ( cmd ) false Delete instances } 645 | ) 646 | ( fun connection -> 647 | let transaction = connection.BeginTransaction() 648 | let cmd = makeCommand state query connection 649 | try 650 | seq { 651 | yield parameterizeSeqAndExecuteCommand< ^T > state query cmd false Delete instances 652 | } 653 | |> Seq.map (fun x -> x) 654 | |> fun x -> transaction.Commit(); x 655 | with exn -> 656 | transaction.Rollback() 657 | seq { Error exn } 658 | ) 659 | |> Seq.head 660 | --------------------------------------------------------------------------------