From 434c04251068b02494453df748a711c662bf943b Mon Sep 17 00:00:00 2001 From: Patrick Stevens <3138005+Smaug123@users.noreply.github.com> Date: Mon, 1 Jul 2024 17:45:36 +0100 Subject: [PATCH] Omit upcasts where possible (#178) --- ConsumePlugin/GeneratedSerde.fs | 87 +++++++++++++++++++ .../SerializationAndDeserialization.fs | 14 +++ .../HttpClientGenerator.fs | 2 +- .../JsonSerializeGenerator.fs | 34 +++++--- 4 files changed, 126 insertions(+), 11 deletions(-) diff --git a/ConsumePlugin/GeneratedSerde.fs b/ConsumePlugin/GeneratedSerde.fs index 4604675..a2c3ff2 100644 --- a/ConsumePlugin/GeneratedSerde.fs +++ b/ConsumePlugin/GeneratedSerde.fs @@ -236,6 +236,55 @@ module FirstDuJsonSerializeExtension = node.Add ("data", dataNode) node :> _ +namespace ConsumePlugin + +open System +open System.Collections.Generic +open System.Text.Json.Serialization + +/// Module containing JSON serializing extension members for the HeaderAndValue type +[] +module HeaderAndValueJsonSerializeExtension = + /// Extension methods for JSON parsing + type HeaderAndValue with + + /// Serialize to a JSON node + static member toJsonNode (input : HeaderAndValue) : System.Text.Json.Nodes.JsonNode = + let node = System.Text.Json.Nodes.JsonObject () + + do + node.Add ("header", (input.Header |> System.Text.Json.Nodes.JsonValue.Create)) + node.Add ("value", (input.Value |> System.Text.Json.Nodes.JsonValue.Create)) + + node :> _ +namespace ConsumePlugin + +open System +open System.Collections.Generic +open System.Text.Json.Serialization + +/// Module containing JSON serializing extension members for the Foo type +[] +module FooJsonSerializeExtension = + /// Extension methods for JSON parsing + type Foo with + + /// Serialize to a JSON node + static member toJsonNode (input : Foo) : System.Text.Json.Nodes.JsonNode = + let node = System.Text.Json.Nodes.JsonObject () + + do + node.Add ( + "message", + (input.Message + |> (fun field -> + match field with + | None -> null :> System.Text.Json.Nodes.JsonNode + | Some field -> HeaderAndValue.toJsonNode field + )) + ) + + node :> _ namespace ConsumePlugin @@ -717,3 +766,41 @@ module FirstDuJsonParseExtension = .GetValue () ) | v -> failwith ("Unrecognised 'type' field value: " + v) +namespace ConsumePlugin + +/// Module containing JSON parsing extension members for the HeaderAndValue type +[] +module HeaderAndValueJsonParseExtension = + /// Extension methods for JSON parsing + type HeaderAndValue with + + /// Parse from a JSON node. + static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : HeaderAndValue = + let arg_1 = + (match node.["value"] with + | null -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("value") + ) + ) + | v -> v) + .AsValue() + .GetValue () + + let arg_0 = + (match node.["header"] with + | null -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("header") + ) + ) + | v -> v) + .AsValue() + .GetValue () + + { + Header = arg_0 + Value = arg_1 + } diff --git a/ConsumePlugin/SerializationAndDeserialization.fs b/ConsumePlugin/SerializationAndDeserialization.fs index 3940f49..720d1a1 100644 --- a/ConsumePlugin/SerializationAndDeserialization.fs +++ b/ConsumePlugin/SerializationAndDeserialization.fs @@ -57,3 +57,17 @@ type FirstDu = | EmptyCase | Case1 of data : string | Case2 of record : JsonRecordTypeWithBoth * i : int + +[] +[] +type HeaderAndValue = + { + Header : string + Value : string + } + +[] +type Foo = + { + Message : HeaderAndValue option + } diff --git a/WoofWare.Myriad.Plugins/HttpClientGenerator.fs b/WoofWare.Myriad.Plugins/HttpClientGenerator.fs index e7e51f1..d04b45a 100644 --- a/WoofWare.Myriad.Plugins/HttpClientGenerator.fs +++ b/WoofWare.Myriad.Plugins/HttpClientGenerator.fs @@ -449,7 +449,7 @@ module internal HttpClientGenerator = SynExpr.createNew (SynType.createLongIdent' [ "System" ; "Net" ; "Http" ; "StringContent" ]) (SynExpr.createIdent' bodyParamName - |> SynExpr.pipeThroughFunction (JsonSerializeGenerator.serializeNode ty) + |> SynExpr.pipeThroughFunction (fst (JsonSerializeGenerator.serializeNode ty)) |> SynExpr.pipeThroughFunction ( SynExpr.createLambda "node" diff --git a/WoofWare.Myriad.Plugins/JsonSerializeGenerator.fs b/WoofWare.Myriad.Plugins/JsonSerializeGenerator.fs index 004f8f5..e395066 100644 --- a/WoofWare.Myriad.Plugins/JsonSerializeGenerator.fs +++ b/WoofWare.Myriad.Plugins/JsonSerializeGenerator.fs @@ -23,7 +23,8 @@ module internal JsonSerializeGenerator = /// Given `input.Ident`, for example, choose how to add it to the ambient `node`. /// The result is a line like `(fun ident -> InnerType.toJsonNode ident)` or `(fun ident -> JsonValue.Create ident)`. - let rec serializeNode (fieldType : SynType) : SynExpr = + /// Returns also a bool which is true if the resulting SynExpr represents something of type JsonNode. + let rec serializeNode (fieldType : SynType) : SynExpr * bool = // TODO: serialization format for DateTime etc match fieldType with | DateOnly @@ -36,20 +37,30 @@ module internal JsonSerializeGenerator = // JsonValue.Create SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonValue" ; "Create" ] |> SynExpr.typeApp [ fieldType ] + |> fun e -> e, false | NullableType ty -> // fun field -> if field.HasValue then {serializeNode ty} field.Value else JsonValue.Create null - SynExpr.applyFunction (serializeNode ty) (SynExpr.createLongIdent [ "field" ; "Value" ]) + let inner, innerIsJsonNode = serializeNode ty + + SynExpr.applyFunction inner (SynExpr.createLongIdent [ "field" ; "Value" ]) |> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]) |> SynExpr.ifThenElse (SynExpr.createLongIdent [ "field" ; "HasValue" ]) (jsonNull ()) |> SynExpr.createLambda "field" + |> fun e -> e, innerIsJsonNode | OptionType ty -> // fun field -> match field with | None -> JsonValue.Create null | Some v -> {serializeNode ty} field let noneClause = jsonNull () |> SynMatchClause.create (SynPat.named "None") let someClause = - SynExpr.applyFunction (serializeNode ty) (SynExpr.createIdent "field") - |> SynExpr.paren - |> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]) + let inner, innerIsJsonNode = serializeNode ty + let target = SynExpr.applyFunction inner (SynExpr.createIdent "field") + + if innerIsJsonNode then + target + else + target + |> SynExpr.paren + |> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]) |> SynMatchClause.create ( SynPat.identWithArgs [ Ident.create "Some" ] (SynArgPats.create [ Ident.create "field" ]) ) @@ -57,6 +68,7 @@ module internal JsonSerializeGenerator = [ noneClause ; someClause ] |> SynExpr.createMatch (SynExpr.createIdent "field") |> SynExpr.createLambda "field" + |> fun e -> e, true | ArrayType ty | ListType ty -> // fun field -> @@ -73,7 +85,7 @@ module internal JsonSerializeGenerator = SynExpr.createIdent "field", SynExpr.applyFunction (SynExpr.createLongIdent [ "arr" ; "Add" ]) - (SynExpr.paren (SynExpr.applyFunction (serializeNode ty) (SynExpr.createIdent "mem"))), + (SynExpr.paren (SynExpr.applyFunction (fst (serializeNode ty)) (SynExpr.createIdent "mem"))), range0 ) SynExpr.createIdent "arr" @@ -86,6 +98,7 @@ module internal JsonSerializeGenerator = |> SynBinding.basic [ Ident.create "arr" ] [] ] |> SynExpr.createLambda "field" + |> fun e -> e, false | IDictionaryType (_keyType, valueType) | DictionaryType (_keyType, valueType) | IReadOnlyDictionaryType (_keyType, valueType) @@ -113,7 +126,7 @@ module internal JsonSerializeGenerator = [ SynExpr.createLongIdent [ "key" ; "ToString" ] |> SynExpr.applyTo (SynExpr.CreateConst ()) - SynExpr.applyFunction (serializeNode valueType) (SynExpr.createIdent "value") + SynExpr.applyFunction (fst (serializeNode valueType)) (SynExpr.createIdent "value") ]), range0 ) @@ -127,6 +140,7 @@ module internal JsonSerializeGenerator = |> SynBinding.basic [ Ident.create "ret" ] [] ] |> SynExpr.createLambda "field" + |> fun e -> e, false | _ -> // {type}.toJsonNode let typeName = @@ -134,7 +148,7 @@ module internal JsonSerializeGenerator = | SynType.LongIdent ident -> ident.LongIdent | _ -> failwith $"Unrecognised type: %+A{fieldType}" - SynExpr.createLongIdent' (typeName @ [ Ident.create "toJsonNode" ]) + SynExpr.createLongIdent' (typeName @ [ Ident.create "toJsonNode" ]), true /// propertyName is probably a string literal, but it could be a [] variable /// `node.Add ({propertyName}, {toJsonNode})` @@ -142,7 +156,7 @@ module internal JsonSerializeGenerator = [ propertyName SynExpr.pipeThroughFunction - (serializeNode fieldType) + (fst (serializeNode fieldType)) (SynExpr.createLongIdent' [ Ident.create "input" ; fieldId ]) |> SynExpr.paren ] @@ -286,7 +300,7 @@ module internal JsonSerializeGenerator = let propertyName = getPropertyName (Option.get fieldData.Ident) fieldData.Attrs let node = - SynExpr.applyFunction (serializeNode fieldData.Type) (SynExpr.createIdent' caseName) + SynExpr.applyFunction (fst (serializeNode fieldData.Type)) (SynExpr.createIdent' caseName) [ propertyName ; node ] |> SynExpr.tuple