From a4fe3f12aad1f990eff57826795fc76950090676 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Thu, 22 Feb 2024 17:09:24 +0000 Subject: [PATCH 1/5] feat(TypeSafeEnum): Add caseValues --- CHANGELOG.md | 5 +++++ src/FsCodec/TypeSafeEnum.fs | 3 +++ src/FsCodec/Union.fs | 5 +++-- 3 files changed, 11 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e027394..11997bc 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,11 @@ The `Unreleased` section name is replaced by the expected version of next releas ## [Unreleased] ### Added + +### Added + +- `TypeeSafeEnum.caseValues<'t>`: Yields all values of a Union + ### Changed ### Removed ### Fixed diff --git a/src/FsCodec/TypeSafeEnum.fs b/src/FsCodec/TypeSafeEnum.fs index 2b329c0..082a8d8 100755 --- a/src/FsCodec/TypeSafeEnum.fs +++ b/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> + +/// Yields all the cases available for 't which must be a TypeSafeEnum +let caseValues<'t>: 't[] = Union.Info.caseValues<'t> diff --git a/src/FsCodec/Union.fs b/src/FsCodec/Union.fs index 71f6600..b4ea797 100644 --- a/src/FsCodec/Union.fs +++ b/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 From 00f95da0bf5cfad1ea6d89942c43032cdb723e47 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Thu, 22 Feb 2024 17:14:58 +0000 Subject: [PATCH 2/5] Tests --- CHANGELOG.md | 2 +- tests/FsCodec.Tests/FsCodec.Tests.fsproj | 1 + tests/FsCodec.Tests/TypeSafeEnumTests.fs | 10 ++++++++++ 3 files changed, 12 insertions(+), 1 deletion(-) create mode 100644 tests/FsCodec.Tests/TypeSafeEnumTests.fs diff --git a/CHANGELOG.md b/CHANGELOG.md index 11997bc..b1c70c7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,7 +12,7 @@ The `Unreleased` section name is replaced by the expected version of next releas ### Added -- `TypeeSafeEnum.caseValues<'t>`: Yields all values of a Union +- `TypeSafeEnum.caseValues<'t>`: Yields all values of a union (that is a `TypeSafeEnum`) [#115](https://github.com/jet/FsCodec/pull/115) ### Changed ### Removed diff --git a/tests/FsCodec.Tests/FsCodec.Tests.fsproj b/tests/FsCodec.Tests/FsCodec.Tests.fsproj index 1c2b239..9c5de84 100644 --- a/tests/FsCodec.Tests/FsCodec.Tests.fsproj +++ b/tests/FsCodec.Tests/FsCodec.Tests.fsproj @@ -8,6 +8,7 @@ + diff --git a/tests/FsCodec.Tests/TypeSafeEnumTests.fs b/tests/FsCodec.Tests/TypeSafeEnumTests.fs new file mode 100644 index 0000000..5bc91fe --- /dev/null +++ b/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 [] caseNames () = + [| Joy; Pain; Misery |] =! TypeSafeEnum.caseValues<_> From 3530a12c5fdf2558fe9c0bd9272003cd3e57b1e3 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Thu, 22 Feb 2024 17:17:41 +0000 Subject: [PATCH 3/5] Fix xmldoc --- src/FsCodec/TypeSafeEnum.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/FsCodec/TypeSafeEnum.fs b/src/FsCodec/TypeSafeEnum.fs index 082a8d8..a7a7ce0 100755 --- a/src/FsCodec/TypeSafeEnum.fs +++ b/src/FsCodec/TypeSafeEnum.fs @@ -31,5 +31,5 @@ let parse<'T> = parseF<'T> (=) let toString<'t> : 't -> string = Union.caseName<'t> -/// Yields all the cases available for 't which must be a TypeSafeEnum +/// Yields all the cases available for 't, which must be a TypeSafeEnum, i.e. have only nullary cases. let caseValues<'t>: 't[] = Union.Info.caseValues<'t> From 06471c55ff16dc5674c698874d0627c91a5b42c4 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Sun, 25 Feb 2024 09:57:20 +0000 Subject: [PATCH 4/5] Fix syntax --- src/FsCodec/TypeSafeEnum.fs | 2 +- src/FsCodec/Union.fs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/FsCodec/TypeSafeEnum.fs b/src/FsCodec/TypeSafeEnum.fs index a7a7ce0..18284ba 100755 --- a/src/FsCodec/TypeSafeEnum.fs +++ b/src/FsCodec/TypeSafeEnum.fs @@ -32,4 +32,4 @@ let parse<'T> = parseF<'T> (=) let toString<'t> : 't -> string = Union.caseName<'t> /// Yields all the cases available for 't, which must be a TypeSafeEnum, i.e. have only nullary cases. -let caseValues<'t>: 't[] = Union.Info.caseValues<'t> +let caseValues<'t> : 't[] = Union.Info.caseValues<'t> diff --git a/src/FsCodec/Union.fs b/src/FsCodec/Union.fs index b4ea797..935829a 100644 --- a/src/FsCodec/Union.fs +++ b/src/FsCodec/Union.fs @@ -26,7 +26,7 @@ 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 caseValues<'t>: 't[] = (get typeof<'t>).cases |> Array.map (fun c -> c.construct Array.empty :?> 't) + 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 From 096d4476f590a84389dd320fab20fa99c73afbf8 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Mon, 26 Feb 2024 10:00:43 +0000 Subject: [PATCH 5/5] feat(SystemTextJson.UnionConverter): Upconvert from TypeSafeEnum rendering --- src/FsCodec.SystemTextJson/UnionConverter.fs | 67 +++++++++++-------- .../UnionConverterTests.fs | 21 ++++++ 2 files changed, 61 insertions(+), 27 deletions(-) diff --git a/src/FsCodec.SystemTextJson/UnionConverter.fs b/src/FsCodec.SystemTextJson/UnionConverter.fs index be1daaa..f865d2b 100755 --- a/src/FsCodec.SystemTextJson/UnionConverter.fs +++ b/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>.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>.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 || 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 || 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) diff --git a/tests/FsCodec.NewtonsoftJson.Tests/UnionConverterTests.fs b/tests/FsCodec.NewtonsoftJson.Tests/UnionConverterTests.fs index 04747f1..81e3609 100644 --- a/tests/FsCodec.NewtonsoftJson.Tests/UnionConverterTests.fs +++ b/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 |] |] +[] +let ``upconverts from strings by generating uninitialized`` c = + let json c = $"\"Case{c}\"" + let deserialize = deserializeDefault + 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 <@ deserialize json @> + [] let ``deserializes properly`` () = let deserialize json = deserializeDefault json