Option converter for Newtonsoft.Json

enum-like-converter.fs

[<AutoOpen>]
module EnumLikeDuConverter =

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

  /// see `enumLikeDuConverter`
  type EnumLikeDuConverter() =
    inherit JsonConverter()

    let canConvertCache = ConcurrentDictionary<Type,bool>()
    let instanceCache = ConcurrentDictionary<Type*string,obj>()

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

            let cases = FSharpType.GetUnionCases t
            let allCasesAreSingleCase =
                cases
                |> Seq.forall (fun case ->
                    case.GetFields().Length = 0
                    )

            if not allCasesAreSingleCase then false else

            for case in cases do
                let instance = FSharpValue.PreComputeUnionConstructor case Array.empty
                let name = case.Name
                
                instanceCache.[(t, name)] <- instance
            true
        canConvertCache.[t] <- result
        result

    override __.WriteJson(writer, value, serializer) =
      if isNull value then
          failwithf "cant serialize null value of type %A" (value.GetType())  
      else
      serializer.Serialize(writer, string value)

    override __.ReadJson(reader, t, v, serializer) =
      if reader.TokenType = JsonToken.Null then
        failwithf "cant deserialize null to type %A" t  
      else
          
      let field = JToken.ReadFrom reader
     
      let instance = instanceCache.[(t, string field)]

      instance

  /// `Newtonsoft.Json` converter which could (de-)serialize enum-like DU
  /// from:
  /// ```fsharp
  /// type EnumDU = A | B | C
  /// type Record = { Field: EnumDU }
  /// let  record = { Field = B }
  /// ```
  /// to json:
  /// 
  /// ```json
  /// {
  ///     "Field": "B"
  /// }
  /// ```
  let enumLikeDuConverter = EnumLikeDuConverter() :> JsonConverter  

option-converter.fs

namespace Inhabit.ETL

[<AutoOpen>]
module OptionConverter =

  open Newtonsoft.Json
  open Microsoft.FSharp.Reflection
  open System

  /// see `optionConverter`
  type OptionConverter() =
    inherit JsonConverter()

    override __.CanConvert t =
      t.IsGenericType
      && typedefof<option<_>>.Equals (t.GetGenericTypeDefinition())

    override __.WriteJson(writer, value, serializer) =
      let value =
        if isNull value then
          null
        else 
          let _,fields = FSharpValue.GetUnionFields(value, value.GetType())
          fields.[0]
      serializer.Serialize(writer, value)

    override __.ReadJson(reader, t, _, serializer) =
      let innerType = t.GetGenericArguments().[0]

      let innerType = 
        if innerType.IsValueType then
          typedefof<Nullable<_>>.MakeGenericType([| innerType |])
        else
          innerType

      let value = serializer.Deserialize(reader, innerType)
      let cases = FSharpType.GetUnionCases t

      if isNull value then
        FSharpValue.MakeUnion(cases.[0], [||])
      else
        FSharpValue.MakeUnion(cases.[1], [|value|])

  /// `Newtonsoft.Json` converter which could (de-)serialize `Option<'a>` values:
  ///
  /// from:
  /// ```fsharp
  /// type Record =
  ///     { Id  : string
  ///       Name: string option }
  /// let withName = { Id = "1"; Name = Some "A" }
  /// let woName = { Id = "2"; Name = None }
  /// ```
  ///
  /// to jsons:
  ///
  /// ```json
  /// {
  ///     "Id": "1",
  ///     "Name": "A"
  /// }
  /// ```
  ///
  /// ```json
  /// {
  ///     "Id": "2",
  ///     "Name": null
  /// }
  /// ```
  let optionConverter = OptionConverter() :> JsonConverter

single-du-converter.fs

namespace Inhabit.ETL

[<AutoOpen>]
module SingleDuConverter =

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

  /// see `singleDuConverter`
  type SingleDuConverter() =
    inherit JsonConverter()

    let canConvertCache = ConcurrentDictionary<Type,bool>()
    let fieldCache = ConcurrentDictionary<Type,obj -> obj>()
    let ctorCache = ConcurrentDictionary<Type,obj -> obj>()
    let caseCache = ConcurrentDictionary<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

  /// `Newtonsoft.Json` converter which could (de-)serialize single case DU
  /// from:
  /// ```fsharp
  /// type SomeId = SomeId of string
  /// type Record = { Id: SomeId }
  /// let  record = { Id = "123" }
  /// ```
  /// to json:
  /// 
  /// ```json
  /// {
  ///     "Id": "123"
  /// }
  /// ```
  let singleDuConverter = SingleDuConverter() :> JsonConverter

usage.fs

module Json =
  
  /// unformatted, omitting null fields, camelCase, with `single-case DU` and `option` converters
  let serializeSettings =
      JsonSerializerSettings(
          Formatting = Formatting.None,
          NullValueHandling = NullValueHandling.Ignore,
          Converters = [|optionConverter; singleDuConverter; enumLikeDuConverter|],
          ContractResolver = CamelCasePropertyNamesContractResolver())

  /// Inline version of `Newtonsoft.Json.JsonConvert.SerializeObject` with hardcoded `serializeSettings`
  let inline serializeUCamel obj =
      JsonConvert.SerializeObject(obj, serializeSettings)

  /// Inline version of `Newtonsoft.Json.JsonConvert.SerializeObject` with hardcoded `serializeSettingsPascal`
  let inline serializeUPascal obj =
      JsonConvert.SerializeObject(obj, serializeSettingsPascal)

  /// Inline version of `Newtonsoft.Json.JsonConvert.SerializeObject` with hardcoded `deserializeSettings`
  let inline deserialize<'a> text =
      JsonConvert.DeserializeObject<'a>(text, deserializeSettings)