Compare commits

...

28 Commits

Author SHA1 Message Date
Patrick Stevens
b98080690d Finish DU parsing (#151) 2024-05-30 22:27:15 +01:00
Patrick Stevens
81b7e5361d Another grand refactor (#150) 2024-05-30 20:34:53 +01:00
Patrick Stevens
94b88a4143 Reduce duplication (#149) 2024-05-30 14:28:56 +01:00
Patrick Stevens
ed3ffecb52 Fix and test GitHub release script (#148) 2024-05-30 12:32:40 +00:00
Patrick Stevens
c696dcf31f Fix curl failing logic (#147) 2024-05-30 11:35:30 +00:00
Patrick Stevens
d5bb2726d3 Tighten the tagging logic (#146) 2024-05-30 11:28:43 +00:00
Patrick Stevens
f17290d0f1 Check generation of files is accurate (#145) 2024-05-30 12:10:49 +01:00
Patrick Stevens
35cd94cba1 Add JSON serialisation of DUs (#144) 2024-05-30 12:00:55 +01:00
Patrick Stevens
1b3eb03380 NerdBank.GitVersioning heights (#143) 2024-05-29 00:44:16 +01:00
dependabot[bot]
b846ce08a3 Bump Microsoft.NET.Test.Sdk from 17.9.0 to 17.10.0 (#141)
* Bump Microsoft.NET.Test.Sdk from 17.9.0 to 17.10.0

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

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

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

* Bump ApiSurface from 4.0.39 to 4.0.40

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

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

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

* Update deps

---------

Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
Co-authored-by: Smaug123 <3138005+Smaug123@users.noreply.github.com>
2024-05-27 12:03:40 +01:00
Patrick Stevens
4b9f63d374 Express HttpClient as extension method (#140) 2024-05-24 22:09:33 +01:00
Patrick Stevens
b9ba07a8a7 JSON parse all primitive types (#139) 2024-05-24 21:19:04 +01:00
Patrick Stevens
e80ed51498 Strip parens in Path parameter (#138) 2024-05-24 20:36:12 +01:00
dependabot[bot]
61b07ad802 Bump fsharp-analyzers from 0.25.0 to 0.26.0 (#134)
* Bump fsharp-analyzers from 0.25.0 to 0.26.0

Bumps [fsharp-analyzers](https://github.com/ionide/FSharp.Analyzers.SDK) from 0.25.0 to 0.26.0.
- [Release notes](https://github.com/ionide/FSharp.Analyzers.SDK/releases)
- [Changelog](https://github.com/ionide/FSharp.Analyzers.SDK/blob/main/CHANGELOG.md)
- [Commits](https://github.com/ionide/FSharp.Analyzers.SDK/compare/v0.25.0...v0.26.0)

---
updated-dependencies:
- dependency-name: fsharp-analyzers
  dependency-type: direct:production
  update-type: version-update:semver-minor
...

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

---------

Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
Co-authored-by: Smaug123 <3138005+Smaug123@users.noreply.github.com>
2024-05-20 19:02:54 +00:00
dependabot[bot]
59369bcb94 Bump cachix/install-nix-action from 26 to 27 (#133) 2024-05-20 12:47:58 +01:00
dependabot[bot]
072169e4e3 Bump ApiSurface from 4.0.36 to 4.0.39 (#132)
* Bump ApiSurface from 4.0.36 to 4.0.39

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

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

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

* Bump deps

---------

Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
Co-authored-by: Smaug123 <3138005+Smaug123@users.noreply.github.com>
2024-05-06 13:59:29 +01:00
Patrick Stevens
91136a25ab Enable query params in Get request endpoint (#131) 2024-04-30 19:03:20 +00:00
Patrick Stevens
c51038448a Be more forgiving about the source of the attributes (#129) 2024-04-29 20:46:14 +01:00
Patrick Stevens
09780efb07 Add RestEase attributes (#128) 2024-04-29 17:51:26 +01:00
dependabot[bot]
f562271c12 Bump fantomas from 6.3.3 to 6.3.4 (#126)
* Bump ApiSurface from 4.0.33 to 4.0.36

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

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

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

* Bump fantomas from 6.3.3 to 6.3.4

Bumps [fantomas](https://github.com/fsprojects/fantomas) from 6.3.3 to 6.3.4.
- [Release notes](https://github.com/fsprojects/fantomas/releases)
- [Changelog](https://github.com/fsprojects/fantomas/blob/main/CHANGELOG.md)
- [Commits](https://github.com/fsprojects/fantomas/compare/v6.3.3...v6.3.4)

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

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

* Drive-by

* Fix deps

---------

Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
Co-authored-by: Smaug123 <3138005+Smaug123@users.noreply.github.com>
2024-04-22 23:36:02 +01:00
Patrick Stevens
e3081c3136 Deal with unit type in generated mock (#124) 2024-04-17 08:44:31 +01:00
Patrick Stevens
232d2ba5ec Relax arg checking strictness (#123) 2024-04-16 22:47:06 +01:00
Patrick Stevens
f7458f521e Track inheritance in GenerateMock (#122) 2024-04-16 22:23:32 +01:00
dependabot[bot]
bfc25a672b Bump fantomas from 6.3.0 to 6.3.3 (#120)
* Bump fantomas from 6.3.0 to 6.3.3

Bumps [fantomas](https://github.com/fsprojects/fantomas) from 6.3.0 to 6.3.3.
- [Release notes](https://github.com/fsprojects/fantomas/releases)
- [Changelog](https://github.com/fsprojects/fantomas/blob/main/CHANGELOG.md)
- [Commits](https://github.com/fsprojects/fantomas/compare/v6.3.0...v6.3.3)

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

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

* Fix dep

---------

Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
Co-authored-by: Smaug123 <3138005+Smaug123@users.noreply.github.com>
2024-04-15 21:23:09 +00:00
dependabot[bot]
af7fcb3028 Bump fantomas from 6.3.0-alpha-008 to 6.3.0 (#118)
* Bump fantomas from 6.3.0-alpha-008 to 6.3.0

Bumps [fantomas](https://github.com/fsprojects/fantomas) from 6.3.0-alpha-008 to 6.3.0.
- [Release notes](https://github.com/fsprojects/fantomas/releases)
- [Changelog](https://github.com/fsprojects/fantomas/blob/main/CHANGELOG.md)
- [Commits](https://github.com/fsprojects/fantomas/commits/v6.3.0)

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

Signed-off-by: dependabot[bot] <support@github.com>
2024-03-19 23:07:38 +00:00
dependabot[bot]
91853b1fff Bump cachix/install-nix-action from 25 to 26 (#116) 2024-03-11 10:10:04 +00:00
dependabot[bot]
1144e93c1c Bump ApiSurface from 4.0.30 to 4.0.33 (#115)
* Bump NUnit from 3.13.3 to 4.1.0

Bumps [NUnit](https://github.com/nunit/nunit) from 3.13.3 to 4.1.0.
- [Release notes](https://github.com/nunit/nunit/releases)
- [Changelog](https://github.com/nunit/nunit/blob/master/CHANGES.md)
- [Commits](https://github.com/nunit/nunit/compare/v3.13.3...4.1.0)

---
updated-dependencies:
- dependency-name: NUnit
  dependency-type: direct:production
  update-type: version-update:semver-major
...

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

* Fix deps

* Bump NUnit from 4.0.1 to 4.1.0

Bumps [NUnit](https://github.com/nunit/nunit) from 4.0.1 to 4.1.0.
- [Release notes](https://github.com/nunit/nunit/releases)
- [Changelog](https://github.com/nunit/nunit/blob/master/CHANGES.md)
- [Commits](https://github.com/nunit/nunit/compare/v4.0.1...4.1.0)

---
updated-dependencies:
- dependency-name: NUnit
  dependency-type: direct:production
  update-type: version-update:semver-minor
...

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

* Bump fantomas from 6.3.0-alpha-007 to 6.3.0-alpha-008

Bumps [fantomas](https://github.com/fsprojects/fantomas) from 6.3.0-alpha-007 to 6.3.0-alpha-008.
- [Release notes](https://github.com/fsprojects/fantomas/releases)
- [Changelog](https://github.com/fsprojects/fantomas/blob/main/CHANGELOG.md)
- [Commits](https://github.com/fsprojects/fantomas/commits)

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

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

* Bump ApiSurface from 4.0.30 to 4.0.33

Bumps [ApiSurface](https://github.com/G-Research/ApiSurface) from 4.0.30 to 4.0.33.
- [Release notes](https://github.com/G-Research/ApiSurface/releases)
- [Commits](https://github.com/G-Research/ApiSurface/commits/ApiSurface.4.0.33)

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

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

* Bump lots of deps

---------

Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
Co-authored-by: Smaug123 <patrick+github@patrickstevens.co.uk>
2024-03-04 19:43:53 +00:00
dependabot[bot]
d899d77ae2 Bump NUnit from 3.13.3 to 4.1.0 (#110)
* Bump NUnit from 3.13.3 to 4.1.0

Bumps [NUnit](https://github.com/nunit/nunit) from 3.13.3 to 4.1.0.
- [Release notes](https://github.com/nunit/nunit/releases)
- [Changelog](https://github.com/nunit/nunit/blob/master/CHANGES.md)
- [Commits](https://github.com/nunit/nunit/compare/v3.13.3...4.1.0)

---
updated-dependencies:
- dependency-name: NUnit
  dependency-type: direct:production
  update-type: version-update:semver-major
...

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

* Fix deps

---------

Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
Co-authored-by: Smaug123 <patrick+github@patrickstevens.co.uk>
2024-02-26 19:00:19 +00:00
53 changed files with 3275 additions and 1838 deletions

View File

@@ -3,13 +3,13 @@
"isRoot": true,
"tools": {
"fantomas": {
"version": "6.3.0-alpha-007",
"version": "6.3.4",
"commands": [
"fantomas"
]
},
"fsharp-analyzers": {
"version": "0.25.0",
"version": "0.26.0",
"commands": [
"fsharp-analyzers"
]

View File

@@ -1,3 +1,4 @@
# yaml-language-server: $schema=https://raw.githubusercontent.com/SchemaStore/schemastore/master/src/schemas/json/github-workflow.json
name: .NET
on:
@@ -28,7 +29,7 @@ jobs:
with:
fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
- name: Install Nix
uses: cachix/install-nix-action@v25
uses: cachix/install-nix-action@V27
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -49,7 +50,7 @@ jobs:
with:
fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
- name: Install Nix
uses: cachix/install-nix-action@v25
uses: cachix/install-nix-action@V27
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -66,7 +67,7 @@ jobs:
- name: Checkout
uses: actions/checkout@v4
- name: Install Nix
uses: cachix/install-nix-action@v25
uses: cachix/install-nix-action@V27
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -79,20 +80,41 @@ jobs:
- name: Checkout
uses: actions/checkout@v4
- name: Install Nix
uses: cachix/install-nix-action@v25
uses: cachix/install-nix-action@V27
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
- name: Run Fantomas
run: nix run .#fantomas -- --check .
check-accurate-generations:
runs-on: ubuntu-latest
steps:
- name: Checkout
uses: actions/checkout@v4
with:
fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
- name: Install Nix
uses: cachix/install-nix-action@V27
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
- name: Whitespace change
run: "echo ' ' >> ConsumePlugin/List.fs"
- name: Generate code
run: nix develop --command dotnet build
- name: Run Fantomas
run: nix run .#fantomas -- .
- name: Verify there is no diff
run: git diff --name-only --no-color --exit-code
check-nix-format:
runs-on: ubuntu-latest
steps:
- name: Checkout
uses: actions/checkout@v4
- name: Install Nix
uses: cachix/install-nix-action@v25
uses: cachix/install-nix-action@V27
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -105,7 +127,7 @@ jobs:
steps:
- uses: actions/checkout@master
- name: Install Nix
uses: cachix/install-nix-action@v25
uses: cachix/install-nix-action@V27
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -118,7 +140,7 @@ jobs:
steps:
- uses: actions/checkout@master
- name: Install Nix
uses: cachix/install-nix-action@v25
uses: cachix/install-nix-action@V27
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -132,7 +154,7 @@ jobs:
with:
fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
- name: Install Nix
uses: cachix/install-nix-action@v25
uses: cachix/install-nix-action@V27
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -174,8 +196,27 @@ jobs:
# Verify that there is exactly one nupkg in the artifact that would be NuGet published
run: if [[ $(find packed-attribute -maxdepth 1 -name 'WoofWare.Myriad.Plugins.Attributes.*.nupkg' -printf c | wc -c) -ne "1" ]]; then exit 1; fi
github-release-plugin-dry-run:
needs: [nuget-pack]
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v4
- name: Download NuGet artifact (plugin)
uses: actions/download-artifact@v4
with:
name: nuget-package-plugin
- name: Download NuGet artifact (attribute)
uses: actions/download-artifact@v4
with:
name: nuget-package-attribute
- name: Tag and release plugin
env:
DRY_RUN: 1
GITHUB_TOKEN: mock-token
run: sh .github/workflows/tag.sh
all-required-checks-complete:
needs: [check-dotnet-format, check-nix-format, build, build-nix, linkcheck, flake-check, analyzers, nuget-pack, expected-pack]
needs: [check-dotnet-format, check-nix-format, check-accurate-generations, build, build-nix, linkcheck, flake-check, analyzers, nuget-pack, expected-pack, github-release-plugin-dry-run]
runs-on: ubuntu-latest
steps:
- run: echo "All required checks complete."
@@ -188,7 +229,7 @@ jobs:
steps:
- uses: actions/checkout@v4
- name: Install Nix
uses: cachix/install-nix-action@v25
uses: cachix/install-nix-action@V27
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}

View File

@@ -1,6 +1,13 @@
#!/bin/sh
#!/bin/bash
find . -maxdepth 1 -type f -name '*.nupkg' -exec sh -c 'tag=$(basename "$1" .nupkg); git tag "$tag"; git push origin "$tag"' shell {} \;
echo "Dry-run? $DRY_RUN!"
find . -maxdepth 1 -type f ! -name "$(printf "*\n*")" -name '*.nupkg' | while IFS= read -r file
do
tag=$(basename "$file" .nupkg)
git tag "$tag"
${DRY_RUN:+echo} git push origin "$tag"
done
export TAG
TAG=$(find . -maxdepth 1 -type f -name 'WoofWare.Myriad.Plugins.*.nupkg' -exec sh -c 'basename "$1" .nupkg' shell {} \; | grep -v Attributes)
@@ -14,4 +21,100 @@ case "$TAG" in
esac
# target_commitish empty indicates the repo default branch
curl -L -X POST -H "Accept: application/vnd.github+json" -H "Authorization: Bearer $GITHUB_TOKEN" -H "X-GitHub-Api-Version: 2022-11-28" https://api.github.com/repos/Smaug123/WoofWare.Myriad/releases -d '{"tag_name":"'"$TAG"'","target_commitish":"","name":"'"$TAG"'","draft":false,"prerelease":false,"generate_release_notes":false}'
curl_body='{"tag_name":"'"$TAG"'","target_commitish":"","name":"'"$TAG"'","draft":false,"prerelease":false,"generate_release_notes":false}'
echo "cURL body: $curl_body"
failed_output=$(cat <<'EOF'
{
"message": "Validation Failed",
"errors": [
{
"resource": "Release",
"code": "already_exists",
"field": "tag_name"
}
],
"documentation_url": "https://docs.github.com/rest/releases/releases#create-a-release"
}
EOF
)
success_output=$(cat <<'EOF'
{
"url": "https://api.github.com/repos/Smaug123/WoofWare.Myriad/releases/158152116",
"assets_url": "https://api.github.com/repos/Smaug123/WoofWare.Myriad/releases/158152116/assets",
"upload_url": "https://uploads.github.com/repos/Smaug123/WoofWare.Myriad/releases/158152116/assets{?name,label}",
"html_url": "https://github.com/Smaug123/WoofWare.Myriad/releases/tag/WoofWare.Myriad.Plugins.2.1.30",
"id": 158152116,
"author": {
"login": "github-actions[bot]",
"id": 41898282,
"node_id": "MDM6Qm90NDE4OTgyODI=",
"avatar_url": "https://avatars.githubusercontent.com/in/15368?v=4",
"gravatar_id": "",
"url": "https://api.github.com/users/github-actions%5Bbot%5D",
"html_url": "https://github.com/apps/github-actions",
"followers_url": "https://api.github.com/users/github-actions%5Bbot%5D/followers",
"following_url": "https://api.github.com/users/github-actions%5Bbot%5D/following{/other_user}",
"gists_url": "https://api.github.com/users/github-actions%5Bbot%5D/gists{/gist_id}",
"starred_url": "https://api.github.com/users/github-actions%5Bbot%5D/starred{/owner}{/repo}",
"subscriptions_url": "https://api.github.com/users/github-actions%5Bbot%5D/subscriptions",
"organizations_url": "https://api.github.com/users/github-actions%5Bbot%5D/orgs",
"repos_url": "https://api.github.com/users/github-actions%5Bbot%5D/repos",
"events_url": "https://api.github.com/users/github-actions%5Bbot%5D/events{/privacy}",
"received_events_url": "https://api.github.com/users/github-actions%5Bbot%5D/received_events",
"type": "Bot",
"site_admin": false
},
"node_id": "RE_kwDOJfksgc4JbTW0",
"tag_name": "WoofWare.Myriad.Plugins.2.1.30",
"target_commitish": "main",
"name": "WoofWare.Myriad.Plugins.2.1.30",
"draft": false,
"prerelease": false,
"created_at": "2024-05-30T11:00:55Z",
"published_at": "2024-05-30T11:03:02Z",
"assets": [
],
"tarball_url": "https://api.github.com/repos/Smaug123/WoofWare.Myriad/tarball/WoofWare.Myriad.Plugins.2.1.30",
"zipball_url": "https://api.github.com/repos/Smaug123/WoofWare.Myriad/zipball/WoofWare.Myriad.Plugins.2.1.30",
"body": null
}
EOF
)
HANDLE_OUTPUT=''
handle_error() {
ERROR_OUTPUT="$1"
exit_message=$(echo "$ERROR_OUTPUT" | jq -r --exit-status 'if .errors | length == 1 then .errors[0].code else null end')
if [ "$exit_message" = "already_exists" ] ; then
HANDLE_OUTPUT="Did not create GitHub release because it already exists at this version."
else
echo "Unexpected error output from curl: $(cat curl_output.json)"
echo "JQ output: $(exit_message)"
exit 2
fi
}
run_tests() {
handle_error "$failed_output"
if [ "$HANDLE_OUTPUT" != "Did not create GitHub release because it already exists at this version." ]; then
echo "Bad output from handler: $HANDLE_OUTPUT"
exit 3
fi
HANDLE_OUTPUT=''
echo "Tests passed."
}
run_tests
if [ "$DRY_RUN" != 1 ] ; then
if curl --fail-with-body -L -X POST -H "Accept: application/vnd.github+json" -H "Authorization: Bearer $GITHUB_TOKEN" -H "X-GitHub-Api-Version: 2022-11-28" https://api.github.com/repos/Smaug123/WoofWare.Myriad/releases -d "$curl_body" > curl_output.json; then
echo "Curl succeeded."
else
handle_error "$(cat curl_output.json)"
echo "$HANDLE_OUTPUT"
fi
fi

View File

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

View File

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

View File

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

View File

@@ -13,7 +13,7 @@ namespace ConsumePlugin
module InnerType =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : InnerType =
let Thing =
let arg_0 =
(match node.[(Literals.something)] with
| null ->
raise (
@@ -26,7 +26,7 @@ module InnerType =
.GetValue<string> ()
{
Thing = Thing
Thing = arg_0
}
namespace ConsumePlugin
@@ -36,7 +36,7 @@ namespace ConsumePlugin
module JsonRecordType =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordType =
let F =
let arg_5 =
(match node.["f"] with
| null ->
raise (
@@ -49,7 +49,7 @@ module JsonRecordType =
|> Seq.map (fun elt -> elt.AsValue().GetValue<int> ())
|> Array.ofSeq
let E =
let arg_4 =
(match node.["e"] with
| null ->
raise (
@@ -62,7 +62,7 @@ module JsonRecordType =
|> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
|> Array.ofSeq
let D =
let arg_3 =
InnerType.jsonParse (
match node.["d"] with
| null ->
@@ -74,7 +74,7 @@ module JsonRecordType =
| v -> v
)
let C =
let arg_2 =
(match node.["hi"] with
| null ->
raise (
@@ -87,7 +87,7 @@ module JsonRecordType =
|> Seq.map (fun elt -> elt.AsValue().GetValue<int> ())
|> List.ofSeq
let B =
let arg_1 =
(match node.["another-thing"] with
| null ->
raise (
@@ -99,7 +99,7 @@ module JsonRecordType =
.AsValue()
.GetValue<string> ()
let A =
let arg_0 =
(match node.["a"] with
| null ->
raise (
@@ -112,12 +112,12 @@ module JsonRecordType =
.GetValue<int> ()
{
A = A
B = B
C = C
D = D
E = E
F = F
A = arg_0
B = arg_1
C = arg_2
D = arg_3
E = arg_4
F = arg_5
}
namespace ConsumePlugin
@@ -129,24 +129,230 @@ module ToGetExtensionMethodJsonParseExtension =
/// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : ToGetExtensionMethod =
let Sailor =
(match node.["sailor"] with
let arg_20 = System.Numerics.BigInteger.Parse (node.["whiskey"].ToJsonString ())
let arg_19 =
(match node.["victor"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("sailor")
sprintf "Required key '%s' not found on JSON object" ("victor")
)
)
| v -> v)
.AsValue()
.GetValue<System.Char> ()
let arg_18 =
(match node.["uniform"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("uniform")
)
)
| v -> v)
.AsValue()
.GetValue<System.Decimal> ()
let arg_17 =
(match node.["tango"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("tango")
)
)
| v -> v)
.AsValue()
.GetValue<System.SByte> ()
let arg_16 =
(match node.["quebec"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("quebec")
)
)
| v -> v)
.AsValue()
.GetValue<System.Byte> ()
let arg_15 =
(match node.["papa"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("papa")
)
)
| v -> v)
.AsValue()
.GetValue<System.Byte> ()
let arg_14 =
(match node.["oscar"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("oscar")
)
)
| v -> v)
.AsValue()
.GetValue<System.SByte> ()
let arg_13 =
(match node.["november"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("november")
)
)
| v -> v)
.AsValue()
.GetValue<System.UInt16> ()
let arg_12 =
(match node.["mike"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("mike")
)
)
| v -> v)
.AsValue()
.GetValue<System.Int16> ()
let arg_11 =
(match node.["lima"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lima")
)
)
| v -> v)
.AsValue()
.GetValue<System.UInt32> ()
let arg_10 =
(match node.["kilo"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("kilo")
)
)
| v -> v)
.AsValue()
.GetValue<System.Int32> ()
let arg_9 =
(match node.["juliette"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("juliette")
)
)
| v -> v)
.AsValue()
.GetValue<System.UInt32> ()
let arg_8 =
(match node.["india"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("india")
)
)
| v -> v)
.AsValue()
.GetValue<int> ()
let arg_7 =
(match node.["hotel"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("hotel")
)
)
| v -> v)
.AsValue()
.GetValue<System.UInt64> ()
let arg_6 =
(match node.["golf"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("golf")
)
)
| v -> v)
.AsValue()
.GetValue<System.Int64> ()
let arg_5 =
(match node.["foxtrot"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("foxtrot")
)
)
| v -> v)
.AsValue()
.GetValue<System.Double> ()
let arg_4 =
(match node.["echo"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("echo")
)
)
| v -> v)
.AsValue()
.GetValue<System.Single> ()
let arg_3 =
(match node.["delta"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("delta")
)
)
| v -> v)
.AsValue()
.GetValue<System.Single> ()
let arg_2 =
(match node.["charlie"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("charlie")
)
)
| v -> v)
.AsValue()
.GetValue<float> ()
let Soldier =
(match node.["soldier"] with
let arg_1 =
(match node.["bravo"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("soldier")
sprintf "Required key '%s' not found on JSON object" ("bravo")
)
)
| v -> v)
@@ -154,24 +360,12 @@ module ToGetExtensionMethodJsonParseExtension =
.GetValue<string> ()
|> System.Uri
let Tailor =
(match node.["tailor"] with
let arg_0 =
(match node.["alpha"] 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")
sprintf "Required key '%s' not found on JSON object" ("alpha")
)
)
| v -> v)
@@ -179,8 +373,25 @@ module ToGetExtensionMethodJsonParseExtension =
.GetValue<string> ()
{
Tinker = Tinker
Tailor = Tailor
Soldier = Soldier
Sailor = Sailor
Alpha = arg_0
Bravo = arg_1
Charlie = arg_2
Delta = arg_3
Echo = arg_4
Foxtrot = arg_5
Golf = arg_6
Hotel = arg_7
India = arg_8
Juliette = arg_9
Kilo = arg_10
Lima = arg_11
Mike = arg_12
November = arg_13
Oscar = arg_14
Papa = arg_15
Quebec = arg_16
Tango = arg_17
Uniform = arg_18
Victor = arg_19
Whiskey = arg_20
}

View File

@@ -5,6 +5,7 @@
namespace SomeNamespace
open System
open WoofWare.Myriad.Plugins
/// Mock record type for an interface
@@ -18,17 +19,18 @@ type internal PublicTypeMock =
/// An implementation where every method throws.
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"))
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem3 = (fun _ -> 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.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
open System
open WoofWare.Myriad.Plugins
/// Mock record type for an interface
@@ -42,17 +44,18 @@ type public PublicTypeInternalFalseMock =
/// An implementation where every method throws.
static member Empty : PublicTypeInternalFalseMock =
{
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"))
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem3 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
}
interface IPublicTypeInternalFalse 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.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
open System
open WoofWare.Myriad.Plugins
/// Mock record type for an interface
@@ -65,15 +68,16 @@ type internal InternalTypeMock =
/// An implementation where every method throws.
static member Empty : InternalTypeMock =
{
Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun _ -> 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)
member this.Mem2 arg_0_0 = this.Mem2 (arg_0_0)
namespace SomeNamespace
open System
open WoofWare.Myriad.Plugins
/// Mock record type for an interface
@@ -86,15 +90,16 @@ type private PrivateTypeMock =
/// An implementation where every method throws.
static member Empty : PrivateTypeMock =
{
Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun _ -> 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)
member this.Mem2 arg_0_0 = this.Mem2 (arg_0_0)
namespace SomeNamespace
open System
open WoofWare.Myriad.Plugins
/// Mock record type for an interface
@@ -107,15 +112,16 @@ type private PrivateTypeInternalFalseMock =
/// An implementation where every method throws.
static member Empty : PrivateTypeInternalFalseMock =
{
Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
}
interface PrivateTypeInternalFalse 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.Mem2 arg_0_0 = this.Mem2 (arg_0_0)
namespace SomeNamespace
open System
open WoofWare.Myriad.Plugins
/// Mock record type for an interface
@@ -127,13 +133,14 @@ type internal VeryPublicTypeMock<'a, 'b> =
/// An implementation where every method throws.
static member Empty () : VeryPublicTypeMock<'a, 'b> =
{
Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
}
interface VeryPublicType<'a, 'b> with
member this.Mem1 (arg_0_0) = this.Mem1 (arg_0_0)
member this.Mem1 arg_0_0 = this.Mem1 (arg_0_0)
namespace SomeNamespace
open System
open WoofWare.Myriad.Plugins
/// Mock record type for an interface
@@ -150,18 +157,18 @@ type internal CurriedMock<'a> =
/// An implementation where every method throws.
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"))
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem3 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem4 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem5 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem6 = (fun _ -> 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.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)
@@ -171,3 +178,31 @@ type internal CurriedMock<'a> =
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)
namespace SomeNamespace
open System
open WoofWare.Myriad.Plugins
/// Mock record type for an interface
type internal TypeWithInterfaceMock =
{
/// Implementation of IDisposable.Dispose
Dispose : unit -> unit
Mem1 : string option -> string[] Async
Mem2 : unit -> string[] Async
}
/// An implementation where every method throws.
static member Empty : TypeWithInterfaceMock =
{
Dispose = (fun _ -> ())
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
}
interface TypeWithInterface with
member this.Mem1 arg_0_0 = this.Mem1 (arg_0_0)
member this.Mem2 () = this.Mem2 (())
interface System.IDisposable with
member this.Dispose () : unit = this.Dispose ()

View File

@@ -46,7 +46,7 @@ namespace PureGym
module GymOpeningHours =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : GymOpeningHours =
let OpeningHours =
let arg_1 =
(match node.["openingHours"] with
| null ->
raise (
@@ -59,7 +59,7 @@ module GymOpeningHours =
|> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
|> List.ofSeq
let IsAlwaysOpen =
let arg_0 =
(match node.["isAlwaysOpen"] with
| null ->
raise (
@@ -72,8 +72,8 @@ module GymOpeningHours =
.GetValue<bool> ()
{
IsAlwaysOpen = IsAlwaysOpen
OpeningHours = OpeningHours
IsAlwaysOpen = arg_0
OpeningHours = arg_1
}
namespace PureGym
@@ -83,7 +83,7 @@ namespace PureGym
module GymAccessOptions =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : GymAccessOptions =
let QrCodeAccess =
let arg_1 =
(match node.["qrCodeAccess"] with
| null ->
raise (
@@ -95,7 +95,7 @@ module GymAccessOptions =
.AsValue()
.GetValue<bool> ()
let PinAccess =
let arg_0 =
(match node.["pinAccess"] with
| null ->
raise (
@@ -108,8 +108,8 @@ module GymAccessOptions =
.GetValue<bool> ()
{
PinAccess = PinAccess
QrCodeAccess = QrCodeAccess
PinAccess = arg_0
QrCodeAccess = arg_1
}
namespace PureGym
@@ -119,7 +119,7 @@ namespace PureGym
module GymLocation =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : GymLocation =
let Latitude =
let arg_1 =
try
(match node.["latitude"] with
| null ->
@@ -152,7 +152,7 @@ module GymLocation =
else
reraise ()
let Longitude =
let arg_0 =
try
(match node.["longitude"] with
| null ->
@@ -186,8 +186,8 @@ module GymLocation =
reraise ()
{
Longitude = Longitude
Latitude = Latitude
Longitude = arg_0
Latitude = arg_1
}
namespace PureGym
@@ -197,7 +197,7 @@ namespace PureGym
module GymAddress =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : GymAddress =
let Postcode =
let arg_5 =
(match node.["postcode"] with
| null ->
raise (
@@ -209,12 +209,12 @@ module GymAddress =
.AsValue()
.GetValue<string> ()
let County =
let arg_4 =
match node.["county"] with
| null -> None
| v -> v.AsValue().GetValue<string> () |> Some
let Town =
let arg_3 =
(match node.["town"] with
| null ->
raise (
@@ -226,17 +226,17 @@ module GymAddress =
.AsValue()
.GetValue<string> ()
let AddressLine3 =
let arg_2 =
match node.["addressLine3"] with
| null -> None
| v -> v.AsValue().GetValue<string> () |> Some
let AddressLine2 =
let arg_1 =
match node.["addressLine2"] with
| null -> None
| v -> v.AsValue().GetValue<string> () |> Some
let AddressLine1 =
let arg_0 =
(match node.["addressLine1"] with
| null ->
raise (
@@ -249,12 +249,12 @@ module GymAddress =
.GetValue<string> ()
{
AddressLine1 = AddressLine1
AddressLine2 = AddressLine2
AddressLine3 = AddressLine3
Town = Town
County = County
Postcode = Postcode
AddressLine1 = arg_0
AddressLine2 = arg_1
AddressLine3 = arg_2
Town = arg_3
County = arg_4
Postcode = arg_5
}
namespace PureGym
@@ -264,7 +264,7 @@ namespace PureGym
module Gym =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : Gym =
let ReopenDate =
let arg_10 =
(match node.["reopenDate"] with
| null ->
raise (
@@ -276,7 +276,7 @@ module Gym =
.AsValue()
.GetValue<string> ()
let TimeZone =
let arg_9 =
(match node.["timeZone"] with
| null ->
raise (
@@ -288,7 +288,7 @@ module Gym =
.AsValue()
.GetValue<string> ()
let Location =
let arg_8 =
GymLocation.jsonParse (
match node.["location"] with
| null ->
@@ -300,7 +300,7 @@ module Gym =
| v -> v
)
let AccessOptions =
let arg_7 =
GymAccessOptions.jsonParse (
match node.["accessOptions"] with
| null ->
@@ -312,7 +312,7 @@ module Gym =
| v -> v
)
let GymOpeningHours =
let arg_6 =
GymOpeningHours.jsonParse (
match node.["gymOpeningHours"] with
| null ->
@@ -324,7 +324,7 @@ module Gym =
| v -> v
)
let EmailAddress =
let arg_5 =
(match node.["emailAddress"] with
| null ->
raise (
@@ -336,7 +336,7 @@ module Gym =
.AsValue()
.GetValue<string> ()
let PhoneNumber =
let arg_4 =
(match node.["phoneNumber"] with
| null ->
raise (
@@ -348,7 +348,7 @@ module Gym =
.AsValue()
.GetValue<string> ()
let Address =
let arg_3 =
GymAddress.jsonParse (
match node.["address"] with
| null ->
@@ -360,7 +360,7 @@ module Gym =
| v -> v
)
let Status =
let arg_2 =
(match node.["status"] with
| null ->
raise (
@@ -372,7 +372,7 @@ module Gym =
.AsValue()
.GetValue<int> ()
let Id =
let arg_1 =
(match node.["id"] with
| null ->
raise (
@@ -384,7 +384,7 @@ module Gym =
.AsValue()
.GetValue<int> ()
let Name =
let arg_0 =
(match node.["name"] with
| null ->
raise (
@@ -397,17 +397,17 @@ module Gym =
.GetValue<string> ()
{
Name = Name
Id = Id
Status = Status
Address = Address
PhoneNumber = PhoneNumber
EmailAddress = EmailAddress
GymOpeningHours = GymOpeningHours
AccessOptions = AccessOptions
Location = Location
TimeZone = TimeZone
ReopenDate = ReopenDate
Name = arg_0
Id = arg_1
Status = arg_2
Address = arg_3
PhoneNumber = arg_4
EmailAddress = arg_5
GymOpeningHours = arg_6
AccessOptions = arg_7
Location = arg_8
TimeZone = arg_9
ReopenDate = arg_10
}
namespace PureGym
@@ -419,7 +419,7 @@ module MemberJsonParseExtension =
/// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : Member =
let MemberStatus =
let arg_14 =
(match node.["memberStatus"] with
| null ->
raise (
@@ -431,7 +431,7 @@ module MemberJsonParseExtension =
.AsValue()
.GetValue<int> ()
let SuspendedReason =
let arg_13 =
(match node.["suspendedReason"] with
| null ->
raise (
@@ -443,7 +443,7 @@ module MemberJsonParseExtension =
.AsValue()
.GetValue<int> ()
let MembershipLevel =
let arg_12 =
(match node.["membershipLevel"] with
| null ->
raise (
@@ -455,7 +455,7 @@ module MemberJsonParseExtension =
.AsValue()
.GetValue<int> ()
let MembershipName =
let arg_11 =
(match node.["membershipName"] with
| null ->
raise (
@@ -467,7 +467,7 @@ module MemberJsonParseExtension =
.AsValue()
.GetValue<string> ()
let Postcode =
let arg_10 =
(match node.["postCode"] with
| null ->
raise (
@@ -479,7 +479,7 @@ module MemberJsonParseExtension =
.AsValue()
.GetValue<string> ()
let MobileNumber =
let arg_9 =
(match node.["mobileNumber"] with
| null ->
raise (
@@ -491,7 +491,7 @@ module MemberJsonParseExtension =
.AsValue()
.GetValue<string> ()
let DateOfBirth =
let arg_8 =
(match node.["dateofBirth"] with
| null ->
raise (
@@ -504,7 +504,7 @@ module MemberJsonParseExtension =
.GetValue<string> ()
|> System.DateOnly.Parse
let GymAccessPin =
let arg_7 =
(match node.["gymAccessPin"] with
| null ->
raise (
@@ -516,7 +516,7 @@ module MemberJsonParseExtension =
.AsValue()
.GetValue<string> ()
let EmailAddress =
let arg_6 =
(match node.["emailAddress"] with
| null ->
raise (
@@ -528,7 +528,7 @@ module MemberJsonParseExtension =
.AsValue()
.GetValue<string> ()
let HomeGymName =
let arg_5 =
(match node.["homeGymName"] with
| null ->
raise (
@@ -540,7 +540,7 @@ module MemberJsonParseExtension =
.AsValue()
.GetValue<string> ()
let HomeGymId =
let arg_4 =
(match node.["homeGymId"] with
| null ->
raise (
@@ -552,7 +552,7 @@ module MemberJsonParseExtension =
.AsValue()
.GetValue<int> ()
let LastName =
let arg_3 =
(match node.["lastName"] with
| null ->
raise (
@@ -564,7 +564,7 @@ module MemberJsonParseExtension =
.AsValue()
.GetValue<string> ()
let FirstName =
let arg_2 =
(match node.["firstName"] with
| null ->
raise (
@@ -576,7 +576,7 @@ module MemberJsonParseExtension =
.AsValue()
.GetValue<string> ()
let CompoundMemberId =
let arg_1 =
(match node.["compoundMemberId"] with
| null ->
raise (
@@ -588,7 +588,7 @@ module MemberJsonParseExtension =
.AsValue()
.GetValue<string> ()
let Id =
let arg_0 =
(match node.["id"] with
| null ->
raise (
@@ -601,21 +601,21 @@ module MemberJsonParseExtension =
.GetValue<int> ()
{
Id = Id
CompoundMemberId = CompoundMemberId
FirstName = FirstName
LastName = LastName
HomeGymId = HomeGymId
HomeGymName = HomeGymName
EmailAddress = EmailAddress
GymAccessPin = GymAccessPin
DateOfBirth = DateOfBirth
MobileNumber = MobileNumber
Postcode = Postcode
MembershipName = MembershipName
MembershipLevel = MembershipLevel
SuspendedReason = SuspendedReason
MemberStatus = MemberStatus
Id = arg_0
CompoundMemberId = arg_1
FirstName = arg_2
LastName = arg_3
HomeGymId = arg_4
HomeGymName = arg_5
EmailAddress = arg_6
GymAccessPin = arg_7
DateOfBirth = arg_8
MobileNumber = arg_9
Postcode = arg_10
MembershipName = arg_11
MembershipLevel = arg_12
SuspendedReason = arg_13
MemberStatus = arg_14
}
namespace PureGym
@@ -625,7 +625,7 @@ namespace PureGym
module GymAttendance =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : GymAttendance =
let MaximumCapacity =
let arg_8 =
(match node.["maximumCapacity"] with
| null ->
raise (
@@ -637,7 +637,7 @@ module GymAttendance =
.AsValue()
.GetValue<int> ()
let LastRefreshedPeopleInClasses =
let arg_7 =
(match node.["lastRefreshedPeopleInClasses"] with
| null ->
raise (
@@ -650,7 +650,7 @@ module GymAttendance =
.GetValue<string> ()
|> System.DateTime.Parse
let LastRefreshed =
let arg_6 =
(match node.["lastRefreshed"] with
| null ->
raise (
@@ -663,7 +663,7 @@ module GymAttendance =
.GetValue<string> ()
|> System.DateTime.Parse
let AttendanceTime =
let arg_5 =
(match node.["attendanceTime"] with
| null ->
raise (
@@ -676,7 +676,7 @@ module GymAttendance =
.GetValue<string> ()
|> System.DateTime.Parse
let IsApproximate =
let arg_4 =
(match node.["isApproximate"] with
| null ->
raise (
@@ -688,12 +688,12 @@ module GymAttendance =
.AsValue()
.GetValue<bool> ()
let TotalPeopleSuffix =
let arg_3 =
match node.["totalPeopleSuffix"] with
| null -> None
| v -> v.AsValue().GetValue<string> () |> Some
let TotalPeopleInClasses =
let arg_2 =
(match node.["totalPeopleInClasses"] with
| null ->
raise (
@@ -705,7 +705,7 @@ module GymAttendance =
.AsValue()
.GetValue<int> ()
let TotalPeopleInGym =
let arg_1 =
(match node.["totalPeopleInGym"] with
| null ->
raise (
@@ -717,7 +717,7 @@ module GymAttendance =
.AsValue()
.GetValue<int> ()
let Description =
let arg_0 =
(match node.["description"] with
| null ->
raise (
@@ -730,15 +730,15 @@ module GymAttendance =
.GetValue<string> ()
{
Description = Description
TotalPeopleInGym = TotalPeopleInGym
TotalPeopleInClasses = TotalPeopleInClasses
TotalPeopleSuffix = TotalPeopleSuffix
IsApproximate = IsApproximate
AttendanceTime = AttendanceTime
LastRefreshed = LastRefreshed
LastRefreshedPeopleInClasses = LastRefreshedPeopleInClasses
MaximumCapacity = MaximumCapacity
Description = arg_0
TotalPeopleInGym = arg_1
TotalPeopleInClasses = arg_2
TotalPeopleSuffix = arg_3
IsApproximate = arg_4
AttendanceTime = arg_5
LastRefreshed = arg_6
LastRefreshedPeopleInClasses = arg_7
MaximumCapacity = arg_8
}
namespace PureGym
@@ -748,7 +748,7 @@ namespace PureGym
module MemberActivityDto =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : MemberActivityDto =
let LastRefreshed =
let arg_5 =
(match node.["lastRefreshed"] with
| null ->
raise (
@@ -761,7 +761,7 @@ module MemberActivityDto =
.GetValue<string> ()
|> System.DateTime.Parse
let IsEstimated =
let arg_4 =
(match node.["isEstimated"] with
| null ->
raise (
@@ -773,7 +773,7 @@ module MemberActivityDto =
.AsValue()
.GetValue<bool> ()
let TotalClasses =
let arg_3 =
(match node.["totalClasses"] with
| null ->
raise (
@@ -785,7 +785,7 @@ module MemberActivityDto =
.AsValue()
.GetValue<int> ()
let TotalVisits =
let arg_2 =
(match node.["totalVisits"] with
| null ->
raise (
@@ -797,7 +797,7 @@ module MemberActivityDto =
.AsValue()
.GetValue<int> ()
let AverageDuration =
let arg_1 =
(match node.["averageDuration"] with
| null ->
raise (
@@ -809,7 +809,7 @@ module MemberActivityDto =
.AsValue()
.GetValue<int> ()
let TotalDuration =
let arg_0 =
(match node.["totalDuration"] with
| null ->
raise (
@@ -822,12 +822,12 @@ module MemberActivityDto =
.GetValue<int> ()
{
TotalDuration = TotalDuration
AverageDuration = AverageDuration
TotalVisits = TotalVisits
TotalClasses = TotalClasses
IsEstimated = IsEstimated
LastRefreshed = LastRefreshed
TotalDuration = arg_0
AverageDuration = arg_1
TotalVisits = arg_2
TotalClasses = arg_3
IsEstimated = arg_4
LastRefreshed = arg_5
}
namespace PureGym
@@ -837,7 +837,7 @@ namespace PureGym
module SessionsAggregate =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : SessionsAggregate =
let Duration =
let arg_2 =
(match node.["Duration"] with
| null ->
raise (
@@ -849,7 +849,7 @@ module SessionsAggregate =
.AsValue()
.GetValue<int> ()
let Visits =
let arg_1 =
(match node.["Visits"] with
| null ->
raise (
@@ -861,7 +861,7 @@ module SessionsAggregate =
.AsValue()
.GetValue<int> ()
let Activities =
let arg_0 =
(match node.["Activities"] with
| null ->
raise (
@@ -874,9 +874,9 @@ module SessionsAggregate =
.GetValue<int> ()
{
Activities = Activities
Visits = Visits
Duration = Duration
Activities = arg_0
Visits = arg_1
Duration = arg_2
}
namespace PureGym
@@ -886,7 +886,7 @@ namespace PureGym
module VisitGym =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : VisitGym =
let Status =
let arg_2 =
(match node.["Status"] with
| null ->
raise (
@@ -898,7 +898,7 @@ module VisitGym =
.AsValue()
.GetValue<string> ()
let Name =
let arg_1 =
(match node.["Name"] with
| null ->
raise (
@@ -910,7 +910,7 @@ module VisitGym =
.AsValue()
.GetValue<string> ()
let Id =
let arg_0 =
(match node.["Id"] with
| null ->
raise (
@@ -923,9 +923,9 @@ module VisitGym =
.GetValue<int> ()
{
Id = Id
Name = Name
Status = Status
Id = arg_0
Name = arg_1
Status = arg_2
}
namespace PureGym
@@ -935,7 +935,7 @@ namespace PureGym
module Visit =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : Visit =
let Gym =
let arg_3 =
VisitGym.jsonParse (
match node.["Gym"] with
| null ->
@@ -947,7 +947,7 @@ module Visit =
| v -> v
)
let Duration =
let arg_2 =
(match node.["Duration"] with
| null ->
raise (
@@ -959,7 +959,7 @@ module Visit =
.AsValue()
.GetValue<int> ()
let StartTime =
let arg_1 =
(match node.["StartTime"] with
| null ->
raise (
@@ -972,7 +972,7 @@ module Visit =
.GetValue<string> ()
|> System.DateTime.Parse
let IsDurationEstimated =
let arg_0 =
(match node.["IsDurationEstimated"] with
| null ->
raise (
@@ -985,10 +985,10 @@ module Visit =
.GetValue<bool> ()
{
IsDurationEstimated = IsDurationEstimated
StartTime = StartTime
Duration = Duration
Gym = Gym
IsDurationEstimated = arg_0
StartTime = arg_1
Duration = arg_2
Gym = arg_3
}
namespace PureGym
@@ -998,7 +998,7 @@ namespace PureGym
module SessionsSummary =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : SessionsSummary =
let ThisWeek =
let arg_1 =
SessionsAggregate.jsonParse (
match node.["ThisWeek"] with
| null ->
@@ -1010,7 +1010,7 @@ module SessionsSummary =
| v -> v
)
let Total =
let arg_0 =
SessionsAggregate.jsonParse (
match node.["Total"] with
| null ->
@@ -1023,8 +1023,8 @@ module SessionsSummary =
)
{
Total = Total
ThisWeek = ThisWeek
Total = arg_0
ThisWeek = arg_1
}
namespace PureGym
@@ -1034,7 +1034,7 @@ namespace PureGym
module Sessions =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : Sessions =
let Visits =
let arg_1 =
(match node.["Visits"] with
| null ->
raise (
@@ -1047,7 +1047,7 @@ module Sessions =
|> Seq.map (fun elt -> Visit.jsonParse elt)
|> List.ofSeq
let Summary =
let arg_0 =
SessionsSummary.jsonParse (
match node.["Summary"] with
| null ->
@@ -1060,8 +1060,8 @@ module Sessions =
)
{
Summary = Summary
Visits = Visits
Summary = arg_0
Visits = arg_1
}
namespace PureGym
@@ -1071,7 +1071,7 @@ namespace PureGym
module UriThing =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : UriThing =
let SomeUri =
let arg_0 =
(match node.["someUri"] with
| null ->
raise (
@@ -1085,5 +1085,5 @@ module UriThing =
|> System.Uri
{
SomeUri = SomeUri
SomeUri = arg_0
}

View File

@@ -87,6 +87,40 @@ module PureGymApi =
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.GetGymAttendance' (gymId : int, 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 (
"v1/gyms/{gym_id}/attendance"
.Replace ("{gym_id}", gymId.ToString () |> System.Web.HttpUtility.UrlEncode),
System.UriKind.Relative
)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
let! jsonNode =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
return GymAttendance.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.GetMember (ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
@@ -288,7 +322,52 @@ module PureGymApi =
| v -> v),
System.Uri (
("/v2/gymSessions/member"
+ "?fromDate="
+ (if "/v2/gymSessions/member".IndexOf (char 63) >= 0 then
"&"
else
"?")
+ "fromDate="
+ ((fromDate.ToString "yyyy-MM-dd") |> System.Web.HttpUtility.UrlEncode)
+ "&toDate="
+ ((toDate.ToString "yyyy-MM-dd") |> System.Web.HttpUtility.UrlEncode)),
System.UriKind.Relative
)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
let! jsonNode =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
return Sessions.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.GetSessionsWithQuery (fromDate : DateOnly, toDate : DateOnly, 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 (
("/v2/gymSessions/member?foo=1"
+ (if "/v2/gymSessions/member?foo=1".IndexOf (char 63) >= 0 then
"&"
else
"?")
+ "fromDate="
+ ((fromDate.ToString "yyyy-MM-dd") |> System.Web.HttpUtility.UrlEncode)
+ "&toDate="
+ ((toDate.ToString "yyyy-MM-dd") |> System.Web.HttpUtility.UrlEncode)),
@@ -1140,6 +1219,69 @@ module ApiWithHeaders =
member _.SomeHeader : string = someHeader ()
member _.SomeOtherHeader : int = someOtherHeader ()
member this.GetPathParam (parameter : string, ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
(match client.BaseAddress with
| null ->
raise (
System.ArgumentNullException (
nameof (client.BaseAddress),
"No base address was supplied on the type, and no BaseAddress was on the HttpClient."
)
)
| v -> v),
System.Uri (
"endpoint/{param}"
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
System.UriKind.Relative
)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
do httpMessage.Headers.Add ("X-Foo", this.SomeHeader.ToString ())
do httpMessage.Headers.Add ("Authorization", this.SomeOtherHeader.ToString ())
do httpMessage.Headers.Add ("Header-Name", "Header-Value")
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! responseString = response.Content.ReadAsStringAsync ct |> Async.AwaitTask
return responseString
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
}
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 ApiWithHeaders2 =
/// Create a REST client. The input functions will be re-evaluated on every HTTP request to obtain the required values for the corresponding header properties.
let make
(someHeader : unit -> string)
(someOtherHeader : unit -> int)
(client : System.Net.Http.HttpClient)
: IApiWithHeaders2
=
{ new IApiWithHeaders2 with
member _.SomeHeader : string = someHeader ()
member _.SomeOtherHeader : int = someOtherHeader ()
member this.GetPathParam (parameter : string, ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken

View File

@@ -149,6 +149,37 @@ module JsonRecordTypeWithBothJsonSerializeExtension =
)
node :> _
namespace ConsumePlugin
open System
open System.Collections.Generic
open System.Text.Json.Serialization
/// Module containing JSON serializing extension members for the FirstDu type
[<AutoOpen>]
module FirstDuJsonSerializeExtension =
/// Extension methods for JSON parsing
type FirstDu with
/// Serialize to a JSON node
static member toJsonNode (input : FirstDu) : System.Text.Json.Nodes.JsonNode =
let node = System.Text.Json.Nodes.JsonObject ()
match input with
| FirstDu.EmptyCase -> node.Add ("type", System.Text.Json.Nodes.JsonValue.Create "emptyCase")
| FirstDu.Case1 (arg0) ->
node.Add ("type", System.Text.Json.Nodes.JsonValue.Create "case1")
let dataNode = System.Text.Json.Nodes.JsonObject ()
dataNode.Add ("data", System.Text.Json.Nodes.JsonValue.Create<string> arg0)
node.Add ("data", dataNode)
| FirstDu.Case2 (arg0, arg1) ->
node.Add ("type", System.Text.Json.Nodes.JsonValue.Create "case2")
let dataNode = System.Text.Json.Nodes.JsonObject ()
dataNode.Add ("record", JsonRecordTypeWithBoth.toJsonNode arg0)
dataNode.Add ("i", System.Text.Json.Nodes.JsonValue.Create<int> arg1)
node.Add ("data", dataNode)
node :> _
namespace ConsumePlugin
@@ -160,7 +191,7 @@ module InnerTypeWithBothJsonParseExtension =
/// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : InnerTypeWithBoth =
let ConcreteDict =
let arg_4 =
(match node.["concreteDict"] with
| null ->
raise (
@@ -178,7 +209,7 @@ module InnerTypeWithBothJsonParseExtension =
|> Seq.map System.Collections.Generic.KeyValuePair
|> System.Collections.Generic.Dictionary
let Dict =
let arg_3 =
(match node.["dict"] with
| null ->
raise (
@@ -195,7 +226,7 @@ module InnerTypeWithBothJsonParseExtension =
)
|> dict
let ReadOnlyDict =
let arg_2 =
(match node.["readOnlyDict"] with
| null ->
raise (
@@ -210,14 +241,14 @@ module InnerTypeWithBothJsonParseExtension =
let value =
(kvp.Value).AsArray ()
|> Seq.map (fun elt -> elt.AsValue().GetValue<char> ())
|> Seq.map (fun elt -> elt.AsValue().GetValue<System.Char> ())
|> List.ofSeq
key, value
)
|> readOnlyDict
let Map =
let arg_1 =
(match node.["map"] with
| null ->
raise (
@@ -234,7 +265,7 @@ module InnerTypeWithBothJsonParseExtension =
)
|> Map.ofSeq
let Thing =
let arg_0 =
(match node.[("it's-a-me")] with
| null ->
raise (
@@ -248,11 +279,11 @@ module InnerTypeWithBothJsonParseExtension =
|> System.Guid.Parse
{
Thing = Thing
Map = Map
ReadOnlyDict = ReadOnlyDict
Dict = Dict
ConcreteDict = ConcreteDict
Thing = arg_0
Map = arg_1
ReadOnlyDict = arg_2
Dict = arg_3
ConcreteDict = arg_4
}
namespace ConsumePlugin
@@ -264,7 +295,7 @@ module JsonRecordTypeWithBothJsonParseExtension =
/// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordTypeWithBoth =
let F =
let arg_5 =
(match node.["f"] with
| null ->
raise (
@@ -277,7 +308,7 @@ module JsonRecordTypeWithBothJsonParseExtension =
|> Seq.map (fun elt -> elt.AsValue().GetValue<int> ())
|> Array.ofSeq
let E =
let arg_4 =
(match node.["e"] with
| null ->
raise (
@@ -290,7 +321,7 @@ module JsonRecordTypeWithBothJsonParseExtension =
|> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
|> Array.ofSeq
let D =
let arg_3 =
InnerTypeWithBoth.jsonParse (
match node.["d"] with
| null ->
@@ -302,7 +333,7 @@ module JsonRecordTypeWithBothJsonParseExtension =
| v -> v
)
let C =
let arg_2 =
(match node.["c"] with
| null ->
raise (
@@ -315,7 +346,7 @@ module JsonRecordTypeWithBothJsonParseExtension =
|> Seq.map (fun elt -> elt.AsValue().GetValue<int> ())
|> List.ofSeq
let B =
let arg_1 =
(match node.["b"] with
| null ->
raise (
@@ -327,7 +358,7 @@ module JsonRecordTypeWithBothJsonParseExtension =
.AsValue()
.GetValue<string> ()
let A =
let arg_0 =
(match node.["a"] with
| null ->
raise (
@@ -340,10 +371,90 @@ module JsonRecordTypeWithBothJsonParseExtension =
.GetValue<int> ()
{
A = A
B = B
C = C
D = D
E = E
F = F
A = arg_0
B = arg_1
C = arg_2
D = arg_3
E = arg_4
F = arg_5
}
namespace ConsumePlugin
/// Module containing JSON parsing extension members for the FirstDu type
[<AutoOpen>]
module FirstDuJsonParseExtension =
/// Extension methods for JSON parsing
type FirstDu with
/// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : FirstDu =
let ty =
(match node.["type"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("type")
)
)
| v -> v)
|> (fun v -> v.GetValue<string> ())
match ty with
| "emptyCase" -> FirstDu.EmptyCase
| "case1" ->
let node =
(match node.["data"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data")
)
)
| v -> v)
FirstDu.Case1 (
(match node.["data"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
)
| "case2" ->
let node =
(match node.["data"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data")
)
)
| v -> v)
FirstDu.Case2 (
JsonRecordTypeWithBoth.jsonParse (
match node.["record"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("record")
)
)
| v -> v
),
(match node.["i"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("i")
)
)
| v -> v)
.AsValue()
.GetValue<int> ()
)
| v -> failwith ("Unrecognised 'type' field value: " + v)

View File

@@ -13,7 +13,7 @@ namespace ConsumePlugin
module JwtVaultAuthResponse =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultAuthResponse =
let NumUses =
let arg_10 =
(match node.["num_uses"] with
| null ->
raise (
@@ -25,7 +25,7 @@ module JwtVaultAuthResponse =
.AsValue()
.GetValue<int> ()
let Orphan =
let arg_9 =
(match node.["orphan"] with
| null ->
raise (
@@ -37,7 +37,7 @@ module JwtVaultAuthResponse =
.AsValue()
.GetValue<bool> ()
let EntityId =
let arg_8 =
(match node.["entity_id"] with
| null ->
raise (
@@ -49,7 +49,7 @@ module JwtVaultAuthResponse =
.AsValue()
.GetValue<string> ()
let TokenType =
let arg_7 =
(match node.["token_type"] with
| null ->
raise (
@@ -61,7 +61,7 @@ module JwtVaultAuthResponse =
.AsValue()
.GetValue<string> ()
let Renewable =
let arg_6 =
(match node.["renewable"] with
| null ->
raise (
@@ -73,7 +73,7 @@ module JwtVaultAuthResponse =
.AsValue()
.GetValue<bool> ()
let LeaseDuration =
let arg_5 =
(match node.["lease_duration"] with
| null ->
raise (
@@ -85,7 +85,7 @@ module JwtVaultAuthResponse =
.AsValue()
.GetValue<int> ()
let IdentityPolicies =
let arg_4 =
(match node.["identity_policies"] with
| null ->
raise (
@@ -98,7 +98,7 @@ module JwtVaultAuthResponse =
|> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
|> List.ofSeq
let TokenPolicies =
let arg_3 =
(match node.["token_policies"] with
| null ->
raise (
@@ -111,7 +111,7 @@ module JwtVaultAuthResponse =
|> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
|> List.ofSeq
let Policies =
let arg_2 =
(match node.["policies"] with
| null ->
raise (
@@ -124,7 +124,7 @@ module JwtVaultAuthResponse =
|> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
|> List.ofSeq
let Accessor =
let arg_1 =
(match node.["accessor"] with
| null ->
raise (
@@ -136,7 +136,7 @@ module JwtVaultAuthResponse =
.AsValue()
.GetValue<string> ()
let ClientToken =
let arg_0 =
(match node.["client_token"] with
| null ->
raise (
@@ -149,17 +149,17 @@ module JwtVaultAuthResponse =
.GetValue<string> ()
{
ClientToken = ClientToken
Accessor = Accessor
Policies = Policies
TokenPolicies = TokenPolicies
IdentityPolicies = IdentityPolicies
LeaseDuration = LeaseDuration
Renewable = Renewable
TokenType = TokenType
EntityId = EntityId
Orphan = Orphan
NumUses = NumUses
ClientToken = arg_0
Accessor = arg_1
Policies = arg_2
TokenPolicies = arg_3
IdentityPolicies = arg_4
LeaseDuration = arg_5
Renewable = arg_6
TokenType = arg_7
EntityId = arg_8
Orphan = arg_9
NumUses = arg_10
}
namespace ConsumePlugin
@@ -169,7 +169,7 @@ namespace ConsumePlugin
module JwtVaultResponse =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultResponse =
let Auth =
let arg_4 =
JwtVaultAuthResponse.jsonParse (
match node.["auth"] with
| null ->
@@ -181,7 +181,7 @@ module JwtVaultResponse =
| v -> v
)
let LeaseDuration =
let arg_3 =
(match node.["lease_duration"] with
| null ->
raise (
@@ -193,7 +193,7 @@ module JwtVaultResponse =
.AsValue()
.GetValue<int> ()
let Renewable =
let arg_2 =
(match node.["renewable"] with
| null ->
raise (
@@ -205,7 +205,7 @@ module JwtVaultResponse =
.AsValue()
.GetValue<bool> ()
let LeaseId =
let arg_1 =
(match node.["lease_id"] with
| null ->
raise (
@@ -217,7 +217,7 @@ module JwtVaultResponse =
.AsValue()
.GetValue<string> ()
let RequestId =
let arg_0 =
(match node.["request_id"] with
| null ->
raise (
@@ -230,11 +230,11 @@ module JwtVaultResponse =
.GetValue<string> ()
{
RequestId = RequestId
LeaseId = LeaseId
Renewable = Renewable
LeaseDuration = LeaseDuration
Auth = Auth
RequestId = arg_0
LeaseId = arg_1
Renewable = arg_2
LeaseDuration = arg_3
Auth = arg_4
}
namespace ConsumePlugin
@@ -244,7 +244,7 @@ namespace ConsumePlugin
module JwtSecretResponse =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtSecretResponse =
let Data8 =
let arg_11 =
(match node.["data8"] with
| null ->
raise (
@@ -262,7 +262,7 @@ module JwtSecretResponse =
|> Seq.map System.Collections.Generic.KeyValuePair
|> System.Collections.Generic.Dictionary
let Data7 =
let arg_10 =
(match node.["data7"] with
| null ->
raise (
@@ -279,7 +279,7 @@ module JwtSecretResponse =
)
|> Map.ofSeq
let Data6 =
let arg_9 =
(match node.["data6"] with
| null ->
raise (
@@ -296,7 +296,7 @@ module JwtSecretResponse =
)
|> dict
let Data5 =
let arg_8 =
(match node.["data5"] with
| null ->
raise (
@@ -313,7 +313,7 @@ module JwtSecretResponse =
)
|> readOnlyDict
let Data4 =
let arg_7 =
(match node.["data4"] with
| null ->
raise (
@@ -330,7 +330,7 @@ module JwtSecretResponse =
)
|> Map.ofSeq
let Data3 =
let arg_6 =
(match node.["data3"] with
| null ->
raise (
@@ -348,7 +348,7 @@ module JwtSecretResponse =
|> Seq.map System.Collections.Generic.KeyValuePair
|> System.Collections.Generic.Dictionary
let Data2 =
let arg_5 =
(match node.["data2"] with
| null ->
raise (
@@ -365,7 +365,7 @@ module JwtSecretResponse =
)
|> dict
let Data =
let arg_4 =
(match node.["data"] with
| null ->
raise (
@@ -382,7 +382,7 @@ module JwtSecretResponse =
)
|> readOnlyDict
let LeaseDuration =
let arg_3 =
(match node.["lease_duration"] with
| null ->
raise (
@@ -394,7 +394,7 @@ module JwtSecretResponse =
.AsValue()
.GetValue<int> ()
let Renewable =
let arg_2 =
(match node.["renewable"] with
| null ->
raise (
@@ -406,7 +406,7 @@ module JwtSecretResponse =
.AsValue()
.GetValue<bool> ()
let LeaseId =
let arg_1 =
(match node.["lease_id"] with
| null ->
raise (
@@ -418,7 +418,7 @@ module JwtSecretResponse =
.AsValue()
.GetValue<string> ()
let RequestId =
let arg_0 =
(match node.["request_id"] with
| null ->
raise (
@@ -431,18 +431,18 @@ module JwtSecretResponse =
.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
RequestId = arg_0
LeaseId = arg_1
Renewable = arg_2
LeaseDuration = arg_3
Data = arg_4
Data2 = arg_5
Data3 = arg_6
Data4 = arg_7
Data5 = arg_8
Data6 = arg_9
Data7 = arg_10
Data8 = arg_11
}
namespace ConsumePlugin
@@ -543,3 +543,201 @@ module VaultClient =
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
}
namespace ConsumePlugin
open System
open System.Collections.Generic
open System.Text.Json.Serialization
open System.Threading
open System.Threading.Tasks
open RestEase
/// Module for constructing a REST client.
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
[<RequireQualifiedAccess>]
module VaultClientNonExtensionMethod =
/// Create a REST client.
let make (client : System.Net.Http.HttpClient) : IVaultClientNonExtensionMethod =
{ new IVaultClientNonExtensionMethod with
member _.GetSecret
(jwt : JwtVaultResponse, path : string, mountPoint : string, ct : CancellationToken option)
=
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
(match client.BaseAddress with
| null ->
raise (
System.ArgumentNullException (
nameof (client.BaseAddress),
"No base address was supplied on the type, and no BaseAddress was on the HttpClient."
)
)
| v -> v),
System.Uri (
"v1/{mountPoint}/{path}"
.Replace("{path}", path.ToString () |> System.Web.HttpUtility.UrlEncode)
.Replace (
"{mountPoint}",
mountPoint.ToString () |> System.Web.HttpUtility.UrlEncode
),
System.UriKind.Relative
)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
let! jsonNode =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
return JwtSecretResponse.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.GetJwt (role : string, jwt : string, ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
(match client.BaseAddress with
| null ->
raise (
System.ArgumentNullException (
nameof (client.BaseAddress),
"No base address was supplied on the type, and no BaseAddress was on the HttpClient."
)
)
| v -> v),
System.Uri ("v1/auth/jwt/login", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
let! jsonNode =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
return JwtVaultResponse.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
}
namespace ConsumePlugin
open System
open System.Collections.Generic
open System.Text.Json.Serialization
open System.Threading
open System.Threading.Tasks
open RestEase
/// Extension methods for constructing a REST client.
[<AutoOpen>]
module VaultClientExtensionMethodHttpClientExtension =
/// Extension methods for HTTP clients
type VaultClientExtensionMethod with
/// Create a REST client.
static member make (client : System.Net.Http.HttpClient) : IVaultClientExtensionMethod =
{ new IVaultClientExtensionMethod with
member _.GetSecret
(jwt : JwtVaultResponse, path : string, mountPoint : string, ct : CancellationToken option)
=
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
(match client.BaseAddress with
| null ->
raise (
System.ArgumentNullException (
nameof (client.BaseAddress),
"No base address was supplied on the type, and no BaseAddress was on the HttpClient."
)
)
| v -> v),
System.Uri (
"v1/{mountPoint}/{path}"
.Replace("{path}", path.ToString () |> System.Web.HttpUtility.UrlEncode)
.Replace (
"{mountPoint}",
mountPoint.ToString () |> System.Web.HttpUtility.UrlEncode
),
System.UriKind.Relative
)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
let! jsonNode =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
return JwtSecretResponse.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.GetJwt (role : string, jwt : string, ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
(match client.BaseAddress with
| null ->
raise (
System.ArgumentNullException (
nameof (client.BaseAddress),
"No base address was supplied on the type, and no BaseAddress was on the HttpClient."
)
)
| v -> v),
System.Uri ("v1/auth/jwt/login", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
let! jsonNode =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
return JwtVaultResponse.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
}

View File

@@ -32,10 +32,27 @@ type JsonRecordType =
[<WoofWare.Myriad.Plugins.JsonParse true>]
type ToGetExtensionMethod =
{
Tinker : string
Tailor : int
Soldier : System.Uri
Sailor : float
Alpha : string
Bravo : System.Uri
Charlie : float
Delta : float32
Echo : single
Foxtrot : double
Golf : int64
Hotel : uint64
India : int
Juliette : uint
Kilo : int32
Lima : uint32
Mike : int16
November : uint16
Oscar : int8
Papa : uint8
Quebec : byte
Tango : sbyte
Uniform : decimal
Victor : char
Whiskey : bigint
}
[<RequireQualifiedAccess>]

View File

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

View File

@@ -1,5 +1,6 @@
namespace SomeNamespace
open System
open WoofWare.Myriad.Plugins
[<GenerateMock>]
@@ -41,3 +42,9 @@ type Curried<'a> =
abstract Mem4 : (int * string) -> ('a * int) -> string
abstract Mem5 : x : int * string -> ('a * int) -> string
abstract Mem6 : int * string -> y : 'a * int -> string
[<GenerateMock>]
type TypeWithInterface =
inherit IDisposable
abstract Mem1 : string option -> string[] Async
abstract Mem2 : unit -> string[] Async

View File

@@ -17,6 +17,9 @@ type IPureGymApi =
[<Get "v1/gyms/{gym_id}/attendance">]
abstract GetGymAttendance : [<Path "gym_id">] gymId : int * ?ct : CancellationToken -> Task<GymAttendance>
[<Get "v1/gyms/{gym_id}/attendance">]
abstract GetGymAttendance' : [<Path("gym_id")>] gymId : int * ?ct : CancellationToken -> Task<GymAttendance>
[<RestEase.GetAttribute "v1/member">]
abstract GetMember : ?ct : CancellationToken -> Member Task
@@ -38,6 +41,10 @@ type IPureGymApi =
abstract GetSessions :
[<Query>] fromDate : DateOnly * [<Query>] toDate : DateOnly * ?ct : CancellationToken -> Task<Sessions>
[<Get "/v2/gymSessions/member?foo=1">]
abstract GetSessionsWithQuery :
[<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>
@@ -120,7 +127,8 @@ type internal IApiWithoutBaseAddress =
[<WoofWare.Myriad.Plugins.HttpClient>]
[<BasePath "foo">]
type IApiWithBasePath =
[<Get "endpoint/{param}">]
// Example where we use the bundled attributes rather than RestEase's
[<WoofWare.Myriad.Plugins.RestEase.Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?cancellationToken : CancellationToken -> Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>]
@@ -141,3 +149,16 @@ type IApiWithHeaders =
[<Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>]
[<WoofWare.Myriad.Plugins.RestEase.Header("Header-Name", "Header-Value")>]
type IApiWithHeaders2 =
[<WoofWare.Myriad.Plugins.RestEase.Header "X-Foo">]
abstract SomeHeader : string
[<WoofWare.Myriad.Plugins.RestEase.Header "Authorization">]
abstract SomeOtherHeader : int
[<Get "endpoint/{param}">]
abstract GetPathParam :
[<WoofWare.Myriad.Plugins.RestEase.Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>

View File

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

View File

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

View File

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

View File

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

View File

@@ -0,0 +1,63 @@
namespace WoofWare.Myriad.Plugins
open System
/// Module containing duplicates of the supported RestEase attributes, in case you don't want
/// to take a dependency on RestEase.
[<RequireQualifiedAccess>]
module RestEase =
/// Indicates that a method represents an HTTP Get query to the specified endpoint.
type GetAttribute (path : string) =
inherit Attribute ()
/// Indicates that a method represents an HTTP Post query to the specified endpoint.
type PostAttribute (path : string) =
inherit Attribute ()
/// Indicates that a method represents an HTTP Delete query to the specified endpoint.
type DeleteAttribute (path : string) =
inherit Attribute ()
/// Indicates that a method represents an HTTP Head query to the specified endpoint.
type HeadAttribute (path : string) =
inherit Attribute ()
/// Indicates that a method represents an HTTP Options query to the specified endpoint.
type OptionsAttribute (path : string) =
inherit Attribute ()
/// Indicates that a method represents an HTTP Put query to the specified endpoint.
type PutAttribute (path : string) =
inherit Attribute ()
/// Indicates that a method represents an HTTP Patch query to the specified endpoint.
type PatchAttribute (path : string) =
inherit Attribute ()
/// Indicates that a method represents an HTTP Trace query to the specified endpoint.
type TraceAttribute (path : string) =
inherit Attribute ()
/// Indicates that this argument to a method is interpolated into the HTTP request at runtime
/// by setting a query parameter (with the given name) to the value of the annotated argument.
type QueryAttribute (paramName : string) =
inherit Attribute ()
/// Indicates that this interface represents a REST client which accesses an API whose paths are
/// all relative to the given address.
type BaseAddressAttribute (addr : string) =
inherit Attribute ()
/// Indicates that this interface member causes the interface to set a header with the given name,
/// whose value is obtained whenever required by a fresh call to the interface member.
type HeaderAttribute (header : string, value : string option) =
inherit Attribute ()
new (header : string) = HeaderAttribute (header, None)
new (header : string, value : string) = HeaderAttribute (header, Some value)
/// Indicates that this argument to a method is interpolated into the request path at runtime
/// by writing it into the templated string that specifies the HTTP query e.g. in the `[<Get "/foo/{template}">]`.
type PathAttribute (path : string option) =
inherit Attribute ()
new (path : string) = PathAttribute (Some path)
new () = PathAttribute None

View File

@@ -6,7 +6,10 @@ WoofWare.Myriad.Plugins.GenerateMockAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.GenerateMockAttribute.DefaultIsInternal [static property]: [read-only] bool
WoofWare.Myriad.Plugins.GenerateMockAttribute.get_DefaultIsInternal [static method]: unit -> bool
WoofWare.Myriad.Plugins.HttpClientAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.HttpClientAttribute..ctor [constructor]: bool
WoofWare.Myriad.Plugins.HttpClientAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.HttpClientAttribute.DefaultIsExtensionMethod [static property]: [read-only] bool
WoofWare.Myriad.Plugins.HttpClientAttribute.get_DefaultIsExtensionMethod [static method]: unit -> bool
WoofWare.Myriad.Plugins.JsonParseAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.JsonParseAttribute..ctor [constructor]: bool
WoofWare.Myriad.Plugins.JsonParseAttribute..ctor [constructor]: unit
@@ -18,4 +21,33 @@ WoofWare.Myriad.Plugins.JsonSerializeAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.JsonSerializeAttribute.DefaultIsExtensionMethod [static property]: [read-only] bool
WoofWare.Myriad.Plugins.JsonSerializeAttribute.get_DefaultIsExtensionMethod [static method]: unit -> bool
WoofWare.Myriad.Plugins.RemoveOptionsAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.RemoveOptionsAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.RemoveOptionsAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.RestEase inherit obj
WoofWare.Myriad.Plugins.RestEase+BaseAddressAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.RestEase+BaseAddressAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.RestEase+DeleteAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.RestEase+DeleteAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.RestEase+GetAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.RestEase+GetAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.RestEase+HeadAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.RestEase+HeadAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.RestEase+HeaderAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.RestEase+HeaderAttribute..ctor [constructor]: (string, string option)
WoofWare.Myriad.Plugins.RestEase+HeaderAttribute..ctor [constructor]: (string, string)
WoofWare.Myriad.Plugins.RestEase+HeaderAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.RestEase+OptionsAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.RestEase+OptionsAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.RestEase+PatchAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.RestEase+PatchAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.RestEase+PathAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.RestEase+PathAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.RestEase+PathAttribute..ctor [constructor]: string option
WoofWare.Myriad.Plugins.RestEase+PathAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.RestEase+PostAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.RestEase+PostAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.RestEase+PutAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.RestEase+PutAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.RestEase+QueryAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.RestEase+QueryAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.RestEase+TraceAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.RestEase+TraceAttribute..ctor [constructor]: string

View File

@@ -11,11 +11,9 @@ module TestSurface =
[<Test>]
let ``Ensure API surface has not been modified`` () = ApiSurface.assertIdentical assembly
(*
[<Test>]
let ``Check version against remote`` () =
MonotonicVersion.validate assembly "WoofWare.Myriad.Plugins.Attributes"
*)
[<Test ; Explicit>]
let ``Update API surface`` () =

View File

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

View File

@@ -19,6 +19,7 @@
<ItemGroup>
<Compile Include="Attributes.fs"/>
<Compile Include="RestEase.fs" />
<EmbeddedResource Include="version.json"/>
<EmbeddedResource Include="SurfaceBaseline.txt"/>
<None Include="..\README.md">

View File

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

View File

@@ -89,6 +89,7 @@ module TestPureGymRestApi =
let api = PureGymApi.make client
api.GetGymAttendance(requestedGym).Result |> shouldEqual expected
api.GetGymAttendance'(requestedGym).Result |> shouldEqual expected
let memberCases =
PureGymDtos.memberCases |> List.allPairs baseUris |> List.map TestCaseData
@@ -234,6 +235,33 @@ module TestPureGymRestApi =
api.GetSessions(startDate, endDate).Result |> shouldEqual expected
[<TestCaseSource(nameof sessionsCases)>]
let ``Test GetSessionsWithQuery``
(baseUri : Uri, (startDate : DateOnly, (endDate : DateOnly, (json : string, expected : Sessions))))
=
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
// This one is specified as being absolute, in its attribute on the IPureGymApi type
let expectedUri =
let fromDate = dateOnlyToString startDate
let toDate = dateOnlyToString endDate
$"https://example.com/v2/gymSessions/member?foo=1&fromDate=%s{fromDate}&toDate=%s{toDate}"
message.RequestUri.ToString () |> shouldEqual expectedUri
let content = new StringContent (json)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make baseUri proc
let api = PureGymApi.make client
api.GetSessionsWithQuery(startDate, endDate).Result |> shouldEqual expected
[<Test>]
let ``URI example`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =

View File

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

View File

@@ -1,6 +1,7 @@
namespace WoofWare.Myriad.Plugins.Test
open System
open System.Numerics
open System.Text.Json.Nodes
open ConsumePlugin
open NUnit.Framework
@@ -12,15 +13,62 @@ module TestExtensionMethod =
[<Test>]
let ``Parse via extension method`` () =
let json =
"""{"tinker": "job", "tailor": 3, "soldier": "https://example.com", "sailor": 3.1}"""
"""{
"alpha": "hello!",
"bravo": "https://example.com",
"charlie": 0.3341,
"delta": 110033.4,
"echo": -0.000993,
"foxtrot": -999999999999,
"golf": -123456789101112,
"hotel": 18446744073709551615,
"india": 99884,
"juliette": 12223334,
"kilo": -2147483642,
"lima": 4294967293,
"mike": -32767,
"november": 65533,
"oscar": -125,
"papa": 253,
"quebec": 254,
"tango": -3,
"uniform": 1004443.300988393349583009,
"victor": "x",
"whiskey": 123456123456123456123456123456123456123456
}"""
|> JsonNode.Parse
let expected =
{
Tinker = "job"
Tailor = 3
Soldier = Uri "https://example.com"
Sailor = 3.1
Alpha = "hello!"
Bravo = Uri "https://example.com"
Charlie = 0.3341
Delta = 110033.4f
Echo = -0.000993f
Foxtrot = -999999999999.0
Golf = -123456789101112L
Hotel = 18446744073709551615UL
India = 99884
Juliette = 12223334u
Kilo = -2147483642
Lima = 4294967293u
Mike = -32767s
November = 65533us
Oscar = -125y
Papa = 253uy
Quebec = 254uy
Tango = -3y
Uniform = 1004443.300988393349583009m
Victor = 'x'
Whiskey =
let mutable i = BigInteger 0
for _ = 0 to 6 do
i <- i * BigInteger 1000000 + BigInteger 123456
i
}
ToGetExtensionMethod.jsonParse json |> shouldEqual expected
let actual = ToGetExtensionMethod.jsonParse json
actual |> shouldEqual expected

View File

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

View File

@@ -2,10 +2,9 @@ namespace WoofWare.Myriad.Plugins.Test
open System
open System.Collections.Generic
open System.IO
open System.Text
open System.Text.Json
open System.Text.Json.Nodes
open FsCheck.Random
open Microsoft.FSharp.Reflection
open NUnit.Framework
open FsCheck
open FsUnitTyped
@@ -124,3 +123,82 @@ module TestJsonSerde =
|> shouldEqual (
sprintf """{"it\u0027s-a-me":"%s","map":{},"readOnlyDict":{},"dict":{},"concreteDict":{}}""" guidStr
)
type Generators =
static member TestCase () =
{ new Arbitrary<InnerTypeWithBoth>() with
override x.Generator = innerGen 5
}
let sanitiseInner (r : InnerTypeWithBoth) : InnerTypeWithBoth =
{
Thing = r.Thing
Map = r.Map
ReadOnlyDict = r.ReadOnlyDict
Dict = r.Dict
ConcreteDict = r.ConcreteDict
}
let sanitiseRec (r : JsonRecordTypeWithBoth) : JsonRecordTypeWithBoth =
{
A = r.A
B = if isNull r.B then "<null>" else r.B
C =
if Object.ReferenceEquals (r.C, (null : obj)) then
[]
else
r.C
D = sanitiseInner r.D
E = if isNull r.E then [||] else r.E
F =
if Object.ReferenceEquals (r.F, (null : obj)) then
[||]
else
r.F
}
let duGen =
gen {
let! case = Gen.choose (0, 2)
match case with
| 0 -> return FirstDu.EmptyCase
| 1 ->
let! s = Arb.generate<NonNull<string>>
return FirstDu.Case1 s.Get
| 2 ->
let! i = Arb.generate<int>
let! record = outerGen
return FirstDu.Case2 (record, i)
| _ -> return failwith $"unexpected: %i{case}"
}
[<Test>]
let ``Discriminated union works`` () =
let property (du : FirstDu) : unit =
du
|> FirstDu.toJsonNode
|> fun s -> s.ToJsonString ()
|> JsonNode.Parse
|> FirstDu.jsonParse
|> shouldEqual du
property |> Prop.forAll (Arb.fromGen duGen) |> Check.QuickThrowOnFailure
[<Test>]
let ``DU generator covers all cases`` () =
let rand = Random ()
let cases = FSharpType.GetUnionCases typeof<FirstDu>
let counts = Array.zeroCreate<int> cases.Length
let decompose = FSharpValue.PreComputeUnionTagReader typeof<FirstDu>
Gen.listOf duGen
|> Gen.eval 100 (StdGen.StdGen (rand.Next (), rand.Next ()))
|> List.iter (fun du ->
let tag = decompose du
counts.[tag] <- counts.[tag] + 1
)
for i in counts do
i |> shouldBeGreaterThan 0

View File

@@ -33,13 +33,12 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="ApiSurface" Version="4.0.30"/>
<PackageReference Include="ApiSurface" Version="4.0.40"/>
<PackageReference Include="FsCheck" Version="2.16.6"/>
<PackageReference Include="FsUnit" Version="6.0.0"/>
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.9.0"/>
<PackageReference Include="NUnit" Version="4.0.1"/>
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.10.0"/>
<PackageReference Include="NUnit" Version="4.1.0"/>
<PackageReference Include="NUnit3TestAdapter" Version="4.5.0"/>
<PackageReference Include="coverlet.collector" Version="6.0.0"/>
</ItemGroup>
<ItemGroup>

View File

@@ -54,6 +54,7 @@ type internal InterfaceType =
{
Attributes : SynAttribute list
Name : LongIdent
Inherits : SynType list
Members : MemberInfo list
Properties : PropertyInfo list
Generics : SynTyparDecls option
@@ -97,6 +98,30 @@ type internal AdtProduct =
[<RequireQualifiedAccess>]
module internal AstHelper =
/// Given e.g. "byte", returns "System.Byte".
let qualifyPrimitiveType (typeName : string) : LongIdent option =
match typeName with
| "float32"
| "single" -> [ "System" ; "Single" ] |> Some
| "float"
| "double" -> [ "System" ; "Double" ] |> Some
| "byte"
| "uint8" -> [ "System" ; "Byte" ] |> Some
| "sbyte"
| "int8" -> [ "System" ; "SByte" ] |> Some
| "int16" -> [ "System" ; "Int16" ] |> Some
| "int"
| "int32" -> [ "System" ; "Int32" ] |> Some
| "int64" -> [ "System" ; "Int64" ] |> Some
| "uint16" -> [ "System" ; "UInt16" ] |> Some
| "uint"
| "uint32" -> [ "System" ; "UInt32" ] |> Some
| "uint64" -> [ "System" ; "UInt64" ] |> Some
| "char" -> [ "System" ; "Char" ] |> Some
| "decimal" -> [ "System" ; "Decimal" ] |> Some
| _ -> None
|> Option.map (List.map Ident.Create)
let instantiateRecord (fields : (RecordFieldName * SynExpr option) list) : SynExpr =
let fields =
fields
@@ -131,6 +156,11 @@ module internal AstHelper =
// TODO: consider Microsoft.FSharp.Option or whatever it is
| _ -> false
let isUnitIdent (ident : SynLongIdent) : bool =
match ident.LongIdent with
| [ i ] when System.String.Equals (i.idText, "unit", System.StringComparison.OrdinalIgnoreCase) -> true
| _ -> false
let isListIdent (ident : SynLongIdent) : bool =
match ident.LongIdent with
| [ i ] when System.String.Equals (i.idText, "list", System.StringComparison.OrdinalIgnoreCase) -> true
@@ -342,7 +372,18 @@ module internal AstHelper =
}
|> List.singleton
}
| _ -> failwith $"Unrecognised args in interface method declaration: %+A{args}"
| arg ->
{
HasParen = false
Args =
{
Attributes = []
IsOptional = false
Id = None
Type = arg
}
|> List.singleton
}
|> fun ty ->
{ ty with
HasParen = ty.HasParen || hasParen
@@ -386,22 +427,26 @@ module internal AstHelper =
let attrs = attrs |> List.collect (fun s -> s.Attributes)
let members, properties =
let members, inherits =
match synTypeDefnRepr with
| SynTypeDefnRepr.ObjectModel (_kind, members, _) ->
members
|> List.map (fun defn ->
match defn with
| SynMemberDefn.AbstractSlot (slotSig, flags, _, _) -> parseMember slotSig flags
| SynMemberDefn.AbstractSlot (slotSig, flags, _, _) -> Choice1Of2 (parseMember slotSig flags)
| SynMemberDefn.Inherit (baseType, _asIdent, _) -> Choice2Of2 baseType
| _ -> failwith $"Unrecognised member definition: %+A{defn}"
)
| _ -> failwith $"Unrecognised SynTypeDefnRepr for an interface type: %+A{synTypeDefnRepr}"
|> List.partitionChoice
let members, properties = members |> List.partitionChoice
{
Members = members
Properties = properties
Name = interfaceName
Inherits = inherits
Attributes = attrs
Generics = typars
Accessibility = accessibility
@@ -486,6 +531,11 @@ module internal SynTypePatterns =
Some innerType
| _ -> None
let (|UnitType|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident when AstHelper.isUnitIdent ident -> Some ()
| _ -> None
let (|ListType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when AstHelper.isListIdent ident ->
@@ -531,14 +581,23 @@ module internal SynTypePatterns =
Some (key, value)
| _ -> None
/// Returns the string name of the type.
let (|PrimitiveType|_|) (fieldType : SynType) =
let (|BigInt|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent |> List.map _.idText with
| [ "bigint" ]
| [ "BigInteger" ]
| [ "Numerics" ; "BigInteger" ]
| [ "System" ; "Numerics" ; "BigInteger" ] -> Some ()
| _ -> None
| _ -> None
/// Returns the type, qualified as in e.g. `System.Boolean`.
let (|PrimitiveType|_|) (fieldType : SynType) : LongIdent option =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent with
| [ i ] ->
[ "string" ; "float" ; "int" ; "bool" ; "char" ]
|> List.tryFind (fun s -> s = i.idText)
| [ i ] -> AstHelper.qualifyPrimitiveType i.idText
| _ -> None
| _ -> None

View File

@@ -182,105 +182,53 @@ module internal CataGenerator =
)
)
SynBinding.SynBinding (
None,
SynBindingKind.Normal,
false,
false,
[],
PreXmlDoc.Create " Execute the catamorphism.",
SynValData.SynValData (
None,
SynValInfo.SynValInfo (
[ [ SynArgInfo.CreateIdString "cata" ] ; [ SynArgInfo.CreateIdString "x" ] ],
SynArgInfo.SynArgInfo ([], false, None)
),
None
),
SynPat.CreateLongIdent (
SynLongIdent.CreateString ("run" + List.last(relevantTypeName).idText),
[ SynPat.CreateParen cataObject ; SynPat.CreateParen inputObject ]
),
Some (SynBindingReturnInfo.Create relevantTypar),
SynExpr.CreateTyped (
SynExpr.LetOrUse (
false,
false,
[
SynBinding.Let (
valData = SynValData.SynValData (None, SynValInfo.Empty, None),
pattern = SynPat.CreateNamed (Ident.Create "instructions"),
expr =
SynExpr.CreateApp (
SynExpr.CreateIdentString "ResizeArray",
SynExpr.CreateConst SynConst.Unit
)
)
],
SynExpr.CreateSequential
[
[
SynExpr.CreateLongIdent analysis.AssociatedProcessInstruction
|> SynExpr.applyTo (SynExpr.CreateLongIdent (SynLongIdent.CreateString "x"))
|> SynExpr.CreateParen
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "instructions" ; "Add" ])
// TODO: add the "all other stacks are empty" sanity checks
SynExpr.CreateIdent (Ident.Create (relevantTyparName.idText + "Stack") |> Ident.lowerFirstLetter)
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "Seq" ; "exactlyOne" ])
|> SynExpr.createLet
[
SynBinding.Let (
valData = SynValData.SynValData (None, SynValInfo.Empty, None),
pattern =
SynPat.Tuple (
false,
List.map
(fun (t : Ident) ->
SynPat.CreateNamed (
Ident.Create (t.idText + "Stack") |> Ident.lowerFirstLetter
)
)
allArtificialTyparNames,
List.replicate (allArtificialTyparNames.Length - 1) range0,
range0
),
expr =
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "instructions" ; "Add" ]),
SynExpr.CreateParen (
SynExpr.CreateApp (
SynExpr.CreateLongIdent analysis.AssociatedProcessInstruction,
SynExpr.CreateLongIdent (SynLongIdent.CreateString "x")
)
)
SynExpr.CreateApp (SynExpr.CreateIdentString "loop", SynExpr.CreateIdentString "cata"),
SynExpr.CreateIdentString "instructions"
)
SynExpr.LetOrUse (
false,
false,
[
SynBinding.Let (
valData = SynValData.SynValData (None, SynValInfo.Empty, None),
pattern =
SynPat.Tuple (
false,
List.map
(fun (t : Ident) ->
SynPat.CreateNamed (
Ident.Create (t.idText + "Stack") |> Ident.lowerFirstLetter
)
)
allArtificialTyparNames,
List.replicate (allArtificialTyparNames.Length - 1) range0,
range0
),
expr =
SynExpr.CreateApp (
SynExpr.CreateApp (
SynExpr.CreateIdentString "loop",
SynExpr.CreateIdentString "cata"
),
SynExpr.CreateIdentString "instructions"
)
)
],
// TODO: add the "all other stacks are empty" sanity checks
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Seq" ; "exactlyOne" ]),
SynExpr.CreateIdent (
Ident.Create (relevantTyparName.idText + "Stack") |> Ident.lowerFirstLetter
)
),
range0,
{
SynExprLetOrUseTrivia.InKeyword = None
}
)
],
range0,
{
InKeyword = None
}
),
relevantTypar
),
range0,
DebugPointAtBinding.NoneAtLet,
SynExpr.synBindingTriviaZero false
)
)
]
]
|> SynExpr.CreateSequential
|> SynExpr.createLet
[
SynExpr.CreateIdentString "ResizeArray"
|> SynExpr.applyTo (SynExpr.CreateConst SynConst.Unit)
|> SynBinding.basic (SynLongIdent.CreateString "instructions") []
]
|> SynExpr.typeAnnotate relevantTypar
|> SynBinding.basic
(SynLongIdent.CreateString ("run" + List.last(relevantTypeName).idText))
[ SynPat.CreateParen cataObject ; SynPat.CreateParen inputObject ]
|> SynBinding.withReturnAnnotation relevantTypar
|> SynBinding.withXmlDoc (PreXmlDoc.Create " Execute the catamorphism.")
let getName (ty : SynTypeDefn) : LongIdent =
match ty with
@@ -979,37 +927,29 @@ module internal CataGenerator =
// The instruction to process us again once our inputs are ready:
let reprocessCommand =
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "instructions" ; "Add" ]),
if selfArgs.Length = unionCase.FlattenedFields.Length then
SynExpr.CreateLongIdent unionCase.AssociatedInstruction
else
// We need to tell ourselves each non-rec arg, and the length of each input list.
SynExpr.CreateApp (
SynExpr.CreateLongIdent unionCase.AssociatedInstruction,
SynExpr.CreateParenedTuple (
listSelfArgs
|> List.map (fun (i, argName, _) ->
i,
SynExpr.CreateParen (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
SynLongIdent.Create [ "List" ; "length" ]
),
SynExpr.CreateIdent argName
)
)
)
|> List.append (
nonRecursiveArgs
|> List.map (fun (i, arg, _) -> i, SynExpr.CreateIdent arg)
)
|> List.sortBy fst
|> List.map snd
if selfArgs.Length = unionCase.FlattenedFields.Length then
SynExpr.CreateLongIdent unionCase.AssociatedInstruction
else
// We need to tell ourselves each non-rec arg, and the length of each input list.
listSelfArgs
|> List.map (fun (i, argName, _) ->
i,
SynExpr.CreateParen (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "List" ; "length" ]),
SynExpr.CreateIdent argName
)
)
|> SynExpr.CreateParen
)
)
|> List.append (
nonRecursiveArgs |> List.map (fun (i, arg, _) -> i, SynExpr.CreateIdent arg)
)
|> List.sortBy fst
|> List.map snd
|> SynExpr.CreateParenedTuple
|> SynExpr.applyFunction (SynExpr.CreateLongIdent unionCase.AssociatedInstruction)
|> SynExpr.CreateParen
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "instructions" ; "Add" ])
[
yield reprocessCommand
@@ -1044,51 +984,43 @@ module internal CataGenerator =
// And push the instruction to process each recursive call
// onto the stack.
yield
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "instructions" ; "Add" ]),
SynExpr.CreateParen (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
// TODO: use an AssociatedProcessInstruction instead
SynLongIdent.Create
[
"Instruction"
// TODO wonky domain
"Process"
+ "__"
+ List.last(getNameUnion(synType).Value).idText
]
),
SynExpr.CreateIdent caseDesc.ArgName
)
)
SynExpr.CreateLongIdent (
// TODO: use an AssociatedProcessInstruction instead
SynLongIdent.Create
[
"Instruction"
// TODO wonky domain
"Process" + "__" + List.last(getNameUnion(synType).Value).idText
]
)
|> SynExpr.applyTo (SynExpr.CreateIdent caseDesc.ArgName)
|> SynExpr.CreateParen
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "instructions" ; "Add" ])
]
|> SynExpr.CreateSequential
let matchLhs =
if unionCase.Fields.Length > 0 then
SynPat.CreateParen (
SynPat.Tuple (
false,
unionCase.Fields
|> List.mapi (fun i case ->
match case with
| CataUnionField.Basic case ->
SynPat.CreateNamed (Ident.lowerFirstLetter case.ArgName)
| CataUnionField.Record fields ->
let fields =
fields
|> List.map (fun (name, field) ->
([], name), range0, SynPat.CreateNamed (Ident.lowerFirstLetter name)
)
SynPat.Tuple (
false,
unionCase.Fields
|> List.mapi (fun i case ->
match case with
| CataUnionField.Basic case ->
SynPat.CreateNamed (Ident.lowerFirstLetter case.ArgName)
| CataUnionField.Record fields ->
let fields =
fields
|> List.map (fun (name, field) ->
([], name), range0, SynPat.CreateNamed (Ident.lowerFirstLetter name)
)
SynPat.Record (fields, range0)
),
List.replicate (unionCase.Fields.Length - 1) range0,
range0
)
SynPat.Record (fields, range0)
),
List.replicate (unionCase.Fields.Length - 1) range0,
range0
)
|> SynPat.CreateParen
|> List.singleton
else
[]
@@ -1113,7 +1045,7 @@ module internal CataGenerator =
analysis.AssociatedProcessInstruction,
None,
None,
SynArgPats.Pats [ SynPat.CreateNamed (Ident.Create "x") ],
SynArgPats.create [ Ident.Create "x" ],
None,
range0
),
@@ -1162,22 +1094,16 @@ module internal CataGenerator =
|> Seq.mapi (fun i x -> (i, x))
|> Seq.choose (fun (i, case) ->
match case.Description with
| FieldDescription.NonRecursive _ -> SynPat.CreateNamed case.ArgName |> Some
| FieldDescription.ListSelf _ -> SynPat.CreateNamed case.ArgName |> Some
| FieldDescription.NonRecursive _ -> case.ArgName |> Some
| FieldDescription.ListSelf _ -> case.ArgName |> Some
| FieldDescription.Self _ -> None
)
|> Seq.toList
let lhs =
match lhsNames with
| [] -> []
| lhsNames ->
SynPat.Tuple (false, lhsNames, List.replicate (lhsNames.Length - 1) range0, range0)
|> SynPat.CreateParen
|> List.singleton
let lhs = SynArgPats.create lhsNames
let pat =
SynPat.LongIdent (unionCase.AssociatedInstruction, None, None, SynArgPats.Pats lhs, None, range0)
SynPat.LongIdent (unionCase.AssociatedInstruction, None, None, lhs, None, range0)
let populateArgs =
unionCase.FlattenedFields
@@ -1193,160 +1119,81 @@ module internal CataGenerator =
// TODO: this is jank
let stackName = inputStacks.[List.last(getNameUnion(synType).Value).idText]
SynExpr.LetOrUse (
false,
false,
SynExpr.minusN (SynLongIdent.CreateFromLongIdent [ stackName ; Ident.Create "Count" ]) 1
|> SynExpr.CreateParen
|> SynExpr.applyFunction (
SynExpr.createLongIdent' [ stackName ; Ident.Create "RemoveAt" ]
)
|> SynExpr.createLet
[
SynBinding.SynBinding (
None,
SynBindingKind.Normal,
false,
false,
[],
PreXmlDoc.Empty,
SynValData.SynValData (None, SynValInfo.Empty, None),
SynPat.CreateNamed field.ArgName,
None,
SynExpr.DotIndexedGet (
SynExpr.CreateIdent stackName,
SynExpr.minusN
(SynLongIdent.CreateFromLongIdent
[ stackName ; Ident.Create "Count" ])
1,
range0,
range0
),
range0,
DebugPointAtBinding.Yes range0,
SynExpr.synBindingTriviaZero false
)
],
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
SynLongIdent.CreateFromLongIdent [ stackName ; Ident.Create "RemoveAt" ]
),
SynExpr.CreateParen (
SynExpr.DotIndexedGet (
SynExpr.CreateIdent stackName,
SynExpr.minusN
(SynLongIdent.CreateFromLongIdent [ stackName ; Ident.Create "Count" ])
1
1,
range0,
range0
)
),
range0,
{
InKeyword = None
}
)
|> SynBinding.basic (SynLongIdent.CreateFromLongIdent [ field.ArgName ]) []
]
|> Some
| ListSelf synType ->
// TODO: also jank
let stackName = inputStacks.[List.last(getNameUnion(synType).Value).idText]
let vals =
SynBinding.SynBinding (
None,
SynBindingKind.Normal,
SynExpr.ComputationExpr (
false,
false,
[],
PreXmlDoc.Empty,
SynValData.SynValData (None, SynValInfo.Empty, None),
SynPat.CreateNamed field.ArgName,
None,
SynExpr.pipeThroughFunction
(SynExpr.CreateLongIdent (SynLongIdent.Create [ "Seq" ; "toList" ]))
(SynExpr.CreateApp (
SynExpr.CreateIdentString "seq",
SynExpr.ComputationExpr (
false,
SynExpr.For (
DebugPointAtFor.Yes range0,
DebugPointAtInOrTo.Yes range0,
Ident.Create "i",
Some range0,
SynExpr.minusN
(SynLongIdent.CreateFromLongIdent
[ stackName ; Ident.Create "Count" ])
1,
false,
SynExpr.minus
(SynLongIdent.CreateFromLongIdent
[ stackName ; Ident.Create "Count" ])
(SynExpr.CreateIdent field.ArgName),
SynExpr.YieldOrReturn (
(true, false),
SynExpr.DotIndexedGet (
SynExpr.CreateIdent stackName,
SynExpr.CreateIdentString "i",
range0,
range0
),
range0
),
range0
),
SynExpr.For (
DebugPointAtFor.Yes range0,
DebugPointAtInOrTo.Yes range0,
Ident.Create "i",
Some range0,
SynExpr.minusN
(SynLongIdent.CreateFromLongIdent [ stackName ; Ident.Create "Count" ])
1,
false,
SynExpr.minus
(SynLongIdent.CreateFromLongIdent [ stackName ; Ident.Create "Count" ])
(SynExpr.CreateIdent field.ArgName),
SynExpr.YieldOrReturn (
(true, false),
SynExpr.DotIndexedGet (
SynExpr.CreateIdent stackName,
SynExpr.CreateIdentString "i",
range0,
range0
)
)),
range0,
DebugPointAtBinding.Yes range0,
SynExpr.synBindingTriviaZero false
),
range0
),
range0
),
range0
)
|> SynExpr.applyFunction (SynExpr.CreateIdentString "seq")
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Seq" ; "toList" ])
|> SynBinding.basic (SynLongIdent.CreateFromLongIdent [ field.ArgName ]) []
let shadowedIdent = Ident.Create (field.ArgName.idText + "_len")
SynExpr.LetOrUse (
false,
false,
[
SynBinding.SynBinding (
None,
SynBindingKind.Normal,
false,
false,
[],
PreXmlDoc.Empty,
SynValData.SynValData (None, SynValInfo.Empty, None),
SynPat.CreateNamed shadowedIdent,
None,
SynExpr.CreateIdent field.ArgName,
range0,
DebugPointAtBinding.Yes range0,
SynExpr.synBindingTriviaZero false
)
],
SynExpr.CreateSequential
[
SynExpr.LetOrUse (
false,
false,
[ vals ],
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
SynLongIdent.CreateFromLongIdent
[ stackName ; Ident.Create "RemoveRange" ]
),
SynExpr.CreateParenedTuple
[
SynExpr.minus
(SynLongIdent.CreateFromLongIdent
[ stackName ; Ident.Create "Count" ])
(SynExpr.CreateIdent shadowedIdent)
SynExpr.CreateIdent shadowedIdent
]
),
range0,
{
InKeyword = None
}
)
],
range0,
{
InKeyword = None
}
[
SynExpr.minus
(SynLongIdent.CreateFromLongIdent [ stackName ; Ident.Create "Count" ])
(SynExpr.CreateIdent shadowedIdent)
SynExpr.CreateIdent shadowedIdent
]
|> SynExpr.CreateParenedTuple
|> SynExpr.applyFunction (
SynExpr.createLongIdent' [ stackName ; Ident.Create "RemoveRange" ]
)
|> SynExpr.createLet [ vals ]
|> SynExpr.createLet
[
SynBinding.basic
(SynLongIdent.CreateFromLongIdent [ shadowedIdent ])
[]
(SynExpr.CreateIdent field.ArgName)
]
|> Some
)
@@ -1365,19 +1212,6 @@ module internal CataGenerator =
)
let createLoopFunction (cataTypeName : Ident) (cataVarName : Ident) (analysis : UnionAnalysis list) : SynBinding =
let valData =
SynValData.SynValData (
None,
SynValInfo.SynValInfo (
[
[ SynArgInfo.SynArgInfo ([], false, Some cataVarName) ]
[ SynArgInfo.SynArgInfo ([], false, Some (Ident.Create "instructions")) ]
],
SynArgInfo.Empty
),
None
)
let userSuppliedGenerics =
analysis
|> List.collect _.Typars
@@ -1407,45 +1241,37 @@ module internal CataGenerator =
yield SynType.Var (SynTypar.SynTypar (case.GenericName, TyparStaticReq.None, false), range0)
]
let headPat =
SynPat.LongIdent (
SynLongIdent.CreateString "loop",
None,
None,
SynArgPats.Pats
[
SynPat.CreateParen (
SynPat.CreateTyped (
SynPat.CreateNamed cataVarName,
SynType.App (
SynType.CreateLongIdent (SynLongIdent.CreateFromLongIdent [ cataTypeName ]),
Some range0,
cataGenerics,
List.replicate (cataGenerics.Length - 1) range0,
Some range0,
false,
range0
)
)
let args =
[
SynPat.CreateParen (
SynPat.CreateTyped (
SynPat.CreateNamed cataVarName,
SynType.App (
SynType.CreateLongIdent (SynLongIdent.CreateFromLongIdent [ cataTypeName ]),
Some range0,
cataGenerics,
List.replicate (cataGenerics.Length - 1) range0,
Some range0,
false,
range0
)
SynPat.CreateParen (
SynPat.CreateTyped (
SynPat.CreateNamed (Ident.Create "instructions"),
SynType.App (
SynType.CreateLongIdent "ResizeArray",
Some range0,
[ instructionsArrType ],
[],
Some range0,
false,
range0
)
)
)
)
SynPat.CreateParen (
SynPat.CreateTyped (
SynPat.CreateNamed (Ident.Create "instructions"),
SynType.App (
SynType.CreateLongIdent "ResizeArray",
Some range0,
[ instructionsArrType ],
[],
Some range0,
false,
range0
)
],
Some (SynAccess.Private range0),
range0
)
)
)
]
let baseMatchClauses = analysis |> List.map createBaseMatchClause
@@ -1455,47 +1281,24 @@ module internal CataGenerator =
SynExpr.CreateMatch (SynExpr.CreateIdentString "currentInstruction", baseMatchClauses @ recMatchClauses)
let body =
SynExpr.CreateSequential
[
SynExpr.CreateApp (
SynExpr.createLongIdent [ "instructions" ; "RemoveAt" ],
SynExpr.CreateParen (SynExpr.minusN (SynLongIdent.Create [ "instructions" ; "Count" ]) 1)
)
matchStatement
]
|> SynExpr.CreateSequential
|> SynExpr.createLet
[
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "instructions" ; "RemoveAt" ]),
SynExpr.CreateParen (SynExpr.minusN (SynLongIdent.Create [ "instructions" ; "Count" ]) 1)
)
matchStatement
]
let body =
SynExpr.LetOrUse (
false,
false,
[
SynBinding.SynBinding (
None,
SynBindingKind.Normal,
false,
false,
[],
PreXmlDoc.Empty,
SynValData.SynValData (None, SynValInfo.SynValInfo ([], SynArgInfo.Empty), None),
SynPat.CreateNamed (Ident.Create "currentInstruction"),
None,
SynExpr.DotIndexedGet (
SynExpr.CreateIdentString "instructions",
SynExpr.minusN (SynLongIdent.Create [ "instructions" ; "Count" ]) 1,
range0,
range0
),
SynExpr.DotIndexedGet (
SynExpr.CreateIdentString "instructions",
SynExpr.minusN (SynLongIdent.Create [ "instructions" ; "Count" ]) 1,
range0,
DebugPointAtBinding.Yes range0,
SynExpr.synBindingTriviaZero false
range0
)
],
body,
range0,
{
InKeyword = None
}
)
|> SynBinding.basic (SynLongIdent.CreateString "currentInstruction") []
]
let body =
SynExpr.CreateSequential
@@ -1504,82 +1307,43 @@ module internal CataGenerator =
DebugPointAtWhile.Yes range0,
SynExpr.greaterThan
(SynExpr.CreateConst (SynConst.Int32 0))
(SynExpr.CreateLongIdent (SynLongIdent.Create [ "instructions" ; "Count" ])),
(SynExpr.createLongIdent [ "instructions" ; "Count" ]),
body,
range0
)
SynExpr.CreateTuple (
analysis
|> List.map (fun unionAnalysis ->
[ unionAnalysis.StackName ]
|> SynLongIdent.CreateFromLongIdent
|> SynExpr.CreateLongIdent
)
|> List.map (fun unionAnalysis -> [ unionAnalysis.StackName ] |> SynExpr.createLongIdent')
)
]
let body =
(body, analysis)
||> List.fold (fun body unionCase ->
SynExpr.LetOrUse (
false,
false,
body
|> SynExpr.createLet
[
SynBinding.SynBinding (
None,
SynBindingKind.Normal,
false,
false,
[],
PreXmlDoc.Empty,
SynValData.SynValData (None, SynValInfo.Empty, None),
SynPat.Named (SynIdent.SynIdent (unionCase.StackName, None), false, None, range0),
None,
SynExpr.CreateApp (
SynExpr.TypeApp (
SynExpr.CreateIdent (Ident.Create "ResizeArray"),
range0,
[
SynType.Var (
SynTypar.SynTypar (unionCase.GenericName, TyparStaticReq.None, false),
range0
)
],
[],
Some range0,
range0,
range0
),
SynExpr.CreateConst SynConst.Unit
),
SynExpr.TypeApp (
SynExpr.CreateIdent (Ident.Create "ResizeArray"),
range0,
DebugPointAtBinding.Yes range0,
SynExpr.synBindingTriviaZero false
[
SynType.Var (
SynTypar.SynTypar (unionCase.GenericName, TyparStaticReq.None, false),
range0
)
],
[],
Some range0,
range0,
range0
)
],
body,
range0,
{
SynExprLetOrUseTrivia.InKeyword = None
}
)
|> SynExpr.applyTo (SynExpr.CreateConst SynConst.Unit)
|> SynBinding.basic (SynLongIdent.CreateFromLongIdent [ unionCase.StackName ]) []
]
)
SynBinding.SynBinding (
Some (SynAccess.Private range0),
SynBindingKind.Normal,
false,
false,
[],
PreXmlDoc.Empty,
valData,
headPat,
None,
body,
range0,
DebugPointAtBinding.NoneAtLet,
trivia = SynExpr.synBindingTriviaZero false
)
SynBinding.basic (SynLongIdent.CreateString "loop") args body
|> SynBinding.withAccessibility (Some (SynAccess.Private range0))
let createModule
(opens : SynOpenDeclTarget list)

View File

@@ -1,13 +1,16 @@
namespace WoofWare.Myriad.Plugins
open System
open System.Net.Http
open System.Text
open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Xml
open Myriad.Core
type internal HttpClientGeneratorOutputSpec =
{
ExtensionMethods : bool
}
[<RequireQualifiedAccess>]
module internal HttpClientGenerator =
open Fantomas.FCS.Text.Range
@@ -82,34 +85,50 @@ module internal HttpClientGenerator =
match attr.TypeName.AsString with
| "Get"
| "GetAttribute"
| "WoofWare.Myriad.Plugins.RestEase.Get"
| "WoofWare.Myriad.Plugins.RestEase.GetAttribute"
| "RestEase.Get"
| "RestEase.GetAttribute" -> Some (HttpMethod.Get, attr.ArgExpr)
| "Post"
| "PostAttribute"
| "WoofWare.Myriad.Plugins.RestEase.Post"
| "WoofWare.Myriad.Plugins.RestEase.PostAttribute"
| "RestEase.Post"
| "RestEase.PostAttribute" -> Some (HttpMethod.Post, attr.ArgExpr)
| "Put"
| "PutAttribute"
| "WoofWare.Myriad.Plugins.RestEase.Put"
| "WoofWare.Myriad.Plugins.RestEase.PutAttribute"
| "RestEase.Put"
| "RestEase.PutAttribute" -> Some (HttpMethod.Put, attr.ArgExpr)
| "Delete"
| "DeleteAttribute"
| "WoofWare.Myriad.Plugins.RestEase.Delete"
| "WoofWare.Myriad.Plugins.RestEase.DeleteAttribute"
| "RestEase.Delete"
| "RestEase.DeleteAttribute" -> Some (HttpMethod.Delete, attr.ArgExpr)
| "Head"
| "HeadAttribute"
| "WoofWare.Myriad.Plugins.RestEase.Head"
| "WoofWare.Myriad.Plugins.RestEase.HeadAttribute"
| "RestEase.Head"
| "RestEase.HeadAttribute" -> Some (HttpMethod.Head, attr.ArgExpr)
| "Options"
| "OptionsAttribute"
| "WoofWare.Myriad.Plugins.RestEase.Options"
| "WoofWare.Myriad.Plugins.RestEase.OptionsAttribute"
| "RestEase.Options"
| "RestEase.OptionsAttribute" -> Some (HttpMethod.Options, attr.ArgExpr)
| "Patch"
| "PatchAttribute"
| "WoofWare.Myriad.Plugins.RestEase.Patch"
| "WoofWare.Myriad.Plugins.RestEase.PatchAttribute"
| "RestEase.Patch"
| "RestEase.PatchAttribute" -> Some (HttpMethod.Patch, attr.ArgExpr)
| "Trace"
| "TraceAttribute"
| "WoofWare.Myriad.Plugins.RestEase.Trace"
| "WoofWare.Myriad.Plugins.RestEase.TraceAttribute"
| "RestEase.Trace"
| "RestEase.TraceAttribute" -> Some (HttpMethod.Trace, attr.ArgExpr)
| _ -> None
@@ -127,7 +146,8 @@ module internal HttpClientGenerator =
|> List.choose (fun attr ->
match attr.TypeName.AsString with
| "Header"
| "RestEase.Header" ->
| "RestEase.Header"
| "WoofWare.Myriad.Plugins.RestEase.Header" ->
match attr.ArgExpr with
| SynExpr.Paren (SynExpr.Tuple (_, [ v1 ; v2 ], _, _), _, _, _) ->
Some [ SynExpr.stripOptionalParen v1 ; SynExpr.stripOptionalParen v2 ]
@@ -254,9 +274,7 @@ module internal HttpClientGenerator =
SynExpr.CreateConstString ("{" + substituteId + "}")
SynExpr.callMethod "ToString" (SynExpr.CreateIdent varName)
|> SynExpr.pipeThroughFunction (
SynExpr.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ]
)
SynExpr.createLongIdent [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ]
)
])
| _ -> template
@@ -293,6 +311,24 @@ module internal HttpClientGenerator =
| None -> failwith "Unable to get parameter variable name from anonymous parameter"
| Some id -> id
let urlSeparator =
// apparent Myriad bug: `IndexOf '?'` gets formatted as `IndexOf ?` which is clearly wrong
let questionMark =
SynExpr.CreateConst (SynConst.Int32 63)
|> SynExpr.applyFunction (SynExpr.CreateIdentString "char")
|> SynExpr.CreateParen
let containsQuestion =
info.UrlTemplate
|> SynExpr.callMethodArg "IndexOf" questionMark
|> SynExpr.greaterThanOrEqual (SynExpr.CreateConst (SynConst.Int32 0))
SynExpr.ifThenElse
containsQuestion
(SynExpr.CreateConst (SynConst.CreateString "?"))
(SynExpr.CreateConst (SynConst.CreateString "&"))
|> SynExpr.CreateParen
let prefix =
SynExpr.CreateIdent firstValueId
|> SynExpr.toString firstValue.Type
@@ -301,7 +337,7 @@ module internal HttpClientGenerator =
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ])
)
|> SynExpr.CreateParen
|> SynExpr.plus (SynExpr.CreateConstString ("?" + firstKey + "="))
|> SynExpr.plus (SynExpr.plus urlSeparator (SynExpr.CreateConstString (firstKey + "=")))
(prefix, queryParams)
||> List.fold (fun uri (paramKey, paramValue) ->
@@ -313,9 +349,7 @@ module internal HttpClientGenerator =
SynExpr.toString paramValue.Type (SynExpr.CreateIdent paramValueId)
|> SynExpr.CreateParen
|> SynExpr.pipeThroughFunction (
SynExpr.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ]
)
SynExpr.createLongIdent [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ]
)
|> SynExpr.CreateParen
|> SynExpr.plus (SynExpr.plus uri (SynExpr.CreateConstString ("&" + paramKey + "=")))
@@ -324,48 +358,31 @@ module internal HttpClientGenerator =
|> SynExpr.CreateParen
let requestUri =
let uriIdent = SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Uri" ])
let uriIdent = SynExpr.createLongIdent [ "System" ; "Uri" ]
let baseAddress = SynExpr.createLongIdent [ "client" ; "BaseAddress" ]
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"
)
]
)
[
SynMatchClause.Create (
SynPat.CreateNull,
None,
match info.BaseAddress with
| None ->
[
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."
]
|> SynExpr.CreateParenedTuple
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "ArgumentNullException" ])
|> SynExpr.CreateParen
|> SynExpr.applyFunction (SynExpr.CreateIdentString "raise")
| Some expr -> SynExpr.CreateApp (uriIdent, expr)
)
SynMatchClause.Create (SynPat.CreateNamed (Ident.Create "v"), None, SynExpr.CreateIdentString "v")
]
|> SynExpr.createMatch baseAddress
|> SynExpr.CreateParen
SynExpr.App (
@@ -380,7 +397,7 @@ module internal HttpClientGenerator =
SynExpr.CreateParenedTuple
[
requestUriTrailer
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "UriKind" ; "Relative" ])
SynExpr.createLongIdent [ "System" ; "UriKind" ; "Relative" ]
]
)
],
@@ -420,10 +437,8 @@ module internal HttpClientGenerator =
[
SynExpr.equals
(SynExpr.CreateIdentString "Method")
(SynExpr.CreateLongIdent (
SynLongIdent.Create
[ "System" ; "Net" ; "Http" ; "HttpMethod" ; httpMethodString info.HttpMethod ]
))
(SynExpr.createLongIdent
[ "System" ; "Net" ; "Http" ; "HttpMethod" ; httpMethodString info.HttpMethod ])
SynExpr.equals (SynExpr.CreateIdentString "RequestUri") (SynExpr.CreateIdentString "uri")
]
|> SynExpr.CreateParenedTuple
@@ -558,9 +573,7 @@ module internal HttpClientGenerator =
"responseString",
SynExpr.awaitTask (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
SynLongIdent.Create [ "response" ; "Content" ; "ReadAsStringAsync" ]
),
SynExpr.createLongIdent [ "response" ; "Content" ; "ReadAsStringAsync" ],
SynExpr.CreateIdentString "ct"
)
)
@@ -571,9 +584,7 @@ module internal HttpClientGenerator =
"responseStream",
SynExpr.awaitTask (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
SynLongIdent.Create [ "response" ; "Content" ; "ReadAsStreamAsync" ]
),
SynExpr.createLongIdent [ "response" ; "Content" ; "ReadAsStreamAsync" ],
SynExpr.CreateIdentString "ct"
)
)
@@ -584,9 +595,7 @@ module internal HttpClientGenerator =
"jsonNode",
SynExpr.awaitTask (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ; "ParseAsync" ]
),
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ; "ParseAsync" ],
SynExpr.CreateParenedTuple
[
SynExpr.CreateIdentString "responseStream"
@@ -603,15 +612,13 @@ module internal HttpClientGenerator =
|> List.map (fun (headerName, callToGetValue) ->
Do (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "httpMessage" ; "Headers" ; "Add" ]),
SynExpr.createLongIdent [ "httpMessage" ; "Headers" ; "Add" ],
SynExpr.CreateParenedTuple
[
headerName
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
SynLongIdent.CreateFromLongIdent
[ Ident.Create "this" ; callToGetValue ; Ident.Create "ToString" ]
),
SynExpr.createLongIdent'
[ Ident.Create "this" ; callToGetValue ; Ident.Create "ToString" ],
SynExpr.CreateConst SynConst.Unit
)
]
@@ -624,14 +631,14 @@ module internal HttpClientGenerator =
|> List.map (fun (headerName, headerValue) ->
Do (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "httpMessage" ; "Headers" ; "Add" ]),
SynExpr.createLongIdent [ "httpMessage" ; "Headers" ; "Add" ],
SynExpr.CreateParenedTuple [ headerName ; headerValue ]
)
)
)
[
yield LetBang ("ct", SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "CancellationToken" ]))
yield LetBang ("ct", SynExpr.createLongIdent [ "Async" ; "CancellationToken" ])
yield Let ("uri", requestUri)
yield
Use (
@@ -656,7 +663,7 @@ module internal HttpClientGenerator =
"response",
SynExpr.awaitTask (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "client" ; "SendAsync" ]),
SynExpr.createLongIdent [ "client" ; "SendAsync" ],
SynExpr.CreateParenedTuple
[ SynExpr.CreateIdentString "httpMessage" ; SynExpr.CreateIdentString "ct" ]
)
@@ -667,7 +674,7 @@ module internal HttpClientGenerator =
Let (
"response",
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "response" ; "EnsureSuccessStatusCode" ]),
SynExpr.createLongIdent [ "response" ; "EnsureSuccessStatusCode" ],
SynExpr.CreateConst SynConst.Unit
)
)
@@ -686,29 +693,32 @@ module internal HttpClientGenerator =
|> SynExpr.createCompExpr "async" returnExpr
|> SynExpr.startAsTask (SynLongIdent.CreateFromLongIdent [ cancellationTokenArg ])
SynMemberDefn.Member (
SynBinding.SynBinding (
info.Accessibility,
SynBindingKind.Normal,
false,
false,
[],
PreXmlDoc.Empty,
valData,
headPat,
None,
implementation,
range0,
DebugPointAtBinding.Yes range0,
SynExpr.synBindingTriviaZero true
),
range0
SynBinding.SynBinding (
None,
SynBindingKind.Normal,
false,
false,
[],
PreXmlDoc.Empty,
valData,
headPat,
None,
implementation,
range0,
DebugPointAtBinding.Yes range0,
SynBinding.triviaZero true
)
|> SynBinding.withAccessibility info.Accessibility
|> fun b -> SynMemberDefn.Member (b, range0)
let getHttpAttributes (attrs : SynAttribute list) : HttpAttribute list =
attrs
|> List.choose (fun attr ->
match attr.TypeName.AsString with
| "RestEase.Query"
| "RestEase.QueryAttribute"
| "WoofWare.Myriad.Plugins.RestEase.Query"
| "WoofWare.Myriad.Plugins.RestEase.QueryAttribute"
| "Query"
| "QueryAttribute" ->
match attr.ArgExpr with
@@ -717,14 +727,22 @@ module internal HttpClientGenerator =
Some (HttpAttribute.Query (Some s))
| SynExpr.Const (a, _) -> failwith $"unrecognised constant arg to the Query attribute: %+A{a}"
| _ -> None
| "RestEase.Path"
| "RestEase.PathAttribute"
| "WoofWare.Myriad.Plugins.RestEase.Path"
| "WoofWare.Myriad.Plugins.RestEase.PathAttribute"
| "Path"
| "PathAttribute" ->
match attr.ArgExpr with
match attr.ArgExpr |> SynExpr.stripOptionalParen with
| SynExpr.Const (SynConst.String (s, SynStringKind.Regular, _), _) ->
Some (HttpAttribute.Path (PathSpec.Verbatim s))
| SynExpr.Const (SynConst.Unit, _) -> Some (HttpAttribute.Path PathSpec.MatchArgName)
| SynExpr.Const (a, _) -> failwith $"unrecognised constant arg to the Path attribute: %+A{a}"
| _ -> None
| "RestEase.Body"
| "RestEase.BodyAttribute"
| "WoofWare.Myriad.Plugins.RestEase.Body"
| "WoofWare.Myriad.Plugins.RestEase.BodyAttribute"
| "Body"
| "BodyAttribute" ->
match attr.ArgExpr with
@@ -740,8 +758,10 @@ module internal HttpClientGenerator =
match attr.TypeName.AsString with
| "BasePath"
| "RestEase.BasePath"
| "WoofWare.Myriad.Plugins.RestEase.BasePath"
| "BasePathAttribute"
| "RestEase.BasePathAttribute" -> Some attr.ArgExpr
| "RestEase.BasePathAttribute"
| "WoofWare.Myriad.Plugins.RestEase.BasePathAttribute" -> Some attr.ArgExpr
| _ -> None
)
@@ -751,19 +771,25 @@ module internal HttpClientGenerator =
match attr.TypeName.AsString with
| "BaseAddress"
| "RestEase.BaseAddress"
| "WoofWare.Myriad.Plugins.RestEase.BaseAddress"
| "BaseAddressAttribute"
| "RestEase.BaseAddressAttribute" -> Some attr.ArgExpr
| "RestEase.BaseAddressAttribute"
| "WoofWare.Myriad.Plugins.RestEase.BaseAddressAttribute" -> Some attr.ArgExpr
| _ -> None
)
let createModule
(opens : SynOpenDeclTarget list)
(ns : LongIdent)
(interfaceType : SynTypeDefn)
(interfaceType : SynTypeDefn, spec : HttpClientGeneratorOutputSpec)
: SynModuleOrNamespace
=
let interfaceType = AstHelper.parseInterface interfaceType
if not (List.isEmpty interfaceType.Inherits) then
failwith
"HttpClientGenerator does not support inheritance. Remove the `inherit` keyword if you want to use this generator."
let constantHeaders =
interfaceType.Attributes
|> extractHeaderInformation
@@ -884,9 +910,7 @@ module internal HttpClientGenerator =
),
Some (SynBindingReturnInfo.Create pi.Type),
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
SynLongIdent.CreateFromLongIdent [ Ident.lowerFirstLetter pi.Identifier ]
),
SynExpr.createLongIdent' [ Ident.lowerFirstLetter pi.Identifier ],
SynExpr.CreateConst SynConst.Unit
),
range0,
@@ -903,7 +927,13 @@ module internal HttpClientGenerator =
let members = propertyMembers @ nonPropertyMembers
let docString = PreXmlDoc.Create " Module for constructing a REST client."
let docString =
(if spec.ExtensionMethods then
"Extension methods"
else
"Module")
|> sprintf " %s for constructing a REST client."
|> PreXmlDoc.Create
let interfaceImpl =
SynExpr.ObjExpr (
@@ -939,53 +969,98 @@ module internal HttpClientGenerator =
" Create a REST client."
else
" Create a REST client. The input functions will be re-evaluated on every HTTP request to obtain the required values for the corresponding header properties."
|> PreXmlDoc.Create
let createFunc =
SynBinding.SynBinding (
None,
SynBindingKind.Normal,
false,
false,
[],
PreXmlDoc.Create xmlDoc,
SynValData.SynValData (
None,
SynValInfo.SynValInfo (
[ [ SynArgInfo.SynArgInfo ([], false, Some (Ident.Create "client")) ] ],
SynArgInfo.Empty
),
let functionName = Ident.Create "client"
let valData =
let memberFlags =
if spec.ExtensionMethods then
{
SynMemberFlags.IsInstance = false
SynMemberFlags.IsDispatchSlot = false
SynMemberFlags.IsOverrideOrExplicitImpl = false
SynMemberFlags.IsFinal = false
SynMemberFlags.GetterOrSetterIsCompilerGenerated = false
SynMemberFlags.MemberKind = SynMemberKind.Member
}
|> Some
else
None
),
SynPat.CreateLongIdent (SynLongIdent.CreateString "make", headerArgs @ [ clientCreationArg ]),
Some (
SynBindingReturnInfo.Create (
SynType.LongIdent (SynLongIdent.CreateFromLongIdent interfaceType.Name)
)
),
interfaceImpl,
range0,
DebugPointAtBinding.NoneAtLet,
SynExpr.synBindingTriviaZero false
)
|> List.singleton
|> SynModuleDecl.CreateLet
let moduleName : LongIdent =
SynValData.SynValData (
memberFlags,
SynValInfo.SynValInfo ([ [ SynArgInfo.SynArgInfo ([], false, Some functionName) ] ], SynArgInfo.Empty),
None
)
let pattern = SynLongIdent.CreateString "make"
let returnInfo =
SynType.LongIdent (SynLongIdent.CreateFromLongIdent interfaceType.Name)
let nameWithoutLeadingI =
List.last interfaceType.Name
|> _.idText
|> fun s ->
if s.StartsWith 'I' then
s.[1..]
s.Substring 1
else
failwith $"Expected interface type to start with 'I', but was: %s{s}"
|> Ident.Create
|> List.singleton
let createFunc =
if spec.ExtensionMethods then
let binding =
SynBinding.basic
(SynLongIdent.CreateString "make")
(headerArgs @ [ clientCreationArg ])
interfaceImpl
|> SynBinding.withXmlDoc xmlDoc
|> SynBinding.makeStaticMember
|> SynBinding.withReturnAnnotation returnInfo
let mem = SynMemberDefn.Member (binding, range0)
let containingType =
SynTypeDefn.SynTypeDefn (
SynComponentInfo.Create (
[ Ident.Create nameWithoutLeadingI ],
xmldoc = PreXmlDoc.Create " Extension methods for HTTP clients"
),
SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Augmentation range0, [], range0),
[ mem ],
None,
range0,
{
LeadingKeyword = SynTypeDefnLeadingKeyword.Type range0
EqualsRange = None
WithKeyword = None
}
)
SynModuleDecl.Types ([ containingType ], range0)
else
SynBinding.basic (SynLongIdent.CreateString "make") (headerArgs @ [ clientCreationArg ]) interfaceImpl
|> SynBinding.withXmlDoc xmlDoc
|> SynBinding.withReturnAnnotation returnInfo
|> List.singleton
|> SynModuleDecl.CreateLet
let moduleName : LongIdent =
if spec.ExtensionMethods then
[ Ident.Create (nameWithoutLeadingI + "HttpClientExtension") ]
else
[ Ident.Create nameWithoutLeadingI ]
let attribs =
[
SynAttributeList.Create SynAttribute.compilationRepresentation
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
]
if spec.ExtensionMethods then
[ SynAttributeList.Create SynAttribute.autoOpen ]
else
[
SynAttributeList.Create SynAttribute.compilationRepresentation
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
]
let modInfo =
SynComponentInfo.Create (
@@ -1023,9 +1098,29 @@ type HttpClientGenerator () =
let namespaceAndTypes =
types
|> List.choose (fun (ns, types) ->
match types |> List.filter Ast.hasAttribute<HttpClientAttribute> with
| [] -> None
| types -> Some (ns, types)
types
|> List.choose (fun typeDef ->
match Ast.getAttribute<HttpClientAttribute> typeDef with
| None -> None
| Some attr ->
let arg =
match SynExpr.stripOptionalParen attr.ArgExpr with
| SynExpr.Const (SynConst.Bool value, _) -> value
| SynExpr.Const (SynConst.Unit, _) -> JsonParseAttribute.DefaultIsExtensionMethod
| arg ->
failwith
$"Unrecognised argument %+A{arg} to [<%s{nameof HttpClientAttribute}>]. Literals are not supported. Use `true` or `false` (or unit) only."
let spec =
{
ExtensionMethods = arg
}
Some (typeDef, spec)
)
|> function
| [] -> None
| ty -> Some (ns, ty)
)
let modules =

View File

@@ -21,6 +21,9 @@ module internal InterfaceMockGenerator =
| None -> failwith "Expected record field to have a name, but it was somehow anonymous"
| Some id -> id
[<RequireQualifiedAccess>]
type private KnownInheritance = | IDisposable
let createType
(spec : GenerateMockOutputSpec)
(name : string)
@@ -29,94 +32,91 @@ module internal InterfaceMockGenerator =
(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 inherits =
interfaceType.Inherits
|> Seq.map (fun ty ->
match ty with
| SynType.LongIdent (SynLongIdent.SynLongIdent (name, _, _)) ->
match name |> List.map _.idText with
| [] -> failwith "Unexpected empty identifier in inheritance declaration"
| [ "IDisposable" ]
| [ "System" ; "IDisposable" ] -> KnownInheritance.IDisposable
| _ -> failwithf "Unrecognised inheritance identifier: %+A" name
| x -> failwithf "Unrecognised type in inheritance: %+A" x
)
|> Set.ofSeq
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
)
SynExpr.createLongIdent [ "System" ; "NotImplementedException" ]
|> SynExpr.applyTo (SynExpr.CreateConstString "Unimplemented mock function")
|> SynExpr.CreateParen
|> SynExpr.applyFunction (SynExpr.CreateIdentString "raise")
|> SynExpr.createLambda "_"
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 generics =
generics.TyparDecls
|> List.map (fun (SynTyparDecl (_, typar)) -> SynType.Var (typar, range0))
let constructor =
SynMemberDefn.Member (
SynBinding.SynBinding (
None,
SynBindingKind.Normal,
false,
false,
[],
PreXmlDoc.Create " An implementation where every method throws.",
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)
}
),
SynType.App (
SynType.CreateLongIdent name,
Some range0,
generics,
List.replicate (generics.Length - 1) range0,
Some range0,
false,
range0
)
let constructorFields =
let extras =
if inherits.Contains KnownInheritance.IDisposable then
let unitFun = SynExpr.createLambda "_" SynExpr.CreateUnit
[
(SynLongIdent.CreateFromLongIdent [ Ident.Create "Dispose" ], true), Some unitFun
]
else
[]
let nonExtras =
fields
|> List.map (fun field -> (SynLongIdent.CreateFromLongIdent [ getName field ], true), Some failwithFun)
extras @ nonExtras
let constructor =
SynBinding.basic
(SynLongIdent.CreateString "Empty")
(if interfaceType.Generics.IsNone then
[]
else
[ SynPat.CreateConst SynConst.Unit ])
(AstHelper.instantiateRecord constructorFields)
|> SynBinding.makeStaticMember
|> SynBinding.withXmlDoc (PreXmlDoc.Create " An implementation where every method throws.")
|> SynBinding.withReturnAnnotation constructorReturnType
|> fun m -> SynMemberDefn.Member (m, range0)
let fields =
let extras =
if inherits.Contains KnownInheritance.IDisposable then
[
SynField.Create (
SynType.CreateFun (SynType.CreateUnit, SynType.CreateUnit),
Ident.Create "Dispose",
xmldoc = PreXmlDoc.Create " Implementation of IDisposable.Dispose"
)
]
else
[]
extras @ fields
let interfaceMembers =
let members =
interfaceType.Members
@@ -150,7 +150,9 @@ module internal InterfaceMockGenerator =
|> List.mapi (fun i arg ->
arg.Args
|> List.mapi (fun j arg ->
SynArgInfo.CreateIdString $"arg_%i{i}_%i{j}"
match arg.Type with
| UnitType -> SynArgInfo.SynArgInfo ([], false, None)
| _ -> SynArgInfo.CreateIdString $"arg_%i{i}_%i{j}"
)
)
],
@@ -165,10 +167,18 @@ module internal InterfaceMockGenerator =
|> List.mapi (fun i tupledArgs ->
let args =
tupledArgs.Args
|> List.mapi (fun j _ -> SynPat.CreateNamed (Ident.Create $"arg_%i{i}_%i{j}"))
|> List.mapi (fun j ty ->
match ty.Type with
| UnitType -> SynPat.Const (SynConst.Unit, range0)
| _ -> SynPat.CreateNamed (Ident.Create $"arg_%i{i}_%i{j}")
)
SynPat.Tuple (false, args, List.replicate (args.Length - 1) range0, range0)
|> SynPat.CreateParen
match args with
| [] -> failwith "somehow got no args at all"
| [ arg ] -> arg
| args ->
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
)
@@ -187,7 +197,11 @@ module internal InterfaceMockGenerator =
memberInfo.Args
|> List.mapi (fun i args ->
args.Args
|> List.mapi (fun j args -> SynExpr.CreateIdentString $"arg_%i{i}_%i{j}")
|> List.mapi (fun j arg ->
match arg.Type with
| UnitType -> SynExpr.CreateConst SynConst.Unit
| _ -> SynExpr.CreateIdentString $"arg_%i{i}_%i{j}"
)
|> SynExpr.CreateParenedTuple
)
@@ -197,13 +211,9 @@ module internal InterfaceMockGenerator =
(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
)
|> SynExpr.applyFunction (
SynExpr.createLongIdent' [ Ident.Create "this" ; memberInfo.Identifier ]
)
SynMemberDefn.Member (
SynBinding.SynBinding (
@@ -264,11 +274,35 @@ module internal InterfaceMockGenerator =
| Some (SynAccess.Internal _), _ -> SynAccess.Internal range0
| Some (SynAccess.Private _), _ -> SynAccess.Private range0
let extraInterfaces =
inherits
|> Seq.map (fun inheritance ->
match inheritance with
| KnownInheritance.IDisposable ->
let binding =
SynBinding.basic
(SynLongIdent.CreateFromLongIdent [ Ident.Create "this" ; Ident.Create "Dispose" ])
[ SynPat.CreateConst SynConst.Unit ]
(SynExpr.CreateApp (SynExpr.createLongIdent [ "this" ; "Dispose" ], SynExpr.CreateUnit))
|> SynBinding.withReturnAnnotation (SynType.Unit ())
|> SynBinding.makeInstanceMember
let mem = SynMemberDefn.Member (binding, range0)
SynMemberDefn.Interface (
SynType.CreateLongIdent (SynLongIdent.Create [ "System" ; "IDisposable" ]),
Some range0,
Some [ mem ],
range0
)
)
|> Seq.toList
let record =
{
Name = Ident.Create name
Fields = fields
Members = Some [ constructor ; interfaceMembers ]
Members = Some ([ constructor ; interfaceMembers ] @ extraInterfaces)
XmlDoc = Some xmlDoc
Generics = interfaceType.Generics
Accessibility = Some access
@@ -326,14 +360,13 @@ module internal InterfaceMockGenerator =
|> _.idText
|> fun s ->
if s.StartsWith 'I' && s.Length > 1 && Char.IsUpper s.[1] then
s.[1..]
s.Substring 1
else
s
|> fun s -> s + "Mock"
let typeDecl = createType spec name interfaceType docString fields
SynModuleOrNamespace.CreateNamespace (
namespaceId,
decls = (opens |> List.map SynModuleDecl.CreateOpen) @ [ typeDecl ]

View File

@@ -31,24 +31,20 @@ module internal JsonParseGenerator =
let assertNotNull (propertyName : SynExpr) (indexed : SynExpr) =
let raiseExpr =
SynExpr.CreateApp (
SynExpr.CreateIdentString "raise",
SynExpr.CreateParen (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Collections" ; "Generic" ; "KeyNotFoundException" ]
),
SynExpr.CreateParen (
SynExpr.CreateApp (
SynExpr.CreateApp (
SynExpr.CreateIdentString "sprintf",
SynExpr.CreateConstString "Required key '%s' not found on JSON object"
),
SynExpr.CreateParen propertyName
)
)
)
SynExpr.CreateApp (
SynExpr.CreateIdentString "sprintf",
SynExpr.CreateConstString "Required key '%s' not found on JSON object"
),
SynExpr.CreateParen propertyName
)
|> SynExpr.CreateParen
|> SynExpr.applyFunction (
SynExpr.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Collections" ; "Generic" ; "KeyNotFoundException" ]
)
)
|> SynExpr.CreateParen
|> SynExpr.applyFunction (SynExpr.CreateIdentString "raise")
SynExpr.CreateMatch (
indexed,
@@ -62,6 +58,13 @@ module internal JsonParseGenerator =
/// {node}.AsValue().GetValue<{typeName}> ()
/// If `propertyName` is Some, uses `assertNotNull {node}` instead of `{node}`.
let asValueGetValue (propertyName : SynExpr option) (typeName : string) (node : SynExpr) : SynExpr =
match propertyName with
| None -> node
| Some propertyName -> assertNotNull propertyName node
|> SynExpr.callMethod "AsValue"
|> SynExpr.callGenericMethod' "GetValue" typeName
let asValueGetValueIdent (propertyName : SynExpr option) (typeName : LongIdent) (node : SynExpr) : SynExpr =
match propertyName with
| None -> node
| Some propertyName -> assertNotNull propertyName node
@@ -122,42 +125,29 @@ module internal JsonParseGenerator =
/// Given e.g. "float", returns "System.Double.Parse"
let parseFunction (typeName : string) : LongIdent =
List.append (SynExpr.qualifyPrimitiveType typeName) [ Ident.Create "Parse" ]
let qualified =
match AstHelper.qualifyPrimitiveType typeName with
| Some x -> x
| None -> failwith $"Could not recognise type %s{typeName} as a primitive."
List.append qualified [ 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 keyArg = SynExpr.createLongIdent [ "kvp" ; "Key" ] |> SynExpr.CreateParen
let valueArg =
SynExpr.CreateLongIdent (SynLongIdent.Create [ "kvp" ; "Value" ])
|> SynExpr.CreateParen
let valueArg = SynExpr.createLongIdent [ "kvp" ; "Value" ] |> SynExpr.CreateParen
SynExpr.LetOrUse (
false,
false,
SynExpr.CreateTuple [ SynExpr.CreateIdentString "key" ; SynExpr.CreateIdentString "value" ]
|> SynExpr.createLet
[
SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create "value"), expr = value valueArg)
]
|> SynExpr.createLet
[
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
@@ -187,25 +177,19 @@ module internal JsonParseGenerator =
| DateOnly ->
node
|> asValueGetValue propertyName "string"
|> SynExpr.pipeThroughFunction (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "DateOnly" ; "Parse" ])
)
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "DateOnly" ; "Parse" ])
| Uri ->
node
|> asValueGetValue propertyName "string"
|> SynExpr.pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Uri" ]))
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "Uri" ])
| Guid ->
node
|> asValueGetValue propertyName "string"
|> SynExpr.pipeThroughFunction (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Guid" ; "Parse" ])
)
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "Guid" ; "Parse" ])
| DateTime ->
node
|> asValueGetValue propertyName "string"
|> SynExpr.pipeThroughFunction (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "DateTime" ; "Parse" ])
)
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "DateTime" ; "Parse" ])
| NumberType typeName ->
let basic = asValueGetValue propertyName typeName node
@@ -225,9 +209,7 @@ module internal JsonParseGenerator =
let handler =
asValueGetValue propertyName "string" node
|> SynExpr.pipeThroughFunction (
SynExpr.CreateLongIdent (SynLongIdent.CreateFromLongIdent (parseFunction typeName))
)
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' (parseFunction typeName))
|> SynExpr.ifThenElse
(SynExpr.equals
option
@@ -252,7 +234,7 @@ module internal JsonParseGenerator =
range0
))
handler
| PrimitiveType typeName -> asValueGetValue propertyName typeName node
| PrimitiveType typeName -> asValueGetValueIdent propertyName typeName node
| OptionType ty ->
parseNode None options ty (SynExpr.CreateIdentString "v")
|> createParseLineOption node
@@ -312,6 +294,11 @@ module internal JsonParseGenerator =
)
)
|> SynExpr.pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "Map" ; "ofSeq" ]))
| BigInt ->
node
|> SynExpr.callMethod "ToJsonString"
|> SynExpr.CreateParen
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Numerics" ; "BigInteger" ; "Parse" ])
| _ ->
// Let's just hope that we've also got our own type annotation!
let typeName =
@@ -327,9 +314,8 @@ module internal JsonParseGenerator =
/// 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).
let createParseRhs (options : JsonParseOption) (propertyName : SynExpr) (fieldType : SynType) : SynExpr =
SynExpr.CreateIdentString "node"
|> SynExpr.index propertyName
|> parseNode (Some propertyName) options fieldType
let objectToParse = SynExpr.CreateIdentString "node" |> SynExpr.index propertyName
parseNode (Some propertyName) options fieldType objectToParse
let isJsonNumberHandling (literal : LongIdent) : bool =
match List.rev literal |> List.map (fun ident -> ident.idText) with
@@ -340,183 +326,30 @@ module internal JsonParseGenerator =
| [ _ ; "JsonNumberHandling" ; "Serialization" ; "Json" ; "Text" ; "System" ] -> true
| _ -> false
let createMaker (spec : JsonParseOutputSpec) (typeName : LongIdent) (fields : SynField list) =
/// `populateNode` will be inserted before we return the `node` variable.
///
/// That is, we give you access to a `JsonNode` called `node`,
/// and you must return a `typeName`.
let scaffolding (spec : JsonParseOutputSpec) (typeName : LongIdent) (functionBody : SynExpr) : SynModuleDecl =
let xmlDoc = PreXmlDoc.Create " Parse from a JSON node."
let returnInfo =
SynBindingReturnInfo.Create (SynType.LongIdent (SynLongIdent.CreateFromLongIdent typeName))
let returnInfo = SynType.LongIdent (SynLongIdent.CreateFromLongIdent typeName)
let inputArg = Ident.Create "node"
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 (
memberFlags,
SynValInfo.SynValInfo ([ [ SynArgInfo.CreateId functionName ] ], SynArgInfo.Empty),
thisIdOpt
)
let assignments =
fields
|> List.map (fun (SynField (attrs, _, id, fieldType, _, _, _, _, _)) ->
let id =
match id with
| None -> failwith "didn't get an ID on field"
| Some id -> id
let attrs = attrs |> List.collect (fun l -> l.Attributes)
let propertyNameAttr =
attrs
|> List.tryFind (fun attr ->
attr.TypeName.AsString.EndsWith ("JsonPropertyName", StringComparison.Ordinal)
)
let options =
(JsonParseOption.None, attrs)
||> List.fold (fun options attr ->
if attr.TypeName.AsString.EndsWith ("JsonNumberHandling", StringComparison.Ordinal) then
let qualifiedEnumValue =
match SynExpr.stripOptionalParen attr.ArgExpr with
| SynExpr.LongIdent (_, SynLongIdent (ident, _, _), _, _) when
isJsonNumberHandling ident
->
// Make sure it's fully qualified
SynExpr.CreateLongIdent (
SynLongIdent.Create
[
"System"
"Text"
"Json"
"Serialization"
"JsonNumberHandling"
"AllowReadingFromString"
]
)
| _ -> attr.ArgExpr
{
JsonNumberHandlingArg = Some qualifiedEnumValue
}
else
options
)
let propertyName =
match propertyNameAttr with
| None ->
let sb = StringBuilder id.idText.Length
sb.Append (Char.ToLowerInvariant id.idText.[0]) |> ignore
if id.idText.Length > 1 then
sb.Append id.idText.[1..] |> ignore
sb.ToString () |> SynConst.CreateString |> SynExpr.CreateConst
| Some name -> name.ArgExpr
let pattern =
SynPat.LongIdent (
SynLongIdent.CreateFromLongIdent [ id ],
None,
None,
SynArgPats.Empty,
None,
range0
)
SynBinding.Let (
isInline = false,
isMutable = false,
expr = createParseRhs options propertyName fieldType,
valData = inputVal,
pattern = pattern
)
)
let finalConstruction =
fields
|> List.map (fun (SynField (_, _, id, _, _, _, _, _, _)) ->
let id =
match id with
| None -> failwith "Expected record field to have an identifying name"
| Some id -> id
(SynLongIdent.CreateFromLongIdent [ id ], true),
Some (SynExpr.CreateLongIdent (SynLongIdent.CreateFromLongIdent [ id ]))
)
|> AstHelper.instantiateRecord
let assignments =
(finalConstruction, assignments)
||> List.fold (fun final assignment ->
SynExpr.LetOrUse (
false,
false,
[ assignment ],
final,
range0,
{
InKeyword = None
}
)
)
let pattern =
SynPat.LongIdent (
SynLongIdent.CreateFromLongIdent [ functionName ],
None,
None,
SynArgPats.Pats
[
SynPat.CreateTyped (
SynPat.CreateNamed inputArg,
SynType.LongIdent (
SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
)
)
|> SynPat.CreateParen
],
None,
range0
let arg =
SynPat.CreateNamed inputArg
|> SynPat.annotateType (
SynType.LongIdent (SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
)
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
}
)
SynBinding.basic (SynLongIdent.CreateFromLongIdent [ functionName ]) [ arg ] functionBody
|> SynBinding.makeStaticMember
|> SynBinding.withXmlDoc xmlDoc
|> SynBinding.withReturnAnnotation returnInfo
let mem = SynMemberDefn.Member (binding, range0)
@@ -536,74 +369,251 @@ module internal JsonParseGenerator =
SynModuleDecl.Types ([ containingType ], range0)
else
let binding =
SynBinding.Let (
isInline = false,
isMutable = false,
xmldoc = xmlDoc,
returnInfo = returnInfo,
expr = assignments,
valData = inputVal,
pattern = pattern
SynBinding.basic (SynLongIdent.CreateFromLongIdent [ functionName ]) [ arg ] functionBody
|> SynBinding.withXmlDoc xmlDoc
|> SynBinding.withReturnAnnotation returnInfo
|> List.singleton
|> SynModuleDecl.CreateLet
let getParseOptions (fieldAttrs : SynAttribute list) =
(JsonParseOption.None, fieldAttrs)
||> List.fold (fun options attr ->
if attr.TypeName.AsString.EndsWith ("JsonNumberHandling", StringComparison.Ordinal) then
let qualifiedEnumValue =
match SynExpr.stripOptionalParen attr.ArgExpr with
| SynExpr.LongIdent (_, SynLongIdent (ident, _, _), _, _) when isJsonNumberHandling ident ->
// Make sure it's fully qualified
SynExpr.createLongIdent
[
"System"
"Text"
"Json"
"Serialization"
"JsonNumberHandling"
"AllowReadingFromString"
]
| _ -> attr.ArgExpr
{
JsonNumberHandlingArg = Some qualifiedEnumValue
}
else
options
)
let createRecordMaker (spec : JsonParseOutputSpec) (typeName : LongIdent) (fields : SynFieldData<Ident> list) =
let assignments =
fields
|> List.mapi (fun i fieldData ->
let propertyNameAttr =
fieldData.Attrs
|> List.tryFind (fun attr ->
attr.TypeName.AsString.EndsWith ("JsonPropertyName", StringComparison.Ordinal)
)
let options = getParseOptions fieldData.Attrs
let propertyName =
match propertyNameAttr with
| None ->
let sb = StringBuilder fieldData.Ident.idText.Length
sb.Append (Char.ToLowerInvariant fieldData.Ident.idText.[0])
|> ignore<StringBuilder>
if fieldData.Ident.idText.Length > 1 then
sb.Append (fieldData.Ident.idText.Substring 1) |> ignore<StringBuilder>
sb.ToString () |> SynConst.CreateString |> SynExpr.CreateConst
| Some name -> name.ArgExpr
createParseRhs options propertyName fieldData.Type
|> SynBinding.basic (SynLongIdent.CreateString $"arg_%i{i}") []
)
let finalConstruction =
fields
|> List.mapi (fun i fieldData ->
(SynLongIdent.CreateFromLongIdent [ fieldData.Ident ], true),
Some (SynExpr.CreateLongIdent (SynLongIdent.CreateString $"arg_%i{i}"))
)
|> AstHelper.instantiateRecord
(finalConstruction, assignments)
||> List.fold (fun final assignment -> SynExpr.createLet [ assignment ] final)
let createUnionMaker (spec : JsonParseOutputSpec) (typeName : LongIdent) (fields : UnionCase<Ident> list) =
fields
|> List.map (fun case ->
let propertyName = JsonSerializeGenerator.getPropertyName case.Ident case.Attrs
let body =
if case.Fields.IsEmpty then
SynExpr.createLongIdent' (typeName @ [ case.Ident ])
else
case.Fields
|> List.map (fun field ->
let propertyName = JsonSerializeGenerator.getPropertyName field.Ident field.Attrs
let options = getParseOptions field.Attrs
createParseRhs options propertyName field.Type
)
|> SynExpr.CreateParenedTuple
|> SynExpr.applyFunction (SynExpr.createLongIdent' (typeName @ [ case.Ident ]))
|> SynExpr.createLet
[
SynExpr.index (SynExpr.CreateConstString "data") (SynExpr.CreateIdentString "node")
|> assertNotNull (SynExpr.CreateConstString "data")
|> SynBinding.basic (SynLongIdent.CreateString "node") []
]
match propertyName with
| SynExpr.Const (synConst, _) ->
SynMatchClause.SynMatchClause (
SynPat.CreateConst synConst,
None,
body,
range0,
DebugPointAtTarget.Yes,
{
ArrowRange = Some range0
BarRange = Some range0
}
)
| _ ->
SynMatchClause.SynMatchClause (
SynPat.CreateNamed (Ident.Create "x"),
Some (SynExpr.equals (SynExpr.CreateIdentString "x") propertyName),
body,
range0,
DebugPointAtTarget.Yes,
{
ArrowRange = Some range0
BarRange = Some range0
}
)
)
|> fun l ->
l
@ [
let fail =
SynExpr.plus
(SynExpr.CreateConstString "Unrecognised 'type' field value: ")
(SynExpr.CreateIdentString "v")
|> SynExpr.CreateParen
|> SynExpr.applyFunction (SynExpr.CreateIdentString "failwith")
SynModuleDecl.CreateLet [ binding ]
SynMatchClause.SynMatchClause (
SynPat.CreateNamed (Ident.Create "v"),
None,
fail,
range0,
DebugPointAtTarget.Yes,
{
ArrowRange = Some range0
BarRange = Some range0
}
)
]
|> SynExpr.createMatch (SynExpr.CreateIdentString "ty")
|> SynExpr.createLet
[
let property = SynExpr.CreateConstString "type"
let createRecordModule (namespaceId : LongIdent) (spec : JsonParseOutputSpec) (typeDefn : SynTypeDefn) =
SynExpr.CreateIdentString "node"
|> SynExpr.index property
|> assertNotNull property
|> SynExpr.pipeThroughFunction (
SynExpr.createLambda
"v"
(SynExpr.callGenericMethod "GetValue" [ Ident.Create "string" ] (SynExpr.CreateIdentString "v"))
)
|> SynBinding.basic (SynLongIdent.CreateString "ty") []
]
(*
let ty =
match node.["type"] with
| null -> raise (System.Collections.Generic.KeyNotFoundException ())
| v -> v.GetValue<string> ()
match ty with
| "emptyCase" -> FirstDu.EmptyCase
| "case1" ->
FirstDu.Case1
| "case2" -> FirstDu.Case2
| _ -> failwithf "Unrecognised case name: %s" ty
*)
let createModule (namespaceId : LongIdent) (spec : JsonParseOutputSpec) (typeDefn : SynTypeDefn) =
let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) =
typeDefn
let (SynComponentInfo (_attributes, _typeParams, _constraints, recordId, _, _preferPostfix, _access, _)) =
let (SynComponentInfo (_attributes, _typeParams, _constraints, ident, _, _preferPostfix, _access, _)) =
synComponentInfo
match synTypeDefnRepr with
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, recordFields, _recordRange), _) ->
let attributes =
if spec.ExtensionMethods then
[ SynAttributeList.Create SynAttribute.autoOpen ]
else
[
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
SynAttributeList.Create SynAttribute.compilationRepresentation
]
let decls = [ createMaker spec recordId recordFields ]
let xmlDoc =
let fullyQualified = ident |> Seq.map (fun i -> i.idText) |> String.concat "."
let attributes =
let description =
if spec.ExtensionMethods then
[ SynAttributeList.Create SynAttribute.autoOpen ]
"extension members"
else
[
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
SynAttributeList.Create SynAttribute.compilationRepresentation
]
"methods"
let xmlDoc =
let fullyQualified = recordId |> Seq.map (fun i -> i.idText) |> String.concat "."
$" Module containing JSON parsing %s{description} for the %s{fullyQualified} type"
|> PreXmlDoc.Create
let description =
if spec.ExtensionMethods then
"extension members"
else
"methods"
let moduleName =
if spec.ExtensionMethods then
match ident with
| [] -> failwith "unexpectedly got an empty identifier for record name"
| ident ->
let expanded =
List.last ident
|> fun i -> i.idText
|> fun s -> s + "JsonParseExtension"
|> Ident.Create
$" Module containing JSON parsing %s{description} for the %s{fullyQualified} type"
|> PreXmlDoc.Create
List.take (List.length ident - 1) ident @ [ expanded ]
else
ident
let moduleName =
if spec.ExtensionMethods then
match recordId with
| [] -> failwith "unexpectedly got an empty identifier for record name"
| recordId ->
let expanded =
List.last recordId
|> fun i -> i.idText
|> fun s -> s + "JsonParseExtension"
|> Ident.Create
let info =
SynComponentInfo.Create (moduleName, attributes = attributes, xmldoc = xmlDoc)
List.take (List.length recordId - 1) recordId @ [ expanded ]
else
recordId
let decl =
match synTypeDefnRepr with
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, fields, _range), _) ->
let fields = fields |> List.map SynField.extractWithIdent
createRecordMaker spec ident fields
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (_accessibility, cases, _range), _) ->
let optionGet (i : Ident option) =
match i with
| None -> failwith "WoofWare.Myriad requires union cases to have identifiers on each field."
| Some i -> i
let info =
SynComponentInfo.Create (moduleName, attributes = attributes, xmldoc = xmlDoc)
let cases =
cases
|> List.map SynUnionCase.extract
|> List.map (UnionCase.mapIdentFields optionGet)
let mdl = SynModuleDecl.CreateNestedModule (info, decls)
createUnionMaker spec ident cases
| _ -> failwithf "Not a record or union type"
SynModuleOrNamespace.CreateNamespace (namespaceId, decls = [ mdl ])
| _ -> failwithf "Not a record type"
let mdl =
[ scaffolding spec ident decl ]
|> fun d -> SynModuleDecl.CreateNestedModule (info, d)
SynModuleOrNamespace.CreateNamespace (namespaceId, decls = [ mdl ])
/// Myriad generator that provides a method (possibly an extension method) for a record type,
/// containing a JSON parse function.
@@ -617,10 +627,20 @@ type JsonParseGenerator () =
let ast, _ =
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
let records = Ast.extractRecords ast
let recordsAndUnions =
Ast.extractTypeDefn ast
|> List.map (fun (name, defns) ->
defns
|> List.choose (fun defn ->
if Ast.isRecord defn then Some defn
elif Ast.isDu defn then Some defn
else None
)
|> fun defns -> name, defns
)
let namespaceAndRecords =
records
let namespaceAndTypes =
recordsAndUnions
|> List.choose (fun (ns, types) ->
types
|> List.choose (fun typeDef ->
@@ -648,13 +668,9 @@ type JsonParseGenerator () =
)
let modules =
namespaceAndRecords
|> List.collect (fun (ns, records) ->
records
|> List.map (fun (record, spec) ->
let recordModule = JsonParseGenerator.createRecordModule ns spec record
recordModule
)
namespaceAndTypes
|> List.collect (fun (ns, types) ->
types |> List.map (fun (ty, spec) -> JsonParseGenerator.createModule ns spec ty)
)
Output.Ast modules

View File

@@ -30,9 +30,7 @@ module internal JsonSerializeGenerator =
| Uri ->
// JsonValue.Create<type>
SynExpr.TypeApp (
SynExpr.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonValue" ; "Create" ]
),
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonValue" ; "Create" ],
range0,
[ fieldType ],
[],
@@ -42,39 +40,37 @@ module internal JsonSerializeGenerator =
)
| OptionType ty ->
// fun field -> match field with | None -> JsonValue.Create null | Some v -> {serializeNode ty} field
SynExpr.CreateMatch (
SynExpr.CreateIdentString "field",
[
SynMatchClause.Create (
SynPat.CreateLongIdent (SynLongIdent.CreateString "None", []),
None,
// The absolutely galaxy-brained implementation of JsonValue has `JsonValue.Parse "null"`
// identically equal to null. We have to work around this later, but we might as well just
// be efficient here and whip up the null directly.
SynExpr.CreateNull
|> SynExpr.upcast' (
SynType.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
)
[
SynMatchClause.Create (
SynPat.CreateLongIdent (SynLongIdent.CreateString "None", []),
None,
// The absolutely galaxy-brained implementation of JsonValue has `JsonValue.Parse "null"`
// identically equal to null. We have to work around this later, but we might as well just
// be efficient here and whip up the null directly.
SynExpr.CreateNull
|> SynExpr.upcast' (
SynType.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
)
)
)
SynMatchClause.Create (
SynPat.CreateLongIdent (
SynLongIdent.CreateString "Some",
[ SynPat.CreateNamed (Ident.Create "field") ]
),
None,
SynExpr.CreateApp (serializeNode ty, SynExpr.CreateIdentString "field")
|> SynExpr.CreateParen
|> SynExpr.upcast' (
SynType.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
)
SynMatchClause.Create (
SynPat.CreateLongIdent (
SynLongIdent.CreateString "Some",
[ SynPat.CreateNamed (Ident.Create "field") ]
),
None,
SynExpr.CreateApp (serializeNode ty, SynExpr.CreateIdentString "field")
|> SynExpr.CreateParen
|> SynExpr.upcast' (
SynType.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
)
)
]
)
)
]
|> SynExpr.createMatch (SynExpr.CreateIdentString "field")
|> SynExpr.createLambda "field"
| ArrayType ty
| ListType ty ->
@@ -82,116 +78,86 @@ module internal JsonSerializeGenerator =
// let arr = JsonArray ()
// for mem in field do arr.Add ({serializeNode} mem)
// arr
SynExpr.LetOrUse (
false,
false,
[
SynExpr.ForEach (
DebugPointAtFor.Yes range0,
DebugPointAtInOrTo.Yes range0,
SeqExprOnly.SeqExprOnly false,
true,
SynPat.CreateNamed (Ident.Create "mem"),
SynExpr.CreateIdent (Ident.Create "field"),
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "arr" ; "Add" ]),
SynExpr.CreateParen (SynExpr.CreateApp (serializeNode ty, SynExpr.CreateIdentString "mem"))
),
range0
)
SynExpr.CreateIdentString "arr"
]
|> SynExpr.CreateSequential
|> SynExpr.createLet
[
SynBinding.Let (
pattern = SynPat.CreateNamed (Ident.Create "arr"),
expr =
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonArray" ]
),
SynExpr.CreateConst SynConst.Unit
)
)
],
SynExpr.CreateSequential
[
SynExpr.ForEach (
DebugPointAtFor.Yes range0,
DebugPointAtInOrTo.Yes range0,
SeqExprOnly.SeqExprOnly false,
true,
SynPat.CreateNamed (Ident.Create "mem"),
SynExpr.CreateIdent (Ident.Create "field"),
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "arr" ; "Add" ]),
SynExpr.CreateParen (
SynExpr.CreateApp (serializeNode ty, SynExpr.CreateIdentString "mem")
)
),
range0
)
SynExpr.CreateIdentString "arr"
],
range0,
{
InKeyword = None
}
)
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonArray" ]
|> SynExpr.applyTo (SynExpr.CreateConst SynConst.Unit)
|> SynBinding.basic (SynLongIdent.CreateString "arr") []
]
|> SynExpr.createLambda "field"
| IDictionaryType (keyType, valueType)
| DictionaryType (keyType, valueType)
| IReadOnlyDictionaryType (keyType, valueType)
| MapType (keyType, valueType) ->
| IDictionaryType (_keyType, valueType)
| DictionaryType (_keyType, valueType)
| IReadOnlyDictionaryType (_keyType, valueType)
| MapType (_keyType, valueType) ->
// fun field ->
// let ret = JsonObject ()
// for (KeyValue(key, value)) in field do
// ret.Add (key.ToString (), {serializeNode} value)
// ret
SynExpr.LetOrUse (
false,
false,
[
SynBinding.Let (
pattern = SynPat.CreateNamed (Ident.Create "ret"),
expr =
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
),
SynExpr.CreateConst SynConst.Unit
)
)
],
SynExpr.CreateSequential
[
SynExpr.ForEach (
DebugPointAtFor.Yes range0,
DebugPointAtInOrTo.Yes range0,
SeqExprOnly.SeqExprOnly false,
true,
SynPat.CreateParen (
SynPat.CreateLongIdent (
SynLongIdent.CreateString "KeyValue",
[
SynPat.CreateParen (
SynPat.Tuple (
false,
[
SynPat.CreateNamed (Ident.Create "key")
SynPat.CreateNamed (Ident.Create "value")
],
[ range0 ],
range0
)
)
]
[
SynExpr.ForEach (
DebugPointAtFor.Yes range0,
DebugPointAtInOrTo.Yes range0,
SeqExprOnly.SeqExprOnly false,
true,
SynPat.CreateParen (
SynPat.CreateLongIdent (
SynLongIdent.CreateString "KeyValue",
[
SynPat.CreateParen (
SynPat.Tuple (
false,
[
SynPat.CreateNamed (Ident.Create "key")
SynPat.CreateNamed (Ident.Create "value")
],
[ range0 ],
range0
)
)
),
SynExpr.CreateIdent (Ident.Create "field"),
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "ret" ; "Add" ]),
SynExpr.CreateParenedTuple
[
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "key" ; "ToString" ]),
SynExpr.CreateConst SynConst.Unit
)
SynExpr.CreateApp (serializeNode valueType, SynExpr.CreateIdentString "value")
]
),
range0
]
)
SynExpr.CreateIdentString "ret"
],
range0,
{
InKeyword = None
}
)
),
SynExpr.CreateIdent (Ident.Create "field"),
SynExpr.CreateApp (
SynExpr.createLongIdent [ "ret" ; "Add" ],
SynExpr.CreateParenedTuple
[
SynExpr.CreateApp (
SynExpr.createLongIdent [ "key" ; "ToString" ],
SynExpr.CreateConst SynConst.Unit
)
SynExpr.CreateApp (serializeNode valueType, SynExpr.CreateIdentString "value")
]
),
range0
)
SynExpr.CreateIdentString "ret"
]
|> SynExpr.CreateSequential
|> SynExpr.createLet
[
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
|> SynExpr.applyTo (SynExpr.CreateConst SynConst.Unit)
|> SynBinding.basic (SynLongIdent.CreateString "ret") []
]
|> SynExpr.createLambda "field"
| _ ->
// {type}.toJsonNode
@@ -200,180 +166,79 @@ module internal JsonSerializeGenerator =
| SynType.LongIdent ident -> ident.LongIdent
| _ -> failwith $"Unrecognised type: %+A{fieldType}"
SynExpr.CreateLongIdent (SynLongIdent.CreateFromLongIdent (typeName @ [ Ident.Create "toJsonNode" ]))
SynExpr.createLongIdent' (typeName @ [ Ident.Create "toJsonNode" ])
/// propertyName is probably a string literal, but it could be a [<Literal>] variable
/// `node.Add ({propertyName}, {toJsonNode})`
let createSerializeRhs (propertyName : SynExpr) (fieldId : Ident) (fieldType : SynType) : SynExpr =
let func = SynExpr.CreateLongIdent (SynLongIdent.Create [ "node" ; "Add" ])
let createSerializeRhsRecord (propertyName : SynExpr) (fieldId : Ident) (fieldType : SynType) : SynExpr =
[
propertyName
SynExpr.CreateApp (serializeNode fieldType, SynExpr.createLongIdent' [ Ident.Create "input" ; fieldId ])
]
|> SynExpr.CreateParenedTuple
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ])
let args =
SynExpr.CreateParenedTuple
[
propertyName
SynExpr.CreateApp (
serializeNode fieldType,
SynExpr.CreateLongIdent (SynLongIdent.CreateFromLongIdent [ Ident.Create "input" ; fieldId ])
)
]
let getPropertyName (fieldId : Ident) (attrs : SynAttribute list) : SynExpr =
let propertyNameAttr =
attrs
|> List.tryFind (fun attr -> attr.TypeName.AsString.EndsWith ("JsonPropertyName", StringComparison.Ordinal))
SynExpr.CreateApp (func, args)
match propertyNameAttr with
| None ->
let sb = StringBuilder fieldId.idText.Length
sb.Append (Char.ToLowerInvariant fieldId.idText.[0]) |> ignore
let createMaker (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (fields : SynField list) =
if fieldId.idText.Length > 1 then
sb.Append fieldId.idText.[1..] |> ignore
sb.ToString () |> SynConst.CreateString |> SynExpr.CreateConst
| Some name -> name.ArgExpr
/// `populateNode` will be inserted before we return the `node` variable.
///
/// That is, we give you access to a `JsonObject` called `node`,
/// and you have access to a variable `inputArgName` which is of type `typeName`.
/// Your job is to provide a `populateNode` expression which has the side effect
/// of mutating `node` to faithfully reflect the value of `inputArgName`.
let scaffolding
(spec : JsonSerializeOutputSpec)
(typeName : LongIdent)
(inputArgName : Ident)
(populateNode : SynExpr)
: SynModuleDecl
=
let xmlDoc = PreXmlDoc.Create " Serialize to a JSON node"
let returnInfo =
SynBindingReturnInfo.Create (
SynType.LongIdent (SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
)
SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
|> SynType.LongIdent
let inputArg = Ident.Create "input"
let functionName = Ident.Create "toJsonNode"
let inputVal =
let memberFlags =
if spec.ExtensionMethods then
{
SynMemberFlags.IsInstance = false
SynMemberFlags.IsDispatchSlot = false
SynMemberFlags.IsOverrideOrExplicitImpl = false
SynMemberFlags.IsFinal = false
SynMemberFlags.GetterOrSetterIsCompilerGenerated = false
SynMemberFlags.MemberKind = SynMemberKind.Member
}
|> Some
else
None
let thisIdOpt = if spec.ExtensionMethods then None else Some inputArg
SynValData.SynValData (
memberFlags,
SynValInfo.SynValInfo ([ [ SynArgInfo.CreateId functionName ] ], SynArgInfo.Empty),
thisIdOpt
)
let assignments =
fields
|> List.map (fun (SynField (attrs, _, id, fieldType, _, _, _, _, _)) ->
let id =
match id with
| None -> failwith "didn't get an ID on field"
| Some id -> id
let attrs = attrs |> List.collect (fun l -> l.Attributes)
let propertyNameAttr =
attrs
|> List.tryFind (fun attr ->
attr.TypeName.AsString.EndsWith ("JsonPropertyName", StringComparison.Ordinal)
)
let propertyName =
match propertyNameAttr with
| None ->
let sb = StringBuilder id.idText.Length
sb.Append (Char.ToLowerInvariant id.idText.[0]) |> ignore
if id.idText.Length > 1 then
sb.Append id.idText.[1..] |> ignore
sb.ToString () |> SynConst.CreateString |> SynExpr.CreateConst
| Some name -> name.ArgExpr
let pattern =
SynPat.LongIdent (
SynLongIdent.CreateFromLongIdent [ id ],
None,
None,
SynArgPats.Empty,
None,
range0
)
createSerializeRhs propertyName id fieldType
)
let finalConstruction =
fields
|> List.map (fun (SynField (_, _, id, _, _, _, _, _, _)) ->
let id =
match id with
| None -> failwith "Expected record field to have an identifying name"
| Some id -> id
(SynLongIdent.CreateFromLongIdent [ id ], true),
Some (SynExpr.CreateLongIdent (SynLongIdent.CreateFromLongIdent [ id ]))
)
|> AstHelper.instantiateRecord
let assignments = assignments |> SynExpr.CreateSequential
let assignments =
SynExpr.LetOrUse (
false,
false,
[
populateNode
SynExpr.Upcast (SynExpr.CreateIdentString "node", SynType.Anon range0, range0)
]
|> SynExpr.CreateSequential
|> SynExpr.createLet
[
SynBinding.Let (
pattern = SynPat.CreateNamed (Ident.Create "node"),
expr =
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
),
SynExpr.CreateConst SynConst.Unit
)
)
],
SynExpr.CreateSequential
[
SynExpr.Do (assignments, range0)
SynExpr.Upcast (SynExpr.CreateIdentString "node", SynType.Anon range0, range0)
],
range0,
{
InKeyword = None
}
)
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
|> SynExpr.applyTo (SynExpr.CreateConst SynConst.Unit)
|> SynBinding.basic (SynLongIdent.CreateString "node") []
]
let pattern =
SynPat.LongIdent (
SynLongIdent.CreateFromLongIdent [ functionName ],
None,
None,
SynArgPats.Pats
[
SynPat.CreateTyped (
SynPat.CreateNamed inputArg,
SynType.LongIdent (SynLongIdent.CreateFromLongIdent typeName)
)
|> SynPat.CreateParen
],
None,
range0
)
SynPat.CreateNamed inputArgName
|> SynPat.annotateType (SynType.LongIdent (SynLongIdent.CreateFromLongIdent typeName))
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
}
)
assignments
|> SynBinding.basic (SynLongIdent.CreateFromLongIdent [ functionName ]) [ pattern ]
|> SynBinding.withXmlDoc xmlDoc
|> SynBinding.withReturnAnnotation returnInfo
|> SynBinding.makeStaticMember
let mem = SynMemberDefn.Member (binding, range0)
@@ -394,19 +259,108 @@ module internal JsonSerializeGenerator =
SynModuleDecl.Types ([ containingType ], range0)
else
let binding =
SynBinding.Let (
isInline = false,
isMutable = false,
xmldoc = xmlDoc,
returnInfo = returnInfo,
expr = assignments,
valData = inputVal,
pattern = pattern
)
assignments
|> SynBinding.basic (SynLongIdent.CreateFromLongIdent [ functionName ]) [ pattern ]
|> SynBinding.withReturnAnnotation returnInfo
|> SynBinding.withXmlDoc xmlDoc
SynModuleDecl.CreateLet [ binding ]
let createRecordModule
let recordModule (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (fields : SynField list) =
let inputArg = Ident.Create "input"
let fields = fields |> List.map SynField.extractWithIdent
fields
|> List.map (fun fieldData ->
let propertyName = getPropertyName fieldData.Ident fieldData.Attrs
createSerializeRhsRecord propertyName fieldData.Ident fieldData.Type
)
|> SynExpr.CreateSequential
|> fun expr -> SynExpr.Do (expr, range0)
|> scaffolding spec typeName inputArg
let unionModule (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (cases : SynUnionCase list) =
let inputArg = Ident.Create "input"
let fields = cases |> List.map SynUnionCase.extract
fields
|> List.map (fun unionCase ->
let propertyName = getPropertyName unionCase.Ident unionCase.Attrs
let caseNames = unionCase.Fields |> List.mapi (fun i _ -> Ident.Create $"arg%i{i}")
let argPats = SynArgPats.create caseNames
let pattern =
SynPat.LongIdent (
SynLongIdent.CreateFromLongIdent (typeName @ [ unionCase.Ident ]),
None,
None,
argPats,
None,
range0
)
let typeLine =
[
SynExpr.CreateConstString "type"
SynExpr.CreateApp (
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonValue" ; "Create" ],
propertyName
)
]
|> SynExpr.CreateParenedTuple
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ])
let dataNode =
SynBinding.Let (
pattern = SynPat.CreateNamed (Ident.Create "dataNode"),
expr =
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
),
SynExpr.CreateConst SynConst.Unit
)
)
let dataBindings =
(unionCase.Fields, caseNames)
||> List.zip
|> List.map (fun (fieldData, caseName) ->
let propertyName = getPropertyName (Option.get fieldData.Ident) fieldData.Attrs
let node =
SynExpr.CreateApp (serializeNode fieldData.Type, SynExpr.CreateIdent caseName)
[ propertyName ; node ]
|> SynExpr.CreateParenedTuple
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "dataNode" ; "Add" ])
)
let assignToNode =
[ SynExpr.CreateConstString "data" ; SynExpr.CreateIdentString "dataNode" ]
|> SynExpr.CreateParenedTuple
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ])
let dataNode =
SynExpr.CreateSequential (dataBindings @ [ assignToNode ])
|> SynExpr.createLet [ dataNode ]
let action =
[
yield typeLine
if not dataBindings.IsEmpty then
yield dataNode
]
|> SynExpr.CreateSequential
SynMatchClause.Create (pattern, None, action)
)
|> fun clauses -> SynExpr.CreateMatch (SynExpr.CreateIdent inputArg, clauses)
|> scaffolding spec typeName inputArg
let createModule
(namespaceId : LongIdent)
(opens : SynOpenDeclTarget list)
(spec : JsonSerializeOutputSpec)
@@ -415,60 +369,62 @@ module internal JsonSerializeGenerator =
let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) =
typeDefn
let (SynComponentInfo (_attributes, _typeParams, _constraints, recordId, _, _preferPostfix, _access, _)) =
let (SynComponentInfo (_attributes, _typeParams, _constraints, ident, _, _preferPostfix, _access, _)) =
synComponentInfo
match synTypeDefnRepr with
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, recordFields, _recordRange), _) ->
let attributes =
if spec.ExtensionMethods then
[ SynAttributeList.Create SynAttribute.autoOpen ]
else
[
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
SynAttributeList.Create SynAttribute.compilationRepresentation
]
let decls = [ createMaker spec recordId recordFields ]
let xmlDoc =
let fullyQualified = ident |> Seq.map (fun i -> i.idText) |> String.concat "."
let attributes =
let description =
if spec.ExtensionMethods then
[ SynAttributeList.Create SynAttribute.autoOpen ]
"extension members"
else
[
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
SynAttributeList.Create SynAttribute.compilationRepresentation
]
"methods"
let xmlDoc =
let fullyQualified = recordId |> Seq.map (fun i -> i.idText) |> String.concat "."
$" Module containing JSON serializing %s{description} for the %s{fullyQualified} type"
|> PreXmlDoc.Create
let description =
if spec.ExtensionMethods then
"extension members"
else
"methods"
let moduleName =
if spec.ExtensionMethods then
match ident with
| [] -> failwith "unexpectedly got an empty identifier for type name"
| ident ->
let expanded =
List.last ident
|> fun i -> i.idText
|> fun s -> s + "JsonSerializeExtension"
|> Ident.Create
$" Module containing JSON serializing %s{description} for the %s{fullyQualified} type"
|> PreXmlDoc.Create
List.take (List.length ident - 1) ident @ [ expanded ]
else
ident
let moduleName =
if spec.ExtensionMethods then
match recordId with
| [] -> failwith "unexpectedly got an empty identifier for record name"
| recordId ->
let expanded =
List.last recordId
|> fun i -> i.idText
|> fun s -> s + "JsonSerializeExtension"
|> Ident.Create
let info =
SynComponentInfo.Create (moduleName, attributes = attributes, xmldoc = xmlDoc)
List.take (List.length recordId - 1) recordId @ [ expanded ]
else
recordId
let decls =
match synTypeDefnRepr with
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, recordFields, _range), _) ->
[ recordModule spec ident recordFields ]
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (_accessibility, unionFields, _range), _) ->
[ unionModule spec ident unionFields ]
| _ -> failwithf "Only record types currently supported."
let info =
SynComponentInfo.Create (moduleName, attributes = attributes, xmldoc = xmlDoc)
let mdl = SynModuleDecl.CreateNestedModule (info, decls)
let mdl = SynModuleDecl.CreateNestedModule (info, decls)
SynModuleOrNamespace.CreateNamespace (
namespaceId,
decls = (opens |> List.map SynModuleDecl.CreateOpen) @ [ mdl ]
)
| _ -> failwithf "Not a record type"
SynModuleOrNamespace.CreateNamespace (
namespaceId,
decls = (opens |> List.map SynModuleDecl.CreateOpen) @ [ mdl ]
)
/// Myriad generator that provides a method (possibly an extension method) for a record type,
/// containing a JSON serialization function.
@@ -482,10 +438,20 @@ type JsonSerializeGenerator () =
let ast, _ =
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
let records = Ast.extractRecords ast
let recordsAndUnions =
Ast.extractTypeDefn ast
|> List.map (fun (name, defns) ->
defns
|> List.choose (fun defn ->
if Ast.isRecord defn then Some defn
elif Ast.isDu defn then Some defn
else None
)
|> fun defns -> name, defns
)
let namespaceAndRecords =
records
let namespaceAndTypes =
recordsAndUnions
|> List.choose (fun (ns, types) ->
types
|> List.choose (fun typeDef ->
@@ -515,13 +481,10 @@ type JsonSerializeGenerator () =
let opens = AstHelper.extractOpens ast
let modules =
namespaceAndRecords
|> List.collect (fun (ns, records) ->
records
|> List.map (fun (record, spec) ->
let recordModule = JsonSerializeGenerator.createRecordModule ns opens spec record
recordModule
)
namespaceAndTypes
|> List.collect (fun (ns, types) ->
types
|> List.map (fun (ty, spec) -> JsonSerializeGenerator.createModule ns opens spec ty)
)
Output.Ast modules

View File

@@ -63,7 +63,7 @@ module internal RemoveOptionsGenerator =
SynModuleDecl.Types ([ typeDecl ], range0)
let createMaker (withOptionsType : LongIdent) (withoutOptionsType : LongIdent) (fields : SynField list) =
let createMaker (withOptionsType : LongIdent) (withoutOptionsType : LongIdent) (fields : SynFieldData<Ident> list) =
let xmlDoc = PreXmlDoc.Create " Remove the optional members of the input."
let returnInfo =
@@ -81,17 +81,17 @@ module internal RemoveOptionsGenerator =
let body =
fields
|> List.map (fun (SynField (_, _, id, fieldType, _, _, _, _, _)) ->
let id =
match id with
| None -> failwith "Expected record field to have an identifying name"
| Some id -> id
|> List.map (fun fieldData ->
let accessor =
SynExpr.LongIdent (false, SynLongIdent ([ inputArg ; id ], [ range0 ], []), None, range0)
SynExpr.LongIdent (
false,
SynLongIdent ([ inputArg ; fieldData.Ident ], [ range0 ], []),
None,
range0
)
let body =
match fieldType with
match fieldData.Type with
| OptionType _ ->
SynExpr.CreateApp (
SynExpr.CreateAppInfix (
@@ -111,14 +111,15 @@ module internal RemoveOptionsGenerator =
SynExpr.CreateLongIdent (SynLongIdent.CreateString "Option.defaultWith"),
SynExpr.CreateLongIdent (
SynLongIdent.CreateFromLongIdent (
withoutOptionsType @ [ Ident.Create (sprintf "Default%s" id.idText) ]
withoutOptionsType
@ [ Ident.Create (sprintf "Default%s" fieldData.Ident.idText) ]
)
)
)
)
| _ -> accessor
(SynLongIdent.CreateFromLongIdent [ id ], true), Some body
(SynLongIdent.CreateFromLongIdent [ fieldData.Ident ], true), Some body
)
|> AstHelper.instantiateRecord
@@ -160,12 +161,13 @@ module internal RemoveOptionsGenerator =
synComponentInfo
match synTypeDefnRepr with
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (accessibility, recordFields, _recordRange), _) ->
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (accessibility, fields, _range), _) ->
let fieldData = fields |> List.map SynField.extractWithIdent
let decls =
[
createType (Some doc) accessibility typeParams recordFields
createMaker [ Ident.Create "Short" ] recordId recordFields
createType (Some doc) accessibility typeParams fields
createMaker [ Ident.Create "Short" ] recordId fieldData
]
let attributes =

View File

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

View File

@@ -0,0 +1,173 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Xml
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal SynBinding =
let rec private stripParen (pat : SynPat) =
match pat with
| SynPat.Paren (p, _) -> stripParen p
| _ -> pat
let rec private getName (pat : SynPat) : Ident option =
match stripParen pat with
| SynPat.Named (SynIdent.SynIdent (name, _), _, _, _) -> Some name
| SynPat.Wild _ -> None
| SynPat.Typed (pat, _, _) -> getName pat
| SynPat.Const _ -> None
| SynPat.LongIdent (SynLongIdent.SynLongIdent (longIdent, _, _), _, _, _, _, _) ->
match longIdent with
| [ x ] -> Some x
| _ -> failwithf "got long ident %O ; can only get the name of a long ident with one component" longIdent
| _ -> failwithf "unrecognised pattern: %+A" pat
let triviaZero (isMember : bool) =
{
SynBindingTrivia.EqualsRange = Some range0
InlineKeyword = None
LeadingKeyword =
if isMember then
SynLeadingKeyword.Member range0
else
SynLeadingKeyword.Let range0
}
let basic (name : SynLongIdent) (args : SynPat list) (body : SynExpr) : SynBinding =
let valInfo : SynValInfo =
args
|> List.map (fun pat -> [ SynArgInfo.SynArgInfo (SynAttributes.Empty, false, getName pat) ])
|> fun x -> SynValInfo.SynValInfo (x, SynArgInfo.SynArgInfo ([], false, None))
SynBinding.SynBinding (
None,
SynBindingKind.Normal,
false,
false,
[],
PreXmlDoc.Empty,
SynValData.SynValData (None, valInfo, None),
SynPat.LongIdent (name, None, None, SynArgPats.Pats args, None, range0),
None,
body,
range0,
DebugPointAtBinding.Yes range0,
triviaZero false
)
let withAccessibility (acc : SynAccess option) (binding : SynBinding) : SynBinding =
match binding with
| SynBinding (_, kind, inl, mut, attrs, xml, valData, headPat, returnInfo, expr, range, debugPoint, trivia) ->
let headPat =
match headPat with
| SynPat.LongIdent (ident, extra, options, argPats, _, range) ->
SynPat.LongIdent (ident, extra, options, argPats, acc, range)
| _ -> failwithf "unrecognised head pattern: %O" headPat
SynBinding (acc, kind, inl, mut, attrs, xml, valData, headPat, returnInfo, expr, range, debugPoint, trivia)
let withXmlDoc (doc : PreXmlDoc) (binding : SynBinding) : SynBinding =
match binding with
| SynBinding (acc, kind, inl, mut, attrs, _, valData, headPat, returnInfo, expr, range, debugPoint, trivia) ->
SynBinding (acc, kind, inl, mut, attrs, doc, valData, headPat, returnInfo, expr, range, debugPoint, trivia)
let withReturnAnnotation (ty : SynType) (binding : SynBinding) : SynBinding =
match binding with
| SynBinding (acc, kind, inl, mut, attrs, doc, valData, headPat, _, expr, range, debugPoint, trivia) ->
let retInfo =
SynBindingReturnInfo.SynBindingReturnInfo (
ty,
range0,
[],
{
ColonRange = Some range0
}
)
SynBinding (
acc,
kind,
inl,
mut,
attrs,
doc,
valData,
headPat,
Some retInfo,
expr,
range,
debugPoint,
trivia
)
let makeInline (binding : SynBinding) : SynBinding =
match binding with
| SynBinding (acc, kind, _, mut, attrs, doc, valData, headPat, ret, expr, range, debugPoint, trivia) ->
SynBinding (
acc,
kind,
true,
mut,
attrs,
doc,
valData,
headPat,
ret,
expr,
range,
debugPoint,
{ trivia with
InlineKeyword = Some range0
}
)
let makeStaticMember (binding : SynBinding) : SynBinding =
let memberFlags =
{
SynMemberFlags.IsInstance = false
SynMemberFlags.IsDispatchSlot = false
SynMemberFlags.IsOverrideOrExplicitImpl = false
SynMemberFlags.IsFinal = false
SynMemberFlags.GetterOrSetterIsCompilerGenerated = false
SynMemberFlags.MemberKind = SynMemberKind.Member
}
match binding with
| SynBinding (acc, kind, inl, mut, attrs, doc, valData, headPat, ret, expr, range, debugPoint, trivia) ->
let valData =
match valData with
| SynValData.SynValData (_, valInfo, _) -> SynValData.SynValData (Some memberFlags, valInfo, None)
let trivia =
{ trivia with
LeadingKeyword = SynLeadingKeyword.StaticMember (range0, range0)
}
SynBinding (acc, kind, inl, mut, attrs, doc, valData, headPat, ret, expr, range, debugPoint, trivia)
let makeInstanceMember (binding : SynBinding) : SynBinding =
let memberFlags =
{
SynMemberFlags.IsInstance = true
SynMemberFlags.IsDispatchSlot = false
SynMemberFlags.IsOverrideOrExplicitImpl = true
SynMemberFlags.IsFinal = false
SynMemberFlags.GetterOrSetterIsCompilerGenerated = false
SynMemberFlags.MemberKind = SynMemberKind.Member
}
match binding with
| SynBinding (acc, kind, inl, mut, attrs, doc, valData, headPat, ret, expr, range, debugPoint, trivia) ->
let valData =
match valData with
| SynValData.SynValData (_, valInfo, _) -> SynValData.SynValData (Some memberFlags, valInfo, None)
let trivia =
{ trivia with
LeadingKeyword = SynLeadingKeyword.Member range0
}
SynBinding (acc, kind, inl, mut, attrs, doc, valData, headPat, ret, expr, range, debugPoint, trivia)

View File

@@ -15,21 +15,25 @@ type internal CompExprBinding =
[<RequireQualifiedAccess>]
module internal SynExpr =
/// {f} {x}
let applyFunction (f : SynExpr) (x : SynExpr) : SynExpr = SynExpr.CreateApp (f, x)
/// {f} {x}
let applyTo (x : SynExpr) (f : SynExpr) : SynExpr = SynExpr.CreateApp (f, x)
/// {expr} |> {func}
let pipeThroughFunction (func : SynExpr) (expr : SynExpr) : SynExpr =
SynExpr.CreateApp (
SynExpr.CreateAppInfix (
SynExpr.CreateLongIdent (
SynLongIdent.SynLongIdent (
[ Ident.Create "op_PipeRight" ],
[],
[ Some (IdentTrivia.OriginalNotation "|>") ]
)
),
expr
SynExpr.CreateAppInfix (
SynExpr.CreateLongIdent (
SynLongIdent.SynLongIdent (
[ Ident.Create "op_PipeRight" ],
[],
[ Some (IdentTrivia.OriginalNotation "|>") ]
)
),
func
expr
)
|> applyTo func
/// if {cond} then {trueBranch} else {falseBranch}
/// Note that this function puts the trueBranch last, for pipelining convenience:
@@ -72,89 +76,75 @@ module internal SynExpr =
/// {a} = {b}
let equals (a : SynExpr) (b : SynExpr) =
SynExpr.CreateApp (
SynExpr.CreateAppInfix (
SynExpr.CreateLongIdent (
SynLongIdent.SynLongIdent (
Ident.CreateLong "op_Equality",
[],
[ Some (IdentTrivia.OriginalNotation "=") ]
)
),
a
SynExpr.CreateAppInfix (
SynExpr.CreateLongIdent (
SynLongIdent.SynLongIdent (
Ident.CreateLong "op_Equality",
[],
[ Some (IdentTrivia.OriginalNotation "=") ]
)
),
b
a
)
|> applyTo b
/// {a} + {b}
let plus (a : SynExpr) (b : SynExpr) =
SynExpr.CreateApp (
SynExpr.CreateAppInfix (
SynExpr.CreateLongIdent (
SynLongIdent.SynLongIdent (
Ident.CreateLong "op_Addition",
[],
[ Some (IdentTrivia.OriginalNotation "+") ]
)
),
a
SynExpr.CreateAppInfix (
SynExpr.CreateLongIdent (
SynLongIdent.SynLongIdent (
Ident.CreateLong "op_Addition",
[],
[ Some (IdentTrivia.OriginalNotation "+") ]
)
),
b
a
)
|> applyTo b
let rec stripOptionalParen (expr : SynExpr) : SynExpr =
match expr with
| SynExpr.Paren (expr, _, _, _) -> stripOptionalParen expr
| expr -> expr
/// Given e.g. "byte", returns "System.Byte".
let qualifyPrimitiveType (typeName : string) : LongIdent =
match typeName with
| "float32" -> [ "System" ; "Single" ]
| "float" -> [ "System" ; "Double" ]
| "byte"
| "uint8" -> [ "System" ; "Byte" ]
| "sbyte" -> [ "System" ; "SByte" ]
| "int16" -> [ "System" ; "Int16" ]
| "int" -> [ "System" ; "Int32" ]
| "int64" -> [ "System" ; "Int64" ]
| "uint16" -> [ "System" ; "UInt16" ]
| "uint"
| "uint32" -> [ "System" ; "UInt32" ]
| "uint64" -> [ "System" ; "UInt64" ]
| _ -> failwith $"Unable to identify a parsing function `string -> %s{typeName}`"
|> List.map Ident.Create
/// {obj}.{meth} {arg}
let callMethodArg (meth : string) (arg : SynExpr) (obj : SynExpr) : SynExpr =
SynExpr.CreateApp (
SynExpr.DotGet (
obj,
range0,
SynLongIdent.SynLongIdent (id = [ Ident.Create meth ], dotRanges = [], trivia = [ None ]),
range0
),
arg
SynExpr.DotGet (
obj,
range0,
SynLongIdent.SynLongIdent (id = [ Ident.Create meth ], dotRanges = [], trivia = [ None ]),
range0
)
|> applyTo arg
/// {obj}.{meth}()
let callMethod (meth : string) (obj : SynExpr) : SynExpr =
callMethodArg meth (SynExpr.CreateConst SynConst.Unit) obj
/// {obj}.{meth}<ty>()
let callGenericMethod (meth : string) (ty : string) (obj : SynExpr) : SynExpr =
SynExpr.CreateApp (
SynExpr.TypeApp (
SynExpr.DotGet (obj, range0, SynLongIdent.Create [ meth ], range0),
range0,
[ SynType.CreateLongIdent ty ],
[],
Some range0,
range0,
range0
),
SynExpr.CreateConst SynConst.Unit
let callGenericMethod (meth : string) (ty : LongIdent) (obj : SynExpr) : SynExpr =
SynExpr.TypeApp (
SynExpr.DotGet (obj, range0, SynLongIdent.Create [ meth ], range0),
range0,
[ SynType.LongIdent (SynLongIdent.CreateFromLongIdent ty) ],
[],
Some range0,
range0,
range0
)
|> applyTo (SynExpr.CreateConst SynConst.Unit)
/// {obj}.{meth}<ty>()
let callGenericMethod' (meth : string) (ty : string) (obj : SynExpr) : SynExpr =
SynExpr.TypeApp (
SynExpr.DotGet (obj, range0, SynLongIdent.Create [ meth ], range0),
range0,
[ SynType.CreateLongIdent ty ],
[],
Some range0,
range0,
range0
)
|> applyTo (SynExpr.CreateConst SynConst.Unit)
let index (property : SynExpr) (obj : SynExpr) : SynExpr =
SynExpr.DotIndexedGet (obj, property, range0, range0)
@@ -177,25 +167,37 @@ module internal SynExpr =
|> SynExpr.CreateParen
let reraise : SynExpr =
SynExpr.CreateApp (SynExpr.CreateIdent (Ident.Create "reraise"), SynExpr.CreateConst SynConst.Unit)
SynExpr.CreateIdent (Ident.Create "reraise")
|> applyTo (SynExpr.CreateConst SynConst.Unit)
/// {body} |> fun a -> Async.StartAsTask (a, ?cancellationToken=ct)
let startAsTask (ct : SynLongIdent) (body : SynExpr) =
let lambda =
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "StartAsTask" ]),
SynExpr.CreateParenedTuple
[
SynExpr.CreateLongIdent (SynLongIdent.CreateString "a")
equals
(SynExpr.LongIdent (true, SynLongIdent.CreateString "cancellationToken", None, range0))
(SynExpr.CreateLongIdent ct)
]
)
[
SynExpr.CreateLongIdent (SynLongIdent.CreateString "a")
equals
(SynExpr.LongIdent (true, SynLongIdent.CreateString "cancellationToken", None, range0))
(SynExpr.CreateLongIdent ct)
]
|> SynExpr.CreateParenedTuple
|> applyFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "StartAsTask" ]))
|> createLambda "a"
pipeThroughFunction lambda body
let createLongIdent (ident : string list) : SynExpr =
SynExpr.CreateLongIdent (SynLongIdent.Create ident)
let createLongIdent' (ident : Ident list) : SynExpr =
SynExpr.CreateLongIdent (SynLongIdent.CreateFromLongIdent ident)
let createLet (bindings : SynBinding list) (body : SynExpr) : SynExpr =
SynExpr.LetOrUse (false, false, bindings, body, range0, SynExprLetOrUseTrivia.empty)
let createMatch (matchOn : SynExpr) (cases : SynMatchClause list) : SynExpr = SynExpr.CreateMatch (matchOn, cases)
let typeAnnotate (ty : SynType) (expr : SynExpr) : SynExpr = SynExpr.CreateTyped (expr, ty)
/// {compExpr} { {lets} ; return {ret} }
let createCompExpr (compExpr : string) (retBody : SynExpr) (lets : CompExprBinding list) : SynExpr =
let retStatement = SynExpr.YieldOrReturn ((false, true), retBody, range0)
@@ -219,16 +221,7 @@ module internal SynExpr =
}
)
| Let (lhs, rhs) ->
SynExpr.LetOrUse (
false,
false,
[ SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create lhs), expr = rhs) ],
state,
range0,
{
SynExprLetOrUseTrivia.InKeyword = None
}
)
createLet [ SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create lhs), expr = rhs) ] state
| Use (lhs, rhs) ->
SynExpr.LetOrUse (
false,
@@ -265,17 +258,6 @@ module internal SynExpr =
let upcast' (ty : SynType) (e : SynExpr) = SynExpr.Upcast (e, ty, range0)
let synBindingTriviaZero (isMember : bool) =
{
SynBindingTrivia.EqualsRange = Some range0
InlineKeyword = None
LeadingKeyword =
if isMember then
SynLeadingKeyword.Member range0
else
SynLeadingKeyword.Let range0
}
/// {ident} - {rhs}
let minus (ident : SynLongIdent) (rhs : SynExpr) : SynExpr =
SynExpr.CreateApp (
@@ -311,3 +293,17 @@ module internal SynExpr =
),
x
)
/// {y} >= {x}
let greaterThanOrEqual (x : SynExpr) (y : SynExpr) : SynExpr =
SynExpr.CreateAppInfix (
SynExpr.CreateLongIdent (
SynLongIdent.SynLongIdent (
[ Ident.Create "op_GreaterThanOrEqual" ],
[],
[ Some (IdentTrivia.OriginalNotation ">=") ]
)
),
y
)
|> applyTo x

View File

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

View File

@@ -0,0 +1,39 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
type internal SynFieldData<'Ident> =
{
Attrs : SynAttribute list
Ident : 'Ident
Type : SynType
}
[<RequireQualifiedAccess>]
module internal SynField =
/// Get the useful information out of a SynField.
let extract (SynField (attrs, _, id, fieldType, _, _, _, _, _)) : SynFieldData<Ident option> =
{
Attrs = attrs |> List.collect (fun l -> l.Attributes)
Ident = id
Type = fieldType
}
let mapIdent<'a, 'b> (f : 'a -> 'b) (x : SynFieldData<'a>) : SynFieldData<'b> =
let ident = f x.Ident
{
Attrs = x.Attrs
Ident = ident
Type = x.Type
}
/// Throws if the field has no identifier.
let extractWithIdent (f : SynField) : SynFieldData<Ident> =
f
|> extract
|> mapIdent (fun ident ->
match ident with
| None -> failwith "expected field identifier to have a value, but it did not"
| Some i -> i
)

View File

@@ -0,0 +1,10 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal SynPat =
let annotateType (ty : SynType) (pat : SynPat) =
SynPat.Paren (SynPat.Typed (pat, ty, range0), range0)

View File

@@ -0,0 +1,41 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
type internal UnionCase<'Ident> =
{
Fields : SynFieldData<'Ident> list
Attrs : SynAttribute list
Ident : Ident
}
[<RequireQualifiedAccess>]
module internal UnionCase =
let mapIdentFields<'a, 'b> (f : 'a -> 'b) (unionCase : UnionCase<'a>) : UnionCase<'b> =
{
Fields = unionCase.Fields |> List.map (SynField.mapIdent f)
Attrs = unionCase.Attrs
Ident = unionCase.Ident
}
[<RequireQualifiedAccess>]
module internal SynUnionCase =
let extract (SynUnionCase (attrs, id, caseType, _, _, _, _)) : UnionCase<Ident option> =
match caseType with
| SynUnionCaseKind.FullType _ -> failwith "WoofWare.Myriad does not support FullType union cases."
| SynUnionCaseKind.Fields fields ->
let fields = fields |> List.map SynField.extract
let id =
match id with
| SynIdent.SynIdent (ident, _) -> ident
// As far as I can tell, there's no way to get any attributes here? :shrug:
let attrs = attrs |> List.collect (fun l -> l.Attributes)
{
Fields = fields
Attrs = attrs
Ident = id
}

View File

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

View File

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

View File

@@ -10,7 +10,7 @@
</PropertyGroup>
<ItemGroup>
<PackageDownload Include="G-Research.FSharp.Analyzers" Version="[0.9.3]" />
<PackageDownload Include="G-Research.FSharp.Analyzers" Version="[0.10.0]" />
</ItemGroup>
</Project>

View File

@@ -7,7 +7,6 @@
};
outputs = {
self,
nixpkgs,
flake-utils,
...

View File

@@ -3,23 +3,18 @@
{fetchNuGet}: [
(fetchNuGet {
pname = "fsharp-analyzers";
version = "0.25.0";
sha256 = "sha256-njfJYi40jNvrD+mgu9LtQw2Omh8P1SSDThesozH0KQY=";
version = "0.26.0";
sha256 = "sha256-60Bl36LOb/zVNdH2SBSuQ5O41lP9dKTNZbs5vvYs+3U=";
})
(fetchNuGet {
pname = "fantomas";
version = "6.3.0-alpha-007";
sha256 = "sha256-uZw6h6k/DS4BcYtK9cv8TLS0H8MZDO3WBaPPTdtTgu0=";
version = "6.3.4";
sha256 = "sha256-1aWqZynBkQoznenGoP0sbf1PcUXAbcHiWyECuv89xa0=";
})
(fetchNuGet {
pname = "ApiSurface";
version = "4.0.30";
sha256 = "0khbp0dx87m4kx1a5b9vgh1pp88vr9w8vpqvxf6afrpcyynwrrcr";
})
(fetchNuGet {
pname = "coverlet.collector";
version = "6.0.0";
sha256 = "12j34vrkmph8lspbafnqmfnj2qvysz1jcrks2khw798s6dwv0j90";
version = "4.0.40";
sha256 = "1c9z0b6minlripwrjmv4yd5w8zj4lcpak4x41izh7ygx8kgmbvx0";
})
(fetchNuGet {
pname = "Fantomas.Core";
@@ -123,13 +118,13 @@
})
(fetchNuGet {
pname = "Microsoft.CodeCoverage";
version = "17.9.0";
sha256 = "1gljgi69k0fz8vy8bn6xlyxabj6q4vls2zza9wz7ng6ix3irm89r";
version = "17.10.0";
sha256 = "0s0v7jmrq85n356xv7zixvwa4z94fszjcr5vll8x4im1a2lp00f9";
})
(fetchNuGet {
pname = "Microsoft.NET.Test.Sdk";
version = "17.9.0";
sha256 = "1lls1fly2gr1n9n1xyl9k33l2v4pwfmylyzkq8v4v5ldnwkl1zdb";
version = "17.10.0";
sha256 = "13g8fwl09li8fc71nk13dgkb7gahd4qhamyg2xby7am63nlchhdf";
})
(fetchNuGet {
pname = "Microsoft.NETCore.App.Host.linux-arm64";
@@ -273,13 +268,13 @@
})
(fetchNuGet {
pname = "Microsoft.TestPlatform.ObjectModel";
version = "17.9.0";
sha256 = "1kgsl9w9fganbm9wvlkqgk0ag9hfi58z88rkfybc6kvg78bx89ca";
version = "17.10.0";
sha256 = "07j69cw8r39533w4p39mnj00kahazz38760in3jfc45kmlcdb26x";
})
(fetchNuGet {
pname = "Microsoft.TestPlatform.TestHost";
version = "17.9.0";
sha256 = "19ffh31a1jxzn8j69m1vnk5hyfz3dbxmflq77b8x82zybiilh5nl";
version = "17.10.0";
sha256 = "1bl471s7fx9jycr0cc8rylwf34mrvlg9qn1an6l86nisavfcyb7v";
})
(fetchNuGet {
pname = "Myriad.Core";
@@ -296,11 +291,6 @@
version = "3.6.133";
sha256 = "1cdw8krvsnx0n34f7fm5hiiy7bs6h3asvncqcikc0g46l50w2j80";
})
(fetchNuGet {
pname = "NETStandard.Library";
version = "2.0.0";
sha256 = "1bc4ba8ahgk15m8k4nd7x406nhi0kwqzbgjk2dmw52ss553xz7iy";
})
(fetchNuGet {
pname = "NETStandard.Library";
version = "2.0.3";
@@ -318,43 +308,38 @@
})
(fetchNuGet {
pname = "NuGet.Common";
version = "6.9.1";
sha256 = "0ic3d46r9v05pkczpmskw86yzixm6iwshbw0ya8i2957nhhlymw8";
version = "6.10.0";
sha256 = "0nizrnilmlcqbm945293h8q3wfqfchb4xi8g50x4kjn0rbpd1kbh";
})
(fetchNuGet {
pname = "NuGet.Configuration";
version = "6.9.1";
sha256 = "07z4qgbibpg59j2r05ifnqdyqf2xinm33rx7gjyr1f73kzg01m33";
version = "6.10.0";
sha256 = "1aqaknaawnqx4mnvx9qw73wvj48jjzv0d78dzwl7m9zjlrl9myhz";
})
(fetchNuGet {
pname = "NuGet.Frameworks";
version = "6.9.1";
sha256 = "0s3az3ac53icjnmb14hfjcmkvzscvrkm62jgqf48yvsbysyhqm5s";
version = "6.10.0";
sha256 = "0hrd8y31zx9a0wps49czw0qgbrakb49zn3abfgylc9xrq990zkqk";
})
(fetchNuGet {
pname = "NuGet.Packaging";
version = "6.9.1";
sha256 = "0w0arkmzg3qh1brq4vm10zrsjm7nw706ld4y5kqcmvjpd16f4b4y";
version = "6.10.0";
sha256 = "18s53cvrf51lihmaqqdf48p2qi6ky1l48jv0hvbp76cxwdg7rba4";
})
(fetchNuGet {
pname = "NuGet.Protocol";
version = "6.7.0";
sha256 = "1v5ibnq2mp801vw68zyj169hkj3xm7h55824i33n1jxxj2vs3vbk";
version = "6.10.0";
sha256 = "0hmv4q0ks9i34mfgpb13l01la9v3jjllfh1qd3aqv105xrqrdxac";
})
(fetchNuGet {
pname = "NuGet.Versioning";
version = "6.9.1";
sha256 = "0xrs82dydy9cgxf0qypr01wawwnq1nf6fc7rwisb4y5v4r259fdm";
version = "6.10.0";
sha256 = "1x19njx4x0sw9fz8y5fibi15xfsrw5avir0cx0599yd7p3ykik5g";
})
(fetchNuGet {
pname = "NUnit";
version = "3.13.3";
sha256 = "0wdzfkygqnr73s6lpxg5b1pwaqz9f414fxpvpdmf72bvh4jaqzv6";
})
(fetchNuGet {
pname = "NUnit";
version = "4.0.1";
sha256 = "0jgiq3dbwli5r70j0bw7021d69r7bhr58s8kphlpjmf7k47l5pcd";
version = "4.1.0";
sha256 = "0fj6xwgqaxq3mrai86bklclfmjkzf038mrslwfqf4ignaz9f7g5j";
})
(fetchNuGet {
pname = "NUnit3TestAdapter";
@@ -448,12 +433,12 @@
})
(fetchNuGet {
pname = "System.Text.Encodings.Web";
version = "6.0.0";
sha256 = "06n9ql3fmhpjl32g3492sj181zjml5dlcc5l76xq2h38c4f87sai";
version = "7.0.0";
sha256 = "1151hbyrcf8kyg1jz8k9awpbic98lwz9x129rg7zk1wrs6vjlpxl";
})
(fetchNuGet {
pname = "System.Text.Json";
version = "6.0.0";
sha256 = "1si2my1g0q0qv1hiqnji4xh9wd05qavxnzj9dwgs23iqvgjky0gl";
version = "7.0.3";
sha256 = "0zjrnc9lshagm6kdb9bdh45dmlnkpwcpyssa896sda93ngbmj8k9";
})
]