SystemTextJson: Support automatic TypeSafeEnum/Union converter select…

…ion (#69)

CHANGELOG.md

@@ -9,6 +9,10 @@ The `Unreleased` section name is replaced by the expected version of next releas
 ## [Unreleased]
 
 ### Added
+
+- `SystemTextJson.UnionOrTypeSafeEnumConverterFactory`: Global converter that automatically applies a `TypeSafeEnumConverter` to all Discriminated Unions that support it, and `UnionConverter` to all others [#69](https://github.com/jet/FsCodec/pull/69)
+- `SystemTextJson.Options(autoUnion = true)`: Automated wireup of `UnionOrTypeSafeEnumConverterFactory` [#69](https://github.com/jet/FsCodec/pull/69)
+
 ### Changed
 
 - `Serdes`: Changed `Serdes` to be stateful, requiring a specific set of `Options`/`Settings` that are always applied consistently [#70](https://github.com/jet/FsCodec/pull/70)

README.md

@@ -95,7 +95,11 @@ The respective concrete Codec packages include relevant `Converter`/`JsonConvert
 
   - [`OptionConverter`](https://github.com/jet/FsCodec/blob/master/src/FsCodec.NewtonsoftJson/OptionConverter.fs#L7) represents F#'s `Option<'t>` as a value or `null`; included in the standard `Settings.Create` profile.
   - [`VerbatimUtf8JsonConverter`](https://github.com/jet/FsCodec/blob/master/src/FsCodec.NewtonsoftJson/VerbatimUtf8JsonConverter.fs#L7) captures/renders known valid UTF8 JSON data into a `byte[]` without decomposing it into an object model (not typically relevant for application level code, used in `Equinox.Cosmos` versions prior to `3.0`).
-
+
+### `FsCodec.SystemTextJson`-specific low level converters
+
+- `UnionOrTypeSafeEnumConverterFactory`: Global converter that automatically applies a `TypeSafeEnumConverter` to all Discriminated Unions that support it, and `UnionConverter` to all others. See [this `System.Text.Json` issue](https://github.com/dotnet/runtime/issues/55744) for background information as to the reasoning behind and tradeoffs involved in applying such a policy.  
+
 ## `FsCodec.NewtonsoftJson.Settings`
 
 [`FsCodec.NewtonsoftJson.Settings`](https://github.com/jet/FsCodec/blob/master/src/FsCodec.NewtonsoftJson/Settings.fs#L8) provides a clean syntax for building a `Newtonsoft.Json.JsonSerializerSettings` with which to define a serialization contract profile for interoperability purposes. Methods:
@@ -110,7 +114,9 @@ The respective concrete Codec packages include relevant `Converter`/`JsonConvert
 [`FsCodec.SystemTextJson.Options`](https://github.com/jet/FsCodec/blob/stj/src/FsCodec.SystemTextJson/Options.fs#L8) provides a clean syntax for building a `System.Text.Json.Serialization.JsonSerializerOptions` as per `FsCodec.NewtonsoftJson.Settings`, above. Methods:
 - `CreateDefault`: equivalent to generating a `new JsonSerializerSettings()` without any overrides of any kind
 - `Create`: as `CreateDefault` with the following difference:
-  - Inhibits the HTML-safe escaping that `System.Text.Json` provides as a default by overriding `Encoder` with `System.Text.Encodings.Web.JavaScriptEncoder.UnsafeRelaxedJsonEscaping`
+  - By default, inhibits the HTML-safe escaping that `System.Text.Json` provides as a default by overriding `Encoder` with `System.Text.Encodings.Web.JavaScriptEncoder.UnsafeRelaxedJsonEscaping`
+  - `(camelCase = true)`: opts into camel case conversion for `PascalCased` properties and `Dictionary` keys
+  - `(autoUnion = true)`: triggers inclusion of a `UnionOrTypeSafeEnumConverterFactory`, enabling F# Discriminated Unions to be converted in an opinionated manner. See [`AutoUnionTests.fs`](https://github.com/jet/FsCodec/blob/master/tests/FsCodec.SystemTextJson.Tests/AutoUnionTests.fs) for examples  
 
 ## `Serdes`
 
@@ -150,7 +156,11 @@ This adds all the converters used by the `serdes` serialization/deserialization
 <a name="aspnetstj"></a>
 ## ASP.NET Core with `System.Text.Json`
 
-The equivalent for the native `System.Text.Json` looks like this:
+The equivalent for the native `System.Text.Json`, as v6, thanks [to the great work of the .NET team](https://github.com/dotnet/runtime/pull/55108), is presently a no-op.
+
+The following illustrates how opt into [`autoUnion` mode](https://github.com/jet/FsCodec/blob/master/tests/FsCodec.SystemTextJson.Tests/AutoUnionTests.fs) for the rendering of View Models by ASP.NET:
+
+    let serdes = FsCodec.SystemTextJson.Options.Create(autoUnion = true) |> FsCodec.SystemTextJson.Serdes
 
     let serdes = FsCodec.SystemTextJson.Options.Create() |> FsCodec.SystemTextJson.Serdes
 
@@ -159,8 +169,6 @@ The equivalent for the native `System.Text.Json` looks like this:
         serdes.Options.Converters |> Seq.iter options.JsonSerializerOptions.Converters.Add
     ) |> ignore
 
-_As of `System.Text.Json` v6, thanks [to the great work of the .NET team](https://github.com/dotnet/runtime/pull/55108), the above is presently a no-op._
-
 # Examples: `FsCodec.(Newtonsoft|SystemText)Json`
 
 There's a test playground in [tests/FsCodec.NewtonsoftJson.Tests/Examples.fsx](tests/FsCodec.NewtonsoftJson.Tests/Examples.fsx). It's highly recommended to experiment with conversions using FSI. (Also, PRs adding examples are much appreciated...)

src/FsCodec.SystemTextJson/FsCodec.SystemTextJson.fsproj

@@ -11,6 +11,7 @@
     <Compile Include="Pickler.fs" />
     <Compile Include="UnionConverter.fs" />
     <Compile Include="TypeSafeEnumConverter.fs" />
+    <Compile Include="UnionOrTypeSafeEnumConverterFactory.fs" />
     <Compile Include="Options.fs" />
     <Compile Include="Codec.fs" />
     <Compile Include="Serdes.fs" />

src/FsCodec.SystemTextJson/Options.fs

@@ -54,7 +54,11 @@ type Options private () =
             [<Optional; DefaultParameterValue(null)>] ?autoUnion : bool) =
 
         Options.CreateDefault(
-            converters = converters,
+            converters =
+                (   if autoUnion = Some true then
+                        let converter : JsonConverter array = [| UnionOrTypeSafeEnumConverterFactory() |]
+                        if converters = null then converter else Array.append converters converter
+                    else converters),
             ?ignoreNulls = ignoreNulls,
             ?indent = indent,
             ?camelCase = camelCase,

src/FsCodec.SystemTextJson/TypeSafeEnumConverter.fs

@@ -7,15 +7,12 @@ open System.Text.Json
 /// Utilities for working with DUs where none of the cases have a value
 module TypeSafeEnum =
 
-    let private _isTypeSafeEnum (t : Type) =
-        Union.isUnion t
-        && (Union.getUnion t).cases |> Seq.forall (fun case -> case.GetFields().Length = 0)
-    let isTypeSafeEnum : Type -> bool = memoize _isTypeSafeEnum
+    let isTypeSafeEnum (typ : Type) =
+        Union.isUnion typ
+        && Union.hasOnlyNullaryCases typ
 
     let tryParseT (t : Type) predicate =
-        if not (Union.isUnion t) then invalidArg "t" "Type must be a FSharpUnion." else
-
-        let u = Union.getUnion t
+        let u = Union.getInfo t
         u.cases
         |> Array.tryFindIndex (fun c -> predicate c.Name)
         |> Option.map (fun tag -> u.caseConstructor.[tag] [||])
@@ -31,9 +28,7 @@ module TypeSafeEnum =
     let parse<'T> (str : string) = parseT typeof<'T> str :?> 'T
 
     let toString<'t> (x : 't) =
-        if not (Union.isUnion (typeof<'t>)) then invalidArg "'t" "Type must be a FSharpUnion." else
-
-        let u = Union.getUnion (typeof<'t>)
+        let u = Union.getInfo typeof<'t>
         let tag = u.tagReader (box x)
         // TOCONSIDER memoize and/or push into `Union` https://github.com/jet/FsCodec/pull/41#discussion_r394473137
         u.cases.[tag].Name

src/FsCodec.SystemTextJson/UnionConverter.fs

@@ -2,17 +2,15 @@
 
 open FSharp.Reflection
 open System
-open System.Reflection
 open System.Text.Json
 
 type IUnionConverterOptions =
     abstract member Discriminator : string with get
     abstract member CatchAllCase : string option with get
 
-/// Use this attribute in combination with a JsonConverter/UnionConverter attribute to specify
-/// your own name for a discriminator and/or a catch-all case for a specific discriminated union.
-/// If this attribute is set, its values take precedence over the values set on the converter via its constructor.
-/// Example: <c>[<JsonConverter(typeof<UnionConverter<T>>); JsonUnionConverterOptions("type")>]</c>
+/// <summary>Use this attribute in combination with a JsonConverter / UnionConverter attribute to specify
+/// your own name for a discriminator and/or a catch-all case for a specific discriminated union.</summary>
+/// <example><c>[JsonConverter typeof &lt; UnionConverter &lt; T &gt; &gt;); JsonUnionConverterOptions("type") &gt;]</c></example>
 [<AttributeUsage(AttributeTargets.Class ||| AttributeTargets.Struct, AllowMultiple = false, Inherited = false)>]
 type JsonUnionConverterOptionsAttribute(discriminator : string) =
     inherit Attribute()
@@ -21,74 +19,41 @@ type JsonUnionConverterOptionsAttribute(discriminator : string) =
         member _.Discriminator = discriminator
         member x.CatchAllCase = Option.ofObj x.CatchAllCase
 
-type UnionConverterOptions =
-    {
-        discriminator : string
-        catchAllCase : string option
-    }
+type private UnionConverterOptions =
+    {   discriminator : string
+        catchAllCase : string option }
     interface IUnionConverterOptions with
         member x.Discriminator = x.discriminator
         member x.CatchAllCase = x.catchAllCase
 
 [<NoComparison; NoEquality>]
 type private Union =
-    {
-        cases : UnionCaseInfo[]
+    {   cases : UnionCaseInfo[]
         tagReader : obj -> int
         fieldReader : (obj -> obj[])[]
         caseConstructor : (obj[] -> obj)[]
-        options : IUnionConverterOptions option
-    }
+        options : IUnionConverterOptions option }
 
 module private Union =
 
     let isUnion : Type -> bool = memoize (fun t -> FSharpType.IsUnion(t, true))
-    let getUnionCases = memoize (fun t -> FSharpType.GetUnionCases(t, true))
 
-    let private createUnion t =
-        let cases = getUnionCases t
-        {
-            cases = cases
+    let private createInfo t =
+        let cases = FSharpType.GetUnionCases(t, true)
+        {   cases = cases
             tagReader = FSharpValue.PreComputeUnionTagReader(t, true)
             fieldReader = cases |> Array.map (fun c -> FSharpValue.PreComputeUnionReader(c, true))
             caseConstructor = cases |> Array.map (fun c -> FSharpValue.PreComputeUnionConstructor(c, true))
             options =
                 t.GetCustomAttributes(typeof<JsonUnionConverterOptionsAttribute>, false)
                 |> Array.tryHead // AttributeUsage(AllowMultiple = false)
-                |> Option.map (fun a -> a :?> IUnionConverterOptions)
-        }
-    let getUnion : Type -> Union = memoize createUnion
-
-    /// Parallels F# behavior wrt how it generates a DU's underlying .NET Type
-    let inline isInlinedIntoUnionItem (t : Type) =
-        t = typeof<string>
-        || (t.IsValueType && t <> typeof<JsonElement>)
-        || t.IsArray
-        || (t.IsGenericType
-           && (typedefof<Option<_>> = t.GetGenericTypeDefinition()
-                || t.GetGenericTypeDefinition().IsValueType)) // Nullable<T>
-
-    let typeHasJsonConverterAttribute_ (t : Type) = t.IsDefined(typeof<Serialization.JsonConverterAttribute>(*, false*))
-    let typeHasJsonConverterAttribute = memoize typeHasJsonConverterAttribute_
-    let typeIsUnionWithConverterAttribute = memoize (fun (t : Type) -> isUnion t && typeHasJsonConverterAttribute_ t)
-
-    let propTypeRequiresConstruction (propertyType : Type) =
-        not (isInlinedIntoUnionItem propertyType)
-        && not (typeHasJsonConverterAttribute propertyType)
-
-    /// Prepare arguments for the Case class ctor based on the kind of case and how F# maps that to a Type
-    /// and/or whether we need to defer to System.Text.Json
-    let mapTargetCaseArgs (element : JsonElement) (options : JsonSerializerOptions) (props : PropertyInfo[]) : obj [] =
-        match props with
-        | [| singleCaseArg |] when propTypeRequiresConstruction singleCaseArg.PropertyType ->
-            [| JsonSerializer.Deserialize(element, singleCaseArg.PropertyType, options) |]
-        | multipleFieldsInCustomCaseType ->
-            [| for fi in multipleFieldsInCustomCaseType ->
-                match element.TryGetProperty fi.Name with
-                | false, _ when fi.PropertyType.IsValueType -> Activator.CreateInstance fi.PropertyType
-                | false, _ -> null
-                | true, el when el.ValueKind = JsonValueKind.Null -> null
-                | true, el -> JsonSerializer.Deserialize(el, fi.PropertyType, options) |]
+                |> Option.map (fun a -> a :?> IUnionConverterOptions) }
+    let getInfo : Type -> Union = memoize createInfo
+
+    /// Allows us to distinguish between Unions that have bodies and hence should UnionConverter
+    let hasOnlyNullaryCases (t : Type) =
+        let union = getInfo t
+        union.cases |> Seq.forall (fun case -> case.GetFields().Length = 0)
 
 type UnionConverter<'T>() =
     inherit Serialization.JsonConverter<'T>()
@@ -101,7 +66,7 @@ type UnionConverter<'T>() =
 
     override _.Write(writer, value, options) =
         let value = box value
-        let union = Union.getUnion typeof<'T>
+        let union = Union.getInfo typeof<'T>
         let unionOptions = getOptions union
         let tag = union.tagReader value
         let case = union.cases.[tag]
@@ -114,8 +79,8 @@ type UnionConverter<'T>() =
         for fieldInfo, fieldValue in Seq.zip fieldInfos fieldValues do
             if fieldValue <> null || options.DefaultIgnoreCondition <> Serialization.JsonIgnoreCondition.Always then
                 let element = JsonSerializer.SerializeToElement(fieldValue, fieldInfo.PropertyType, options)
-                if fieldInfos.Length = 1 && element.ValueKind = JsonValueKind.Object && not (Union.typeIsUnionWithConverterAttribute fieldInfo.PropertyType) then
-                    // flatten the object properties into the same one as the discriminator
+                if fieldInfos.Length = 1 && FSharpType.IsRecord(fieldInfo.PropertyType, true) then
+                    // flatten the record properties into the same JSON object as the discriminator
                     for prop in element.EnumerateObject() do
                         prop.WriteTo writer
                 else
@@ -127,7 +92,7 @@ type UnionConverter<'T>() =
         if reader.TokenType <> JsonTokenType.StartObject then
             sprintf "Unexpected token when reading Union: %O" reader.TokenType |> JsonException |> raise
         use document = JsonDocument.ParseValue &reader
-        let union = Union.getUnion typeof<'T>
+        let union = Union.getInfo typeof<'T>
         let unionOptions = getOptions union
         let element = document.RootElement
 
@@ -147,4 +112,11 @@ type UnionConverter<'T>() =
                 | Some foundIndex -> foundIndex
 
         let targetCaseFields, targetCaseCtor = union.cases.[targetCaseIndex].GetFields(), union.caseConstructor.[targetCaseIndex]
-        targetCaseCtor (Union.mapTargetCaseArgs element options targetCaseFields) :?> 'T
+        let ctorArgs =
+            [| for fieldInfo in targetCaseFields ->
+                let t = fieldInfo.PropertyType
+                let targetEl =
+                    if targetCaseFields.Length = 1 && (t = typeof<JsonElement> || FSharpType.IsRecord(t, true)) then element
+                    else let _found, el = element.TryGetProperty fieldInfo.Name in el
+                JsonSerializer.Deserialize(targetEl, t, options) |]
+        targetCaseCtor ctorArgs :?> 'T

src/FsCodec.SystemTextJson/UnionOrTypeSafeEnumConverterFactory.fs

@@ -0,0 +1,22 @@
+namespace FsCodec.SystemTextJson
+
+open System
+open System.Linq.Expressions
+open System.Text.Json.Serialization
+
+type internal ConverterActivator = delegate of unit -> JsonConverter
+
+type UnionOrTypeSafeEnumConverterFactory() =
+    inherit JsonConverterFactory()
+
+    override _.CanConvert(t : Type) =
+        Union.isUnion t
+
+    override _.CreateConverter(typ, _options) =
+        let openConverterType = if Union.hasOnlyNullaryCases typ then typedefof<TypeSafeEnumConverter<_>> else typedefof<UnionConverter<_>>
+        let constructor = openConverterType.MakeGenericType(typ).GetConstructors() |> Array.head
+        let newExpression = Expression.New(constructor)
+        let lambda = Expression.Lambda(typeof<ConverterActivator>, newExpression)
+
+        let activator = lambda.Compile() :?> ConverterActivator
+        activator.Invoke()

tests/FsCodec.NewtonsoftJson.Tests/UnionConverterTests.fs

@@ -487,6 +487,7 @@ module ``Struct discriminated unions`` =
         | CaseAV of av : TestRecordPayloadStruct
         | CaseB
         | CaseC of string
+        | CaseC2 of c2: int
         | CaseD of d : string
         | CaseE of e : string * int
         | CaseF of f : string * fb : int
@@ -511,6 +512,9 @@ module ``Struct discriminated unions`` =
         let c = CaseC "hi"
         test <@ """{"case":"CaseC","Item":"hi"}""" = serialize c @>
 
+        let c2 = CaseC2 2
+        test <@ """{"case":"CaseC2","c2":2}""" = serialize c2 @>
+
         let d = CaseD "hi"
         test <@ """{"case":"CaseD","d":"hi"}""" = serialize d @>
 

tests/FsCodec.SystemTextJson.Tests/AutoUnionTests.fs

@@ -0,0 +1,24 @@
+module FsCodec.SystemTextJson.Tests.AutoUnionTests
+
+open FsCodec.SystemTextJson
+open Swensen.Unquote
+
+type ATypeSafeEnum = A | B | C
+type NotAUnion = { body : string }
+type AUnion = D of value : string | E of ATypeSafeEnum | F
+type Any = Tse of enum : ATypeSafeEnum | Not of NotAUnion | Union of AUnion
+
+let serdes = Options.Create(autoUnion = true) |> Serdes
+
+let [<Xunit.Fact>] ``Basic characteristics`` () =
+    test <@ "\"B\"" = serdes.Serialize B @>
+    test <@ "{\"body\":\"A\"}" = serdes.Serialize { body = "A" } @>
+    test <@ "{\"case\":\"D\",\"value\":\"A\"}" = serdes.Serialize (D "A") @>
+    test <@ "{\"case\":\"Tse\",\"enum\":\"B\"}" = serdes.Serialize (Tse B) @>
+    test <@ Tse B = serdes.Deserialize "{\"case\":\"Tse\",\"enum\":\"B\"}" @>
+    test <@ Not { body = "A" } = serdes.Deserialize "{\"case\":\"Not\",\"body\":\"A\"}" @>
+
+let [<FsCheck.Xunit.Property>] ``auto-encodes Unions and non-unions`` (x : Any) =
+    let encoded = serdes.Serialize x
+    let decoded : Any = serdes.Deserialize encoded
+    test <@ decoded = x @>

tests/FsCodec.SystemTextJson.Tests/FsCodec.SystemTextJson.Tests.fsproj

@@ -35,6 +35,7 @@
       <Link>UnionConverterTests.fs</Link>
     </Compile>
     <Compile Include="InteropTests.fs" />
+    <Compile Include="AutoUnionTests.fs" />
   </ItemGroup>
 
 </Project>