Add provider specific column types

.gitignore

@@ -19,6 +19,7 @@ nupkg
 **/.idea/**/tasks.xml
 **/.idea/shelf/*
 **/.idea/dictionaries
+.idea
 
 # Sensitive or high-churn files
 **/.idea/**/dataSources/

src/SqlHydra.Npgsql/NpgsqlSchemaProvider.fs

@@ -1,7 +1,7 @@
 module SqlHydra.Npgsql.NpgsqlSchemaProvider
 
 open System.Data
-open Npgsql
+open NpgsqlTypes
 open SqlHydra.Domain
 
 let getSchema (cfg: Config) : Schema =
@@ -59,6 +59,12 @@ let getSchema (cfg: Config) : Schema =
             |}
         )
 
+    let getDbColumnType =
+        function
+            | "json" -> { TypeName = nameof NpgsqlDbType; TypeValue = nameof NpgsqlDbType.Json } |> Some
+            | "jsonb" -> { TypeName = nameof NpgsqlDbType; TypeValue = nameof NpgsqlDbType.Jsonb } |> Some
+            | _ -> None
+
     let tables = 
         sTables.Rows
         |> Seq.cast<DataRow>
@@ -87,6 +93,7 @@ let getSchema (cfg: Config) : Schema =
                     |> Option.map (fun typeMapping ->
                         { 
                             Column.Name = col.ColumnName
+                            Column.DbColumnType = getDbColumnType col.ProviderTypeName
                             Column.IsNullable = col.IsNullable
                             Column.TypeMapping = typeMapping
                             Column.IsPK = pks.Contains(col.TableSchema, col.TableName, col.ColumnName)

src/SqlHydra.Query/Kata.fs

@@ -1,5 +1,8 @@
 namespace SqlHydra.Query
 
+open System.Reflection
+open SqlHydra.DbColumnTypeAttribute
+open SqlHydra.Domain
 open SqlKata
 open System.Collections.Generic
 open System
@@ -25,6 +28,12 @@ module FQ =
         | Some schema -> $"{schema}.{tbl.Name}"
         | None -> tbl.Name
 
+type QueryParameter = 
+    {
+        Value: obj
+        Type: DbColumnType option
+    }
+
 type InsertQuerySpec<'T, 'Identity> =
     {
         Table: string
@@ -80,28 +89,34 @@ module private KataUtils =
                 | null -> box System.DBNull.Value 
                 | o -> o
 
+    let getDbColumnType (p: PropertyInfo) =
+        let attrs = p.GetCustomAttributes(true)
+        (attrs
+        |> Seq.choose (function | :? DbColumnTypeAttribute as attr -> Some attr.ColumnType | _ -> None))
+        |> Seq.tryHead
+
     let fromUpdate (spec: UpdateQuerySpec<'T>) = 
         let kvps = 
             match spec.Entity, spec.SetValues with
             | Some entity, [] -> 
                 match spec.Fields with 
                 | [] -> 
                     FSharp.Reflection.FSharpType.GetRecordFields(typeof<'T>) 
-                    |> Array.map (fun p -> p.Name, p.GetValue(entity))
+                    |> Array.map (fun p -> p.Name, { Value = p.GetValue(entity) |> boxValueOrOption; Type = getDbColumnType p } :> obj)
 
                 | fields -> 
                     let included = fields |> Set.ofList
                     FSharp.Reflection.FSharpType.GetRecordFields(typeof<'T>) 
                     |> Array.filter (fun p -> included.Contains(p.Name)) 
-                    |> Array.map (fun p -> p.Name, p.GetValue(entity))
+                    |> Array.map (fun p -> p.Name, { Value = p.GetValue(entity) |> boxValueOrOption; Type = getDbColumnType p } :> obj)
 
             | Some _, _ -> failwith "Cannot have both `entity` and `set` operations in an `update` expression."
             | None, [] -> failwith "Either an `entity` or `set` operations must be present in an `update` expression."
             | None, setValues -> setValues |> List.toArray
 
         let preparedKvps = 
             kvps 
-            |> Seq.map (fun (key,value) -> key, boxValueOrOption value)
+            |> Seq.map (fun (key,value) -> key, value)
             |> dict
             |> Seq.map id
 
@@ -129,7 +144,7 @@ module private KataUtils =
         | [ entity ] -> 
             let keyValuePairs =
                 includedProperties
-                |> Array.map (fun p -> KeyValuePair(p.Name, p.GetValue(entity) |> boxValueOrOption))
+                |> Array.map (fun p -> KeyValuePair(p.Name, { Value = p.GetValue(entity) |> boxValueOrOption; Type = getDbColumnType p } :> obj))
                 |> Array.toList
             Query(spec.Table).AsInsert(keyValuePairs, returnId = spec.IdentityField.IsSome)
 
@@ -141,7 +156,7 @@ module private KataUtils =
                 entities
                 |> List.map (fun entity ->
                     includedProperties
-                    |> Array.map (fun p -> p.GetValue(entity) |> boxValueOrOption)
+                    |> Array.map (fun p -> { Value = p.GetValue(entity) |> boxValueOrOption; Type = getDbColumnType p } :> obj)
                     |> Array.toSeq
                 )
             Query(spec.Table).AsInsert(columns, rowsValues)

src/SqlHydra.Query/QueryContext.fs

@@ -5,7 +5,16 @@ open SqlKata
 
 /// Contains methods that compile and read a query.
 type QueryContext(conn: DbConnection, compiler: SqlKata.Compilers.Compiler) =
-
+    let setParameterDbType (param: DbParameter) (qp: QueryParameter) =
+        match qp.Type, compiler with
+        | Some type', :? SqlKata.Compilers.PostgresCompiler when type'.TypeName = "NpgsqlDbType" ->
+            let property = param.GetType().GetProperty("NpgsqlDbType")
+            let dbTypeSetter = property.GetSetMethod()
+
+            let value = System.Enum.Parse(property.PropertyType, type'.TypeValue)
+            dbTypeSetter.Invoke(param, [|value|]) |> ignore
+        | _ -> ()    
+
     interface System.IDisposable with
         member this.Dispose() = 
             conn.Dispose()
@@ -44,7 +53,13 @@ type QueryContext(conn: DbConnection, compiler: SqlKata.Compilers.Compiler) =
         for kvp in compiledQuery.NamedBindings do
             let p = cmd.CreateParameter()
             p.ParameterName <- kvp.Key
-            p.Value <- kvp.Value
+
+            match kvp.Value with
+            | :? QueryParameter as qp ->
+                do setParameterDbType p qp
+                p.Value <- qp.Value
+            | _ ->
+                p.Value <- kvp.Value
             cmd.Parameters.Add(p) |> ignore
         cmd
 

src/SqlHydra.Query/SqlHydra.Query.fsproj

@@ -1,7 +1,7 @@
 <Project Sdk="Microsoft.NET.Sdk">
 
     <PropertyGroup>
-        <TargetFramework>netstandard2.0</TargetFramework>
+        <TargetFramework>net5.0</TargetFramework>
         <GenerateDocumentationFile>true</GenerateDocumentationFile>
         <WarnOn>3390;$(WarnOn)</WarnOn>
         <Version>0.530.0</Version>
@@ -32,4 +32,8 @@
         <PackageReference Include="SqlKata" Version="2.3.7" />
     </ItemGroup>
 
+    <ItemGroup>
+      <ProjectReference Include="..\SqlHydra\SqlHydra.fsproj" />
+    </ItemGroup>
+
 </Project>

src/SqlHydra.SqlServer/SqlServerSchemaProvider.fs

@@ -73,8 +73,9 @@ let getSchema (cfg: Config) : Schema =
                 |> Seq.choose (fun col -> 
                     SqlServerDataTypes.tryFindTypeMapping(col.ProviderTypeName)
                     |> Option.map (fun typeMapping -> 
-                        { 
+                        {
                             Column.Name = col.ColumnName
+                            Column.DbColumnType = None
                             Column.IsNullable = col.IsNullable
                             Column.TypeMapping = typeMapping
                             Column.IsPK = pks.Contains(col.TableSchema, col.TableName, col.ColumnName)

src/SqlHydra.Sqlite/SqliteSchemaProvider.fs

@@ -62,6 +62,7 @@ let getSchema (cfg: Config) : Schema =
                     |> Option.map (fun typeMapping -> 
                         { 
                             Column.Name = col.ColumnName
+                            Column.DbColumnType = None
                             Column.IsNullable = col.IsNullable
                             Column.TypeMapping = typeMapping
                             Column.IsPK = col.IsPK

src/SqlHydra/DbColumnTypeAttribute.fs

@@ -0,0 +1,13 @@
+module SqlHydra.DbColumnTypeAttribute
+
+open System
+open SqlHydra.Domain
+
+[<AttributeUsage(AttributeTargets.Property
+                 ||| AttributeTargets.Field)>]
+type DbColumnTypeAttribute(columnTypeName: string, columnTypeValue: string) =
+    inherit Attribute()
+
+    member this.ColumnType: DbColumnType =
+        { TypeName = columnTypeName
+          TypeValue = columnTypeValue }

src/SqlHydra/Domain.fs

@@ -17,9 +17,16 @@ type TypeMapping =
         ReaderMethod: string
     }
 
+type DbColumnType =
+    {
+        TypeName: string
+        TypeValue: string
+    }
+
 type Column = 
     {
         Name: string
+        DbColumnType: DbColumnType option
         TypeMapping: TypeMapping
         IsNullable: bool
         IsPK: bool

src/SqlHydra/SchemaGenerator.fs

@@ -1,10 +1,12 @@
 module SqlHydra.SchemaGenerator
 open FSharp.Compiler.SyntaxTree
 open FSharp.Compiler
+open FSharp.Compiler.XmlDoc
 open FsAst
 open Fantomas
 open Domain
 open System.Data
+open SqlHydra.DbColumnTypeAttribute
 
 let range0 = Range.range.Zero
 
@@ -23,26 +25,53 @@ let cliMutableAttribute =
     let atts = [ SynAttributeList.Create(attr) ]
     SynModuleDecl.CreateAttributes(atts)
 
+let createDbColumnTypeAttributes (column: Column) =
+    column.DbColumnType
+    |> Option.map (fun type' ->
+    let attr =
+        { TypeName = LongIdentWithDots.CreateString (nameof DbColumnTypeAttribute)
+        ; ArgExpr = SynExpr.CreateParenedTuple [ SynExpr.CreateConst (SynConst.String(type'.TypeName, range0))
+                                                 SynExpr.CreateConst (SynConst.String(type'.TypeValue, range0)) ]
+        ; Target = None
+        ; AppliesToGetterAndSetter = false
+        ; Range = range0 } : SynAttribute
+
+    SynAttributes.Cons (SynAttributeList.Create attr, SynAttributes.Empty)
+    ) |> Option.defaultValue SynAttributes.Empty
+
 /// Creates a record definition named after a table.
 let createTableRecord (tbl: Table) = 
     let myRecordId = LongIdentWithDots.CreateString tbl.Name
     let recordCmpInfo = SynComponentInfoRcd.Create(myRecordId.Lid)
 
     let recordDef =
         tbl.Columns
-        |> List.map (fun col -> 
+        |> List.map (fun col ->
             let field = 
                 if col.TypeMapping.ClrType = "byte[]" then 
                     let b = SynType.Create("byte")
                     SynType.Array(0, b, range0)
                 else
                     SynType.Create(col.TypeMapping.ClrType)
-
-            if col.IsNullable then                         
-                let opt = SynType.Option(field)
-                SynFieldRcd.Create(Ident.Create(col.Name), opt)
-            else 
-                SynFieldRcd.Create(Ident.Create(col.Name), field)
+
+            let attributes = createDbColumnTypeAttributes col
+
+            let type' =
+                if col.IsNullable then
+                    SynType.Option(field)
+                else
+                    field
+
+            {   
+                Attributes = attributes
+                IsStatic = false
+                Id = Some (Ident.Create(col.Name))
+                Type = type'
+                IsMutable = false
+                XmlDoc = PreXmlDoc.Empty
+                Access = None
+                Range = range0
+            }
         )
         |> SynTypeDefnSimpleReprRecordRcd.Create
         |> SynTypeDefnSimpleReprRcd.Record
@@ -631,7 +660,10 @@ let substitutions =
     [
         /// Reader classes at top of namespace
         "open Substitute.Extensions",
-        """type Column(reader: System.Data.IDataReader, getOrdinal: string -> int, column) =
+        """
+open SqlHydra.DbColumnTypeAttribute
+
+type Column(reader: System.Data.IDataReader, getOrdinal: string -> int, column) =
         member __.Name = column
         member __.IsNull() = getOrdinal column |> reader.IsDBNull
         override __.ToString() = __.Name

src/SqlHydra/SqlHydra.fsproj

@@ -10,6 +10,7 @@
 
   <ItemGroup>
     <Compile Include="Domain.fs" />
+    <Compile Include="DbColumnTypeAttribute.fs" />
     <Compile Include="SchemaGenerator.fs" />
     <Compile Include="TomlConfigParser.fs" />
     <Compile Include="Fsproj.fs" />