diff --git a/src/FsCodec.NewtonsoftJson/UnionConverter.fs b/src/FsCodec.NewtonsoftJson/UnionConverter.fs index c5c63820..0472a484 100755 --- a/src/FsCodec.NewtonsoftJson/UnionConverter.fs +++ b/src/FsCodec.NewtonsoftJson/UnionConverter.fs @@ -20,7 +20,7 @@ module private Union = let isUnion = memoize (fun t -> FSharpType.IsUnion(t, true)) let getUnionCases = memoize (fun t -> FSharpType.GetUnionCases(t, true)) - let createUnion t = + let private createUnion t = let cases = getUnionCases t { cases = cases diff --git a/src/FsCodec.SystemTextJson/FsCodec.SystemTextJson.fsproj b/src/FsCodec.SystemTextJson/FsCodec.SystemTextJson.fsproj index fd22c065..8056225b 100644 --- a/src/FsCodec.SystemTextJson/FsCodec.SystemTextJson.fsproj +++ b/src/FsCodec.SystemTextJson/FsCodec.SystemTextJson.fsproj @@ -26,7 +26,8 @@ - + + diff --git a/src/FsCodec.SystemTextJson/UnionConverter.fs b/src/FsCodec.SystemTextJson/UnionConverter.fs index 9a6c0b3a..fec3df35 100755 --- a/src/FsCodec.SystemTextJson/UnionConverter.fs +++ b/src/FsCodec.SystemTextJson/UnionConverter.fs @@ -65,13 +65,14 @@ module private Union = /// Parallels F# behavior wrt how it generates a DU's underlying .NET Type let inline isInlinedIntoUnionItem (t : Type) = t = typeof - //|| t.IsValueType + || (t.IsValueType && t <> typeof) || t.IsArray || (t.IsGenericType && (typedefof> = t.GetGenericTypeDefinition() || t.GetGenericTypeDefinition().IsValueType)) // Nullable - let typeHasJsonConverterAttribute = memoize (fun (t : Type) -> t.IsDefined(typeof, false)) + let typeHasJsonConverterAttribute = memoize (fun (t : Type) -> t.IsDefined(typeof(*, false*))) + let typeIsUnionWithConverterAttribute = memoize (fun (t : Type) -> isUnion t && typeHasJsonConverterAttribute t) let propTypeRequiresConstruction (propertyType : Type) = not (isInlinedIntoUnionItem propertyType) @@ -115,7 +116,7 @@ type UnionConverter<'T>() = writer.WriteStringValue(case.Name) match fieldInfos with - | [| fi |] -> + | [| fi |] when not (Union.typeIsUnionWithConverterAttribute fi.PropertyType) -> match fieldValues.[0] with | null when options.IgnoreNullValues -> () | fv -> diff --git a/tests/FsCodec.NewtonsoftJson.Tests/UnionConverterTests.fs b/tests/FsCodec.NewtonsoftJson.Tests/UnionConverterTests.fs index 4f22aace..a188a817 100644 --- a/tests/FsCodec.NewtonsoftJson.Tests/UnionConverterTests.fs +++ b/tests/FsCodec.NewtonsoftJson.Tests/UnionConverterTests.fs @@ -328,6 +328,7 @@ module ``Unmatched case handling`` = fun (e : System.InvalidOperationException) -> <@ -1 <> e.Message.IndexOf "No case defined for 'CaseUnknown', and no catchAllCase nominated" @> |> raisesWith <@ act() @> + [] [, "case", "Catchall")>] type DuWithCatchAll = | Known @@ -338,7 +339,7 @@ module ``Unmatched case handling`` = let aJson = """{"case":"CaseUnknown"}""" let a = JsonConvert.DeserializeObject(aJson, settings) - test <@ Catchall = a @> + test <@ DuWithCatchAll.Catchall = a @> [, "case", "CatchAllThatCantBeFound")>] type DuWithMissingCatchAll = diff --git a/tests/FsCodec.SystemTextJson.Tests/SerdesTests.fs b/tests/FsCodec.SystemTextJson.Tests/SerdesTests.fs index 935c9320..c2f7238d 100644 --- a/tests/FsCodec.SystemTextJson.Tests/SerdesTests.fs +++ b/tests/FsCodec.SystemTextJson.Tests/SerdesTests.fs @@ -39,7 +39,7 @@ module StjCharacterization = let correctSer = """["A,"B"]""" raisesWith <@ Serdes.Deserialize(correctSer, ootbOptions) @> - <| fun e -> <@ e.Message.Contains "Deserialization of reference types without a parameterless constructor, a singular parameterized constructor, or a parameterized constructor annotated with 'JsonConstructorAttribute' is not supported. Type 'Microsoft.FSharp.Collections.FSharpList`1[System.String]" @> + <| fun e -> <@ e.Message.Contains "s abstract, an interface, or is read only, and could not be instantiated and populated" @> // System.Text.Json's JsonSerializerOptions by default escapes HTML-sensitive characters when generating JSON strings // while this arguably makes sense as a default diff --git a/tests/FsCodec.SystemTextJson.Tests/UnionConverterTests.fs b/tests/FsCodec.SystemTextJson.Tests/UnionConverterTests.fs index 5ef52b72..f5109de1 100644 --- a/tests/FsCodec.SystemTextJson.Tests/UnionConverterTests.fs +++ b/tests/FsCodec.SystemTextJson.Tests/UnionConverterTests.fs @@ -251,22 +251,17 @@ module ``Unmatched case handling`` = |> raisesWith <@ act() @> [>); JsonUnionConverterOptions("case", CatchAllCase = "Catchall")>] - type DuWithCatchAllWithAttributes = + JsonConverter(typeof>); JsonUnionConverterOptions("case", CatchAllCase = "Catchall")>] + type DuWithCatchAll = | Known | Catchall [] let ``UnionConverter supports a nominated catchall via attributes`` () = let aJson = """{"case":"CaseUnknown"}""" - let a = JsonSerializer.Deserialize(aJson) + let a = JsonSerializer.Deserialize(aJson) - test <@ DuWithCatchAllWithAttributes.Catchall = a @> - - [] - type DuWithCatchAllWithoutAttributes = - | Known - | Catchall + test <@ DuWithCatchAll.Catchall = a @> [>); JsonUnionConverterOptions("case", CatchAllCase = "CatchAllThatCantBeFound")>] @@ -376,3 +371,122 @@ module ``Struct discriminated unions`` = let i = CaseIV ( {test = "hi" }, "bye") test <@ """{"case":"CaseIV","iv":{"test":"hi"},"ibv":"bye"}""" = serialize i @> + +module Nested = + + [>)>] + type U = + | B of NU + | C of UUA + | D of UU + | E of E + | EA of E[] + | R of {| a : int; b : NU |} + | S + and [>)>] + NU = + | A of string + | B of int + | R of {| a : int; b : NU |} + | S + and [>)>] + UU = + | A of string + | B of int + | E of E + | EO of E option + | R of {| a: int; b: string |} + | S + and [>); JsonUnionConverterOptions("case2")>] + UUA = + | A of string + | B of int + | E of E + | EO of E option + | R of {| a: int; b: string |} + | S + and [>)>] + E = + | V1 + | V2 + + let ro = Options.Create() + do ro.IgnoreReadOnlyFields <- true + do ro.IgnoreReadOnlyProperties <- true + + let [] ``can nest`` (value : U) = + let ser = Serdes.Serialize(value, ro) + test <@ value = Serdes.Deserialize(ser, ro) @> + + let [] ``nesting Unions represents child as item`` () = + let v : U = U.C (UUA.B 42) + let ser = Serdes.Serialize(v, ro) + """{"case":"C","Item":{"case2":"B","Item":42}}""" =! ser + test <@ v = Serdes.Deserialize(ser, ro) @> + + let [] ``TypeSafeEnum converts direct`` () = + let v : U = U.C (UUA.E E.V1) + let ser = Serdes.Serialize(v, ro) + """{"case":"C","Item":{"case2":"E","Item":"V1"}}""" =! ser + test <@ v = Serdes.Deserialize(ser, ro) @> + + let v : U = U.E E.V2 + let ser = Serdes.Serialize v + """{"case":"E","Item":"V2"}""" =! ser + test <@ v = Serdes.Deserialize ser @> + + let v : U = U.EA [|E.V2; E.V2|] + let ser = Serdes.Serialize v + """{"case":"EA","Item":["V2","V2"]}""" =! ser + test <@ v = Serdes.Deserialize ser @> + + let v : U = U.C (UUA.EO (Some E.V1)) + let ser = Serdes.Serialize v + """{"case":"C","Item":{"case2":"EO","Item":"V1"}}""" =! ser + test <@ v = Serdes.Deserialize ser @> + + let v : U = U.C (UUA.EO None) + let ser = Serdes.Serialize v + """{"case":"C","Item":{"case2":"EO","Item":null}}""" =! ser + test <@ v = Serdes.Deserialize ser @> + + let v : U = U.C UUA.S + let ser = Serdes.Serialize v + """{"case":"C","Item":{"case2":"S"}}""" =! ser + test <@ v = Serdes.Deserialize ser @> + +/// And for everything else, JsonIsomorphism allows plenty ways of customizing the encoding and/or decoding +module IsomorphismUnionEncoder = + + type [)>] + Top = + | S + | N of Nested + and Nested = + | A + | B of int + and TopConverter() = + inherit JsonIsomorphism>() + override __.Pickle value = + match value with + | S -> { disc = TS; v = None } + | N A -> { disc = TA; v = None } + | N (B v) -> { disc = TB; v = Some v } + override __.UnPickle flat = + match flat with + | { disc = TS } -> S + | { disc = TA } -> N A + | { disc = TB; v = v} -> N (B (Option.get v)) + and Flat<'T> = { disc : JiType; v : 'T option } + and [>)>] + JiType = TS | TA | TB + + let [] ``Can control the encoding to the nth degree`` () = + let v : Top = N (B 42) + let ser = Serdes.Serialize v + """{"disc":"TB","v":42}""" =! ser + test <@ v = Serdes.Deserialize ser @> + + let [] ``can roundtrip`` (value : Top) = + let ser = Serdes.Serialize value + test <@ value = Serdes.Deserialize ser @>