Single DU converter

single-du-converter.fs

[<AutoOpen>]
module SingleDuConverter

open Newtonsoft.Json
open Microsoft.FSharp.Reflection
open System
open System.Collections.Generic
open Newtonsoft.Json.Linq

type SingleDuConverter() =
  inherit JsonConverter()

  let canConvertCache = Dictionary<Type,bool>()
  let fieldCache = Dictionary<Type,obj -> obj>()
  let ctorCache = Dictionary<Type,obj -> obj>()
  let caseCache = Dictionary<Type,UnionCaseInfo>()

  override __.CanConvert t =
    match canConvertCache.TryGetValue t with
    | true, r -> r
    | false, _ ->
      let result = 
          FSharpType.IsUnion t &&

          let cases = FSharpType.GetUnionCases t
          let isOneCase = cases.Length = 1
          
          if not isOneCase then false else

          let singleCase = cases.[0]
          let fieldFunc = FSharpValue.PreComputeUnionReader singleCase >> Array.head
          let unionCtor arg = FSharpValue.PreComputeUnionConstructor singleCase [|arg|]
          ctorCache.[t] <- unionCtor
          fieldCache.[t] <- fieldFunc
          caseCache.[t] <- singleCase
          let fields = cases.[0].GetFields()
          fields.Length = 1
      canConvertCache.[t] <- result
      result

  override __.WriteJson(writer, value, serializer) =
    let fieldFunc = fieldCache.[value.GetType()]
    let field = fieldFunc value
    serializer.Serialize(writer, field)

  override __.ReadJson(reader, t, v, serializer) =
    if reader.TokenType = JsonToken.Null then null else
    let ctor = ctorCache.[t]
    let caseInfo = caseCache.[t]

    let field = JToken.ReadFrom reader
    let fieldProp = caseInfo.GetFields() |> Seq.head
    field.ToObject(fieldProp.PropertyType, serializer)
    |> ctor

let singleDuConverter = SingleDuConverter() :> JsonConverter