Force boxing for type Option<'a> if the structure of type 'a may …

…lead to ambiguities. (Better and more complete fix for #3)

This ambiguity occurs for instance for discriminated union or record types that happen to have a field named 'Some'

FSharpLu.Json/Compact.fs

@@ -10,8 +10,18 @@ open Microsoft.FSharp.Reflection
 type CompactUnionJsonConverter() =
     inherit Newtonsoft.Json.JsonConverter()
 
+    let SomeFieldIdentifier = "Some"
+
     let isOptionType (t:System.Type) = 
-        t.IsGenericType && t.GetGenericTypeDefinition() = typedefof<option<_>>
+       t.IsGenericType && t.GetGenericTypeDefinition() = typedefof<option<_>>
+
+    /// Determine if a given type has a field named 'Some' which would cause
+    /// ambiguity if nested under an option type without being boxed
+    let hasFieldNamedSome (t:System.Type) = 
+        isOptionType t // the option type itself has a 'Some' field
+        || (FSharpType.IsRecord t && FSharpType.GetRecordFields t |> Seq.exists (fun r -> r.Name = SomeFieldIdentifier))
+        || (FSharpType.IsUnion t && FSharpType.GetUnionCases t |> Seq.exists (fun r -> r.Name = SomeFieldIdentifier))
+        || (FSharpType.IsUnion t && FSharpType.GetUnionCases t |> Seq.exists (fun r -> r.Name = SomeFieldIdentifier))
 
     override __.CanConvert(objectType:System.Type) = 
         // Include F# discriminated unions
@@ -38,20 +48,22 @@ type CompactUnionJsonConverter() =
                 let innerValue = fields.[0]
                 if isNull innerValue then
                     writer.WriteStartObject()
-                    writer.WritePropertyName("Some")
+                    writer.WritePropertyName(SomeFieldIdentifier)
                     writer.WriteNull()
                     writer.WriteEndObject()
                 // Some v with v <> null && v <> None
                 else
-                    // Is it a nested option: `(e.g., "Some (Some ... Some ( ... )))"`?
-                    if isOptionType <| innerType then
+                    // Is it nesting another option: `(e.g., "Some (Some ... Some ( ... )))"`
+                    // or any other type with a field named 'Some'?
+                    if hasFieldNamedSome innerType then
                         // Preserved the nested structure through boxing
                         writer.WriteStartObject()
-                        writer.WritePropertyName("Some")
+                        writer.WritePropertyName(SomeFieldIdentifier)
                         serializer.Serialize(writer, innerValue)
                         writer.WriteEndObject()
                     else
-                        // Type is option<'a> where 'a is NOT an option type itself
+                        // Type is option<'a> where 'a does not have a field named 'Some
+                        // (and therfore in particular is NOT an option type itself)
                         // => we can simplify the Json by omitting the `Some` boxing
                         // and serializing the nested object directly
                         serializer.Serialize(writer, innerValue)
@@ -86,65 +98,44 @@ type CompactUnionJsonConverter() =
             if jToken.Type = Linq.JTokenType.Null then
                 FSharpValue.MakeUnion(caseNone, [||])
 
-            // Json that is not null maps to `Some _`
+            // Json that is not null must map to `Some _`
             else
                 let nestedType = objectType.GetGenericArguments().[0]
-                let parseBoxedOption (jToken:Linq.JToken) =
-                    if jToken.Type <> Linq.JTokenType.Object then
-                        failwith "Nested option types must be serialized as boxed Json objects"
-
-                    let jObject = jToken :?> Linq.JObject
-                    match jObject.TryGetValue("Some") with
-                    | false, _ ->
-                        failwith "Nested option types must be serialized as boxed Json objects with attribute 'Some'."
-                    | true, unboxedValue ->
-                        if unboxedValue.Type = Linq.JTokenType.Null then
-                            // Case of Json { "Some" : null } for type option<'a> where 'a is nullable
-                            // => deserialized to `Some null`
-                            null
-                        else
-                            // Case of Json { "Some" : <obj> } where <obj> is not null
-                            // => we just deserialize the nested object recursively
-                            unboxedValue.ToObject(nestedType, serializer)
-
-                let parseBoxedNonOptionObject (jToken:Linq.JToken) =
-                    if jToken.Type <> Linq.JTokenType.Object then
-                        failwith "Nested option types must be serialized as boxed Json objects"
 
-                    let jObject = jToken :?> Linq.JObject
-                    match jObject.TryGetValue("Some") with
-                    | false, _ ->
-                        // 'Some' field absent from Json: this must be a nested discriminated union object.
-                        // Not need to unbox: we just deserialize the Json object as is.
-                        jObject.ToObject(nestedType, serializer)
-                    | true, unboxedValue ->
-                        if unboxedValue.Type = Linq.JTokenType.Null then
-                            // Case of Json { "Some" : null } for type option<'a> where 'a is nullable
-                            // => deserialized to `Some null`
-                            null
-                        else
-                            // Case of Json { "Some" : <obj> } where <obj> is not null
-                            // => we just deserialize the nested object recursively
-                            //
-                            // NOTE: there is a possible ambuiguity here: we assume that the 'Some' field
-                            // from the Json blob corresponds to the Option type being deserialized. However, it
-                            // could just by a coincidence where 'Some' is also the name of a field in a nested 
-                            // discriminated union. (type X = { Some : string } and Y = Y option)
-                            // If this is the case the deserialization fails.
-                            unboxedValue.ToObject(nestedType, serializer)
+                // If the specified Json an object of the form `{ "Some" = token }`
+                // then return `Some token`, otherwise returns `None`.
+                let tryGetSomeAttributeValue (jToken:Linq.JToken) =
+                    if jToken.Type = Linq.JTokenType.Object then
+                        let jObject = jToken :?> Linq.JObject
+                        match jObject.TryGetValue SomeFieldIdentifier with
+                        | true, token -> Some token
+                        | false, _ -> None
+                    else
+                        None
 
                 let nestedValue = 
-                    // Is the nested type an option type itself?
-                    // or is the Json to be deserialized is an object Json?
-                    if isOptionType nestedType then 
-                        // Nested option type are always boxed in Json to prevent any ambguity
-                        parseBoxedOption jToken
-                    else if jToken.Type = Linq.JTokenType.Object then
-                        parseBoxedNonOptionObject jToken
-                    else
+                    match tryGetSomeAttributeValue jToken with
+                    | Some someAttributeValue when someAttributeValue.Type = Linq.JTokenType.Null ->
+                        // The Json object is { "Some" : null } for type option<'a>
+                        // where 'a is nullable => deserialized to `Some null`
+                        null
+
+                    | Some someAttributeValue when hasFieldNamedSome nestedType ->
+                        // Case of Json { "Some" : <obj> } where <obj> is not null
+                        // => we just deserialize the nested object recursively
+                        someAttributeValue.ToObject(nestedType, serializer)
+
+                    | Some someAttributeValue ->
+                        failwithf "Unexpected Json 'Some' attribute set to %O" someAttributeValue
+
+                    | None when hasFieldNamedSome nestedType ->
+                        failwith "Types with a field named 'Some' and nested under an option type must be boxed under a 'Some' attribute when serialized to Json."
+
+                    | None ->
                         // type is option<'a> where 'a is not an option type and not a 
-                        // type that would be serialized as a Json object. i.e. 'a is a base Json type (e.g. integer or string)
-                        // => we can deserialize the object of type 'a directly without unboxing
+                        // type that would be serialized as a Json object. 
+                        // i.e. 'a is either a base Json type (e.g. integer or string) or 
+                        // a Json array => we can deserialize the object of type 'a directly without unboxing
                         jToken.ToObject(nestedType, serializer)
 
                 FSharpValue.MakeUnion(caseSome, [| nestedValue |])
@@ -224,7 +215,8 @@ module Compact =
             static member settings =
                 let s = JsonSerializerSettings( NullValueHandling = NullValueHandling.Ignore,
                                                 // Strict deserialization is required to avoid certain ambiguities
-                                                MissingMemberHandling = MissingMemberHandling.Error)
+                                                MissingMemberHandling = MissingMemberHandling.Error
+                                                )
                 s.Converters.Add(CompactUnionJsonConverter())
                 s
 

FSharpLu.Json/FSharpLu.Json.fsproj

@@ -60,6 +60,8 @@
     <Content Include="packages.config" />
     <None Include="FSharpLu.Json.nuspec" />
     <None Include="Script.fsx" />
+    <None Include="Scripts\load-references-release.fsx" />
+    <None Include="Scripts\load-project-release.fsx" />
   </ItemGroup>
   <ItemGroup>
     <Reference Include="mscorlib" />

FSharpLu.Json/Script.fsx

@@ -12,8 +12,8 @@ open Microsoft.FSharpLu.Json
 type WithFields = SomeField of int * int
 type ComplexDu = ComplexDu of WithFields | SimpleDU | AString of string
 let x= (ComplexDu (SomeField (4,9))) |> Default.serialize
-let y = x |> Default.deserialize :> ComplexDu 
-let z = x |> Compact.deserialize :> ComplexDu
+let y = x |> Default.deserialize<ComplexDu>
+let z = x |> Compact.deserialize<ComplexDu>
 
 module T =
     type OptionOfBase = int option
@@ -22,3 +22,19 @@ module T =
     Some 5 |> Default.serialize |> BackwardCompatible.deserialize :> OptionOfBase 
     Default.deserialize<OptionOfBase> "null"
     BackwardCompatible.deserialize<OptionOfBase> "null"
+
+module T2  =
+    type X = {Some :string}
+
+    Option.Some { X.Some = "test"} |> Compact.serialize
+
+    Option.Some { X.Some = null} |> Compact.serialize
+
+    let z = Option.Some { X.Some = null} |> Compact.serialize |> Compact.deserialize<X option>
+
+    Some (Some null) |> Compact.serialize<obj option option> |> Compact.deserialize<obj option option>
+
+    Some null |> Compact.serialize<obj option> |> Compact.deserialize<obj option>
+
+    null  |> Compact.serialize|> Compact.deserialize<obj option option>
+

FSharpLu.Json/Scripts/load-project-release.fsx

@@ -0,0 +1,9 @@
+// Warning: generated file; your changes could be lost when a new file is generated.
+#I __SOURCE_DIRECTORY__
+#load "load-references-release.fsx"
+#load "../AssemblyInfo.fs"
+      "../Helpers.fs"
+      "../WithFunctor.fs"
+      "../NewtonSoft.fs"
+      "../Compact.fs"
+      "../BackwardCompatible.fs"

FSharpLu.Json/Scripts/load-references-release.fsx

@@ -0,0 +1,5 @@
+// Warning: generated file; your changes could be lost when a new file is generated.
+#I __SOURCE_DIRECTORY__
+#r "../../packages/Newtonsoft.Json.8.0.3/lib/net45/Newtonsoft.Json.dll"
+#r "System.Core.dll"
+#r "System.dll"

FSharpLu.Tests/JsonTests.fs

@@ -42,9 +42,9 @@ let inline reciprocal< ^T when ^T:equality> (x: ^T) =
 let inline areReciprocal< ^T when ^T:equality> (x: ^T) = 
     let s = x |> serialize< ^T>
     let sds = s |> deserialize< ^T> |> serialize< ^T>
-    Assert.AreEqual(s, sds, sprintf "Inconsistent serialization: 1st call: <%s> 2nd call <%s>" s sds)
+    Assert.AreEqual(s, sds, sprintf "Inconsistent serialization: 1st call: <%s> 2nd call <%s>. Type %A" s sds (typeof< ^T>))
     let sdsd = sds |> deserialize< ^T>
-    Assert.AreEqual(sdsd, x, sprintf "Did not get the same object back: <%A> gave <%A>" x sdsd)
+    Assert.AreEqual(sdsd, x, sprintf "Did not get the same object back: <%A> gave back <%A> for type %A" x sdsd (typeof< ^T>))
 
 /// Check that given object serializes to the specified Json string
 let inline serializedAs json o =