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

Omit upcasts where possible (#178)

Browse Source
This commit is contained in:
Patrick Stevens
2024-07-01 17:45:36 +01:00
committed by GitHub
parent c590db2a65
commit 434c042510
4 changed files with 126 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

87
ConsumePlugin/GeneratedSerde.fs
View File

@@ -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
[<AutoOpen>]
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<string>))
node.Add ("value", (input.Value |> System.Text.Json.Nodes.JsonValue.Create<string>))
node :> _
namespace ConsumePlugin
open System
open System.Collections.Generic
open System.Text.Json.Serialization
/// Module containing JSON serializing extension members for the Foo type
[<AutoOpen>]
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<System.Int32> ()
)
| v -> failwith ("Unrecognised 'type' field value: " + v)
namespace ConsumePlugin
/// Module containing JSON parsing extension members for the HeaderAndValue type
[<AutoOpen>]
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<System.String> ()
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<System.String> ()
{
Header = arg_0
Value = arg_1
}

14
ConsumePlugin/SerializationAndDeserialization.fs
View File

@@ -57,3 +57,17 @@ type FirstDu =
| EmptyCase
| Case1 of data : string
| Case2 of record : JsonRecordTypeWithBoth * i : int
[<WoofWare.Myriad.Plugins.JsonParse true>]
[<WoofWare.Myriad.Plugins.JsonSerialize true>]
type HeaderAndValue =
{
Header : string
Value : string
}
[<WoofWare.Myriad.Plugins.JsonSerialize true>]
type Foo =
{
Message : HeaderAndValue option
}

2
WoofWare.Myriad.Plugins/HttpClientGenerator.fs
View File

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

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

@@ -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<type>
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 [<Literal>] 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