From 9d1bec352fde130fcc87f7a38cf74375dc4ba689 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Fri, 25 Aug 2023 14:17:22 +0100 Subject: [PATCH 1/2] feat: STJ.TypeSafeEnum case insensitivity --- CHANGELOG.md | 2 + .../TypeSafeEnumConverter.fs | 49 ++++++++++++------- src/FsCodec.SystemTextJson/UnionConverter.fs | 4 +- .../UnionOrTypeSafeEnumConverterFactory.fs | 10 ++-- .../AutoUnionTests.fs | 29 ++++++++++- .../TypeSafeEnumConverterTests.fs | 4 +- 6 files changed, 71 insertions(+), 27 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 3de55a48..0efe8755 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,11 +14,13 @@ The `Unreleased` section name is replaced by the expected version of next releas - `StreamName.Split`: Splits a StreamName into its `{category}` and `{streamId}` portions, using `StreamId` for the latter. Replaces `CategoryAndId` [#100](https://github.com/jet/FsCodec/pull/100) - `StreamName.tryFind`: Helper to implement `Stream.tryDecode` / `Reactions.For` pattern (to implement validation of StreamId format when parsing `StreamName`s). (See README) [#100](https://github.com/jet/FsCodec/pull/100) - `StreamName.Category`: covers aspects of `StreamName` pertaining to the `{category}` portion (mainly moved from `StreamName`.* equivalents; see Changed) [#100](https://github.com/jet/FsCodec/pull/100) +- `TypeSafeEnum.tryParseF/parseF`: parameterizes matching of the Union Case name (to enable e.g. case insensitive matching) ### Changed - `StreamName`: breaking changes to reflect introduction of strongly typed `StreamId` [#100](https://github.com/jet/FsCodec/pull/100) - `StreamName`: renames: `trySplitCategoryAndStreamId` -> `Internal.tryParse`; `splitCategoryAndStreamId` -> `split`; `CategoryAndId` -> `Split`; `Categorized|NotCategorized`-> `Internal`.*; `category`->`Category.ofStreamName`, `IdElements` -> `StreamId.Parse` [#100](https://github.com/jet/FsCodec/pull/100) +- `SystemTextJson.UnionOrTypeSafeEnumConverterFactory`: Allow specific converters to override global policy ### Removed diff --git a/src/FsCodec.SystemTextJson/TypeSafeEnumConverter.fs b/src/FsCodec.SystemTextJson/TypeSafeEnumConverter.fs index bba30a42..2c99a31f 100755 --- a/src/FsCodec.SystemTextJson/TypeSafeEnumConverter.fs +++ b/src/FsCodec.SystemTextJson/TypeSafeEnumConverter.fs @@ -2,34 +2,47 @@ open System open System.Collections.Generic +open System.ComponentModel open System.Text.Json /// Utilities for working with DUs where none of the cases have a value module TypeSafeEnum = - let isTypeSafeEnum (t : Type) = + let isTypeSafeEnum (t: Type) = Union.isUnion t && Union.hasOnlyNullaryCases t - let tryParseT (t : Type) (str : string) = + [] + let tryParseTF (t: Type) = let u = Union.getInfo t - u.cases - |> Array.tryFindIndex (fun c -> c.Name = str) - |> Option.map (fun tag -> u.caseConstructor[tag] [||]) - let tryParse<'T> (str : string) = tryParseT typeof<'T> str |> Option.map (fun e -> e :?> 'T) - - let parseT (t : Type) (str : string) = - match tryParseT t str with - | Some e -> e - | None -> - // Keep exception compat, but augment with a meaningful message. - raise (KeyNotFoundException(sprintf "Could not find case '%s' for type '%s'" str t.FullName)) - let parse<'T> (str : string) = parseT typeof<'T> str :?> 'T - - let toString<'t> (x : 't) = + fun predicate -> + u.cases + |> Array.tryFindIndex (fun c -> predicate c.Name) + |> Option.map (fun tag -> u.caseConstructor[tag] [||]) + let tryParseF<'T> = let p = tryParseTF typeof<'T> in fun f str -> p (f str) |> Option.map (fun e -> e :?> 'T) + let tryParse<'T> = tryParseF<'T> (=) + + [] + let parseTF (t: Type) predicate = + let p = tryParseTF t + fun (str: string) -> + match p (predicate str) with + | Some e -> e + | None -> + // Keep exception compat, but augment with a meaningful message. + raise (KeyNotFoundException(sprintf "Could not find case '%s' for type '%s'" str t.FullName)) + [] + let parseT (t: Type) = parseTF t (=) + let parseF<'T> f = + let p = parseTF typeof<'T> f + fun (str: string) -> p str :?> 'T + let parse<'T> = parseF<'T> (=) + + let toString<'t> = let u = Union.getInfo typeof<'t> - let tag = u.tagReader x - u.cases[tag].Name + fun (x: 't) -> + let tag = u.tagReader x + u.cases[tag].Name /// Maps strings to/from Union cases; refuses to convert for values not in the Union type TypeSafeEnumConverter<'T>() = diff --git a/src/FsCodec.SystemTextJson/UnionConverter.fs b/src/FsCodec.SystemTextJson/UnionConverter.fs index f62e24f8..6588e47d 100755 --- a/src/FsCodec.SystemTextJson/UnionConverter.fs +++ b/src/FsCodec.SystemTextJson/UnionConverter.fs @@ -38,6 +38,8 @@ type private Union = module private Union = let isUnion : Type -> bool = memoize (fun t -> FSharpType.IsUnion(t, true)) + // TOCONSIDER: could memoize this within the Info + let unionHasJsonConverterAttribute = memoize (fun (t : Type) -> t.IsDefined(typeof, true)) let private createInfo t = let cases = FSharpType.GetUnionCases(t, true) @@ -47,7 +49,7 @@ module private Union = caseConstructor = cases |> Array.map (fun c -> FSharpValue.PreComputeUnionConstructor(c, true)) options = t.GetCustomAttributes(typeof, false) - |> Array.tryHead // AttributeUsage(AllowMultiple = false) + |> Array.tryHead // could be tryExactlyOne as AttributeUsage(AllowMultiple = false) |> Option.map (fun a -> a :?> IUnionConverterOptions) } let getInfo : Type -> Union = memoize createInfo diff --git a/src/FsCodec.SystemTextJson/UnionOrTypeSafeEnumConverterFactory.fs b/src/FsCodec.SystemTextJson/UnionOrTypeSafeEnumConverterFactory.fs index 7a8cb206..1f9de13c 100644 --- a/src/FsCodec.SystemTextJson/UnionOrTypeSafeEnumConverterFactory.fs +++ b/src/FsCodec.SystemTextJson/UnionOrTypeSafeEnumConverterFactory.fs @@ -9,14 +9,14 @@ type internal ConverterActivator = delegate of unit -> JsonConverter type UnionOrTypeSafeEnumConverterFactory(typeSafeEnum, union) = inherit JsonConverterFactory() - let isIntrinsic (t : Type) = + let isIntrinsic (t: Type) = t.IsGenericType - && (t.GetGenericTypeDefinition() = typedefof> - || t.GetGenericTypeDefinition() = typedefof>) + && (let gtd = t.GetGenericTypeDefinition() in gtd = typedefof> || gtd = typedefof>) override _.CanConvert(t : Type) = - Union.isUnion t - && not (isIntrinsic t) + not (isIntrinsic t) + && Union.isUnion t + && not (Union.unionHasJsonConverterAttribute t) && ((typeSafeEnum && union) || typeSafeEnum = Union.hasOnlyNullaryCases t) diff --git a/tests/FsCodec.SystemTextJson.Tests/AutoUnionTests.fs b/tests/FsCodec.SystemTextJson.Tests/AutoUnionTests.fs index f5109f7e..17e97662 100644 --- a/tests/FsCodec.SystemTextJson.Tests/AutoUnionTests.fs +++ b/tests/FsCodec.SystemTextJson.Tests/AutoUnionTests.fs @@ -35,11 +35,38 @@ let [] ``Opting out`` () = raises <@ serdesT.Serialize(Union F) @> test <@ Union F = Union F |> serdesT.Serialize |> serdesT.Deserialize @> +module TypeSafeEnumConversion = + + type SimpleTruth = True | False + + let [] ``is case sensitive`` () = + let serdesT = Options.Create(autoTypeSafeEnumToJsonString = true) |> Serdes + True =! serdesT.Deserialize "\"True\"" + raises <@ serdesT.Deserialize "\"true\"" @> + + module ``Overriding With Case Insensitive`` = + + [)>] + type Truth = + | True | False | FileNotFound + static member Parse: string -> Truth = TypeSafeEnum.parseF(fun s inp -> s.Equals(inp, System.StringComparison.OrdinalIgnoreCase)) + and LogicalConverter() = + inherit JsonIsomorphism() + override _.Pickle x = match x with FileNotFound -> "lost" | x -> TypeSafeEnum.toString x + override _.UnPickle input = Truth.Parse input + + let [] ``specific converter wins`` () = + let serdesT = Options.Create(autoTypeSafeEnumToJsonString = true) |> Serdes + let serdesDef = Serdes.Default + for serdes in [| serdesT; serdesDef |] do + test <@ FileNotFound = serdes.Deserialize "\"fileNotFound\"" @> + test <@ "\"lost\"" = serdes.Serialize FileNotFound @> + let [] ``auto-encodes Unions and non-unions`` (x : Any) = let encoded = serdes.Serialize x let decoded : Any = serdes.Deserialize encoded - // Special cases for (non-roundtrippable) Some null => None conversion that STJ (and NSJ OptionConverter) do + // Special cases for (non roundtrip capable) Some null => None conversion that STJ (and NSJ OptionConverter) do // See next test for a debatable trick match decoded, x with | Union (G None), Union (G (Some null)) -> () diff --git a/tests/FsCodec.SystemTextJson.Tests/TypeSafeEnumConverterTests.fs b/tests/FsCodec.SystemTextJson.Tests/TypeSafeEnumConverterTests.fs index 025eb9fe..a421c848 100644 --- a/tests/FsCodec.SystemTextJson.Tests/TypeSafeEnumConverterTests.fs +++ b/tests/FsCodec.SystemTextJson.Tests/TypeSafeEnumConverterTests.fs @@ -10,9 +10,9 @@ open Xunit type Outcome = Joy | Pain | Misery let [] happy () = - test <@ box Joy = TypeSafeEnum.parseT (typeof) "Joy" @> + test <@ box Joy = TypeSafeEnum.parseT typeof "Joy" @> test <@ Joy = TypeSafeEnum.parse "Joy" @> - test <@ box Joy = TypeSafeEnum.parseT (typeof) "Joy" @> + test <@ box Joy = TypeSafeEnum.parseT typeof "Joy" @> test <@ None = TypeSafeEnum.tryParse "Wat" @> raises <@ TypeSafeEnum.parse "Wat" @> From 3742bc5745c706859efa77cff9e1dd5f97d39882 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Fri, 25 Aug 2023 14:28:33 +0100 Subject: [PATCH 2/2] CL --- CHANGELOG.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0efe8755..56a4b574 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,13 +14,13 @@ The `Unreleased` section name is replaced by the expected version of next releas - `StreamName.Split`: Splits a StreamName into its `{category}` and `{streamId}` portions, using `StreamId` for the latter. Replaces `CategoryAndId` [#100](https://github.com/jet/FsCodec/pull/100) - `StreamName.tryFind`: Helper to implement `Stream.tryDecode` / `Reactions.For` pattern (to implement validation of StreamId format when parsing `StreamName`s). (See README) [#100](https://github.com/jet/FsCodec/pull/100) - `StreamName.Category`: covers aspects of `StreamName` pertaining to the `{category}` portion (mainly moved from `StreamName`.* equivalents; see Changed) [#100](https://github.com/jet/FsCodec/pull/100) -- `TypeSafeEnum.tryParseF/parseF`: parameterizes matching of the Union Case name (to enable e.g. case insensitive matching) +- `TypeSafeEnum.tryParseF/parseF`: parameterizes matching of the Union Case name (to enable e.g. case insensitive matching) [#101](https://github.com/jet/FsCodec/pull/101) ### Changed - `StreamName`: breaking changes to reflect introduction of strongly typed `StreamId` [#100](https://github.com/jet/FsCodec/pull/100) - `StreamName`: renames: `trySplitCategoryAndStreamId` -> `Internal.tryParse`; `splitCategoryAndStreamId` -> `split`; `CategoryAndId` -> `Split`; `Categorized|NotCategorized`-> `Internal`.*; `category`->`Category.ofStreamName`, `IdElements` -> `StreamId.Parse` [#100](https://github.com/jet/FsCodec/pull/100) -- `SystemTextJson.UnionOrTypeSafeEnumConverterFactory`: Allow specific converters to override global policy +- `SystemTextJson.UnionOrTypeSafeEnumConverterFactory`: Allow specific converters to override global policy [#101](https://github.com/jet/FsCodec/pull/101) ### Removed