Compare commits

...

5 Commits

Author SHA1 Message Date
dependabot[bot]
e96803e303 Bump ApiSurface from 4.0.42 to 4.0.43 (#180)
* Bump ApiSurface from 4.0.42 to 4.0.43

Bumps ApiSurface from 4.0.42 to 4.0.43.

---
updated-dependencies:
- dependency-name: ApiSurface
  dependency-type: direct:production
  update-type: version-update:semver-patch
...

Signed-off-by: dependabot[bot] <support@github.com>

* Deps

---------

Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
Co-authored-by: Smaug123 <3138005+Smaug123@users.noreply.github.com>
2024-07-08 19:06:18 +01:00
dependabot[bot]
b53b410feb Bump ApiSurface from 4.0.41 to 4.0.42 (#176)
* Bump ApiSurface from 4.0.41 to 4.0.42

Bumps [ApiSurface](https://github.com/G-Research/ApiSurface) from 4.0.41 to 4.0.42.
- [Release notes](https://github.com/G-Research/ApiSurface/releases)
- [Commits](https://github.com/G-Research/ApiSurface/compare/ApiSurface.4.0.41...ApiSurface.4.0.42)

---
updated-dependencies:
- dependency-name: ApiSurface
  dependency-type: direct:production
  update-type: version-update:semver-patch
...

Signed-off-by: dependabot[bot] <support@github.com>

* Deps

---------

Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
Co-authored-by: Smaug123 <3138005+Smaug123@users.noreply.github.com>
2024-07-01 18:21:26 +01:00
Patrick Stevens
398cd04a2a Support DateTimeOffset in JSON generators (#179) 2024-07-01 18:08:09 +01:00
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
15 changed files with 515 additions and 77 deletions

View File

@@ -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 =
@@ -184,6 +202,14 @@ module JsonRecordTypeWithBothJsonSerializeExtension =
)) ))
) )
node.Add ("enum", (input.Enum |> SomeEnum.toJsonNode))
node.Add (
"timestamp",
(input.Timestamp
|> (fun field -> field.ToString "o" |> System.Text.Json.Nodes.JsonValue.Create<string>))
)
node :> _ node :> _
namespace ConsumePlugin namespace ConsumePlugin
@@ -216,6 +242,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
@@ -323,6 +398,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 =
@@ -331,6 +424,31 @@ 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_20 =
(match node.["timestamp"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("timestamp")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
|> System.DateTimeOffset.Parse
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 = let arg_18 =
match node.["intMeasureNullable"] with match node.["intMeasureNullable"] with
| null -> System.Nullable () | null -> System.Nullable ()
@@ -585,6 +703,8 @@ module JsonRecordTypeWithBothJsonParseExtension =
Single = arg_16 Single = arg_16
IntMeasureOption = arg_17 IntMeasureOption = arg_17
IntMeasureNullable = arg_18 IntMeasureNullable = arg_18
Enum = arg_19
Timestamp = arg_20
} }
namespace ConsumePlugin namespace ConsumePlugin
@@ -666,3 +786,59 @@ 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
}
namespace ConsumePlugin
/// Module containing JSON parsing extension members for the Foo type
[<AutoOpen>]
module FooJsonParseExtension =
/// Extension methods for JSON parsing
type Foo with
/// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : Foo =
let arg_0 =
match node.["message"] with
| null -> None
| v -> HeaderAndValue.jsonParse v |> Some
{
Message = arg_0
}

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
@@ -42,6 +48,8 @@ type JsonRecordTypeWithBoth =
Single : single<measure> Single : single<measure>
IntMeasureOption : int<measure> option IntMeasureOption : int<measure> option
IntMeasureNullable : int<measure> Nullable IntMeasureNullable : int<measure> Nullable
Enum : SomeEnum
Timestamp : DateTimeOffset
} }
[<WoofWare.Myriad.Plugins.JsonSerialize true>] [<WoofWare.Myriad.Plugins.JsonSerialize true>]
@@ -50,3 +58,18 @@ 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>]
[<WoofWare.Myriad.Plugins.JsonParse true>]
type Foo =
{
Message : HeaderAndValue option
}

View File

@@ -12,7 +12,7 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="ApiSurface" Version="4.0.41" /> <PackageReference Include="ApiSurface" Version="4.0.43" />
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.10.0"/> <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.10.0"/>
<PackageReference Include="NUnit" Version="4.1.0"/> <PackageReference Include="NUnit" Version="4.1.0"/>
<PackageReference Include="NUnit3TestAdapter" Version="4.5.0"/> <PackageReference Include="NUnit3TestAdapter" Version="4.5.0"/>

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

@@ -91,6 +91,8 @@ module TestJsonSerde =
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! intMeasureOption = Arb.generate
let! intMeasureNullable = Arb.generate let! intMeasureNullable = Arb.generate
let! someEnum = Gen.choose (0, 1)
let! timestamp = Arb.generate
return return
{ {
@@ -113,6 +115,8 @@ module TestJsonSerde =
Single = single Single = single
IntMeasureOption = intMeasureOption IntMeasureOption = intMeasureOption
IntMeasureNullable = intMeasureNullable IntMeasureNullable = intMeasureNullable
Enum = enum<SomeEnum> someEnum
Timestamp = timestamp
} }
} }
@@ -130,6 +134,80 @@ module TestJsonSerde =
property |> Prop.forAll (Arb.fromGen outerGen) |> Check.QuickThrowOnFailure property |> Prop.forAll (Arb.fromGen outerGen) |> Check.QuickThrowOnFailure
[<Test>]
let ``Single example of big record`` () =
let guid = Guid.Parse "dfe24db5-9f8d-447b-8463-4c0bcf1166d5"
let data =
{
A = 3
B = "hello!"
C = [ 1 ; -9 ]
D =
{
Thing = guid
Map = Map.ofList []
ReadOnlyDict = readOnlyDict []
Dict = dict []
ConcreteDict = Dictionary ()
}
E = [| "I'm-a-string" |]
Arr = [| -18883 ; 9100 |]
Byte = 87uy<measure>
Sbyte = 89y<measure>
I = 199993345<measure>
I32 = -485832<measure>
I64 = -13458625689L<measure>
U = 458582u<measure>
U32 = 857362147u<measure>
U64 = 1234567892123414596UL<measure>
F = 8833345667.1<measure>
F32 = 1000.98f<measure>
Single = 0.334f<measure>
IntMeasureOption = Some 981<measure>
IntMeasureNullable = Nullable -883<measure>
Enum = enum<SomeEnum> 1
Timestamp = DateTimeOffset (2024, 07, 01, 17, 54, 00, TimeSpan.FromHours 1.0)
}
let expected =
"""{
"a": 3,
"b": "hello!",
"c": [1, -9],
"d": {
"it\u0027s-a-me": "dfe24db5-9f8d-447b-8463-4c0bcf1166d5",
"map": {},
"readOnlyDict": {},
"dict": {},
"concreteDict": {}
},
"e": ["I\u0027m-a-string"],
"arr": [-18883, 9100],
"byte": 87,
"sbyte": 89,
"i": 199993345,
"i32": -485832,
"i64": -13458625689,
"u": 458582,
"u32": 857362147,
"u64": 1234567892123414596,
"f": 8833345667.1,
"f32": 1000.98,
"single": 0.334,
"intMeasureOption": 981,
"intMeasureNullable": -883,
"enum": 1,
"timestamp": "2024-07-01T17:54:00.0000000\u002B01:00"
}
"""
|> fun s -> s.ToCharArray ()
|> Array.filter (fun c -> not (Char.IsWhiteSpace c))
|> fun s -> new String (s)
JsonRecordTypeWithBoth.toJsonNode(data).ToJsonString () |> shouldEqual expected
JsonRecordTypeWithBoth.jsonParse (JsonNode.Parse expected) |> shouldEqual data
[<Test>] [<Test>]
let ``Guids are treated just like strings`` () = let ``Guids are treated just like strings`` () =
let guidStr = "b1e7496e-6e79-4158-8579-a01de355d3b2" let guidStr = "b1e7496e-6e79-4158-8579-a01de355d3b2"

View File

@@ -33,7 +33,7 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="ApiSurface" Version="4.0.41"/> <PackageReference Include="ApiSurface" Version="4.0.43"/>
<PackageReference Include="FsCheck" Version="2.16.6"/> <PackageReference Include="FsCheck" Version="2.16.6"/>
<PackageReference Include="FsUnit" Version="6.0.0"/> <PackageReference Include="FsUnit" Version="6.0.0"/>
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.10.0"/> <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.10.0"/>

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
@@ -192,6 +192,10 @@ module internal JsonParseGenerator =
node node
|> asValueGetValue propertyName "string" |> asValueGetValue propertyName "string"
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "DateTime" ; "Parse" ]) |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "DateTime" ; "Parse" ])
| DateTimeOffset ->
node
|> asValueGetValue propertyName "string"
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "DateTimeOffset" ; "Parse" ])
| 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 ->
@@ -488,6 +492,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
@@ -548,6 +605,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 ]
@@ -569,20 +633,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

@@ -23,7 +23,8 @@ module internal JsonSerializeGenerator =
/// 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
@@ -34,29 +35,43 @@ 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 ], | DateTimeOffset ->
[], // fun field -> field.ToString("o") |> JsonValue.Create<string>
Some range0, let create =
range0, SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonValue" ; "Create" ]
range0 |> SynExpr.typeApp [ SynType.named "string" ]
)
SynExpr.createIdent "field"
|> SynExpr.callMethodArg "ToString" (SynExpr.CreateConst "o")
|> SynExpr.pipeThroughFunction create
|> SynExpr.createLambda "field"
|> fun e -> e, false
| NullableType ty -> | NullableType ty ->
// fun field -> if field.HasValue then {serializeNode ty} field.Value else JsonValue.Create null // 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.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
|> SynExpr.ifThenElse (SynExpr.createLongIdent [ "field" ; "HasValue" ]) (jsonNull ()) |> SynExpr.ifThenElse (SynExpr.createLongIdent [ "field" ; "HasValue" ]) (jsonNull ())
|> SynExpr.createLambda "field" |> 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 = jsonNull () |> SynMatchClause.create (SynPat.named "None") let noneClause = jsonNull () |> 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" ])
) )
@@ -64,6 +79,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 ->
@@ -80,7 +96,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"
@@ -93,6 +109,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)
@@ -120,7 +137,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
) )
@@ -134,6 +151,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 =
@@ -141,7 +159,7 @@ 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})`
@@ -149,7 +167,7 @@ module internal JsonSerializeGenerator =
[ [
propertyName propertyName
SynExpr.pipeThroughFunction SynExpr.pipeThroughFunction
(serializeNode fieldType) (fst (serializeNode fieldType))
(SynExpr.createLongIdent' [ Ident.create "input" ; fieldId ]) (SynExpr.createLongIdent' [ Ident.create "input" ; fieldId ])
|> SynExpr.paren |> SynExpr.paren
] ]
@@ -238,8 +256,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
@@ -249,7 +266,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"
@@ -295,7 +311,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
@@ -322,7 +338,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)
@@ -378,14 +455,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
@@ -403,20 +489,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

@@ -121,29 +121,18 @@ module internal SynExpr =
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

@@ -241,6 +241,15 @@ module internal SynTypePatterns =
| _ -> None | _ -> None
| _ -> None | _ -> None
let (|DateTimeOffset|_|) (fieldType : SynType) =
match fieldType with
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
match ident |> List.map (fun i -> i.idText) with
| [ "System" ; "DateTimeOffset" ]
| [ "DateTimeOffset" ] -> Some ()
| _ -> None
| _ -> None
let (|Uri|_|) (fieldType : SynType) = let (|Uri|_|) (fieldType : SynType) =
match fieldType with match fieldType with
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) -> | SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->

View File

@@ -6,7 +6,7 @@
"pathFilters": [ "pathFilters": [
"./", "./",
":/WoofWare.Myriad.Plugins.Attributes", ":/WoofWare.Myriad.Plugins.Attributes",
"^:/WoofWare.Myriad.Plugins.Attributes/WoofWare.Myriad.Plugins.Attributes.Test", "^:/WoofWare.Myriad.Plugins.Attributes/Test",
":/global.json", ":/global.json",
":/README.md", ":/README.md",
":/Directory.Build.props" ":/Directory.Build.props"

View File

@@ -3,8 +3,8 @@
{fetchNuGet}: [ {fetchNuGet}: [
(fetchNuGet { (fetchNuGet {
pname = "ApiSurface"; pname = "ApiSurface";
version = "4.0.41"; version = "4.0.43";
sha256 = "03kfa5ngmgkik9lc58sp8s9rrh9g40hhgjnrv662ks0d0y2i9i89"; sha256 = "0bx09n3c751vz7v39pcdm6zb8k5p01fzc2vlclgkxg4nj38mmvh8";
}) })
(fetchNuGet { (fetchNuGet {
pname = "fantomas"; pname = "fantomas";
@@ -193,33 +193,33 @@
}) })
(fetchNuGet { (fetchNuGet {
pname = "NuGet.Common"; pname = "NuGet.Common";
version = "6.10.0"; version = "6.10.1";
sha256 = "0nizrnilmlcqbm945293h8q3wfqfchb4xi8g50x4kjn0rbpd1kbh"; sha256 = "1z69k0j727jcwrxzmvnixdac84lb9706iabqs8mrns8j7kbmw1ns";
}) })
(fetchNuGet { (fetchNuGet {
pname = "NuGet.Configuration"; pname = "NuGet.Configuration";
version = "6.10.0"; version = "6.10.1";
sha256 = "1aqaknaawnqx4mnvx9qw73wvj48jjzv0d78dzwl7m9zjlrl9myhz"; sha256 = "0qy2bdi3dz6fdw7qbv77fg956idm9d9733j8b1pcrcj9pfayys26";
}) })
(fetchNuGet { (fetchNuGet {
pname = "NuGet.Frameworks"; pname = "NuGet.Frameworks";
version = "6.10.0"; version = "6.10.1";
sha256 = "0hrd8y31zx9a0wps49czw0qgbrakb49zn3abfgylc9xrq990zkqk"; sha256 = "1p8d701fhbqv2r8vqmj948af9xvz2fd3273803cdrjy3a2wykmq1";
}) })
(fetchNuGet { (fetchNuGet {
pname = "NuGet.Packaging"; pname = "NuGet.Packaging";
version = "6.10.0"; version = "6.10.1";
sha256 = "18s53cvrf51lihmaqqdf48p2qi6ky1l48jv0hvbp76cxwdg7rba4"; sha256 = "0zl8xfzvd1yij2ln6iwy6cz8qfwlbyyqlin872ab5y58ws61a2x2";
}) })
(fetchNuGet { (fetchNuGet {
pname = "NuGet.Protocol"; pname = "NuGet.Protocol";
version = "6.10.0"; version = "6.10.1";
sha256 = "0hmv4q0ks9i34mfgpb13l01la9v3jjllfh1qd3aqv105xrqrdxac"; sha256 = "0zw5q1pn74qa1mcxx5268nklx18442s76x70dlqan4pm9kbvzr2i";
}) })
(fetchNuGet { (fetchNuGet {
pname = "NuGet.Versioning"; pname = "NuGet.Versioning";
version = "6.10.0"; version = "6.10.1";
sha256 = "1x19njx4x0sw9fz8y5fibi15xfsrw5avir0cx0599yd7p3ykik5g"; sha256 = "0lji7g6abnpmhzlgvni8wlb7l62n4180v3sphp4494wi0gn7ds4c";
}) })
(fetchNuGet { (fetchNuGet {
pname = "NUnit"; pname = "NUnit";