From 8de403d185b92460683d63593145feede642eefd Mon Sep 17 00:00:00 2001 From: Tuomas Hietanen Date: Thu, 9 Nov 2023 10:33:03 +0000 Subject: [PATCH 1/2] Performance optimizations: Use Structs for faster execution and smaller memory footprint --- FSharp.Json/Core.fs | 112 +++++++++++++++------- FSharp.Json/InterfaceTypes.fs | 7 +- FSharp.Json/JsonValue.fs | 10 +- FSharp.Json/JsonValueHelpers.fs | 165 +++++++++++++++++--------------- FSharp.Json/TextConversions.fs | 20 ++-- FSharp.Json/Utils.fs | 4 +- 6 files changed, 189 insertions(+), 129 deletions(-) diff --git a/FSharp.Json/Core.fs b/FSharp.Json/Core.fs index 6b7af4f..6e47ad1 100644 --- a/FSharp.Json/Core.fs +++ b/FSharp.Json/Core.fs @@ -191,8 +191,7 @@ module internal Core = let items = values.Cast() |> Seq.map (fun value -> - serializeUnwrapOption (getType value) JsonField.Default value) - |> Seq.map (Option.defaultValue JsonValue.Null) + serializeUnwrapOption (getType value) JsonField.Default value |> Option.defaultValue JsonValue.Null) items |> Array.ofSeq |> JsonValue.Array let serializeTupleItems (types: Type seq) (values: IEnumerable): JsonValue = @@ -200,8 +199,7 @@ module internal Core = values.Cast() |> Seq.zip types |> Seq.map (fun (t, value) -> - serializeUnwrapOption t JsonField.Default value) - |> Seq.map (Option.defaultValue JsonValue.Null) + serializeUnwrapOption t JsonField.Default value |> Option.defaultValue JsonValue.Null) items |> Array.ofSeq |> JsonValue.Array let serializeKvpEnumerable (kvps: IEnumerable): JsonValue = @@ -299,17 +297,22 @@ module internal Core = | EnumMode.Value -> match baseT with | baseT when baseT = typeof -> - let enumValue = JsonValueHelpers.getInt path jvalue - Enum.ToObject(t, enumValue) + match jvalue with + | JsonValueHelpers.GetInt enumValue -> Enum.ToObject(t, enumValue) + | _ -> JsonValueHelpers.raiseWrongType path "int" jvalue | baseT when baseT = typeof -> - let enumValue = JsonValueHelpers.getByte path jvalue - Enum.ToObject(t, enumValue) + match jvalue with + | JsonValueHelpers.GetByte enumValue -> Enum.ToObject(t, enumValue) + | _ -> JsonValueHelpers.raiseWrongType path "byte" jvalue | baseT when baseT = typeof -> - let enumValue = JsonValueHelpers.getChar path jvalue - Enum.ToObject(t, enumValue) + match jvalue with + | JsonValueHelpers.GetChar enumValue -> Enum.ToObject(t, enumValue) + | JsonValueHelpers.GetString v when v.Length > 1 -> raise(JsonDeserializationError(path, sprintf "Expected string with single character, got jvalue: %s" v)) + | _ -> JsonValueHelpers.raiseWrongType path "char" jvalue | EnumMode.Name -> - let valueStr = JsonValueHelpers.getString path jvalue - Enum.Parse(t, valueStr) + match jvalue with + | JsonValueHelpers.GetString valueStr -> Enum.Parse(t, valueStr) + | _ -> JsonValueHelpers.raiseWrongType path "string" jvalue | mode -> failDeserialization path <| sprintf "Failed to deserialize enum %s, unsupported enum mode: %A" t.Name mode let getUntypedType (path: JsonPath) (t: Type) (jvalue: JsonValue): Type = @@ -333,41 +336,78 @@ module internal Core = let jvalue = match t with | t when t = typeof -> - JsonValueHelpers.getInt16 path jvalue :> obj + match jvalue with + | JsonValueHelpers.GetInt16 v -> v :> obj + | _ -> JsonValueHelpers.raiseWrongType path "int16" jvalue | t when t = typeof -> - JsonValueHelpers.getUInt16 path jvalue :> obj + match jvalue with + | JsonValueHelpers.GetUInt16 v -> v :> obj + | _ -> JsonValueHelpers.raiseWrongType path "uint16" jvalue | t when t = typeof -> - JsonValueHelpers.getInt path jvalue :> obj + match jvalue with + | JsonValueHelpers.GetInt v -> v :> obj + | _ -> JsonValueHelpers.raiseWrongType path "int" jvalue | t when t = typeof -> - JsonValueHelpers.getUInt32 path jvalue :> obj + match jvalue with + | JsonValueHelpers.GetUInt32 v -> v :> obj + | _ -> JsonValueHelpers.raiseWrongType path "uint32" jvalue | t when t = typeof -> - JsonValueHelpers.getInt64 path jvalue :> obj + match jvalue with + | JsonValueHelpers.GetInt64 v -> v :> obj + | _ -> JsonValueHelpers.raiseWrongType path "int64" jvalue | t when t = typeof -> - JsonValueHelpers.getUInt64 path jvalue :> obj + match jvalue with + | JsonValueHelpers.GetUInt64 v -> v :> obj + | _ -> JsonValueHelpers.raiseWrongType path "uint64" jvalue | t when t = typeof -> - JsonValueHelpers.getBigint path jvalue :> obj + match jvalue with + | JsonValueHelpers.GetBigint v -> v :> obj + | _ -> JsonValueHelpers.raiseWrongType path "bigint" jvalue | t when t = typeof -> - JsonValueHelpers.getSingle path jvalue :> obj + match jvalue with + | JsonValueHelpers.GetSingle v -> v :> obj + | _ -> JsonValueHelpers.raiseWrongType path "single" jvalue | t when t = typeof -> - JsonValueHelpers.getFloat path jvalue :> obj + match jvalue with + | JsonValueHelpers.GetFloat v -> v :> obj + | _ -> JsonValueHelpers.raiseWrongType path "float" jvalue | t when t = typeof -> - JsonValueHelpers.getDecimal path jvalue :> obj + match jvalue with + | JsonValueHelpers.GetDecimal v -> v :> obj + | _ -> JsonValueHelpers.raiseWrongType path "decimal" jvalue | t when t = typeof -> - JsonValueHelpers.getByte path jvalue :> obj + match jvalue with + | JsonValueHelpers.GetByte v -> v :> obj + | _ -> JsonValueHelpers.raiseWrongType path "byte" jvalue | t when t = typeof -> - JsonValueHelpers.getSByte path jvalue :> obj + match jvalue with + | JsonValueHelpers.GetSByte v -> v :> obj + | _ -> JsonValueHelpers.raiseWrongType path "sbyte" jvalue | t when t = typeof -> - JsonValueHelpers.getBool path jvalue :> obj + match jvalue with + | JsonValueHelpers.GetBool v -> v :> obj + | _ -> JsonValueHelpers.raiseWrongType path "bool" jvalue | t when t = typeof -> - JsonValueHelpers.getString path jvalue :> obj + match jvalue with + | JsonValueHelpers.GetString v -> v :> obj + | _ -> JsonValueHelpers.raiseWrongType path "string" jvalue | t when t = typeof -> - JsonValueHelpers.getChar path jvalue :> obj + match jvalue with + | JsonValueHelpers.GetChar v -> v :> obj + | JsonValueHelpers.GetString v when v.Length > 1 -> raise(JsonDeserializationError(path, sprintf "Expected string with single character, got jvalue: %s" v)) + | _ -> JsonValueHelpers.raiseWrongType path "char" jvalue | t when t = typeof -> - JsonValueHelpers.getDateTime CultureInfo.InvariantCulture path jvalue :> obj + match jvalue with + | JsonValueHelpers.GetDateTime CultureInfo.InvariantCulture v -> v :> obj + | _ -> JsonValueHelpers.raiseWrongType path "DateTime" jvalue | t when t = typeof -> - JsonValueHelpers.getDateTimeOffset CultureInfo.InvariantCulture path jvalue :> obj + match jvalue with + | JsonValueHelpers.GetDateTimeOffset CultureInfo.InvariantCulture v -> v :> obj + | _ -> JsonValueHelpers.raiseWrongType path "DateTimeOffset" jvalue | t when t = typeof -> - JsonValueHelpers.getGuid path jvalue :> obj + match jvalue with + | JsonValueHelpers.GetGuid v -> v :> obj + | _ -> JsonValueHelpers.raiseWrongType path "Guid" jvalue | t when t.IsEnum -> deserializeEnum path t jsonField jvalue | t when isTuple t || isList t || isArray t || isMap t || isRecord t || isUnion t -> @@ -522,14 +562,16 @@ module internal Core = | UnionMode.CaseKeyDiscriminatorField -> let caseKeyFieldName, caseKeyFieldValue = mustFindField path jsonUnion.CaseKeyField fields let caseNamePath = caseKeyFieldName |> JsonPathItem.Field |> path.createNew - let jCaseName = caseKeyFieldValue |> JsonValueHelpers.getString caseNamePath - makeUnion path t jCaseName jvalue + match caseKeyFieldValue with + | JsonValueHelpers.GetString jCaseName -> makeUnion path t jCaseName jvalue + | _ -> JsonValueHelpers.raiseWrongType path "string" jvalue | UnionMode.CaseKeyAsFieldValue -> let caseKeyFieldName, caseKeyFieldValue = mustFindField path jsonUnion.CaseKeyField fields let _, jCaseValue = mustFindField path jsonUnion.CaseValueField fields - let caseNamePath = caseKeyFieldName |> JsonPathItem.Field |> path.createNew - let jCaseName = caseKeyFieldValue |> JsonValueHelpers.getString caseNamePath - makeUnion path t jCaseName jCaseValue + let caseNamePath = caseKeyFieldName |> JsonPathItem.Field |> path.createNew + match caseKeyFieldValue with + | JsonValueHelpers.GetString jCaseName -> makeUnion path t jCaseName jCaseValue + | _ -> JsonValueHelpers.raiseWrongType path "string" jvalue | UnionMode.CaseKeyAsFieldName -> match fields with | [| (jCaseName, jCaseValue) |] -> diff --git a/FSharp.Json/InterfaceTypes.fs b/FSharp.Json/InterfaceTypes.fs index c8ce7a5..c50d79d 100644 --- a/FSharp.Json/InterfaceTypes.fs +++ b/FSharp.Json/InterfaceTypes.fs @@ -77,11 +77,12 @@ with /// Represents one item in [JsonPath] +[] type JsonPathItem = /// Field in JSON object. - | Field of string + | Field of field: string /// Item in JSON array. - | ArrayItem of int + | ArrayItem of itm: int /// Represents path in JSON structure type JsonPath = { @@ -119,6 +120,7 @@ type JsonDeserializationError(path: JsonPath, message: string) = member e.Path = path /// Modes of serialization of option None value +[] type SerializeNone = /// Serialize None value as null in JSON. | Null @@ -126,6 +128,7 @@ type SerializeNone = | Omit /// Modes of deserialization of option types +[] type DeserializeOption = /// Allow members with None value to be omitted in JSON. | AllowOmit diff --git a/FSharp.Json/JsonValue.fs b/FSharp.Json/JsonValue.fs index cfad05e..bc1a7d1 100644 --- a/FSharp.Json/JsonValue.fs +++ b/FSharp.Json/JsonValue.fs @@ -212,7 +212,7 @@ type private JsonParser(jsonText:string, cultureInfo, tolerateErrors) = elif d >= 'A' && d <= 'F' then int32 d - int32 'A' + 10 else failwith "hexdigit" let unicodeChar (s:string) = - if s.Length <> 4 then failwith "unicodeChar"; + if s.Length <> 4 then failwithf "unicodeChar (%s)" s; char (hexdigit s.[0] * 4096 + hexdigit s.[1] * 256 + hexdigit s.[2] * 16 + hexdigit s.[3]) let ch = unicodeChar (s.Substring(i+2, 4)) buf.Append(ch) |> ignore @@ -220,8 +220,8 @@ type private JsonParser(jsonText:string, cultureInfo, tolerateErrors) = | 'U' -> ensure(i+9 < s.Length) let unicodeChar (s:string) = - if s.Length <> 8 then failwith "unicodeChar"; - if s.[0..1] <> "00" then failwith "unicodeChar"; + if s.Length <> 8 then failwithf "unicodeChar (%s)" s; + if s.[0..1] <> "00" then failwithf "unicodeChar (%s)" s; UnicodeHelper.getUnicodeSurrogatePair <| System.UInt32.Parse(s, NumberStyles.HexNumber) let lead, trail = unicodeChar (s.Substring(i+2, 8)) buf.Append(lead) |> ignore @@ -245,10 +245,10 @@ type private JsonParser(jsonText:string, cultureInfo, tolerateErrors) = let len = i - start let sub = s.Substring(start,len) match TextConversions.AsDecimal cultureInfo sub with - | Some x -> JsonValue.Number x + | ValueSome x -> JsonValue.Number x | _ -> match TextConversions.AsFloat [| |] (*useNoneForMissingValues*)false cultureInfo sub with - | Some x -> JsonValue.Float x + | ValueSome x -> JsonValue.Float x | _ -> throw() and parsePair() = diff --git a/FSharp.Json/JsonValueHelpers.fs b/FSharp.Json/JsonValueHelpers.fs index 7e8ae30..d3e7277 100644 --- a/FSharp.Json/JsonValueHelpers.fs +++ b/FSharp.Json/JsonValueHelpers.fs @@ -8,124 +8,137 @@ module internal JsonValueHelpers = let raiseWrongType path typeName jvalue = raise(JsonDeserializationError(path, sprintf "Expected type %s is incompatible with jvalue: %A" typeName jvalue)) - let getInt16 (path: JsonPath) (jvalue: JsonValue) = + [] + let (|GetInt16|_|) (jvalue: JsonValue) = match jvalue with - | JsonValue.Number value -> int16 value - | JsonValue.Float value -> int16 value - | _ -> raiseWrongType path "int16" jvalue + | JsonValue.Number value -> ValueSome (int16 value) + | JsonValue.Float value -> ValueSome (int16 value) + | _ -> ValueNone - let getUInt16 (path: JsonPath) (jvalue: JsonValue) = + [] + let (|GetUInt16|_|) (jvalue: JsonValue) = match jvalue with - | JsonValue.Number value -> uint16 value - | JsonValue.Float value -> uint16 value - | _ -> raiseWrongType path "uint16" jvalue + | JsonValue.Number value -> ValueSome (uint16 value) + | JsonValue.Float value -> ValueSome (uint16 value) + | _ -> ValueNone - let getInt (path: JsonPath) (jvalue: JsonValue) = + [] + let (|GetInt|_|) (jvalue: JsonValue) = match jvalue with - | JsonValue.Number value -> int value - | JsonValue.Float value -> int value - | _ -> raiseWrongType path "int" jvalue + | JsonValue.Number value -> ValueSome (int value) + | JsonValue.Float value -> ValueSome (int value) + | _ -> ValueNone - let getUInt32 (path: JsonPath) (jvalue: JsonValue) = + [] + let (|GetUInt32|_|) (jvalue: JsonValue) = match jvalue with - | JsonValue.Number value -> uint32 value - | JsonValue.Float value -> uint32 value - | _ -> raiseWrongType path "uint32" jvalue + | JsonValue.Number value -> ValueSome (uint32 value) + | JsonValue.Float value -> ValueSome (uint32 value) + | _ -> ValueNone - let getInt64 (path: JsonPath) (jvalue: JsonValue) = + [] + let (|GetInt64|_|) (jvalue: JsonValue) = match jvalue with - | JsonValue.Number value -> int64 value - | JsonValue.Float value -> int64 value - | _ -> raiseWrongType path "int64" jvalue + | JsonValue.Number value -> ValueSome (int64 value) + | JsonValue.Float value -> ValueSome (int64 value) + | _ -> ValueNone - let getUInt64 (path: JsonPath) (jvalue: JsonValue) = + [] + let (|GetUInt64|_|) (jvalue: JsonValue) = match jvalue with - | JsonValue.Number value -> uint64 value - | JsonValue.Float value -> uint64 value - | _ -> raiseWrongType path "uint64" jvalue + | JsonValue.Number value -> ValueSome (uint64 value) + | JsonValue.Float value -> ValueSome (uint64 value) + | _ -> ValueNone - let getBigint (path: JsonPath) (jvalue: JsonValue) = + [] + let (|GetBigint|_|) (jvalue: JsonValue) = match jvalue with - | JsonValue.Number value -> bigint value - | JsonValue.Float value -> bigint value - | _ -> raiseWrongType path "bigint" jvalue + | JsonValue.Number value -> ValueSome (bigint value) + | JsonValue.Float value -> ValueSome (bigint value) + | _ -> ValueNone - let getSingle (path: JsonPath) (jvalue: JsonValue) = + [] + let (|GetSingle|_|) (jvalue: JsonValue) = match jvalue with - | JsonValue.Float value -> single value - | JsonValue.Number value -> single value - | _ -> raiseWrongType path "single" jvalue + | JsonValue.Float value -> ValueSome (single value) + | JsonValue.Number value -> ValueSome (single value) + | _ -> ValueNone - let getFloat (path: JsonPath) (jvalue: JsonValue) = + [] + let (|GetFloat|_|) (jvalue: JsonValue) = match jvalue with - | JsonValue.Float value -> value - | JsonValue.Number value -> float value - | _ -> raiseWrongType path "float" jvalue + | JsonValue.Float value -> ValueSome value + | JsonValue.Number value -> ValueSome (float value) + | _ -> ValueNone - let getDecimal (path: JsonPath) (jvalue: JsonValue) = + [] + let (|GetDecimal|_|) (jvalue: JsonValue) = match jvalue with - | JsonValue.Number value -> value - | JsonValue.Float value -> decimal value - | _ -> raiseWrongType path "decimal" jvalue + | JsonValue.Number value -> ValueSome value + | JsonValue.Float value -> ValueSome (decimal value) + | _ -> ValueNone - let getByte (path: JsonPath) (jvalue: JsonValue) = + [] + let (|GetByte|_|) (jvalue: JsonValue) = match jvalue with - | JsonValue.Number value -> byte value - | JsonValue.Float value -> byte value - | _ -> raiseWrongType path "byte" jvalue + | JsonValue.Number value -> ValueSome (byte value) + | JsonValue.Float value -> ValueSome (byte value) + | _ -> ValueNone - let getSByte (path: JsonPath) (jvalue: JsonValue) = + [] + let (|GetSByte|_|) (jvalue: JsonValue) = match jvalue with - | JsonValue.Number value -> sbyte value - | JsonValue.Float value -> sbyte value - | _ -> raiseWrongType path "sbyte" jvalue + | JsonValue.Number value -> ValueSome (sbyte value) + | JsonValue.Float value -> ValueSome (sbyte value) + | _ -> ValueNone - let getBool (path: JsonPath) (jvalue: JsonValue) = + [] + let (|GetBool|_|) (jvalue: JsonValue) = match jvalue with - | JsonValue.Boolean value -> value - | _ -> raiseWrongType path "bool" jvalue + | JsonValue.Boolean value -> ValueSome value + | _ -> ValueNone - let getString (path: JsonPath) (jvalue: JsonValue) = + [] + let (|GetString|_|) (jvalue: JsonValue) = match jvalue with - | JsonValue.String value -> value - | _ -> raiseWrongType path "string" jvalue + | JsonValue.String value -> ValueSome value + | _ -> ValueNone - let getChar (path: JsonPath) (jvalue: JsonValue) = + [] + let (|GetChar|_|) (jvalue: JsonValue) = match jvalue with | JsonValue.String value -> match value.Length with - | 1 -> value.Chars(0) - | _ -> raise(JsonDeserializationError(path, sprintf "Expected string with single character, got jvalue: %s" value)) - | _ -> raiseWrongType path "char" jvalue + | 1 -> ValueSome (value.Chars 0) + | _ -> ValueNone + | _ -> ValueNone - let getDateTime cultureInfo (path: JsonPath) (jvalue: JsonValue) = + [] + let (|GetDateTime|_|) cultureInfo (jvalue: JsonValue) = match jvalue with | JsonValue.String value -> let jvalue = TextConversions.AsDateTime cultureInfo value - match jvalue with - | Some jvalue -> jvalue - | None -> raiseWrongType path "DateTime" jvalue - | _ -> raiseWrongType path "DateTime" jvalue + jvalue + | _ -> ValueNone - let getDateTimeOffset cultureInfo (path: JsonPath) (jvalue: JsonValue) = + [] + let (|GetDateTimeOffset|_|) cultureInfo (jvalue: JsonValue) = match jvalue with | JsonValue.String value -> let jvalue = AsDateTimeOffset cultureInfo value - match jvalue with - | Some jvalue -> jvalue - | None -> raiseWrongType path "DateTimeOffset" jvalue - | _ -> raiseWrongType path "DateTimeOffset" jvalue + jvalue + | _ -> ValueNone - let getGuid (path: JsonPath) (jvalue: JsonValue) = + [] + let (|GetGuid|_|) (jvalue: JsonValue) = match jvalue with | JsonValue.String value -> let jvalue = TextConversions.AsGuid value - match jvalue with - | Some jvalue -> jvalue - | None -> raiseWrongType path "Guid" jvalue - | _ -> raiseWrongType path "Guid" jvalue + jvalue + | _ -> ValueNone - let getArray (path: JsonPath) (jvalue: JsonValue) = + [] + let (|GetArray|_|) (jvalue: JsonValue) = match jvalue with - | JsonValue.Array arr -> arr - | _ -> raiseWrongType path "array" jvalue + | JsonValue.Array arr -> ValueSome arr + | _ -> ValueNone diff --git a/FSharp.Json/TextConversions.fs b/FSharp.Json/TextConversions.fs index 3d8477b..a9bd40b 100644 --- a/FSharp.Json/TextConversions.fs +++ b/FSharp.Json/TextConversions.fs @@ -14,14 +14,16 @@ open System.Text.RegularExpressions module private Helpers = /// Convert the result of TryParse to option type - let asOption = function true, v -> Some v | _ -> None + let asOption = function true, v -> ValueSome v | _ -> ValueNone + [] let (|StringEqualsIgnoreCase|_|) (s1:string) s2 = if s1.Equals(s2, StringComparison.OrdinalIgnoreCase) - then Some () else None + then ValueSome () else ValueNone + [] let (|OneOfIgnoreCase|_|) set str = - if Array.exists (fun s -> StringComparer.OrdinalIgnoreCase.Compare(s, str) = 0) set then Some() else None + if Array.exists (fun s -> StringComparer.OrdinalIgnoreCase.Compare(s, str) = 0) set then ValueSome() else ValueNone let regexOptions = #if FX_NO_REGEX_COMPILATION @@ -73,10 +75,10 @@ type internal TextConversions private() = /// if useNoneForMissingValues is true, NAs are returned as None, otherwise Some Double.NaN is used static member AsFloat missingValues useNoneForMissingValues cultureInfo (text:string) = match text.Trim() with - | OneOfIgnoreCase missingValues -> if useNoneForMissingValues then None else Some Double.NaN + | OneOfIgnoreCase missingValues -> if useNoneForMissingValues then ValueNone else ValueSome Double.NaN | _ -> Double.TryParse(text, NumberStyles.Any, cultureInfo) |> asOption - |> Option.bind (fun f -> if useNoneForMissingValues && Double.IsNaN f then None else Some f) + |> ValueOption.bind (fun f -> if useNoneForMissingValues && Double.IsNaN f then ValueNone else ValueSome f) static member AsBoolean (text:string) = match text.Trim() with @@ -94,17 +96,17 @@ type internal TextConversions private() = matchesMS.Groups.[1].Value |> Double.Parse |> DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc).AddMilliseconds - |> Some + |> ValueSome else // Parse ISO 8601 format, fixing time zone if needed let dateTimeStyles = DateTimeStyles.AllowWhiteSpaces ||| DateTimeStyles.RoundtripKind match DateTime.TryParse(text, cultureInfo, dateTimeStyles) with | true, d -> if d.Kind = DateTimeKind.Unspecified then - new DateTime(d.Ticks, DateTimeKind.Local) |> Some + new DateTime(d.Ticks, DateTimeKind.Local) |> ValueSome else - Some d - | _ -> None + ValueSome d + | _ -> ValueNone static member AsGuid (text:string) = Guid.TryParse(text.Trim()) |> asOption diff --git a/FSharp.Json/Utils.fs b/FSharp.Json/Utils.fs index 4b3a877..5d6cc0e 100644 --- a/FSharp.Json/Utils.fs +++ b/FSharp.Json/Utils.fs @@ -8,5 +8,5 @@ module internal Conversions = // Parse ISO 8601 format, fixing time zone if needed let dateTimeStyles = DateTimeStyles.AllowWhiteSpaces ||| DateTimeStyles.RoundtripKind ||| DateTimeStyles.AssumeUniversal match DateTimeOffset.TryParse(text, cultureInfo, dateTimeStyles) with - | true, d -> Some d - | _ -> None + | true, d -> ValueSome d + | _ -> ValueNone From a67eaa64fb6169f3ed445fc57c75fd99bd3f66eb Mon Sep 17 00:00:00 2001 From: Tuomas Hietanen Date: Thu, 9 Nov 2023 12:00:19 +0000 Subject: [PATCH 2/2] less function nesting, more valuetypes --- FSharp.Json/Core.fs | 85 +++++++++++++++++----------------- FSharp.Json/FSharp.Json.fsproj | 5 +- FSharp.Json/Reflection.fs | 6 +-- 3 files changed, 50 insertions(+), 46 deletions(-) diff --git a/FSharp.Json/Core.fs b/FSharp.Json/Core.fs index 6e47ad1..6ce63d7 100644 --- a/FSharp.Json/Core.fs +++ b/FSharp.Json/Core.fs @@ -72,40 +72,41 @@ module internal Core = let failSerialization (message: string) = raise (new JsonSerializationError(message)) - let rec serialize (config: JsonConfig) (t: Type) (value: obj): JsonValue = - let serializeEnum (t: Type) (jsonField: JsonField) (value: obj): JsonValue = - let baseT = Enum.GetUnderlyingType t - let enumMode = getEnumMode config jsonField - match enumMode with - | EnumMode.Value -> - match baseT with - | t when t = typeof -> - let enumValue = decimal (value :?> int) - JsonValue.Number enumValue - | t when t = typeof -> - let enumValue = decimal (value :?> byte) - JsonValue.Number enumValue - | t when t = typeof -> - let enumValue = sprintf "%c" (value :?> char) - JsonValue.String enumValue - | EnumMode.Name -> - let strvalue = Enum.GetName(t, value) - JsonValue.String strvalue - | mode -> failSerialization <| sprintf "Failed to serialize enum %s, unsupported enum mode: %A" t.Name mode + let internal serializeEnum config (t: Type) (jsonField: JsonField) (value: obj): JsonValue = + let baseT = Enum.GetUnderlyingType t + let enumMode = getEnumMode config jsonField + match enumMode with + | EnumMode.Value -> + match baseT with + | t when t = typeof -> + let enumValue = decimal (value :?> int) + JsonValue.Number enumValue + | t when t = typeof -> + let enumValue = decimal (value :?> byte) + JsonValue.Number enumValue + | t when t = typeof -> + let enumValue = sprintf "%c" (value :?> char) + JsonValue.String enumValue + | EnumMode.Name -> + let strvalue = Enum.GetName(t, value) + JsonValue.String strvalue + | mode -> failSerialization <| sprintf "Failed to serialize enum %s, unsupported enum mode: %A" t.Name mode + + let internal getUntypedType config (t: Type) (value: obj): Type = + if t = typeof then + if config.allowUntyped then + getType value + else + failSerialization <| "Failed to serialize untyped data, allowUntyped set to false" + else t - let getUntypedType (t: Type) (value: obj): Type = - if t = typeof then - if config.allowUntyped then - getType value - else - failSerialization <| "Failed to serialize untyped data, allowUntyped set to false" - else t + let rec serialize (config: JsonConfig) (t: Type) (value: obj): JsonValue = let serializeNonOption (t: Type) (jsonField: JsonField) (value: obj): JsonValue = match jsonField.AsJson with | false -> let t, value = transformToTargetType t value jsonField.Transform - let t = getUntypedType t value + let t = getUntypedType config t value match t with | t when t = typeof -> JsonValue.Null @@ -146,7 +147,7 @@ module internal Core = | t when t = typeof -> JsonValue.String ((value :?> Guid).ToString()) | t when t.IsEnum -> - serializeEnum t jsonField value + serializeEnum config t jsonField value | t when isTuple t || isList t || isArray t || isMap t || isRecord t || isUnion t -> serialize config t value | _ -> failSerialization <| sprintf "Unknown type: %s" t.Name @@ -157,25 +158,25 @@ module internal Core = with ex -> JsonValue.String value - let serializeUnwrapOption (t: Type) (jsonField: JsonField) (value: obj): JsonValue option = + let serializeUnwrapOption (t: Type) (jsonField: JsonField) (value: obj): JsonValue voption = match t with | t when isOption t -> let unwrapedValue = unwrapOption t value match unwrapedValue with - | Some value -> Some (serializeNonOption (getOptionType t) jsonField value) - | None -> + | ValueSome value -> ValueSome (serializeNonOption (getOptionType t) jsonField value) + | ValueNone -> match config.serializeNone with - | Null -> Some JsonValue.Null - | Omit -> None - | _ -> Some (serializeNonOption t jsonField value) + | Null -> ValueSome JsonValue.Null + | Omit -> ValueNone + | _ -> ValueSome (serializeNonOption t jsonField value) let serializeUnwrapOptionWithNull (t: Type) (jsonField: JsonField) (value: obj): JsonValue = match t with | t when isOption t -> let unwrapedValue = unwrapOption t value match unwrapedValue with - | Some value -> serializeNonOption (getOptionType t) jsonField value - | None -> JsonValue.Null + | ValueSome value -> serializeNonOption (getOptionType t) jsonField value + | ValueNone -> JsonValue.Null | _ -> serializeNonOption t jsonField value let serializeProperty (therec: obj) (prop: PropertyInfo): (string*JsonValue) option = @@ -184,14 +185,14 @@ module internal Core = let name = getJsonFieldName config jsonField prop let jvalue = serializeUnwrapOption prop.PropertyType jsonField propValue match jvalue with - | Some jvalue -> Some (name, jvalue) - | None -> None + | ValueSome jvalue -> Some (name, jvalue) + | ValueNone -> None let serializeEnumerable (values: IEnumerable): JsonValue = let items = values.Cast() |> Seq.map (fun value -> - serializeUnwrapOption (getType value) JsonField.Default value |> Option.defaultValue JsonValue.Null) + serializeUnwrapOption (getType value) JsonField.Default value |> ValueOption.defaultValue JsonValue.Null) items |> Array.ofSeq |> JsonValue.Array let serializeTupleItems (types: Type seq) (values: IEnumerable): JsonValue = @@ -199,7 +200,7 @@ module internal Core = values.Cast() |> Seq.zip types |> Seq.map (fun (t, value) -> - serializeUnwrapOption t JsonField.Default value |> Option.defaultValue JsonValue.Null) + serializeUnwrapOption t JsonField.Default value |> ValueOption.defaultValue JsonValue.Null) items |> Array.ofSeq |> JsonValue.Array let serializeKvpEnumerable (kvps: IEnumerable): JsonValue = @@ -209,7 +210,7 @@ module internal Core = let key = KvpKey kvp :?> string let value = KvpValue kvp let jvalue = serializeUnwrapOption (getType value) JsonField.Default value - (key, Option.defaultValue JsonValue.Null jvalue) + (key, ValueOption.defaultValue JsonValue.Null jvalue) ) props|> Array.ofSeq |> JsonValue.Record diff --git a/FSharp.Json/FSharp.Json.fsproj b/FSharp.Json/FSharp.Json.fsproj index ff632bb..74566c0 100644 --- a/FSharp.Json/FSharp.Json.fsproj +++ b/FSharp.Json/FSharp.Json.fsproj @@ -10,7 +10,10 @@ https://github.com/vsapronov/FSharp.Json 0.4.1 - + + true + true + diff --git a/FSharp.Json/Reflection.fs b/FSharp.Json/Reflection.fs index 9a6f789..bbb01bd 100644 --- a/FSharp.Json/Reflection.fs +++ b/FSharp.Json/Reflection.fs @@ -77,11 +77,11 @@ module internal Reflection = let getMapValueType: Type -> Type = getMapValueType_ |> cacheResult let getMapKvpTupleType: Type -> Type = getMapKvpTupleType_ |> cacheResult - let unwrapOption (t: Type) (value: obj): obj option = + let unwrapOption (t: Type) (value: obj): obj voption = let _, fields = FSharpValue.GetUnionFields(value, t) match fields.Length with - | 1 -> Some fields.[0] - | _ -> None + | 1 -> ValueSome fields.[0] + | _ -> ValueNone let optionNone (t: Type): obj = let casesInfos = getUnionCases t