mirror of
https://github.com/Smaug123/WoofWare.Myriad
synced 2025-10-23 12:58:39 +00:00
Merge main
This commit is contained in:
@@ -9,10 +9,10 @@
|
||||
]
|
||||
},
|
||||
"fsharp-analyzers": {
|
||||
"version": "0.22.0",
|
||||
"version": "0.23.0",
|
||||
"commands": [
|
||||
"fsharp-analyzers"
|
||||
]
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
2
.github/dependabot.yml
vendored
2
.github/dependabot.yml
vendored
@@ -7,7 +7,7 @@ updates:
|
||||
interval: "weekly"
|
||||
|
||||
- package-ecosystem: "nuget"
|
||||
directory: "/ApiSurface"
|
||||
directory: "/"
|
||||
schedule:
|
||||
interval: "weekly"
|
||||
ignore:
|
||||
|
18
.github/workflows/dotnet.yaml
vendored
18
.github/workflows/dotnet.yaml
vendored
@@ -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 }}
|
||||
|
5
ConsumePlugin/AssemblyInfo.fs
Normal file
5
ConsumePlugin/AssemblyInfo.fs
Normal file
@@ -0,0 +1,5 @@
|
||||
namespace ConsumePlugin.AssemblyInfo
|
||||
|
||||
[<assembly : System.Runtime.CompilerServices.InternalsVisibleTo("WoofWare.Myriad.Plugins.Test")>]
|
||||
|
||||
do ()
|
@@ -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>
|
||||
|
@@ -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
|
||||
}
|
||||
|
113
ConsumePlugin/GeneratedMock.fs
Normal file
113
ConsumePlugin/GeneratedMock.fs
Normal 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)
|
@@ -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
|
||||
}
|
||||
|
@@ -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))
|
||||
}
|
||||
|
549
ConsumePlugin/GeneratedVault.fs
Normal file
549
ConsumePlugin/GeneratedVault.fs
Normal 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))
|
||||
}
|
@@ -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
|
||||
|
32
ConsumePlugin/MockExample.fs
Normal file
32
ConsumePlugin/MockExample.fs
Normal 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
|
@@ -177,3 +177,9 @@ type Sessions =
|
||||
[<JsonPropertyName "Visits">]
|
||||
Visits : Visit list
|
||||
}
|
||||
|
||||
[<WoofWare.Myriad.Plugins.JsonParse>]
|
||||
type UriThing =
|
||||
{
|
||||
SomeUri : Uri
|
||||
}
|
||||
|
@@ -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
78
ConsumePlugin/Vault.fs
Normal 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>
|
@@ -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>
|
||||
<!--
|
||||
|
@@ -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>
|
58
README.md
58
README.md
@@ -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
|
||||
|
||||
|
@@ -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
|
@@ -1,4 +1,4 @@
|
||||
namespace MyriadPlugin.Test
|
||||
namespace WoofWare.Myriad.Plugins.Test
|
||||
|
||||
open PureGym
|
||||
open System
|
@@ -1,4 +1,4 @@
|
||||
namespace MyriadPlugin.Test
|
||||
namespace WoofWare.Myriad.Plugins.Test
|
||||
|
||||
open System
|
||||
open System.Net
|
80
WoofWare.Myriad.Plugins.Test/TestHttpClient/TestBasePath.fs
Normal file
80
WoofWare.Myriad.Plugins.Test/TestHttpClient/TestBasePath.fs
Normal 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')"
|
105
WoofWare.Myriad.Plugins.Test/TestHttpClient/TestBodyParam.fs
Normal file
105
WoofWare.Myriad.Plugins.Test/TestHttpClient/TestBodyParam.fs
Normal 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
|
@@ -1,4 +1,4 @@
|
||||
namespace MyriadPlugin.Test
|
||||
namespace WoofWare.Myriad.Plugins.Test
|
||||
|
||||
open System
|
||||
open System.Net
|
@@ -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"
|
@@ -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'">]
|
170
WoofWare.Myriad.Plugins.Test/TestHttpClient/TestVaultClient.fs
Normal file
170
WoofWare.Myriad.Plugins.Test/TestHttpClient/TestVaultClient.fs
Normal 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"
|
||||
]
|
@@ -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
|
@@ -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
|
@@ -1,4 +1,4 @@
|
||||
namespace MyriadPlugin.Test
|
||||
namespace WoofWare.Myriad.Plugins.Test
|
||||
|
||||
open System
|
||||
open System.Text.Json.Nodes
|
@@ -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"
|
@@ -1,4 +1,4 @@
|
||||
namespace MyriadPlugin.Test
|
||||
namespace WoofWare.Myriad.Plugins.Test
|
||||
|
||||
open FsCheck
|
||||
open ConsumePlugin
|
@@ -1,4 +1,4 @@
|
||||
namespace MyriadPlugin.Test
|
||||
namespace WoofWare.Myriad.Plugins.Test
|
||||
|
||||
open NUnit.Framework
|
||||
open WoofWare.Myriad.Plugins
|
@@ -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>
|
@@ -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, _, _, _, _) ->
|
||||
|
@@ -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
|
||||
|
362
WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs
Normal file
362
WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs
Normal 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
|
@@ -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
|
||||
)
|
||||
)
|
||||
|
@@ -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
|
||||
]
|
||||
|
||||
|
@@ -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
|
||||
|
@@ -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
|
||||
}
|
||||
|
@@ -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
|
||||
}
|
||||
|
@@ -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"/>
|
||||
|
@@ -1,5 +1,5 @@
|
||||
{
|
||||
"version": "1.1",
|
||||
"version": "1.3",
|
||||
"publicReleaseRefSpec": [
|
||||
"^refs/heads/main$"
|
||||
],
|
||||
|
@@ -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
|
||||
|
@@ -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;
|
||||
|
75
nix/deps.nix
75
nix/deps.nix
@@ -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";
|
||||
|
Reference in New Issue
Block a user