Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
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
@jcuello

This comment has been minimized.

Copy link

commented Nov 9, 2015

Thanks this is useful, however is there a way to NOT include JSON properties that have null values (i.e. when a record has an optional field and it has the None value).

@Neftedollar

This comment has been minimized.

Copy link

commented Jan 21, 2016

@jcuello
use

let jsonSerializerSettings = new JsonSerializerSettings()
//some code
jsonSerializerSettings.NullValueHandling <- NullValueHandling.Ignore
@bartsokol

This comment has been minimized.

Copy link

commented Nov 4, 2016

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

This comment has been minimized.

Copy link

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

This comment has been minimized.

Copy link

commented Apr 3, 2017

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

@DaveEmmerson

This comment has been minimized.

Copy link

commented Sep 5, 2017

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

This comment has been minimized.

Copy link

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

This comment has been minimized.

Copy link

commented Oct 4, 2017

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
You can’t perform that action at this time.