diff --git a/ConsumePlugin/GeneratedJson.fs b/ConsumePlugin/GeneratedJson.fs index daf9186..956fb22 100644 --- a/ConsumePlugin/GeneratedJson.fs +++ b/ConsumePlugin/GeneratedJson.fs @@ -14,7 +14,7 @@ module internal InternalTypeNotExtensionSerial = /// Serialize to a JSON node let toJsonNode (input : InternalTypeNotExtensionSerial) : System.Text.Json.Nodes.JsonNode = let node = System.Text.Json.Nodes.JsonObject () - do node.Add ((Literals.something), System.Text.Json.Nodes.JsonValue.Create input.InternalThing2) + do node.Add ((Literals.something), (input.InternalThing2 |> System.Text.Json.Nodes.JsonValue.Create)) node :> _ namespace ConsumePlugin @@ -29,7 +29,7 @@ module internal InternalTypeExtensionJsonSerializeExtension = /// Serialize to a JSON node static member toJsonNode (input : InternalTypeExtension) : System.Text.Json.Nodes.JsonNode = let node = System.Text.Json.Nodes.JsonObject () - do node.Add ((Literals.something), System.Text.Json.Nodes.JsonValue.Create input.ExternalThing) + do node.Add ((Literals.something), (input.ExternalThing |> System.Text.Json.Nodes.JsonValue.Create)) node :> _ namespace ConsumePlugin diff --git a/ConsumePlugin/GeneratedPureGymDto.fs b/ConsumePlugin/GeneratedPureGymDto.fs index 8280460..4930adb 100644 --- a/ConsumePlugin/GeneratedPureGymDto.fs +++ b/ConsumePlugin/GeneratedPureGymDto.fs @@ -20,21 +20,26 @@ module MemberJsonSerializeExtension = let node = System.Text.Json.Nodes.JsonObject () do - node.Add ("id", System.Text.Json.Nodes.JsonValue.Create input.Id) - node.Add ("compoundMemberId", System.Text.Json.Nodes.JsonValue.Create input.CompoundMemberId) - node.Add ("firstName", System.Text.Json.Nodes.JsonValue.Create input.FirstName) - node.Add ("lastName", System.Text.Json.Nodes.JsonValue.Create input.LastName) - node.Add ("homeGymId", System.Text.Json.Nodes.JsonValue.Create input.HomeGymId) - node.Add ("homeGymName", System.Text.Json.Nodes.JsonValue.Create input.HomeGymName) - node.Add ("emailAddress", System.Text.Json.Nodes.JsonValue.Create input.EmailAddress) - node.Add ("gymAccessPin", System.Text.Json.Nodes.JsonValue.Create input.GymAccessPin) - node.Add ("dateofBirth", System.Text.Json.Nodes.JsonValue.Create input.DateOfBirth) - node.Add ("mobileNumber", System.Text.Json.Nodes.JsonValue.Create input.MobileNumber) - node.Add ("postCode", System.Text.Json.Nodes.JsonValue.Create input.Postcode) - node.Add ("membershipName", System.Text.Json.Nodes.JsonValue.Create input.MembershipName) - node.Add ("membershipLevel", System.Text.Json.Nodes.JsonValue.Create input.MembershipLevel) - node.Add ("suspendedReason", System.Text.Json.Nodes.JsonValue.Create input.SuspendedReason) - node.Add ("memberStatus", System.Text.Json.Nodes.JsonValue.Create input.MemberStatus) + node.Add ("id", (input.Id |> System.Text.Json.Nodes.JsonValue.Create)) + + node.Add ( + "compoundMemberId", + (input.CompoundMemberId |> System.Text.Json.Nodes.JsonValue.Create) + ) + + node.Add ("firstName", (input.FirstName |> System.Text.Json.Nodes.JsonValue.Create)) + node.Add ("lastName", (input.LastName |> System.Text.Json.Nodes.JsonValue.Create)) + node.Add ("homeGymId", (input.HomeGymId |> System.Text.Json.Nodes.JsonValue.Create)) + node.Add ("homeGymName", (input.HomeGymName |> System.Text.Json.Nodes.JsonValue.Create)) + node.Add ("emailAddress", (input.EmailAddress |> System.Text.Json.Nodes.JsonValue.Create)) + node.Add ("gymAccessPin", (input.GymAccessPin |> System.Text.Json.Nodes.JsonValue.Create)) + node.Add ("dateofBirth", (input.DateOfBirth |> System.Text.Json.Nodes.JsonValue.Create)) + node.Add ("mobileNumber", (input.MobileNumber |> System.Text.Json.Nodes.JsonValue.Create)) + node.Add ("postCode", (input.Postcode |> System.Text.Json.Nodes.JsonValue.Create)) + node.Add ("membershipName", (input.MembershipName |> System.Text.Json.Nodes.JsonValue.Create)) + node.Add ("membershipLevel", (input.MembershipLevel |> System.Text.Json.Nodes.JsonValue.Create)) + node.Add ("suspendedReason", (input.SuspendedReason |> System.Text.Json.Nodes.JsonValue.Create)) + node.Add ("memberStatus", (input.MemberStatus |> System.Text.Json.Nodes.JsonValue.Create)) node :> _ diff --git a/ConsumePlugin/GeneratedSerde.fs b/ConsumePlugin/GeneratedSerde.fs index 3e37072..ca6b66e 100644 --- a/ConsumePlugin/GeneratedSerde.fs +++ b/ConsumePlugin/GeneratedSerde.fs @@ -21,69 +21,69 @@ module InnerTypeWithBothJsonSerializeExtension = let node = System.Text.Json.Nodes.JsonObject () do - node.Add (("it's-a-me"), System.Text.Json.Nodes.JsonValue.Create input.Thing) + node.Add (("it's-a-me"), (input.Thing |> System.Text.Json.Nodes.JsonValue.Create)) node.Add ( "map", - (fun field -> - let ret = System.Text.Json.Nodes.JsonObject () + (input.Map + |> (fun field -> + let ret = System.Text.Json.Nodes.JsonObject () - for (KeyValue (key, value)) in field do - ret.Add (key.ToString (), System.Text.Json.Nodes.JsonValue.Create value) + for (KeyValue (key, value)) in field do + ret.Add (key.ToString (), System.Text.Json.Nodes.JsonValue.Create value) - ret - ) - input.Map + ret + )) ) node.Add ( "readOnlyDict", - (fun field -> - let ret = System.Text.Json.Nodes.JsonObject () + (input.ReadOnlyDict + |> (fun field -> + let ret = System.Text.Json.Nodes.JsonObject () - for (KeyValue (key, value)) in field do - ret.Add ( - key.ToString (), - (fun field -> - let arr = System.Text.Json.Nodes.JsonArray () + for (KeyValue (key, value)) in field do + ret.Add ( + key.ToString (), + (fun field -> + let arr = System.Text.Json.Nodes.JsonArray () - for mem in field do - arr.Add (System.Text.Json.Nodes.JsonValue.Create mem) + for mem in field do + arr.Add (System.Text.Json.Nodes.JsonValue.Create mem) - arr - ) - value - ) + arr + ) + value + ) - ret - ) - input.ReadOnlyDict + ret + )) ) node.Add ( "dict", - (fun field -> - let ret = System.Text.Json.Nodes.JsonObject () + (input.Dict + |> (fun field -> + let ret = System.Text.Json.Nodes.JsonObject () - for (KeyValue (key, value)) in field do - ret.Add (key.ToString (), System.Text.Json.Nodes.JsonValue.Create value) + for (KeyValue (key, value)) in field do + ret.Add (key.ToString (), System.Text.Json.Nodes.JsonValue.Create value) - ret - ) - input.Dict + ret + )) ) node.Add ( "concreteDict", - (fun field -> - let ret = System.Text.Json.Nodes.JsonObject () + (input.ConcreteDict + |> (fun field -> + let ret = System.Text.Json.Nodes.JsonObject () - for (KeyValue (key, value)) in field do - ret.Add (key.ToString (), InnerTypeWithBoth.toJsonNode value) + for (KeyValue (key, value)) in field do + ret.Add (key.ToString (), InnerTypeWithBoth.toJsonNode value) - ret - ) - input.ConcreteDict + ret + )) ) node :> _ @@ -104,61 +104,85 @@ module JsonRecordTypeWithBothJsonSerializeExtension = let node = System.Text.Json.Nodes.JsonObject () do - node.Add ("a", System.Text.Json.Nodes.JsonValue.Create input.A) - node.Add ("b", System.Text.Json.Nodes.JsonValue.Create input.B) + node.Add ("a", (input.A |> System.Text.Json.Nodes.JsonValue.Create)) + node.Add ("b", (input.B |> System.Text.Json.Nodes.JsonValue.Create)) node.Add ( "c", - (fun field -> - let arr = System.Text.Json.Nodes.JsonArray () + (input.C + |> (fun field -> + let arr = System.Text.Json.Nodes.JsonArray () - for mem in field do - arr.Add (System.Text.Json.Nodes.JsonValue.Create mem) + for mem in field do + arr.Add (System.Text.Json.Nodes.JsonValue.Create mem) - arr - ) - input.C + arr + )) ) - node.Add ("d", InnerTypeWithBoth.toJsonNode input.D) + node.Add ("d", (input.D |> InnerTypeWithBoth.toJsonNode)) node.Add ( "e", - (fun field -> - let arr = System.Text.Json.Nodes.JsonArray () + (input.E + |> (fun field -> + let arr = System.Text.Json.Nodes.JsonArray () - for mem in field do - arr.Add (System.Text.Json.Nodes.JsonValue.Create mem) + for mem in field do + arr.Add (System.Text.Json.Nodes.JsonValue.Create mem) - arr - ) - input.E + arr + )) ) node.Add ( "arr", - (fun field -> - let arr = System.Text.Json.Nodes.JsonArray () + (input.Arr + |> (fun field -> + let arr = System.Text.Json.Nodes.JsonArray () - for mem in field do - arr.Add (System.Text.Json.Nodes.JsonValue.Create mem) + for mem in field do + arr.Add (System.Text.Json.Nodes.JsonValue.Create mem) - arr - ) - input.Arr + arr + )) ) - node.Add ("byte", System.Text.Json.Nodes.JsonValue.Create> input.Byte) - node.Add ("sbyte", System.Text.Json.Nodes.JsonValue.Create> input.Sbyte) - node.Add ("i", System.Text.Json.Nodes.JsonValue.Create> input.I) - node.Add ("i32", System.Text.Json.Nodes.JsonValue.Create> input.I32) - node.Add ("i64", System.Text.Json.Nodes.JsonValue.Create> input.I64) - node.Add ("u", System.Text.Json.Nodes.JsonValue.Create> input.U) - node.Add ("u32", System.Text.Json.Nodes.JsonValue.Create> input.U32) - node.Add ("u64", System.Text.Json.Nodes.JsonValue.Create> input.U64) - node.Add ("f", System.Text.Json.Nodes.JsonValue.Create> input.F) - node.Add ("f32", System.Text.Json.Nodes.JsonValue.Create> input.F32) - node.Add ("single", System.Text.Json.Nodes.JsonValue.Create> input.Single) + node.Add ("byte", (input.Byte |> System.Text.Json.Nodes.JsonValue.Create>)) + node.Add ("sbyte", (input.Sbyte |> System.Text.Json.Nodes.JsonValue.Create>)) + node.Add ("i", (input.I |> System.Text.Json.Nodes.JsonValue.Create>)) + node.Add ("i32", (input.I32 |> System.Text.Json.Nodes.JsonValue.Create>)) + node.Add ("i64", (input.I64 |> System.Text.Json.Nodes.JsonValue.Create>)) + node.Add ("u", (input.U |> System.Text.Json.Nodes.JsonValue.Create>)) + node.Add ("u32", (input.U32 |> System.Text.Json.Nodes.JsonValue.Create>)) + node.Add ("u64", (input.U64 |> System.Text.Json.Nodes.JsonValue.Create>)) + node.Add ("f", (input.F |> System.Text.Json.Nodes.JsonValue.Create>)) + node.Add ("f32", (input.F32 |> System.Text.Json.Nodes.JsonValue.Create>)) + node.Add ("single", (input.Single |> System.Text.Json.Nodes.JsonValue.Create>)) + + node.Add ( + "intMeasureOption", + (input.IntMeasureOption + |> (fun field -> + match field with + | None -> null :> System.Text.Json.Nodes.JsonNode + | Some field -> + (System.Text.Json.Nodes.JsonValue.Create> field) + :> System.Text.Json.Nodes.JsonNode + )) + ) + + node.Add ( + "intMeasureNullable", + (input.IntMeasureNullable + |> (fun field -> + if field.HasValue then + System.Text.Json.Nodes.JsonValue.Create> field.Value + :> System.Text.Json.Nodes.JsonNode + else + null :> System.Text.Json.Nodes.JsonNode + )) + ) node :> _ namespace ConsumePlugin @@ -307,6 +331,22 @@ module JsonRecordTypeWithBothJsonParseExtension = /// Parse from a JSON node. static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordTypeWithBoth = + let arg_18 = + match node.["intMeasureNullable"] with + | null -> System.Nullable () + | v -> + v.AsValue().GetValue () + |> LanguagePrimitives.Int32WithMeasure + |> System.Nullable + + let arg_17 = + match node.["intMeasureOption"] with + | null -> None + | v -> + v.AsValue().GetValue () + |> LanguagePrimitives.Int32WithMeasure + |> Some + let arg_16 = (match node.["single"] with | null -> @@ -543,6 +583,8 @@ module JsonRecordTypeWithBothJsonParseExtension = F = arg_14 F32 = arg_15 Single = arg_16 + IntMeasureOption = arg_17 + IntMeasureNullable = arg_18 } namespace ConsumePlugin diff --git a/ConsumePlugin/SerializationAndDeserialization.fs b/ConsumePlugin/SerializationAndDeserialization.fs index 08be311..e6db5ed 100644 --- a/ConsumePlugin/SerializationAndDeserialization.fs +++ b/ConsumePlugin/SerializationAndDeserialization.fs @@ -40,6 +40,8 @@ type JsonRecordTypeWithBoth = F : float F32 : float32 Single : single + IntMeasureOption : int option + IntMeasureNullable : int Nullable } [] diff --git a/WoofWare.Myriad.Plugins.Test/TestJsonSerialize/TestJsonSerde.fs b/WoofWare.Myriad.Plugins.Test/TestJsonSerialize/TestJsonSerde.fs index d044c48..7b64bf3 100644 --- a/WoofWare.Myriad.Plugins.Test/TestJsonSerialize/TestJsonSerde.fs +++ b/WoofWare.Myriad.Plugins.Test/TestJsonSerialize/TestJsonSerde.fs @@ -89,6 +89,8 @@ module TestJsonSerde = let! f = Arb.generate |> Gen.filter (fun s -> Double.IsFinite (s / 1.0)) let! f32 = Arb.generate |> Gen.filter (fun s -> Single.IsFinite (s / 1.0f)) let! single = Arb.generate |> Gen.filter (fun s -> Single.IsFinite (s / 1.0f)) + let! intMeasureOption = Arb.generate + let! intMeasureNullable = Arb.generate return { @@ -109,6 +111,8 @@ module TestJsonSerde = F = f F32 = f32 Single = single + IntMeasureOption = intMeasureOption + IntMeasureNullable = intMeasureNullable } } diff --git a/WoofWare.Myriad.Plugins/JsonParseGenerator.fs b/WoofWare.Myriad.Plugins/JsonParseGenerator.fs index 01a7bd7..c04df53 100644 --- a/WoofWare.Myriad.Plugins/JsonParseGenerator.fs +++ b/WoofWare.Myriad.Plugins/JsonParseGenerator.fs @@ -95,17 +95,6 @@ module internal JsonParseGenerator = ) |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ collectionType ; "ofSeq" ]) - /// match {node} with | null -> None | v -> {body} |> Some - /// Use the variable `v` to get access to the `Some`. - let createParseLineOption (node : SynExpr) (body : SynExpr) : SynExpr = - let body = SynExpr.pipeThroughFunction (SynExpr.createIdent "Some") body - - [ - SynMatchClause.create SynPat.createNull (SynExpr.createIdent "None") - SynMatchClause.create (SynPat.named "v") body - ] - |> SynExpr.createMatch node - let dotParse (typeName : LongIdent) : LongIdent = List.append typeName [ Ident.create "Parse" ] @@ -206,8 +195,29 @@ module internal JsonParseGenerator = | NumberType typeName -> parseNumberType options propertyName node typeName | PrimitiveType typeName -> asValueGetValueIdent propertyName typeName node | OptionType ty -> - parseNode None options ty (SynExpr.createIdent "v") - |> createParseLineOption node + let someClause = + parseNode None options ty (SynExpr.createIdent "v") + |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some") + |> SynMatchClause.create (SynPat.named "v") + + [ + SynMatchClause.create SynPat.createNull (SynExpr.createIdent "None") + someClause + ] + |> SynExpr.createMatch node + | NullableType ty -> + let someClause = + parseNode None options ty (SynExpr.createIdent "v") + |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "Nullable" ]) + |> SynMatchClause.create (SynPat.named "v") + + [ + SynMatchClause.create + SynPat.createNull + (SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Nullable" ]) (SynExpr.CreateConst ())) + someClause + ] + |> SynExpr.createMatch node | ListType ty -> parseNode None options ty (SynExpr.createIdent "elt") |> asArrayMapped propertyName "List" node diff --git a/WoofWare.Myriad.Plugins/JsonSerializeGenerator.fs b/WoofWare.Myriad.Plugins/JsonSerializeGenerator.fs index adb5493..534ee2e 100644 --- a/WoofWare.Myriad.Plugins/JsonSerializeGenerator.fs +++ b/WoofWare.Myriad.Plugins/JsonSerializeGenerator.fs @@ -13,6 +13,14 @@ type internal JsonSerializeOutputSpec = module internal JsonSerializeGenerator = open Fantomas.FCS.Text.Range + + // The absolutely galaxy-brained implementation of JsonValue has `JsonValue.Parse "null"` + // identically equal to null. We have to work around this later, but we might as well just + // be efficient here and whip up the null directly. + let private jsonNull () = + SynExpr.createNull () + |> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]) + /// 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 = @@ -35,15 +43,15 @@ module internal JsonSerializeGenerator = range0, range0 ) + | NullableType ty -> + // fun field -> if field.HasValue then {serializeNode ty} field.Value else JsonValue.Create null + SynExpr.applyFunction (serializeNode ty) (SynExpr.createLongIdent [ "field" ; "Value" ]) + |> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]) + |> SynExpr.ifThenElse (SynExpr.createLongIdent [ "field" ; "HasValue" ]) (jsonNull ()) + |> SynExpr.createLambda "field" | OptionType ty -> // fun field -> match field with | None -> JsonValue.Create null | Some v -> {serializeNode ty} field - let noneClause = - // The absolutely galaxy-brained implementation of JsonValue has `JsonValue.Parse "null"` - // identically equal to null. We have to work around this later, but we might as well just - // be efficient here and whip up the null directly. - SynExpr.createNull () - |> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]) - |> SynMatchClause.create (SynPat.named "None") + let noneClause = jsonNull () |> SynMatchClause.create (SynPat.named "None") let someClause = SynExpr.applyFunction (serializeNode ty) (SynExpr.createIdent "field") @@ -140,9 +148,10 @@ module internal JsonSerializeGenerator = let createSerializeRhsRecord (propertyName : SynExpr) (fieldId : Ident) (fieldType : SynType) : SynExpr = [ propertyName - SynExpr.applyFunction + SynExpr.pipeThroughFunction (serializeNode fieldType) (SynExpr.createLongIdent' [ Ident.create "input" ; fieldId ]) + |> SynExpr.paren ] |> SynExpr.tuple |> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ]) diff --git a/WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs b/WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs index 15e1e14..ae69118 100644 --- a/WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs +++ b/WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs @@ -106,15 +106,16 @@ module internal SynExpr = | SynExpr.Paren (expr, _, _, _) -> stripOptionalParen expr | expr -> expr - /// {obj}.{meth} {arg} - let callMethodArg (meth : string) (arg : SynExpr) (obj : SynExpr) : SynExpr = + let dotGet (field : string) (obj : SynExpr) : SynExpr = SynExpr.DotGet ( obj, range0, - SynLongIdent.SynLongIdent (id = [ Ident.create meth ], dotRanges = [], trivia = [ None ]), + SynLongIdent.SynLongIdent (id = [ Ident.create field ], dotRanges = [], trivia = [ None ]), range0 ) - |> applyTo arg + + /// {obj}.{meth} {arg} + let callMethodArg (meth : string) (arg : SynExpr) (obj : SynExpr) : SynExpr = dotGet meth obj |> applyTo arg /// {obj}.{meth}() let callMethod (meth : string) (obj : SynExpr) : SynExpr = diff --git a/WoofWare.Myriad.Plugins/SynExpr/SynLongIdent.fs b/WoofWare.Myriad.Plugins/SynExpr/SynLongIdent.fs index 23ecb0d..acd7fb4 100644 --- a/WoofWare.Myriad.Plugins/SynExpr/SynLongIdent.fs +++ b/WoofWare.Myriad.Plugins/SynExpr/SynLongIdent.fs @@ -70,6 +70,12 @@ module internal SynLongIdent = // TODO: consider Microsoft.FSharp.Option or whatever it is | _ -> false + let isNullable (ident : SynLongIdent) : bool = + match ident.LongIdent |> List.map _.idText with + | [ "System" ; "Nullable" ] + | [ "Nullable" ] -> true + | _ -> false + let isResponse (ident : SynLongIdent) : bool = match ident.LongIdent |> List.map _.idText with | [ "Response" ] diff --git a/WoofWare.Myriad.Plugins/SynExpr/SynType.fs b/WoofWare.Myriad.Plugins/SynExpr/SynType.fs index 5efbe9e..5994406 100644 --- a/WoofWare.Myriad.Plugins/SynExpr/SynType.fs +++ b/WoofWare.Myriad.Plugins/SynExpr/SynType.fs @@ -59,6 +59,12 @@ module internal SynTypePatterns = Some innerType | _ -> None + let (|NullableType|_|) (fieldType : SynType) = + match fieldType with + | SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when SynLongIdent.isNullable ident -> + Some innerType + | _ -> None + let (|UnitType|_|) (fieldType : SynType) : unit option = match fieldType with | SynType.LongIdent ident when SynLongIdent.isUnit ident -> Some ()