Skip to content

Instantly share code, notes, and snippets.

@isaacabraham
Created September 7, 2014 21:17
Show Gist options
  • Save isaacabraham/ba679f285bfd15d2f53e to your computer and use it in GitHub Desktop.
Save isaacabraham/ba679f285bfd15d2f53e to your computer and use it in GitHub Desktop.
This JSON.Net converter handles F# discriminated unions with more "idiomatic" JSON than what is generated by the current version of JSON .NET. Option types and single case DUs are transparently handled, and tuple-style properties are used rather than array notation.
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
Copy link

Seems like there is an issue with serialization when we have union type with two options without fields:

type ResponseType = OK | Error

    type Response = {
        status: ResponseType
        message: string
    }

    let ok =
        { status = OK; message = "Test" }

ok serializes to:

{
  "status": null,
  "message": "Test"
}

when debugging I found that it matches the first case in match and so it writes null to output:

match unionCases.Length, fields, allCasesHaveValues with
        | 2, [||], false -> writer.WriteNull()

Do you have any ideas why is that/how to fix it?

@sendittokeith
Copy link

sendittokeith commented Mar 16, 2017

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.

@VinceAvery
Copy link

For those who are interested, I have ported the code to C#. It can be found here.

@DaveEmmerson
Copy link

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?

@toburger
Copy link

toburger commented Sep 28, 2017

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())

@DaveEmmerson
Copy link

Yeah, I was being dense... needed AddJsonOptions:

    services.AddMvc().AddJsonOptions(fun options ->
        options.SerializerSettings.Converters.Add(IdiomaticDuConverter())
    ) |> ignore

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment