patrick/WoofWare.Myriad
1
0
Fork 0
mirror of https://github.com/Smaug123/WoofWare.Myriad synced 2025-10-05 03:58:40 +00:00
Code Issues Packages Projects Releases Wiki Activity

Add nullable support to JSON generators (#174)

Browse Source
This commit is contained in:
Patrick Stevens
2024-06-27 08:40:58 +01:00
committed by GitHub
parent ba31689145
commit 6a81513a93
10 changed files with 200 additions and 115 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
ConsumePlugin/GeneratedJson.fs
View File

@@ -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<string> input.InternalThing2)
do node.Add ((Literals.something), (input.InternalThing2 |> System.Text.Json.Nodes.JsonValue.Create<string>))
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<string> input.ExternalThing)
do node.Add ((Literals.something), (input.ExternalThing |> System.Text.Json.Nodes.JsonValue.Create<string>))
node :> _
namespace ConsumePlugin

35
ConsumePlugin/GeneratedPureGymDto.fs
View File

@@ -20,21 +20,26 @@ module MemberJsonSerializeExtension =
let node = System.Text.Json.Nodes.JsonObject ()
do
node.Add ("id", System.Text.Json.Nodes.JsonValue.Create<int> input.Id)
node.Add ("compoundMemberId", System.Text.Json.Nodes.JsonValue.Create<string> input.CompoundMemberId)
node.Add ("firstName", System.Text.Json.Nodes.JsonValue.Create<string> input.FirstName)
node.Add ("lastName", System.Text.Json.Nodes.JsonValue.Create<string> input.LastName)
node.Add ("homeGymId", System.Text.Json.Nodes.JsonValue.Create<int> input.HomeGymId)
node.Add ("homeGymName", System.Text.Json.Nodes.JsonValue.Create<string> input.HomeGymName)
node.Add ("emailAddress", System.Text.Json.Nodes.JsonValue.Create<string> input.EmailAddress)
node.Add ("gymAccessPin", System.Text.Json.Nodes.JsonValue.Create<string> input.GymAccessPin)
node.Add ("dateofBirth", System.Text.Json.Nodes.JsonValue.Create<DateOnly> input.DateOfBirth)
node.Add ("mobileNumber", System.Text.Json.Nodes.JsonValue.Create<string> input.MobileNumber)
node.Add ("postCode", System.Text.Json.Nodes.JsonValue.Create<string> input.Postcode)
node.Add ("membershipName", System.Text.Json.Nodes.JsonValue.Create<string> input.MembershipName)
node.Add ("membershipLevel", System.Text.Json.Nodes.JsonValue.Create<int> input.MembershipLevel)
node.Add ("suspendedReason", System.Text.Json.Nodes.JsonValue.Create<int> input.SuspendedReason)
node.Add ("memberStatus", System.Text.Json.Nodes.JsonValue.Create<int> input.MemberStatus)
node.Add ("id", (input.Id |> System.Text.Json.Nodes.JsonValue.Create<int>))
node.Add (
"compoundMemberId",
(input.CompoundMemberId |> System.Text.Json.Nodes.JsonValue.Create<string>)
)
node.Add ("firstName", (input.FirstName |> System.Text.Json.Nodes.JsonValue.Create<string>))
node.Add ("lastName", (input.LastName |> System.Text.Json.Nodes.JsonValue.Create<string>))
node.Add ("homeGymId", (input.HomeGymId |> System.Text.Json.Nodes.JsonValue.Create<int>))
node.Add ("homeGymName", (input.HomeGymName |> System.Text.Json.Nodes.JsonValue.Create<string>))
node.Add ("emailAddress", (input.EmailAddress |> System.Text.Json.Nodes.JsonValue.Create<string>))
node.Add ("gymAccessPin", (input.GymAccessPin |> System.Text.Json.Nodes.JsonValue.Create<string>))
node.Add ("dateofBirth", (input.DateOfBirth |> System.Text.Json.Nodes.JsonValue.Create<DateOnly>))
node.Add ("mobileNumber", (input.MobileNumber |> System.Text.Json.Nodes.JsonValue.Create<string>))
node.Add ("postCode", (input.Postcode |> System.Text.Json.Nodes.JsonValue.Create<string>))
node.Add ("membershipName", (input.MembershipName |> System.Text.Json.Nodes.JsonValue.Create<string>))
node.Add ("membershipLevel", (input.MembershipLevel |> System.Text.Json.Nodes.JsonValue.Create<int>))
node.Add ("suspendedReason", (input.SuspendedReason |> System.Text.Json.Nodes.JsonValue.Create<int>))
node.Add ("memberStatus", (input.MemberStatus |> System.Text.Json.Nodes.JsonValue.Create<int>))
node :> _

188
ConsumePlugin/GeneratedSerde.fs
View File

@@ -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<Guid> input.Thing)
node.Add (("it's-a-me"), (input.Thing |> System.Text.Json.Nodes.JsonValue.Create<Guid>))
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<Uri> value)
for (KeyValue (key, value)) in field do
ret.Add (key.ToString (), System.Text.Json.Nodes.JsonValue.Create<Uri> 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<char> mem)
for mem in field do
arr.Add (System.Text.Json.Nodes.JsonValue.Create<char> 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<bool> value)
for (KeyValue (key, value)) in field do
ret.Add (key.ToString (), System.Text.Json.Nodes.JsonValue.Create<bool> 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<int> input.A)
node.Add ("b", System.Text.Json.Nodes.JsonValue.Create<string> input.B)
node.Add ("a", (input.A |> System.Text.Json.Nodes.JsonValue.Create<int>))
node.Add ("b", (input.B |> System.Text.Json.Nodes.JsonValue.Create<string>))
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<int> mem)
for mem in field do
arr.Add (System.Text.Json.Nodes.JsonValue.Create<int> 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<string> mem)
for mem in field do
arr.Add (System.Text.Json.Nodes.JsonValue.Create<string> 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<int> mem)
for mem in field do
arr.Add (System.Text.Json.Nodes.JsonValue.Create<int> mem)
arr
)
input.Arr
arr
))
)
node.Add ("byte", System.Text.Json.Nodes.JsonValue.Create<byte<measure>> input.Byte)
node.Add ("sbyte", System.Text.Json.Nodes.JsonValue.Create<sbyte<measure>> input.Sbyte)
node.Add ("i", System.Text.Json.Nodes.JsonValue.Create<int<measure>> input.I)
node.Add ("i32", System.Text.Json.Nodes.JsonValue.Create<int32<measure>> input.I32)
node.Add ("i64", System.Text.Json.Nodes.JsonValue.Create<int64<measure>> input.I64)
node.Add ("u", System.Text.Json.Nodes.JsonValue.Create<uint<measure>> input.U)
node.Add ("u32", System.Text.Json.Nodes.JsonValue.Create<uint32<measure>> input.U32)
node.Add ("u64", System.Text.Json.Nodes.JsonValue.Create<uint64<measure>> input.U64)
node.Add ("f", System.Text.Json.Nodes.JsonValue.Create<float<measure>> input.F)
node.Add ("f32", System.Text.Json.Nodes.JsonValue.Create<float32<measure>> input.F32)
node.Add ("single", System.Text.Json.Nodes.JsonValue.Create<single<measure>> input.Single)
node.Add ("byte", (input.Byte |> System.Text.Json.Nodes.JsonValue.Create<byte<measure>>))
node.Add ("sbyte", (input.Sbyte |> System.Text.Json.Nodes.JsonValue.Create<sbyte<measure>>))
node.Add ("i", (input.I |> System.Text.Json.Nodes.JsonValue.Create<int<measure>>))
node.Add ("i32", (input.I32 |> System.Text.Json.Nodes.JsonValue.Create<int32<measure>>))
node.Add ("i64", (input.I64 |> System.Text.Json.Nodes.JsonValue.Create<int64<measure>>))
node.Add ("u", (input.U |> System.Text.Json.Nodes.JsonValue.Create<uint<measure>>))
node.Add ("u32", (input.U32 |> System.Text.Json.Nodes.JsonValue.Create<uint32<measure>>))
node.Add ("u64", (input.U64 |> System.Text.Json.Nodes.JsonValue.Create<uint64<measure>>))
node.Add ("f", (input.F |> System.Text.Json.Nodes.JsonValue.Create<float<measure>>))
node.Add ("f32", (input.F32 |> System.Text.Json.Nodes.JsonValue.Create<float32<measure>>))
node.Add ("single", (input.Single |> System.Text.Json.Nodes.JsonValue.Create<single<measure>>))
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<int<measure>> field)
:> System.Text.Json.Nodes.JsonNode
))
)
node.Add (
"intMeasureNullable",
(input.IntMeasureNullable
|> (fun field ->
if field.HasValue then
System.Text.Json.Nodes.JsonValue.Create<int<measure>> 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<System.Int32> ()
|> LanguagePrimitives.Int32WithMeasure
|> System.Nullable
let arg_17 =
match node.["intMeasureOption"] with
| null -> None
| v ->
v.AsValue().GetValue<System.Int32> ()
|> 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

2
ConsumePlugin/SerializationAndDeserialization.fs
View File

@@ -40,6 +40,8 @@ type JsonRecordTypeWithBoth =
F : float<measure>
F32 : float32<measure>
Single : single<measure>
IntMeasureOption : int<measure> option
IntMeasureNullable : int<measure> Nullable
}
[<WoofWare.Myriad.Plugins.JsonSerialize true>]

4
WoofWare.Myriad.Plugins.Test/TestJsonSerialize/TestJsonSerde.fs
View File

@@ -89,6 +89,8 @@ module TestJsonSerde =
let! f = Arb.generate |> Gen.filter (fun s -> Double.IsFinite (s / 1.0<measure>))
let! f32 = Arb.generate |> Gen.filter (fun s -> Single.IsFinite (s / 1.0f<measure>))
let! single = Arb.generate |> Gen.filter (fun s -> Single.IsFinite (s / 1.0f<measure>))
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
}
}

36
WoofWare.Myriad.Plugins/JsonParseGenerator.fs
View File

@@ -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

25
WoofWare.Myriad.Plugins/JsonSerializeGenerator.fs
View File

@@ -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" ])

9
WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs
View File

@@ -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 =

6
WoofWare.Myriad.Plugins/SynExpr/SynLongIdent.fs
View File

@@ -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" ]

6
WoofWare.Myriad.Plugins/SynExpr/SynType.fs
View File

@@ -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 ()