Field coders

.vscode/settings.json

@@ -15,11 +15,4 @@
     },
     "files.trimTrailingWhitespace": true,
     "files.trimFinalNewlines": true,
-    "workbench.iconTheme": "material-icon-theme",
-    "workbench.colorTheme": "One Dark Pro",
-    "editor.fontSize": 12,
-    "terminal.integrated.fontSize": 12,
-    "editor.fontLigatures": true,
-    "editor.fontFamily": "Fira Code, JetBrains Mono, Consolas, 'Courier New', monospace",
-    "gitlens.codeLens.enabled": false
 }

paket.dependencies

@@ -10,10 +10,10 @@ nuget Fable.Core ~> 3 framework: netstandard2.0
 
 group tests
     # Get the tests from Thoth.Json repo so both project are in sync
-    github thoth-org/Thoth.Json:master tests/Types.fs
-    github thoth-org/Thoth.Json:master tests/Decoders.fs
-    github thoth-org/Thoth.Json:master tests/Encoders.fs
-    github thoth-org/Thoth.Json:master tests/ExtraCoders.fs
+    github thoth-org/Thoth.Json:develop tests/Types.fs
+    github thoth-org/Thoth.Json:develop tests/Decoders.fs
+    github thoth-org/Thoth.Json:develop tests/Encoders.fs
+    github thoth-org/Thoth.Json:develop tests/ExtraCoders.fs
 
 group netcorebuild
     source https://www.nuget.org/api/v2

paket.lock

@@ -1398,7 +1398,7 @@ GROUP tests
 
 GITHUB
   remote: thoth-org/Thoth.Json
-    tests/Decoders.fs (27570b0bd3188432e214d731763f9e53d0febbeb)
-    tests/Encoders.fs (27570b0bd3188432e214d731763f9e53d0febbeb)
-    tests/ExtraCoders.fs (27570b0bd3188432e214d731763f9e53d0febbeb)
-    tests/Types.fs (27570b0bd3188432e214d731763f9e53d0febbeb)
+    tests/Decoders.fs (fd3078398debc465e30e5bad2c48ea86c72b7af3)
+    tests/Encoders.fs (fd3078398debc465e30e5bad2c48ea86c72b7af3)
+    tests/ExtraCoders.fs (fd3078398debc465e30e5bad2c48ea86c72b7af3)
+    tests/Types.fs (fd3078398debc465e30e5bad2c48ea86c72b7af3)

src/Encode.fs

@@ -347,6 +347,11 @@ module Encode =
 
     open FSharp.Reflection
 
+    type private EncodeAutoExtra =
+        { Encoders: Map<string, ref<BoxedEncoder>>
+          FieldEncoders: Map<string, Map<string, FieldEncoder>>
+          CaseStrategy: CaseStrategy }
+
     type private EncoderCrate<'T>(enc: Encoder<'T>) =
         inherit BoxedEncoder()
         override __.Encode(value: obj): JsonValue =
@@ -402,21 +407,30 @@ module Encode =
             LowerFirst
     #endif
 
-    let rec private autoEncodeRecordsAndUnions extra (caseStrategy : CaseStrategy) (skipNullField : bool) (t: System.Type) : BoxedEncoder =
+    let rec private autoEncodeRecordsAndUnions extra (skipNullField : bool) (t: System.Type) : BoxedEncoder =
         // Add the encoder to extra in case one of the fields is recursive
         let encoderRef = ref Unchecked.defaultof<_>
-        let extra = extra |> Map.add t.FullName encoderRef
+        let extra = { extra with Encoders = extra.Encoders |> Map.add t.FullName encoderRef }
         let encoder =
             if FSharpType.IsRecord(t, allowAccessToPrivateRepresentation=true) then
+                let fieldEncoders =
+                    Map.tryFind t.FullName extra.FieldEncoders
+                    |> Option.defaultValue Map.empty
                 let setters =
                     FSharpType.GetRecordFields(t, allowAccessToPrivateRepresentation=true)
                     |> Array.map (fun fi ->
-                        let targetKey = Util.Casing.convert caseStrategy fi.Name
-                        let encoder = autoEncoder extra caseStrategy skipNullField fi.PropertyType
+                        let targetKey = Util.Casing.convert extra.CaseStrategy fi.Name
+                        let encoder = autoEncoder extra skipNullField fi.PropertyType
                         fun (source: obj) (target: JObject) ->
                             let value = FSharpValue.GetRecordField(source, fi)
                             if not skipNullField || (skipNullField && not (isNull value)) then // Discard null fields
-                                target.[targetKey] <- encoder.Encode value
+                                match Map.tryFind fi.Name fieldEncoders with
+                                | None -> target.[targetKey] <- encoder.Encode value
+                                | Some fieldEncoder ->
+                                    match fieldEncoder value with
+                                    | UseAutoEncoder -> target.[targetKey] <- encoder.Encode value
+                                    | UseJsonValue v -> target.[targetKey] <- v
+                                    | IgnoreField -> ()
                             target)
                 boxEncoder(fun (source: obj) ->
                     (JObject(), setters) ||> Seq.fold (fun target set -> set source target) :> JsonValue)
@@ -448,7 +462,7 @@ module Encode =
                         let target = Array.zeroCreate<JsonValue> (len + 1)
                         target.[0] <- string info.Name
                         for i = 1 to len do
-                            let encoder = autoEncoder extra caseStrategy skipNullField fieldTypes.[i-1].PropertyType
+                            let encoder = autoEncoder extra skipNullField fieldTypes.[i-1].PropertyType
                             target.[i] <- encoder.Encode(fields.[i-1])
                         array target)
             else
@@ -463,61 +477,65 @@ module Encode =
                 ar.Add(encoder.Encode(x))
             ar :> JsonValue)
 
-    and private autoEncoder (extra: Map<string, ref<BoxedEncoder>>) caseStrategy (skipNullField : bool) (t: System.Type) : BoxedEncoder =
+    and private autoEncodeMapOrDict (extra: EncodeAutoExtra) (skipNullField : bool) (t: System.Type) : BoxedEncoder =
+        let keyType = t.GenericTypeArguments.[0]
+        let valueType = t.GenericTypeArguments.[1]
+        let valueEncoder = valueType |> autoEncoder extra skipNullField
+        let kvProps = typedefof<KeyValuePair<obj,obj>>.MakeGenericType(keyType, valueType).GetProperties()
+        match keyType with
+        | StringifiableType toString ->
+            boxEncoder(fun (value: obj) ->
+                let target = JObject()
+                for kv in value :?> System.Collections.IEnumerable do
+                    let k = kvProps.[0].GetValue(kv)
+                    let v = kvProps.[1].GetValue(kv)
+                    target.[toString k] <- valueEncoder.Encode v
+                target :> JsonValue)
+        | _ ->
+            let keyEncoder = keyType |> autoEncoder extra skipNullField
+            boxEncoder(fun (value: obj) ->
+                let target = JArray()
+                for kv in value :?> System.Collections.IEnumerable do
+                    let k = kvProps.[0].GetValue(kv)
+                    let v = kvProps.[1].GetValue(kv)
+                    target.Add(JArray [|keyEncoder.Encode k; valueEncoder.Encode v|])
+                target :> JsonValue)
+
+    and private autoEncoder (extra: EncodeAutoExtra) (skipNullField : bool) (t: System.Type) : BoxedEncoder =
       let fullname = t.FullName
-      match Map.tryFind fullname extra with
+      match Map.tryFind fullname extra.Encoders with
       | Some encoderRef -> boxEncoder(fun v -> encoderRef.contents.BoxedEncoder v)
       | None ->
         if t.IsArray then
-            t.GetElementType() |> autoEncoder extra caseStrategy skipNullField |> genericSeq
+            t.GetElementType() |> autoEncoder extra skipNullField |> genericSeq
         elif t.IsGenericType then
             if FSharpType.IsTuple(t) then
                 let encoders =
                     FSharpType.GetTupleElements(t)
-                    |> Array.map (autoEncoder extra caseStrategy skipNullField)
+                    |> Array.map (autoEncoder extra skipNullField)
                 boxEncoder(fun (value: obj) ->
                     FSharpValue.GetTupleFields(value)
                     |> Seq.mapi (fun i x -> encoders.[i].Encode x) |> seq)
             else
                 let fullname = t.GetGenericTypeDefinition().FullName
                 if fullname = typedefof<obj option>.FullName then
                     // Evaluate lazily so we don't need to generate the encoder for null values
-                    let encoder = lazy autoEncoder extra caseStrategy skipNullField t.GenericTypeArguments.[0]
+                    let encoder = lazy autoEncoder extra skipNullField t.GenericTypeArguments.[0]
                     boxEncoder(fun (value: obj) ->
                         if isNull value then nil
                         else
                             let _, fields = FSharpValue.GetUnionFields(value, t, allowAccessToPrivateRepresentation=true)
                             encoder.Value.Encode fields.[0])
                 elif fullname = typedefof<obj list>.FullName
-                    || fullname = typedefof<Set<string>>.FullName then
-                    // I don't know how to support seq for now.
-                    // || fullname = typedefof<obj seq>.FullName
-                    t.GenericTypeArguments.[0] |> autoEncoder extra caseStrategy skipNullField |> genericSeq
-                elif fullname = typedefof< Map<string, obj> >.FullName then
-                    let keyType = t.GenericTypeArguments.[0]
-                    let valueType = t.GenericTypeArguments.[1]
-                    let valueEncoder = valueType |> autoEncoder extra caseStrategy skipNullField
-                    let kvProps = typedefof<KeyValuePair<obj,obj>>.MakeGenericType(keyType, valueType).GetProperties()
-                    match keyType with
-                    | StringifiableType toString ->
-                        boxEncoder(fun (value: obj) ->
-                            let target = JObject()
-                            for kv in value :?> System.Collections.IEnumerable do
-                                let k = kvProps.[0].GetValue(kv)
-                                let v = kvProps.[1].GetValue(kv)
-                                target.[toString k] <- valueEncoder.Encode v
-                            target :> JsonValue)
-                    | _ ->
-                        let keyEncoder = keyType |> autoEncoder extra caseStrategy skipNullField
-                        boxEncoder(fun (value: obj) ->
-                            let target = JArray()
-                            for kv in value :?> System.Collections.IEnumerable do
-                                let k = kvProps.[0].GetValue(kv)
-                                let v = kvProps.[1].GetValue(kv)
-                                target.Add(JArray [|keyEncoder.Encode k; valueEncoder.Encode v|])
-                            target :> JsonValue)
+                    || fullname = typedefof<Set<string>>.FullName
+                    || fullname = typedefof<HashSet<string>>.FullName
+                    || fullname = typedefof<obj seq>.FullName then
+                    t.GenericTypeArguments.[0] |> autoEncoder extra skipNullField |> genericSeq
+                elif fullname = typedefof< Map<string, obj> >.FullName
+                    || fullname = typedefof< Dictionary<string, obj> >.FullName then
+                    autoEncodeMapOrDict extra skipNullField t
                 else
-                    autoEncodeRecordsAndUnions extra caseStrategy skipNullField t
+                    autoEncodeRecordsAndUnions extra skipNullField t
         elif t.IsEnum then
             let enumType = System.Enum.GetUnderlyingType(t).FullName
             if enumType = typeof<sbyte>.FullName then
@@ -535,7 +553,7 @@ module Encode =
             else
                 failwithf
                     """Cannot generate auto encoder for %s.
-Thoth.Json.Net only support the folluwing enum types:
+Thoth.Json.Net only support the following enum types:
 - sbyte
 - byte
 - int16
@@ -589,12 +607,18 @@ If you can't use one of these types, please pass an extra encoder.
             elif fullname = typeof<obj>.FullName then
                 boxEncoder(fun (v: obj) -> JValue(v) :> JsonValue)
             else
-                autoEncodeRecordsAndUnions extra caseStrategy skipNullField t
-
-    let private makeExtra (extra: ExtraCoders option) =
-        match extra with
-        | None -> Map.empty
-        | Some e -> Map.map (fun _ (enc,_) -> ref enc) e.Coders
+                autoEncodeRecordsAndUnions extra skipNullField t
+
+    let private makeExtra (extra: ExtraCoders option) caseStrategy =
+        let encoders =
+            extra |> Option.map (fun e -> e.Coders |> Map.map (fun _ (enc,_) -> ref enc))
+        let fieldEncoders =
+            extra |> Option.map (fun e -> e.FieldEncoders)
+        {
+            CaseStrategy = caseStrategy
+            Encoders = defaultArg encoders Map.empty
+            FieldEncoders = defaultArg fieldEncoders Map.empty
+        }
 
     module Auto =
 
@@ -613,7 +637,7 @@ If you can't use one of these types, please pass an extra encoder.
 
                 let encoderCrate =
                     Cache.Encoders.Value.GetOrAdd(key, fun _ ->
-                        autoEncoder (makeExtra extra) caseStrategy skipNullField t)
+                        autoEncoder (makeExtra extra caseStrategy) skipNullField t)
 
                 fun (value: 'T) ->
                     encoderCrate.Encode value
@@ -627,7 +651,7 @@ If you can't use one of these types, please pass an extra encoder.
         static member generateEncoder<'T>(?caseStrategy : CaseStrategy, ?extra: ExtraCoders, ?skipNullField: bool): Encoder<'T> =
             let caseStrategy = defaultArg caseStrategy PascalCase
             let skipNullField = defaultArg skipNullField true
-            let encoderCrate = autoEncoder (makeExtra extra) caseStrategy skipNullField typeof<'T>
+            let encoderCrate = autoEncoder (makeExtra extra caseStrategy) skipNullField typeof<'T>
             fun (value: 'T) ->
                 encoderCrate.Encode value
 

src/Extra.fs

@@ -3,7 +3,9 @@ module Thoth.Json.Net.Extra
 
 let empty: ExtraCoders =
     { Hash = ""
-      Coders = Map.empty }
+      Coders = Map.empty
+      FieldDecoders = Map.empty
+      FieldEncoders = Map.empty }
 
 let inline internal withCustomAndKey (encoder: Encoder<'Value>) (decoder: Decoder<'Value>)
            (extra: ExtraCoders): ExtraCoders =
@@ -25,3 +27,25 @@ let inline withDecimal (extra: ExtraCoders): ExtraCoders =
 
 let inline withBigInt (extra: ExtraCoders): ExtraCoders =
     withCustomAndKey Encode.bigint Decode.bigint extra
+
+let __withCustomFieldDecoderAndKey typeFullName (fieldName: string) (fieldDecoder: FieldDecoder) (extra: ExtraCoders) =
+    { extra with Hash = System.Guid.NewGuid().ToString()
+                 FieldDecoders =
+                    Map.tryFind typeFullName extra.FieldDecoders
+                    |> Option.defaultValue Map.empty
+                    |> Map.add fieldName fieldDecoder
+                    |> fun m -> Map.add typeFullName m extra.FieldDecoders }
+
+let inline withCustomFieldDecoder<'T> (fieldName: string) (fieldDecoder: FieldDecoder) (extra: ExtraCoders) =
+    __withCustomFieldDecoderAndKey typeof<'T>.FullName fieldName fieldDecoder extra
+
+let __withCustomFieldEncoderAndKey typeFullName (fieldName: string) (fieldEncoder: FieldEncoder) (extra: ExtraCoders) =
+    { extra with Hash = System.Guid.NewGuid().ToString()
+                 FieldEncoders =
+                    Map.tryFind typeFullName extra.FieldEncoders
+                    |> Option.defaultValue Map.empty
+                    |> Map.add fieldName fieldEncoder
+                    |> fun m -> Map.add typeFullName m extra.FieldEncoders }
+
+let inline withCustomFieldEncoder<'T> (fieldName: string) (fieldEncoder: FieldEncoder) (extra: ExtraCoders) =
+    __withCustomFieldEncoderAndKey typeof<'T>.FullName fieldName fieldEncoder extra

src/Types.fs

@@ -36,9 +36,25 @@ type BoxedEncoder() =
     abstract Encode: value: obj -> JsonValue
     member this.BoxedEncoder: Encoder<obj> = this.Encode
 
+type FieldDecoderResult =
+    | UseOk of obj
+    | UseError of DecoderError
+    | UseAutoDecoder
+
+type FieldDecoder = string -> JsonValue option -> FieldDecoderResult
+
+type FieldEncoderResult =
+    | UseJsonValue of JsonValue
+    | IgnoreField
+    | UseAutoEncoder
+
+type FieldEncoder = obj -> FieldEncoderResult
+
 type ExtraCoders =
     { Hash: string
-      Coders: Map<string, BoxedEncoder * BoxedDecoder> }
+      Coders: Map<string, BoxedEncoder * BoxedDecoder>
+      FieldDecoders: Map<string, Map<string, FieldDecoder>>
+      FieldEncoders: Map<string, Map<string, FieldEncoder>> }
 
 module internal Cache =
     open System