Merge pull request #95 from xperiandri/master

Implemented ability to deserialize discriminated unions regardless of union tag position

Author: Tarmil

build.fsx

@@ -93,7 +93,7 @@ Target.create "TestTrim" <| fun _ ->
 /// project(s) as part of the run.
 Target.create "Benchmark" (fun _ ->
     DotNet.exec (fun o -> { o with 
-                                WorkingDirectory = Paths.benchmarks } ) "run" "-c release --filter \"*\""
+                                WorkingDirectory = Paths.benchmarks } ) "run" "-c release --runtimes netcoreapp50 --filter \"*\""
     |> checkOk "Benchmarks"
 )
 

docs/Customizing.md

@@ -406,6 +406,27 @@ type Location =
     // Instead of {"Item":{"lat":48.858,"long":2.295}}
     ```
 
+#### `AllowUnorderedTag`
+
+`JsonUnionEncoding.AllowUnorderedTag` is enabled by default.
+It takes effect during deserialization in AdjacentTag and InternalTag modes.
+When it is disabled, the name of the case must be the first field of the JSON object.
+When it is enabled, the name of the case may come later in the object, at the cost of a slight performance penalty if it does.
+
+For example, without `AllowUnorderedTag`, the following will fail to parse:
+
+```fsharp
+JsonSerializer.Deserialize("""{"Fields":[3.14],"Case":"WithOneArg"}""", options)
+// --> Error: Failed to find union case field for Example: expected Case
+```
+
+Whereas with `AllowUnorderedTag`, it will succeed:
+
+```fsharp
+JsonSerializer.Deserialize("""{"Fields":[3.14],"Case":"WithOneArg"}""", options)
+// --> WithOneArg 3.14
+```
+
 ### Combined flags
 
 `JsonUnionEncoding` also contains a few items that combine several of the above flags.
@@ -417,6 +438,7 @@ type Location =
     JsonUnionEncoding.AdjacentTag
     ||| JsonUnionEncoding.UnwrapOption
     ||| JsonUnionEncoding.UnwrapSingleCaseUnions
+    ||| JsonUnionEncoding.AllowUnorderedTag
     ```
 
     It is particularly useful if you want to use the default encoding with some additional options, for example:
@@ -430,6 +452,7 @@ type Location =
 
     ```fsharp
     JsonUnionEncoding.AdjacentTag
+    ||| JsonUnionEncoding.AllowUnorderedTag
     ```
 
 * `JsonUnionEncoding.ThothLike` causes similar behavior to the library [Thoth.Json](https://thoth-org.github.io/Thoth.Json/).
@@ -438,6 +461,7 @@ type Location =
     ```fsharp
     JsonUnionEncoding.InternalTag
     ||| JsonUnionEncoding.UnwrapFieldlessTags
+    ||| JsonUnionEncoding.AllowUnorderedTag
     ```
 
 * `JsonUnionEncoding.FSharpLuLike` causes similar behavior to the library [FSharpLu.Json](https://github.com/microsoft/fsharplu/wiki/FSharpLu.Json) in Compact mode.
@@ -448,6 +472,7 @@ type Location =
     ||| JsonUnionEncoding.UnwrapFieldlessTags
     ||| JsonUnionEncoding.UnwrapOption
     ||| JsonUnionEncoding.UnwrapSingleFieldCases
+    ||| JsonUnionEncoding.AllowUnorderedTag
     ```
 
 ## `unionTagName`

src/FSharp.SystemTextJson/Helpers.fs

@@ -19,8 +19,11 @@ let readExpecting expectedTokenType expectedLabel (reader: byref<Utf8JsonReader>
     if not (reader.Read()) || reader.TokenType <> expectedTokenType then
         fail expectedLabel &reader ty
 
+let inline readIsExpectingPropertyNamed (expectedPropertyName: string) (reader: byref<Utf8JsonReader>) ty =
+    (reader.Read()) && reader.TokenType = JsonTokenType.PropertyName && (reader.ValueTextEquals expectedPropertyName)
+
 let readExpectingPropertyNamed (expectedPropertyName: string) (reader: byref<Utf8JsonReader>) ty =
-    if not (reader.Read()) || reader.TokenType <> JsonTokenType.PropertyName || not (reader.ValueTextEquals expectedPropertyName) then
+    if not <| readIsExpectingPropertyNamed expectedPropertyName &reader ty then
         fail ("\"" + expectedPropertyName + "\"") &reader ty
 
 let isNullableUnion (ty: Type) =

src/FSharp.SystemTextJson/Options.fs

@@ -77,13 +77,17 @@ type JsonUnionEncoding =
     /// the fields of this record are encoded directly as fields of the object representing the union.
     | UnwrapRecordCases         = 0x00_00_21_00
 
+    /// In AdjacentTag and InternalTag mode, allow deserializing unions
+    /// where the tag is not the first field in the JSON object.
+    | AllowUnorderedTag         = 0x00_00_40_00
+
 
     //// Specific formats
 
-    | Default                   = 0x00_00_0C_01
-    | NewtonsoftLike            = 0x00_00_00_01
-    | ThothLike                 = 0x00_00_02_04
-    | FSharpLuLike              = 0x00_00_16_02
+    | Default                   = 0x00_00_4C_01 // AdjacentTag ||| UnwrapOption ||| UnwrapSingleCaseUnions ||| AllowUnorderedTag
+    | NewtonsoftLike            = 0x00_00_40_01 // AdjacentTag ||| AllowUnorderedTag
+    | ThothLike                 = 0x00_00_42_04 // InternalTag ||| BareFieldlessTags ||| AllowUnorderedTag
+    | FSharpLuLike              = 0x00_00_56_02 // ExternalTag ||| BareFieldlessTags ||| UnwrapOption ||| UnwrapSingleFieldCases ||| AllowUnorderedTag
 
 type JsonUnionTagName = string
 type JsonUnionFieldsName = string

src/FSharp.SystemTextJson/Union.fs

@@ -5,6 +5,7 @@ open System.Collections.Generic
 open System.Text.Json
 open FSharp.Reflection
 open System.Text.Json.Serialization.Helpers
+open System.Buffers
 
 type private Field =
     {
@@ -153,7 +154,7 @@ type JsonUnionConverter<'T>
         else
             ValueNone
 
-    let getCaseByTag (reader: byref<Utf8JsonReader>) =
+    let getCaseByTagReader (reader: byref<Utf8JsonReader>) =
         let found =
             match casesByName with
             | ValueNone ->
@@ -176,6 +177,29 @@ type JsonUnionConverter<'T>
         | ValueSome case ->
             case
 
+    let getCaseByTagString tag =
+        let found =
+            match casesByName with
+            | ValueNone ->
+                let mutable found = ValueNone
+                let mutable i = 0
+                while found.IsNone && i < cases.Length do
+                    let case = cases.[i]
+                    if case.Name.Equals(tag, StringComparison.OrdinalIgnoreCase) then
+                        found <- ValueSome case
+                    else
+                        i <- i + 1
+                found
+            | ValueSome d ->
+                match d.TryGetValue(tag) with
+                | true, c -> ValueSome c
+                | false, _ -> ValueNone
+        match found with
+        | ValueNone ->
+            raise (JsonException("Unknown case for union type " + ty.FullName + ": " + tag))
+        | ValueSome case ->
+            case
+
     let getCaseByFieldName (reader: byref<Utf8JsonReader>) =
         let found =
             match allFieldsByName with
@@ -286,39 +310,61 @@ type JsonUnionConverter<'T>
         else
             readFieldsAsArray &reader case options
 
+    let getCaseFromDocument (reader: Utf8JsonReader) =
+        let mutable reader = reader
+        let document = JsonDocument.ParseValue(&reader)
+        match document.RootElement.TryGetProperty fsOptions.UnionTagName with
+        | true, element -> getCaseByTagString (element.GetString())
+        | false, _ ->
+            sprintf "Failed to find union case field for %s: expected %s" ty.FullName fsOptions.UnionTagName
+            |> JsonException
+            |> raise
+
+    let getCase (reader: byref<Utf8JsonReader>) =
+        let mutable snapshot = reader
+        if readIsExpectingPropertyNamed fsOptions.UnionTagName &snapshot ty then
+            readExpectingPropertyNamed fsOptions.UnionTagName &reader ty
+            readExpecting JsonTokenType.String "case name" &reader ty
+            struct (getCaseByTagReader &reader, false)
+        elif fsOptions.UnionEncoding.HasFlag JsonUnionEncoding.AllowUnorderedTag then
+            struct (getCaseFromDocument reader, true)
+        else
+            sprintf "Failed to find union case field for %s: expected %s" ty.FullName fsOptions.UnionTagName
+            |> JsonException
+            |> raise
+
     let readAdjacentTag (reader: byref<Utf8JsonReader>) (options: JsonSerializerOptions) =
         expectAlreadyRead JsonTokenType.StartObject "object" &reader ty
-        readExpectingPropertyNamed fsOptions.UnionTagName &reader ty
-        readExpecting JsonTokenType.String "case name" &reader ty
-        let case = getCaseByTag &reader
+        let struct (case, usedDocument) = getCase &reader
         let res =
             if case.Fields.Length > 0 then
                 readExpectingPropertyNamed fsOptions.UnionFieldsName &reader ty
                 readFields &reader case options
             else
                 case.Ctor [||] :?> 'T
+        if usedDocument then
+            reader.Read() |> ignore
+            reader.Skip()
         readExpecting JsonTokenType.EndObject "end of object" &reader ty
         res
 
     let readExternalTag (reader: byref<Utf8JsonReader>) (options: JsonSerializerOptions) =
         expectAlreadyRead JsonTokenType.StartObject "object" &reader ty
         readExpecting JsonTokenType.PropertyName "case name" &reader ty
-        let case = getCaseByTag &reader
+        let case = getCaseByTagReader &reader
         let res = readFields &reader case options
         readExpecting JsonTokenType.EndObject "end of object" &reader ty
         res
 
     let readInternalTag (reader: byref<Utf8JsonReader>) (options: JsonSerializerOptions) =
         if namedFields then
             expectAlreadyRead JsonTokenType.StartObject "object" &reader ty
-            readExpectingPropertyNamed fsOptions.UnionTagName &reader ty
-            readExpecting JsonTokenType.String "case name" &reader ty
-            let case = getCaseByTag &reader
+            let struct (case, usedDocument) = getCase &reader
             readFieldsAsRestOfObject &reader case false options
         else
             expectAlreadyRead JsonTokenType.StartArray "array" &reader ty
             readExpecting JsonTokenType.String "case name" &reader ty
-            let case = getCaseByTag &reader
+            let case = getCaseByTagReader &reader
             readFieldsAsRestOfArray &reader case options
 
     let readUntagged (reader: byref<Utf8JsonReader>) (options: JsonSerializerOptions) =
@@ -408,7 +454,7 @@ type JsonUnionConverter<'T>
         | JsonTokenType.Null when Helpers.isNullableUnion ty ->
             (null : obj) :?> 'T
         | JsonTokenType.String when unwrapFieldlessTags ->
-            let case = getCaseByTag &reader
+            let case = getCaseByTagReader &reader
             case.Ctor [||] :?> 'T
         | _ ->
             match baseFormat with