diff --git a/CHANGELOG.md b/CHANGELOG.md index e1e0e9f..e34fa84 100644 --- a/CHANGELOG.md +++ b/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) diff --git a/README.md b/README.md index 985d5e9..24c2dc3 100644 --- a/README.md +++ b/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 ## 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...) diff --git a/src/FsCodec.SystemTextJson/FsCodec.SystemTextJson.fsproj b/src/FsCodec.SystemTextJson/FsCodec.SystemTextJson.fsproj index 8582f9f..f8682c4 100644 --- a/src/FsCodec.SystemTextJson/FsCodec.SystemTextJson.fsproj +++ b/src/FsCodec.SystemTextJson/FsCodec.SystemTextJson.fsproj @@ -11,6 +11,7 @@ + diff --git a/src/FsCodec.SystemTextJson/Options.fs b/src/FsCodec.SystemTextJson/Options.fs index 35c43c8..8533e24 100755 --- a/src/FsCodec.SystemTextJson/Options.fs +++ b/src/FsCodec.SystemTextJson/Options.fs @@ -54,7 +54,11 @@ type Options private () = [] ?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, diff --git a/src/FsCodec.SystemTextJson/TypeSafeEnumConverter.fs b/src/FsCodec.SystemTextJson/TypeSafeEnumConverter.fs index 477f4b5..bae51df 100755 --- a/src/FsCodec.SystemTextJson/TypeSafeEnumConverter.fs +++ b/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 diff --git a/src/FsCodec.SystemTextJson/UnionConverter.fs b/src/FsCodec.SystemTextJson/UnionConverter.fs index 82895d0..4aac49b 100755 --- a/src/FsCodec.SystemTextJson/UnionConverter.fs +++ b/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: [>); JsonUnionConverterOptions("type")>] +/// 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. +/// [JsonConverter typeof < UnionConverter < T > >); JsonUnionConverterOptions("type") >] [] 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 [] 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, 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 - || (t.IsValueType && t <> typeof) - || t.IsArray - || (t.IsGenericType - && (typedefof> = t.GetGenericTypeDefinition() - || t.GetGenericTypeDefinition().IsValueType)) // Nullable - - let typeHasJsonConverterAttribute_ (t : Type) = t.IsDefined(typeof(*, 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 || FSharpType.IsRecord(t, true)) then element + else let _found, el = element.TryGetProperty fieldInfo.Name in el + JsonSerializer.Deserialize(targetEl, t, options) |] + targetCaseCtor ctorArgs :?> 'T diff --git a/src/FsCodec.SystemTextJson/UnionOrTypeSafeEnumConverterFactory.fs b/src/FsCodec.SystemTextJson/UnionOrTypeSafeEnumConverterFactory.fs new file mode 100644 index 0000000..8c31c34 --- /dev/null +++ b/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> else typedefof> + let constructor = openConverterType.MakeGenericType(typ).GetConstructors() |> Array.head + let newExpression = Expression.New(constructor) + let lambda = Expression.Lambda(typeof, newExpression) + + let activator = lambda.Compile() :?> ConverterActivator + activator.Invoke() diff --git a/tests/FsCodec.NewtonsoftJson.Tests/UnionConverterTests.fs b/tests/FsCodec.NewtonsoftJson.Tests/UnionConverterTests.fs index c82b334..0f67961 100644 --- a/tests/FsCodec.NewtonsoftJson.Tests/UnionConverterTests.fs +++ b/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 @> diff --git a/tests/FsCodec.SystemTextJson.Tests/AutoUnionTests.fs b/tests/FsCodec.SystemTextJson.Tests/AutoUnionTests.fs new file mode 100644 index 0000000..84b2e31 --- /dev/null +++ b/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 [] ``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 [] ``auto-encodes Unions and non-unions`` (x : Any) = + let encoded = serdes.Serialize x + let decoded : Any = serdes.Deserialize encoded + test <@ decoded = x @> diff --git a/tests/FsCodec.SystemTextJson.Tests/FsCodec.SystemTextJson.Tests.fsproj b/tests/FsCodec.SystemTextJson.Tests/FsCodec.SystemTextJson.Tests.fsproj index b6ec900..4c7bdac 100644 --- a/tests/FsCodec.SystemTextJson.Tests/FsCodec.SystemTextJson.Tests.fsproj +++ b/tests/FsCodec.SystemTextJson.Tests/FsCodec.SystemTextJson.Tests.fsproj @@ -35,6 +35,7 @@ UnionConverterTests.fs +