feat: SystemTextJson.TypeSafeEnum case insensitivity (#101)

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) [#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 [#101](https://github.com/jet/FsCodec/pull/101)
 
 ### Removed
 

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) =
+    [<EditorBrowsable(EditorBrowsableState.Never)>]
+    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> (=)
+
+    [<EditorBrowsable(EditorBrowsableState.Never)>]
+    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))
+    [<EditorBrowsable(EditorBrowsableState.Never)>]
+    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>() =

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<System.Text.Json.Serialization.JsonConverterAttribute>, 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<JsonUnionConverterOptionsAttribute>, 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
 

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<option<_>>
-            || t.GetGenericTypeDefinition() = typedefof<list<_>>)
+        && (let gtd = t.GetGenericTypeDefinition() in gtd = typedefof<option<_>> || gtd = typedefof<list<_>>)
 
     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)
 

tests/FsCodec.SystemTextJson.Tests/AutoUnionTests.fs

@@ -35,11 +35,38 @@ let [<Xunit.Fact>] ``Opting out`` () =
     raises<System.NotSupportedException> <@ serdesT.Serialize(Union F) @>
     test <@ Union F = Union F |> serdesT.Serialize |> serdesT.Deserialize @>
 
+module TypeSafeEnumConversion =
+
+    type SimpleTruth = True | False
+
+    let [<Xunit.Fact>] ``is case sensitive`` () =
+        let serdesT = Options.Create(autoTypeSafeEnumToJsonString = true) |> Serdes
+        True =! serdesT.Deserialize<SimpleTruth> "\"True\""
+        raises<System.Collections.Generic.KeyNotFoundException> <@ serdesT.Deserialize<SimpleTruth> "\"true\"" @>
+
+    module ``Overriding With Case Insensitive`` =
+
+        [<System.Text.Json.Serialization.JsonConverter(typeof<LogicalConverter>)>]
+        type Truth =
+            | True | False | FileNotFound
+            static member Parse: string -> Truth = TypeSafeEnum.parseF<Truth>(fun s inp -> s.Equals(inp, System.StringComparison.OrdinalIgnoreCase))
+        and LogicalConverter() =
+            inherit JsonIsomorphism<Truth, string>()
+            override _.Pickle x = match x with FileNotFound -> "lost" | x -> TypeSafeEnum.toString x
+            override _.UnPickle input = Truth.Parse input
+
+        let [<Xunit.Fact>] ``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 [<FsCheck.Xunit.Property>] ``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)) -> ()

tests/FsCodec.SystemTextJson.Tests/TypeSafeEnumConverterTests.fs

@@ -10,9 +10,9 @@ open Xunit
 type Outcome = Joy | Pain | Misery
 
 let [<Fact>] happy () =
-    test <@ box Joy = TypeSafeEnum.parseT (typeof<Outcome>) "Joy" @>
+    test <@ box Joy = TypeSafeEnum.parseT typeof<Outcome> "Joy" @>
     test <@ Joy = TypeSafeEnum.parse "Joy" @>
-    test <@ box Joy = TypeSafeEnum.parseT (typeof<Outcome>) "Joy"  @>
+    test <@ box Joy = TypeSafeEnum.parseT typeof<Outcome> "Joy"  @>
     test <@ None = TypeSafeEnum.tryParse<Outcome> "Wat" @>
     raises<KeyNotFoundException> <@ TypeSafeEnum.parse<Outcome> "Wat" @>