-
-
Save isaacabraham/ba679f285bfd15d2f53e to your computer and use it in GitHub Desktop.
namespace Newtonsoft.Json.Converters | |
open Microsoft.FSharp.Reflection | |
open Newtonsoft.Json | |
open System | |
type IdiomaticDuConverter() = | |
inherit JsonConverter() | |
[<Literal>] | |
let discriminator = "__Case" | |
let primitives = Set [ JsonToken.Boolean; JsonToken.Date; JsonToken.Float; JsonToken.Integer; JsonToken.Null; JsonToken.String ] | |
let writeValue (value:obj) (serializer:JsonSerializer, writer : JsonWriter) = | |
if value.GetType().IsPrimitive then writer.WriteValue value | |
else serializer.Serialize(writer, value) | |
let writeProperties (fields : obj array) (serializer:JsonSerializer, writer : JsonWriter) = | |
fields |> Array.iteri (fun index value -> | |
writer.WritePropertyName(sprintf "Item%d" index) | |
(serializer, writer) |> writeValue value) | |
let writeDiscriminator (name : string) (writer : JsonWriter) = | |
writer.WritePropertyName discriminator | |
writer.WriteValue name | |
override __.WriteJson(writer, value, serializer) = | |
let unionCases = FSharpType.GetUnionCases(value.GetType()) | |
let unionType = value.GetType() | |
let case, fields = FSharpValue.GetUnionFields(value, unionType) | |
let allCasesHaveValues = unionCases |> Seq.forall (fun c -> c.GetFields() |> Seq.length > 0) | |
match unionCases.Length, fields, allCasesHaveValues with | |
| 2, [||], false -> writer.WriteNull() | |
| 1, [| singleValue |], _ | |
| 2, [| singleValue |], false -> (serializer, writer) |> writeValue singleValue | |
| 1, fields, _ | |
| 2, fields, false -> | |
writer.WriteStartObject() | |
(serializer, writer) |> writeProperties fields | |
writer.WriteEndObject() | |
| _ -> | |
writer.WriteStartObject() | |
writer |> writeDiscriminator case.Name | |
(serializer, writer) |> writeProperties fields | |
writer.WriteEndObject() | |
override __.ReadJson(reader, destinationType, _, _) = | |
let parts = | |
if reader.TokenType <> JsonToken.StartObject then [| (JsonToken.Undefined, obj()), (reader.TokenType, reader.Value) |] | |
else | |
seq { | |
yield! reader |> Seq.unfold (fun reader -> | |
if reader.Read() then Some((reader.TokenType, reader.Value), reader) | |
else None) | |
} | |
|> Seq.takeWhile(fun (token, _) -> token <> JsonToken.EndObject) | |
|> Seq.pairwise | |
|> Seq.mapi (fun id value -> id, value) | |
|> Seq.filter (fun (id, _) -> id % 2 = 0) | |
|> Seq.map snd | |
|> Seq.toArray | |
let values = | |
parts | |
|> Seq.filter (fun ((_, keyValue), _) -> keyValue <> (discriminator :> obj)) | |
|> Seq.map snd | |
|> Seq.filter (fun (valueToken, _) -> primitives.Contains valueToken) | |
|> Seq.map snd | |
|> Seq.toArray | |
let case = | |
let unionCases = FSharpType.GetUnionCases(destinationType) | |
let unionCase = | |
parts | |
|> Seq.tryFind (fun ((_,keyValue), _) -> keyValue = (discriminator :> obj)) | |
|> Option.map (snd >> snd) | |
match unionCase with | |
| Some case -> unionCases |> Array.find (fun f -> f.Name :> obj = case) | |
| None -> | |
// implied union case | |
match values with | |
| [| null |] -> unionCases |> Array.find(fun c -> c.GetFields().Length = 0) | |
| _ -> unionCases |> Array.find(fun c -> c.GetFields().Length > 0) | |
let values = | |
case.GetFields() | |
|> Seq.zip values | |
|> Seq.map (fun (value, propertyInfo) -> Convert.ChangeType(value, propertyInfo.PropertyType)) | |
|> Seq.toArray | |
FSharpValue.MakeUnion(case, values) | |
override __.CanConvert(objectType) = FSharpType.IsUnion objectType |
bartsokol,
I have noticed this behavior as well. You can modify this line to fix it for the interim.
let allCasesHaveValues = unionCases |> Seq.forall (fun c -> c.GetFields() |> Seq.length > -1)
I don't know the original intent from the author since it is implying that it is checking for values, so you may want to check back later for an update.
For those who are interested, I have ported the code to C#. It can be found here.
I'm probably being dense here, but could someone tell me how you'd get this to be used by ASP.NET as a default converter when you hit a controller?
If you use an F# list and rely on Newtonsoft.Json's default list serializer to serialize your list you will end up with a deeply nested JSON structure with lots of Item1 and Item2 keys, since F# lists are DUs and this converter serializes them before the default list serializer comes into place.
You could convert every list to an array or you could add a list converter before the IdiomaticDUConverter, but the simplest solution is to explicitly exclude lists:
override __.CanConvert(objectType) =
FSharpType.IsUnion objectType &&
not (objectType.IsGenericType &&
typedefof<list<_>> = objectType.GetGenericTypeDefinition())
Yeah, I was being dense... needed AddJsonOptions:
services.AddMvc().AddJsonOptions(fun options ->
options.SerializerSettings.Converters.Add(IdiomaticDuConverter())
) |> ignore
Seems like there is an issue with serialization when we have union type with two options without fields:
ok
serializes to:when debugging I found that it matches the first case in match and so it writes
null
to output:Do you have any ideas why is that/how to fix it?