Merge main

This commit is contained in:
Smaug123
2024-01-25 20:30:13 +00:00
47 changed files with 3401 additions and 446 deletions

View File

@@ -9,10 +9,10 @@
]
},
"fsharp-analyzers": {
"version": "0.22.0",
"version": "0.23.0",
"commands": [
"fsharp-analyzers"
]
}
}
}
}

View File

@@ -7,7 +7,7 @@ updates:
interval: "weekly"
- package-ecosystem: "nuget"
directory: "/ApiSurface"
directory: "/"
schedule:
interval: "weekly"
ignore:

View File

@@ -28,7 +28,7 @@ jobs:
with:
fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
- name: Install Nix
uses: cachix/install-nix-action@v24
uses: cachix/install-nix-action@v25
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -49,7 +49,7 @@ jobs:
with:
fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
- name: Install Nix
uses: cachix/install-nix-action@v24
uses: cachix/install-nix-action@v25
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -66,7 +66,7 @@ jobs:
- name: Checkout
uses: actions/checkout@v4
- name: Install Nix
uses: cachix/install-nix-action@v24
uses: cachix/install-nix-action@v25
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -79,7 +79,7 @@ jobs:
- name: Checkout
uses: actions/checkout@v4
- name: Install Nix
uses: cachix/install-nix-action@v24
uses: cachix/install-nix-action@v25
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -92,7 +92,7 @@ jobs:
- name: Checkout
uses: actions/checkout@v4
- name: Install Nix
uses: cachix/install-nix-action@v24
uses: cachix/install-nix-action@v25
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -105,7 +105,7 @@ jobs:
steps:
- uses: actions/checkout@master
- name: Install Nix
uses: cachix/install-nix-action@v24
uses: cachix/install-nix-action@v25
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -118,7 +118,7 @@ jobs:
steps:
- uses: actions/checkout@master
- name: Install Nix
uses: cachix/install-nix-action@v24
uses: cachix/install-nix-action@v25
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -132,7 +132,7 @@ jobs:
with:
fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
- name: Install Nix
uses: cachix/install-nix-action@v24
uses: cachix/install-nix-action@v25
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -174,7 +174,7 @@ jobs:
steps:
- uses: actions/checkout@v4
- name: Install Nix
uses: cachix/install-nix-action@v24
uses: cachix/install-nix-action@v25
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}

View File

@@ -0,0 +1,5 @@
namespace ConsumePlugin.AssemblyInfo
[<assembly : System.Runtime.CompilerServices.InternalsVisibleTo("WoofWare.Myriad.Plugins.Test")>]
do ()

View File

@@ -10,25 +10,31 @@
<ItemGroup>
<None Include="myriad.toml"/>
<Compile Include="AssemblyInfo.fs" />
<Compile Include="RecordFile.fs"/>
<Compile Include="GeneratedRecord.fs"> <!--1-->
<MyriadFile>RecordFile.fs</MyriadFile> <!--2-->
<Compile Include="GeneratedRecord.fs">
<MyriadFile>RecordFile.fs</MyriadFile>
</Compile>
<Compile Include="JsonRecord.fs"/>
<Compile Include="GeneratedJson.fs"> <!--1-->
<MyriadFile>JsonRecord.fs</MyriadFile> <!--2-->
<Compile Include="GeneratedJson.fs">
<MyriadFile>JsonRecord.fs</MyriadFile>
</Compile>
<Compile Include="PureGymDto.fs"/>
<Compile Include="GeneratedPureGymDto.fs">
<MyriadFile>PureGymDto.fs</MyriadFile> <!--2-->
<MyriadFile>PureGymDto.fs</MyriadFile>
</Compile>
<Compile Include="RestApiExample.fs"/>
<Compile Include="GeneratedRestClient.fs">
<MyriadFile>RestApiExample.fs</MyriadFile> <!--2-->
<MyriadFile>RestApiExample.fs</MyriadFile>
</Compile>
<Compile Include="MockExample.fs"/>
<Compile Include="GeneratedMock.fs">
<MyriadFile>MockExample.fs</MyriadFile>
</Compile>
<Compile Include="Vault.fs" />
<Compile Include="GeneratedVault.fs">
<MyriadFile>Vault.fs</MyriadFile>
</Compile>
<None Include="..\runmyriad.sh">
<Link>runmyriad.sh</Link>
</None>
</ItemGroup>
<ItemGroup>

View File

@@ -3,6 +3,7 @@
// Changes to this file will be lost when the code is regenerated.
//------------------------------------------------------------------------------
namespace ConsumePlugin
/// Module containing JSON parsing methods for the InnerType type
@@ -60,7 +61,17 @@ module JsonRecordType =
|> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
|> Array.ofSeq
let D = InnerType.jsonParse node.["d"]
let D =
InnerType.jsonParse (
match node.["d"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("d")
)
)
| v -> v
)
let C =
(match node.["hi"] with
@@ -107,3 +118,68 @@ module JsonRecordType =
E = E
F = F
}
namespace ConsumePlugin
/// Module containing JSON parsing extension members for the ToGetExtensionMethod type
[<AutoOpen>]
module ToGetExtensionMethodJsonParseExtension =
///Extension methods for JSON parsing
type ToGetExtensionMethod with
/// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : ToGetExtensionMethod =
let Sailor =
(match node.["sailor"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("sailor")
)
)
| v -> v)
.AsValue()
.GetValue<float> ()
let Soldier =
(match node.["soldier"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("soldier")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
|> System.Uri
let Tailor =
(match node.["tailor"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("tailor")
)
)
| v -> v)
.AsValue()
.GetValue<int> ()
let Tinker =
(match node.["tinker"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("tinker")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
{
Tinker = Tinker
Tailor = Tailor
Soldier = Soldier
Sailor = Sailor
}

View File

@@ -0,0 +1,113 @@
//------------------------------------------------------------------------------
// This code was generated by myriad.
// Changes to this file will be lost when the code is regenerated.
//------------------------------------------------------------------------------
namespace SomeNamespace
/// Mock record type for an interface
type internal PublicTypeMock =
{
Mem1 : string * int -> string list
Mem2 : string -> int
Mem3 : int * option<System.Threading.CancellationToken> -> string
}
static member Empty : PublicTypeMock =
{
Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem3 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
}
interface IPublicType with
member this.Mem1 (arg_0_0, arg_0_1) = this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 (arg_0_0) = this.Mem2 (arg_0_0)
member this.Mem3 (arg_0_0, arg_0_1) = this.Mem3 (arg_0_0, arg_0_1)
namespace SomeNamespace
/// Mock record type for an interface
type internal InternalTypeMock =
{
Mem1 : string * int -> unit
Mem2 : string -> int
}
static member Empty : InternalTypeMock =
{
Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
}
interface InternalType with
member this.Mem1 (arg_0_0, arg_0_1) = this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 (arg_0_0) = this.Mem2 (arg_0_0)
namespace SomeNamespace
/// Mock record type for an interface
type private PrivateTypeMock =
{
Mem1 : string * int -> unit
Mem2 : string -> int
}
static member Empty : PrivateTypeMock =
{
Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
}
interface PrivateType with
member this.Mem1 (arg_0_0, arg_0_1) = this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 (arg_0_0) = this.Mem2 (arg_0_0)
namespace SomeNamespace
/// Mock record type for an interface
type internal VeryPublicTypeMock<'a, 'b> =
{
Mem1 : 'a -> 'b
}
static member Empty () : VeryPublicTypeMock<'a, 'b> =
{
Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
}
interface VeryPublicType<'a, 'b> with
member this.Mem1 (arg_0_0) = this.Mem1 (arg_0_0)
namespace SomeNamespace
/// Mock record type for an interface
type internal CurriedMock<'a> =
{
Mem1 : int -> 'a -> string
Mem2 : int * string -> 'a -> string
Mem3 : (int * string) -> 'a -> string
Mem4 : (int * string) -> ('a * int) -> string
Mem5 : int * string -> ('a * int) -> string
Mem6 : int * string -> 'a * int -> string
}
static member Empty () : CurriedMock<'a> =
{
Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem3 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem4 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem5 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem6 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
}
interface Curried<'a> with
member this.Mem1 (arg_0_0) (arg_1_0) = this.Mem1 (arg_0_0) (arg_1_0)
member this.Mem2 (arg_0_0, arg_0_1) (arg_1_0) = this.Mem2 (arg_0_0, arg_0_1) (arg_1_0)
member this.Mem3 ((arg_0_0, arg_0_1)) (arg_1_0) = this.Mem3 (arg_0_0, arg_0_1) (arg_1_0)
member this.Mem4 ((arg_0_0, arg_0_1)) ((arg_1_0, arg_1_1)) =
this.Mem4 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1)
member this.Mem5 (arg_0_0, arg_0_1) ((arg_1_0, arg_1_1)) =
this.Mem5 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1)
member this.Mem6 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1) =
this.Mem6 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1)

View File

@@ -3,6 +3,7 @@
// Changes to this file will be lost when the code is regenerated.
//------------------------------------------------------------------------------
namespace PureGym
/// Module containing JSON parsing methods for the GymOpeningHours type
@@ -253,9 +254,41 @@ module Gym =
.AsValue()
.GetValue<string> ()
let Location = GymLocation.jsonParse node.["location"]
let AccessOptions = GymAccessOptions.jsonParse node.["accessOptions"]
let GymOpeningHours = GymOpeningHours.jsonParse node.["gymOpeningHours"]
let Location =
GymLocation.jsonParse (
match node.["location"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("location")
)
)
| v -> v
)
let AccessOptions =
GymAccessOptions.jsonParse (
match node.["accessOptions"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("accessOptions")
)
)
| v -> v
)
let GymOpeningHours =
GymOpeningHours.jsonParse (
match node.["gymOpeningHours"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("gymOpeningHours")
)
)
| v -> v
)
let EmailAddress =
(match node.["emailAddress"] with
@@ -281,7 +314,17 @@ module Gym =
.AsValue()
.GetValue<string> ()
let Address = GymAddress.jsonParse node.["address"]
let Address =
GymAddress.jsonParse (
match node.["address"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("address")
)
)
| v -> v
)
let Status =
(match node.["status"] with
@@ -856,7 +899,17 @@ namespace PureGym
module Visit =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : Visit =
let Gym = VisitGym.jsonParse node.["Gym"]
let Gym =
VisitGym.jsonParse (
match node.["Gym"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("Gym")
)
)
| v -> v
)
let Duration =
(match node.["Duration"] with
@@ -909,8 +962,29 @@ namespace PureGym
module SessionsSummary =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : SessionsSummary =
let ThisWeek = SessionsAggregate.jsonParse node.["ThisWeek"]
let Total = SessionsAggregate.jsonParse node.["Total"]
let ThisWeek =
SessionsAggregate.jsonParse (
match node.["ThisWeek"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("ThisWeek")
)
)
| v -> v
)
let Total =
SessionsAggregate.jsonParse (
match node.["Total"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("Total")
)
)
| v -> v
)
{
Total = Total
@@ -937,9 +1011,43 @@ module Sessions =
|> Seq.map (fun elt -> Visit.jsonParse elt)
|> List.ofSeq
let Summary = SessionsSummary.jsonParse node.["Summary"]
let Summary =
SessionsSummary.jsonParse (
match node.["Summary"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("Summary")
)
)
| v -> v
)
{
Summary = Summary
Visits = Visits
}
namespace PureGym
/// Module containing JSON parsing methods for the UriThing type
[<RequireQualifiedAccess>]
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module UriThing =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : UriThing =
let SomeUri =
(match node.["someUri"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("someUri")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
|> System.Uri
{
SomeUri = SomeUri
}

View File

@@ -4,6 +4,7 @@
//------------------------------------------------------------------------------
namespace PureGym
open System
@@ -26,7 +27,12 @@ module PureGymApi =
let! ct = Async.CancellationToken
let uri =
System.Uri (client.BaseAddress, System.Uri ("v1/gyms/", System.UriKind.Relative))
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri ("v1/gyms/", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
@@ -52,7 +58,9 @@ module PureGymApi =
let uri =
System.Uri (
client.BaseAddress,
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri (
"v1/gyms/{gym_id}/attendance"
.Replace ("{gym_id}", gymId.ToString () |> System.Web.HttpUtility.UrlEncode),
@@ -83,7 +91,12 @@ module PureGymApi =
let! ct = Async.CancellationToken
let uri =
System.Uri (client.BaseAddress, System.Uri ("v1/member", System.UriKind.Relative))
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri ("v1/member", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
@@ -109,7 +122,9 @@ module PureGymApi =
let uri =
System.Uri (
client.BaseAddress,
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri (
"v1/gyms/{gym_id}"
.Replace ("{gym_id}", gymId.ToString () |> System.Web.HttpUtility.UrlEncode),
@@ -140,7 +155,12 @@ module PureGymApi =
let! ct = Async.CancellationToken
let uri =
System.Uri (client.BaseAddress, System.Uri ("v1/member/activity", System.UriKind.Relative))
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri ("v1/member/activity", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
@@ -160,13 +180,45 @@ module PureGymApi =
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.GetUrl (ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri ("some/url", 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! stream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
let! node =
System.Text.Json.Nodes.JsonNode.ParseAsync (stream, cancellationToken = ct)
|> Async.AwaitTask
return UriThing.jsonParse node
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.GetSessions (fromDate : DateOnly, toDate : DateOnly, ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
client.BaseAddress,
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri (
("/v2/gymSessions/member"
+ "?fromDate="
@@ -195,13 +247,176 @@ module PureGymApi =
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.CreateUserString (user : string, ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri ("users/new", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Post,
RequestUri = uri
)
let queryParams = new System.Net.Http.StringContent (user)
do httpMessage.Content <- queryParams
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! node = response.Content.ReadAsStringAsync ct |> Async.AwaitTask
return node
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.CreateUserStream (user : System.IO.Stream, ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri ("users/new", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Post,
RequestUri = uri
)
let queryParams = new System.Net.Http.StreamContent (user)
do httpMessage.Content <- queryParams
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! node = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
return node
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.CreateUserByteArr (user : byte[], ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri ("users/new", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Post,
RequestUri = uri
)
let queryParams = new System.Net.Http.ByteArrayContent (user)
do httpMessage.Content <- queryParams
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! node = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
return node
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.CreateUserByteArr' (user : array<byte>, ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri ("users/new", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Post,
RequestUri = uri
)
let queryParams = new System.Net.Http.ByteArrayContent (user)
do httpMessage.Content <- queryParams
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! node = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
return node
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.CreateUserByteArr'' (user : byte array, ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri ("users/new", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Post,
RequestUri = uri
)
let queryParams = new System.Net.Http.ByteArrayContent (user)
do httpMessage.Content <- queryParams
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! node = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
return node
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.CreateUserHttpContent (user : System.Net.Http.HttpContent, ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri ("users/new", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Post,
RequestUri = uri
)
do httpMessage.Content <- user
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! node = response.Content.ReadAsStringAsync ct |> Async.AwaitTask
return node
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.GetPathParam (parameter : string, ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
client.BaseAddress,
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri (
"endpoint/{param}"
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
@@ -227,7 +442,12 @@ module PureGymApi =
let! ct = Async.CancellationToken
let uri =
System.Uri (client.BaseAddress, System.Uri ("endpoint", System.UriKind.Relative))
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri ("endpoint", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
@@ -247,7 +467,12 @@ module PureGymApi =
let! ct = Async.CancellationToken
let uri =
System.Uri (client.BaseAddress, System.Uri ("endpoint", System.UriKind.Relative))
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri ("endpoint", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
@@ -267,7 +492,12 @@ module PureGymApi =
let! ct = Async.CancellationToken
let uri =
System.Uri (client.BaseAddress, System.Uri ("endpoint", System.UriKind.Relative))
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri ("endpoint", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
@@ -287,7 +517,12 @@ module PureGymApi =
let! ct = Async.CancellationToken
let uri =
System.Uri (client.BaseAddress, System.Uri ("endpoint", System.UriKind.Relative))
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri ("endpoint", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
@@ -307,7 +542,12 @@ module PureGymApi =
let! ct = Async.CancellationToken
let uri =
System.Uri (client.BaseAddress, System.Uri ("endpoint", System.UriKind.Relative))
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri ("endpoint", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
@@ -327,7 +567,12 @@ module PureGymApi =
let! ct = Async.CancellationToken
let uri =
System.Uri (client.BaseAddress, System.Uri ("endpoint", System.UriKind.Relative))
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri ("endpoint", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
@@ -347,7 +592,12 @@ module PureGymApi =
let! ct = Async.CancellationToken
let uri =
System.Uri (client.BaseAddress, System.Uri ("endpoint", System.UriKind.Relative))
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri ("endpoint", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
@@ -367,7 +617,12 @@ module PureGymApi =
let! ct = Async.CancellationToken
let uri =
System.Uri (client.BaseAddress, System.Uri ("endpoint", System.UriKind.Relative))
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri ("endpoint", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
@@ -386,7 +641,12 @@ module PureGymApi =
let! ct = Async.CancellationToken
let uri =
System.Uri (client.BaseAddress, System.Uri ("endpoint", System.UriKind.Relative))
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri ("endpoint", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
@@ -401,3 +661,153 @@ module PureGymApi =
}
|> (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 internal ApiWithoutBaseAddress =
/// Create a REST client.
let make (client : System.Net.Http.HttpClient) : IApiWithoutBaseAddress =
{ new IApiWithoutBaseAddress with
member _.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
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! node = response.Content.ReadAsStringAsync ct |> Async.AwaitTask
return node
}
|> (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 ApiWithBasePath =
/// Create a REST client.
let make (client : System.Net.Http.HttpClient) : IApiWithBasePath =
{ new IApiWithBasePath with
member _.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
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! node = response.Content.ReadAsStringAsync ct |> Async.AwaitTask
return node
}
|> (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 ApiWithBasePathAndAddress =
/// Create a REST client.
let make (client : System.Net.Http.HttpClient) : IApiWithBasePathAndAddress =
{ new IApiWithBasePathAndAddress with
member _.GetPathParam (parameter : string, ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| 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
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! node = response.Content.ReadAsStringAsync ct |> Async.AwaitTask
return node
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
}

View File

@@ -0,0 +1,549 @@
//------------------------------------------------------------------------------
// This code was generated by myriad.
// Changes to this file will be lost when the code is regenerated.
//------------------------------------------------------------------------------
namespace ConsumePlugin
/// Module containing JSON parsing methods for the JwtVaultAuthResponse type
[<RequireQualifiedAccess>]
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module JwtVaultAuthResponse =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultAuthResponse =
let NumUses =
(match node.["num_uses"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("num_uses")
)
)
| v -> v)
.AsValue()
.GetValue<int> ()
let Orphan =
(match node.["orphan"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("orphan")
)
)
| v -> v)
.AsValue()
.GetValue<bool> ()
let EntityId =
(match node.["entity_id"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("entity_id")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
let TokenType =
(match node.["token_type"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("token_type")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
let Renewable =
(match node.["renewable"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("renewable")
)
)
| v -> v)
.AsValue()
.GetValue<bool> ()
let LeaseDuration =
(match node.["lease_duration"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_duration")
)
)
| v -> v)
.AsValue()
.GetValue<int> ()
let IdentityPolicies =
(match node.["identity_policies"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("identity_policies")
)
)
| v -> v)
.AsArray ()
|> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
|> List.ofSeq
let TokenPolicies =
(match node.["token_policies"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("token_policies")
)
)
| v -> v)
.AsArray ()
|> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
|> List.ofSeq
let Policies =
(match node.["policies"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("policies")
)
)
| v -> v)
.AsArray ()
|> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
|> List.ofSeq
let Accessor =
(match node.["accessor"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("accessor")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
let ClientToken =
(match node.["client_token"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("client_token")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
{
ClientToken = ClientToken
Accessor = Accessor
Policies = Policies
TokenPolicies = TokenPolicies
IdentityPolicies = IdentityPolicies
LeaseDuration = LeaseDuration
Renewable = Renewable
TokenType = TokenType
EntityId = EntityId
Orphan = Orphan
NumUses = NumUses
}
namespace ConsumePlugin
/// Module containing JSON parsing methods for the JwtVaultResponse type
[<RequireQualifiedAccess>]
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module JwtVaultResponse =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultResponse =
let Auth =
JwtVaultAuthResponse.jsonParse (
match node.["auth"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("auth")
)
)
| v -> v
)
let LeaseDuration =
(match node.["lease_duration"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_duration")
)
)
| v -> v)
.AsValue()
.GetValue<int> ()
let Renewable =
(match node.["renewable"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("renewable")
)
)
| v -> v)
.AsValue()
.GetValue<bool> ()
let LeaseId =
(match node.["lease_id"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_id")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
let RequestId =
(match node.["request_id"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("request_id")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
{
RequestId = RequestId
LeaseId = LeaseId
Renewable = Renewable
LeaseDuration = LeaseDuration
Auth = Auth
}
namespace ConsumePlugin
/// Module containing JSON parsing methods for the JwtSecretResponse type
[<RequireQualifiedAccess>]
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module JwtSecretResponse =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtSecretResponse =
let Data8 =
(match node.["data8"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data8")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<string> () |> System.Uri
key, value
)
|> Seq.map System.Collections.Generic.KeyValuePair
|> System.Collections.Generic.Dictionary
let Data7 =
(match node.["data7"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data7")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<int> ()
key, value
)
|> Map.ofSeq
let Data6 =
(match node.["data6"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data6")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key) |> System.Uri
let value = (kvp.Value).AsValue().GetValue<string> ()
key, value
)
|> dict
let Data5 =
(match node.["data5"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data5")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key) |> System.Uri
let value = (kvp.Value).AsValue().GetValue<string> ()
key, value
)
|> readOnlyDict
let Data4 =
(match node.["data4"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data4")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<string> ()
key, value
)
|> Map.ofSeq
let Data3 =
(match node.["data3"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data3")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<string> ()
key, value
)
|> Seq.map System.Collections.Generic.KeyValuePair
|> System.Collections.Generic.Dictionary
let Data2 =
(match node.["data2"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data2")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<string> ()
key, value
)
|> dict
let Data =
(match node.["data"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<string> ()
key, value
)
|> readOnlyDict
let LeaseDuration =
(match node.["lease_duration"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_duration")
)
)
| v -> v)
.AsValue()
.GetValue<int> ()
let Renewable =
(match node.["renewable"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("renewable")
)
)
| v -> v)
.AsValue()
.GetValue<bool> ()
let LeaseId =
(match node.["lease_id"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_id")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
let RequestId =
(match node.["request_id"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("request_id")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
{
RequestId = RequestId
LeaseId = LeaseId
Renewable = Renewable
LeaseDuration = LeaseDuration
Data = Data
Data2 = Data2
Data3 = Data3
Data4 = Data4
Data5 = Data5
Data6 = Data6
Data7 = Data7
Data8 = Data8
}
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 VaultClient =
/// Create a REST client.
let make (client : System.Net.Http.HttpClient) : IVaultClient =
{ new IVaultClient 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! stream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
let! node =
System.Text.Json.Nodes.JsonNode.ParseAsync (stream, cancellationToken = ct)
|> Async.AwaitTask
return JwtSecretResponse.jsonParse node
}
|> (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! stream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
let! node =
System.Text.Json.Nodes.JsonNode.ParseAsync (stream, cancellationToken = ct)
|> Async.AwaitTask
return JwtVaultResponse.jsonParse node
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
}

View File

@@ -28,3 +28,16 @@ type JsonRecordType =
E : string array
F : int[]
}
[<WoofWare.Myriad.Plugins.JsonParse true>]
type ToGetExtensionMethod =
{
Tinker : string
Tailor : int
Soldier : System.Uri
Sailor : float
}
[<RequireQualifiedAccess>]
module ToGetExtensionMethod =
let thisModuleWouldClash = 3

View File

@@ -0,0 +1,32 @@
namespace SomeNamespace
open WoofWare.Myriad.Plugins
[<GenerateMock>]
type IPublicType =
abstract Mem1 : string * int -> string list
abstract Mem2 : string -> int
abstract Mem3 : x : int * ?ct : System.Threading.CancellationToken -> string
[<GenerateMock>]
type internal InternalType =
abstract Mem1 : string * int -> unit
abstract Mem2 : string -> int
[<GenerateMock>]
type private PrivateType =
abstract Mem1 : string * int -> unit
abstract Mem2 : string -> int
[<GenerateMock>]
type VeryPublicType<'a, 'b> =
abstract Mem1 : 'a -> 'b
[<GenerateMock>]
type Curried<'a> =
abstract Mem1 : int -> 'a -> string
abstract Mem2 : int * string -> 'a -> string
abstract Mem3 : (int * string) -> 'a -> string
abstract Mem4 : (int * string) -> ('a * int) -> string
abstract Mem5 : x : int * string -> ('a * int) -> string
abstract Mem6 : int * string -> y : 'a * int -> string

View File

@@ -177,3 +177,9 @@ type Sessions =
[<JsonPropertyName "Visits">]
Visits : Visit list
}
[<WoofWare.Myriad.Plugins.JsonParse>]
type UriThing =
{
SomeUri : Uri
}

View File

@@ -9,6 +9,7 @@ open System.Net.Http
open RestEase
[<WoofWare.Myriad.Plugins.HttpClient>]
[<BaseAddress "https://whatnot.com">]
type IPureGymApi =
[<Get "v1/gyms/">]
abstract GetGyms : ?ct : CancellationToken -> Task<Gym list>
@@ -25,11 +26,34 @@ type IPureGymApi =
[<GetAttribute "v1/member/activity">]
abstract GetMemberActivity : ?ct : CancellationToken -> Task<MemberActivityDto>
[<Get "some/url">]
abstract GetUrl : ?ct : CancellationToken -> Task<UriThing>
// We'll use this one to check handling of absolute URIs too
[<Get "/v2/gymSessions/member">]
abstract GetSessions :
[<Query>] fromDate : DateOnly * [<Query>] toDate : DateOnly * ?ct : CancellationToken -> Task<Sessions>
// An example from RestEase's own docs
[<Post "users/new">]
abstract CreateUserString : [<Body>] user : string * ?ct : CancellationToken -> Task<string>
[<Post "users/new">]
abstract CreateUserStream : [<Body>] user : System.IO.Stream * ?ct : CancellationToken -> Task<Stream>
[<Post "users/new">]
abstract CreateUserByteArr : [<Body>] user : byte[] * ?ct : CancellationToken -> Task<Stream>
[<Post "users/new">]
abstract CreateUserByteArr' : [<Body>] user : array<byte> * ?ct : CancellationToken -> Task<Stream>
[<Post "users/new">]
abstract CreateUserByteArr'' : [<Body>] user : byte array * ?ct : CancellationToken -> Task<Stream>
[<Post "users/new">]
abstract CreateUserHttpContent :
[<Body>] user : System.Net.Http.HttpContent * ?ct : CancellationToken -> Task<string>
[<Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
@@ -72,3 +96,23 @@ type IPureGymApi =
[<Get "endpoint">]
abstract GetWithoutAnyReturnCode : ?ct : CancellationToken -> Task<HttpResponseMessage>
[<WoofWare.Myriad.Plugins.HttpClient>]
type internal IApiWithoutBaseAddress =
[<Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
// TODO: implement BasePath support
[<WoofWare.Myriad.Plugins.HttpClient>]
[<BasePath "foo">]
type IApiWithBasePath =
[<Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>]
[<BaseAddress "https://whatnot.com">]
[<BasePath "foo">]
type IApiWithBasePathAndAddress =
[<Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>

78
ConsumePlugin/Vault.fs Normal file
View File

@@ -0,0 +1,78 @@
namespace ConsumePlugin
open System
open System.Collections.Generic
open System.Text.Json.Serialization
open System.Threading
open System.Threading.Tasks
open RestEase
[<WoofWare.Myriad.Plugins.JsonParse>]
type JwtVaultAuthResponse =
{
[<JsonPropertyName "client_token">]
ClientToken : string
Accessor : string
Policies : string list
[<JsonPropertyName "token_policies">]
TokenPolicies : string list
[<JsonPropertyName "identity_policies">]
IdentityPolicies : string list
[<JsonPropertyName "lease_duration">]
LeaseDuration : int
Renewable : bool
[<JsonPropertyName "token_type">]
TokenType : string
[<JsonPropertyName "entity_id">]
EntityId : string
Orphan : bool
[<JsonPropertyName "num_uses">]
NumUses : int
}
[<WoofWare.Myriad.Plugins.JsonParse>]
type JwtVaultResponse =
{
[<JsonPropertyName "request_id">]
RequestId : string
[<JsonPropertyName "lease_id">]
LeaseId : string
Renewable : bool
[<JsonPropertyName "lease_duration">]
LeaseDuration : int
Auth : JwtVaultAuthResponse
}
[<WoofWare.Myriad.Plugins.JsonParse>]
type JwtSecretResponse =
{
[<JsonPropertyName "request_id">]
RequestId : string
[<JsonPropertyName "lease_id">]
LeaseId : string
Renewable : bool
[<JsonPropertyName "lease_duration">]
LeaseDuration : int
Data : IReadOnlyDictionary<string, string>
// These ones aren't actually part of the Vault response, but are here for tests
Data2 : IDictionary<string, string>
Data3 : Dictionary<string, string>
Data4 : Map<string, string>
Data5 : IReadOnlyDictionary<System.Uri, string>
Data6 : IDictionary<Uri, string>
Data7 : Map<string, int>
Data8 : Dictionary<string, Uri>
}
[<WoofWare.Myriad.Plugins.HttpClient>]
type IVaultClient =
[<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>

View File

@@ -6,12 +6,12 @@
<DisableImplicitLibraryPacksFolder>true</DisableImplicitLibraryPacksFolder>
<DisableImplicitNuGetFallbackFolder>true</DisableImplicitNuGetFallbackFolder>
<TreatWarningsAsErrors>true</TreatWarningsAsErrors>
<WarnOn>FS3559</WarnOn>
<DebugType>embedded</DebugType>
<WarnOn>FS3388,FS3559</WarnOn>
</PropertyGroup>
<ItemGroup>
<PackageReference Include="Nerdbank.GitVersioning" Version="3.6.128" PrivateAssets="all"/>
<PackageReference Include="Microsoft.SourceLink.GitHub" Version="1.1.1" PrivateAssets="All"/>
<PackageReference Include="Nerdbank.GitVersioning" Version="3.6.133" PrivateAssets="all"/>
<PackageReference Include="Microsoft.SourceLink.GitHub" Version="8.0.0" PrivateAssets="All"/>
<SourceLinkGitHubHost Include="github.com" ContentUrl="https://raw.githubusercontent.com"/>
</ItemGroup>
<!--

View File

@@ -1,38 +0,0 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net8.0</TargetFramework>
<IsPackable>false</IsPackable>
<IsTestProject>true</IsTestProject>
</PropertyGroup>
<ItemGroup>
<Compile Include="HttpClient.fs"/>
<Compile Include="TestPathParam.fs" />
<Compile Include="TestReturnTypes.fs" />
<Compile Include="TestAllowAnyStatusCode.fs" />
<Compile Include="TestSurface.fs"/>
<Compile Include="TestRemoveOptions.fs"/>
<Compile Include="TestJsonParse.fs"/>
<Compile Include="PureGymDtos.fs"/>
<Compile Include="TestPureGymJson.fs"/>
<Compile Include="TestPureGymRestApi.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="ApiSurface" Version="4.0.25"/>
<PackageReference Include="FsCheck" Version="2.16.6"/>
<PackageReference Include="FsUnit" Version="5.6.1"/>
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.5.0"/>
<PackageReference Include="NUnit" Version="3.14.0"/>
<PackageReference Include="NUnit3TestAdapter" Version="4.4.2"/>
<PackageReference Include="NUnit.Analyzers" Version="3.6.1"/>
<PackageReference Include="coverlet.collector" Version="3.2.0"/>
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\WoofWare.Myriad.Plugins\WoofWare.Myriad.Plugins.fsproj"/>
<ProjectReference Include="..\ConsumePlugin\ConsumePlugin.fsproj"/>
</ItemGroup>
</Project>

View File

@@ -16,6 +16,7 @@ Currently implemented:
* `JsonParse` (to stamp out `jsonParse : JsonNode -> 'T` methods);
* `RemoveOptions` (to strip `option` modifiers from a type).
* `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).
## `JsonParse`
@@ -204,20 +205,65 @@ The motivating example is again ahead-of-time compilation: we wish to avoid the
RestEase is complex, and handles a lot of different stuff.
* As of this writing, `[<Body>]` is explicitly unsupported (it throws with a TODO).
* 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"`).
We combine URIs using `UriKind.Relative`, so without a trailing slash, the last component may be chopped off.
* Parameters are serialised solely with `ToString`, and there's no control over this;
nor is there control over encoding in any sense.
* Deserialisation follows the same logic as the `JsonParse` generator,
and it generally assumes you're using types which `JsonParse` is applied to.
* Headers are not yet supported.
* You have to specify the `BaseAddress` on the input client yourself, and you can't have the same client talking to a
different `BaseAddress` this way unless you manually set it before making any different request.
* I haven't yet worked out how to integrate this with a mocked HTTP client; you can always mock up an `HttpClient`,
but I prefer to use a mock which defines a single member `SendAsync`.
* Anonymous parameters are currently forbidden.
There are also some design decisions:
* Every function must take an optional `CancellationToken` (which is good practice anyway);
so arguments are forced to be tupled.
This is a won't-fix for as long as F# requires tupled arguments if any of the args are optional.
## `GenerateMock`
Takes a type like this:
```fsharp
[<GenerateMock>]
type IPublicType =
abstract Mem1 : string * int -> string list
abstract Mem2 : string -> int
```
and stamps out a type like this:
```fsharp
/// Mock record type for an interface
type internal PublicTypeMock =
{
Mem1 : string * int -> string list
Mem2 : string -> int
}
static member Empty : PublicTypeMock =
{
Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
}
interface IPublicType with
member this.Mem1 (arg0, arg1) = this.Mem1 (arg0, arg1)
member this.Mem2 (arg0) = this.Mem2 (arg0)
```
### What's the point?
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,
thereby allowing the programmer to use F#'s record-update syntax.
### Limitations
* We currently only support interfaces with tupled arguments.
* We make the resulting record type at most internal (never public), since this is intended only to be used in tests.
You will therefore need an `AssemblyInfo.fs` file [like the one in WoofWare.Myriad's own tests](./ConsumePlugin/AssemblyInfo.fs).
# Detailed examples

View File

@@ -1,4 +1,4 @@
namespace MyriadPlugin.Test
namespace WoofWare.Myriad.Plugins.Test
open System.Net.Http
@@ -11,7 +11,11 @@ type HttpClientMock (result : HttpRequestMessage -> Async<HttpResponseMessage>)
[<RequireQualifiedAccess>]
module HttpClientMock =
let make (baseUrl : System.Uri) (handler : HttpRequestMessage -> Async<HttpResponseMessage>) =
let makeNoUri (handler : HttpRequestMessage -> Async<HttpResponseMessage>) =
let result = new HttpClientMock (handler)
result
let make (baseUrl : System.Uri) (handler : HttpRequestMessage -> Async<HttpResponseMessage>) =
let result = makeNoUri handler
result.BaseAddress <- baseUrl
result

View File

@@ -1,4 +1,4 @@
namespace MyriadPlugin.Test
namespace WoofWare.Myriad.Plugins.Test
open PureGym
open System

View File

@@ -1,4 +1,4 @@
namespace MyriadPlugin.Test
namespace WoofWare.Myriad.Plugins.Test
open System
open System.Net

View File

@@ -0,0 +1,80 @@
namespace WoofWare.Myriad.Plugins.Test
open System
open System.Net
open System.Net.Http
open NUnit.Framework
open PureGym
open FsUnitTyped
[<TestFixture>]
module TestBasePath =
[<Test>]
let ``Base address is respected`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
let content = new StringContent (message.RequestUri.ToString ())
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.makeNoUri proc
let api = PureGymApi.make client
let observedUri = api.GetPathParam("param").Result
observedUri |> shouldEqual "https://whatnot.com/endpoint/param"
[<Test>]
let ``Without a base address attr but with BaseAddress on client, request goes through`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
let content = new StringContent (message.RequestUri.ToString ())
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make (System.Uri "https://baseaddress.com") proc
let api = ApiWithoutBaseAddress.make client
let observedUri = api.GetPathParam("param").Result
observedUri |> shouldEqual "https://baseaddress.com/endpoint/param"
[<Test>]
let ``Without a base address attr or BaseAddress on client, request throws`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
let content = new StringContent (message.RequestUri.ToString ())
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.makeNoUri proc
let api = ApiWithoutBaseAddress.make client
let observedExc =
async {
let! result = api.GetPathParam ("param") |> Async.AwaitTask |> Async.Catch
match result with
| Choice1Of2 _ -> return failwith "test failure"
| Choice2Of2 exc -> return exc
}
|> Async.RunSynchronously
let observedExc =
match observedExc with
| :? AggregateException as exc ->
match exc.InnerException with
| :? ArgumentNullException as exc -> exc
| _ -> failwith "test failure"
| _ -> failwith "test failure"
observedExc.Message
|> shouldEqual
"No base address was supplied on the type, and no BaseAddress was on the HttpClient. (Parameter 'BaseAddress')"

View File

@@ -0,0 +1,105 @@
namespace WoofWare.Myriad.Plugins.Test
open System
open System.IO
open System.Net
open System.Net.Http
open System.Text.Json.Nodes
open NUnit.Framework
open PureGym
open FsUnitTyped
[<TestFixture>]
module TestBodyParam =
[<Test>]
let ``Body param of string`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Post
let! content = message.Content.ReadAsStringAsync () |> Async.AwaitTask
let content = new StringContent (content)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make (Uri "https://example.com") proc
let api = PureGymApi.make client
let observedUri = api.CreateUserString("username?not!url%encoded").Result
observedUri |> shouldEqual "username?not!url%encoded"
[<Test>]
let ``Body param of stream`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Post
let! content = message.Content.ReadAsStreamAsync () |> Async.AwaitTask
let content = new StreamContent (content)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
let contents = [| 1uy ; 2uy ; 3uy ; 4uy |]
use client = HttpClientMock.make (Uri "https://example.com") proc
let api = PureGymApi.make client
use stream = new MemoryStream (contents)
let observedContent = api.CreateUserStream(stream).Result
let buf = Array.zeroCreate 10
let written = observedContent.ReadAtLeast (buf.AsSpan (), 5, false)
buf |> Array.take written |> shouldEqual contents
[<Test>]
let ``Body param of HttpContent`` () =
let mutable observedContent = None
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Post
let resp = new HttpResponseMessage (HttpStatusCode.OK)
observedContent <- Some message.Content
resp.Content <- new StringContent ("oh hi")
return resp
}
use client = HttpClientMock.make (Uri "https://example.com") proc
let api = PureGymApi.make client
use content = new StringContent ("hello!")
api.CreateUserHttpContent(content).Result |> shouldEqual "oh hi"
Object.ReferenceEquals (Option.get observedContent, content) |> shouldEqual true
[<TestCase "ByteArr">]
[<TestCase "ByteArr'">]
[<TestCase "ByteArr''">]
let ``Body param of byte arr`` (case : string) =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Post
let! content = message.Content.ReadAsStreamAsync () |> Async.AwaitTask
let content = new StreamContent (content)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make (Uri "https://example.com") proc
let api = PureGymApi.make client
let contents = [| 1uy ; 2uy ; 3uy ; 4uy |]
let observedContent =
match case with
| "ByteArr" -> api.CreateUserByteArr(contents).Result
| "ByteArr'" -> api.CreateUserByteArr'(contents).Result
| "ByteArr''" -> api.CreateUserByteArr''(contents).Result
| _ -> failwith $"Unrecognised case: %s{case}"
let buf = Array.zeroCreate 10
let written = observedContent.ReadAtLeast (buf.AsSpan (), 5, false)
buf |> Array.take written |> shouldEqual contents

View File

@@ -1,4 +1,4 @@
namespace MyriadPlugin.Test
namespace WoofWare.Myriad.Plugins.Test
open System
open System.Net

View File

@@ -1,4 +1,4 @@
namespace MyriadPlugin.Test
namespace WoofWare.Myriad.Plugins.Test
open System
open System.Net
@@ -236,3 +236,27 @@ module TestPureGymRestApi =
let api = PureGymApi.make client
api.GetSessions(startDate, endDate).Result |> shouldEqual expected
[<Test>]
let ``URI example`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
message.RequestUri.ToString () |> shouldEqual "https://whatnot.com/some/url"
let content =
new StringContent ("""{"someUri": "https://patrick@en.wikipedia.org/wiki/foo"}""")
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.makeNoUri proc
let api = PureGymApi.make client
let uri = api.GetUrl().Result.SomeUri
uri.ToString () |> shouldEqual "https://patrick@en.wikipedia.org/wiki/foo"
uri.UserInfo |> shouldEqual "patrick"
uri.Host |> shouldEqual "en.wikipedia.org"

View File

@@ -1,4 +1,4 @@
namespace MyriadPlugin.Test
namespace WoofWare.Myriad.Plugins.Test
open System
open System.IO
@@ -54,8 +54,8 @@ module TestReturnTypes =
| _ -> failwith $"unrecognised case: %s{case}"
let buf = Array.zeroCreate 10
stream.Read (buf, 0, 10) |> shouldEqual 4
Array.take 4 buf |> shouldEqual result
let written = stream.ReadAtLeast (buf.AsSpan (), 10, false)
Array.take written buf |> shouldEqual result
[<TestCase "GetResponseMessage">]
[<TestCase "GetResponseMessage'">]

View File

@@ -0,0 +1,170 @@
namespace WoofWare.Myriad.Plugins.Test
open System
open System.Net
open System.Net.Http
open NUnit.Framework
open FsUnitTyped
open ConsumePlugin
[<TestFixture>]
module TestVaultClient =
let exampleVaultKeyResponseString =
"""{
"request_id": "e2470000-0000-0000-0000-000000001f47",
"lease_id": "",
"renewable": false,
"lease_duration": 0,
"data": {
"key1_1": "value1_1",
"key1_2": "value1_2"
},
"data2": {
"key2_1": "value2_1",
"key2_2": "value2_2"
},
"data3": {
"key3_1": "value3_1",
"key3_2": "value3_2"
},
"data4": {
"key4_1": "value4_1",
"key4_2": "value4_2"
},
"data5": {
"https://example.com/data5/1": "value5_1",
"https://example.com/data5/2": "value5_2"
},
"data6": {
"https://example.com/data6/1": "value6_1",
"https://example.com/data6/2": "value6_2"
},
"data7": {
"key7_1": 71,
"key7_2": 72
},
"data8": {
"key8_1": "https://example.com/data8/1",
"key8_2": "https://example.com/data8/2"
}
}"""
let exampleVaultJwtResponseString =
"""{
"request_id": "80000000-0000-0000-0000-00000000000d",
"lease_id": "",
"renewable": false,
"lease_duration": 0,
"data": null,
"wrap_info": null,
"warnings": null,
"auth": {
"client_token": "redacted_client_token",
"accessor": "redacted_accessor",
"policies": [
"policy1",
"default"
],
"identity_policies": [
"identity-policy",
"default-2"
],
"token_policies": [
"token-policy",
"default-3"
],
"metadata": {
"role": "some-role"
},
"lease_duration": 43200,
"renewable": true,
"entity_id": "20000000-0000-0000-0000-000000000007",
"token_type": "service",
"orphan": true,
"mfa_requirement": null,
"num_uses": 0
}
}"""
[<Test>]
let ``URI example`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
let requestUri = message.RequestUri.ToString ()
match requestUri with
| "https://my-vault.com/v1/auth/jwt/login" ->
let content = new StringContent (exampleVaultJwtResponseString)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
| "https://my-vault.com/v1/mount/path" ->
let content = new StringContent (exampleVaultKeyResponseString)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
| _ -> return failwith $"bad URI: %s{requestUri}"
}
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
value.Data
|> Seq.toList
|> List.map (fun (KeyValue (k, v)) -> k, v)
|> shouldEqual [ "key1_1", "value1_1" ; "key1_2", "value1_2" ]
value.Data2
|> Seq.toList
|> List.map (fun (KeyValue (k, v)) -> k, v)
|> shouldEqual [ "key2_1", "value2_1" ; "key2_2", "value2_2" ]
value.Data3
|> Seq.toList
|> List.map (fun (KeyValue (k, v)) -> k, v)
|> shouldEqual [ "key3_1", "value3_1" ; "key3_2", "value3_2" ]
value.Data4
|> Seq.toList
|> List.map (fun (KeyValue (k, v)) -> k, v)
|> shouldEqual [ "key4_1", "value4_1" ; "key4_2", "value4_2" ]
value.Data5
|> Seq.toList
|> List.map (fun (KeyValue (k, v)) -> (k : Uri).ToString (), v)
|> shouldEqual
[
"https://example.com/data5/1", "value5_1"
"https://example.com/data5/2", "value5_2"
]
value.Data6
|> Seq.toList
|> List.map (fun (KeyValue (k, v)) -> (k : Uri).ToString (), v)
|> shouldEqual
[
"https://example.com/data6/1", "value6_1"
"https://example.com/data6/2", "value6_2"
]
value.Data7
|> Seq.toList
|> List.map (fun (KeyValue (k, v)) -> k, v)
|> shouldEqual [ "key7_1", 71 ; "key7_2", 72 ]
value.Data8
|> Seq.toList
|> List.map (fun (KeyValue (k, v)) -> k, (v : Uri).ToString ())
|> shouldEqual
[
"key8_1", "https://example.com/data8/1"
"key8_2", "https://example.com/data8/2"
]

View File

@@ -0,0 +1,26 @@
namespace WoofWare.Myriad.Plugins.Test
open System
open System.Text.Json.Nodes
open ConsumePlugin
open NUnit.Framework
open FsUnitTyped
[<TestFixture>]
module TestExtensionMethod =
[<Test>]
let ``Parse via extension method`` () =
let json =
"""{"tinker": "job", "tailor": 3, "soldier": "https://example.com", "sailor": 3.1}"""
|> JsonNode.Parse
let expected =
{
Tinker = "job"
Tailor = 3
Soldier = Uri "https://example.com"
Sailor = 3.1
}
ToGetExtensionMethod.jsonParse json |> shouldEqual expected

View File

@@ -1,4 +1,4 @@
namespace MyriadPlugin.Test
namespace WoofWare.Myriad.Plugins.Test
open System.Text.Json.Nodes
open ConsumePlugin
@@ -32,3 +32,18 @@ module TestJsonParse =
let actual = s |> JsonNode.Parse |> JsonRecordType.jsonParse
actual |> shouldEqual expected
[<Test>]
let ``Inner example`` () =
let s =
"""{
"something": "oh hi"
}"""
let expected =
{
Thing = "oh hi"
}
let actual = s |> JsonNode.Parse |> InnerType.jsonParse
actual |> shouldEqual expected

View File

@@ -1,4 +1,4 @@
namespace MyriadPlugin.Test
namespace WoofWare.Myriad.Plugins.Test
open System
open System.Text.Json.Nodes

View File

@@ -0,0 +1,36 @@
namespace WoofWare.Myriad.Plugins.Test
open System
open SomeNamespace
open NUnit.Framework
open FsUnitTyped
[<TestFixture>]
module TestMockGenerator =
[<Test>]
let ``Example of use: IPublicType`` () =
let mock : IPublicType =
{ PublicTypeMock.Empty with
Mem1 = fun (s, count) -> List.replicate count s
}
:> _
let _ =
Assert.Throws<NotImplementedException> (fun () -> mock.Mem2 "hi" |> ignore<int>)
mock.Mem1 ("hi", 3) |> shouldEqual [ "hi" ; "hi" ; "hi" ]
[<Test>]
let ``Example of use: curried args`` () =
let mock : Curried<_> =
{ CurriedMock.Empty () with
Mem1 = fun i c -> Array.replicate i c |> String
Mem2 = fun (i, s) c -> String.concat $"%c{c}" (List.replicate i s)
Mem3 = fun (i, s) c -> String.concat $"%c{c}" (List.replicate i s)
}
:> _
mock.Mem1 3 'a' |> shouldEqual "aaa"
mock.Mem2 (3, "hi") 'a' |> shouldEqual "hiahiahi"
mock.Mem3 (3, "hi") 'a' |> shouldEqual "hiahiahi"

View File

@@ -1,4 +1,4 @@
namespace MyriadPlugin.Test
namespace WoofWare.Myriad.Plugins.Test
open FsCheck
open ConsumePlugin

View File

@@ -1,4 +1,4 @@
namespace MyriadPlugin.Test
namespace WoofWare.Myriad.Plugins.Test
open NUnit.Framework
open WoofWare.Myriad.Plugins

View File

@@ -0,0 +1,43 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net8.0</TargetFramework>
<IsPackable>false</IsPackable>
<IsTestProject>true</IsTestProject>
</PropertyGroup>
<ItemGroup>
<Compile Include="HttpClient.fs"/>
<Compile Include="PureGymDtos.fs"/>
<Compile Include="TestJsonParse\TestJsonParse.fs" />
<Compile Include="TestJsonParse\TestPureGymJson.fs" />
<Compile Include="TestJsonParse\TestExtensionMethod.fs" />
<Compile Include="TestHttpClient\TestPureGymRestApi.fs" />
<Compile Include="TestHttpClient\TestPathParam.fs" />
<Compile Include="TestHttpClient\TestReturnTypes.fs" />
<Compile Include="TestHttpClient\TestAllowAnyStatusCode.fs" />
<Compile Include="TestHttpClient\TestBasePath.fs" />
<Compile Include="TestHttpClient\TestBodyParam.fs" />
<Compile Include="TestHttpClient\TestVaultClient.fs" />
<Compile Include="TestMockGenerator\TestMockGenerator.fs" />
<Compile Include="TestRemoveOptions.fs"/>
<Compile Include="TestSurface.fs"/>
</ItemGroup>
<ItemGroup>
<PackageReference Include="ApiSurface" Version="4.0.25"/>
<PackageReference Include="FsCheck" Version="2.16.6"/>
<PackageReference Include="FsUnit" Version="6.0.0"/>
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.8.0"/>
<PackageReference Include="NUnit" Version="4.0.1"/>
<PackageReference Include="NUnit3TestAdapter" Version="4.5.0"/>
<PackageReference Include="NUnit.Analyzers" Version="3.10.0"/>
<PackageReference Include="coverlet.collector" Version="6.0.0"/>
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\WoofWare.Myriad.Plugins\WoofWare.Myriad.Plugins.fsproj"/>
<ProjectReference Include="..\ConsumePlugin\ConsumePlugin.fsproj"/>
</ItemGroup>
</Project>

View File

@@ -6,26 +6,73 @@ open Fantomas.FCS.Text.Range
open Fantomas.FCS.Xml
open Myriad.Core.AstExtensions
type internal ParameterInfo =
{
Attributes : SynAttribute list
IsOptional : bool
Id : Ident option
Type : SynType
}
type internal TupledArg =
{
HasParen : bool
Args : ParameterInfo list
}
type internal MemberInfo =
{
ReturnType : SynType
Accessibility : SynAccess option
/// Each element of this list is a list of args in a tuple, or just one arg if not a tuple.
Args : TupledArg list
Identifier : Ident
Attributes : SynAttribute list
XmlDoc : PreXmlDoc option
IsInline : bool
IsMutable : bool
}
type internal InterfaceType =
{
Attributes : SynAttribute list
Name : LongIdent
Members : MemberInfo list
Generics : SynTyparDecls option
Accessibility : SynAccess option
}
type internal RecordType =
{
Name : Ident
Fields : SynField seq
Members : SynMemberDefns option
XmlDoc : PreXmlDoc option
Generics : SynTyparDecls option
Accessibility : SynAccess option
}
[<RequireQualifiedAccess>]
module internal AstHelper =
let constructRecord (fields : (RecordFieldName * SynExpr option) list) : SynExpr =
let instantiateRecord (fields : (RecordFieldName * SynExpr option) list) : SynExpr =
let fields =
fields
|> List.map (fun (rfn, synExpr) -> SynExprRecordField (rfn, Some range0, synExpr, None))
SynExpr.Record (None, None, fields, range0)
let private createRecordType
(
name : Ident,
repr : SynTypeDefnRepr,
members : SynMemberDefns,
xmldoc : PreXmlDoc
)
: SynTypeDefn
=
let name = SynComponentInfo.Create ([ name ], xmldoc = xmldoc)
let defineRecordType (record : RecordType) : SynTypeDefn =
let repr =
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (None, Seq.toList record.Fields, range0), range0)
let name =
SynComponentInfo.Create (
[ record.Name ],
?xmldoc = record.XmlDoc,
?parameters = record.Generics,
access = record.Accessibility
)
let trivia : SynTypeDefnTrivia =
{
@@ -34,21 +81,7 @@ module internal AstHelper =
WithKeyword = Some range0
}
SynTypeDefn (name, repr, members, None, range0, trivia)
let defineRecordType
(
name : Ident,
fields : SynField seq,
members : SynMemberDefns option,
xmldoc : PreXmlDoc option
)
: SynTypeDefn
=
let repr =
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (None, Seq.toList fields, range0), range0)
createRecordType (name, repr, defaultArg members SynMemberDefns.Empty, defaultArg xmldoc PreXmlDoc.Empty)
SynTypeDefn (name, repr, defaultArg record.Members SynMemberDefns.Empty, None, range0, trivia)
let isOptionIdent (ident : SynLongIdent) : bool =
match ident.LongIdent with
@@ -69,12 +102,245 @@ module internal AstHelper =
|| System.String.Equals (i.idText, "[]", System.StringComparison.Ordinal)
->
true
// TODO: consider FSharpList or whatever it is
| [ i ] ->
printfn $"Not array: %s{i.idText}"
false
| _ -> false
let isMapIdent (ident : SynLongIdent) : bool =
match ident.LongIdent |> List.map _.idText with
| [ "Map" ] -> true
| _ -> false
let isReadOnlyDictionaryIdent (ident : SynLongIdent) : bool =
match ident.LongIdent |> List.map _.idText with
| [ "IReadOnlyDictionary" ]
| [ "Generic" ; "IReadOnlyDictionary" ]
| [ "Collections" ; "Generic" ; "IReadOnlyDictionary" ]
| [ "System" ; "Collections" ; "Generic" ; "IReadOnlyDictionary" ] -> true
| _ -> false
let isDictionaryIdent (ident : SynLongIdent) : bool =
match ident.LongIdent |> List.map _.idText with
| [ "Dictionary" ]
| [ "Generic" ; "Dictionary" ]
| [ "Collections" ; "Generic" ; "Dictionary" ]
| [ "System" ; "Collections" ; "Generic" ; "Dictionary" ] -> true
| _ -> false
let isIDictionaryIdent (ident : SynLongIdent) : bool =
match ident.LongIdent |> List.map _.idText with
| [ "IDictionary" ]
| [ "Generic" ; "IDictionary" ]
| [ "Collections" ; "Generic" ; "IDictionary" ]
| [ "System" ; "Collections" ; "Generic" ; "IDictionary" ] -> true
| _ -> false
let rec private extractOpensFromDecl (moduleDecls : SynModuleDecl list) : SynOpenDeclTarget list =
moduleDecls
|> List.choose (fun moduleDecl ->
match moduleDecl with
| SynModuleDecl.Open (target, _) -> Some target
| _ -> None
)
let extractOpens (ast : ParsedInput) : SynOpenDeclTarget list =
match ast with
| ParsedInput.ImplFile (ParsedImplFileInput (_, _, _, _, _, modules, _, _, _)) ->
modules
|> List.collect (fun (SynModuleOrNamespace (_, _, _, decls, _, _, _, _, _)) -> extractOpensFromDecl decls)
| _ -> []
let rec convertSigParam (ty : SynType) : ParameterInfo * bool =
match ty with
| SynType.Paren (inner, _) ->
let result, _ = convertSigParam inner
result, true
| SynType.LongIdent ident ->
{
Attributes = []
IsOptional = false
Id = None
Type = SynType.CreateLongIdent ident
},
false
| SynType.SignatureParameter (attrs, opt, id, usedType, _) ->
let attrs = attrs |> List.collect (fun attrs -> attrs.Attributes)
{
Attributes = attrs
IsOptional = opt
Id = id
Type = usedType
},
false
| SynType.Var (typar, _) ->
{
Attributes = []
IsOptional = false
Id = None
Type = SynType.Var (typar, range0)
},
false
| _ -> failwithf "expected SignatureParameter, got: %+A" ty
let rec extractTupledTypes (tupleType : SynTupleTypeSegment list) : TupledArg =
match tupleType with
| [] ->
{
HasParen = false
Args = []
}
| [ SynTupleTypeSegment.Type param ] ->
let converted, hasParen = convertSigParam param
{
HasParen = hasParen
Args = [ converted ]
}
| SynTupleTypeSegment.Type param :: SynTupleTypeSegment.Star _ :: rest ->
let rest = extractTupledTypes rest
let converted, _ = convertSigParam param
{
HasParen = false
Args = converted :: rest.Args
}
| _ -> failwithf "Didn't have alternating type-and-star in interface member definition: %+A" tupleType
let toFun (inputs : SynType list) (ret : SynType) : SynType =
(ret, List.rev inputs)
||> List.fold (fun ty input -> SynType.CreateFun (input, ty))
/// Returns the args (where these are tuple types if curried) in order, and the return type.
let rec getType (ty : SynType) : (SynType * bool) list * SynType =
match ty with
| SynType.Paren (ty, _) -> getType ty
| SynType.Fun (argType, returnType, _, _) ->
let args, ret = getType returnType
// TODO this code is clearly wrong
let (inputArgs, inputRet), hasParen =
match argType with
| SynType.Paren (argType, _) -> getType argType, true
| _ -> getType argType, false
((toFun (List.map fst inputArgs) inputRet), hasParen) :: args, ret
| _ -> [], ty
/// Assumes that the input type is an ObjectModel, i.e. a `type Foo = member ...`
let parseInterface (interfaceType : SynTypeDefn) : InterfaceType =
let (SynTypeDefn (SynComponentInfo (attrs, typars, _, interfaceName, _, _, accessibility, _),
synTypeDefnRepr,
_,
_,
_,
_)) =
interfaceType
let attrs = attrs |> List.collect (fun s -> s.Attributes)
let members =
match synTypeDefnRepr with
| SynTypeDefnRepr.ObjectModel (_kind, members, _) ->
members
|> List.map (fun defn ->
match defn with
| SynMemberDefn.AbstractSlot (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 SynTypeDefnRepr for an interface type: %+A{synTypeDefnRepr}"
{
Members = members
Name = interfaceName
Attributes = attrs
Generics = typars
Accessibility = accessibility
}
[<AutoOpen>]
module internal SynTypePatterns =
let (|OptionType|_|) (fieldType : SynType) =
@@ -103,6 +369,32 @@ module internal SynTypePatterns =
| SynType.Array (1, innerType, _) -> Some innerType
| _ -> None
let (|DictionaryType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when AstHelper.isDictionaryIdent ident ->
Some (key, value)
| _ -> None
let (|IDictionaryType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when AstHelper.isIDictionaryIdent ident ->
Some (key, value)
| _ -> None
let (|IReadOnlyDictionaryType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when
AstHelper.isReadOnlyDictionaryIdent ident
->
Some (key, value)
| _ -> None
let (|MapType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when AstHelper.isMapIdent ident ->
Some (key, value)
| _ -> None
/// Returns the string name of the type.
let (|PrimitiveType|_|) (fieldType : SynType) =
match fieldType with
@@ -123,6 +415,14 @@ module internal SynTypePatterns =
| _ -> None
| _ -> None
let (|Byte|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent with
| [ i ] -> [ "byte" ] |> List.tryFind (fun s -> s = i.idText) |> Option.map ignore<string>
| _ -> None
| _ -> None
let (|HttpResponseMessage|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident ->
@@ -134,6 +434,17 @@ module internal SynTypePatterns =
| _ -> None
| _ -> None
let (|HttpContent|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent |> List.map (fun i -> i.idText) with
| [ "System" ; "Net" ; "Http" ; "HttpContent" ]
| [ "Net" ; "Http" ; "HttpContent" ]
| [ "Http" ; "HttpContent" ]
| [ "HttpContent" ] -> Some ()
| _ -> None
| _ -> None
let (|Stream|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident ->
@@ -170,6 +481,15 @@ module internal SynTypePatterns =
| _ -> None
| _ -> None
let (|Uri|_|) (fieldType : SynType) =
match fieldType with
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
match ident |> List.map (fun i -> i.idText) with
| [ "System" ; "Uri" ]
| [ "Uri" ] -> Some ()
| _ -> None
| _ -> None
let (|Task|_|) (fieldType : SynType) : SynType option =
match fieldType with
| SynType.App (SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)), _, args, _, _, _, _) ->

View File

@@ -3,12 +3,13 @@ namespace WoofWare.Myriad.Plugins
open System
open System.Net.Http
open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Xml
open Myriad.Core
/// Attribute indicating a record type to which the "create HTTP client" Myriad
/// 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 () =
inherit Attribute ()
@@ -31,16 +32,21 @@ module internal HttpClientGenerator =
Type : SynType
}
let synBindingTriviaZero (isMember : bool) =
{
SynBindingTrivia.EqualsRange = Some range0
InlineKeyword = None
LeadingKeyword =
if isMember then
SynLeadingKeyword.Member range0
else
SynLeadingKeyword.Let range0
}
[<RequireQualifiedAccess>]
type BodyParamMethods =
| StringContent
| StreamContent
| ByteArrayContent
| HttpContent
| Serialise of SynType
override this.ToString () =
match this with
| BodyParamMethods.Serialise _ -> "ToString"
| BodyParamMethods.ByteArrayContent -> "ByteArrayContent"
| BodyParamMethods.StringContent -> "StringContent"
| BodyParamMethods.StreamContent -> "StreamContent"
| BodyParamMethods.HttpContent -> "HttpContent"
type MemberInfo =
{
@@ -48,11 +54,13 @@ module internal HttpClientGenerator =
HttpMethod : HttpMethod
/// E.g. "v1/gyms/{gym_id}/attendance"
UrlTemplate : string
ReturnType : SynType
Arity : SynArgInfo list
TaskReturnType : SynType
Args : Parameter list
Identifier : Ident
EnsureSuccessHttpCode : bool
BaseAddress : SynExpr option
BasePath : SynExpr option
Accessibility : SynAccess option
}
let httpMethodString (m : HttpMethod) : string =
@@ -112,10 +120,10 @@ module internal HttpClientGenerator =
match arg with
| SynExpr.Const (SynConst.String (text, SynStringKind.Regular, _), _) -> meth, text
| arg ->
failwithf "Unrecognised AST member in attribute argument. Only regular strings are supported: %+A" arg
failwith $"Unrecognised AST member in attribute argument. Only regular strings are supported: %+A{arg}"
| [] -> failwith "Required exactly one recognised RestEase attribute on member, but got none"
| matchingAttrs ->
failwithf "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}"
let shouldAllowAnyStatusCode (attrs : SynAttribute list) : bool =
attrs
@@ -254,18 +262,9 @@ module internal HttpClientGenerator =
| None -> failwith "Unable to get parameter variable name from anonymous parameter"
| Some id -> id
let toString (ident : SynExpr) (ty : SynType) =
match ty with
| DateOnly ->
ident
|> SynExpr.callMethodArg "ToString" (SynExpr.CreateConstString "yyyy-MM-dd")
| DateTime ->
ident
|> SynExpr.callMethodArg "ToString" (SynExpr.CreateConstString "yyyy-MM-ddTHH:mm:ss")
| _ -> SynExpr.callMethod "ToString" ident
let prefix =
toString (SynExpr.CreateIdent firstValueId) firstValue.Type
SynExpr.CreateIdent firstValueId
|> SynExpr.toString firstValue.Type
|> SynExpr.CreateParen
|> SynExpr.pipeThroughFunction (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ])
@@ -280,7 +279,7 @@ module internal HttpClientGenerator =
| None -> failwith "Unable to get parameter variable name from anonymous parameter"
| Some id -> id
toString (SynExpr.CreateIdent paramValueId) paramValue.Type
SynExpr.toString paramValue.Type (SynExpr.CreateIdent paramValueId)
|> SynExpr.CreateParen
|> SynExpr.pipeThroughFunction (
SynExpr.CreateLongIdent (
@@ -296,13 +295,55 @@ module internal HttpClientGenerator =
let requestUri =
let uriIdent = SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Uri" ])
let baseAddress =
SynExpr.CreateLongIdent (SynLongIdent.Create [ "client" ; "BaseAddress" ])
let baseAddress =
SynExpr.CreateMatch (
baseAddress,
[
SynMatchClause.Create (
SynPat.CreateNull,
None,
match info.BaseAddress with
| None ->
SynExpr.CreateApp (
SynExpr.CreateIdentString "raise",
SynExpr.CreateParen (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
SynLongIdent.Create [ "System" ; "ArgumentNullException" ]
),
SynExpr.CreateParenedTuple
[
SynExpr.CreateApp (
SynExpr.CreateIdentString "nameof",
SynExpr.CreateParen baseAddress
)
SynExpr.CreateConstString
"No base address was supplied on the type, and no BaseAddress was on the HttpClient."
]
)
)
)
| Some expr -> SynExpr.CreateApp (uriIdent, expr)
)
SynMatchClause.Create (
SynPat.CreateNamed (Ident.Create "v"),
None,
SynExpr.CreateIdentString "v"
)
]
)
|> SynExpr.CreateParen
SynExpr.App (
ExprAtomicFlag.Atomic,
false,
uriIdent,
SynExpr.CreateParenedTuple
[
SynExpr.CreateLongIdent (SynLongIdent.Create [ "client" ; "BaseAddress" ])
baseAddress
SynExpr.CreateApp (
uriIdent,
SynExpr.CreateParenedTuple
@@ -326,8 +367,23 @@ module internal HttpClientGenerator =
)
)
if not bodyParams.IsEmpty then
failwith "[<Body>] is not yet supported"
let bodyParam =
match bodyParams with
| [] -> None
| [ x ] ->
// TODO: body serialisation method
let paramName =
match x.Id with
| None -> failwith "Anonymous [<Body>] parameter is unsupported"
| Some id -> id
match x.Type with
| Stream -> Some (BodyParamMethods.StreamContent, paramName)
| String -> Some (BodyParamMethods.StringContent, paramName)
| ArrayType Byte -> Some (BodyParamMethods.ByteArrayContent, paramName)
| HttpContent -> Some (BodyParamMethods.HttpContent, paramName)
| ty -> Some (BodyParamMethods.Serialise ty, paramName)
| _ -> failwith "You can only have at most one [<Body>] parameter on a method."
let httpReqMessageConstructor =
[
@@ -342,17 +398,82 @@ module internal HttpClientGenerator =
|> SynExpr.CreateParenedTuple
let returnExpr =
match info.ReturnType with
match info.TaskReturnType with
| HttpResponseMessage
| String
| Stream -> SynExpr.CreateIdentString "node"
| _ ->
| retType ->
JsonParseGenerator.parseNode
None
JsonParseGenerator.JsonParseOption.None
info.ReturnType
retType
(SynExpr.CreateIdentString "node")
let handleBodyParams =
match bodyParam with
| None -> []
| Some (bodyParamType, bodyParamName) ->
match bodyParamType with
| BodyParamMethods.StreamContent
| BodyParamMethods.ByteArrayContent
| BodyParamMethods.StringContent ->
[
Let (
"queryParams",
SynExpr.New (
false,
SynType.CreateLongIdent (
SynLongIdent.Create
[ "System" ; "Net" ; "Http" ; (bodyParamType : BodyParamMethods).ToString () ]
),
SynExpr.CreateParen (SynExpr.CreateIdent bodyParamName),
range0
)
)
Do (
SynExpr.LongIdentSet (
SynLongIdent.Create [ "httpMessage" ; "Content" ],
SynExpr.CreateIdentString "queryParams",
range0
)
)
]
| BodyParamMethods.HttpContent ->
[
Do (
SynExpr.LongIdentSet (
SynLongIdent.Create [ "httpMessage" ; "Content" ],
SynExpr.CreateIdent bodyParamName,
range0
)
)
]
| BodyParamMethods.Serialise _ ->
failwith "We don't yet support serialising Body parameters; use string or Stream instead"
(*
// TODO: this should use JSON instead of ToString
[
Let (
"queryParams",
SynExpr.New (
false,
SynType.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Net" ; "Http" ; "StringContent" ]
),
SynExpr.CreateParen (SynExpr.CreateIdent bodyParamName |> SynExpr.toString ty),
range0
)
)
Do (
SynExpr.LongIdentSet (
SynLongIdent.Create [ "httpMessage" ; "Content" ],
SynExpr.CreateIdentString "queryParams",
range0
)
)
]
*)
let implementation =
[
yield LetBang ("ct", SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "CancellationToken" ]))
@@ -369,30 +490,9 @@ module internal HttpClientGenerator =
range0
)
)
(*
if not bodyParams.IsEmpty then
yield
Use (
"queryParams",
SynExpr.New (
false,
SynType.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Net" ; "Http" ; "StringContent" ]
),
SynExpr.CreateParen (failwith "TODO"),
range0
)
)
yield
Do (
SynExpr.LongIdentSet (
SynLongIdent.Create [ "httpMessage" ; "Content" ],
SynExpr.CreateIdentString "queryParams",
range0
)
)
*)
yield! handleBodyParams
yield
LetBang (
"response",
@@ -413,7 +513,7 @@ module internal HttpClientGenerator =
SynExpr.CreateConst SynConst.Unit
)
)
match info.ReturnType with
match info.TaskReturnType with
| HttpResponseMessage -> yield Let ("node", SynExpr.CreateIdentString "response")
| String ->
yield
@@ -480,7 +580,7 @@ module internal HttpClientGenerator =
SynMemberDefn.Member (
SynBinding.SynBinding (
None,
info.Accessibility,
SynBindingKind.Normal,
false,
false,
@@ -492,64 +592,59 @@ module internal HttpClientGenerator =
implementation,
range0,
DebugPointAtBinding.Yes range0,
synBindingTriviaZero true
SynExpr.synBindingTriviaZero true
),
range0
)
let rec convertSigParam (ty : SynType) : Parameter =
match ty with
| SynType.Paren (inner, _) -> convertSigParam inner
| SynType.SignatureParameter (attrs, opt, id, usedType, _) ->
let attrs =
attrs
|> List.collect (fun attrs ->
attrs.Attributes
|> List.choose (fun attr ->
match attr.TypeName.AsString with
| "Query"
| "QueryAttribute" ->
match attr.ArgExpr with
| SynExpr.Const (SynConst.Unit, _) -> Some (HttpAttribute.Query None)
| SynExpr.Const (SynConst.String (s, SynStringKind.Regular, _), _) ->
Some (HttpAttribute.Query (Some s))
| SynExpr.Const (a, _) ->
failwithf "unrecognised constant arg to the Query attribute: %+A" a
| _ -> None
| "Path"
| "PathAttribute" ->
match attr.ArgExpr with
| SynExpr.Const (SynConst.String (s, SynStringKind.Regular, _), _) ->
Some (HttpAttribute.Path s)
| SynExpr.Const (a, _) ->
failwithf "unrecognised constant arg to the Path attribute: %+A" a
| _ -> None
| "Body"
| "BodyAttribute" ->
match attr.ArgExpr with
| SynExpr.Const (SynConst.Unit, _) -> Some (HttpAttribute.Body)
| SynExpr.Const (a, _) ->
failwithf "unrecognised constant arg to the Body attribute: %+A" a
| _ -> None
| _ -> None
)
)
let getHttpAttributes (attrs : SynAttribute list) : HttpAttribute list =
attrs
|> List.choose (fun attr ->
match attr.TypeName.AsString with
| "Query"
| "QueryAttribute" ->
match attr.ArgExpr with
| SynExpr.Const (SynConst.Unit, _) -> Some (HttpAttribute.Query None)
| SynExpr.Const (SynConst.String (s, SynStringKind.Regular, _), _) ->
Some (HttpAttribute.Query (Some s))
| SynExpr.Const (a, _) -> failwith $"unrecognised constant arg to the Query attribute: %+A{a}"
| _ -> None
| "Path"
| "PathAttribute" ->
match attr.ArgExpr with
| SynExpr.Const (SynConst.String (s, SynStringKind.Regular, _), _) -> Some (HttpAttribute.Path s)
| SynExpr.Const (a, _) -> failwith $"unrecognised constant arg to the Path attribute: %+A{a}"
| _ -> None
| "Body"
| "BodyAttribute" ->
match attr.ArgExpr with
| SynExpr.Const (SynConst.Unit, _) -> Some HttpAttribute.Body
| SynExpr.Const (a, _) -> failwith $"unrecognised constant arg to the Body attribute: %+A{a}"
| _ -> None
| _ -> None
)
{
Attributes = attrs
IsOptional = opt
Id = id
Type = usedType
}
| _ -> failwithf "expected SignatureParameter, got: %+A" ty
let extractBasePath (attrs : SynAttribute list) : SynExpr option =
attrs
|> List.tryPick (fun attr ->
match attr.TypeName.AsString with
| "BasePath"
| "RestEase.BasePath"
| "BasePathAttribute"
| "RestEase.BasePathAttribute" -> Some attr.ArgExpr
| _ -> None
)
let rec extractTypes (tupleType : SynTupleTypeSegment list) : Parameter list =
match tupleType with
| [] -> []
| [ SynTupleTypeSegment.Type param ] -> [ convertSigParam param ]
| SynTupleTypeSegment.Type param :: SynTupleTypeSegment.Star _ :: rest ->
convertSigParam param :: extractTypes rest
| _ -> failwithf "Didn't have alternating type-and-star in interface member definition: %+A" tupleType
let extractBaseAddress (attrs : SynAttribute list) : SynExpr option =
attrs
|> List.tryPick (fun attr ->
match attr.TypeName.AsString with
| "BaseAddress"
| "RestEase.BaseAddress"
| "BaseAddressAttribute"
| "RestEase.BaseAddressAttribute" -> Some attr.ArgExpr
| _ -> None
)
let createModule
(opens : SynOpenDeclTarget list)
@@ -557,100 +652,65 @@ module internal HttpClientGenerator =
(interfaceType : SynTypeDefn)
: SynModuleOrNamespace
=
let (SynTypeDefn (SynComponentInfo (_, _, _, interfaceName, _, _, _, _), synTypeDefnRepr, _, _, _, _)) =
interfaceType
let interfaceType = AstHelper.parseInterface interfaceType
let baseAddress = extractBaseAddress interfaceType.Attributes
let basePath = extractBasePath interfaceType.Attributes
let members =
match synTypeDefnRepr with
| SynTypeDefnRepr.ObjectModel (_kind, members, _) ->
members
|> List.map (fun defn ->
match defn with
| SynMemberDefn.AbstractSlot (slotSig, flags, _, _) ->
match flags.MemberKind with
| SynMemberKind.Member -> ()
| kind -> failwithf "Unrecognised member kind: %+A" kind
interfaceType.Members
|> List.map (fun mem ->
let httpMethod, url = extractHttpInformation mem.Attributes
if not flags.IsInstance then
failwith "member was not an instance member"
let shouldEnsureSuccess = not (shouldAllowAnyStatusCode mem.Attributes)
match slotSig with
| SynValSig (attrs,
SynIdent.SynIdent (ident, _),
_typeParams,
synType,
arity,
isInline,
isMutable,
_xmlDoc,
accessibility,
synExpr,
_,
_) ->
if isInline then
failwith "inline members not supported"
let returnType =
match mem.ReturnType with
| Task ty -> ty
| a -> failwith $"Method must return a generic Task; returned %+A{a}"
if isMutable then
failwith "mutable members not supported"
if mem.IsMutable then
failwith $"mutable methods not supported (identifier: %+A{mem.Identifier})"
match accessibility with
| Some (SynAccess.Internal _)
| Some (SynAccess.Private _) -> failwith "only public members are supported"
| _ -> ()
match synExpr with
| Some _ -> failwith "literal members are not supported"
| None -> ()
let attrs = attrs |> List.collect (fun a -> a.Attributes)
let arity =
match arity with
| SynValInfo ([ curriedArgs ], SynArgInfo ([], false, _)) -> curriedArgs
| SynValInfo (curriedArgs, SynArgInfo ([], false, _)) ->
failwithf "only tupled arguments are supported, but got: %+A" curriedArgs
| SynValInfo (_, info) ->
failwithf
"only bare return values like `Task<foo>` are supported, but got: %+A"
info
let args, ret =
match synType with
| SynType.Fun (argType, Task returnType, _, _) -> argType, returnType
| _ ->
failwithf
"Expected a return type of a generic Task; bad signature was: %+A"
synType
let args =
match args with
| SynType.SignatureParameter _ -> [ convertSigParam args ]
| SynType.Tuple (false, path, _) -> extractTypes path
| _ -> failwithf "Unrecognised args in interface method declaration: %+A" args
let httpMethod, url = extractHttpInformation attrs
let shouldEnsureSuccess = not (shouldAllowAnyStatusCode attrs)
if mem.IsInline then
failwith $"inline methods not supported (identifier: %+A{mem.Identifier})"
let args =
match mem.Args with
| [ args ] ->
args.Args
|> List.map (fun arg ->
{
HttpMethod = httpMethod
UrlTemplate = url
ReturnType = ret
Arity = arity
Args = args
Identifier = ident
EnsureSuccessHttpCode = shouldEnsureSuccess
Attributes = arg.Attributes |> getHttpAttributes
IsOptional = arg.IsOptional
Id = arg.Id
Type = arg.Type
}
| _ -> failwithf "Unrecognised member definition: %+A" defn
)
| _ -> failwithf "Unrecognised SynTypeDefnRepr: %+A" synTypeDefnRepr
)
| [] -> failwith $"Expected %+A{mem.Identifier} to have tupled args, but it had no args."
| _ ->
failwith
$"Expected %+A{mem.Identifier} to have tupled args, but it was curried: %+A{mem.Args}."
{
HttpMethod = httpMethod
UrlTemplate = url
TaskReturnType = returnType
Args = args
Identifier = mem.Identifier
EnsureSuccessHttpCode = shouldEnsureSuccess
BaseAddress = baseAddress
BasePath = basePath
Accessibility = mem.Accessibility
}
)
let constructed = members |> List.map constructMember
let docString = PreXmlDoc.Create " Module for constructing a REST client."
let interfaceImpl =
SynExpr.ObjExpr (
SynType.LongIdent (SynLongIdent.CreateFromLongIdent interfaceName),
SynType.LongIdent (SynLongIdent.CreateFromLongIdent interfaceType.Name),
None,
Some range0,
[],
@@ -689,23 +749,27 @@ module internal HttpClientGenerator =
)
]
),
Some (SynBindingReturnInfo.Create (SynType.LongIdent (SynLongIdent.CreateFromLongIdent interfaceName))),
Some (
SynBindingReturnInfo.Create (
SynType.LongIdent (SynLongIdent.CreateFromLongIdent interfaceType.Name)
)
),
interfaceImpl,
range0,
DebugPointAtBinding.NoneAtLet,
synBindingTriviaZero false
SynExpr.synBindingTriviaZero false
)
|> List.singleton
|> SynModuleDecl.CreateLet
let moduleName : LongIdent =
List.last interfaceName
List.last interfaceType.Name
|> fun ident -> ident.idText
|> fun s ->
if s.StartsWith 'I' then
s.[1..]
else
failwithf "Expected interface type to start with 'I', but was: %s" s
failwith $"Expected interface type to start with 'I', but was: %s{s}"
|> Ident.Create
|> List.singleton
@@ -716,7 +780,12 @@ module internal HttpClientGenerator =
]
let modInfo =
SynComponentInfo.Create (moduleName, attributes = attribs, xmldoc = docString)
SynComponentInfo.Create (
moduleName,
attributes = attribs,
xmldoc = docString,
access = interfaceType.Accessibility
)
SynModuleOrNamespace.CreateNamespace (
ns,
@@ -728,14 +797,6 @@ module internal HttpClientGenerator =
]
)
let rec extractOpens (moduleDecls : SynModuleDecl list) : SynOpenDeclTarget list =
moduleDecls
|> List.choose (fun moduleDecl ->
match moduleDecl with
| SynModuleDecl.Open (target, _) -> Some target
| other -> None
)
/// Myriad generator that provides an HTTP client for an interface type using RestEase annotations.
[<MyriadGenerator("http-client")>]
type HttpClientGenerator () =
@@ -749,14 +810,7 @@ type HttpClientGenerator () =
let types = Ast.extractTypeDefn ast
let opens =
match ast with
| ParsedInput.ImplFile (ParsedImplFileInput (_, _, _, _, _, modules, _, _, _)) ->
modules
|> List.collect (fun (SynModuleOrNamespace (nsId, _, _, decls, _, _, _, _, _)) ->
HttpClientGenerator.extractOpens decls
)
| _ -> []
let opens = AstHelper.extractOpens ast
let namespaceAndTypes =
types
@@ -768,12 +822,6 @@ type HttpClientGenerator () =
let modules =
namespaceAndTypes
|> List.collect (fun (ns, types) ->
types
|> List.map (fun interfaceType ->
let clientModule = HttpClientGenerator.createModule opens ns interfaceType
clientModule
)
)
|> List.collect (fun (ns, types) -> types |> List.map (HttpClientGenerator.createModule opens ns))
Output.Ast modules

View File

@@ -0,0 +1,362 @@
namespace WoofWare.Myriad.Plugins
open System
open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Xml
open Myriad.Core
/// Attribute indicating an interface type for which the "Generate Mock" Myriad
/// generator should apply during build.
/// This generator creates a record which implements the interface,
/// but where each method is represented as a record field, so you can use
/// record update syntax to easily specify partially-implemented mock objects.
type GenerateMockAttribute () =
inherit Attribute ()
[<RequireQualifiedAccess>]
module internal InterfaceMockGenerator =
open Fantomas.FCS.Text.Range
open Myriad.Core.Ast
let private getName (SynField (_, _, id, _, _, _, _, _, _)) =
match id with
| None -> failwith "Expected record field to have a name, but it was somehow anonymous"
| Some id -> id
let createType
(name : string)
(interfaceType : InterfaceType)
(xmlDoc : PreXmlDoc)
(fields : SynField list)
: SynModuleDecl
=
let synValData =
{
SynMemberFlags.IsInstance = false
SynMemberFlags.IsDispatchSlot = false
SynMemberFlags.IsOverrideOrExplicitImpl = false
SynMemberFlags.IsFinal = false
SynMemberFlags.GetterOrSetterIsCompilerGenerated = false
SynMemberFlags.MemberKind = SynMemberKind.Member
}
let failwithFun =
SynExpr.createLambda
"x"
(SynExpr.CreateApp (
SynExpr.CreateIdentString "raise",
SynExpr.CreateParen (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "NotImplementedException" ]),
SynExpr.CreateConstString "Unimplemented mock function"
)
)
))
let constructorIdent =
let generics =
interfaceType.Generics
|> Option.map (fun generics -> SynValTyparDecls (Some generics, false))
SynPat.LongIdent (
SynLongIdent.CreateString "Empty",
None,
None, // no generics on the "Empty", only on the return type
SynArgPats.Pats (
if generics.IsNone then
[]
else
[ SynPat.CreateParen (SynPat.CreateConst SynConst.Unit) ]
),
None,
range0
)
let constructorReturnType =
match interfaceType.Generics with
| None -> SynType.CreateLongIdent name
| Some generics ->
let generics =
generics.TyparDecls
|> List.map (fun (SynTyparDecl (_, typar)) -> SynType.Var (typar, range0))
SynType.App (
SynType.CreateLongIdent name,
Some range0,
generics,
List.replicate (generics.Length - 1) range0,
Some range0,
false,
range0
)
|> SynBindingReturnInfo.Create
let constructor =
SynMemberDefn.Member (
SynBinding.SynBinding (
None,
SynBindingKind.Normal,
false,
false,
[],
PreXmlDoc.Empty,
SynValData.SynValData (Some synValData, SynValInfo.Empty, None),
constructorIdent,
Some constructorReturnType,
AstHelper.instantiateRecord (
fields
|> List.map (fun field ->
((SynLongIdent.CreateFromLongIdent [ getName field ], true), Some failwithFun)
)
),
range0,
DebugPointAtBinding.Yes range0,
{ SynExpr.synBindingTriviaZero true with
LeadingKeyword = SynLeadingKeyword.StaticMember (range0, range0)
}
),
range0
)
let interfaceMembers =
let members =
interfaceType.Members
|> List.map (fun memberInfo ->
let synValData =
SynValData.SynValData (
Some
{
IsInstance = true
IsDispatchSlot = false
IsOverrideOrExplicitImpl = true
IsFinal = false
GetterOrSetterIsCompilerGenerated = false
MemberKind = SynMemberKind.Member
},
valInfo =
SynValInfo.SynValInfo (
curriedArgInfos =
[
yield
[
SynArgInfo.SynArgInfo (
attributes = [],
optional = false,
ident = None
)
]
yield!
memberInfo.Args
|> List.mapi (fun i arg ->
arg.Args
|> List.mapi (fun j arg ->
SynArgInfo.CreateIdString $"arg_%i{i}_%i{j}"
)
)
],
returnInfo =
SynArgInfo.SynArgInfo (attributes = [], optional = false, ident = None)
),
thisIdOpt = None
)
let headArgs =
memberInfo.Args
|> List.mapi (fun i tupledArgs ->
let args =
tupledArgs.Args
|> List.mapi (fun j _ -> SynPat.CreateNamed (Ident.Create $"arg_%i{i}_%i{j}"))
SynPat.Tuple (false, args, List.replicate (args.Length - 1) range0, range0)
|> SynPat.CreateParen
|> fun i -> if tupledArgs.HasParen then SynPat.Paren (i, range0) else i
)
let headPat =
SynPat.LongIdent (
SynLongIdent.CreateFromLongIdent [ Ident.Create "this" ; memberInfo.Identifier ],
None,
None,
SynArgPats.Pats headArgs,
None,
range0
)
let body =
let tuples =
memberInfo.Args
|> List.mapi (fun i args ->
args.Args
|> List.mapi (fun j args -> SynExpr.CreateIdentString $"arg_%i{i}_%i{j}")
|> SynExpr.CreateParenedTuple
)
match tuples |> List.rev with
| [] -> failwith "expected args but got none"
| last :: rest ->
(last, rest)
||> List.fold (fun trail next -> SynExpr.CreateApp (next, trail))
|> fun args ->
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
SynLongIdent.CreateFromLongIdent [ Ident.Create "this" ; memberInfo.Identifier ]
),
args
)
SynMemberDefn.Member (
SynBinding.SynBinding (
None,
SynBindingKind.Normal,
false,
false,
[],
PreXmlDoc.Empty,
synValData,
headPat,
None,
body,
range0,
DebugPointAtBinding.Yes range0,
{
LeadingKeyword = SynLeadingKeyword.Member range0
InlineKeyword = None
EqualsRange = Some range0
}
),
range0
)
)
let interfaceName =
let baseName =
SynType.CreateLongIdent (SynLongIdent.CreateFromLongIdent interfaceType.Name)
match interfaceType.Generics with
| None -> baseName
| Some generics ->
let generics =
match generics with
| SynTyparDecls.PostfixList (decls, _, _) -> decls
| SynTyparDecls.PrefixList (decls, _) -> decls
| SynTyparDecls.SinglePrefix (decl, _) -> [ decl ]
|> List.map (fun (SynTyparDecl (_, typar)) -> SynType.Var (typar, range0))
SynType.App (
baseName,
Some range0,
generics,
List.replicate (generics.Length - 1) range0,
Some range0,
false,
range0
)
SynMemberDefn.Interface (interfaceName, Some range0, Some members, range0)
// TODO: allow an arg to the attribute, specifying a custom visibility
let access =
match interfaceType.Accessibility with
| Some (SynAccess.Public _)
| Some (SynAccess.Internal _)
| None -> SynAccess.Internal range0
| Some (SynAccess.Private _) -> SynAccess.Private range0
let record =
{
Name = Ident.Create name
Fields = fields
Members = Some [ constructor ; interfaceMembers ]
XmlDoc = Some xmlDoc
Generics = interfaceType.Generics
Accessibility = Some access
}
let typeDecl = AstHelper.defineRecordType record
SynModuleDecl.Types ([ typeDecl ], range0)
let private buildType (x : ParameterInfo) : SynType =
if x.IsOptional then
SynType.App (SynType.CreateLongIdent "option", Some range0, [ x.Type ], [], Some range0, false, range0)
else
x.Type
let private constructMemberSinglePlace (tuple : TupledArg) : SynType =
match tuple.Args |> List.rev |> List.map buildType with
| [] -> failwith "no-arg functions not supported yet"
| [ x ] -> x
| last :: rest ->
([ SynTupleTypeSegment.Type last ], rest)
||> List.fold (fun ty nextArg -> SynTupleTypeSegment.Type nextArg :: SynTupleTypeSegment.Star range0 :: ty)
|> fun segs -> SynType.Tuple (false, segs, range0)
|> fun ty -> if tuple.HasParen then SynType.Paren (ty, range0) else ty
let constructMember (mem : MemberInfo) : SynField =
let inputType = mem.Args |> List.map constructMemberSinglePlace
let funcType = AstHelper.toFun inputType mem.ReturnType
SynField.SynField (
[],
false,
Some mem.Identifier,
funcType,
false,
mem.XmlDoc |> Option.defaultValue PreXmlDoc.Empty,
None,
range0,
SynFieldTrivia.Zero
)
let createRecord (namespaceId : LongIdent) (interfaceType : SynTypeDefn) : SynModuleOrNamespace =
let interfaceType = AstHelper.parseInterface interfaceType
let fields = interfaceType.Members |> List.map constructMember
let docString = PreXmlDoc.Create " Mock record type for an interface"
let name =
List.last interfaceType.Name
|> fun s -> s.idText
|> fun s ->
if s.StartsWith 'I' && s.Length > 1 && Char.IsUpper s.[1] then
s.[1..]
else
s
|> fun s -> s + "Mock"
let typeDecl = createType name interfaceType docString fields
SynModuleOrNamespace.CreateNamespace (namespaceId, decls = [ typeDecl ])
/// Myriad generator that creates a record which implements the given interface,
/// but with every field mocked out.
[<MyriadGenerator("interface-mock")>]
type InterfaceMockGenerator () =
interface IMyriadGenerator with
member _.ValidInputExtensions = [ ".fs" ]
member _.Generate (context : GeneratorContext) =
let ast, _ =
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
let types = Ast.extractTypeDefn ast
let namespaceAndInterfaces =
types
|> List.choose (fun (ns, types) ->
match types |> List.filter Ast.hasAttribute<GenerateMockAttribute> with
| [] -> None
| types -> Some (ns, types)
)
let opens = AstHelper.extractOpens ast
let modules =
namespaceAndInterfaces
|> List.collect (fun (ns, records) -> records |> List.map (InterfaceMockGenerator.createRecord ns))
Output.Ast modules

View File

@@ -9,9 +9,26 @@ open Myriad.Core
/// Attribute indicating a record type to which the "Add JSON parse" Myriad
/// generator should apply during build.
type JsonParseAttribute () =
/// The purpose of this generator is to create methods (possibly extension methods) of the form
/// `{TypeName}.jsonParse : System.Text.Json.Nodes.JsonNode -> {TypeName}`.
///
/// 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 JsonParseAttribute (isExtensionMethod : bool) =
inherit Attribute ()
/// If changing this, *adjust the documentation strings*
static member internal DefaultIsExtensionMethod = false
/// Shorthand for the "isExtensionMethod = false" constructor; see documentation there for details.
new () = JsonParseAttribute JsonParseAttribute.DefaultIsExtensionMethod
type internal JsonParseOutputSpec =
{
ExtensionMethods : bool
}
[<RequireQualifiedAccess>]
module internal JsonParseGenerator =
open Fantomas.FCS.Text.Range
@@ -68,6 +85,14 @@ module internal JsonParseGenerator =
|> SynExpr.callMethod "AsValue"
|> SynExpr.callGenericMethod "GetValue" typeName
/// {node}.AsObject()
/// If `propertyName` is Some, uses `assertNotNull {node}` instead of `{node}`.
let asObject (propertyName : SynExpr option) (node : SynExpr) : SynExpr =
match propertyName with
| None -> node
| Some propertyName -> assertNotNull propertyName node
|> SynExpr.callMethod "AsObject"
/// {type}.jsonParse {node}
let typeJsonParse (typeName : LongIdent) (node : SynExpr) : SynExpr =
SynExpr.CreateApp (
@@ -116,6 +141,54 @@ module internal JsonParseGenerator =
let parseFunction (typeName : string) : LongIdent =
List.append (SynExpr.qualifyPrimitiveType typeName) [ Ident.Create "Parse" ]
/// fun kvp -> let key = {key(kvp)} in let value = {value(kvp)} in (key, value))
/// The inputs will be fed with appropriate SynExprs to apply them to the `kvp.Key` and `kvp.Value` args.
let dictionaryMapper (key : SynExpr -> SynExpr) (value : SynExpr -> SynExpr) : SynExpr =
let keyArg =
SynExpr.CreateLongIdent (SynLongIdent.Create [ "kvp" ; "Key" ])
|> SynExpr.CreateParen
let valueArg =
SynExpr.CreateLongIdent (SynLongIdent.Create [ "kvp" ; "Value" ])
|> SynExpr.CreateParen
SynExpr.LetOrUse (
false,
false,
[
SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create "key"), expr = key keyArg)
],
SynExpr.LetOrUse (
false,
false,
[
SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create "value"), expr = value valueArg)
],
SynExpr.CreateTuple [ SynExpr.CreateIdentString "key" ; SynExpr.CreateIdentString "value" ],
range0,
{
InKeyword = None
}
),
range0,
{
InKeyword = None
}
)
|> SynExpr.createLambda "kvp"
/// A conforming JSON object has only strings as keys. But it would be reasonable to allow the user
/// to parse these as URIs, for example.
let parseKeyString (desiredType : SynType) (key : SynExpr) : SynExpr =
match desiredType with
| String -> key
| Uri ->
key
|> SynExpr.pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Uri" ]))
| _ ->
failwithf
$"Unable to parse the key type %+A{desiredType} of a JSON object. Keys are strings, and this plugin does not know how to convert to that from a string."
/// Given `node.["town"]`, for example, choose how to obtain a JSON value from it.
/// The property name is used in error messages at runtime to show where a JSON
/// parse error occurred; supply `None` to indicate "don't validate".
@@ -134,6 +207,10 @@ module internal JsonParseGenerator =
|> SynExpr.pipeThroughFunction (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "DateOnly" ; "Parse" ])
)
| Uri ->
node
|> asValueGetValue propertyName "string"
|> SynExpr.pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Uri" ]))
| DateTime ->
node
|> asValueGetValue propertyName "string"
@@ -196,6 +273,56 @@ module internal JsonParseGenerator =
| ArrayType ty ->
parseNode None options ty (SynExpr.CreateLongIdent (SynLongIdent.CreateString "elt"))
|> asArrayMapped propertyName "Array" node
| IDictionaryType (keyType, valueType) ->
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Seq" ; "map" ]),
dictionaryMapper (parseKeyString keyType) (parseNode None options valueType)
)
)
|> SynExpr.pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "dict" ]))
| DictionaryType (keyType, valueType) ->
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Seq" ; "map" ]),
dictionaryMapper (parseKeyString keyType) (parseNode None options valueType)
)
)
|> SynExpr.pipeThroughFunction (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Seq" ; "map" ]),
SynExpr.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Collections" ; "Generic" ; "KeyValuePair" ]
)
)
)
|> SynExpr.pipeThroughFunction (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Collections" ; "Generic" ; "Dictionary" ])
)
| IReadOnlyDictionaryType (keyType, valueType) ->
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Seq" ; "map" ]),
dictionaryMapper (parseKeyString keyType) (parseNode None options valueType)
)
)
|> SynExpr.pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "readOnlyDict" ]))
| MapType (keyType, valueType) ->
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Seq" ; "map" ]),
dictionaryMapper (parseKeyString keyType) (parseNode None options valueType)
)
)
|> SynExpr.pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "Map" ; "ofSeq" ]))
| _ ->
// Let's just hope that we've also got our own type annotation!
let typeName =
@@ -203,7 +330,10 @@ module internal JsonParseGenerator =
| SynType.LongIdent ident -> ident.LongIdent
| _ -> failwith $"Unrecognised type: %+A{fieldType}"
typeJsonParse typeName node
match propertyName with
| None -> node
| Some propertyName -> assertNotNull propertyName node
|> typeJsonParse typeName
/// propertyName is probably a string literal, but it could be a [<Literal>] variable
/// The result of this function is the body of a let-binding (not including the LHS of that let-binding).
@@ -221,7 +351,7 @@ module internal JsonParseGenerator =
| [ _ ; "JsonNumberHandling" ; "Serialization" ; "Json" ; "Text" ; "System" ] -> true
| _ -> false
let createMaker (typeName : LongIdent) (fields : SynField list) =
let createMaker (spec : JsonParseOutputSpec) (typeName : LongIdent) (fields : SynField list) =
let xmlDoc = PreXmlDoc.Create " Parse from a JSON node."
let returnInfo =
@@ -231,10 +361,26 @@ module internal JsonParseGenerator =
let functionName = Ident.Create "jsonParse"
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 (
None,
memberFlags,
SynValInfo.SynValInfo ([ [ SynArgInfo.CreateId functionName ] ], SynArgInfo.Empty),
Some inputArg
thisIdOpt
)
let assignments =
@@ -325,7 +471,7 @@ module internal JsonParseGenerator =
(SynLongIdent.CreateFromLongIdent [ id ], true),
Some (SynExpr.CreateLongIdent (SynLongIdent.CreateFromLongIdent [ id ]))
)
|> AstHelper.constructRecord
|> AstHelper.instantiateRecord
let assignments =
(finalConstruction, assignments)
@@ -361,20 +507,60 @@ module internal JsonParseGenerator =
range0
)
let binding =
SynBinding.Let (
isInline = false,
isMutable = false,
xmldoc = xmlDoc,
returnInfo = returnInfo,
expr = assignments,
valData = inputVal,
pattern = pattern
)
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
}
)
SynModuleDecl.CreateLet [ binding ]
let mem = SynMemberDefn.Member (binding, range0)
let createRecordModule (namespaceId : LongIdent) (typeDefn : SynTypeDefn) =
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 createRecordModule (namespaceId : LongIdent) (spec : JsonParseOutputSpec) (typeDefn : SynTypeDefn) =
let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) =
typeDefn
@@ -384,30 +570,54 @@ module internal JsonParseGenerator =
match synTypeDefnRepr with
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, recordFields, _recordRange), _) ->
let decls = [ createMaker recordId recordFields ]
let decls = [ createMaker spec recordId recordFields ]
let attributes =
[
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
SynAttributeList.Create SynAttribute.compilationRepresentation
]
if spec.ExtensionMethods then
[ SynAttributeList.Create SynAttribute.autoOpen ]
else
[
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
SynAttributeList.Create SynAttribute.compilationRepresentation
]
let xmlDoc =
recordId
|> Seq.map (fun i -> i.idText)
|> String.concat "."
|> sprintf " Module containing JSON parsing methods for the %s type"
let fullyQualified = recordId |> Seq.map (fun i -> i.idText) |> String.concat "."
let description =
if spec.ExtensionMethods then
"extension members"
else
"methods"
$" Module containing JSON parsing %s{description} for the %s{fullyQualified} type"
|> PreXmlDoc.Create
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
List.take (List.length recordId - 1) recordId @ [ expanded ]
else
recordId
let info =
SynComponentInfo.Create (recordId, attributes = attributes, xmldoc = xmlDoc)
SynComponentInfo.Create (moduleName, attributes = attributes, xmldoc = xmlDoc)
let mdl = SynModuleDecl.CreateNestedModule (info, decls)
SynModuleOrNamespace.CreateNamespace (namespaceId, decls = [ mdl ])
| _ -> failwithf "Not a record type"
/// Myriad generator that provides a JSON parse function for a record type.
/// Myriad generator that provides a method (possibly an extension method) for a record type,
/// containing a JSON parse function.
[<MyriadGenerator("json-parse")>]
type JsonParseGenerator () =
@@ -423,17 +633,37 @@ type JsonParseGenerator () =
let namespaceAndRecords =
records
|> List.choose (fun (ns, types) ->
match types |> List.filter Ast.hasAttribute<JsonParseAttribute> with
| [] -> None
| types -> Some (ns, types)
types
|> List.choose (fun typeDef ->
match Ast.getAttribute<JsonParseAttribute> 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 [<JsonParseAttribute>]. 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 =
namespaceAndRecords
|> List.collect (fun (ns, records) ->
records
|> List.map (fun record ->
let recordModule = JsonParseGenerator.createRecordModule ns record
|> List.map (fun (record, spec) ->
let recordModule = JsonParseGenerator.createRecordModule ns spec record
recordModule
)
)

View File

@@ -8,6 +8,7 @@ open Myriad.Core
/// Attribute indicating a record type to which the "Remove Options" Myriad
/// generator should apply during build.
/// The purpose of this generator is to strip the `option` modifier from types.
type RemoveOptionsAttribute () =
inherit Attribute ()
@@ -46,14 +47,26 @@ module internal RemoveOptionsGenerator =
)
// TODO: this option seems a bit odd
let createType (xmlDoc : PreXmlDoc option) (fields : SynField list) =
let createType
(xmlDoc : PreXmlDoc option)
(accessibility : SynAccess option)
(generics : SynTyparDecls option)
(fields : SynField list)
=
let fields : SynField list = fields |> List.map removeOption
let name = Ident.Create "Short"
let typeDecl : SynTypeDefn =
match xmlDoc with
| None -> AstHelper.defineRecordType (name, fields, None, None)
| Some xmlDoc -> AstHelper.defineRecordType (name, fields, None, Some xmlDoc)
let record =
{
Name = name
Fields = fields
Members = None
XmlDoc = xmlDoc
Generics = generics
Accessibility = accessibility
}
let typeDecl = AstHelper.defineRecordType record
SynModuleDecl.Types ([ typeDecl ], range0)
@@ -114,7 +127,7 @@ module internal RemoveOptionsGenerator =
(SynLongIdent.CreateFromLongIdent [ id ], true), Some body
)
|> AstHelper.constructRecord
|> AstHelper.instantiateRecord
let pattern =
SynPat.LongIdent (
@@ -150,15 +163,15 @@ module internal RemoveOptionsGenerator =
let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) =
typeDefn
let (SynComponentInfo (_attributes, _typeParams, _constraints, recordId, doc, _preferPostfix, _access, _)) =
let (SynComponentInfo (_attributes, typeParams, _constraints, recordId, doc, _preferPostfix, _access, _)) =
synComponentInfo
match synTypeDefnRepr with
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, recordFields, _recordRange), _) ->
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (accessibility, recordFields, _recordRange), _) ->
let decls =
[
createType (Some doc) recordFields
createType (Some doc) accessibility typeParams recordFields
createMaker [ Ident.Create "Short" ] recordId recordFields
]

View File

@@ -1,8 +1,13 @@
WoofWare.Myriad.Plugins.GenerateMockAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.GenerateMockAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.HttpClientAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.HttpClientAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.HttpClientGenerator inherit obj, implements Myriad.Core.IMyriadGenerator
WoofWare.Myriad.Plugins.HttpClientGenerator..ctor [constructor]: unit
WoofWare.Myriad.Plugins.InterfaceMockGenerator inherit obj, implements Myriad.Core.IMyriadGenerator
WoofWare.Myriad.Plugins.InterfaceMockGenerator..ctor [constructor]: unit
WoofWare.Myriad.Plugins.JsonParseAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.JsonParseAttribute..ctor [constructor]: bool
WoofWare.Myriad.Plugins.JsonParseAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.JsonParseGenerator inherit obj, implements Myriad.Core.IMyriadGenerator
WoofWare.Myriad.Plugins.JsonParseGenerator..ctor [constructor]: unit

View File

@@ -20,3 +20,12 @@ module internal SynAttribute =
AppliesToGetterAndSetter = false
Range = range0
}
let internal autoOpen : SynAttribute =
{
TypeName = SynLongIdent.CreateString "AutoOpen"
ArgExpr = SynExpr.CreateConst SynConst.Unit
Target = None
AppliesToGetterAndSetter = false
Range = range0
}

View File

@@ -102,9 +102,9 @@ module internal SynExpr =
b
)
let stripOptionalParen (expr : SynExpr) : SynExpr =
let rec stripOptionalParen (expr : SynExpr) : SynExpr =
match expr with
| SynExpr.Paren (expr, _, _, _) -> expr
| SynExpr.Paren (expr, _, _, _) -> stripOptionalParen expr
| expr -> expr
/// Given e.g. "byte", returns "System.Byte".
@@ -240,7 +240,7 @@ module internal SynExpr =
SynExprLetOrUseTrivia.InKeyword = None
}
)
| Do body -> SynExpr.Do (body, range0)
| Do body -> SynExpr.CreateSequential [ SynExpr.Do (body, range0) ; state ]
)
SynExpr.CreateApp (
@@ -252,3 +252,24 @@ module internal SynExpr =
let awaitTask (expr : SynExpr) : SynExpr =
expr
|> pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "AwaitTask" ]))
/// {ident}.ToString ()
/// with special casing for some types like DateTime
let toString (ty : SynType) (ident : SynExpr) =
match ty with
| DateOnly -> ident |> callMethodArg "ToString" (SynExpr.CreateConstString "yyyy-MM-dd")
| DateTime ->
ident
|> callMethodArg "ToString" (SynExpr.CreateConstString "yyyy-MM-ddTHH:mm:ss")
| _ -> callMethod "ToString" ident
let synBindingTriviaZero (isMember : bool) =
{
SynBindingTrivia.EqualsRange = Some range0
InlineKeyword = None
LeadingKeyword =
if isMember then
SynLeadingKeyword.Member range0
else
SynLeadingKeyword.Let range0
}

View File

@@ -28,6 +28,7 @@
<Compile Include="SynExpr.fs"/>
<Compile Include="SynAttribute.fs"/>
<Compile Include="RemoveOptionsGenerator.fs"/>
<Compile Include="InterfaceMockGenerator.fs" />
<Compile Include="JsonParseGenerator.fs"/>
<Compile Include="HttpClientGenerator.fs"/>
<EmbeddedResource Include="version.json"/>

View File

@@ -1,5 +1,5 @@
{
"version": "1.1",
"version": "1.3",
"publicReleaseRefSpec": [
"^refs/heads/main$"
],

View File

@@ -4,7 +4,7 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "ConsumePlugin", "ConsumePlu
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WoofWare.Myriad.Plugins", "WoofWare.Myriad.Plugins\WoofWare.Myriad.Plugins.fsproj", "{DB86C53B-4090-4791-884B-024C5759855F}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyriadPlugin.Test", "MyriadPlugin.Test\MyriadPlugin.Test.fsproj", "{13370CA7-2A80-4B4D-8DEB-F1AA77F206C4}"
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WoofWare.Myriad.Plugins.Test", "WoofWare.Myriad.Plugins.Test\WoofWare.Myriad.Plugins.Test.fsproj", "{EBFFA5D3-7F74-4824-8795-B6194E6FE0CB}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
@@ -20,9 +20,9 @@ Global
{DB86C53B-4090-4791-884B-024C5759855F}.Debug|Any CPU.Build.0 = Debug|Any CPU
{DB86C53B-4090-4791-884B-024C5759855F}.Release|Any CPU.ActiveCfg = Release|Any CPU
{DB86C53B-4090-4791-884B-024C5759855F}.Release|Any CPU.Build.0 = Release|Any CPU
{13370CA7-2A80-4B4D-8DEB-F1AA77F206C4}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{13370CA7-2A80-4B4D-8DEB-F1AA77F206C4}.Debug|Any CPU.Build.0 = Debug|Any CPU
{13370CA7-2A80-4B4D-8DEB-F1AA77F206C4}.Release|Any CPU.ActiveCfg = Release|Any CPU
{13370CA7-2A80-4B4D-8DEB-F1AA77F206C4}.Release|Any CPU.Build.0 = Release|Any CPU
{EBFFA5D3-7F74-4824-8795-B6194E6FE0CB}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{EBFFA5D3-7F74-4824-8795-B6194E6FE0CB}.Debug|Any CPU.Build.0 = Debug|Any CPU
{EBFFA5D3-7F74-4824-8795-B6194E6FE0CB}.Release|Any CPU.ActiveCfg = Release|Any CPU
{EBFFA5D3-7F74-4824-8795-B6194E6FE0CB}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
EndGlobal

View File

@@ -45,7 +45,7 @@
in {
packages = {
fantomas = dotnetTool null "fantomas" (builtins.fromJSON (builtins.readFile ./.config/dotnet-tools.json)).tools.fantomas.version "sha256-Jmo7s8JMdQ8SxvNvPnryfE7n24mIgKi5cbgNwcQw3yU=";
fsharp-analyzers = dotnetTool "FSharp.Analyzers.Cli" "fsharp-analyzers" (builtins.fromJSON (builtins.readFile ./.config/dotnet-tools.json)).tools.fsharp-analyzers.version "sha256-wDS7aE4VI718iwU8xUm0aCOYIcFpMuqWu9+H5d+8XAA=";
fsharp-analyzers = dotnetTool "FSharp.Analyzers.Cli" "fsharp-analyzers" (builtins.fromJSON (builtins.readFile ./.config/dotnet-tools.json)).tools.fsharp-analyzers.version "sha256-CWMW06ncSs8QkQvxNPNrgn3TAzMU6qCT1k2A3pnGrYQ=";
fetchDeps = let
flags = [];
runtimeIds = ["win-x64"] ++ map (system: pkgs.dotnetCorePackages.systemToDotnetRid system) dotnet-sdk.meta.platforms;

View File

@@ -3,8 +3,8 @@
{fetchNuGet}: [
(fetchNuGet {
pname = "fsharp-analyzers";
version = "0.22.0";
sha256 = "sha256-wDS7aE4VI718iwU8xUm0aCOYIcFpMuqWu9+H5d+8XAA=";
version = "0.23.0";
sha256 = "sha256-CWMW06ncSs8QkQvxNPNrgn3TAzMU6qCT1k2A3pnGrYQ=";
})
(fetchNuGet {
pname = "fantomas";
@@ -18,8 +18,8 @@
})
(fetchNuGet {
pname = "coverlet.collector";
version = "3.2.0";
sha256 = "1qxpv8v10p5wn162lzdm193gdl6c5f81zadj8h889dprlnj3g8yr";
version = "6.0.0";
sha256 = "12j34vrkmph8lspbafnqmfnj2qvysz1jcrks2khw798s6dwv0j90";
})
(fetchNuGet {
pname = "Fantomas.Core";
@@ -48,8 +48,8 @@
})
(fetchNuGet {
pname = "FsUnit";
version = "5.6.1";
sha256 = "1zffn9dm2c44v8qjzwfg6y3psydiv2bn3n305rf7mc57cmm4ygv3";
version = "6.0.0";
sha256 = "18q3p0z155znwj1l0qq3vq9nh9wl2i4mlfx4pmrnia4czr0xdkmb";
})
(fetchNuGet {
pname = "Microsoft.AspNetCore.App.Ref";
@@ -113,18 +113,18 @@
})
(fetchNuGet {
pname = "Microsoft.Build.Tasks.Git";
version = "1.1.1";
sha256 = "1bb5p4zlnfn88skkvymxfsn0jybqncl4356hwnic9jxdq2d4fz1w";
version = "8.0.0";
sha256 = "0055f69q3hbagqp8gl3nk0vfn4qyqyxsxyy7pd0g7wm3z28byzmx";
})
(fetchNuGet {
pname = "Microsoft.CodeCoverage";
version = "17.5.0";
sha256 = "0briw00gb5bz9k9kx00p6ghq47w501db7gb6ig5zzmz9hb8lw4a4";
version = "17.8.0";
sha256 = "173wjadp3gan4x2jfjchngnc4ca4mb95h1sbb28jydfkfw0z1zvj";
})
(fetchNuGet {
pname = "Microsoft.NET.Test.Sdk";
version = "17.5.0";
sha256 = "00gz2i8kx4mlq1ywj3imvf7wc6qzh0bsnynhw06z0mgyha1a21jy";
version = "17.8.0";
sha256 = "1syvl3g0hbrcgfi9rq6pld8s8hqqww4dflf1lxn59ccddyyx0gmv";
})
(fetchNuGet {
pname = "Microsoft.NETCore.App.Host.linux-arm64";
@@ -236,11 +236,6 @@
version = "8.0.0";
sha256 = "054icf5jjnwnswrnv1r05x3pfjvacbz6g3dj8caar1zp53k49rkk";
})
(fetchNuGet {
pname = "Microsoft.NETCore.Platforms";
version = "1.1.0";
sha256 = "08vh1r12g6ykjygq5d3vq09zylgb84l63k49jc4v8faw9g93iqqm";
})
(fetchNuGet {
pname = "Microsoft.NETCore.Platforms";
version = "1.1.1";
@@ -258,23 +253,23 @@
})
(fetchNuGet {
pname = "Microsoft.SourceLink.Common";
version = "1.1.1";
sha256 = "0xkdqs7az2cprar7jzjlgjpd64l6f8ixcmwmpkdm03fyb4s5m0bg";
version = "8.0.0";
sha256 = "0xrr8yd34ij7dqnyddkp2awfmf9qn3c89xmw2f3npaa4wnajmx81";
})
(fetchNuGet {
pname = "Microsoft.SourceLink.GitHub";
version = "1.1.1";
sha256 = "099y35f2npvva3jk1zp8hn0vb9pwm2l0ivjasdly6y2idv53s5yy";
version = "8.0.0";
sha256 = "1gdx7n45wwia3yvang3ls92sk3wrymqcx9p349j8wba2lyjf9m44";
})
(fetchNuGet {
pname = "Microsoft.TestPlatform.ObjectModel";
version = "17.5.0";
sha256 = "0qkjyf3ky6xpjg5is2sdsawm99ka7fzgid2bvpglwmmawqgm8gls";
version = "17.8.0";
sha256 = "0b0i7lmkrcfvim8i3l93gwqvkhhhfzd53fqfnygdqvkg6np0cg7m";
})
(fetchNuGet {
pname = "Microsoft.TestPlatform.TestHost";
version = "17.5.0";
sha256 = "17g0k3r5n8grba8kg4nghjyhnq9w8v0w6c2nkyyygvfh8k8x9wh3";
version = "17.8.0";
sha256 = "0f5jah93kjkvxwmhwb78lw11m9pkkq9fvf135hpymmmpxqbdh97q";
})
(fetchNuGet {
pname = "Myriad.Core";
@@ -288,13 +283,8 @@
})
(fetchNuGet {
pname = "Nerdbank.GitVersioning";
version = "3.6.128";
sha256 = "1ip5qlhssfhx7q6gjnx7syvwc9m1bf4ikd17z5cbn9l257465hrj";
})
(fetchNuGet {
pname = "NETStandard.Library";
version = "2.0.0";
sha256 = "1bc4ba8ahgk15m8k4nd7x406nhi0kwqzbgjk2dmw52ss553xz7iy";
version = "3.6.133";
sha256 = "1cdw8krvsnx0n34f7fm5hiiy7bs6h3asvncqcikc0g46l50w2j80";
})
(fetchNuGet {
pname = "Newtonsoft.Json";
@@ -318,8 +308,8 @@
})
(fetchNuGet {
pname = "NuGet.Frameworks";
version = "5.11.0";
sha256 = "0wv26gq39hfqw9md32amr5771s73f5zn1z9vs4y77cgynxr73s4z";
version = "6.5.0";
sha256 = "0s37d1p4md0k6d4cy6sq36f2dgkd9qfbzapxhkvi8awwh0vrynhj";
})
(fetchNuGet {
pname = "NuGet.Frameworks";
@@ -343,18 +333,23 @@
})
(fetchNuGet {
pname = "NUnit";
version = "3.14.0";
sha256 = "19p8911lrfds1k9rv47jk1bbn665s0pvghkd06gzbg78j6mzzqqa";
version = "4.0.1";
sha256 = "0jgiq3dbwli5r70j0bw7021d69r7bhr58s8kphlpjmf7k47l5pcd";
})
(fetchNuGet {
pname = "NUnit.Analyzers";
version = "3.6.1";
sha256 = "16dw5375k2wyhiw9x387y7pjgq6zms30y036qb8z7idx4lxw9yi9";
version = "3.10.0";
sha256 = "1zc6s7lmzw5avrnbbjwyzla9d6bafbpxgv62m4zlqxv14p85md0d";
})
(fetchNuGet {
pname = "NUnit3TestAdapter";
version = "4.4.2";
sha256 = "1n2jlc16vjdd81cb1by4qbp75sq73zsjz5w3zc61ssmbdci1q2ri";
version = "4.5.0";
sha256 = "1srx1629s0k1kmf02nmz251q07vj6pv58mdafcr5dr0bbn1fh78i";
})
(fetchNuGet {
pname = "RestEase";
version = "1.6.4";
sha256 = "1mvi3nbrr450g3fgd1y4wg3bwl9k1agyjfd9wdkqk12714bsln8l";
})
(fetchNuGet {
pname = "runtime.any.System.Runtime";