feat(SystemTextJson.UnionConverter): Upconvert from TypeSafeEnum render

CHANGELOG.md

@@ -9,6 +9,11 @@ The `Unreleased` section name is replaced by the expected version of next releas
 ## [Unreleased]
 
 ### Added
+
+### Added
+
+- `TypeSafeEnum.caseValues<'t>`: Yields all values of a union (that is a `TypeSafeEnum`) [#115](https://github.com/jet/FsCodec/pull/115)
+
 ### Changed
 ### Removed
 ### Fixed

src/FsCodec.SystemTextJson/UnionConverter.fs

@@ -23,8 +23,22 @@ module private UnionConverterOptions =
 type UnionConverter<'T>() =
     inherit Serialization.JsonConverter<'T>()
 
+    let jnull = JsonSerializer.SerializeToElement null
     let converterOptions = UnionConverterOptions.get typeof<'T>
     let info = FsCodec.Union.Info.get typeof<'T>
+    let findCase (t: Type) name =
+        let inline findCaseNamed x = FsCodec.Union.Info.tryFindCaseWithName info ((=) x)
+        match findCaseNamed name, converterOptions.CatchAllCase with
+        | None, null ->
+            sprintf "No case defined for '%s', and no catchAllCase nominated for '%s' on type '%s'"
+                name typeof<UnionConverter<'T>>.Name t.FullName |> invalidOp
+        | Some c, _ -> c
+        | None, catchAllCaseName ->
+            match findCaseNamed catchAllCaseName with
+            | None ->
+                sprintf "No case defined for '%s', nominated catchAllCase: '%s' not found in type '%s'"
+                    name catchAllCaseName t.FullName |> invalidOp
+            | Some c -> c
 
     override _.CanConvert t = t = typeof<'T> && FsCodec.Union.isUnion t
 
@@ -48,30 +62,29 @@ type UnionConverter<'T>() =
         writer.WriteEndObject()
 
     override _.Read(reader, t: Type, options) =
-        if reader.TokenType <> JsonTokenType.StartObject then
-            sprintf "Unexpected token when reading Union: %O" reader.TokenType |> JsonException |> raise
-        use document = JsonDocument.ParseValue &reader
-        let element = document.RootElement
-
-        let case =
-            let inputCaseNameValue = element.GetProperty converterOptions.DiscriminatorPropName |> string
-            let findCaseNamed x = FsCodec.Union.Info.tryFindCaseWithName info ((=) x)
-            match findCaseNamed inputCaseNameValue, converterOptions.CatchAllCase  with
-            | None, null ->
-                sprintf "No case defined for '%s', and no catchAllCase nominated for '%s' on type '%s'"
-                    inputCaseNameValue typeof<UnionConverter<'T>>.Name t.FullName |> invalidOp
-            | Some c, _ -> c
-            | None, catchAllCaseName ->
-                match findCaseNamed catchAllCaseName with
-                | None ->
-                    sprintf "No case defined for '%s', nominated catchAllCase: '%s' not found in type '%s'"
-                        inputCaseNameValue catchAllCaseName t.FullName |> invalidOp
-                | Some c -> c
-        let ctorArgs =
-            [| for fieldInfo in case.fields ->
-                let ft = fieldInfo.PropertyType
-                let targetEl =
-                    if case.fields.Length = 1 && (ft = typeof<JsonElement> || FSharpType.IsRecord(ft, true)) then element
-                    else let _found, el = element.TryGetProperty fieldInfo.Name in el
-                JsonSerializer.Deserialize(targetEl, ft, options) |]
-        case.construct ctorArgs :?> 'T
+        let inline isSingle ({ fields = f } : FsCodec.Union.CaseInfo) =
+            let shouldBindDirect pt = pt = typeof<JsonElement> || FSharpType.IsRecord(pt, true)
+            if f.Length = 1 && shouldBindDirect f[0].PropertyType then ValueSome f[0].PropertyType else ValueNone
+        let rejectMissingRecords propertyType name =
+            if FSharpType.IsRecord(propertyType, true) then
+                raise (JsonException <| sprintf "No property found for %s" name)
+        let inline construct (case: FsCodec.Union.CaseInfo) args = case.construct args :?> 'T
+        let inline des name propertyType (el: JsonElement) =
+            if el.ValueKind = JsonValueKind.Null then rejectMissingRecords propertyType name
+            JsonSerializer.Deserialize(el, propertyType, options)
+        if reader.TokenType = JsonTokenType.String then // For upconversion from a TypeSafeEnum
+            let case = reader.GetString() |> findCase t
+            match isSingle case with
+            | ValueSome pt -> [| System.Runtime.Serialization.FormatterServices.GetUninitializedObject pt |]
+            | ValueNone -> [| for f in case.fields -> (*des f.Name f.PropertyType j*)null (*OR: jnull*) |]
+            |> construct case
+        elif reader.TokenType = JsonTokenType.StartObject then
+            use doc = JsonDocument.ParseValue &reader
+            let el = doc.RootElement
+            let case = el.GetProperty converterOptions.DiscriminatorPropName |> string |> findCase t
+            let propOrDefault (name: string) = let _found, propertyElement = el.TryGetProperty name in propertyElement
+            // we deserialize direct from the full element if it's a record or the JsonElement catchall
+            match isSingle case with
+            | ValueSome pt -> [| des "Item" pt el |] |> construct case
+            | ValueNone -> [| for x in case.fields -> propOrDefault x.Name |> des x.Name x.PropertyType |] |> construct case
+        else raise (JsonException <| sprintf "Unexpected token when reading Union: %O" reader.TokenType)

src/FsCodec/TypeSafeEnum.fs

@@ -30,3 +30,6 @@ let parseF<'T> f =
 let parse<'T> = parseF<'T> (=)
 
 let toString<'t> : 't -> string = Union.caseName<'t>
+
+/// <summary>Yields all the cases available for <c>'t</c>, which must be a <c>TypeSafeEnum</c>, i.e. have only nullary cases.</summary>
+let caseValues<'t> : 't[] = Union.Info.caseValues<'t>

src/FsCodec/Union.fs

@@ -26,10 +26,11 @@ module Info =
         let getCase value = cases[getTag value]
         { cases = cases; getCase = getCase })
     let tryFindCaseWithName u (predicate: string -> bool): CaseInfo option = u.cases |> Array.tryFind (fun c -> predicate c.name)
-    let private caseValues: Type -> obj[] = memoize (fun t -> (get t).cases |> Array.map (fun c -> c.construct Array.empty))
+    let caseValues<'t> : 't[] = (get typeof<'t>).cases |> Array.map (fun c -> c.construct Array.empty :?> 't)
+    let caseValuesT: Type -> obj[] = memoize (fun t -> (get t).cases |> Array.map (fun c -> c.construct Array.empty))
     let tryFindCaseValueWithName (t: Type): (string -> bool) -> obj option =
         let u = get t
-        let caseValue = let values = caseValues t in fun i -> values[i]
+        let caseValue = let values = caseValuesT t in fun i -> values[i]
         fun predicate -> u.cases |> Array.tryFindIndex (fun c -> predicate c.name) |> Option.map caseValue
 
 /// Determines whether the type is a Union

tests/FsCodec.NewtonsoftJson.Tests/UnionConverterTests.fs

@@ -135,6 +135,27 @@ let ``produces expected output`` () =
     let u = CaseU [| SkuId.Parse "f09f17cb4c9744b4a979afb53be0847f"; SkuId.Parse "c747d53a644d42548b3bbc0988561ce1" |]
     test <@ """{"case":"CaseU","Item":["f09f17cb4c9744b4a979afb53be0847f","c747d53a644d42548b3bbc0988561ce1"]}""" = serialize u @>
 
+let values : obj[][] = [| for c in 'A'..'Z' -> [| c |] |]
+[<Theory; MemberData(nameof values)>]
+let ``upconverts from strings by generating uninitialized`` c =
+    let json c = $"\"Case{c}\""
+    let deserialize = deserializeDefault<TestDU>
+    let json = json c
+    match c with
+    | 'A' -> CaseA { test = null } =! deserialize json
+    | 'B' -> CaseB =! deserialize json
+    | 'C' -> CaseC null =! deserialize json
+    | 'D' -> CaseD null =! deserialize json
+    | 'G' -> CaseG { Item = null } =! deserialize json
+    | 'H' -> CaseH { test = null } =! deserialize json
+    | 'J' -> CaseJ (Nullable()) =! deserialize json
+    | 'L' -> CaseL (Nullable(), Nullable()) =! deserialize json
+    | 'M' -> CaseM None =! deserialize json
+    | 'O' -> CaseO (None, None) =! deserialize json
+    | 'U' -> CaseU null =! deserialize json
+    | 'V' -> CaseV null =! deserialize json
+    | _ -> raises<JsonException> <@ deserialize json @>
+
 [<Fact>]
 let ``deserializes properly`` () =
     let deserialize json = deserializeDefault<TestDU> json

tests/FsCodec.Tests/FsCodec.Tests.fsproj

@@ -8,6 +8,7 @@
   <ItemGroup>
     <Compile Include="StreamNameTests.fs" />
     <Compile Include="CompressionTests.fs" />
+    <Compile Include="TypeSafeEnumTests.fs" />
   </ItemGroup>
 
   <ItemGroup>

tests/FsCodec.Tests/TypeSafeEnumTests.fs

@@ -0,0 +1,10 @@
+module FsCodec.Tests.TypeSafeEnumTests
+
+open FsCodec
+open Swensen.Unquote
+open Xunit
+
+type Outcome = Joy | Pain | Misery
+
+let [<Fact>] caseNames () =
+    [| Joy; Pain; Misery |] =! TypeSafeEnum.caseValues<_>