1+ namespace Microsoft.FSharpLu.Json
2+
3+ /// Serializers for F# discriminated unions improving upon the stock implementation by JSon.Net
4+ /// The default formatting used by Json.Net to serialize F# discriminated unions
5+ /// and Option types is too verbose. This module implements a more succinct serialization
6+ /// for those data types.
7+
8+ open Newtonsoft.Json
9+ open Microsoft.FSharp .Reflection
10+
11+ /// Improved Json converter for discriminated unions and option types ('a option).
12+ type DiscriminatedUnionJsonConverter () =
13+ inherit Newtonsoft.Json.JsonConverter()
14+
15+ override __.CanConvert ( objectType : System.Type ) =
16+ // Include F# discriminated unions
17+ FSharpType.IsUnion objectType
18+ // and exclude the standard FSharp lists (which are implemented as discriminated unions)
19+ && not ( objectType.IsGenericType && objectType.GetGenericTypeDefinition() = typedefof<_ list>)
20+
21+ override __.WriteJson ( writer : JsonWriter , value : obj , serializer : JsonSerializer ) =
22+ let t = value.GetType()
23+ // Option type?
24+ if t.IsGenericType && t.GetGenericTypeDefinition() = typedefof< option<_>> then
25+ if isNull value then
26+ ()
27+ else
28+ let _ , fields = FSharpValue.GetUnionFields( value, t)
29+ serializer.Serialize( writer, fields.[ 0 ])
30+ // Discriminated union
31+ else
32+ let case , fields = FSharpValue.GetUnionFields( value, t)
33+ match fields with
34+ // Field-less union case
35+ | [||] ->
36+ writer.WriteValue( sprintf " %A " )
37+ // Case with single field
38+ | [| onefield|] ->
39+ writer.WriteStartObject()
40+ writer.WritePropertyName( case.Name)
41+ serializer.Serialize( writer, onefield)
42+ writer.WriteEndObject()
43+ // Case with list of fields
44+ | _ ->
45+ writer.WriteStartObject()
46+ writer.WritePropertyName( case.Name)
47+ serializer.Serialize( writer, fields)
48+ writer.WriteEndObject()
49+
50+ override __.ReadJson ( reader : JsonReader , objectType : System.Type , existingValue : obj , serializer : JsonSerializer ) =
51+ let cases = FSharpType.GetUnionCases( objectType)
52+ // Option type?
53+ if objectType.IsGenericType && objectType.GetGenericTypeDefinition() = typedefof< option<_>> then
54+ let caseNone , caseSome = cases.[ 0 ], cases.[ 1 ]
55+ let jToken = Linq.JToken.ReadFrom( reader)
56+ if jToken.Type = Linq.JTokenType.Null then
57+ FSharpValue.MakeUnion( caseNone, [||])
58+ else
59+ let nestedType = objectType.GetGenericArguments().[ 0 ]
60+ let nestedValue = jToken.ToObject( nestedType, serializer)
61+ FSharpValue.MakeUnion( caseSome, [| nestedValue |])
62+
63+ // Discriminated union
64+ else
65+ // There are three types of union cases:
66+ // | Case1 | Case2 of 'a | Case3 of 'a1 * 'a2 ... * 'an
67+ // Those are respectively serialized to Json as
68+ // "Case1"
69+ // { "Case2" : value }
70+ // { "Case3" : [v1, v2, ... vn] }
71+
72+ // Load JObject from stream
73+ let jToken = Linq.JToken.Load( reader)
74+
75+ if isNull jToken then
76+ null
77+
78+ // Type1: field-less union case
79+ elif jToken.Type = Linq.JTokenType.String then
80+ let caseName = jToken.ToString()
81+ let matchingCase =
82+ cases
83+ |> Array.tryFind
84+ ( fun case -> case.Name.Equals( caseName, System.StringComparison.InvariantCultureIgnoreCase)
85+ && ( case.GetFields() |> Array.isEmpty))
86+ match matchingCase with
87+ | Some case -> FSharpValue.MakeUnion( case,[||])
88+ | None ->
89+ failwithf " Cannot parse DU field-less value: %O %O " ( System.String.Join( " , " , cases |> Seq.map( fun c -> c.Name)))
90+
91+ // Type 2 or 3: Case with fields
92+ elif jToken.Type = Linq.JTokenType.Object then
93+ let jObject = jToken :?> Linq.JObject
94+ let jObjectProperties = jObject.Properties()
95+ if Seq.length jObjectProperties <> 1 then
96+ failwith " Incorrect Json format for discriminated union. A DU value with fields must be serialized to a Json object with a single Json attribute"
97+
98+ let caseProperty = jObjectProperties |> Seq.head
99+ /// Lookup the DU case by name
100+ let matchingCase =
101+ cases
102+ |> Seq.tryFind ( fun case -> case.Name.Equals( caseProperty.Name, System.StringComparison.InvariantCultureIgnoreCase))
103+
104+ match matchingCase with
105+ | None ->
106+ failwithf " Case %s %s "
107+
108+ // Type 2: A union case with a single field: Case2 of 'a
109+ | Some case when case.GetFields() .Length = 1 ->
110+ let fieldType = case.GetFields().[ 0 ]. PropertyType
111+ let field = caseProperty.Value.ToObject( fieldType, serializer)
112+ FSharpValue.MakeUnion( case, [| field|])
113+
114+ // Type 3: A union case with more than one field: Case3 of 'a1 * 'a2 ... * 'an
115+ | Some case ->
116+ // Here there could be an ambiguity:
117+ // the Json values are either the fields of the case
118+ // or if the array is Use target type to resolve ambiguity
119+ let fields =
120+ case.GetFields()
121+ |> Seq.zip caseProperty.Value
122+ |> Seq.map ( fun ( v , t ) -> ( t.PropertyType, serializer))
123+ |> Seq.toArray
124+ FSharpValue.MakeUnion( case, fields)
125+ else
126+ failwithf " Unexpected Json token type %O %O "
127+
128+ /// Serialization settings for our custom Json converter
129+ type UnionSettings =
130+ static member settings =
131+ let converter = DiscriminatedUnionJsonConverter()
132+ let s = JsonSerializerSettings( NullValueHandling = NullValueHandling.Ignore)
133+ s.Converters.Add( converter)
134+ s
135+
136+ /// Our Json serializer
137+ type Union = With< UnionSettings>
0 commit comments