Merge pull request #4 from Microsoft/wiblum/2

Fix bug #3 and add corresponding test case

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,37 +98,46 @@ 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 parseBox (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 nestedValue = 
-                    // Is the nested type an option type itself?
-                    // or is the Json to be deserialized an object Json?
-                    if isOptionType nestedType || jToken.Type = Linq.JTokenType.Object then 
-                        // Nested option type are always boxed in Json to prevent any ambguity
-                        parseBox jToken
+                // 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
-                        // type is option<'a> where 'a is not an option type
-                        // => we can deserialize the object of type 'a directly without unboxing
+                        None
+
+                let nestedValue = 
+                    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 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 |])
 
         // Discriminated union
@@ -162,7 +183,7 @@ type CompactUnionJsonConverter() =
 
                 match matchingCase with
                 | None ->
-                    failwithf "Case %s with fields does not exist for discriminated union %s" caseProperty.Name objectType.Name
+                    failwithf "Case with fields '%s' does not exist for discriminated union %s" caseProperty.Name objectType.Name
 
                 // Type 2: A union case with a single field: Case2 of 'a
                 | Some case when case.GetFields().Length = 1 ->
@@ -192,7 +213,10 @@ module Compact =
         /// Serialization settings for our compact Json converter
         type Settings =
             static member settings =
-                let s = JsonSerializerSettings(NullValueHandling = NullValueHandling.Ignore)
+                let s = JsonSerializerSettings( NullValueHandling = NullValueHandling.Ignore,
+                                                // Strict deserialization is required to avoid certain ambiguities
+                                                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

@@ -17,7 +17,18 @@ type 'a Test = Case1 | Case2 of int | Case3 of int * string * 'a
 type MapType = Map<string,Color>
 type 'a NestedOptions = 'a option option option option
 
-type 'a Ambiguous = { Some : 'a }
+type NestedStructure = { subField : int }
+type NestedOptionStructure = { field : NestedStructure option }
+
+/// Test cases for possible ambiguity between option types and other DU or records with a 'Some' field.
+module SomeAmbiguity =
+    type 'a RecordWithFieldNamedSome = { Some : 'a }
+    type DUWithFieldlessCaseNamedSome = Some of string | Bla
+    type DUWithCaseWithFieldNamedSome = Some | Bla
+    type 'a Ambiguous1 = 'a RecordWithFieldNamedSome option
+    type Ambiguous2 = DUWithFieldlessCaseNamedSome option
+    type Ambiguous3 = DUWithCaseWithFieldNamedSome option
+
 
 let inline serialize< ^T> (x: ^T) = Compact.serialize< ^T> x
 let inline deserialize< ^T> x : ^T = Compact.deserialize< ^T> x
@@ -29,11 +40,16 @@ let inline reciprocal< ^T when ^T:equality> (x: ^T) =
     x |> serialize |> deserialize |> serialize |> deserialize = x
 
 let inline areReciprocal< ^T when ^T:equality> (x: ^T) = 
-    Assert.IsTrue(reciprocal< ^T> x)
+    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>. 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 back <%A> for type %A" x sdsd (typeof< ^T>))
 
 /// Check that given object serializes to the specified Json string
 let inline serializedAs json o = 
-    Assert.AreEqual(json, serialize o)
+    let s = serialize o
+    Assert.AreEqual(json, s, sprintf "Object was not serialized to the expected format")
 
 /// Check that deserialization coincides with NewtonSoft's default serializer.
 /// That is: when the Json is deserializable by both deserializers Union and Default
@@ -82,8 +98,12 @@ type Reciprocality () =
     static member x17 = reciprocal<string option option>
     static member x18 = reciprocal<string option option option option>
     static member x19 = reciprocal<int NestedOptions>
-    static member x20 = reciprocal<Ambiguous<string>>
-    static member x21 = reciprocal<Ambiguous<SimpleDu>>
+    static member x20 = reciprocal<SomeAmbiguity.Ambiguous1<string>>
+    static member x21 = reciprocal<SomeAmbiguity.Ambiguous1<SimpleDu>>
+    static member x22 = reciprocal<NestedOptionStructure>
+    static member x23 = reciprocal<SomeAmbiguity.Ambiguous2>
+    static member x24 = reciprocal<SomeAmbiguity.Ambiguous3>
+
 
 type CoincidesWithJsonNetOnDeserialization () =
     static member x1 = coincidesWithDefault<ComplexDu>
@@ -105,8 +125,11 @@ type CoincidesWithJsonNetOnDeserialization () =
     static member x17 = coincidesWithDefault<string option option>
     static member x18 = coincidesWithDefault<string option option option option>
     static member x19 = coincidesWithDefault<int NestedOptions>
-    static member x20 = coincidesWithDefault<Ambiguous<string>>
-    static member x21 = coincidesWithDefault<Ambiguous<SimpleDu>>
+    static member x20 = coincidesWithDefault<SomeAmbiguity.Ambiguous1<string>>
+    static member x21 = coincidesWithDefault<SomeAmbiguity.Ambiguous1<SimpleDu>>
+    static member x22 = coincidesWithDefault<NestedOptionStructure>
+    static member x23 = coincidesWithDefault<SomeAmbiguity.Ambiguous2>
+    static member x24 = coincidesWithDefault<SomeAmbiguity.Ambiguous3>
 
 type BackwardCompatibility () =
     static member x1 = backwardCompatibleWithDefault<ComplexDu>
@@ -128,15 +151,17 @@ type BackwardCompatibility () =
     static member x17 = backwardCompatibleWithDefault<string option option>
     static member x18 = backwardCompatibleWithDefault<string option option option option>
     static member x19 = backwardCompatibleWithDefault<int NestedOptions>
-    static member x20 = backwardCompatibleWithDefault<Ambiguous<string>>
-    static member x21 = backwardCompatibleWithDefault<Ambiguous<SimpleDu>>
-
+    static member x20 = backwardCompatibleWithDefault<SomeAmbiguity.Ambiguous1<string>>
+    static member x21 = backwardCompatibleWithDefault<SomeAmbiguity.Ambiguous1<SimpleDu>>
+    static member x22 = backwardCompatibleWithDefault<NestedOptionStructure>
+    static member x23 = backwardCompatibleWithDefault<SomeAmbiguity.Ambiguous2>
+    static member x24 = backwardCompatibleWithDefault<SomeAmbiguity.Ambiguous3>
 
 [<TestClass>]
 type JsonSerializerTests() =
 
     [<ClassInitialize>]
-    static member init(context : TestContext) = ()
+    static member Init(context : TestContext) = ()
 
     [<TestMethod>]
     [<TestCategory("FSharpLu.Json")>]
@@ -217,10 +242,14 @@ type JsonSerializerTests() =
     [<TestCategory("FSharpLu.Json")>]
     member this.``No ambiguity between records and Option type``() =
         areReciprocal <| Some (Some (Some None))
-        areReciprocal <| { Some = null }
-        areReciprocal <| { Some = SimpleDu.Foo }
-        areReciprocal <| { Some = "test" }
-        areReciprocal <| { Some = 123 }
+        areReciprocal <| { SomeAmbiguity.Some = null }
+        areReciprocal <| { SomeAmbiguity.Some = SimpleDu.Foo }
+        areReciprocal <| { SomeAmbiguity.Some = "test" }
+        areReciprocal <| { SomeAmbiguity.Some = 123 }
+        areReciprocal <| (Option.Some { SomeAmbiguity.Some = 345 })
+        areReciprocal <| (Option.Some <| SomeAmbiguity.DUWithFieldlessCaseNamedSome.Some "ambiguous")
+        areReciprocal <| (Option.Some { SomeAmbiguity.RecordWithFieldNamedSome.Some = 8 })
+        areReciprocal <| (Option.Some <| SomeAmbiguity.DUWithCaseWithFieldNamedSome.Some)
 
     [<TestMethod>]
     [<TestCategory("FSharpLu.Json.Fuzzing")>]