Compare commits

...

3 Commits

Author SHA1 Message Date
Patrick Stevens
434c042510 Omit upcasts where possible (#178) 2024-07-01 17:45:36 +01:00
Patrick Stevens
c590db2a65 JSON enums (#175) 2024-06-27 21:23:06 +01:00
Patrick Stevens
6a81513a93 Add nullable support to JSON generators (#174) 2024-06-27 08:40:58 +01:00
14 changed files with 557 additions and 174 deletions

View File

@@ -14,7 +14,7 @@ module internal InternalTypeNotExtensionSerial =
/// Serialize to a JSON node /// Serialize to a JSON node
let toJsonNode (input : InternalTypeNotExtensionSerial) : System.Text.Json.Nodes.JsonNode = let toJsonNode (input : InternalTypeNotExtensionSerial) : System.Text.Json.Nodes.JsonNode =
let node = System.Text.Json.Nodes.JsonObject () 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 :> _ node :> _
namespace ConsumePlugin namespace ConsumePlugin
@@ -29,7 +29,7 @@ module internal InternalTypeExtensionJsonSerializeExtension =
/// Serialize to a JSON node /// Serialize to a JSON node
static member toJsonNode (input : InternalTypeExtension) : System.Text.Json.Nodes.JsonNode = static member toJsonNode (input : InternalTypeExtension) : System.Text.Json.Nodes.JsonNode =
let node = System.Text.Json.Nodes.JsonObject () 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 :> _ node :> _
namespace ConsumePlugin namespace ConsumePlugin

View File

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

View File

@@ -21,69 +21,69 @@ module InnerTypeWithBothJsonSerializeExtension =
let node = System.Text.Json.Nodes.JsonObject () let node = System.Text.Json.Nodes.JsonObject ()
do 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 ( node.Add (
"map", "map",
(fun field -> (input.Map
let ret = System.Text.Json.Nodes.JsonObject () |> (fun field ->
let ret = System.Text.Json.Nodes.JsonObject ()
for (KeyValue (key, value)) in field do for (KeyValue (key, value)) in field do
ret.Add (key.ToString (), System.Text.Json.Nodes.JsonValue.Create<Uri> value) ret.Add (key.ToString (), System.Text.Json.Nodes.JsonValue.Create<Uri> value)
ret ret
) ))
input.Map
) )
node.Add ( node.Add (
"readOnlyDict", "readOnlyDict",
(fun field -> (input.ReadOnlyDict
let ret = System.Text.Json.Nodes.JsonObject () |> (fun field ->
let ret = System.Text.Json.Nodes.JsonObject ()
for (KeyValue (key, value)) in field do for (KeyValue (key, value)) in field do
ret.Add ( ret.Add (
key.ToString (), key.ToString (),
(fun field -> (fun field ->
let arr = System.Text.Json.Nodes.JsonArray () let arr = System.Text.Json.Nodes.JsonArray ()
for mem in field do for mem in field do
arr.Add (System.Text.Json.Nodes.JsonValue.Create<char> mem) arr.Add (System.Text.Json.Nodes.JsonValue.Create<char> mem)
arr arr
) )
value value
) )
ret ret
) ))
input.ReadOnlyDict
) )
node.Add ( node.Add (
"dict", "dict",
(fun field -> (input.Dict
let ret = System.Text.Json.Nodes.JsonObject () |> (fun field ->
let ret = System.Text.Json.Nodes.JsonObject ()
for (KeyValue (key, value)) in field do for (KeyValue (key, value)) in field do
ret.Add (key.ToString (), System.Text.Json.Nodes.JsonValue.Create<bool> value) ret.Add (key.ToString (), System.Text.Json.Nodes.JsonValue.Create<bool> value)
ret ret
) ))
input.Dict
) )
node.Add ( node.Add (
"concreteDict", "concreteDict",
(fun field -> (input.ConcreteDict
let ret = System.Text.Json.Nodes.JsonObject () |> (fun field ->
let ret = System.Text.Json.Nodes.JsonObject ()
for (KeyValue (key, value)) in field do for (KeyValue (key, value)) in field do
ret.Add (key.ToString (), InnerTypeWithBoth.toJsonNode value) ret.Add (key.ToString (), InnerTypeWithBoth.toJsonNode value)
ret ret
) ))
input.ConcreteDict
) )
node :> _ node :> _
@@ -93,6 +93,24 @@ open System
open System.Collections.Generic open System.Collections.Generic
open System.Text.Json.Serialization open System.Text.Json.Serialization
/// Module containing JSON serializing extension members for the SomeEnum type
[<AutoOpen>]
module SomeEnumJsonSerializeExtension =
/// Extension methods for JSON parsing
type SomeEnum with
/// Serialize to a JSON node
static member toJsonNode (input : SomeEnum) : System.Text.Json.Nodes.JsonNode =
match input with
| SomeEnum.Blah -> System.Text.Json.Nodes.JsonValue.Create 1
| SomeEnum.Thing -> System.Text.Json.Nodes.JsonValue.Create 0
| v -> failwith (sprintf "Unrecognised value for enum: %O" v)
namespace ConsumePlugin
open System
open System.Collections.Generic
open System.Text.Json.Serialization
/// Module containing JSON serializing extension members for the JsonRecordTypeWithBoth type /// Module containing JSON serializing extension members for the JsonRecordTypeWithBoth type
[<AutoOpen>] [<AutoOpen>]
module JsonRecordTypeWithBothJsonSerializeExtension = module JsonRecordTypeWithBothJsonSerializeExtension =
@@ -104,61 +122,87 @@ module JsonRecordTypeWithBothJsonSerializeExtension =
let node = System.Text.Json.Nodes.JsonObject () let node = System.Text.Json.Nodes.JsonObject ()
do do
node.Add ("a", System.Text.Json.Nodes.JsonValue.Create<int> input.A) node.Add ("a", (input.A |> System.Text.Json.Nodes.JsonValue.Create<int>))
node.Add ("b", System.Text.Json.Nodes.JsonValue.Create<string> input.B) node.Add ("b", (input.B |> System.Text.Json.Nodes.JsonValue.Create<string>))
node.Add ( node.Add (
"c", "c",
(fun field -> (input.C
let arr = System.Text.Json.Nodes.JsonArray () |> (fun field ->
let arr = System.Text.Json.Nodes.JsonArray ()
for mem in field do for mem in field do
arr.Add (System.Text.Json.Nodes.JsonValue.Create<int> mem) arr.Add (System.Text.Json.Nodes.JsonValue.Create<int> mem)
arr arr
) ))
input.C
) )
node.Add ("d", InnerTypeWithBoth.toJsonNode input.D) node.Add ("d", (input.D |> InnerTypeWithBoth.toJsonNode))
node.Add ( node.Add (
"e", "e",
(fun field -> (input.E
let arr = System.Text.Json.Nodes.JsonArray () |> (fun field ->
let arr = System.Text.Json.Nodes.JsonArray ()
for mem in field do for mem in field do
arr.Add (System.Text.Json.Nodes.JsonValue.Create<string> mem) arr.Add (System.Text.Json.Nodes.JsonValue.Create<string> mem)
arr arr
) ))
input.E
) )
node.Add ( node.Add (
"arr", "arr",
(fun field -> (input.Arr
let arr = System.Text.Json.Nodes.JsonArray () |> (fun field ->
let arr = System.Text.Json.Nodes.JsonArray ()
for mem in field do for mem in field do
arr.Add (System.Text.Json.Nodes.JsonValue.Create<int> mem) arr.Add (System.Text.Json.Nodes.JsonValue.Create<int> mem)
arr arr
) ))
input.Arr
) )
node.Add ("byte", System.Text.Json.Nodes.JsonValue.Create<byte<measure>> input.Byte) node.Add ("byte", (input.Byte |> System.Text.Json.Nodes.JsonValue.Create<byte<measure>>))
node.Add ("sbyte", System.Text.Json.Nodes.JsonValue.Create<sbyte<measure>> input.Sbyte) node.Add ("sbyte", (input.Sbyte |> System.Text.Json.Nodes.JsonValue.Create<sbyte<measure>>))
node.Add ("i", System.Text.Json.Nodes.JsonValue.Create<int<measure>> input.I) node.Add ("i", (input.I |> System.Text.Json.Nodes.JsonValue.Create<int<measure>>))
node.Add ("i32", System.Text.Json.Nodes.JsonValue.Create<int32<measure>> input.I32) node.Add ("i32", (input.I32 |> System.Text.Json.Nodes.JsonValue.Create<int32<measure>>))
node.Add ("i64", System.Text.Json.Nodes.JsonValue.Create<int64<measure>> input.I64) node.Add ("i64", (input.I64 |> System.Text.Json.Nodes.JsonValue.Create<int64<measure>>))
node.Add ("u", System.Text.Json.Nodes.JsonValue.Create<uint<measure>> input.U) node.Add ("u", (input.U |> System.Text.Json.Nodes.JsonValue.Create<uint<measure>>))
node.Add ("u32", System.Text.Json.Nodes.JsonValue.Create<uint32<measure>> input.U32) node.Add ("u32", (input.U32 |> System.Text.Json.Nodes.JsonValue.Create<uint32<measure>>))
node.Add ("u64", System.Text.Json.Nodes.JsonValue.Create<uint64<measure>> input.U64) node.Add ("u64", (input.U64 |> System.Text.Json.Nodes.JsonValue.Create<uint64<measure>>))
node.Add ("f", System.Text.Json.Nodes.JsonValue.Create<float<measure>> input.F) node.Add ("f", (input.F |> System.Text.Json.Nodes.JsonValue.Create<float<measure>>))
node.Add ("f32", System.Text.Json.Nodes.JsonValue.Create<float32<measure>> input.F32) node.Add ("f32", (input.F32 |> System.Text.Json.Nodes.JsonValue.Create<float32<measure>>))
node.Add ("single", System.Text.Json.Nodes.JsonValue.Create<single<measure>> input.Single) 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.Add ("enum", (input.Enum |> SomeEnum.toJsonNode))
node :> _ node :> _
namespace ConsumePlugin namespace ConsumePlugin
@@ -192,6 +236,55 @@ module FirstDuJsonSerializeExtension =
node.Add ("data", dataNode) node.Add ("data", dataNode)
node :> _ 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 namespace ConsumePlugin
@@ -299,6 +392,24 @@ module InnerTypeWithBothJsonParseExtension =
} }
namespace ConsumePlugin namespace ConsumePlugin
/// Module containing JSON parsing extension members for the SomeEnum type
[<AutoOpen>]
module SomeEnumJsonParseExtension =
/// Extension methods for JSON parsing
type SomeEnum with
/// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : SomeEnum =
match node.GetValueKind () with
| System.Text.Json.JsonValueKind.Number -> node.AsValue().GetValue<int> () |> enum<SomeEnum>
| System.Text.Json.JsonValueKind.String ->
match node.AsValue().GetValue<string>().ToLowerInvariant () with
| "blah" -> SomeEnum.Blah
| "thing" -> SomeEnum.Thing
| v -> failwith ("Unrecognised value for enum: %i" + v)
| _ -> failwith ("Unrecognised kind for enum of type: " + "SomeEnum")
namespace ConsumePlugin
/// Module containing JSON parsing extension members for the JsonRecordTypeWithBoth type /// Module containing JSON parsing extension members for the JsonRecordTypeWithBoth type
[<AutoOpen>] [<AutoOpen>]
module JsonRecordTypeWithBothJsonParseExtension = module JsonRecordTypeWithBothJsonParseExtension =
@@ -307,6 +418,34 @@ module JsonRecordTypeWithBothJsonParseExtension =
/// Parse from a JSON node. /// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordTypeWithBoth = static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordTypeWithBoth =
let arg_19 =
SomeEnum.jsonParse (
match node.["enum"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("enum")
)
)
| v -> v
)
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 = let arg_16 =
(match node.["single"] with (match node.["single"] with
| null -> | null ->
@@ -543,6 +682,9 @@ module JsonRecordTypeWithBothJsonParseExtension =
F = arg_14 F = arg_14
F32 = arg_15 F32 = arg_15
Single = arg_16 Single = arg_16
IntMeasureOption = arg_17
IntMeasureNullable = arg_18
Enum = arg_19
} }
namespace ConsumePlugin namespace ConsumePlugin
@@ -624,3 +766,41 @@ module FirstDuJsonParseExtension =
.GetValue<System.Int32> () .GetValue<System.Int32> ()
) )
| v -> failwith ("Unrecognised 'type' field value: " + v) | 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
}

View File

@@ -16,6 +16,12 @@ type InnerTypeWithBoth =
ConcreteDict : Dictionary<string, InnerTypeWithBoth> ConcreteDict : Dictionary<string, InnerTypeWithBoth>
} }
[<WoofWare.Myriad.Plugins.JsonParse true>]
[<WoofWare.Myriad.Plugins.JsonSerialize true>]
type SomeEnum =
| Blah = 1
| Thing = 0
[<Measure>] [<Measure>]
type measure type measure
@@ -40,6 +46,9 @@ type JsonRecordTypeWithBoth =
F : float<measure> F : float<measure>
F32 : float32<measure> F32 : float32<measure>
Single : single<measure> Single : single<measure>
IntMeasureOption : int<measure> option
IntMeasureNullable : int<measure> Nullable
Enum : SomeEnum
} }
[<WoofWare.Myriad.Plugins.JsonSerialize true>] [<WoofWare.Myriad.Plugins.JsonSerialize true>]
@@ -48,3 +57,17 @@ type FirstDu =
| EmptyCase | EmptyCase
| Case1 of data : string | Case1 of data : string
| Case2 of record : JsonRecordTypeWithBoth * i : int | 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
}

View File

@@ -49,3 +49,15 @@ module TestJsonParse =
let actual = s |> JsonNode.Parse |> InnerType.jsonParse let actual = s |> JsonNode.Parse |> InnerType.jsonParse
actual |> shouldEqual expected actual |> shouldEqual expected
[<TestCase("thing", SomeEnum.Thing)>]
[<TestCase("Thing", SomeEnum.Thing)>]
[<TestCase("THING", SomeEnum.Thing)>]
[<TestCase("blah", SomeEnum.Blah)>]
[<TestCase("Blah", SomeEnum.Blah)>]
[<TestCase("BLAH", SomeEnum.Blah)>]
let ``Can deserialise enum`` (str : string, expected : SomeEnum) =
sprintf "\"%s\"" str
|> JsonNode.Parse
|> SomeEnum.jsonParse
|> shouldEqual expected

View File

@@ -89,6 +89,9 @@ module TestJsonSerde =
let! f = Arb.generate |> Gen.filter (fun s -> Double.IsFinite (s / 1.0<measure>)) 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! 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! single = Arb.generate |> Gen.filter (fun s -> Single.IsFinite (s / 1.0f<measure>))
let! intMeasureOption = Arb.generate
let! intMeasureNullable = Arb.generate
let! someEnum = Gen.choose (0, 1)
return return
{ {
@@ -109,6 +112,9 @@ module TestJsonSerde =
F = f F = f
F32 = f32 F32 = f32
Single = single Single = single
IntMeasureOption = intMeasureOption
IntMeasureNullable = intMeasureNullable
Enum = enum<SomeEnum> someEnum
} }
} }

View File

@@ -96,6 +96,11 @@ type internal AdtProduct =
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module internal AstHelper = module internal AstHelper =
let isEnum (SynTypeDefn.SynTypeDefn (_, repr, _, _, _, _)) : bool =
match repr with
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Enum _, _) -> true
| _ -> false
let instantiateRecord (fields : (RecordFieldName * SynExpr option) list) : SynExpr = let instantiateRecord (fields : (RecordFieldName * SynExpr option) list) : SynExpr =
let fields = let fields =
fields fields

View File

@@ -1070,17 +1070,11 @@ module internal CataGenerator =
body body
|> SynExpr.createLet |> SynExpr.createLet
[ [
SynExpr.TypeApp ( (SynExpr.createIdent "ResizeArray")
SynExpr.createIdent "ResizeArray", |> SynExpr.typeApp
range0,
[ [
SynType.var (SynTypar.SynTypar (unionCase.GenericName, TyparStaticReq.None, false)) SynType.var (SynTypar.SynTypar (unionCase.GenericName, TyparStaticReq.None, false))
], ]
[],
Some range0,
range0,
range0
)
|> SynExpr.applyTo (SynExpr.CreateConst ()) |> SynExpr.applyTo (SynExpr.CreateConst ())
|> SynBinding.basic [ unionCase.StackName ] [] |> SynBinding.basic [ unionCase.StackName ] []
] ]

View File

@@ -449,7 +449,7 @@ module internal HttpClientGenerator =
SynExpr.createNew SynExpr.createNew
(SynType.createLongIdent' [ "System" ; "Net" ; "Http" ; "StringContent" ]) (SynType.createLongIdent' [ "System" ; "Net" ; "Http" ; "StringContent" ])
(SynExpr.createIdent' bodyParamName (SynExpr.createIdent' bodyParamName
|> SynExpr.pipeThroughFunction (JsonSerializeGenerator.serializeNode ty) |> SynExpr.pipeThroughFunction (fst (JsonSerializeGenerator.serializeNode ty))
|> SynExpr.pipeThroughFunction ( |> SynExpr.pipeThroughFunction (
SynExpr.createLambda SynExpr.createLambda
"node" "node"

View File

@@ -24,7 +24,7 @@ module internal JsonParseGenerator =
JsonNumberHandlingArg = None JsonNumberHandlingArg = None
} }
/// (match {indexed} with | null -> raise (System.Collections.Generic.KeyNotFoundException ()) | v -> v) /// (match {indexed} with | null -> raise (System.Collections.Generic.KeyNotFoundException ({propertyName} not found)) | v -> v)
let assertNotNull (propertyName : SynExpr) (indexed : SynExpr) = let assertNotNull (propertyName : SynExpr) (indexed : SynExpr) =
let raiseExpr = let raiseExpr =
SynExpr.applyFunction SynExpr.applyFunction
@@ -95,17 +95,6 @@ module internal JsonParseGenerator =
) )
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ collectionType ; "ofSeq" ]) |> 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 = let dotParse (typeName : LongIdent) : LongIdent =
List.append typeName [ Ident.create "Parse" ] List.append typeName [ Ident.create "Parse" ]
@@ -206,8 +195,29 @@ module internal JsonParseGenerator =
| NumberType typeName -> parseNumberType options propertyName node typeName | NumberType typeName -> parseNumberType options propertyName node typeName
| PrimitiveType typeName -> asValueGetValueIdent propertyName typeName node | PrimitiveType typeName -> asValueGetValueIdent propertyName typeName node
| OptionType ty -> | OptionType ty ->
parseNode None options ty (SynExpr.createIdent "v") let someClause =
|> createParseLineOption node 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 -> | ListType ty ->
parseNode None options ty (SynExpr.createIdent "elt") parseNode None options ty (SynExpr.createIdent "elt")
|> asArrayMapped propertyName "List" node |> asArrayMapped propertyName "List" node
@@ -478,6 +488,59 @@ module internal JsonParseGenerator =
|> SynBinding.basic [ Ident.create "ty" ] [] |> SynBinding.basic [ Ident.create "ty" ] []
] ]
let createEnumMaker
(spec : JsonParseOutputSpec)
(typeName : LongIdent)
(fields : (Ident * SynExpr) list)
: SynExpr
=
let numberKind =
[ "System" ; "Text" ; "Json" ; "JsonValueKind" ; "Number" ]
|> List.map Ident.create
let stringKind =
[ "System" ; "Text" ; "Json" ; "JsonValueKind" ; "String" ]
|> List.map Ident.create
let fail =
SynExpr.plus
(SynExpr.CreateConst "Unrecognised kind for enum of type: ")
(SynExpr.CreateConst (typeName |> List.map _.idText |> String.concat "."))
|> SynExpr.paren
|> SynExpr.applyFunction (SynExpr.createIdent "failwith")
let failString =
SynExpr.plus (SynExpr.CreateConst "Unrecognised value for enum: %i") (SynExpr.createIdent "v")
|> SynExpr.paren
|> SynExpr.applyFunction (SynExpr.createIdent "failwith")
let parseString =
fields
|> List.map (fun (ident, _) ->
SynMatchClause.create
(SynPat.createConst (
SynConst.String (ident.idText.ToLowerInvariant (), SynStringKind.Regular, range0)
))
(SynExpr.createLongIdent' (typeName @ [ ident ]))
)
|> fun l -> l @ [ SynMatchClause.create (SynPat.named "v") failString ]
|> SynExpr.createMatch (
asValueGetValue None "string" (SynExpr.createIdent "node")
|> SynExpr.callMethod "ToLowerInvariant"
)
[
SynMatchClause.create
(SynPat.identWithArgs numberKind (SynArgPats.create []))
(asValueGetValue None "int" (SynExpr.createIdent "node")
|> SynExpr.pipeThroughFunction (
SynExpr.typeApp [ SynType.createLongIdent typeName ] (SynExpr.createIdent "enum")
))
SynMatchClause.create (SynPat.identWithArgs stringKind (SynArgPats.create [])) parseString
SynMatchClause.create (SynPat.named "_") fail
]
|> SynExpr.createMatch (SynExpr.callMethod "GetValueKind" (SynExpr.createIdent "node"))
let createModule (namespaceId : LongIdent) (spec : JsonParseOutputSpec) (typeDefn : SynTypeDefn) = let createModule (namespaceId : LongIdent) (spec : JsonParseOutputSpec) (typeDefn : SynTypeDefn) =
let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) = let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) =
typeDefn typeDefn
@@ -538,6 +601,13 @@ module internal JsonParseGenerator =
|> List.map SynUnionCase.extract |> List.map SynUnionCase.extract
|> List.map (UnionCase.mapIdentFields optionGet) |> List.map (UnionCase.mapIdentFields optionGet)
|> createUnionMaker spec ident |> createUnionMaker spec ident
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Enum (cases, _range), _) ->
cases
|> List.map (fun c ->
match c with
| SynEnumCase.SynEnumCase (_, SynIdent.SynIdent (ident, _), value, _, _, _) -> ident, value
)
|> createEnumMaker spec ident
| _ -> failwithf "Not a record or union type" | _ -> failwithf "Not a record or union type"
[ scaffolding spec ident decl ] [ scaffolding spec ident decl ]
@@ -559,20 +629,21 @@ type JsonParseGenerator () =
let ast, _ = let ast, _ =
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
let recordsAndUnions = let relevantTypes =
Ast.extractTypeDefn ast Ast.extractTypeDefn ast
|> List.map (fun (name, defns) -> |> List.map (fun (name, defns) ->
defns defns
|> List.choose (fun defn -> |> List.choose (fun defn ->
if Ast.isRecord defn then Some defn if Ast.isRecord defn then Some defn
elif Ast.isDu defn then Some defn elif Ast.isDu defn then Some defn
elif AstHelper.isEnum defn then Some defn
else None else None
) )
|> fun defns -> name, defns |> fun defns -> name, defns
) )
let namespaceAndTypes = let namespaceAndTypes =
recordsAndUnions relevantTypes
|> List.choose (fun (ns, types) -> |> List.choose (fun (ns, types) ->
types types
|> List.choose (fun typeDef -> |> List.choose (fun typeDef ->

View File

@@ -13,9 +13,18 @@ type internal JsonSerializeOutputSpec =
module internal JsonSerializeGenerator = module internal JsonSerializeGenerator =
open Fantomas.FCS.Text.Range 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`. /// 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)`. /// 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 // TODO: serialization format for DateTime etc
match fieldType with match fieldType with
| DateOnly | DateOnly
@@ -26,29 +35,32 @@ module internal JsonSerializeGenerator =
| Guid | Guid
| Uri -> | Uri ->
// JsonValue.Create<type> // JsonValue.Create<type>
SynExpr.TypeApp ( SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonValue" ; "Create" ]
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonValue" ; "Create" ], |> SynExpr.typeApp [ fieldType ]
range0, |> fun e -> e, false
[ fieldType ], | NullableType ty ->
[], // fun field -> if field.HasValue then {serializeNode ty} field.Value else JsonValue.Create null
Some range0, let inner, innerIsJsonNode = serializeNode ty
range0,
range0 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 -> | OptionType ty ->
// fun field -> match field with | None -> JsonValue.Create null | Some v -> {serializeNode ty} field // fun field -> match field with | None -> JsonValue.Create null | Some v -> {serializeNode ty} field
let noneClause = let noneClause = jsonNull () |> SynMatchClause.create (SynPat.named "None")
// 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 someClause = let someClause =
SynExpr.applyFunction (serializeNode ty) (SynExpr.createIdent "field") let inner, innerIsJsonNode = serializeNode ty
|> SynExpr.paren let target = SynExpr.applyFunction inner (SynExpr.createIdent "field")
|> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
if innerIsJsonNode then
target
else
target
|> SynExpr.paren
|> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
|> SynMatchClause.create ( |> SynMatchClause.create (
SynPat.identWithArgs [ Ident.create "Some" ] (SynArgPats.create [ Ident.create "field" ]) SynPat.identWithArgs [ Ident.create "Some" ] (SynArgPats.create [ Ident.create "field" ])
) )
@@ -56,6 +68,7 @@ module internal JsonSerializeGenerator =
[ noneClause ; someClause ] [ noneClause ; someClause ]
|> SynExpr.createMatch (SynExpr.createIdent "field") |> SynExpr.createMatch (SynExpr.createIdent "field")
|> SynExpr.createLambda "field" |> SynExpr.createLambda "field"
|> fun e -> e, true
| ArrayType ty | ArrayType ty
| ListType ty -> | ListType ty ->
// fun field -> // fun field ->
@@ -72,7 +85,7 @@ module internal JsonSerializeGenerator =
SynExpr.createIdent "field", SynExpr.createIdent "field",
SynExpr.applyFunction SynExpr.applyFunction
(SynExpr.createLongIdent [ "arr" ; "Add" ]) (SynExpr.createLongIdent [ "arr" ; "Add" ])
(SynExpr.paren (SynExpr.applyFunction (serializeNode ty) (SynExpr.createIdent "mem"))), (SynExpr.paren (SynExpr.applyFunction (fst (serializeNode ty)) (SynExpr.createIdent "mem"))),
range0 range0
) )
SynExpr.createIdent "arr" SynExpr.createIdent "arr"
@@ -85,6 +98,7 @@ module internal JsonSerializeGenerator =
|> SynBinding.basic [ Ident.create "arr" ] [] |> SynBinding.basic [ Ident.create "arr" ] []
] ]
|> SynExpr.createLambda "field" |> SynExpr.createLambda "field"
|> fun e -> e, false
| IDictionaryType (_keyType, valueType) | IDictionaryType (_keyType, valueType)
| DictionaryType (_keyType, valueType) | DictionaryType (_keyType, valueType)
| IReadOnlyDictionaryType (_keyType, valueType) | IReadOnlyDictionaryType (_keyType, valueType)
@@ -112,7 +126,7 @@ module internal JsonSerializeGenerator =
[ [
SynExpr.createLongIdent [ "key" ; "ToString" ] SynExpr.createLongIdent [ "key" ; "ToString" ]
|> SynExpr.applyTo (SynExpr.CreateConst ()) |> SynExpr.applyTo (SynExpr.CreateConst ())
SynExpr.applyFunction (serializeNode valueType) (SynExpr.createIdent "value") SynExpr.applyFunction (fst (serializeNode valueType)) (SynExpr.createIdent "value")
]), ]),
range0 range0
) )
@@ -126,6 +140,7 @@ module internal JsonSerializeGenerator =
|> SynBinding.basic [ Ident.create "ret" ] [] |> SynBinding.basic [ Ident.create "ret" ] []
] ]
|> SynExpr.createLambda "field" |> SynExpr.createLambda "field"
|> fun e -> e, false
| _ -> | _ ->
// {type}.toJsonNode // {type}.toJsonNode
let typeName = let typeName =
@@ -133,16 +148,17 @@ module internal JsonSerializeGenerator =
| SynType.LongIdent ident -> ident.LongIdent | SynType.LongIdent ident -> ident.LongIdent
| _ -> failwith $"Unrecognised type: %+A{fieldType}" | _ -> 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 /// propertyName is probably a string literal, but it could be a [<Literal>] variable
/// `node.Add ({propertyName}, {toJsonNode})` /// `node.Add ({propertyName}, {toJsonNode})`
let createSerializeRhsRecord (propertyName : SynExpr) (fieldId : Ident) (fieldType : SynType) : SynExpr = let createSerializeRhsRecord (propertyName : SynExpr) (fieldId : Ident) (fieldType : SynType) : SynExpr =
[ [
propertyName propertyName
SynExpr.applyFunction SynExpr.pipeThroughFunction
(serializeNode fieldType) (fst (serializeNode fieldType))
(SynExpr.createLongIdent' [ Ident.create "input" ; fieldId ]) (SynExpr.createLongIdent' [ Ident.create "input" ; fieldId ])
|> SynExpr.paren
] ]
|> SynExpr.tuple |> SynExpr.tuple
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ]) |> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ])
@@ -229,8 +245,7 @@ module internal JsonSerializeGenerator =
|> SynBinding.withXmlDoc xmlDoc |> SynBinding.withXmlDoc xmlDoc
|> SynModuleDecl.createLet |> SynModuleDecl.createLet
let recordModule (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (fields : SynField list) = let recordModule (spec : JsonSerializeOutputSpec) (_typeName : LongIdent) (fields : SynField list) =
let inputArg = Ident.create "input"
let fields = fields |> List.map SynField.extractWithIdent let fields = fields |> List.map SynField.extractWithIdent
fields fields
@@ -240,7 +255,6 @@ module internal JsonSerializeGenerator =
) )
|> SynExpr.sequential |> SynExpr.sequential
|> fun expr -> SynExpr.Do (expr, range0) |> fun expr -> SynExpr.Do (expr, range0)
|> scaffolding spec typeName inputArg
let unionModule (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (cases : SynUnionCase list) = let unionModule (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (cases : SynUnionCase list) =
let inputArg = Ident.create "input" let inputArg = Ident.create "input"
@@ -286,7 +300,7 @@ module internal JsonSerializeGenerator =
let propertyName = getPropertyName (Option.get fieldData.Ident) fieldData.Attrs let propertyName = getPropertyName (Option.get fieldData.Ident) fieldData.Attrs
let node = let node =
SynExpr.applyFunction (serializeNode fieldData.Type) (SynExpr.createIdent' caseName) SynExpr.applyFunction (fst (serializeNode fieldData.Type)) (SynExpr.createIdent' caseName)
[ propertyName ; node ] [ propertyName ; node ]
|> SynExpr.tuple |> SynExpr.tuple
@@ -313,7 +327,68 @@ module internal JsonSerializeGenerator =
SynMatchClause.create pattern action SynMatchClause.create pattern action
) )
|> SynExpr.createMatch (SynExpr.createIdent' inputArg) |> SynExpr.createMatch (SynExpr.createIdent' inputArg)
|> scaffolding spec typeName inputArg
let enumModule
(spec : JsonSerializeOutputSpec)
(typeName : LongIdent)
(cases : (Ident * SynExpr) list)
: SynModuleDecl
=
let fail =
SynExpr.CreateConst "Unrecognised value for enum: %O"
|> SynExpr.applyFunction (SynExpr.createIdent "sprintf")
|> SynExpr.applyTo (SynExpr.createIdent "v")
|> SynExpr.paren
|> SynExpr.applyFunction (SynExpr.createIdent "failwith")
let body =
cases
|> List.map (fun (caseName, value) ->
value
|> SynExpr.applyFunction (
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonValue" ; "Create" ]
)
|> SynMatchClause.create (SynPat.identWithArgs (typeName @ [ caseName ]) (SynArgPats.create []))
)
|> fun l -> l @ [ SynMatchClause.create (SynPat.named "v") fail ]
|> SynExpr.createMatch (SynExpr.createIdent "input")
let xmlDoc = PreXmlDoc.create "Serialize to a JSON node"
let returnInfo =
SynLongIdent.createS' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
|> SynType.LongIdent
let functionName = Ident.create "toJsonNode"
let pattern =
SynPat.named "input"
|> SynPat.annotateType (SynType.LongIdent (SynLongIdent.create typeName))
if spec.ExtensionMethods then
let componentInfo =
SynComponentInfo.createLong typeName
|> SynComponentInfo.withDocString (PreXmlDoc.create "Extension methods for JSON parsing")
let memberDef =
body
|> SynBinding.basic [ functionName ] [ pattern ]
|> SynBinding.withXmlDoc xmlDoc
|> SynBinding.withReturnAnnotation returnInfo
|> SynMemberDefn.staticMember
let containingType =
SynTypeDefnRepr.augmentation ()
|> SynTypeDefn.create componentInfo
|> SynTypeDefn.withMemberDefns [ memberDef ]
SynModuleDecl.Types ([ containingType ], range0)
else
body
|> SynBinding.basic [ functionName ] [ pattern ]
|> SynBinding.withReturnAnnotation returnInfo
|> SynBinding.withXmlDoc xmlDoc
|> SynModuleDecl.createLet
let createModule let createModule
(namespaceId : LongIdent) (namespaceId : LongIdent)
@@ -369,14 +444,23 @@ module internal JsonSerializeGenerator =
let decls = let decls =
match synTypeDefnRepr with match synTypeDefnRepr with
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, recordFields, _range), _) -> | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, recordFields, _range), _) ->
[ recordModule spec ident recordFields ] recordModule spec ident recordFields
|> scaffolding spec ident (Ident.create "input")
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (_accessibility, unionFields, _range), _) -> | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (_accessibility, unionFields, _range), _) ->
[ unionModule spec ident unionFields ] unionModule spec ident unionFields
| _ -> failwithf "Only record types currently supported." |> scaffolding spec ident (Ident.create "input")
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Enum (cases, _range), _) ->
cases
|> List.map (fun c ->
match c with
| SynEnumCase.SynEnumCase (_, SynIdent.SynIdent (ident, _), value, _, _, _) -> ident, value
)
|> enumModule spec ident
| ty -> failwithf "Unsupported type: got %O" ty
[ [
yield! opens |> List.map SynModuleDecl.openAny yield! opens |> List.map SynModuleDecl.openAny
yield SynModuleDecl.nestedModule info decls yield decls |> List.singleton |> SynModuleDecl.nestedModule info
] ]
|> SynModuleOrNamespace.createNamespace namespaceId |> SynModuleOrNamespace.createNamespace namespaceId
@@ -394,20 +478,21 @@ type JsonSerializeGenerator () =
let ast, _ = let ast, _ =
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
let recordsAndUnions = let relevantTypes =
Ast.extractTypeDefn ast Ast.extractTypeDefn ast
|> List.map (fun (name, defns) -> |> List.map (fun (name, defns) ->
defns defns
|> List.choose (fun defn -> |> List.choose (fun defn ->
if Ast.isRecord defn then Some defn if Ast.isRecord defn then Some defn
elif Ast.isDu defn then Some defn elif Ast.isDu defn then Some defn
elif AstHelper.isEnum defn then Some defn
else None else None
) )
|> fun defns -> name, defns |> fun defns -> name, defns
) )
let namespaceAndTypes = let namespaceAndTypes =
recordsAndUnions relevantTypes
|> List.choose (fun (ns, types) -> |> List.choose (fun (ns, types) ->
types types
|> List.choose (fun typeDef -> |> List.choose (fun typeDef ->

View File

@@ -106,43 +106,33 @@ module internal SynExpr =
| SynExpr.Paren (expr, _, _, _) -> stripOptionalParen expr | SynExpr.Paren (expr, _, _, _) -> stripOptionalParen expr
| expr -> expr | expr -> expr
/// {obj}.{meth} {arg} let dotGet (field : string) (obj : SynExpr) : SynExpr =
let callMethodArg (meth : string) (arg : SynExpr) (obj : SynExpr) : SynExpr =
SynExpr.DotGet ( SynExpr.DotGet (
obj, obj,
range0, range0,
SynLongIdent.SynLongIdent (id = [ Ident.create meth ], dotRanges = [], trivia = [ None ]), SynLongIdent.SynLongIdent (id = [ Ident.create field ], dotRanges = [], trivia = [ None ]),
range0 range0
) )
|> applyTo arg
/// {obj}.{meth} {arg}
let callMethodArg (meth : string) (arg : SynExpr) (obj : SynExpr) : SynExpr = dotGet meth obj |> applyTo arg
/// {obj}.{meth}() /// {obj}.{meth}()
let callMethod (meth : string) (obj : SynExpr) : SynExpr = let callMethod (meth : string) (obj : SynExpr) : SynExpr =
callMethodArg meth (SynExpr.CreateConst ()) obj callMethodArg meth (SynExpr.CreateConst ()) obj
let typeApp (types : SynType list) (operand : SynExpr) =
SynExpr.TypeApp (operand, range0, types, List.replicate (types.Length - 1) range0, Some range0, range0, range0)
let callGenericMethod (meth : string) (ty : LongIdent) (obj : SynExpr) : SynExpr = let callGenericMethod (meth : string) (ty : LongIdent) (obj : SynExpr) : SynExpr =
SynExpr.TypeApp ( SynExpr.DotGet (obj, range0, SynLongIdent.createS meth, range0)
SynExpr.DotGet (obj, range0, SynLongIdent.createS meth, range0), |> typeApp [ SynType.LongIdent (SynLongIdent.create ty) ]
range0,
[ SynType.LongIdent (SynLongIdent.create ty) ],
[],
Some range0,
range0,
range0
)
|> applyTo (SynExpr.CreateConst ()) |> applyTo (SynExpr.CreateConst ())
/// {obj}.{meth}<ty>() /// {obj}.{meth}<ty>()
let callGenericMethod' (meth : string) (ty : string) (obj : SynExpr) : SynExpr = let callGenericMethod' (meth : string) (ty : string) (obj : SynExpr) : SynExpr =
SynExpr.TypeApp ( SynExpr.DotGet (obj, range0, SynLongIdent.createS meth, range0)
SynExpr.DotGet (obj, range0, SynLongIdent.createS meth, range0), |> typeApp [ SynType.createLongIdent' [ ty ] ]
range0,
[ SynType.createLongIdent' [ ty ] ],
[],
Some range0,
range0,
range0
)
|> applyTo (SynExpr.CreateConst ()) |> applyTo (SynExpr.CreateConst ())
let inline index (property : SynExpr) (obj : SynExpr) : SynExpr = let inline index (property : SynExpr) (obj : SynExpr) : SynExpr =

View File

@@ -70,6 +70,12 @@ module internal SynLongIdent =
// TODO: consider Microsoft.FSharp.Option or whatever it is // TODO: consider Microsoft.FSharp.Option or whatever it is
| _ -> false | _ -> false
let isNullable (ident : SynLongIdent) : bool =
match ident.LongIdent |> List.map _.idText with
| [ "System" ; "Nullable" ]
| [ "Nullable" ] -> true
| _ -> false
let isResponse (ident : SynLongIdent) : bool = let isResponse (ident : SynLongIdent) : bool =
match ident.LongIdent |> List.map _.idText with match ident.LongIdent |> List.map _.idText with
| [ "Response" ] | [ "Response" ]

View File

@@ -59,6 +59,12 @@ module internal SynTypePatterns =
Some innerType Some innerType
| _ -> None | _ -> 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 = let (|UnitType|_|) (fieldType : SynType) : unit option =
match fieldType with match fieldType with
| SynType.LongIdent ident when SynLongIdent.isUnit ident -> Some () | SynType.LongIdent ident when SynLongIdent.isUnit ident -> Some ()