diff --git a/.vscode/settings.json b/.vscode/settings.json index 6778a9e..52b0f94 100644 --- a/.vscode/settings.json +++ b/.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 } diff --git a/paket.dependencies b/paket.dependencies index 0458237..7f33701 100644 --- a/paket.dependencies +++ b/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 diff --git a/paket.lock b/paket.lock index fe2d5bd..3519307 100644 --- a/paket.lock +++ b/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) \ No newline at end of file + tests/Decoders.fs (fd3078398debc465e30e5bad2c48ea86c72b7af3) + tests/Encoders.fs (fd3078398debc465e30e5bad2c48ea86c72b7af3) + tests/ExtraCoders.fs (fd3078398debc465e30e5bad2c48ea86c72b7af3) + tests/Types.fs (fd3078398debc465e30e5bad2c48ea86c72b7af3) \ No newline at end of file diff --git a/src/Decode.fs b/src/Decode.fs index 405f4c1..aaef473 100644 --- a/src/Decode.fs +++ b/src/Decode.fs @@ -67,7 +67,7 @@ module Decode = | BadField (msg, value) -> genericMsg msg value true | BadPath (msg, value, fieldName) -> - genericMsg msg value true + ("\nNode `" + fieldName + "` is unkown.") + genericMsg msg value true + ("\nNode `" + fieldName + "` is unknown.") | TooSmallArray (msg, value) -> "Expecting " + msg + ".\n" + (Helpers.anyToString value) | BadOneOf messages -> @@ -422,25 +422,7 @@ module Decode = // Data structure /// //////////////////// - let list (decoder : Decoder<'value>) : Decoder<'value list> = - fun path value -> - if Helpers.isArray value then - let mutable i = -1 - let tokens = Helpers.asArray value - (Ok [], tokens) ||> Array.fold (fun acc value -> - i <- i + 1 - match acc with - | Error _ -> acc - | Ok acc -> - match decoder (path + ".[" + (i.ToString()) + "]") value with - | Error er -> Error er - | Ok value -> Ok (value::acc)) - |> Result.map List.rev - else - (path, BadPrimitive ("a list", value)) - |> Error - - let array (decoder : Decoder<'value>) : Decoder<'value array> = + let private arrayWith expectedMsg (mapping: 'value[] -> 'result) (decoder : Decoder<'value>) : Decoder<'result> = fun path value -> if Helpers.isArray value then let mutable i = -1 @@ -454,10 +436,20 @@ module Decode = match decoder (path + ".[" + (i.ToString()) + "]") value with | Error er -> Error er | Ok value -> acc.[i] <- value; Ok acc) + |> Result.map mapping else - (path, BadPrimitive ("an array", value)) + (path, BadPrimitive (expectedMsg, value)) |> Error + let list (decoder : Decoder<'value>) : Decoder<'value list> = + arrayWith "a list" List.ofArray decoder + + let seq (decoder : Decoder<'value>) : Decoder<'value seq> = + arrayWith "a seq" Seq.ofArray decoder + + let array (decoder : Decoder<'value>) : Decoder<'value array> = + arrayWith "an array" id decoder + let keyValuePairs (decoder : Decoder<'value>) : Decoder<(string * 'value) list> = fun path value -> if Helpers.isObject value then @@ -928,6 +920,11 @@ module Decode = open FSharp.Reflection + type private DecodeAutoExtra = + { Decoders: Map> + FieldDecoders: Map> + CaseStrategy: CaseStrategy } + type private DecoderCrate<'T>(dec: Decoder<'T>) = inherit BoxedDecoder() override __.Decode(path, token) = @@ -942,7 +939,7 @@ module Decode = let unboxDecoder<'T> (d: BoxedDecoder): Decoder<'T> = (d :?> DecoderCrate<'T>).UnboxedDecoder - let private autoObject (decoderInfos: (string * BoxedDecoder)[]) (path : string) (value: JsonValue) = + let private autoObject (decoderInfos: (string * BoxedDecoder)[]) (fieldDecoders: Map) (path : string) (value: JsonValue) = if not (Helpers.isObject value) then (path, BadPrimitive ("an object", value)) |> Error else @@ -950,8 +947,15 @@ module Decode = match acc with | Error _ -> acc | Ok result -> - Helpers.getField name value - |> decoder.BoxedDecoder (path + "." + name) + let path = path + "." + name + let value = Helpers.getField name value + match Map.tryFind name fieldDecoders with + | None -> decoder.BoxedDecoder path value + | Some fieldDecoder -> + match fieldDecoder path (Option.ofObj value) with + | UseOk v -> Ok v + | UseError e -> Error e + | UseAutoDecoder -> decoder.BoxedDecoder path value |> Result.map (fun v -> v::result)) let private mixedArray msg (decoders: BoxedDecoder[]) (path: string) (values: JsonValue[]): Result = @@ -990,6 +994,19 @@ module Decode = | Error er -> Error er | Ok result -> FSharpValue.MakeUnion(ucis.[1], [|result; acc|], allowAccessToPrivateRepresentation=true) |> Ok) + let private genericArray elemType (decoder: BoxedDecoder) = + fun path value -> + if not (Helpers.isArray value) then + (path, BadPrimitive ("a list", value)) |> Error + else + match array decoder.BoxedDecoder path value with + | Ok items -> + let ar = System.Array.CreateInstance(elemType, items.Length) + for i = 0 to ar.Length - 1 do + ar.SetValue(items.[i], i) + Ok ar + | Error er -> Error er + // let private genericSeq t (decoder: BoxedDecoder) = // fun (path : string) (value: JsonValue) -> // if not (Helpers.isArray value) then @@ -1031,16 +1048,33 @@ module Decode = System.Enum.Parse(t, toString enumValue) |> Ok | false -> - (path, BadPrimitiveExtra(t.FullName, value, "Unkown value provided for the enum")) + (path, BadPrimitiveExtra(t.FullName, value, "Unknown value provided for the enum")) |> Error | Error msg -> Error msg - let rec private genericMap extra isCamelCase (t: System.Type) = + let private genericDict (t: System.Type) (keyType: System.Type) (valueType: System.Type) (kvs: obj) = + let dic = System.Activator.CreateInstance(t) + let addMethod = t.GetMethod("Add") + let kvProps = typedefof.MakeGenericType(keyType, valueType).GetProperties() + for kv in kvs :?> System.Collections.IEnumerable do + let k = kvProps.[0].GetValue(kv) + let v = kvProps.[1].GetValue(kv) + addMethod.Invoke(dic, [|k; v|]) |> ignore + dic + + let private genericHashSet (t: System.Type) (xs: obj) = + let hashSet = System.Activator.CreateInstance(t) + let addMethod = t.GetMethod("Add") + for x in xs :?> System.Collections.IEnumerable do + addMethod.Invoke(hashSet, [|x|]) |> ignore + hashSet + + let rec private autoDecodeMapOrDict (constructor: System.Type -> System.Type -> System.Type -> obj -> obj) extra (t: System.Type) = let keyType = t.GenericTypeArguments.[0] let valueType = t.GenericTypeArguments.[1] - let valueDecoder = autoDecoder extra isCamelCase false valueType - let keyDecoder = autoDecoder extra isCamelCase false keyType + let valueDecoder = autoDecoder extra false valueType + let keyDecoder = autoDecoder extra false keyType let tupleType = typedefof.MakeGenericType([|keyType; valueType|]) let listType = typedefof< ResizeArray >.MakeGenericType([|tupleType|]) let addMethod = listType.GetMethod("Add") @@ -1077,10 +1111,21 @@ module Decode = Ok acc) | _ -> (path, BadPrimitive ("an array or an object", value)) |> Error - kvs |> Result.map (fun kvs -> System.Activator.CreateInstance(t, kvs)) + kvs |> Result.map (constructor t keyType valueType) + and private autoDecodeSetOrHashSet (constructor: System.Type -> obj -> obj) extra (t: System.Type) = + let keyType = t.GenericTypeArguments.[0] + let decoder = autoDecoder extra false keyType + fun path value -> + match array decoder.BoxedDecoder path value with + | Ok items -> + let ar = System.Array.CreateInstance(keyType, items.Length) + for i = 0 to ar.Length - 1 do + ar.SetValue(items.[i], i) + constructor t ar |> Ok + | Error er -> Error er - and private makeUnion extra caseStrategy t name (path : string) (values: JsonValue[]) = + and private makeUnion extra t name (path : string) (values: JsonValue[]) = let uci = FSharpType.GetUnionCases(t, allowAccessToPrivateRepresentation=true) |> Array.tryFind (fun x -> x.Name = name) @@ -1090,34 +1135,37 @@ module Decode = if values.Length = 0 then FSharpValue.MakeUnion(uci, [||], allowAccessToPrivateRepresentation=true) |> Ok else - let decoders = uci.GetFields() |> Array.map (fun fi -> autoDecoder extra caseStrategy false fi.PropertyType) + let decoders = uci.GetFields() |> Array.map (fun fi -> autoDecoder extra false fi.PropertyType) mixedArray "union fields" decoders path values |> Result.map (fun values -> FSharpValue.MakeUnion(uci, List.toArray values, allowAccessToPrivateRepresentation=true)) - and private autoDecodeRecordsAndUnions extra (caseStrategy : CaseStrategy) (isOptional : bool) (t: System.Type): BoxedDecoder = + and private autoDecodeRecordsAndUnions extra (isOptional : bool) (t: System.Type): BoxedDecoder = // Add the decoder to extra in case one of the fields is recursive let decoderRef = ref Unchecked.defaultof<_> - let extra = extra |> Map.add t.FullName decoderRef + let extra = { extra with Decoders = extra.Decoders |> Map.add t.FullName decoderRef } let decoder = if FSharpType.IsRecord(t, allowAccessToPrivateRepresentation=true) then + let fieldDecoders = + Map.tryFind t.FullName extra.FieldDecoders + |> Option.defaultValue Map.empty let decoders = FSharpType.GetRecordFields(t, allowAccessToPrivateRepresentation=true) |> Array.map (fun fi -> - let name = Util.Casing.convert caseStrategy fi.Name - name, autoDecoder extra caseStrategy false fi.PropertyType) + let name = Util.Casing.convert extra.CaseStrategy fi.Name + name, autoDecoder extra false fi.PropertyType) boxDecoder(fun path value -> - autoObject decoders path value + autoObject decoders fieldDecoders path value |> Result.map (fun xs -> FSharpValue.MakeRecord(t, List.toArray xs, allowAccessToPrivateRepresentation=true))) elif FSharpType.IsUnion(t, allowAccessToPrivateRepresentation=true) then boxDecoder(fun path (value: JsonValue) -> if Helpers.isString(value) then let name = Helpers.asString value - makeUnion extra caseStrategy t name path [||] + makeUnion extra t name path [||] elif Helpers.isArray(value) then let values = Helpers.asArray value let name = Helpers.asString values.[0] - makeUnion extra caseStrategy t name path values.[1..] + makeUnion extra t name path values.[1..] else (path, BadPrimitive("a string or array", value)) |> Error) else if isOptional then @@ -1129,26 +1177,17 @@ module Decode = decoderRef := decoder decoder - - and private autoDecoder (extra: Map>) caseStrategy (isOptional : bool) (t: System.Type) : BoxedDecoder = + and private autoDecoder (extra: DecodeAutoExtra) (isOptional : bool) (t: System.Type) : BoxedDecoder = let fullname = t.FullName - match Map.tryFind fullname extra with + match Map.tryFind fullname extra.Decoders with | Some decoderRef -> boxDecoder(fun path value -> decoderRef.contents.BoxedDecoder path value) | None -> if t.IsArray then let elemType = t.GetElementType() - let decoder = autoDecoder extra caseStrategy false elemType - boxDecoder(fun path value -> - match array decoder.BoxedDecoder path value with - | Ok items -> - let ar = System.Array.CreateInstance(elemType, items.Length) - for i = 0 to ar.Length - 1 do - ar.SetValue(items.[i], i) - Ok ar - | Error er -> Error er) + autoDecoder extra false elemType |> genericArray elemType |> boxDecoder elif t.IsGenericType then if FSharpType.IsTuple(t) then - let decoders = FSharpType.GetTupleElements(t) |> Array.map (autoDecoder extra caseStrategy false) + let decoders = FSharpType.GetTupleElements(t) |> Array.map (autoDecoder extra false) boxDecoder(fun path value -> if Helpers.isArray value then mixedArray "tuple elements" decoders path (Helpers.asArray value) @@ -1157,28 +1196,22 @@ module Decode = else let fullname = t.GetGenericTypeDefinition().FullName if fullname = typedefof.FullName then - autoDecoder extra caseStrategy true t.GenericTypeArguments.[0] |> genericOption t |> boxDecoder + autoDecoder extra true t.GenericTypeArguments.[0] |> genericOption t |> boxDecoder elif fullname = typedefof.FullName then - autoDecoder extra caseStrategy false t.GenericTypeArguments.[0] |> genericList t |> boxDecoder - // I don't know for now how to support seq - // elif fullname = typedefof.FullName then - // autoDecoder extra caseStrategy false t.GenericTypeArguments.[0] |> genericSeq t |> boxDecoder + autoDecoder extra false t.GenericTypeArguments.[0] |> genericList t |> boxDecoder + elif fullname = typedefof.FullName then + let elemType = t.GenericTypeArguments.[0] + autoDecoder extra false elemType |> genericArray elemType |> boxDecoder elif fullname = typedefof< Map >.FullName then - genericMap extra caseStrategy t |> boxDecoder + autoDecodeMapOrDict (fun t _ _ kvs -> System.Activator.CreateInstance(t, kvs)) extra t |> boxDecoder + elif fullname = typedefof< System.Collections.Generic.Dictionary >.FullName then + autoDecodeMapOrDict genericDict extra t |> boxDecoder elif fullname = typedefof< Set >.FullName then - let t = t.GenericTypeArguments.[0] - let decoder = autoDecoder extra caseStrategy false t - boxDecoder(fun path value -> - match array decoder.BoxedDecoder path value with - | Ok items -> - let ar = System.Array.CreateInstance(t, items.Length) - for i = 0 to ar.Length - 1 do - ar.SetValue(items.[i], i) - let setType = typedefof< Set >.MakeGenericType([|t|]) - System.Activator.CreateInstance(setType, ar) |> Ok - | Error er -> Error er) + autoDecodeSetOrHashSet (fun t kvs -> System.Activator.CreateInstance(t, kvs)) extra t |> boxDecoder + elif fullname = typedefof< System.Collections.Generic.HashSet >.FullName then + autoDecodeSetOrHashSet genericHashSet extra t |> boxDecoder else - autoDecodeRecordsAndUnions extra caseStrategy isOptional t + autoDecodeRecordsAndUnions extra isOptional t elif t.IsEnum then let enumType = System.Enum.GetUnderlyingType(t).FullName if enumType = typeof.FullName then @@ -1196,7 +1229,7 @@ module Decode = else failwithf """Cannot generate auto decoder for %s. -Thoth.Json.Net only support the folluwing enum types: +Thoth.Json.Net only support the following enum types: - sbyte - byte - int16 @@ -1251,13 +1284,20 @@ If you can't use one of these types, please pass an extra decoder. boxDecoder (fun _ v -> if Helpers.isNullValue v then Ok(null: obj) else v.Value() |> Ok) - else autoDecodeRecordsAndUnions extra caseStrategy isOptional t - - let private makeExtra (extra: ExtraCoders option) = - match extra with - | None -> Map.empty - | Some e -> Map.map (fun _ (_,dec) -> ref dec) e.Coders - + else autoDecodeRecordsAndUnions extra isOptional t + + let private makeExtra (extra: ExtraCoders option) caseStrategy = + let decoders = + extra |> Option.map (fun e -> e.Coders |> Map.map (fun _ (_,dec) -> ref dec)) + let fieldDecoders = + extra |> Option.map (fun e -> + e.FieldDecoders |> Map.map (fun _ kvs -> + kvs |> Seq.map (fun kv -> Util.Casing.convert caseStrategy kv.Key, kv.Value) |> Map)) + { + CaseStrategy = caseStrategy + Decoders = defaultArg decoders Map.empty + FieldDecoders = defaultArg fieldDecoders Map.empty + } module Auto = /// This API is only implemented inside Thoth.Json.Net for now @@ -1274,7 +1314,7 @@ If you can't use one of these types, please pass an extra decoder. let decoderCrate = Cache.Decoders.Value.GetOrAdd(key, fun _ -> - autoDecoder (makeExtra extra) caseStrategy false t) + autoDecoder (makeExtra extra caseStrategy) false t) fun path token -> match decoderCrate.Decode(path, token) with @@ -1283,7 +1323,7 @@ If you can't use one of these types, please pass an extra decoder. static member generateDecoder<'T> (t: System.Type, ?caseStrategy : CaseStrategy, ?extra: ExtraCoders): Decoder<'T> = let caseStrategy = defaultArg caseStrategy PascalCase - let decoderCrate = autoDecoder (makeExtra extra) caseStrategy false t + let decoderCrate = autoDecoder (makeExtra extra caseStrategy) false t fun path token -> match decoderCrate.Decode(path, token) with | Ok x -> Ok(x :?> 'T) diff --git a/src/Encode.fs b/src/Encode.fs index cfff75a..618106c 100644 --- a/src/Encode.fs +++ b/src/Encode.fs @@ -347,6 +347,11 @@ module Encode = open FSharp.Reflection + type private EncodeAutoExtra = + { Encoders: Map> + FieldEncoders: Map> + 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 (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,18 +477,42 @@ module Encode = ar.Add(encoder.Encode(x)) ar :> JsonValue) - and private autoEncoder (extra: Map>) 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>.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) @@ -482,42 +520,22 @@ module Encode = let fullname = t.GetGenericTypeDefinition().FullName if fullname = typedefof.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.FullName - || fullname = typedefof>.FullName then - // I don't know how to support seq for now. - // || fullname = typedefof.FullName - t.GenericTypeArguments.[0] |> autoEncoder extra caseStrategy skipNullField |> genericSeq - elif fullname = typedefof< Map >.FullName then - let keyType = t.GenericTypeArguments.[0] - let valueType = t.GenericTypeArguments.[1] - let valueEncoder = valueType |> autoEncoder extra caseStrategy skipNullField - let kvProps = typedefof>.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>.FullName + || fullname = typedefof>.FullName + || fullname = typedefof.FullName then + t.GenericTypeArguments.[0] |> autoEncoder extra skipNullField |> genericSeq + elif fullname = typedefof< Map >.FullName + || fullname = typedefof< Dictionary >.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.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.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 diff --git a/src/Extra.fs b/src/Extra.fs index 65b92b0..dc40352 100644 --- a/src/Extra.fs +++ b/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 diff --git a/src/Types.fs b/src/Types.fs index dd8d768..ba2c7e1 100644 --- a/src/Types.fs +++ b/src/Types.fs @@ -36,9 +36,25 @@ type BoxedEncoder() = abstract Encode: value: obj -> JsonValue member this.BoxedEncoder: Encoder = 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 } + Coders: Map + FieldDecoders: Map> + FieldEncoders: Map> } module internal Cache = open System