Port TypeSafeEnum and Converter to System.Text.Json

src/FsCodec.SystemTextJson/FsCodec.SystemTextJson.fsproj

@@ -14,6 +14,8 @@
     <Compile Include="JsonOptionConverter.fs" />
     <Compile Include="JsonRecordConverter.fs" />
     <Compile Include="Pickler.fs" />
+    <Compile Include="UnionConverter.fs" />
+    <Compile Include="TypeSafeEnumConverter.fs" />
     <Compile Include="Options.fs" />
     <Compile Include="Codec.fs" />
     <Compile Include="Serdes.fs" />

src/FsCodec.SystemTextJson/JsonOptionConverter.fs

@@ -26,7 +26,7 @@ type JsonOptionConverter () =
     override __.CanConvert(t : Type) =
         t.IsGenericType && t.GetGenericTypeDefinition() = typedefof<option<_>>
 
-    override __.CreateConverter (typ, options) =
+    override __.CreateConverter (typ, _options) =
         let valueType = typ.GetGenericArguments() |> Array.head
         let constructor = typedefof<JsonOptionConverter<_>>.MakeGenericType(valueType).GetConstructors() |> Array.head
         let newExpression = Expression.New(constructor)

src/FsCodec.SystemTextJson/TypeSafeEnumConverter.fs

@@ -0,0 +1,54 @@
+namespace FsCodec.SystemTextJson
+
+open System
+open System.Collections.Generic
+open System.Text.Json
+
+/// Utilities for working with DUs where none of the cases have a value
+module TypeSafeEnum =
+
+    let private _isTypeSafeEnum (t : Type) =
+        Union.tryGetUnion t
+        |> Option.exists (fun u -> u.cases |> Seq.forall (fun case -> case.GetFields().Length = 0))
+    let isTypeSafeEnum = memoize _isTypeSafeEnum
+
+    let tryParseT (t : Type) (str : string) =
+        match Union.tryGetUnion t with
+        | None -> invalidArg "t" "Type must be a FSharpUnion."
+        | Some u ->
+            u.cases
+            |> Array.tryFindIndex (fun case -> case.Name = str)
+            |> Option.map (fun tag -> u.caseConstructor.[tag] [||])
+            // TOCONSIDER memoize and/or push into `Union` https://github.com/jet/FsCodec/pull/41#discussion_r394473137
+    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 (x : obj) =
+        let union = x.GetType() |> Union.tryGetUnion |> Option.get
+        let tag = union.tagReader x
+        // TOCONSIDER memoize and/or push into `Union` https://github.com/jet/FsCodec/pull/41#discussion_r394473137
+        union.cases.[tag].Name
+
+/// Maps strings to/from Union cases; refuses to convert for values not in the Union
+type TypeSafeEnumConverter<'T>() =
+    inherit Serialization.JsonConverter<'T>()
+
+    override __.CanConvert(t : Type) =
+        TypeSafeEnum.isTypeSafeEnum t
+
+    override __.Write(writer, value, _options) =
+        let str = TypeSafeEnum.toString value
+        writer.WriteStringValue str
+
+    override __.Read(reader, _t, _options) =
+        if reader.TokenType <> JsonTokenType.String then
+            sprintf "Unexpected token when reading TypeSafeEnum: %O" reader.TokenType |> JsonException |> raise
+        let str = reader.GetString()
+        TypeSafeEnum.parse<'T> str

src/FsCodec.SystemTextJson/UnionConverter.fs

@@ -0,0 +1,27 @@
+namespace FsCodec.SystemTextJson
+
+open FSharp.Reflection
+open System
+
+[<NoComparison; NoEquality>]
+type private Union =
+    {
+        cases: UnionCaseInfo[]
+        tagReader: obj -> int
+        fieldReader: (obj -> obj[])[]
+        caseConstructor: (obj[] -> obj)[]
+    }
+
+module private Union =
+    let private _tryGetUnion t =
+        if not (FSharpType.IsUnion(t, true)) then
+            None
+        else
+            let cases = FSharpType.GetUnionCases(t, true)
+            {
+                cases = cases
+                tagReader = FSharpValue.PreComputeUnionTagReader(t, true)
+                fieldReader = cases |> Array.map (fun c -> FSharpValue.PreComputeUnionReader(c, true))
+                caseConstructor = cases |> Array.map (fun c -> FSharpValue.PreComputeUnionConstructor(c, true))
+            } |> Some
+    let tryGetUnion : Type -> Union option = memoize _tryGetUnion

tests/FsCodec.SystemTextJson.Tests/FsCodec.SystemTextJson.Tests.fsproj

@@ -24,6 +24,7 @@
     <Compile Include="CodecTests.fs" />
     <Compile Include="SerdesTests.fs" />
     <Compile Include="UmxInteropTests.fs" />
+    <Compile Include="TypeSafeEnumConverterTests.fs" />
   </ItemGroup>
 
 </Project>

tests/FsCodec.SystemTextJson.Tests/TypeSafeEnumConverterTests.fs

@@ -0,0 +1,46 @@
+module FsCodec.SystemTextJson.Tests.TypeSafeEnumConverterTests
+
+open FsCodec.SystemTextJson
+open System
+open System.Collections.Generic
+open System.Text.Json
+open Swensen.Unquote
+open Xunit
+
+type Outcome = Joy | Pain | Misery
+
+let [<Fact>] happy () =
+    test <@ box Joy = TypeSafeEnum.parseT (typeof<Outcome>) "Joy" @>
+    test <@ Joy = TypeSafeEnum.parse "Joy" @>
+    test <@ box Joy = TypeSafeEnum.parseT (typeof<Outcome>) "Joy"  @>
+    test <@ None = TypeSafeEnum.tryParse<Outcome> "Wat" @>
+    raises<KeyNotFoundException> <@ TypeSafeEnum.parse<Outcome> "Wat" @>
+
+    let optionsWithOutcomeConverter = Options.Create(TypeSafeEnumConverter<Outcome>())
+    test <@ Joy = Serdes.Deserialize("\"Joy\"", optionsWithOutcomeConverter) @>
+    test <@ Some Joy = Serdes.Deserialize("\"Joy\"", optionsWithOutcomeConverter) @>
+    raises<KeyNotFoundException> <@ Serdes.Deserialize<Outcome>("\"Confusion\"", optionsWithOutcomeConverter) @>
+    raises<JsonException> <@ Serdes.Deserialize<Outcome> "1" @>
+
+let [<Fact>] sad () =
+    raises<ArgumentException> <@ TypeSafeEnum.tryParse<string> "Wat" @>
+    raises<ArgumentException> <@ TypeSafeEnum.toString "Wat" @>
+
+[<System.Text.Json.Serialization.JsonConverter(typeof<OutcomeWithCatchAllConverter>)>]
+type OutcomeWithOther = Joy | Pain | Misery | Other
+and OutcomeWithCatchAllConverter() =
+    inherit JsonIsomorphism<OutcomeWithOther, string>()
+    override __.Pickle v =
+        TypeSafeEnum.toString v
+
+    override __.UnPickle json =
+        json
+        |> TypeSafeEnum.tryParse<OutcomeWithOther>
+        |> Option.defaultValue Other
+
+let [<Fact>] fallBackExample () =
+    test <@ Joy = Serdes.Deserialize<OutcomeWithOther> "\"Joy\"" @>
+    test <@ Some Other = Serdes.Deserialize<OutcomeWithOther option> "\"Wat\"" @>
+    test <@ Other = Serdes.Deserialize<OutcomeWithOther> "\"Wat\"" @>
+    raises<JsonException> <@ Serdes.Deserialize<OutcomeWithOther> "1" @>
+    test <@ Seq.forall (fun (x,y) -> x = y) <| Seq.zip [Joy; Other] (Serdes.Deserialize "[\"Joy\", \"Wat\"]") @>