patrick/WoofWare.Myriad
1
0
Fork 0
mirror of https://github.com/Smaug123/WoofWare.Myriad synced 2025-10-08 13:38:39 +00:00
Code Issues Packages Projects Releases Wiki Activity

Implement RestEase variable headers (#76)

Browse Source
This commit is contained in:
Patrick Stevens
2024-01-29 21:24:41 +00:00
committed by GitHub
parent 5c1841c3d2
commit f803b44311
9 changed files with 886 additions and 482 deletions
Download Patch File Download Diff File Expand all files Collapse all files

63
ConsumePlugin/GeneratedRestClient.fs
View File

@@ -1047,3 +1047,66 @@ module ApiWithBasePathAndAddress =
} }
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
} }
namespace PureGym
open System
open System.Threading
open System.Threading.Tasks
open System.IO
open System.Net
open System.Net.Http
open RestEase
/// Module for constructing a REST client.
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
[<RequireQualifiedAccess>]
module ApiWithHeaders =
/// 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.
let make
(someHeader : unit -> string)
(someOtherHeader : unit -> int)
(client : System.Net.Http.HttpClient)
: IApiWithHeaders
=
{ new IApiWithHeaders with
member _.SomeHeader : string = someHeader ()
member _.SomeOtherHeader : int = someOtherHeader ()
member this.GetPathParam (parameter : 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 (
"endpoint/{param}"
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
System.UriKind.Relative
)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
do httpMessage.Headers.Add ("X-Foo", this.SomeHeader.ToString ())
do httpMessage.Headers.Add ("Authorization", this.SomeOtherHeader.ToString ())
do httpMessage.Headers.Add ("Header-Name", "Header-Value")
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! responseString = response.Content.ReadAsStringAsync ct |> Async.AwaitTask
return responseString
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
}

12
ConsumePlugin/RestApiExample.fs
View File

@@ -125,3 +125,15 @@ type IApiWithBasePath =
type IApiWithBasePathAndAddress = type IApiWithBasePathAndAddress =
[<Get "endpoint/{param}">] [<Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string> abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>]
[<Header("Header-Name", "Header-Value")>]
type IApiWithHeaders =
[<Header "X-Foo">]
abstract SomeHeader : string
[<Header "Authorization">]
abstract SomeOtherHeader : int
[<Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>

754
README.md
View File

@@ -1,375 +1,379 @@
# WoofWare.Myriad.Plugins # WoofWare.Myriad.Plugins
[![NuGet version](https://img.shields.io/nuget/v/WoofWare.Myriad.Plugins.svg?style=flat-square)](https://www.nuget.org/packages/WoofWare.Myriad.Plugins) [![NuGet version](https://img.shields.io/nuget/v/WoofWare.Myriad.Plugins.svg?style=flat-square)](https://www.nuget.org/packages/WoofWare.Myriad.Plugins)
[![GitHub Actions status](https://github.com/Smaug123/WoofWare.Myriad/actions/workflows/dotnet.yaml/badge.svg)](https://github.com/Smaug123/WoofWare.Myriad/actions?query=branch%3Amain) [![GitHub Actions status](https://github.com/Smaug123/WoofWare.Myriad/actions/workflows/dotnet.yaml/badge.svg)](https://github.com/Smaug123/WoofWare.Myriad/actions?query=branch%3Amain)
[![License file](https://img.shields.io/github/license/Smaug123/WoofWare.Myriad)](./LICENSE) [![License file](https://img.shields.io/github/license/Smaug123/WoofWare.Myriad)](./LICENSE)
![Project logo: the face of a cartoon Shiba Inu, staring with powerful cyborg eyes directly at the viewer, with a background of stylised plugs.](./WoofWare.Myriad.Plugins/logo.png) ![Project logo: the face of a cartoon Shiba Inu, staring with powerful cyborg eyes directly at the viewer, with a background of stylised plugs.](./WoofWare.Myriad.Plugins/logo.png)
Some helpers in [Myriad](https://github.com/MoiraeSoftware/myriad/) which might be useful. Some helpers in [Myriad](https://github.com/MoiraeSoftware/myriad/) which might be useful.
These are currently somewhat experimental, and I personally am their primary customer. These are currently somewhat experimental, and I personally am their primary customer.
The `RemoveOptions` generator in particular is extremely half-baked. The `RemoveOptions` generator in particular is extremely half-baked.
If you would like to ensure that your particular use-case remains unbroken, please do contribute tests to this repository. If you would like to ensure that your particular use-case remains unbroken, please do contribute tests to this repository.
The `ConsumePlugin` assembly contains a number of invocations of these source generators, The `ConsumePlugin` assembly contains a number of invocations of these source generators,
so you just need to add copies of your types to that assembly to ensure that I will at least notice if I break the build; so you just need to add copies of your types to that assembly to ensure that I will at least notice if I break the build;
and if you add tests to `WoofWare.Myriad.Plugins.Test` then I will also notice if I break the runtime semantics of the generated code. and if you add tests to `WoofWare.Myriad.Plugins.Test` then I will also notice if I break the runtime semantics of the generated code.
Currently implemented: Currently implemented:
* `JsonParse` (to stamp out `jsonParse : JsonNode -> 'T` methods); * `JsonParse` (to stamp out `jsonParse : JsonNode -> 'T` methods);
* `JsonSerialize` (to stamp out `toJsonNode : 'T -> JsonNode` methods); * `JsonSerialize` (to stamp out `toJsonNode : 'T -> JsonNode` methods);
* `RemoveOptions` (to strip `option` modifiers from a type). * `RemoveOptions` (to strip `option` modifiers from a type).
* `HttpClient` (to stamp out a [RestEase](https://github.com/canton7/RestEase)-style HTTP client). * `HttpClient` (to stamp out a [RestEase](https://github.com/canton7/RestEase)-style HTTP client).
* `GenerateMock` (to stamp out a record type corresponding to an interface). * `GenerateMock` (to stamp out a record type corresponding to an interface).
## `JsonParse` ## `JsonParse`
Takes records like this: Takes records like this:
```fsharp ```fsharp
[<WoofWare.Myriad.Plugins.JsonParse>] [<WoofWare.Myriad.Plugins.JsonParse>]
type InnerType = type InnerType =
{ {
[<JsonPropertyName "something">] [<JsonPropertyName "something">]
Thing : string Thing : string
} }
/// My whatnot /// My whatnot
[<WoofWare.Myriad.Plugins.JsonParse>] [<WoofWare.Myriad.Plugins.JsonParse>]
type JsonRecordType = type JsonRecordType =
{ {
/// A thing! /// A thing!
A : int A : int
/// Another thing! /// Another thing!
B : string B : string
[<System.Text.Json.Serialization.JsonPropertyName "hi">] [<System.Text.Json.Serialization.JsonPropertyName "hi">]
C : int list C : int list
D : InnerType D : InnerType
} }
``` ```
and stamps out parsing methods like this: and stamps out parsing methods like this:
```fsharp ```fsharp
/// Module containing JSON parsing methods for the InnerType type /// Module containing JSON parsing methods for the InnerType type
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>] [<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module InnerType = module InnerType =
/// Parse from a JSON node. /// Parse from a JSON node.
let jsonParse (node: System.Text.Json.Nodes.JsonNode) : InnerType = let jsonParse (node: System.Text.Json.Nodes.JsonNode) : InnerType =
let Thing = node.["something"].AsValue().GetValue<string>() let Thing = node.["something"].AsValue().GetValue<string>()
{ Thing = Thing } { Thing = Thing }
namespace UsePlugin namespace UsePlugin
/// Module containing JSON parsing methods for the JsonRecordType type /// Module containing JSON parsing methods for the JsonRecordType type
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>] [<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module JsonRecordType = module JsonRecordType =
/// Parse from a JSON node. /// Parse from a JSON node.
let jsonParse (node: System.Text.Json.Nodes.JsonNode) : JsonRecordType = let jsonParse (node: System.Text.Json.Nodes.JsonNode) : JsonRecordType =
let D = InnerType.jsonParse node.["d"] let D = InnerType.jsonParse node.["d"]
let C = let C =
node.["hi"].AsArray() |> Seq.map (fun elt -> elt.GetValue<int>()) |> List.ofSeq node.["hi"].AsArray() |> Seq.map (fun elt -> elt.GetValue<int>()) |> List.ofSeq
let B = node.["b"].AsValue().GetValue<string>() let B = node.["b"].AsValue().GetValue<string>()
let A = node.["a"].AsValue().GetValue<int>() let A = node.["a"].AsValue().GetValue<int>()
{ A = A; B = B; C = C; D = D } { A = A; B = B; C = C; D = D }
``` ```
You can optionally supply the boolean `true` to the attribute, 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. which will cause Myriad to stamp out an extension method rather than a module with the same name as the type.
This is useful if you want to reuse the type name as a module name yourself, This is useful if you want to reuse the type name as a module name yourself,
or if you want to apply multiple source generators which each want to use the module name. or if you want to apply multiple source generators which each want to use the module name.
### What's the point? ### What's the point?
`System.Text.Json`, in a `PublishAot` context, relies on C# source generators. `System.Text.Json`, in a `PublishAot` context, relies on C# source generators.
The default reflection-heavy implementations have the necessary code trimmed away, and result in a runtime exception. The default reflection-heavy implementations have the necessary code trimmed away, and result in a runtime exception.
But C# source generators [are entirely unsupported in F#](https://github.com/dotnet/fsharp/issues/14300). But C# source generators [are entirely unsupported in F#](https://github.com/dotnet/fsharp/issues/14300).
This Myriad generator expects you to use `System.Text.Json` to construct a `JsonNode`, This Myriad generator expects you to use `System.Text.Json` to construct a `JsonNode`,
and then the generator takes over to construct a strongly-typed object. and then the generator takes over to construct a strongly-typed object.
### Limitations ### Limitations
This source generator is enough for what I first wanted to use it for. This source generator is enough for what I first wanted to use it for.
However, there is *far* more that could be done. However, there is *far* more that could be done.
* Make it possible to give an exact format and cultural info in date and time parsing. * Make it possible to give an exact format and cultural info in date and time parsing.
* Make it possible to reject parsing if extra fields are present. * Make it possible to reject parsing if extra fields are present.
* Generally support all the `System.Text.Json` attributes. * Generally support all the `System.Text.Json` attributes.
For an example of using both `JsonParse` and `JsonSerialize` together with complex types, see [the type definitions](./ConsumePlugin/SerializationAndDeserialization.fs) and [tests](./WoofWare.Myriad.Plugins.Test/TestJsonSerialize/TestJsonSerde.fs). For an example of using both `JsonParse` and `JsonSerialize` together with complex types, see [the type definitions](./ConsumePlugin/SerializationAndDeserialization.fs) and [tests](./WoofWare.Myriad.Plugins.Test/TestJsonSerialize/TestJsonSerde.fs).
## `JsonSerialize` ## `JsonSerialize`
Takes records like this: Takes records like this:
```fsharp ```fsharp
[<WoofWare.Myriad.Plugins.JsonSerialize true>] [<WoofWare.Myriad.Plugins.JsonSerialize true>]
type InnerTypeWithBoth = type InnerTypeWithBoth =
{ {
[<JsonPropertyName("it's-a-me")>] [<JsonPropertyName("it's-a-me")>]
Thing : string Thing : string
ReadOnlyDict : IReadOnlyDictionary<string, Uri list> ReadOnlyDict : IReadOnlyDictionary<string, Uri list>
} }
``` ```
and stamps out modules like this: and stamps out modules like this:
```fsharp ```fsharp
module InnerTypeWithBoth = module InnerTypeWithBoth =
let toJsonNode (input : InnerTypeWithBoth) : System.Text.Json.Nodes.JsonNode = let toJsonNode (input : InnerTypeWithBoth) : System.Text.Json.Nodes.JsonNode =
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<string> input.Thing) node.Add (("it's-a-me"), System.Text.Json.Nodes.JsonValue.Create<string> input.Thing)
node.Add ( node.Add (
"ReadOnlyDict", "ReadOnlyDict",
(fun field -> (fun field ->
let ret = System.Text.Json.Nodes.JsonObject () 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 ) input.Map
) )
node node
``` ```
As in `JsonParse`, you can optionally supply the boolean `true` to the attribute, 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. which will cause Myriad to stamp out an extension method rather than a module with the same name as the type.
The same limitations generally apply to `JsonSerialize` as do to `JsonParse`. The same limitations generally apply to `JsonSerialize` as do to `JsonParse`.
For an example of using both `JsonParse` and `JsonSerialize` together with complex types, see [the type definitions](./ConsumePlugin/SerializationAndDeserialization.fs) and [tests](./WoofWare.Myriad.Plugins.Test/TestJsonSerialize/TestJsonSerde.fs). For an example of using both `JsonParse` and `JsonSerialize` together with complex types, see [the type definitions](./ConsumePlugin/SerializationAndDeserialization.fs) and [tests](./WoofWare.Myriad.Plugins.Test/TestJsonSerialize/TestJsonSerde.fs).
## `RemoveOptions` ## `RemoveOptions`
Takes a record like this: Takes a record like this:
```fsharp ```fsharp
type Foo = type Foo =
{ {
A : int option A : int option
B : string B : string
C : float list C : float list
} }
``` ```
and stamps out a record like this: and stamps out a record like this:
```fsharp ```fsharp
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Foo = module Foo =
type Short = type Short =
{ {
A : int A : int
B : string B : string
C : float list C : float list
} }
``` ```
### What's the point? ### What's the point?
The motivating example is argument parsing. The motivating example is argument parsing.
An argument parser naturally wants to express "the user did not supply this, so I will provide a default". An argument parser naturally wants to express "the user did not supply this, so I will provide a default".
But it's not a very ergonomic experience for the programmer to deal with all these options, But it's not a very ergonomic experience for the programmer to deal with all these options,
so this Myriad generator stamps out a type *without* any options, so this Myriad generator stamps out a type *without* any options,
and also stamps out an appropriate constructor function. and also stamps out an appropriate constructor function.
### Limitations ### Limitations
This generator is *far* from where I want it, because I haven't really spent any time on it. This generator is *far* from where I want it, because I haven't really spent any time on it.
* It really wants to be able to recurse into the types within the record, to strip options from them. * It really wants to be able to recurse into the types within the record, to strip options from them.
* It needs some sort of attribute to mark a field as *not* receiving this treatment. * It needs some sort of attribute to mark a field as *not* receiving this treatment.
* What do we do about discriminated unions? * What do we do about discriminated unions?
## `HttpClient` ## `HttpClient`
Takes a type like this: Takes a type like this:
```fsharp ```fsharp
[<WoofWare.Myriad.Plugins.HttpClient>] [<WoofWare.Myriad.Plugins.HttpClient>]
type IPureGymApi = type IPureGymApi =
[<Get "v1/gyms/">] [<Get "v1/gyms/">]
abstract GetGyms : ?ct : CancellationToken -> Task<Gym list> abstract GetGyms : ?ct : CancellationToken -> Task<Gym list>
[<Get "v1/gyms/{gym_id}/attendance">] [<Get "v1/gyms/{gym_id}/attendance">]
abstract GetGymAttendance : [<Path "gym_id">] gymId : int * ?ct : CancellationToken -> Task<GymAttendance> abstract GetGymAttendance : [<Path "gym_id">] gymId : int * ?ct : CancellationToken -> Task<GymAttendance>
[<Get "v1/member">] [<Get "v1/member">]
abstract GetMember : ?ct : CancellationToken -> Task<Member> abstract GetMember : ?ct : CancellationToken -> Task<Member>
[<Get "v1/gyms/{gym_id}">] [<Get "v1/gyms/{gym_id}">]
abstract GetGym : [<Path "gym_id">] gymId : int * ?ct : CancellationToken -> Task<Gym> abstract GetGym : [<Path "gym_id">] gymId : int * ?ct : CancellationToken -> Task<Gym>
[<Get "v1/member/activity">] [<Get "v1/member/activity">]
abstract GetMemberActivity : ?ct : CancellationToken -> Task<MemberActivityDto> abstract GetMemberActivity : ?ct : CancellationToken -> Task<MemberActivityDto>
[<Get "v2/gymSessions/member">] [<Get "v2/gymSessions/member">]
abstract GetSessions : abstract GetSessions :
[<Query>] fromDate : DateTime * [<Query>] toDate : DateTime * ?ct : CancellationToken -> Task<Sessions> [<Query>] fromDate : DateTime * [<Query>] toDate : DateTime * ?ct : CancellationToken -> Task<Sessions>
``` ```
and stamps out a type like this: and stamps out a type like this:
```fsharp ```fsharp
/// Module for constructing a REST client. /// Module for constructing a REST client.
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>] [<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module PureGymApi = module PureGymApi =
/// Create a REST client. /// Create a REST client.
let make (client : System.Net.Http.HttpClient) : IPureGymApi = let make (client : System.Net.Http.HttpClient) : IPureGymApi =
{ new IPureGymApi with { new IPureGymApi with
member _.GetGyms (ct : CancellationToken option) = member _.GetGyms (ct : CancellationToken option) =
async { async {
let! ct = Async.CancellationToken let! ct = Async.CancellationToken
let httpMessage = let httpMessage =
new System.Net.Http.HttpRequestMessage ( new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get, Method = System.Net.Http.HttpMethod.Get,
RequestUri = System.Uri (client.BaseAddress.ToString () + "v1/gyms/") RequestUri = System.Uri (client.BaseAddress.ToString () + "v1/gyms/")
) )
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode () let response = response.EnsureSuccessStatusCode ()
let! stream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask let! stream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
let! node = let! node =
System.Text.Json.Nodes.JsonNode.ParseAsync (stream, cancellationToken = ct) System.Text.Json.Nodes.JsonNode.ParseAsync (stream, cancellationToken = ct)
|> Async.AwaitTask |> Async.AwaitTask
return node.AsArray () |> Seq.map (fun elt -> Gym.jsonParse elt) |> List.ofSeq return node.AsArray () |> Seq.map (fun elt -> Gym.jsonParse elt) |> List.ofSeq
} }
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
// (more methods here) // (more methods here)
} }
``` ```
### What's the point? ### What's the point?
The motivating example is again ahead-of-time compilation: we wish to avoid the reflection which RestEase does. The motivating example is again ahead-of-time compilation: we wish to avoid the reflection which RestEase does.
### Limitations ### Features
RestEase is complex, and handles a lot of different stuff. * Variable and constant header values are supported:
see [the definition of `IApiWithHeaders`](./ConsumePlugin/RestApiExample.fs).
* If you set the `BaseAddress` on your input `HttpClient`, make sure to end with a trailing slash
on any trailing directories (so `"blah/foo/"` rather than `"blah/foo"`). ### Limitations
We combine URIs using `UriKind.Relative`, so without a trailing slash, the last component may be chopped off.
* Parameters are serialised naively with `toJsonNode` as though the `JsonSerialize` generator were applied, RestEase is complex, and handles a lot of different stuff.
and you can't control the serialisation. You can't yet serialise e.g. a primitive type this way (other than `String`);
all body parameters must be types which have a suitable `toJsonNode : 'a -> JsonNode` method. * If you set the `BaseAddress` on your input `HttpClient`, make sure to end with a trailing slash
* Deserialisation follows the same logic as the `JsonParse` generator, on any trailing directories (so `"blah/foo/"` rather than `"blah/foo"`).
and it generally assumes you're using types which `JsonParse` is applied to. We combine URIs using `UriKind.Relative`, so without a trailing slash, the last component may be chopped off.
* Headers are not yet supported. * Parameters are serialised naively with `toJsonNode` as though the `JsonSerialize` generator were applied,
* Anonymous parameters are currently forbidden. and you can't control the serialisation. You can't yet serialise e.g. a primitive type this way (other than `String`);
all body parameters must be types which have a suitable `toJsonNode : 'a -> JsonNode` method.
There are also some design decisions: * Deserialisation follows the same logic as the `JsonParse` generator,
and it generally assumes you're using types which `JsonParse` is applied to.
* Every function must take an optional `CancellationToken` (which is good practice anyway); * Anonymous parameters are currently forbidden.
so arguments are forced to be tupled.
There are also some design decisions:
## `GenerateMock`
* Every function must take an optional `CancellationToken` (which is good practice anyway);
Takes a type like this: so arguments are forced to be tupled.
```fsharp ## `GenerateMock`
[<GenerateMock>]
type IPublicType = Takes a type like this:
abstract Mem1 : string * int -> string list
abstract Mem2 : string -> int ```fsharp
``` [<GenerateMock>]
type IPublicType =
and stamps out a type like this: abstract Mem1 : string * int -> string list
abstract Mem2 : string -> int
```fsharp ```
/// Mock record type for an interface
type internal PublicTypeMock = and stamps out a type like this:
{
Mem1 : string * int -> string list ```fsharp
Mem2 : string -> int /// Mock record type for an interface
} type internal PublicTypeMock =
{
static member Empty : PublicTypeMock = Mem1 : string * int -> string list
{ Mem2 : string -> int
Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) }
Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
} static member Empty : PublicTypeMock =
{
interface IPublicType with Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
member this.Mem1 (arg0, arg1) = this.Mem1 (arg0, arg1) Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
member this.Mem2 (arg0) = this.Mem2 (arg0) }
```
interface IPublicType with
### What's the point? member this.Mem1 (arg0, arg1) = this.Mem1 (arg0, arg1)
member this.Mem2 (arg0) = this.Mem2 (arg0)
Reflective mocking libraries like [Foq](https://github.com/fsprojects/Foq) in my experience are a rich source of flaky tests. ```
The [Grug-brained developer](https://grugbrain.dev/) would prefer to do this without reflection, and this reduces the rate of strange one-in-ten-thousand "failed to generate IL" errors.
But since F# does not let you partially update an interface definition, we instead stamp out a record, ### What's the point?
thereby allowing the programmer to use F#'s record-update syntax.
Reflective mocking libraries like [Foq](https://github.com/fsprojects/Foq) in my experience are a rich source of flaky tests.
### Limitations The [Grug-brained developer](https://grugbrain.dev/) would prefer to do this without reflection, and this reduces the rate of strange one-in-ten-thousand "failed to generate IL" errors.
But since F# does not let you partially update an interface definition, we instead stamp out a record,
* We make the resulting record type at most internal (never public), since this is intended only to be used in tests. thereby allowing the programmer to use F#'s record-update syntax.
You will therefore need an `AssemblyInfo.fs` file [like the one in WoofWare.Myriad's own tests](./ConsumePlugin/AssemblyInfo.fs).
### Limitations
# Detailed examples
* We make the resulting record type at most internal (never public), since this is intended only to be used in tests.
See the tests. You will therefore need an `AssemblyInfo.fs` file [like the one in WoofWare.Myriad's own tests](./ConsumePlugin/AssemblyInfo.fs).
For example, [PureGymDto.fs](./ConsumePlugin/PureGymDto.fs) is a real-world set of DTOs.
# Detailed examples
## How to use
See the tests.
* In your `.fsproj` file, define a helper variable so that subsequent steps don't all have to be kept in sync: For example, [PureGymDto.fs](./ConsumePlugin/PureGymDto.fs) is a real-world set of DTOs.
```xml
<PropertyGroup> ## How to use
<WoofWareMyriadPluginVersion>1.3.5</WoofWareMyriadPluginVersion>
</PropertyGroup> * In your `.fsproj` file, define a helper variable so that subsequent steps don't all have to be kept in sync:
``` ```xml
* Take a reference on `WoofWare.Myriad.Plugins`: <PropertyGroup>
```xml <WoofWareMyriadPluginVersion>1.3.5</WoofWareMyriadPluginVersion>
<ItemGroup> </PropertyGroup>
<PackageReference Include="WoofWare.Myriad.Plugins" Version="$(WoofWareMyriadPluginVersion)" /> ```
</ItemGroup> * Take a reference on `WoofWare.Myriad.Plugins`:
``` ```xml
* Point Myriad to the DLL within the NuGet package which is the source of the plugins: <ItemGroup>
```xml <PackageReference Include="WoofWare.Myriad.Plugins" Version="$(WoofWareMyriadPluginVersion)" />
<ItemGroup> </ItemGroup>
<MyriadSdkGenerator Include="$(NuGetPackageRoot)/woofware.myriad.plugins/$(WoofWareMyriadPluginVersion)/lib/net6.0/WoofWare.Myriad.Plugins.dll" /> ```
</ItemGroup> * Point Myriad to the DLL within the NuGet package which is the source of the plugins:
``` ```xml
<ItemGroup>
Now you are ready to start using the generators. <MyriadSdkGenerator Include="$(NuGetPackageRoot)/woofware.myriad.plugins/$(WoofWareMyriadPluginVersion)/lib/net6.0/WoofWare.Myriad.Plugins.dll" />
For example, this specifies that Myriad is to use the contents of `Client.fs` to generate the file `GeneratedClient.fs`: </ItemGroup>
```
```xml
<ItemGroup> Now you are ready to start using the generators.
<Compile Include="Client.fs" /> For example, this specifies that Myriad is to use the contents of `Client.fs` to generate the file `GeneratedClient.fs`:
<Compile Include="GeneratedClient.fs">
<MyriadFile>Client.fs</MyriadFile> ```xml
</Compile> <ItemGroup>
</ItemGroup> <Compile Include="Client.fs" />
``` <Compile Include="GeneratedClient.fs">
<MyriadFile>Client.fs</MyriadFile>
### Myriad Gotchas </Compile>
</ItemGroup>
* MsBuild doesn't always realise that it needs to invoke Myriad during rebuild. ```
You can always save a whitespace change to the source file (e.g. `Client.fs` above),
and MsBuild will then execute Myriad during the next build. ### Myriad Gotchas
* [Fantomas](https://github.com/fsprojects/fantomas), the F# source formatter which powers Myriad,
is customisable with [editorconfig](https://editorconfig.org/), * MsBuild doesn't always realise that it needs to invoke Myriad during rebuild.
but it [does not easily expose](https://github.com/fsprojects/fantomas/issues/3031) this customisation You can always save a whitespace change to the source file (e.g. `Client.fs` above),
except through the standalone Fantomas client. and MsBuild will then execute Myriad during the next build.
So Myriad's output is formatted without respect to any conventions which may hold in the rest of your repository. * [Fantomas](https://github.com/fsprojects/fantomas), the F# source formatter which powers Myriad,
You should probably add these files to your [fantomasignore](https://github.com/fsprojects/fantomas/blob/a999b77ca5a024fbc3409955faac797e29b39d27/docs/docs/end-users/IgnoreFiles.md) is customisable with [editorconfig](https://editorconfig.org/),
if you use Fantomas to format your repo; but it [does not easily expose](https://github.com/fsprojects/fantomas/issues/3031) this customisation
the alternative is to manually reformat every time Myriad changes the generated files. except through the standalone Fantomas client.
So Myriad's output is formatted without respect to any conventions which may hold in the rest of your repository.
You should probably add these files to your [fantomasignore](https://github.com/fsprojects/fantomas/blob/a999b77ca5a024fbc3409955faac797e29b39d27/docs/docs/end-users/IgnoreFiles.md)
if you use Fantomas to format your repo;
the alternative is to manually reformat every time Myriad changes the generated files.

108
WoofWare.Myriad.Plugins.Test/TestHttpClient/TestVariableHeader.fs Normal file
View File

@@ -0,0 +1,108 @@
namespace WoofWare.Myriad.Plugins.Test
open System
open System.Net
open System.Net.Http
open System.Threading
open NUnit.Framework
open FsUnitTyped
open PureGym
[<TestFixture>]
module TestVariableHeader =
[<Test>]
let ``Headers are set`` () : unit =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
message.RequestUri.ToString ()
|> shouldEqual "https://example.com/endpoint/param"
let headers =
[
for h in message.Headers do
yield $"%s{h.Key}: %s{Seq.exactlyOne h.Value}"
]
|> String.concat "\n"
let content = new StringContent (headers)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make (Uri "https://example.com") proc
let someHeaderCount = ref 10
let someHeader () =
(Interlocked.Increment someHeaderCount : int).ToString ()
let someOtherHeaderCount = ref -100
let someOtherHeader () =
Interlocked.Increment someOtherHeaderCount
let api = ApiWithHeaders.make someHeader someOtherHeader client
someHeaderCount.Value |> shouldEqual 10
someOtherHeaderCount.Value |> shouldEqual -100
api.GetPathParam("param").Result.Split "\n"
|> Array.sort
|> shouldEqual [| "Authorization: -99" ; "Header-Name: Header-Value" ; "X-Foo: 11" |]
someHeaderCount.Value |> shouldEqual 11
someOtherHeaderCount.Value |> shouldEqual -99
[<Test>]
let ``Headers get re-evaluated every time`` () : unit =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
message.RequestUri.ToString ()
|> shouldEqual "https://example.com/endpoint/param"
let headers =
[
for h in message.Headers do
yield $"%s{h.Key}: %s{Seq.exactlyOne h.Value}"
]
|> String.concat "\n"
let content = new StringContent (headers)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make (Uri "https://example.com") proc
let someHeaderCount = ref 10
let someHeader () =
(Interlocked.Increment someHeaderCount : int).ToString ()
let someOtherHeaderCount = ref -100
let someOtherHeader () =
Interlocked.Increment someOtherHeaderCount
let api = ApiWithHeaders.make someHeader someOtherHeader client
someHeaderCount.Value |> shouldEqual 10
someOtherHeaderCount.Value |> shouldEqual -100
api.GetPathParam("param").Result.Split "\n"
|> Array.sort
|> shouldEqual [| "Authorization: -99" ; "Header-Name: Header-Value" ; "X-Foo: 11" |]
api.GetPathParam("param").Result.Split "\n"
|> Array.sort
|> shouldEqual [| "Authorization: -98" ; "Header-Name: Header-Value" ; "X-Foo: 12" |]
someHeaderCount.Value |> shouldEqual 12
someOtherHeaderCount.Value |> shouldEqual -98

1
WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj
View File

@@ -19,6 +19,7 @@
<Compile Include="TestHttpClient\TestBasePath.fs" /> <Compile Include="TestHttpClient\TestBasePath.fs" />
<Compile Include="TestHttpClient\TestBodyParam.fs" /> <Compile Include="TestHttpClient\TestBodyParam.fs" />
<Compile Include="TestHttpClient\TestVaultClient.fs" /> <Compile Include="TestHttpClient\TestVaultClient.fs" />
<Compile Include="TestHttpClient\TestVariableHeader.fs" />
<Compile Include="TestMockGenerator\TestMockGenerator.fs" /> <Compile Include="TestMockGenerator\TestMockGenerator.fs" />
<Compile Include="TestRemoveOptions.fs"/> <Compile Include="TestRemoveOptions.fs"/>
<Compile Include="TestSurface.fs"/> <Compile Include="TestSurface.fs"/>

211
WoofWare.Myriad.Plugins/AstHelper.fs
View File

@@ -33,11 +33,29 @@ type internal MemberInfo =
IsMutable : bool IsMutable : bool
} }
[<RequireQualifiedAccess>]
type internal PropertyAccessors =
| Get
| Set
| GetSet
type internal PropertyInfo =
{
Type : SynType
Accessibility : SynAccess option
Attributes : SynAttribute list
XmlDoc : PreXmlDoc option
Accessors : PropertyAccessors
IsInline : bool
Identifier : Ident
}
type internal InterfaceType = type internal InterfaceType =
{ {
Attributes : SynAttribute list Attributes : SynAttribute list
Name : LongIdent Name : LongIdent
Members : MemberInfo list Members : MemberInfo list
Properties : PropertyInfo list
Generics : SynTyparDecls option Generics : SynTyparDecls option
Accessibility : SynAccess option Accessibility : SynAccess option
} }
@@ -230,6 +248,108 @@ module internal AstHelper =
((toFun (List.map fst inputArgs) inputRet), hasParen) :: args, ret ((toFun (List.map fst inputArgs) inputRet), hasParen) :: args, ret
| _ -> [], ty | _ -> [], ty
let private parseMember (slotSig : SynValSig) (flags : SynMemberFlags) : Choice<MemberInfo, PropertyInfo> =
if not flags.IsInstance then
failwith "member was not an instance member"
let propertyAccessors =
match flags.MemberKind with
| SynMemberKind.Member -> None
| SynMemberKind.PropertyGet -> Some PropertyAccessors.Get
| SynMemberKind.PropertySet -> Some PropertyAccessors.Set
| SynMemberKind.PropertyGetSet -> Some PropertyAccessors.GetSet
| kind -> failwithf "Unrecognised member kind: %+A" kind
match slotSig with
| SynValSig (attrs,
SynIdent.SynIdent (ident, _),
_typeParams,
synType,
_arity,
isInline,
isMutable,
xmlDoc,
accessibility,
synExpr,
_,
_) ->
match synExpr with
| Some _ -> failwith "literal members are not supported"
| None -> ()
let attrs = attrs |> List.collect _.Attributes
let args, ret = getType synType
let args =
args
|> List.map (fun (args, hasParen) ->
match args with
| SynType.Tuple (false, path, _) -> extractTupledTypes path
| SynType.SignatureParameter _ ->
let arg, hasParen = convertSigParam args
{
HasParen = hasParen
Args = [ arg ]
}
| SynType.LongIdent (SynLongIdent (ident, _, _)) ->
{
HasParen = false
Args =
{
Attributes = []
IsOptional = false
Id = None
Type = SynType.CreateLongIdent (SynLongIdent.CreateFromLongIdent ident)
}
|> List.singleton
}
| SynType.Var (typar, _) ->
{
HasParen = false
Args =
{
Attributes = []
IsOptional = false
Id = None
Type = SynType.Var (typar, range0)
}
|> List.singleton
}
| _ -> failwith $"Unrecognised args in interface method declaration: %+A{args}"
|> fun ty ->
{ ty with
HasParen = ty.HasParen || hasParen
}
)
match propertyAccessors with
| None ->
{
ReturnType = ret
Args = args
Identifier = ident
Attributes = attrs
XmlDoc = Some xmlDoc
Accessibility = accessibility
IsInline = isInline
IsMutable = isMutable
}
|> Choice1Of2
| Some accessors ->
{
Type = ret
Accessibility = accessibility
Attributes = attrs
XmlDoc = Some xmlDoc
Accessors = accessors
IsInline = isInline
Identifier = ident
}
|> Choice2Of2
/// Assumes that the input type is an ObjectModel, i.e. a `type Foo = member ...` /// Assumes that the input type is an ObjectModel, i.e. a `type Foo = member ...`
let parseInterface (interfaceType : SynTypeDefn) : InterfaceType = let parseInterface (interfaceType : SynTypeDefn) : InterfaceType =
let (SynTypeDefn (SynComponentInfo (attrs, typars, _, interfaceName, _, _, accessibility, _), let (SynTypeDefn (SynComponentInfo (attrs, typars, _, interfaceName, _, _, accessibility, _),
@@ -242,104 +362,21 @@ module internal AstHelper =
let attrs = attrs |> List.collect (fun s -> s.Attributes) let attrs = attrs |> List.collect (fun s -> s.Attributes)
let members = let members, properties =
match synTypeDefnRepr with match synTypeDefnRepr with
| SynTypeDefnRepr.ObjectModel (_kind, members, _) -> | SynTypeDefnRepr.ObjectModel (_kind, members, _) ->
members members
|> List.map (fun defn -> |> List.map (fun defn ->
match defn with match defn with
| SynMemberDefn.AbstractSlot (slotSig, flags, _, _) -> | SynMemberDefn.AbstractSlot (slotSig, flags, _, _) -> parseMember slotSig flags
match flags.MemberKind with
| SynMemberKind.Member -> ()
| kind -> failwithf "Unrecognised member kind: %+A" kind
if not flags.IsInstance then
failwith "member was not an instance member"
match slotSig with
| SynValSig (attrs,
SynIdent.SynIdent (ident, _),
_typeParams,
synType,
arity,
isInline,
isMutable,
xmlDoc,
accessibility,
synExpr,
_,
_) ->
match synExpr with
| Some _ -> failwith "literal members are not supported"
| None -> ()
let attrs = attrs |> List.collect (fun attr -> attr.Attributes)
let args, ret = getType synType
let args =
args
|> List.map (fun (args, hasParen) ->
match args with
| SynType.Tuple (false, path, _) -> extractTupledTypes path
| SynType.SignatureParameter _ ->
let arg, hasParen = convertSigParam args
{
HasParen = hasParen
Args = [ arg ]
}
| SynType.LongIdent (SynLongIdent (ident, _, _)) ->
{
HasParen = false
Args =
{
Attributes = []
IsOptional = false
Id = None
Type =
SynType.CreateLongIdent (
SynLongIdent.CreateFromLongIdent ident
)
}
|> List.singleton
}
| SynType.Var (typar, _) ->
{
HasParen = false
Args =
{
Attributes = []
IsOptional = false
Id = None
Type = SynType.Var (typar, range0)
}
|> List.singleton
}
| _ -> failwith $"Unrecognised args in interface method declaration: %+A{args}"
|> fun ty ->
{ ty with
HasParen = ty.HasParen || hasParen
}
)
{
ReturnType = ret
Args = args
Identifier = ident
Attributes = attrs
XmlDoc = Some xmlDoc
Accessibility = accessibility
IsInline = isInline
IsMutable = isMutable
}
| _ -> failwith $"Unrecognised member definition: %+A{defn}" | _ -> failwith $"Unrecognised member definition: %+A{defn}"
) )
| _ -> failwith $"Unrecognised SynTypeDefnRepr for an interface type: %+A{synTypeDefnRepr}" | _ -> failwith $"Unrecognised SynTypeDefnRepr for an interface type: %+A{synTypeDefnRepr}"
|> List.partitionChoice
{ {
Members = members Members = members
Properties = properties
Name = interfaceName Name = interfaceName
Attributes = attrs Attributes = attrs
Generics = typars Generics = typars

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

@@ -2,7 +2,9 @@ namespace WoofWare.Myriad.Plugins
open System open System
open System.Net.Http open System.Net.Http
open System.Text
open Fantomas.FCS.Syntax open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Xml open Fantomas.FCS.Xml
open Myriad.Core open Myriad.Core
@@ -125,6 +127,20 @@ module internal HttpClientGenerator =
| matchingAttrs -> | matchingAttrs ->
failwith $"Required exactly one recognised RestEase attribute on member, but got %i{matchingAttrs.Length}" failwith $"Required exactly one recognised RestEase attribute on member, but got %i{matchingAttrs.Length}"
/// Get the args associated with the Header attributes within the list.
let extractHeaderInformation (attrs : SynAttribute list) : SynExpr list list =
attrs
|> List.choose (fun attr ->
match attr.TypeName.AsString with
| "Header"
| "RestEase.Header" ->
match attr.ArgExpr with
| SynExpr.Paren (SynExpr.Tuple (_, [ v1 ; v2 ], _, _), _, _, _) ->
Some [ SynExpr.stripOptionalParen v1 ; SynExpr.stripOptionalParen v2 ]
| e -> Some [ SynExpr.stripOptionalParen e ]
| _ -> None
)
let shouldAllowAnyStatusCode (attrs : SynAttribute list) : bool = let shouldAllowAnyStatusCode (attrs : SynAttribute list) : bool =
attrs attrs
|> List.exists (fun attr -> |> List.exists (fun attr ->
@@ -136,7 +152,14 @@ module internal HttpClientGenerator =
| _ -> false | _ -> false
) )
let constructMember (info : MemberInfo) : SynMemberDefn = /// constantHeaders are a list of (headerName, headerValue)
/// variableHeaders are a list of (headerName, selfPropertyToGetValueOf)
let constructMember
(constantHeaders : (SynExpr * SynExpr) list)
(variableHeaders : (SynExpr * Ident) list)
(info : MemberInfo)
: SynMemberDefn
=
let valInfo = let valInfo =
SynValInfo.SynValInfo ( SynValInfo.SynValInfo (
[ [
@@ -194,8 +217,10 @@ module internal HttpClientGenerator =
|> SynArgPats.Pats |> SynArgPats.Pats
let headPat = let headPat =
let thisIdent = if variableHeaders.IsEmpty then "_" else "this"
SynPat.LongIdent ( SynPat.LongIdent (
SynLongIdent.CreateFromLongIdent [ Ident.Create "_" ; info.Identifier ], SynLongIdent.CreateFromLongIdent [ Ident.Create thisIdent ; info.Identifier ],
None, None,
None, None,
argPats, argPats,
@@ -561,6 +586,38 @@ module internal HttpClientGenerator =
) )
) )
let setVariableHeaders =
variableHeaders
|> List.map (fun (headerName, callToGetValue) ->
Do (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "httpMessage" ; "Headers" ; "Add" ]),
SynExpr.CreateParenedTuple
[
headerName
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
SynLongIdent.CreateFromLongIdent
[ Ident.Create "this" ; callToGetValue ; Ident.Create "ToString" ]
),
SynExpr.CreateConst SynConst.Unit
)
]
)
)
)
let setConstantHeaders =
constantHeaders
|> List.map (fun (headerName, headerValue) ->
Do (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "httpMessage" ; "Headers" ; "Add" ]),
SynExpr.CreateParenedTuple [ headerName ; headerValue ]
)
)
)
[ [
yield LetBang ("ct", SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "CancellationToken" ])) yield LetBang ("ct", SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "CancellationToken" ]))
yield Let ("uri", requestUri) yield Let ("uri", requestUri)
@@ -579,6 +636,9 @@ module internal HttpClientGenerator =
yield! handleBodyParams yield! handleBodyParams
yield! setVariableHeaders
yield! setConstantHeaders
yield yield
LetBang ( LetBang (
"response", "response",
@@ -682,6 +742,12 @@ module internal HttpClientGenerator =
| _ -> None | _ -> None
) )
let lowerFirstLetter (x : Ident) : Ident =
let result = StringBuilder x.idText.Length
result.Append (Char.ToLowerInvariant x.idText.[0]) |> ignore
result.Append x.idText.[1..] |> ignore
Ident.Create ((result : StringBuilder).ToString ())
let createModule let createModule
(opens : SynOpenDeclTarget list) (opens : SynOpenDeclTarget list)
(ns : LongIdent) (ns : LongIdent)
@@ -690,10 +756,48 @@ module internal HttpClientGenerator =
= =
let interfaceType = AstHelper.parseInterface interfaceType let interfaceType = AstHelper.parseInterface interfaceType
let constantHeaders =
interfaceType.Attributes
|> extractHeaderInformation
|> List.map (fun exprs ->
match exprs with
| [ key ; value ] -> key, value
| [] ->
failwith
"Expected constant header parameters to be of the form [<Header (key, value)>], but got no args"
| [ _ ] ->
failwith
"Expected constant header parameters to be of the form [<Header (key, value)>], but got only one arg"
| _ ->
failwith
"Expected constant header parameters to be of the form [<Header (key, value)>], but got more than two args"
)
let baseAddress = extractBaseAddress interfaceType.Attributes let baseAddress = extractBaseAddress interfaceType.Attributes
let basePath = extractBasePath interfaceType.Attributes let basePath = extractBasePath interfaceType.Attributes
let members = let properties =
interfaceType.Properties
|> List.map (fun pi ->
let headerInfo =
match extractHeaderInformation pi.Attributes with
| [ [ x ] ] -> x
| [ xs ] ->
failwith
"Expected exactly one Header parameter on the member, with exactly one arg; got one Header parameter with non-1-many args"
| [] ->
failwith
"Expected exactly one Header parameter on the member, with exactly one arg; got no Header parameters"
| _ ->
failwith
"Expected exactly one Header parameter on the member, with exactly one arg; got multiple Header parameters"
headerInfo, pi
)
let nonPropertyMembers =
let properties = properties |> List.map (fun (header, pi) -> header, pi.Identifier)
interfaceType.Members interfaceType.Members
|> List.map (fun mem -> |> List.map (fun mem ->
let httpMethod, url = extractHttpInformation mem.Attributes let httpMethod, url = extractHttpInformation mem.Attributes
@@ -740,8 +844,57 @@ module internal HttpClientGenerator =
Accessibility = mem.Accessibility Accessibility = mem.Accessibility
} }
) )
|> List.map (constructMember constantHeaders properties)
let propertyMembers =
properties
|> List.map (fun (_, pi) ->
SynMemberDefn.Member (
SynBinding.SynBinding (
pi.Accessibility,
SynBindingKind.Normal,
pi.IsInline,
false,
[],
PreXmlDoc.Empty,
SynValData.SynValData (
Some
{
IsInstance = true
IsDispatchSlot = false
IsOverrideOrExplicitImpl = true
IsFinal = false
GetterOrSetterIsCompilerGenerated = false
MemberKind = SynMemberKind.Member
},
SynValInfo.SynValInfo ([ [ SynArgInfo.Empty ] ; [] ], SynArgInfo.Empty),
None
),
SynPat.CreateLongIdent (
SynLongIdent.CreateFromLongIdent [ Ident.Create "_" ; pi.Identifier ],
[]
),
Some (SynBindingReturnInfo.Create pi.Type),
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
SynLongIdent.CreateFromLongIdent [ lowerFirstLetter pi.Identifier ]
),
SynExpr.CreateConst SynConst.Unit
),
range0,
DebugPointAtBinding.Yes range0,
{
LeadingKeyword = SynLeadingKeyword.Member range0
InlineKeyword = if pi.IsInline then Some range0 else None
EqualsRange = Some range0
}
),
range0
)
)
let members = propertyMembers @ nonPropertyMembers
let constructed = members |> List.map constructMember
let docString = PreXmlDoc.Create " Module for constructing a REST client." let docString = PreXmlDoc.Create " Module for constructing a REST client."
let interfaceImpl = let interfaceImpl =
@@ -750,12 +903,35 @@ module internal HttpClientGenerator =
None, None,
Some range0, Some range0,
[], [],
constructed, members,
[], [],
range0, range0,
range0 range0
) )
let headerArgs =
properties
|> List.map (fun (_, pi) ->
SynPat.CreateTyped (
SynPat.CreateNamed (lowerFirstLetter pi.Identifier),
SynType.CreateFun (SynType.CreateLongIdent "unit", pi.Type)
)
|> SynPat.CreateParen
)
let clientCreationArg =
SynPat.CreateTyped (
SynPat.CreateNamed (Ident.Create "client"),
SynType.CreateLongIdent (SynLongIdent.Create [ "System" ; "Net" ; "Http" ; "HttpClient" ])
)
|> SynPat.CreateParen
let xmlDoc =
if properties.IsEmpty then
" 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."
let createFunc = let createFunc =
SynBinding.SynBinding ( SynBinding.SynBinding (
None, None,
@@ -763,7 +939,7 @@ module internal HttpClientGenerator =
false, false,
false, false,
[], [],
PreXmlDoc.Create " Create a REST client.", PreXmlDoc.Create xmlDoc,
SynValData.SynValData ( SynValData.SynValData (
None, None,
SynValInfo.SynValInfo ( SynValInfo.SynValInfo (
@@ -772,19 +948,7 @@ module internal HttpClientGenerator =
), ),
None None
), ),
SynPat.CreateLongIdent ( SynPat.CreateLongIdent (SynLongIdent.CreateString "make", headerArgs @ [ clientCreationArg ]),
SynLongIdent.CreateString "make",
[
SynPat.CreateParen (
SynPat.CreateTyped (
SynPat.CreateNamed (Ident.Create "client"),
SynType.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Net" ; "Http" ; "HttpClient" ]
)
)
)
]
),
Some ( Some (
SynBindingReturnInfo.Create ( SynBindingReturnInfo.Create (
SynType.LongIdent (SynLongIdent.CreateFromLongIdent interfaceType.Name) SynType.LongIdent (SynLongIdent.CreateFromLongIdent interfaceType.Name)
@@ -800,7 +964,7 @@ module internal HttpClientGenerator =
let moduleName : LongIdent = let moduleName : LongIdent =
List.last interfaceType.Name List.last interfaceType.Name
|> fun ident -> ident.idText |> _.idText
|> fun s -> |> fun s ->
if s.StartsWith 'I' then if s.StartsWith 'I' then
s.[1..] s.[1..]

14
WoofWare.Myriad.Plugins/List.fs Normal file
View File

@@ -0,0 +1,14 @@
namespace WoofWare.Myriad.Plugins
[<RequireQualifiedAccess>]
module private List =
let partitionChoice<'a, 'b> (xs : Choice<'a, 'b> list) : 'a list * 'b list =
let xs, ys =
(([], []), xs)
||> List.fold (fun (xs, ys) v ->
match v with
| Choice1Of2 x -> x :: xs, ys
| Choice2Of2 y -> xs, y :: ys
)
List.rev xs, List.rev ys

1
WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj
View File

@@ -24,6 +24,7 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<Compile Include="List.fs" />
<Compile Include="AstHelper.fs"/> <Compile Include="AstHelper.fs"/>
<Compile Include="SynExpr.fs"/> <Compile Include="SynExpr.fs"/>
<Compile Include="SynType.fs" /> <Compile Include="SynType.fs" />