Single case union support

docsSrc/How_Tos/Using_Single_Case_unions.md

@@ -0,0 +1,97 @@
+# Single case union types (aka Simple types)
+It's common to use single case discriminated unions to meaningfully represent data values.
+But EF does not know anything about this kind of type. Luckily this repository has some ways to help you to deal with they.
+
+
+    [hide]
+    #r "Microsoft.EntityFrameworkCore.Sqlite.dll"
+
+    open System
+    open System.ComponentModel.DataAnnotations
+    open System.Linq
+    open Microsoft.EntityFrameworkCore
+    open EntityFrameworkCore.FSharp
+    open EntityFrameworkCore.FSharp.DbContextHelpers
+
+## Configuring
+
+We have two approaches to deal with single case union types which are a converter or an extension that searches for all Single Case Unions in your entities.
+
+
+
+```fsharp
+open EntityFrameworkCore.FSharp.Extensions
+
+type PostitiveInteger = PositiveInteger of int
+
+[<CLIMutable>]
+type Blog = {
+    [<Key>]
+    Id : Guid
+    Title : string
+    Votes: PositiveInteger
+}
+
+type MyContext () =
+    inherit DbContext()
+
+    [<DefaultValue>]
+    val mutable private _blogs : DbSet<Blog>
+    member this.Blogs with get() = this._blogs and set v = this._blogs <- v
+
+    override _.OnModelCreating builder =
+
+        // setting manually each property
+        builder.Entity<Blog>()
+            .Property(fun x -> x.Votes)
+            .HasConversion(SingleCaseUnionConverter<int, PositiveInteger>())
+        |> ignore
+
+        // OR
+
+        // enables single clase unions for all entities
+        builder.RegisterSingleUnionCases() 
+
+    override _.OnConfiguring(options: DbContextOptionsBuilder) : unit =
+           options
+             .UseSqlite( "Data Source=dbName.db")
+             .UseFSharpTypes() // enable queries for F# types
+           |> ignore
+
+```
+
+## Querying
+
+You can query for equality without any problem
+
+
+```fsharp
+let blog =
+   query {
+       for blog in ctx.Blogs do
+       where (blog.Votes = PositiveInteger 10)
+       select blog
+       headOrDefault
+   }
+
+ // or  
+let blog = ctx.Blogs.Where(fun b -> b.Votes = PositiveInteger 10).FirstOrDefault()
+```
+
+
+For querying with other types of operation you will need to unwrap the value inside the query
+
+```fsharp
+let blog =
+   query {
+       for blog in ctx.Blogs do
+       let (PositiveInteger votes) = blog.Votes
+       where (votes > 0)
+       select blog
+       headOrDefault
+   }
+```
+
+## Private Constructor
+
+This extension doesn't support private union case constructors. 

docsSrc/index.md

@@ -36,6 +36,7 @@ This provides support for code-first and database-first use of EF Core in F#, in
         <a href="{{siteBaseUrl}}/How_Tos/Scaffold_As_Types.html" class="btn btn-primary">Scaffolding &amp; Code Generation</a>
         <a href="{{siteBaseUrl}}/How_Tos/Use_DbContextHelpers.html" class="btn btn-primary">Using DbContext Helpers</a>
         <a href="{{siteBaseUrl}}/How_Tos/Querying_Options.html" class="btn btn-primary">Querying option types</a>
+        <a href="{{siteBaseUrl}}/How_Tos/Using_Single_Case_unions.html" class="btn btn-primary">Single Case Unions</a>
       </div>
     </div>
   </div>

src/EFCore.FSharp/EFCore.FSharp.fsproj

@@ -32,6 +32,8 @@
     <Compile Include="Internal\FSharpUtilities.fs" />
     <Compile Include="ValueConverters\Converters.fs" />
     <Compile Include="Translations\OptionTranslation.fs" />
+    <Compile Include="Translations\SingleCaseUnionTranslation.fs" />
+    <Compile Include="Translations\Translation.fs" />
     <Compile Include="Scaffolding\FSharpDbContextGenerator.fs" />
     <Compile Include="Scaffolding\FSharpEntityTypeGenerator.fs" />
     <Compile Include="Scaffolding\Internal\FSharpModelGenerator.fs" />

src/EFCore.FSharp/Extensions/ModelBuilderExtensions.fs

@@ -1,14 +1,15 @@
 namespace EntityFrameworkCore.FSharp
 
 open System
-open EntityFrameworkCore.FSharp.Translations.OptionTranslation
+open EntityFrameworkCore.FSharp.Translations
 open Microsoft.EntityFrameworkCore
 open Microsoft.EntityFrameworkCore.Infrastructure
 open Microsoft.EntityFrameworkCore.Storage.ValueConversion
 
 module Extensions =
 
     let private genericOptionConverterType = typedefof<OptionConverter<_>>
+    let private genericSingleCaseUnionConverterType = typedefof<SingleCaseUnionConverter<_,_>>
 
     type ModelBuilder with
 
@@ -49,9 +50,32 @@ module Extensions =
                         .HasConversion(converter)
                     |> ignore
 
+        member this.RegisterSingleUnionCases() =
+            let makeSingleUnionCaseConverter tUnion =
+                let underlyingType = SharedTypeExtensions.unwrapSingleCaseUnion tUnion
+                let converterType = genericSingleCaseUnionConverterType.MakeGenericType(underlyingType, tUnion)
+                let converter = converterType.GetConstructor([||]).Invoke([||]) :?> ValueConverter
+                converter
+
+            let converterDetails =
+                this.Model.GetEntityTypes()
+                |> Seq.filter (fun p -> not <| SharedTypeExtensions.isSingleCaseUnion p.ClrType)
+                |> Seq.collect (fun e -> e.ClrType.GetProperties())
+                |> Seq.filter (fun p -> SharedTypeExtensions.isSingleCaseUnion p.PropertyType)
+                |> Seq.map(fun p -> (p, (makeSingleUnionCaseConverter p.PropertyType)) )
+
+            for (prop, converter) in converterDetails do
+                    this.Entity(prop.DeclaringType)
+                        .Property(prop.PropertyType,prop.Name)
+                        .HasConversion(converter)
+                    |> ignore
+
     let registerOptionTypes (modelBuilder : ModelBuilder) =
         modelBuilder.RegisterOptionTypes()
 
+    let registerSingleCaseUnionTypes (modelBuilder : ModelBuilder) =
+        modelBuilder.RegisterSingleUnionCases()
+
     let useValueConverter<'a> (converter : ValueConverter) (modelBuilder : ModelBuilder) =
         modelBuilder.UseValueConverterForType<'a>(converter)
 
@@ -62,8 +86,9 @@ module Extensions =
     type DbContextOptionsBuilder with
         member this.UseFSharpTypes() =
             let extension =
-                let finded = this.Options.FindExtension<FsharpTypeOptionsExtension>()
-                if (box finded) <> null then finded else FsharpTypeOptionsExtension()
+                let finded = this.Options.FindExtension<FSharpTypeOptionsExtension>()
+                if (box finded) <> null then finded else FSharpTypeOptionsExtension()
+
 
             (this :> IDbContextOptionsBuilderInfrastructure).AddOrUpdateExtension(extension)
             this

src/EFCore.FSharp/Translations/OptionTranslation.fs

@@ -1,10 +1,9 @@
 module EntityFrameworkCore.FSharp.Translations.OptionTranslation
 
 open EntityFrameworkCore.FSharp
-open Microsoft.EntityFrameworkCore.Infrastructure
 open Microsoft.EntityFrameworkCore.Query
 
-let memberTranslator(sqlExp: ISqlExpressionFactory ) = {
+let optionMemberTranslator(sqlExp: ISqlExpressionFactory ) = {
     new IMemberTranslator with
         member _.Translate(instance, member', returnType, loger) =
            if not (SharedTypeExtensions.isOptionType member'.DeclaringType) then
@@ -13,7 +12,7 @@ let memberTranslator(sqlExp: ISqlExpressionFactory ) = {
                sqlExp.Convert(instance, returnType) :> _
 }
 
-let methodCallTranslator(sqlExp: ISqlExpressionFactory ) = {
+let optionMethodCallTranslator(sqlExp: ISqlExpressionFactory ) = {
     new IMethodCallTranslator with
         member _.Translate(instance, method, arguments, loger) =
            if not (SharedTypeExtensions.isOptionType method.DeclaringType) then
@@ -27,41 +26,5 @@ let methodCallTranslator(sqlExp: ISqlExpressionFactory ) = {
            | _ -> null
 }
 
-type OptionMemberTranslatorPlugin(sqlExpressionFactory) =
-    interface IMemberTranslatorPlugin with
-        member _.Translators = seq {
-            memberTranslator sqlExpressionFactory
-        }
-
-type OptionMethodCallTranslatorPlugin(sqlExpressionFactory) =
-    interface IMethodCallTranslatorPlugin with
-        member _.Translators = seq {
-            methodCallTranslator sqlExpressionFactory
-        }
-
-type ExtensionInfo(extension) =
-    inherit DbContextOptionsExtensionInfo(extension)
-        override _.IsDatabaseProvider = false
-
-        override _.GetServiceProviderHashCode() = 0L
-
-        override _.PopulateDebugInfo debugInfo =
-             debugInfo.["SqlServer: UseFSharp"] <- "1"
-
-        override _.LogFragment = "using FSharp option type"
-
-type FsharpTypeOptionsExtension() =
-     interface IDbContextOptionsExtension with
-         member this.ApplyServices(services) =
-             EntityFrameworkRelationalServicesBuilder(services)
-                 .TryAddProviderSpecificServices(
-                     fun x ->
-                         x.TryAddSingletonEnumerable<IMemberTranslatorPlugin, OptionMemberTranslatorPlugin>()
-                          .TryAddSingletonEnumerable<IMethodCallTranslatorPlugin, OptionMethodCallTranslatorPlugin>()
-                         |> ignore)
-             |> ignore
-
-         member this.Info = ExtensionInfo(this :> IDbContextOptionsExtension) :> _
-         member this.Validate _ = ()
 
 

src/EFCore.FSharp/Translations/SingleCaseUnionTranslation.fs

@@ -0,0 +1,13 @@
+module EntityFrameworkCore.FSharp.Translations.SingleCaseUnionTranslation
+
+open EntityFrameworkCore.FSharp
+open Microsoft.EntityFrameworkCore.Query
+
+let singleCaseUnionMemberTranslator(sqlExp: ISqlExpressionFactory ) = {
+    new IMemberTranslator with
+        member _.Translate(instance, member', returnType, loger) =
+           if SharedTypeExtensions.isSingleCaseUnion member'.DeclaringType then
+               sqlExp.Convert(instance, returnType) :> _
+           else
+               instance
+}

src/EFCore.FSharp/Translations/Translation.fs

@@ -0,0 +1,42 @@
+namespace EntityFrameworkCore.FSharp.Translations
+
+open Microsoft.EntityFrameworkCore.Infrastructure
+open Microsoft.EntityFrameworkCore.Query
+
+type FSharpMemberTranslatorPlugin(sqlExpressionFactory) =
+    interface IMemberTranslatorPlugin with
+        member _.Translators = seq {
+            OptionTranslation.optionMemberTranslator sqlExpressionFactory
+            SingleCaseUnionTranslation.singleCaseUnionMemberTranslator sqlExpressionFactory
+        }
+
+type FSharpMethodCallTranslatorPlugin(sqlExpressionFactory) =
+    interface IMethodCallTranslatorPlugin with
+        member _.Translators = seq {
+            OptionTranslation.optionMethodCallTranslator sqlExpressionFactory
+        }
+
+type ExtensionInfo(extension) =
+    inherit DbContextOptionsExtensionInfo(extension)
+        override _.IsDatabaseProvider = false
+
+        override _.GetServiceProviderHashCode() = 0L
+
+        override _.PopulateDebugInfo debugInfo =
+             debugInfo.["SqlServer: UseFSharp"] <- "1"
+
+        override _.LogFragment = "using FSharp types"
+
+type FSharpTypeOptionsExtension() =
+     interface IDbContextOptionsExtension with
+         member this.ApplyServices(services) =
+             EntityFrameworkRelationalServicesBuilder(services)
+                 .TryAddProviderSpecificServices(
+                     fun x ->
+                         x.TryAddSingletonEnumerable<IMemberTranslatorPlugin, FSharpMemberTranslatorPlugin>()
+                          .TryAddSingletonEnumerable<IMethodCallTranslatorPlugin, FSharpMethodCallTranslatorPlugin>()
+                         |> ignore)
+             |> ignore
+
+         member this.Info = ExtensionInfo(this :> IDbContextOptionsExtension) :> _
+         member this.Validate _ = ()

src/EFCore.FSharp/Utilities/SharedTypeExtensions.fs

@@ -3,6 +3,7 @@ namespace EntityFrameworkCore.FSharp
 open System
 open System.Reflection
 open System.Text
+open Microsoft.FSharp.Reflection
 
 module internal rec SharedTypeExtensions =
 
@@ -165,3 +166,15 @@ module internal rec SharedTypeExtensions =
         let sb = StringBuilder()
         processType t useFullName sb |> ignore
         sb.ToString()
+
+    let isSingleCaseUnion t =
+      FSharpType.IsUnion t
+      && FSharpType.GetUnionCases(t)
+         |> Array.length
+         |> ((=)1)
+
+    let unwrapSingleCaseUnion t =
+      let case = FSharpType.GetUnionCases(t)
+                 |> Array.exactlyOne
+      let field = case.GetFields() |> Array.head
+      field.PropertyType

src/EFCore.FSharp/ValueConverters/Converters.fs

@@ -2,6 +2,7 @@ namespace EntityFrameworkCore.FSharp
 
 module Conversion =
 
+  open FSharp.Reflection
   open Microsoft.FSharp.Linq.RuntimeHelpers
   open System
   open System.Linq.Expressions
@@ -16,6 +17,20 @@ module Conversion =
     |> LeafExpressionConverter.QuotationToExpression
     |> unbox<Expression<Func<'T option, 'T>>>
 
+  let toSingleCaseUnion<'T, 'U> =
+    <@ Func<'T, 'U>(fun (x : 'T) -> FSharpValue.MakeUnion(FSharpType.GetUnionCases(typedefof<'U>) |> Array.exactlyOne, [|x :> obj|]) :?> 'U) @>
+    |> LeafExpressionConverter.QuotationToExpression
+    |> unbox<Expression<Func<'T, 'U>>>
+
+  let fromFromSingleCase<'T, 'U> =
+    <@ Func<'U, 'T>(fun (x : 'U) -> FSharpValue.GetUnionFields(x, x.GetType()) |> snd |> Seq.head :?> 'T) @>
+    |> LeafExpressionConverter.QuotationToExpression
+    |> unbox<Expression<Func<'U, 'T>>>
+
 type OptionConverter<'T> () =
   inherit Microsoft.EntityFrameworkCore.Storage.ValueConversion.ValueConverter<'T option, 'T>
             (Conversion.fromOption, Conversion.toOption)
+
+type SingleCaseUnionConverter<'T, 'U> () =
+  inherit Microsoft.EntityFrameworkCore.Storage.ValueConversion.ValueConverter<'U, 'T>
+            (Conversion.fromFromSingleCase, Conversion.toSingleCaseUnion)

tests/EFCore.FSharp.Tests/EFCore.FSharp.Tests.fsproj

@@ -27,6 +27,7 @@
         <Compile Include="Scaffolding\Internal\FSharpDbContextGeneratorTest.fs" />
         <Compile Include="ValueConverters\ValueConvertersTest.fs" />
         <Compile Include="Translations\OptionTranslationTests.fs" />
+        <Compile Include="Translations\SingleCaseUnionTranslationTests.fs" />
         <Compile Include="DbContextHelperTests.fs" />
         <Compile Include="Main.fs" />
     </ItemGroup>