* MapTo support Option and ValueOption on target types

* TemplateAsRecord to generate list of properies and types

Author: Thorium

docs/RELEASE_NOTES.md

@@ -1,3 +1,10 @@
+### 1.5.8 - 04.06.2025
+* MapTo support Option and ValueOption on target types
+* TemplateAsRecord to generate list of properies and types
+
+### 1.5.7 - 13.05.2025
+* Performance improvement: ProvidedTypes update
+
 ### 1.5.6 - 06.05.2025
 * Mock-database case sensitivity backup search
 

docs/content/core/mappers.fsx

@@ -20,12 +20,10 @@ type sql  = SqlDataProvider<
 
 (**
 
-## Adding a Mapper using dataContext to use generated types from db
+## Adding a Mapper using dataContext to use generated types from the DB
 
-Typically F# is about writing business logic and not about OR-mapping. Consider using your database types as is. But sometimes you want to 
-map objects to different, for example to interact with other languages like C# domain.
-
-This mapper will ensure that you always sync your types with those you receive from your DB.
+Typically, F# is about writing business logic and not about OR-mapping. Consider using your database types as is. And select only the columns you need, not full entities. But sometimes you want to
+map objects to different ones, for example to interact with other languages like C# domain.
 
 First, add a Domain Model
 
@@ -41,7 +39,7 @@ type Employee = {
 }
 
 (**
-Then you can create the mapper using dataContext to use generated types from db
+Then you can create the mapper using dataContext to use the generated types from the DB
 *)
 
 let mapEmployee (dbRecord:sql.dataContext.``main.EmployeesEntity``) : Employee =
@@ -51,7 +49,25 @@ let mapEmployee (dbRecord:sql.dataContext.``main.EmployeesEntity``) : Employee =
       HireDate = dbRecord.HireDate }
 
 (**
-SqlProvider also has a `.MapTo<'T>` convenience  method:
+
+### TemplateAsRecord
+
+If you want to copy and paste the current SQLProvider objects as separate classes, you can use `TemplateAsRecord` property of your database table:
+
+*)
+
+ctx.Main.Employees.TemplateAsRecord
+// intellisense will generate you code that you can copy and paste as template to create your own type:
+// ``type MainOrders = { CustomerId : String voption; EmployeeId : Int64 voption; Freight : Decimal voption; OrderDate : DateTime voption; OrderId : Int64; RequiredDate : DateTime voption; ShipAddress : String voption; ShipCity : String voption; ShipCountry : String voption; ShipName : String voption; ShipPostalCode : String voption; ShipRegion : String voption; ShippedDate : DateTime voption }``
+
+(**
+
+This could be useful if you e.g. want to use SQLProvider objects in some reflection based code-generator (because the normal objects are erased).
+
+
+### MapTo
+
+SqlProvider also has a `.MapTo<'T>` convenience method:
 *)
 
 
@@ -71,6 +87,9 @@ let qry = query { for row in employees do
 
 (**
 The target type can be a record (as in the example) or a class type with properties named as the source columns and with a parameterless setter.
+
+Target will support mapping database nullable fields to Option and ValueOption types automatically.
+
 The target field name can also be different than the column name; in this case, it must be decorated with the MappedColumnAttribute custom attribute:
 *)
 
@@ -88,7 +107,10 @@ let qry2 =
 
 
 (**
-Or alternatively, the ColumnValues from  SQLEntity can be used to create a map, with the
+
+### ColumnValues
+
+Or alternatively, the ColumnValues from SQLEntity can be used to create a map, with the
 column as a key:
 *)
 
@@ -99,4 +121,3 @@ let rows =
 
 let employees2map = rows |> Seq.map(fun i -> i.ColumnValues |> Map.ofSeq)
 let firstNames = employees2map |> Seq.map (fun x -> x.["FirstName"])
-

src/SQLProvider.Common/SqlRuntime.Common.fs

@@ -341,6 +341,8 @@ type SqlEntity(dc: ISqlDataContext, tableName, columns: ColumnLookup, activeColu
             aliasCache.Value.Add(alias,newEntity)
             newEntity
 
+    /// Maps database entity class to the type provided in generic attribute.
+    /// You can define more detailed mapping via MappedColumnAttribute or propertyTypeMapping 
     member x.MapTo<'a>(?propertyTypeMapping : (string * obj) -> obj) =
         let typ = typeof<'a>
         let propertyTypeMapping = defaultArg propertyTypeMapping snd
@@ -359,15 +361,23 @@ type SqlEntity(dc: ISqlDataContext, tableName, columns: ColumnLookup, activeColu
                 [|
                     for prop in fields do
                         match dataMap.TryGetValue(clean prop) with
-                        | true, data -> yield propertyTypeMapping (prop.Name,data)
+                        | true, null when (prop.PropertyType.Name.StartsWith "FSharpValueOption" || prop.PropertyType.Name.StartsWith "FSharpOption") ->
+                            let cases = FSharpType.GetUnionCases prop.PropertyType
+                            let typedNone = FSharpValue.MakeUnion(cases[0], null)
+                            yield propertyTypeMapping (prop.Name, typedNone)
+                        | true, dataVal -> yield propertyTypeMapping (prop.Name, (Utilities.convertTypes dataVal prop.PropertyType))
                         | false, _ -> ()
                 |]
             unbox<'a> (ctor(values))
         else
             let instance = Activator.CreateInstance<'a>()
             for prop in typ.GetProperties() do
                 match dataMap.TryGetValue(clean prop) with
-                | true, data -> prop.GetSetMethod().Invoke(instance, [|propertyTypeMapping (prop.Name,data)|]) |> ignore
+                | true, null when (prop.PropertyType.Name.StartsWith "FSharpValueOption" || prop.PropertyType.Name.StartsWith "FSharpOption") ->
+                    let cases = FSharpType.GetUnionCases prop.PropertyType
+                    let typedNone = FSharpValue.MakeUnion(cases[0], null)
+                    prop.GetSetMethod().Invoke(instance, [|propertyTypeMapping (prop.Name, typedNone)|]) |> ignore
+                | true, dataVal -> prop.GetSetMethod().Invoke(instance, [|propertyTypeMapping (prop.Name, (Utilities.convertTypes dataVal prop.PropertyType))|]) |> ignore
                 | false, _ -> ()
             instance
 

src/SQLProvider.Common/Utils.fs

@@ -78,6 +78,8 @@ module Utilities =
         Type.GetType typename
 
     let rec internal convertTypes (itm:obj) (returnType:Type) =
+        if not(isNull itm) && Type.(=) (itm.GetType(), returnType) then itm
+        else
         if (returnType.Name.StartsWith("Option") || returnType.Name.StartsWith("FSharpOption")) && returnType.GenericTypeArguments.Length = 1 then
             if isNull itm then None |> box
             else
@@ -99,7 +101,9 @@ module Utilities =
             | :? Char as t -> Option.Some t |> box
             | :? DateTimeOffset as t -> Option.Some t |> box
             | :? TimeSpan as t -> Option.Some t |> box
-            | t -> Option.Some t |> box
+            | t ->
+                if t.GetType().Name.StartsWith("FSharpOption") then t |> box
+                else Option.Some t |> box
         elif (returnType.Name.StartsWith("ValueOption") || returnType.Name.StartsWith("FSharpValueOption")) && returnType.GenericTypeArguments.Length = 1 then
             if isNull itm then ValueNone |> box
             else
@@ -121,7 +125,10 @@ module Utilities =
             | :? Char as t -> ValueOption.Some t |> box
             | :? DateTimeOffset as t -> ValueOption.Some t |> box
             | :? TimeSpan as t -> ValueOption.Some t |> box
-            | t -> ValueOption.Some t |> box
+            | t ->
+                if t.GetType().Name.StartsWith("FSharpValueOption") then t|> box
+                else ValueOption.Some t |> box
+
         elif returnType.Name.StartsWith("Nullable") && returnType.GenericTypeArguments.Length = 1 then
             if isNull itm then null |> box
             else convertTypes itm (returnType.GenericTypeArguments.[0])

src/SQLProvider.DesignTime/SqlDesignTime.fs

@@ -930,8 +930,25 @@ module DesignTimeUtils =
                                   e
                               @@>)
 
-
-                        // This genertes a template.
+                        let templateContainer = ProvidedTypeDefinition("TemplateAsRecord", Some typeof<obj>, isErased=true)
+                        let templateCont = ProvidedProperty("TemplateAsRecord", templateContainer, getterCode = empty)
+                        templateCont.AddXmlDocDelayed(fun () -> "As this is erasing TypeProvider, you can use the generated types. However, if you need manual access to corresponding type, e.g. to use it in reflection, this will generate you a template of the runtime type. Copy and paste this to use however you will (e.g. with MapTo).")
+                        templateContainer.AddMemberDelayed(fun () ->
+                            let optType =
+                                match useOptionTypes with
+                                | NullableColumnType.OPTION -> " option"
+                                | NullableColumnType.VALUE_OPTION -> " voption"
+                                | NullableColumnType.NO_OPTION
+                                | _ -> ""
+                            let template=
+                                let items = 
+                                    columns
+                                    |> Seq.toArray
+                                    |> Array.map(fun kvp -> (SchemaProjections.nicePascalName kvp.Value.Name) + " : " + (Utilities.getType kvp.Value.TypeMapping.ClrType).Name + (if kvp.Value.IsNullable then optType else ""))
+                                "type " + (SchemaProjections.nicePascalName key) + " = { "  + (String.concat "; " items) + " }"
+                            ProvidedProperty(template, typeof<unit>, getterCode = empty) :> MemberInfo
+                        )
+                        serviceType.AddMember templateContainer
 
                         seq {
                             if not (ct.DeclaredProperties |> Seq.exists(fun m -> m.Name = "Individuals")) then
@@ -956,6 +973,7 @@ module DesignTimeUtils =
                                backwardCompatibilityOnly.Length <> minimalParameters.Length then
                                    create4old.AddXmlDoc("This will be obsolete soon. Migrate away from this!")
                                    yield create4old :> MemberInfo
+                            yield templateCont :> MemberInfo
 
                          } |> Seq.toList
                     )
@@ -1071,6 +1089,76 @@ module DesignTimeUtils =
             | Some con -> if (dbVendor <> DatabaseProviderTypes.MSACCESS) && con.State <> ConnectionState.Closed then con.Close()
             | None -> ()
 
+            let funcType =
+                typedefof<FSharpFunc<_, _>>.MakeGenericType(serviceType, typedefof<System.Threading.Tasks.Task>)
+            let wtr = ProvidedMethod("WithTransaction", [ ProvidedParameter("func", funcType)], typedefof<System.Threading.Tasks.Task>, invokeCode = fun args ->
+                let a0 = args.[0]
+                let func = args.[1]
+                let isMono = not(isNull (Type.GetType "Mono.Runtime"))
+                <@@
+                    task {
+                        use scope =
+                            match isMono with
+                            | true -> Unchecked.defaultof<Transactions.TransactionScope> // new Transactions.TransactionScope()
+                            | false ->
+                                // Note1: On Mono, 4.6.1 or newer is requred for compiling TransactionScopeAsyncFlowOption.
+                                // Note2: We should here also set the transaction option isolation level.
+                                new Transactions.TransactionScope(System.Transactions.TransactionScopeAsyncFlowOption.Enabled)
+                    //            new Transactions.TransactionScope(
+                    //                Transactions.TransactionScopeOption.Required,
+                    //                new Transactions.TransactionOptions(
+                    //                    IsolationLevel = Transactions.IsolationLevel.RepeatableRead),
+                    //                System.Transactions.TransactionScopeAsyncFlowOption.Enabled)
+
+                        let! res = ((%%func : obj) :?> FSharpFunc<ISqlDataContext,Task<_>>) ((%%a0 : obj) :?> ISqlDataContext)
+
+                        if not (isMono || isNull scope) then
+                            try
+                                scope.Complete()
+                                scope.Dispose()
+                            with
+                            | :? ObjectDisposedException -> ()
+                        return res
+                    }
+                    @@> )
+            wtr.AddXmlDoc ("Write operations can be wrapped into a single transaction with this. Try to avoid transactions taking possibly seconds.")
+            rootType.AddMember wtr
+
+            let funcTypeA =
+                typedefof<FSharpFunc<_, _>>.MakeGenericType(serviceType, typedefof<Async>)
+            let wtra = ProvidedMethod("WithTransactionAsync", [ ProvidedParameter("func", funcTypeA)], typedefof<Async>, invokeCode = fun args ->
+                let a0 = args.[0]
+                let func = args.[1]
+                <@@
+                    task {
+                        let isMono = not(isNull (Type.GetType "Mono.Runtime"))
+                        use scope =
+                            match isMono with
+                            | true -> Unchecked.defaultof<Transactions.TransactionScope> // new Transactions.TransactionScope()
+                            | false ->
+                                // Note1: On Mono, 4.6.1 or newer is requred for compiling TransactionScopeAsyncFlowOption.
+                                // Note2: We should here also set the transaction option isolation level.
+                                new Transactions.TransactionScope(System.Transactions.TransactionScopeAsyncFlowOption.Enabled)
+                    //            new Transactions.TransactionScope(
+                    //                Transactions.TransactionScopeOption.Required,
+                    //                new Transactions.TransactionOptions(
+                    //                    IsolationLevel = Transactions.IsolationLevel.RepeatableRead),
+                    //                System.Transactions.TransactionScopeAsyncFlowOption.Enabled)
+
+                        let! res = ((%%func : obj) :?> FSharpFunc<ISqlDataContext,Async<_>>) ((%%a0 : obj) :?> ISqlDataContext)
+
+                        if not (isMono || isNull scope) then
+                            try
+                                scope.Complete()
+                                scope.Dispose()
+                            with
+                            | :? ObjectDisposedException -> ()
+                        return res
+                    }
+                    @@> )
+            wtra.AddXmlDoc ("Write operations can be wrapped into a single transaction with this. Try to avoid transactions taking possibly seconds.")
+            rootType.AddMember wtra
+
             ()
 
         let createConstructors (config:TypeProviderConfig) (rootType:ProvidedTypeDefinition, serviceType, readServiceType, args) = 
@@ -1091,7 +1179,7 @@ module DesignTimeUtils =
 
             let customResPath =
               "resolutionPath",
-              "The location to look for dynamically loaded assemblies containing database vendor specific connections and custom types.  Types used in desing-time: If no better clue, prefer .NET Standard 2.0 versions. Semicolon to separate multiple.",
+              "The location to look for dynamically loaded assemblies containing database vendor specific connections and custom types.  Types used in design-time: If no better clue, prefer .NET Standard 2.0 versions. Semicolon to separate multiple.",
               typeof<string>
 
             let customTransOpts =
@@ -1447,7 +1535,7 @@ type public SqlTypeProvider(config: TypeProviderConfig) as this =
                     <param name='DatabaseVendor'> The target database vendor</param>
                     <param name='IndividualsAmount'>The amount of sample entities to project into the type system for each SQL entity type. Default 50. Note GDPR/PII regulations if using individuals with ContextSchemaPath.</param>
                     <param name='UseOptionTypes'>If set, F# option types will be used in place of nullable database columns.  If not, you will always receive the default value of the column's type even if it is null in the database.</param>
-                    <param name='ResolutionPath'>The location to look for dynamically loaded assemblies containing database vendor specific connections and custom types. Types used in desing-time: If no better clue, prefer .NET Standard 2.0 versions. Semicolon to separate multiple.</param>
+                    <param name='ResolutionPath'>The location to look for dynamically loaded assemblies containing database vendor specific connections and custom types. Types used in design-time: If no better clue, prefer .NET Standard 2.0 versions. Semicolon to separate multiple.</param>
                     <param name='Owner'>Oracle: The owner of the schema for this provider to resolve. PostgreSQL: A list of schemas to resolve, separated by spaces, newlines, commas, or semicolons.</param>
                     <param name='CaseSensitivityChange'>Should we do ToUpper or ToLower when generating table names?</param>
                     <param name='TableNames'>Comma separated table names list to limit a number of tables in big instances. The names can have '%' sign to handle it as in the 'LIKE' query (Oracle and MSSQL Only)</param>

src/SQLProvider.Runtime/Providers.MsSqlServer.fs

@@ -80,7 +80,7 @@ module MSSqlServer =
         findClrType <- clrMappings.TryFind
         findDbType <- dbMappings.TryFind
 
-    let checkIfMsSqlAssemblyIsDesingOnly (assembly:System.Reflection.Assembly)=
+    let checkIfMsSqlAssemblyIsDesignOnly (assembly:System.Reflection.Assembly)=
         try
             let metaData =
                 assembly.GetCustomAttributes(typeof<System.Reflection.AssemblyMetadataAttribute>, false)

tests/SqlProvider.Tests/QueryTests.fs

@@ -2928,5 +2928,29 @@ let ``mock for unit-testing: datacontext``() =
 
     Assert.AreEqual(2, res.Length)
     ()
-    
 
+
+// Generated with dc.Main.OrderDetails.TemplateAsRecord
+type MyMainOrders = { CustomerId : String voption; EmployeeId : Int64 voption; Freight : Decimal voption; OrderDate : DateTime voption; OrderId : Int64; RequiredDate : DateTime voption; ShipAddress : String voption; ShipCity : String voption; ShipCountry : String voption; ShipName : String voption; ShipPostalCode : String voption; ShipRegion : String voption; ShippedDate : DateTime voption }
+
+type MyMainOrders2() =
+    class
+        member val CustomerId = ValueSome "" with get,set
+        member val ShipRegion = ValueSome "" with get,set
+    end
+
+
+[<Test >]
+let ``simple select query with MapTo``() = 
+    let dc = sqlValueOption.GetDataContext()
+
+    let qry = 
+        query {
+            for ord in dc.Main.Orders do
+            select (ord)
+        } |> Seq.head
+    let mapped1 = qry.MapTo<MyMainOrders>()
+    let mapped2 = qry.MapTo<MyMainOrders2>()
+
+    Assert.AreEqual(ValueSome "VINET", mapped1.CustomerId)
+    Assert.AreEqual(ValueSome "VINET", mapped2.CustomerId)