Compare commits

...

4 Commits

Author SHA1 Message Date
Patrick Stevens
35cd94cba1 Add JSON serialisation of DUs (#144) 2024-05-30 12:00:55 +01:00
Patrick Stevens
1b3eb03380 NerdBank.GitVersioning heights (#143) 2024-05-29 00:44:16 +01:00
dependabot[bot]
b846ce08a3 Bump Microsoft.NET.Test.Sdk from 17.9.0 to 17.10.0 (#141)
* Bump Microsoft.NET.Test.Sdk from 17.9.0 to 17.10.0

Bumps [Microsoft.NET.Test.Sdk](https://github.com/microsoft/vstest) from 17.9.0 to 17.10.0.
- [Release notes](https://github.com/microsoft/vstest/releases)
- [Changelog](https://github.com/microsoft/vstest/blob/main/docs/releases.md)
- [Commits](https://github.com/microsoft/vstest/compare/v17.9.0...v17.10.0)

---
updated-dependencies:
- dependency-name: Microsoft.NET.Test.Sdk
  dependency-type: direct:production
  update-type: version-update:semver-minor
...

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

* Bump ApiSurface from 4.0.39 to 4.0.40

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

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

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

* Update 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-05-27 12:03:40 +01:00
Patrick Stevens
4b9f63d374 Express HttpClient as extension method (#140) 2024-05-24 22:09:33 +01:00
28 changed files with 942 additions and 240 deletions

View File

@@ -1,6 +1,18 @@
Notable changes are recorded here.
# WoofWare.Myriad.Plugins 1.4 -> 2.0
# WoofWare.Myriad.Plugins 2.1.20, WoofWare.Myriad.Plugins.Attributes 3.0.1
We now bundle copies of the RestEase attributes in `WoofWare.Myriad.Plugins.Attributes`, in case you don't want to take a dependency on RestEase.
# WoofWare.Myriad.Plugins 2.1.15
The `GenerateMock` generator now permits a limited amount of inheritance in the record we're mocking out (specifically, `IDisposable`).
# WoofWare.Myriad.Plugins 2.1.8
No change to the packages, but this is when we started creating and tagging GitHub releases, which are a better source of truth than this file.
# WoofWare.Myriad.Plugins 2.0
This transition split the attributes (e.g. `[<JsonParseAttribute>]`) into their own assembly, WoofWare.Myriad.Plugins.Attributes.
The new assembly has minimal dependencies, so you may safely use it from your own code.

View File

@@ -60,7 +60,7 @@ module TreeCata =
instructions.RemoveAt (instructions.Count - 1)
match currentInstruction with
| Instruction.Process__TreeBuilder x ->
| Instruction.Process__TreeBuilder (x) ->
match x with
| TreeBuilder.Child (arg0_0) ->
instructions.Add Instruction.TreeBuilder_Child
@@ -68,7 +68,7 @@ module TreeCata =
| TreeBuilder.Parent (arg0_0) ->
instructions.Add Instruction.TreeBuilder_Parent
instructions.Add (Instruction.Process__Tree arg0_0)
| Instruction.Process__Tree x ->
| Instruction.Process__Tree (x) ->
match x with
| Tree.Const (arg0_0, arg1_0) -> cata.Tree.Const arg0_0 arg1_0 |> treeStack.Add
| Tree.Pair (arg0_0, arg1_0, arg2_0) ->

View File

@@ -41,7 +41,7 @@ module FileSystemItemCata =
instructions.RemoveAt (instructions.Count - 1)
match currentInstruction with
| Instruction.Process__FileSystemItem x ->
| Instruction.Process__FileSystemItem (x) ->
match x with
| FileSystemItem.Directory ({
Name = name
@@ -116,7 +116,7 @@ module GiftCata =
instructions.RemoveAt (instructions.Count - 1)
match currentInstruction with
| Instruction.Process__Gift x ->
| Instruction.Process__Gift (x) ->
match x with
| Gift.Book (arg0_0) -> cata.Gift.Book arg0_0 |> giftStack.Add
| Gift.Chocolate (arg0_0) -> cata.Gift.Chocolate arg0_0 |> giftStack.Add

View File

@@ -149,6 +149,37 @@ module JsonRecordTypeWithBothJsonSerializeExtension =
)
node :> _
namespace ConsumePlugin
open System
open System.Collections.Generic
open System.Text.Json.Serialization
/// Module containing JSON serializing extension members for the FirstDu type
[<AutoOpen>]
module FirstDuJsonSerializeExtension =
/// Extension methods for JSON parsing
type FirstDu with
/// Serialize to a JSON node
static member toJsonNode (input : FirstDu) : System.Text.Json.Nodes.JsonNode =
let node = System.Text.Json.Nodes.JsonObject ()
match input with
| FirstDu.EmptyCase -> node.Add ("type", System.Text.Json.Nodes.JsonValue.Create "emptyCase")
| FirstDu.Case1 (arg0) ->
node.Add ("type", System.Text.Json.Nodes.JsonValue.Create "case1")
let dataNode = System.Text.Json.Nodes.JsonObject ()
dataNode.Add ("data", System.Text.Json.Nodes.JsonValue.Create<string> arg0)
node.Add ("data", dataNode)
| FirstDu.Case2 (arg0, arg1) ->
node.Add ("type", System.Text.Json.Nodes.JsonValue.Create "case2")
let dataNode = System.Text.Json.Nodes.JsonObject ()
dataNode.Add ("record", JsonRecordTypeWithBoth.toJsonNode arg0)
dataNode.Add ("i", System.Text.Json.Nodes.JsonValue.Create<int> arg1)
node.Add ("data", dataNode)
node :> _
namespace ConsumePlugin

View File

@@ -543,3 +543,201 @@ module VaultClient =
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
}
namespace ConsumePlugin
open System
open System.Collections.Generic
open System.Text.Json.Serialization
open System.Threading
open System.Threading.Tasks
open RestEase
/// Module for constructing a REST client.
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
[<RequireQualifiedAccess>]
module VaultClientNonExtensionMethod =
/// Create a REST client.
let make (client : System.Net.Http.HttpClient) : IVaultClientNonExtensionMethod =
{ new IVaultClientNonExtensionMethod with
member _.GetSecret
(jwt : JwtVaultResponse, path : string, mountPoint : string, ct : CancellationToken option)
=
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
(match client.BaseAddress with
| null ->
raise (
System.ArgumentNullException (
nameof (client.BaseAddress),
"No base address was supplied on the type, and no BaseAddress was on the HttpClient."
)
)
| v -> v),
System.Uri (
"v1/{mountPoint}/{path}"
.Replace("{path}", path.ToString () |> System.Web.HttpUtility.UrlEncode)
.Replace (
"{mountPoint}",
mountPoint.ToString () |> System.Web.HttpUtility.UrlEncode
),
System.UriKind.Relative
)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
let! jsonNode =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
return JwtSecretResponse.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.GetJwt (role : string, jwt : string, ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
(match client.BaseAddress with
| null ->
raise (
System.ArgumentNullException (
nameof (client.BaseAddress),
"No base address was supplied on the type, and no BaseAddress was on the HttpClient."
)
)
| v -> v),
System.Uri ("v1/auth/jwt/login", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
let! jsonNode =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
return JwtVaultResponse.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
}
namespace ConsumePlugin
open System
open System.Collections.Generic
open System.Text.Json.Serialization
open System.Threading
open System.Threading.Tasks
open RestEase
/// Extension methods for constructing a REST client.
[<AutoOpen>]
module VaultClientExtensionMethodHttpClientExtension =
/// Extension methods for HTTP clients
type VaultClientExtensionMethod with
/// Create a REST client.
static member make (client : System.Net.Http.HttpClient) : IVaultClientExtensionMethod =
{ new IVaultClientExtensionMethod with
member _.GetSecret
(jwt : JwtVaultResponse, path : string, mountPoint : string, ct : CancellationToken option)
=
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
(match client.BaseAddress with
| null ->
raise (
System.ArgumentNullException (
nameof (client.BaseAddress),
"No base address was supplied on the type, and no BaseAddress was on the HttpClient."
)
)
| v -> v),
System.Uri (
"v1/{mountPoint}/{path}"
.Replace("{path}", path.ToString () |> System.Web.HttpUtility.UrlEncode)
.Replace (
"{mountPoint}",
mountPoint.ToString () |> System.Web.HttpUtility.UrlEncode
),
System.UriKind.Relative
)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
let! jsonNode =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
return JwtSecretResponse.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.GetJwt (role : string, jwt : string, ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
(match client.BaseAddress with
| null ->
raise (
System.ArgumentNullException (
nameof (client.BaseAddress),
"No base address was supplied on the type, and no BaseAddress was on the HttpClient."
)
)
| v -> v),
System.Uri ("v1/auth/jwt/login", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
let! jsonNode =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
return JwtVaultResponse.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
}

View File

@@ -41,7 +41,7 @@ module MyListCata =
instructions.RemoveAt (instructions.Count - 1)
match currentInstruction with
| Instruction.Process__MyList x ->
| Instruction.Process__MyList (x) ->
match x with
| MyList.Nil -> cata.MyList.Nil |> myListStack.Add
| MyList.Cons ({
@@ -97,7 +97,7 @@ module MyList2Cata =
instructions.RemoveAt (instructions.Count - 1)
match currentInstruction with
| Instruction.Process__MyList2 x ->
| Instruction.Process__MyList2 (x) ->
match x with
| MyList2.Nil -> cata.MyList2.Nil |> myList2Stack.Add
| MyList2.Cons (arg0_0, arg1_0) ->

View File

@@ -27,3 +27,9 @@ type JsonRecordTypeWithBoth =
E : string array
F : int[]
}
[<WoofWare.Myriad.Plugins.JsonSerialize true>]
type FirstDu =
| EmptyCase
| Case1 of data : string
| Case2 of record : JsonRecordTypeWithBoth * i : int

View File

@@ -76,3 +76,33 @@ type IVaultClient =
[<Get "v1/auth/jwt/login">]
abstract GetJwt : role : string * jwt : string * ?ct : CancellationToken -> Task<JwtVaultResponse>
[<WoofWare.Myriad.Plugins.HttpClient false>]
type IVaultClientNonExtensionMethod =
[<Get "v1/{mountPoint}/{path}">]
abstract GetSecret :
jwt : JwtVaultResponse *
[<Path "path">] path : string *
[<Path "mountPoint">] mountPoint : string *
?ct : CancellationToken ->
Task<JwtSecretResponse>
[<Get "v1/auth/jwt/login">]
abstract GetJwt : role : string * jwt : string * ?ct : CancellationToken -> Task<JwtVaultResponse>
[<WoofWare.Myriad.Plugins.HttpClient(true)>]
type IVaultClientExtensionMethod =
[<Get "v1/{mountPoint}/{path}">]
abstract GetSecret :
jwt : JwtVaultResponse *
[<Path "path">] path : string *
[<Path "mountPoint">] mountPoint : string *
?ct : CancellationToken ->
Task<JwtSecretResponse>
[<Get "v1/auth/jwt/login">]
abstract GetJwt : role : string * jwt : string * ?ct : CancellationToken -> Task<JwtVaultResponse>
[<RequireQualifiedAccess>]
type VaultClientExtensionMethod =
static member thisClashes = 99

View File

@@ -143,6 +143,9 @@ module InnerTypeWithBoth =
node
```
Also includes an *opinionated* serializer for discriminated unions.
(Any such serializer must be opinionated, because JSON does not natively model DUs.)
As in `JsonParse`, you can optionally supply the boolean `true` to the attribute,
which will cause Myriad to stamp out an extension method rather than a module with the same name as the type.

View File

@@ -60,8 +60,17 @@ type JsonParseAttribute (isExtensionMethod : bool) =
/// generator should apply during build.
/// This generator is intended to replicate much of the functionality of RestEase,
/// i.e. to stamp out HTTP REST clients from interfaces defining the API.
type HttpClientAttribute () =
///
/// If you supply isExtensionMethod = true, you will get extension methods.
/// These can only be consumed from F#, but the benefit is that they don't use up the module name
/// (since by default we create a module called "{TypeName}").
type HttpClientAttribute (isExtensionMethod : bool) =
inherit Attribute ()
/// The default value of `isExtensionMethod`, the optional argument to the HttpClientAttribute constructor.
static member DefaultIsExtensionMethod = false
/// Shorthand for the "isExtensionMethod = false" constructor; see documentation there for details.
new () = HttpClientAttribute HttpClientAttribute.DefaultIsExtensionMethod
/// Attribute indicating a DU type to which the "create catamorphism" Myriad
/// generator should apply during build.

View File

@@ -6,7 +6,10 @@ WoofWare.Myriad.Plugins.GenerateMockAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.GenerateMockAttribute.DefaultIsInternal [static property]: [read-only] bool
WoofWare.Myriad.Plugins.GenerateMockAttribute.get_DefaultIsInternal [static method]: unit -> bool
WoofWare.Myriad.Plugins.HttpClientAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.HttpClientAttribute..ctor [constructor]: bool
WoofWare.Myriad.Plugins.HttpClientAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.HttpClientAttribute.DefaultIsExtensionMethod [static property]: [read-only] bool
WoofWare.Myriad.Plugins.HttpClientAttribute.get_DefaultIsExtensionMethod [static method]: unit -> bool
WoofWare.Myriad.Plugins.JsonParseAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.JsonParseAttribute..ctor [constructor]: bool
WoofWare.Myriad.Plugins.JsonParseAttribute..ctor [constructor]: unit

View File

@@ -12,8 +12,8 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="ApiSurface" Version="4.0.39" />
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.9.0"/>
<PackageReference Include="ApiSurface" Version="4.0.40" />
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.10.0"/>
<PackageReference Include="NUnit" Version="4.1.0"/>
<PackageReference Include="NUnit3TestAdapter" Version="4.5.0"/>
</ItemGroup>

View File

@@ -1,7 +1,15 @@
{
"version": "3.0",
"version": "3.1",
"publicReleaseRefSpec": [
"^refs/heads/main$"
],
"pathFilters": null
}
"pathFilters": [
":/README.md",
":/LICENSE",
":/WoofWare.Myriad.Plugins/logo.png",
":/Directory.Build.props",
":/global.json",
"./",
"^./Test"
]
}

View File

@@ -87,8 +87,10 @@ module TestVaultClient =
}
}"""
[<Test>]
let ``URI example`` () =
[<TestCase 1>]
[<TestCase 2>]
[<TestCase 3>]
let ``URI example`` (vaultClientId : int) =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
@@ -112,10 +114,25 @@ module TestVaultClient =
}
use client = HttpClientMock.make (Uri "https://my-vault.com") proc
let api = VaultClient.make client
let vaultResponse = api.GetJwt("role", "jwt").Result
let value = api.GetSecret(vaultResponse, "path", "mount").Result
let value =
match vaultClientId with
| 1 ->
let api = VaultClient.make client
let vaultResponse = api.GetJwt("role", "jwt").Result
let value = api.GetSecret(vaultResponse, "path", "mount").Result
value
| 2 ->
let api = VaultClientNonExtensionMethod.make client
let vaultResponse = api.GetJwt("role", "jwt").Result
let value = api.GetSecret(vaultResponse, "path", "mount").Result
value
| 3 ->
let api = VaultClientExtensionMethod.make client
let vaultResponse = api.GetJwt("role", "jwt").Result
let value = api.GetSecret(vaultResponse, "path", "mount").Result
value
| _ -> failwith $"Unrecognised ID: %i{vaultClientId}"
value.Data
|> Seq.toList
@@ -168,3 +185,5 @@ module TestVaultClient =
"key8_1", "https://example.com/data8/1"
"key8_2", "https://example.com/data8/2"
]
let _canSeePastExtensionMethod = VaultClientExtensionMethod.thisClashes

View File

@@ -7,6 +7,8 @@ open FsUnitTyped
[<TestFixture>]
module TestJsonParse =
let _canSeePastExtensionMethod = ToGetExtensionMethod.thisModuleWouldClash
[<Test>]
let ``Single example`` () =
let s =

View File

@@ -33,10 +33,10 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="ApiSurface" Version="4.0.39"/>
<PackageReference Include="ApiSurface" Version="4.0.40"/>
<PackageReference Include="FsCheck" Version="2.16.6"/>
<PackageReference Include="FsUnit" Version="6.0.0"/>
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.9.0"/>
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.10.0"/>
<PackageReference Include="NUnit" Version="4.1.0"/>
<PackageReference Include="NUnit3TestAdapter" Version="4.5.0"/>
</ItemGroup>

View File

@@ -1113,7 +1113,7 @@ module internal CataGenerator =
analysis.AssociatedProcessInstruction,
None,
None,
SynArgPats.Pats [ SynPat.CreateNamed (Ident.Create "x") ],
SynArgPats.create [ Ident.Create "x" ],
None,
range0
),
@@ -1162,22 +1162,16 @@ module internal CataGenerator =
|> Seq.mapi (fun i x -> (i, x))
|> Seq.choose (fun (i, case) ->
match case.Description with
| FieldDescription.NonRecursive _ -> SynPat.CreateNamed case.ArgName |> Some
| FieldDescription.ListSelf _ -> SynPat.CreateNamed case.ArgName |> Some
| FieldDescription.NonRecursive _ -> case.ArgName |> Some
| FieldDescription.ListSelf _ -> case.ArgName |> Some
| FieldDescription.Self _ -> None
)
|> Seq.toList
let lhs =
match lhsNames with
| [] -> []
| lhsNames ->
SynPat.Tuple (false, lhsNames, List.replicate (lhsNames.Length - 1) range0, range0)
|> SynPat.CreateParen
|> List.singleton
let lhs = SynArgPats.create lhsNames
let pat =
SynPat.LongIdent (unionCase.AssociatedInstruction, None, None, SynArgPats.Pats lhs, None, range0)
SynPat.LongIdent (unionCase.AssociatedInstruction, None, None, lhs, None, range0)
let populateArgs =
unionCase.FlattenedFields

View File

@@ -6,6 +6,11 @@ open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Xml
open Myriad.Core
type internal HttpClientGeneratorOutputSpec =
{
ExtensionMethods : bool
}
[<RequireQualifiedAccess>]
module internal HttpClientGenerator =
open Fantomas.FCS.Text.Range
@@ -811,7 +816,7 @@ module internal HttpClientGenerator =
let createModule
(opens : SynOpenDeclTarget list)
(ns : LongIdent)
(interfaceType : SynTypeDefn)
(interfaceType : SynTypeDefn, spec : HttpClientGeneratorOutputSpec)
: SynModuleOrNamespace
=
let interfaceType = AstHelper.parseInterface interfaceType
@@ -959,7 +964,13 @@ module internal HttpClientGenerator =
let members = propertyMembers @ nonPropertyMembers
let docString = PreXmlDoc.Create " Module for constructing a REST client."
let docString =
(if spec.ExtensionMethods then
"Extension methods"
else
"Module")
|> sprintf " %s for constructing a REST client."
|> PreXmlDoc.Create
let interfaceImpl =
SynExpr.ObjExpr (
@@ -995,38 +1006,38 @@ module internal HttpClientGenerator =
" Create a REST client."
else
" Create a REST client. The input functions will be re-evaluated on every HTTP request to obtain the required values for the corresponding header properties."
|> PreXmlDoc.Create
let createFunc =
SynBinding.SynBinding (
None,
SynBindingKind.Normal,
false,
false,
[],
PreXmlDoc.Create xmlDoc,
SynValData.SynValData (
None,
SynValInfo.SynValInfo (
[ [ SynArgInfo.SynArgInfo ([], false, Some (Ident.Create "client")) ] ],
SynArgInfo.Empty
),
let functionName = Ident.Create "client"
let valData =
let memberFlags =
if spec.ExtensionMethods then
{
SynMemberFlags.IsInstance = false
SynMemberFlags.IsDispatchSlot = false
SynMemberFlags.IsOverrideOrExplicitImpl = false
SynMemberFlags.IsFinal = false
SynMemberFlags.GetterOrSetterIsCompilerGenerated = false
SynMemberFlags.MemberKind = SynMemberKind.Member
}
|> Some
else
None
),
SynPat.CreateLongIdent (SynLongIdent.CreateString "make", headerArgs @ [ clientCreationArg ]),
Some (
SynBindingReturnInfo.Create (
SynType.LongIdent (SynLongIdent.CreateFromLongIdent interfaceType.Name)
)
),
interfaceImpl,
range0,
DebugPointAtBinding.NoneAtLet,
SynExpr.synBindingTriviaZero false
)
|> List.singleton
|> SynModuleDecl.CreateLet
let moduleName : LongIdent =
SynValData.SynValData (
memberFlags,
SynValInfo.SynValInfo ([ [ SynArgInfo.SynArgInfo ([], false, Some functionName) ] ], SynArgInfo.Empty),
None
)
let pattern =
SynPat.CreateLongIdent (SynLongIdent.CreateString "make", headerArgs @ [ clientCreationArg ])
let returnInfo =
SynBindingReturnInfo.Create (SynType.LongIdent (SynLongIdent.CreateFromLongIdent interfaceType.Name))
let nameWithoutLeadingI =
List.last interfaceType.Name
|> _.idText
|> fun s ->
@@ -1034,14 +1045,84 @@ module internal HttpClientGenerator =
s.[1..]
else
failwith $"Expected interface type to start with 'I', but was: %s{s}"
|> Ident.Create
|> List.singleton
let createFunc =
if spec.ExtensionMethods then
let binding =
SynBinding.SynBinding (
None,
SynBindingKind.Normal,
false,
false,
[],
xmlDoc,
valData,
pattern,
Some returnInfo,
interfaceImpl,
range0,
DebugPointAtBinding.NoneAtInvisible,
{
LeadingKeyword = SynLeadingKeyword.StaticMember (range0, range0)
InlineKeyword = None
EqualsRange = Some range0
}
)
let mem = SynMemberDefn.Member (binding, range0)
let containingType =
SynTypeDefn.SynTypeDefn (
SynComponentInfo.Create (
[ Ident.Create nameWithoutLeadingI ],
xmldoc = PreXmlDoc.Create " Extension methods for HTTP clients"
),
SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Augmentation range0, [], range0),
[ mem ],
None,
range0,
{
LeadingKeyword = SynTypeDefnLeadingKeyword.Type range0
EqualsRange = None
WithKeyword = None
}
)
SynModuleDecl.Types ([ containingType ], range0)
else
SynBinding.SynBinding (
None,
SynBindingKind.Normal,
false,
false,
[],
xmlDoc,
valData,
pattern,
Some returnInfo,
interfaceImpl,
range0,
DebugPointAtBinding.NoneAtLet,
SynExpr.synBindingTriviaZero false
)
|> List.singleton
|> SynModuleDecl.CreateLet
let moduleName : LongIdent =
if spec.ExtensionMethods then
[ Ident.Create (nameWithoutLeadingI + "HttpClientExtension") ]
else
[ Ident.Create nameWithoutLeadingI ]
let attribs =
[
SynAttributeList.Create SynAttribute.compilationRepresentation
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
]
if spec.ExtensionMethods then
[ SynAttributeList.Create SynAttribute.autoOpen ]
else
[
SynAttributeList.Create SynAttribute.compilationRepresentation
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
]
let modInfo =
SynComponentInfo.Create (
@@ -1079,9 +1160,29 @@ type HttpClientGenerator () =
let namespaceAndTypes =
types
|> List.choose (fun (ns, types) ->
match types |> List.filter Ast.hasAttribute<HttpClientAttribute> with
| [] -> None
| types -> Some (ns, types)
types
|> List.choose (fun typeDef ->
match Ast.getAttribute<HttpClientAttribute> typeDef with
| None -> None
| Some attr ->
let arg =
match SynExpr.stripOptionalParen attr.ArgExpr with
| SynExpr.Const (SynConst.Bool value, _) -> value
| SynExpr.Const (SynConst.Unit, _) -> JsonParseAttribute.DefaultIsExtensionMethod
| arg ->
failwith
$"Unrecognised argument %+A{arg} to [<%s{nameof HttpClientAttribute}>]. Literals are not supported. Use `true` or `false` (or unit) only."
let spec =
{
ExtensionMethods = arg
}
Some (typeDef, spec)
)
|> function
| [] -> None
| ty -> Some (ns, ty)
)
let modules =

View File

@@ -566,61 +566,61 @@ module internal JsonParseGenerator =
SynModuleDecl.CreateLet [ binding ]
let createRecordModule (namespaceId : LongIdent) (spec : JsonParseOutputSpec) (typeDefn : SynTypeDefn) =
let createModule (namespaceId : LongIdent) (spec : JsonParseOutputSpec) (typeDefn : SynTypeDefn) =
let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) =
typeDefn
let (SynComponentInfo (_attributes, _typeParams, _constraints, recordId, _, _preferPostfix, _access, _)) =
let (SynComponentInfo (_attributes, _typeParams, _constraints, ident, _, _preferPostfix, _access, _)) =
synComponentInfo
match synTypeDefnRepr with
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, recordFields, _recordRange), _) ->
let attributes =
if spec.ExtensionMethods then
[ SynAttributeList.Create SynAttribute.autoOpen ]
else
[
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
SynAttributeList.Create SynAttribute.compilationRepresentation
]
let decls = [ createMaker spec recordId recordFields ]
let xmlDoc =
let fullyQualified = ident |> Seq.map (fun i -> i.idText) |> String.concat "."
let attributes =
let description =
if spec.ExtensionMethods then
[ SynAttributeList.Create SynAttribute.autoOpen ]
"extension members"
else
[
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
SynAttributeList.Create SynAttribute.compilationRepresentation
]
"methods"
let xmlDoc =
let fullyQualified = recordId |> Seq.map (fun i -> i.idText) |> String.concat "."
$" Module containing JSON parsing %s{description} for the %s{fullyQualified} type"
|> PreXmlDoc.Create
let description =
if spec.ExtensionMethods then
"extension members"
else
"methods"
let moduleName =
if spec.ExtensionMethods then
match ident with
| [] -> failwith "unexpectedly got an empty identifier for record name"
| ident ->
let expanded =
List.last ident
|> fun i -> i.idText
|> fun s -> s + "JsonParseExtension"
|> Ident.Create
$" Module containing JSON parsing %s{description} for the %s{fullyQualified} type"
|> PreXmlDoc.Create
List.take (List.length ident - 1) ident @ [ expanded ]
else
ident
let moduleName =
if spec.ExtensionMethods then
match recordId with
| [] -> failwith "unexpectedly got an empty identifier for record name"
| recordId ->
let expanded =
List.last recordId
|> fun i -> i.idText
|> fun s -> s + "JsonParseExtension"
|> Ident.Create
let info =
SynComponentInfo.Create (moduleName, attributes = attributes, xmldoc = xmlDoc)
List.take (List.length recordId - 1) recordId @ [ expanded ]
else
recordId
let decls =
match synTypeDefnRepr with
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, recordFields, _recordRange), _) ->
[ createMaker spec ident recordFields ]
| _ -> failwithf "Not a record type"
let info =
SynComponentInfo.Create (moduleName, attributes = attributes, xmldoc = xmlDoc)
let mdl = SynModuleDecl.CreateNestedModule (info, decls)
let mdl = SynModuleDecl.CreateNestedModule (info, decls)
SynModuleOrNamespace.CreateNamespace (namespaceId, decls = [ mdl ])
| _ -> failwithf "Not a record type"
SynModuleOrNamespace.CreateNamespace (namespaceId, decls = [ mdl ])
/// Myriad generator that provides a method (possibly an extension method) for a record type,
/// containing a JSON parse function.
@@ -634,10 +634,20 @@ type JsonParseGenerator () =
let ast, _ =
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
let records = Ast.extractRecords ast
let recordsAndUnions =
Ast.extractTypeDefn ast
|> List.map (fun (name, defns) ->
defns
|> List.choose (fun defn ->
if Ast.isRecord defn then Some defn
elif Ast.isDu defn then Some defn
else None
)
|> fun defns -> name, defns
)
let namespaceAndRecords =
records
let namespaceAndTypes =
recordsAndUnions
|> List.choose (fun (ns, types) ->
types
|> List.choose (fun typeDef ->
@@ -665,13 +675,9 @@ type JsonParseGenerator () =
)
let modules =
namespaceAndRecords
|> List.collect (fun (ns, records) ->
records
|> List.map (fun (record, spec) ->
let recordModule = JsonParseGenerator.createRecordModule ns spec record
recordModule
)
namespaceAndTypes
|> List.collect (fun (ns, types) ->
types |> List.map (fun (ty, spec) -> JsonParseGenerator.createModule ns spec ty)
)
Output.Ast modules

View File

@@ -117,9 +117,7 @@ module internal JsonSerializeGenerator =
SynExpr.CreateIdentString "arr"
],
range0,
{
InKeyword = None
}
SynExprLetOrUseTrivia.empty
)
|> SynExpr.createLambda "field"
| IDictionaryType (keyType, valueType)
@@ -188,9 +186,7 @@ module internal JsonSerializeGenerator =
SynExpr.CreateIdentString "ret"
],
range0,
{
InKeyword = None
}
SynExprLetOrUseTrivia.empty
)
|> SynExpr.createLambda "field"
| _ ->
@@ -204,7 +200,7 @@ module internal JsonSerializeGenerator =
/// propertyName is probably a string literal, but it could be a [<Literal>] variable
/// `node.Add ({propertyName}, {toJsonNode})`
let createSerializeRhs (propertyName : SynExpr) (fieldId : Ident) (fieldType : SynType) : SynExpr =
let createSerializeRhsRecord (propertyName : SynExpr) (fieldId : Ident) (fieldType : SynType) : SynExpr =
let func = SynExpr.CreateLongIdent (SynLongIdent.Create [ "node" ; "Add" ])
let args =
@@ -219,7 +215,24 @@ module internal JsonSerializeGenerator =
SynExpr.CreateApp (func, args)
let createMaker (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (fields : SynField list) =
let getPropertyName (fieldId : Ident) (attrs : SynAttribute list) : SynExpr =
let propertyNameAttr =
attrs
|> List.tryFind (fun attr -> attr.TypeName.AsString.EndsWith ("JsonPropertyName", StringComparison.Ordinal))
match propertyNameAttr with
| None ->
let sb = StringBuilder fieldId.idText.Length
sb.Append (Char.ToLowerInvariant fieldId.idText.[0]) |> ignore
if fieldId.idText.Length > 1 then
sb.Append fieldId.idText.[1..] |> ignore
sb.ToString () |> SynConst.CreateString |> SynExpr.CreateConst
| Some name -> name.ArgExpr
let recordModule (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (fields : SynField list) =
let xmlDoc = PreXmlDoc.Create " Serialize to a JSON node"
let returnInfo =
@@ -253,7 +266,7 @@ module internal JsonSerializeGenerator =
thisIdOpt
)
let assignments =
let fields =
fields
|> List.map (fun (SynField (attrs, _, id, fieldType, _, _, _, _, _)) ->
let id =
@@ -261,26 +274,14 @@ module internal JsonSerializeGenerator =
| None -> failwith "didn't get an ID on field"
| Some id -> id
attrs, id, fieldType
)
let assignments =
fields
|> List.map (fun (attrs, id, fieldType) ->
let attrs = attrs |> List.collect (fun l -> l.Attributes)
let propertyNameAttr =
attrs
|> List.tryFind (fun attr ->
attr.TypeName.AsString.EndsWith ("JsonPropertyName", StringComparison.Ordinal)
)
let propertyName =
match propertyNameAttr with
| None ->
let sb = StringBuilder id.idText.Length
sb.Append (Char.ToLowerInvariant id.idText.[0]) |> ignore
if id.idText.Length > 1 then
sb.Append id.idText.[1..] |> ignore
sb.ToString () |> SynConst.CreateString |> SynExpr.CreateConst
| Some name -> name.ArgExpr
let pattern =
SynPat.LongIdent (
SynLongIdent.CreateFromLongIdent [ id ],
@@ -291,17 +292,14 @@ module internal JsonSerializeGenerator =
range0
)
createSerializeRhs propertyName id fieldType
let propertyName = getPropertyName id attrs
createSerializeRhsRecord propertyName id fieldType
)
let finalConstruction =
fields
|> List.map (fun (SynField (_, _, id, _, _, _, _, _, _)) ->
let id =
match id with
| None -> failwith "Expected record field to have an identifying name"
| Some id -> id
|> List.map (fun (_, id, _) ->
(SynLongIdent.CreateFromLongIdent [ id ], true),
Some (SynExpr.CreateLongIdent (SynLongIdent.CreateFromLongIdent [ id ]))
)
@@ -331,9 +329,7 @@ module internal JsonSerializeGenerator =
SynExpr.Upcast (SynExpr.CreateIdentString "node", SynType.Anon range0, range0)
],
range0,
{
InKeyword = None
}
SynExprLetOrUseTrivia.empty
)
let pattern =
@@ -406,7 +402,247 @@ module internal JsonSerializeGenerator =
SynModuleDecl.CreateLet [ binding ]
let createRecordModule
let unionModule (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (cases : SynUnionCase list) =
let xmlDoc = PreXmlDoc.Create " Serialize to a JSON node"
let returnInfo =
SynBindingReturnInfo.Create (
SynType.LongIdent (SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
)
let inputArg = Ident.Create "input"
let functionName = Ident.Create "toJsonNode"
let inputVal =
let memberFlags =
if spec.ExtensionMethods then
{
SynMemberFlags.IsInstance = false
SynMemberFlags.IsDispatchSlot = false
SynMemberFlags.IsOverrideOrExplicitImpl = false
SynMemberFlags.IsFinal = false
SynMemberFlags.GetterOrSetterIsCompilerGenerated = false
SynMemberFlags.MemberKind = SynMemberKind.Member
}
|> Some
else
None
let thisIdOpt = if spec.ExtensionMethods then None else Some inputArg
SynValData.SynValData (
memberFlags,
SynValInfo.SynValInfo ([ [ SynArgInfo.CreateId functionName ] ], SynArgInfo.Empty),
thisIdOpt
)
let cases =
cases
|> List.map (fun (SynUnionCase (attrs, SynIdent.SynIdent (id, _), caseType, _, _, _, _)) ->
match caseType with
| SynUnionCaseKind.FullType _ -> failwith "WoofWare.Myriad does not support FullType union cases."
| SynUnionCaseKind.Fields fields ->
let fields =
fields
|> List.map (fun (SynField (attrs, _, id, fieldType, _, _, _, _, _)) ->
match id with
| None -> failwith "WoofWare.Myriad requires all union fields to have names"
| Some id ->
let attrs = attrs |> List.collect (fun l -> l.Attributes)
attrs, id, fieldType
)
// As far as I can tell, there's no way to get any attributes here? :shrug:
let attrs = attrs |> List.collect (fun l -> l.Attributes)
attrs, id, fields
)
let matchClauses : SynMatchClause list =
cases
|> List.map (fun (attrs, id, caseType) ->
let propertyName = getPropertyName id attrs
let caseNames = caseType |> List.mapi (fun i _ -> Ident.Create $"arg%i{i}")
let argPats = SynArgPats.create caseNames
let pattern =
SynPat.LongIdent (
SynLongIdent.CreateFromLongIdent (typeName @ [ id ]),
None,
None,
argPats,
None,
range0
)
let typeLine =
let func = SynExpr.CreateLongIdent (SynLongIdent.Create [ "node" ; "Add" ])
let args =
SynExpr.CreateParenedTuple
[
SynExpr.CreateConstString "type"
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
SynLongIdent.CreateString "System.Text.Json.Nodes.JsonValue.Create"
),
propertyName
)
]
SynExpr.CreateApp (func, args)
let dataNode =
SynBinding.Let (
pattern = SynPat.CreateNamed (Ident.Create "dataNode"),
expr =
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
),
SynExpr.CreateConst SynConst.Unit
)
)
let dataBindings =
(caseType, caseNames)
||> List.zip
|> List.map (fun ((attrs, ident, synType), caseName) ->
let propertyName = getPropertyName ident attrs
let func = SynExpr.CreateLongIdent (SynLongIdent.Create [ "dataNode" ; "Add" ])
let node = SynExpr.CreateApp (serializeNode synType, SynExpr.CreateIdent caseName)
SynExpr.CreateApp (func, SynExpr.CreateParenedTuple [ propertyName ; node ])
)
let assignToNode =
let func = SynExpr.CreateLongIdent (SynLongIdent.Create [ "node" ; "Add" ])
let args =
SynExpr.CreateParenedTuple
[ SynExpr.CreateConstString "data" ; SynExpr.CreateIdentString "dataNode" ]
SynExpr.CreateApp (func, args)
let dataNode =
SynExpr.LetOrUse (
false,
false,
[ dataNode ],
SynExpr.CreateSequential (dataBindings @ [ assignToNode ]),
range0,
SynExprLetOrUseTrivia.empty
)
let action =
[
yield typeLine
if not dataBindings.IsEmpty then
yield dataNode
]
|> SynExpr.CreateSequential
SynMatchClause.Create (pattern, None, action)
)
let assignments =
SynExpr.LetOrUse (
false,
false,
[
SynBinding.Let (
pattern = SynPat.CreateNamed (Ident.Create "node"),
expr =
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
),
SynExpr.CreateConst SynConst.Unit
)
)
],
SynExpr.CreateSequential
[
SynExpr.CreateMatch (SynExpr.CreateIdent inputArg, matchClauses)
SynExpr.Upcast (SynExpr.CreateIdentString "node", SynType.Anon range0, range0)
],
range0,
SynExprLetOrUseTrivia.empty
)
let pattern =
SynPat.LongIdent (
SynLongIdent.CreateFromLongIdent [ functionName ],
None,
None,
SynArgPats.Pats
[
SynPat.CreateTyped (
SynPat.CreateNamed inputArg,
SynType.LongIdent (SynLongIdent.CreateFromLongIdent typeName)
)
|> SynPat.CreateParen
],
None,
range0
)
if spec.ExtensionMethods then
let binding =
SynBinding.SynBinding (
None,
SynBindingKind.Normal,
false,
false,
[],
xmlDoc,
inputVal,
pattern,
Some returnInfo,
assignments,
range0,
DebugPointAtBinding.NoneAtInvisible,
{
LeadingKeyword = SynLeadingKeyword.StaticMember (range0, range0)
InlineKeyword = None
EqualsRange = Some range0
}
)
let mem = SynMemberDefn.Member (binding, range0)
let containingType =
SynTypeDefn.SynTypeDefn (
SynComponentInfo.Create (typeName, xmldoc = PreXmlDoc.Create " Extension methods for JSON parsing"),
SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Augmentation range0, [], range0),
[ mem ],
None,
range0,
{
LeadingKeyword = SynTypeDefnLeadingKeyword.Type range0
EqualsRange = None
WithKeyword = None
}
)
SynModuleDecl.Types ([ containingType ], range0)
else
let binding =
SynBinding.Let (
isInline = false,
isMutable = false,
xmldoc = xmlDoc,
returnInfo = returnInfo,
expr = assignments,
valData = inputVal,
pattern = pattern
)
SynModuleDecl.CreateLet [ binding ]
let createModule
(namespaceId : LongIdent)
(opens : SynOpenDeclTarget list)
(spec : JsonSerializeOutputSpec)
@@ -415,60 +651,62 @@ module internal JsonSerializeGenerator =
let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) =
typeDefn
let (SynComponentInfo (_attributes, _typeParams, _constraints, recordId, _, _preferPostfix, _access, _)) =
let (SynComponentInfo (_attributes, _typeParams, _constraints, ident, _, _preferPostfix, _access, _)) =
synComponentInfo
match synTypeDefnRepr with
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, recordFields, _recordRange), _) ->
let attributes =
if spec.ExtensionMethods then
[ SynAttributeList.Create SynAttribute.autoOpen ]
else
[
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
SynAttributeList.Create SynAttribute.compilationRepresentation
]
let decls = [ createMaker spec recordId recordFields ]
let xmlDoc =
let fullyQualified = ident |> Seq.map (fun i -> i.idText) |> String.concat "."
let attributes =
let description =
if spec.ExtensionMethods then
[ SynAttributeList.Create SynAttribute.autoOpen ]
"extension members"
else
[
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
SynAttributeList.Create SynAttribute.compilationRepresentation
]
"methods"
let xmlDoc =
let fullyQualified = recordId |> Seq.map (fun i -> i.idText) |> String.concat "."
$" Module containing JSON serializing %s{description} for the %s{fullyQualified} type"
|> PreXmlDoc.Create
let description =
if spec.ExtensionMethods then
"extension members"
else
"methods"
let moduleName =
if spec.ExtensionMethods then
match ident with
| [] -> failwith "unexpectedly got an empty identifier for type name"
| ident ->
let expanded =
List.last ident
|> fun i -> i.idText
|> fun s -> s + "JsonSerializeExtension"
|> Ident.Create
$" Module containing JSON serializing %s{description} for the %s{fullyQualified} type"
|> PreXmlDoc.Create
List.take (List.length ident - 1) ident @ [ expanded ]
else
ident
let moduleName =
if spec.ExtensionMethods then
match recordId with
| [] -> failwith "unexpectedly got an empty identifier for record name"
| recordId ->
let expanded =
List.last recordId
|> fun i -> i.idText
|> fun s -> s + "JsonSerializeExtension"
|> Ident.Create
let info =
SynComponentInfo.Create (moduleName, attributes = attributes, xmldoc = xmlDoc)
List.take (List.length recordId - 1) recordId @ [ expanded ]
else
recordId
let decls =
match synTypeDefnRepr with
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, recordFields, _range), _) ->
[ recordModule spec ident recordFields ]
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (_accessibility, unionFields, _range), _) ->
[ unionModule spec ident unionFields ]
| _ -> failwithf "Only record types currently supported."
let info =
SynComponentInfo.Create (moduleName, attributes = attributes, xmldoc = xmlDoc)
let mdl = SynModuleDecl.CreateNestedModule (info, decls)
let mdl = SynModuleDecl.CreateNestedModule (info, decls)
SynModuleOrNamespace.CreateNamespace (
namespaceId,
decls = (opens |> List.map SynModuleDecl.CreateOpen) @ [ mdl ]
)
| _ -> failwithf "Not a record type"
SynModuleOrNamespace.CreateNamespace (
namespaceId,
decls = (opens |> List.map SynModuleDecl.CreateOpen) @ [ mdl ]
)
/// Myriad generator that provides a method (possibly an extension method) for a record type,
/// containing a JSON serialization function.
@@ -482,10 +720,20 @@ type JsonSerializeGenerator () =
let ast, _ =
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
let records = Ast.extractRecords ast
let recordsAndUnions =
Ast.extractTypeDefn ast
|> List.map (fun (name, defns) ->
defns
|> List.choose (fun defn ->
if Ast.isRecord defn then Some defn
elif Ast.isDu defn then Some defn
else None
)
|> fun defns -> name, defns
)
let namespaceAndRecords =
records
let namespaceAndTypes =
recordsAndUnions
|> List.choose (fun (ns, types) ->
types
|> List.choose (fun typeDef ->
@@ -515,13 +763,10 @@ type JsonSerializeGenerator () =
let opens = AstHelper.extractOpens ast
let modules =
namespaceAndRecords
|> List.collect (fun (ns, records) ->
records
|> List.map (fun (record, spec) ->
let recordModule = JsonSerializeGenerator.createRecordModule ns opens spec record
recordModule
)
namespaceAndTypes
|> List.collect (fun (ns, types) ->
types
|> List.map (fun (ty, spec) -> JsonSerializeGenerator.createModule ns opens spec ty)
)
Output.Ast modules

View File

@@ -0,0 +1,18 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal SynArgPats =
let create (caseNames : Ident list) : SynArgPats =
if caseNames.IsEmpty then
SynArgPats.Pats []
else
caseNames
|> List.map (fun ident -> SynPat.Named (SynIdent.SynIdent (ident, None), false, None, range0))
|> fun ps -> SynPat.Tuple (false, ps, List.replicate (ps.Length - 1) range0, range0)
|> fun p -> SynPat.Paren (p, range0)
|> List.singleton
|> SynArgPats.Pats

View File

@@ -0,0 +1,10 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.SyntaxTrivia
[<RequireQualifiedAccess>]
module internal SynExprLetOrUseTrivia =
let empty : SynExprLetOrUseTrivia =
{
InKeyword = None
}

View File

@@ -27,9 +27,11 @@
<Compile Include="List.fs"/>
<Compile Include="Ident.fs" />
<Compile Include="AstHelper.fs"/>
<Compile Include="SynExpr.fs" />
<Compile Include="SynType.fs"/>
<Compile Include="SynAttribute.fs"/>
<Compile Include="SynExpr\SynExpr.fs" />
<Compile Include="SynExpr\SynType.fs" />
<Compile Include="SynExpr\SynAttribute.fs" />
<Compile Include="SynExpr\SynArgPats.fs" />
<Compile Include="SynExpr\SynExprLetOrUseTrivia.fs" />
<Compile Include="RemoveOptionsGenerator.fs"/>
<Compile Include="InterfaceMockGenerator.fs"/>
<Compile Include="JsonSerializeGenerator.fs"/>

View File

@@ -3,5 +3,10 @@
"publicReleaseRefSpec": [
"^refs/heads/main$"
],
"pathFilters": null
}
"pathFilters": [
":/",
":^WoofWare.Myriad.Plugins.Test/",
":^WoofWare.Myriad.Plugins.Attributes/Test/",
":^/.github/"
]
}

View File

@@ -13,8 +13,8 @@
})
(fetchNuGet {
pname = "ApiSurface";
version = "4.0.39";
sha256 = "sha256-I4K5nJbltsfL/1r+KPTIo2wUd30zsCC2pkrnIRnsRHM=";
version = "4.0.40";
sha256 = "1c9z0b6minlripwrjmv4yd5w8zj4lcpak4x41izh7ygx8kgmbvx0";
})
(fetchNuGet {
pname = "Fantomas.Core";
@@ -118,13 +118,13 @@
})
(fetchNuGet {
pname = "Microsoft.CodeCoverage";
version = "17.9.0";
sha256 = "1gljgi69k0fz8vy8bn6xlyxabj6q4vls2zza9wz7ng6ix3irm89r";
version = "17.10.0";
sha256 = "0s0v7jmrq85n356xv7zixvwa4z94fszjcr5vll8x4im1a2lp00f9";
})
(fetchNuGet {
pname = "Microsoft.NET.Test.Sdk";
version = "17.9.0";
sha256 = "1lls1fly2gr1n9n1xyl9k33l2v4pwfmylyzkq8v4v5ldnwkl1zdb";
version = "17.10.0";
sha256 = "13g8fwl09li8fc71nk13dgkb7gahd4qhamyg2xby7am63nlchhdf";
})
(fetchNuGet {
pname = "Microsoft.NETCore.App.Host.linux-arm64";
@@ -268,13 +268,13 @@
})
(fetchNuGet {
pname = "Microsoft.TestPlatform.ObjectModel";
version = "17.9.0";
sha256 = "1kgsl9w9fganbm9wvlkqgk0ag9hfi58z88rkfybc6kvg78bx89ca";
version = "17.10.0";
sha256 = "07j69cw8r39533w4p39mnj00kahazz38760in3jfc45kmlcdb26x";
})
(fetchNuGet {
pname = "Microsoft.TestPlatform.TestHost";
version = "17.9.0";
sha256 = "19ffh31a1jxzn8j69m1vnk5hyfz3dbxmflq77b8x82zybiilh5nl";
version = "17.10.0";
sha256 = "1bl471s7fx9jycr0cc8rylwf34mrvlg9qn1an6l86nisavfcyb7v";
})
(fetchNuGet {
pname = "Myriad.Core";
@@ -308,33 +308,33 @@
})
(fetchNuGet {
pname = "NuGet.Common";
version = "6.9.1";
sha256 = "0ic3d46r9v05pkczpmskw86yzixm6iwshbw0ya8i2957nhhlymw8";
version = "6.10.0";
sha256 = "0nizrnilmlcqbm945293h8q3wfqfchb4xi8g50x4kjn0rbpd1kbh";
})
(fetchNuGet {
pname = "NuGet.Configuration";
version = "6.9.1";
sha256 = "07z4qgbibpg59j2r05ifnqdyqf2xinm33rx7gjyr1f73kzg01m33";
version = "6.10.0";
sha256 = "1aqaknaawnqx4mnvx9qw73wvj48jjzv0d78dzwl7m9zjlrl9myhz";
})
(fetchNuGet {
pname = "NuGet.Frameworks";
version = "6.9.1";
sha256 = "0s3az3ac53icjnmb14hfjcmkvzscvrkm62jgqf48yvsbysyhqm5s";
version = "6.10.0";
sha256 = "0hrd8y31zx9a0wps49czw0qgbrakb49zn3abfgylc9xrq990zkqk";
})
(fetchNuGet {
pname = "NuGet.Packaging";
version = "6.9.1";
sha256 = "0w0arkmzg3qh1brq4vm10zrsjm7nw706ld4y5kqcmvjpd16f4b4y";
version = "6.10.0";
sha256 = "18s53cvrf51lihmaqqdf48p2qi6ky1l48jv0hvbp76cxwdg7rba4";
})
(fetchNuGet {
pname = "NuGet.Protocol";
version = "6.7.0";
sha256 = "1v5ibnq2mp801vw68zyj169hkj3xm7h55824i33n1jxxj2vs3vbk";
version = "6.10.0";
sha256 = "0hmv4q0ks9i34mfgpb13l01la9v3jjllfh1qd3aqv105xrqrdxac";
})
(fetchNuGet {
pname = "NuGet.Versioning";
version = "6.9.1";
sha256 = "0xrs82dydy9cgxf0qypr01wawwnq1nf6fc7rwisb4y5v4r259fdm";
version = "6.10.0";
sha256 = "1x19njx4x0sw9fz8y5fibi15xfsrw5avir0cx0599yd7p3ykik5g";
})
(fetchNuGet {
pname = "NUnit";
@@ -433,12 +433,12 @@
})
(fetchNuGet {
pname = "System.Text.Encodings.Web";
version = "6.0.0";
sha256 = "06n9ql3fmhpjl32g3492sj181zjml5dlcc5l76xq2h38c4f87sai";
version = "7.0.0";
sha256 = "1151hbyrcf8kyg1jz8k9awpbic98lwz9x129rg7zk1wrs6vjlpxl";
})
(fetchNuGet {
pname = "System.Text.Json";
version = "6.0.0";
sha256 = "1si2my1g0q0qv1hiqnji4xh9wd05qavxnzj9dwgs23iqvgjky0gl";
version = "7.0.3";
sha256 = "0zjrnc9lshagm6kdb9bdh45dmlnkpwcpyssa896sda93ngbmj8k9";
})
]