Compare commits

..

4 Commits

Author SHA1 Message Date
Smaug123
c5216943bb Merge main 2024-01-25 20:30:13 +00:00
Smaug123
63a45f14d8 urgh 2023-12-29 23:23:00 +00:00
Smaug123
a9024584a5 Extend 2023-12-29 23:16:42 +00:00
Smaug123
9472d9d06b Failing test 2023-12-29 23:14:56 +00:00
119 changed files with 4500 additions and 118368 deletions

View File

@@ -3,16 +3,16 @@
"isRoot": true, "isRoot": true,
"tools": { "tools": {
"fantomas": { "fantomas": {
"version": "7.0.3", "version": "6.3.0-alpha-005",
"commands": [ "commands": [
"fantomas" "fantomas"
] ]
}, },
"fsharp-analyzers": { "fsharp-analyzers": {
"version": "0.33.1", "version": "0.23.0",
"commands": [ "commands": [
"fsharp-analyzers" "fsharp-analyzers"
] ]
} }
} }
} }

View File

@@ -2,6 +2,7 @@ root=true
[*] [*]
charset=utf-8 charset=utf-8
end_of_line=crlf
trim_trailing_whitespace=true trim_trailing_whitespace=true
insert_final_newline=true insert_final_newline=true
indent_style=space indent_style=space

23
.envrc
View File

@@ -1,23 +0,0 @@
use flake
DOTNET_PATH=$(readlink "$(which dotnet)")
SETTINGS_FILE=$(find . -maxdepth 1 -type f -name '*.sln.DotSettings.user')
MSBUILD=$(realpath "$(find "$(dirname "$DOTNET_PATH")/../share/dotnet/sdk" -maxdepth 2 -type f -name MSBuild.dll)")
if [ -f "$SETTINGS_FILE" ] ; then
xmlstarlet ed --inplace \
-N wpf="http://schemas.microsoft.com/winfx/2006/xaml/presentation" \
-N x="http://schemas.microsoft.com/winfx/2006/xaml" \
-N s="clr-namespace:System;assembly=mscorlib" \
-N ss="urn:shemas-jetbrains-com:settings-storage-xaml" \
--update "//s:String[@x:Key='/Default/Environment/Hierarchy/Build/BuildTool/DotNetCliExePath/@EntryValue']" \
--value "$(realpath "$(dirname "$DOTNET_PATH")/../share/dotnet/dotnet")" \
"$SETTINGS_FILE"
xmlstarlet ed --inplace \
-N wpf="http://schemas.microsoft.com/winfx/2006/xaml/presentation" \
-N x="http://schemas.microsoft.com/winfx/2006/xaml" \
-N s="clr-namespace:System;assembly=mscorlib" \
-N ss="urn:shemas-jetbrains-com:settings-storage-xaml" \
--update "//s:String[@x:Key='/Default/Environment/Hierarchy/Build/BuildTool/CustomBuildToolPath/@EntryValue']" \
--value "$MSBUILD" \
"$SETTINGS_FILE"
fi

View File

@@ -1 +0,0 @@
.direnv/

10
.gitattributes vendored
View File

@@ -1,5 +1,5 @@
* eol=auto * eol=auto
*.sh text eol=lf *.sh text eol=lf
*.yaml text *.yaml text
*.nix text eol=lf *.nix text eol=lf
hooks/pre-push text eol=lf hooks/pre-push text eol=lf

View File

@@ -1,4 +1,3 @@
# yaml-language-server: $schema=https://raw.githubusercontent.com/SchemaStore/schemastore/master/src/schemas/json/github-workflow.json
name: .NET name: .NET
on: on:
@@ -25,11 +24,11 @@ jobs:
runs-on: ubuntu-latest runs-on: ubuntu-latest
steps: steps:
- uses: actions/checkout@v5 - uses: actions/checkout@v4
with: with:
fetch-depth: 0 # so that NerdBank.GitVersioning has access to history fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
- name: Install Nix - name: Install Nix
uses: cachix/install-nix-action@v31 uses: cachix/install-nix-action@v25
with: with:
extra_nix_config: | extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -46,11 +45,11 @@ jobs:
security-events: write security-events: write
steps: steps:
- name: Checkout - name: Checkout
uses: actions/checkout@v5 uses: actions/checkout@v4
with: with:
fetch-depth: 0 # so that NerdBank.GitVersioning has access to history fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
- name: Install Nix - name: Install Nix
uses: cachix/install-nix-action@v31 uses: cachix/install-nix-action@v25
with: with:
extra_nix_config: | extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -59,64 +58,41 @@ jobs:
- name: Build project - name: Build project
run: nix develop --command dotnet build ./WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj run: nix develop --command dotnet build ./WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj
- name: Run analyzers - name: Run analyzers
run: nix run .#fsharp-analyzers -- --project ./WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj --analyzers-path ./.analyzerpackages/g-research.fsharp.analyzers/*/ --verbosity detailed --report ./analysis.sarif --treat-as-error GRA-STRING-001 GRA-STRING-002 GRA-STRING-003 GRA-UNIONCASE-001 GRA-INTERPOLATED-001 GRA-TYPE-ANNOTATE-001 GRA-VIRTUALCALL-001 GRA-IMMUTABLECOLLECTIONEQUALITY-001 GRA-JSONOPTS-001 GRA-LOGARGFUNCFULLAPP-001 GRA-DISPBEFOREASYNC-001 --exclude-analyzers PartialAppAnalyzer run: nix run .#fsharp-analyzers -- --project ./WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj --analyzers-path ./.analyzerpackages/g-research.fsharp.analyzers/0.6.0/ --verbosity detailed --report ./analysis.sarif --treat-as-error GRA-STRING-001 GRA-STRING-002 GRA-STRING-003 GRA-UNIONCASE-001 GRA-INTERPOLATED-001 GRA-TYPE-ANNOTATE-001 GRA-VIRTUALCALL-001 GRA-IMMUTABLECOLLECTIONEQUALITY-001 GRA-JSONOPTS-001 GRA-LOGARGFUNCFULLAPP-001
build-nix: build-nix:
runs-on: ubuntu-latest runs-on: ubuntu-latest
steps: steps:
- name: Checkout - name: Checkout
uses: actions/checkout@v5 uses: actions/checkout@v4
- name: Install Nix - name: Install Nix
uses: cachix/install-nix-action@v31 uses: cachix/install-nix-action@v25
with: with:
extra_nix_config: | extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
- name: Build - name: Build
run: nix build run: nix build
- name: Reproducibility check
run: nix build --rebuild
check-dotnet-format: check-dotnet-format:
runs-on: ubuntu-latest runs-on: ubuntu-latest
steps: steps:
- name: Checkout - name: Checkout
uses: actions/checkout@v5 uses: actions/checkout@v4
- name: Install Nix - name: Install Nix
uses: cachix/install-nix-action@v31 uses: cachix/install-nix-action@v25
with: with:
extra_nix_config: | extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
- name: Run Fantomas - name: Run Fantomas
run: nix run .#fantomas -- --check . run: nix run .#fantomas -- --check .
check-accurate-generations:
runs-on: ubuntu-latest
steps:
- name: Checkout
uses: actions/checkout@v5
with:
fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
- name: Install Nix
uses: cachix/install-nix-action@v31
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: check-nix-format:
runs-on: ubuntu-latest runs-on: ubuntu-latest
steps: steps:
- name: Checkout - name: Checkout
uses: actions/checkout@v5 uses: actions/checkout@v4
- name: Install Nix - name: Install Nix
uses: cachix/install-nix-action@v31 uses: cachix/install-nix-action@v25
with: with:
extra_nix_config: | extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -129,7 +105,7 @@ jobs:
steps: steps:
- uses: actions/checkout@master - uses: actions/checkout@master
- name: Install Nix - name: Install Nix
uses: cachix/install-nix-action@v31 uses: cachix/install-nix-action@v25
with: with:
extra_nix_config: | extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -142,7 +118,7 @@ jobs:
steps: steps:
- uses: actions/checkout@master - uses: actions/checkout@master
- name: Install Nix - name: Install Nix
uses: cachix/install-nix-action@v31 uses: cachix/install-nix-action@v25
with: with:
extra_nix_config: | extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -152,11 +128,11 @@ jobs:
nuget-pack: nuget-pack:
runs-on: ubuntu-latest runs-on: ubuntu-latest
steps: steps:
- uses: actions/checkout@v5 - uses: actions/checkout@v4
with: with:
fetch-depth: 0 # so that NerdBank.GitVersioning has access to history fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
- name: Install Nix - name: Install Nix
uses: cachix/install-nix-action@v31 uses: cachix/install-nix-action@v25
with: with:
extra_nix_config: | extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -166,224 +142,45 @@ jobs:
run: nix develop --command dotnet build --no-restore --configuration Release run: nix develop --command dotnet build --no-restore --configuration Release
- name: Pack - name: Pack
run: nix develop --command dotnet pack --configuration Release run: nix develop --command dotnet pack --configuration Release
- name: Upload NuGet artifact (plugin) - name: Upload NuGet artifact
uses: actions/upload-artifact@v4 uses: actions/upload-artifact@v4
with: with:
name: nuget-package-plugin name: nuget-package
path: WoofWare.Myriad.Plugins/bin/Release/WoofWare.Myriad.Plugins.*.nupkg path: WoofWare.Myriad.Plugins/bin/Release/WoofWare.Myriad.Plugins.*.nupkg
- name: Upload NuGet artifact (attributes)
uses: actions/upload-artifact@v4
with:
name: nuget-package-attribute
path: WoofWare.Myriad.Plugins.Attributes/bin/Release/WoofWare.Myriad.Plugins.Attributes.*.nupkg
expected-pack: expected-pack:
needs: [nuget-pack] needs: [nuget-pack]
runs-on: ubuntu-latest runs-on: ubuntu-latest
steps: steps:
- name: Download NuGet artifact (plugin)
uses: actions/download-artifact@v5
with:
name: nuget-package-plugin
path: packed-plugin
- name: Check NuGet contents
# Verify that there is exactly one nupkg in the artifact that would be NuGet published
run: if [[ $(find packed-plugin -maxdepth 1 -name 'WoofWare.Myriad.Plugins.*.nupkg' -printf c | wc -c) -ne "1" ]]; then exit 1; fi
- name: Download NuGet artifact (attributes)
uses: actions/download-artifact@v5
with:
name: nuget-package-attribute
path: packed-attribute
- name: Check NuGet contents
# 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-dry-run:
strategy:
matrix:
artifact:
- nuget-package-plugin
- nuget-package-attribute
runs-on: ubuntu-latest
needs: [nuget-pack]
steps:
- uses: actions/checkout@v5
- name: Download NuGet artifact - name: Download NuGet artifact
uses: actions/download-artifact@v5 uses: actions/download-artifact@v4
with: with:
name: ${{ matrix.artifact }} name: nuget-package
- name: Compute package path - name: Check NuGet contents
id: compute-path # Verify that there is exactly one nupkg in the artifact that would be NuGet published
run: | run: if [[ $(find . -maxdepth 1 -name 'WoofWare.Myriad.Plugins.*.nupkg' -printf c | wc -c) -ne "1" ]]; then exit 1; fi
find . -maxdepth 1 -type f -name 'WoofWare.Myriad.*.nupkg' -exec sh -c 'echo "output=$(basename "$1")" >> $GITHUB_OUTPUT' shell {} \;
- name: Compute tag name
id: compute-tag
env:
NUPKG_PATH: ${{ steps.compute-path.outputs.output }}
run: echo "output=$(basename "$NUPKG_PATH" .nupkg)" >> $GITHUB_OUTPUT
- name: Tag and release
uses: G-Research/common-actions/github-release@19d7281a0f9f83e13c78f99a610dbc80fc59ba3b
with:
github-token: ${{ secrets.GITHUB_TOKEN }}
target-commitish: ${{ github.sha }}
tag: ${{ steps.compute-tag.outputs.output }}
binary-contents: ${{ steps.compute-path.outputs.output }}
dry-run: true
all-required-checks-complete: all-required-checks-complete:
needs: [check-dotnet-format, check-nix-format, check-accurate-generations, build, build-nix, linkcheck, flake-check, analyzers, nuget-pack, expected-pack, github-release-dry-run] needs: [check-dotnet-format, check-nix-format, build, build-nix, linkcheck, flake-check, analyzers, nuget-pack, expected-pack]
if: ${{ always() }}
runs-on: ubuntu-latest runs-on: ubuntu-latest
steps: steps:
- uses: G-Research/common-actions/check-required-lite@2b7dc49cb14f3344fbe6019c14a31165e258c059 - run: echo "All required checks complete."
with:
needs-context: ${{ toJSON(needs) }}
attestation-attribute: nuget-publish:
runs-on: ubuntu-latest
needs: [all-required-checks-complete]
if: ${{ !github.event.repository.fork && github.ref == 'refs/heads/main' }}
permissions:
id-token: write
attestations: write
contents: read
steps:
- name: Download NuGet artifact
uses: actions/download-artifact@v5
with:
name: nuget-package-attribute
path: packed
- name: Attest Build Provenance
uses: actions/attest-build-provenance@977bb373ede98d70efdf65b84cb5f73e068dcc2a # v3.0.0
with:
subject-path: "packed/*.nupkg"
attestation-plugin:
runs-on: ubuntu-latest
needs: [all-required-checks-complete]
if: ${{ !github.event.repository.fork && github.ref == 'refs/heads/main' }}
permissions:
id-token: write
attestations: write
contents: read
steps:
- name: Download NuGet artifact
uses: actions/download-artifact@v5
with:
name: nuget-package-plugin
path: packed
- name: Attest Build Provenance
uses: actions/attest-build-provenance@977bb373ede98d70efdf65b84cb5f73e068dcc2a # v3.0.0
with:
subject-path: "packed/*.nupkg"
nuget-publish-attribute:
runs-on: ubuntu-latest runs-on: ubuntu-latest
if: ${{ !github.event.repository.fork && github.ref == 'refs/heads/main' }} if: ${{ !github.event.repository.fork && github.ref == 'refs/heads/main' }}
needs: [all-required-checks-complete] needs: [all-required-checks-complete]
environment: main-deploy environment: main-deploy
permissions:
id-token: write
attestations: write
contents: read
steps: steps:
- uses: actions/checkout@v5 - uses: actions/checkout@v4
- name: Install Nix - name: Install Nix
uses: cachix/install-nix-action@v31 uses: cachix/install-nix-action@v25
with: with:
extra_nix_config: | extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
- name: Download NuGet artifact - name: Download NuGet artifact
uses: actions/download-artifact@v5 uses: actions/download-artifact@v4
with: with:
name: nuget-package-attribute name: nuget-package
path: packed
- name: Identify `dotnet`
id: dotnet-identify
run: nix develop --command bash -c 'echo "dotnet=$(which dotnet)" >> $GITHUB_OUTPUT'
- name: Obtain NuGet key
uses: NuGet/login@d22cc5f58ff5b88bf9bd452535b4335137e24544
id: login
with:
user: ${{ secrets.NUGET_USER }}
- name: Publish to NuGet - name: Publish to NuGet
id: publish-success run: nix develop --command dotnet nuget push "WoofWare.Myriad.Plugins.*.nupkg" --api-key ${{ secrets.NUGET_API_KEY }} --source https://api.nuget.org/v3/index.json
uses: G-Research/common-actions/publish-nuget@2b7dc49cb14f3344fbe6019c14a31165e258c059
with:
package-name: WoofWare.Myriad.Plugins.Attributes
nuget-key: ${{ steps.login.outputs.NUGET_API_KEY }}
nupkg-dir: packed/
dotnet: ${{ steps.dotnet-identify.outputs.dotnet }}
nuget-publish-plugin:
runs-on: ubuntu-latest
if: ${{ !github.event.repository.fork && github.ref == 'refs/heads/main' }}
needs: [all-required-checks-complete]
environment: main-deploy
permissions:
id-token: write
attestations: write
contents: read
steps:
- uses: actions/checkout@v5
- name: Install Nix
uses: cachix/install-nix-action@v31
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
- name: Download NuGet artifact
uses: actions/download-artifact@v5
with:
name: nuget-package-plugin
path: packed
- name: Identify `dotnet`
id: dotnet-identify
run: nix develop --command bash -c 'echo "dotnet=$(which dotnet)" >> $GITHUB_OUTPUT'
- name: Obtain NuGet key
uses: NuGet/login@d22cc5f58ff5b88bf9bd452535b4335137e24544
id: login
with:
user: ${{ secrets.NUGET_USER }}
- name: Publish to NuGet
id: publish-success
uses: G-Research/common-actions/publish-nuget@2b7dc49cb14f3344fbe6019c14a31165e258c059
with:
package-name: WoofWare.Myriad.Plugins
nuget-key: ${{ steps.login.outputs.NUGET_API_KEY }}
nupkg-dir: packed/
dotnet: ${{ steps.dotnet-identify.outputs.dotnet }}
github-release:
strategy:
matrix:
artifact:
- nuget-package-attribute
- nuget-package-plugin
runs-on: ubuntu-latest
if: ${{ !github.event.repository.fork && github.ref == 'refs/heads/main' }}
needs: [all-required-checks-complete]
environment: main-deploy
permissions:
contents: write
steps:
- uses: actions/checkout@v5
- name: Download NuGet artifact
uses: actions/download-artifact@v5
with:
name: ${{ matrix.artifact }}
- name: Compute package path
id: compute-path
run: |
find . -maxdepth 1 -type f -name 'WoofWare.Myriad.*.nupkg' -exec sh -c 'echo "output=$(basename "$1")" >> $GITHUB_OUTPUT' shell {} \;
- name: Compute tag name
id: compute-tag
env:
NUPKG_PATH: ${{ steps.compute-path.outputs.output }}
run: echo "output=$(basename "$NUPKG_PATH" .nupkg)" >> $GITHUB_OUTPUT
- name: Tag and release
uses: G-Research/common-actions/github-release@19d7281a0f9f83e13c78f99a610dbc80fc59ba3b
with:
github-token: ${{ secrets.GITHUB_TOKEN }}
target-commitish: ${{ github.sha }}
tag: ${{ steps.compute-tag.outputs.output }}
binary-contents: ${{ steps.compute-path.outputs.output }}

View File

@@ -1,57 +0,0 @@
# yaml-language-server: $schema=https://raw.githubusercontent.com/SchemaStore/schemastore/master/src/schemas/json/github-workflow.json
name: Weekly Nix Flake Update
on:
schedule:
- cron: '0 0 * * 0' # Runs at 00:00 every Sunday
workflow_dispatch: # Allows manual triggering
jobs:
update-nix-flake:
runs-on: ubuntu-latest
steps:
- name: Check out repository
uses: actions/checkout@v5
- name: Install Nix
uses: DeterminateSystems/nix-installer-action@main
with:
github-token: ${{ secrets.GITHUB_TOKEN }}
- name: Update Nix flake
run: 'nix flake update'
- name: Build fetch-deps
run: 'nix build ".#default.fetch-deps"'
- name: Run fetch-deps
run: |
set -o pipefail
./result nix/deps.json
- name: Format
run: 'nix develop --command alejandra .'
- name: Create token
id: generate-token
uses: actions/create-github-app-token@v2
with:
# https://github.com/actions/create-github-app-token/issues/136
app-id: ${{ secrets.APP_ID }}
private-key: ${{ secrets.APP_PRIVATE_KEY }}
- name: Raise pull request
uses: Smaug123/commit-action@d34807f26cb52c7a05bbd80efe9f964cdf29bc87
id: cpr
with:
bearer-token: ${{ steps.generate-token.outputs.token }}
pr-title: "Upgrade Nix flake and deps"
branch-name: "auto-pr"
- name: Enable Pull Request Automerge
if: ${{ steps.cpr.outputs.pull-request-number }}
uses: peter-evans/enable-pull-request-automerge@v3
with:
token: ${{ steps.generate-token.outputs.token }}
pull-request-number: ${{ steps.cpr.outputs.pull-request-number }}
merge-method: squash

25
.gitignore vendored
View File

@@ -1,14 +1,11 @@
bin/ bin/
obj/ obj/
/packages/ /packages/
riderModule.iml riderModule.iml
/_ReSharper.Caches/ /_ReSharper.Caches/
.idea/ .idea/
*.sln.DotSettings.user *.sln.DotSettings.user
.DS_Store .DS_Store
result result
.analyzerpackages/ .analyzerpackages/
analysis.sarif analysis.sarif
.direnv/
.venv/
.vs/

View File

@@ -1,76 +0,0 @@
Notable changes are recorded here.
# WoofWare.Myriad.Plugins 8.1.1
Adds `GenerateCapturingMock`, which is `GenerateMock` but additionally records the calls made to each function.
# WoofWare.Myriad.Plugins 8.0.3
The RestEase-style HTTP client generator now automatically adds the `application/json` content type header to requests which are POSTing a body that is known to be JSON-serialised.
You can override this by setting the `[<RestEase.Header ("Content-Type", "desired content type")>]` header manually on any affected member.
# WoofWare.Myriad.Plugins 7.0.1
All generators should now be compatible with `<Nullable>enable</Nullable>`.
**Please test the results and let me know of unexpected failures.**
There are a number of heuristics in this code, because:
* `System.Text.Json.Nodes` is an unfathomably weird API which simply requires us to make educated guesses about whether a user-provided type is supposed to be nullable, despite this being irrelevant to the operation of `System.Text.Json`;
* Some types (like `Uri` and `String`) have `ToString` methods which can't return `null`, but in general `Object.ToString` can of course return `null`, and as far as I can tell there is simply no way to know from the source alone whether a given type will have a nullable `ToString`.
# WoofWare.Myriad.Plugins 6.0.1
The `ArgParser` generator's type signatures have changed.
The `parse'` method no longer takes `getEnvironmentVariable : string -> string`; it's now `getEnvironmentVariable : string -> string option`.
This is to permit satisfying the `<Nullable>enable</Nullable>` compiler setting.
If you're calling `parse'`, give it `Environment.GetEnvironmentVariable >> Option.ofObj` instead.
# WoofWare.Myriad.Plugins 5.0.1
We now enforce non-nullability on more types during JSON parse.
We have always expected you to consume nullable types wrapped in an `option`, but now we enforce this in more cases by throwing `ArgumentNullException`.
# WoofWare.Myriad.Plugins 3.0.1
Semantics of `HttpClient`'s URI component composition changed:
we now implicitly insert `/` characters after `[<BaseAddress>]` and `[<BasePath>]`, so that URI composition doesn't silently drop the last component if you didn't put a slash there.
# WoofWare.Myriad.Plugins 2.3.9
`JsonParse` and `JsonSerialize` now interpret `[<JsonExtensionData>]`, which must be on a `Dictionary<string, _>`; this collects any extra components that were present on the JSON object.
# WoofWare.Myriad.Plugins 2.2.1, WoofWare.Myriad.Plugins.Attributes 3.2.1
New generator: `ArgParser`, a basic reflection-free argument parser.
# WoofWare.Myriad.Plugins 2.1.45, WoofWare.Myriad.Plugins.Attributes 3.1.7
The NuGet packages are now attested to through [GitHub Attestations](https://github.blog/2024-05-02-introducing-artifact-attestations-now-in-public-beta/).
You can run `gh attestation verify ~/.nuget/packages/woofware.myriad.plugins/2.1.45/woofware.myriad.plugins.2.1.45.nupkg -o Smaug123`, for example, to verify with GitHub that the GitHub Actions pipeline on this repository produced a nupkg file with the same hash as the one you were served from NuGet.
# WoofWare.Myriad.Plugins 2.1.33
`JsonParse` can now deserialize the discriminated unions which `JsonSerialize` wrote out.
# WoofWare.Myriad.Plugins 2.1.32, WoofWare.Myriad.Plugins.Attributes 3.1.4
`JsonSerialize` can now serialize many discriminated unions.
(This operation is inherently opinionated, because JSON does not model discriminated unions.)
# 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

@@ -44,7 +44,7 @@ git config blame.ignoreRevsFile .git-blame-ignore-revs
## Dependencies ## Dependencies
I try to keep this repository's dependencies as few as possible, because (for example) any consumer of the source generator will also consume this project via the attributes. I try to keep this repository's dependencies as few as possible, because (for example) any consumer of the source generator will also consume this project via the attributes.
When adding dependencies, you will need to `nix run .#fetchDeps` to obtain a new copy of [the dependency lockfile](./nix/deps.json). When adding dependencies, you will need to `nix run .#fetchDeps` to obtain a new copy of [the dependency lockfile](./nix/deps.nix).
## Branch strategy ## Branch strategy

View File

@@ -1,237 +0,0 @@
namespace ConsumePlugin
open System
open System.IO
open WoofWare.Myriad.Plugins
[<ArgParser>]
type BasicNoPositionals =
{
Foo : int
Bar : string
Baz : bool
Rest : int list
}
[<ArgParser>]
type Basic =
{
[<ArgumentHelpText "This is a foo!">]
Foo : int
Bar : string
Baz : bool
[<ArgumentHelpText "Here's where the rest of the args go">]
[<PositionalArgs>]
Rest : string list
}
[<ArgParser>]
type BasicWithIntPositionals =
{
Foo : int
Bar : string
Baz : bool
[<PositionalArgs>]
Rest : int list
}
[<ArgParser>]
type LoadsOfTypes =
{
Foo : int
Bar : string
Baz : bool
SomeFile : FileInfo
SomeDirectory : DirectoryInfo
SomeList : DirectoryInfo list
OptionalThingWithNoDefault : int option
[<PositionalArgs>]
Positionals : int list
[<ArgumentDefaultFunction>]
OptionalThing : Choice<bool, bool>
[<ArgumentDefaultFunction>]
AnotherOptionalThing : Choice<int, int>
[<ArgumentDefaultEnvironmentVariable "CONSUMEPLUGIN_THINGS">]
YetAnotherOptionalThing : Choice<string, string>
}
static member DefaultOptionalThing () = true
static member DefaultAnotherOptionalThing () = 3
[<ArgParser>]
type LoadsOfTypesNoPositionals =
{
Foo : int
Bar : string
Baz : bool
SomeFile : FileInfo
SomeDirectory : DirectoryInfo
SomeList : DirectoryInfo list
OptionalThingWithNoDefault : int option
[<ArgumentDefaultFunction>]
OptionalThing : Choice<bool, bool>
[<ArgumentDefaultFunction>]
AnotherOptionalThing : Choice<int, int>
[<ArgumentDefaultEnvironmentVariable "CONSUMEPLUGIN_THINGS">]
YetAnotherOptionalThing : Choice<string, string>
}
static member DefaultOptionalThing () = false
static member DefaultAnotherOptionalThing () = 3
[<ArgParser true>]
type DatesAndTimes =
{
Plain : TimeSpan
[<InvariantCulture>]
Invariant : TimeSpan
[<ParseExact @"hh\:mm\:ss">]
[<ArgumentHelpText "An exact time please">]
Exact : TimeSpan
[<InvariantCulture ; ParseExact @"hh\:mm\:ss">]
InvariantExact : TimeSpan
}
type ChildRecord =
{
Thing1 : int
Thing2 : string
}
[<ArgParser true>]
type ParentRecord =
{
Child : ChildRecord
AndAnother : bool
}
type ChildRecordWithPositional =
{
Thing1 : int
[<PositionalArgs>]
Thing2 : Uri list
}
[<ArgParser true>]
type ParentRecordChildPos =
{
Child : ChildRecordWithPositional
AndAnother : bool
}
[<ArgParser true>]
type ParentRecordSelfPos =
{
Child : ChildRecord
[<PositionalArgs>]
AndAnother : bool list
}
[<ArgParser true>]
type ChoicePositionals =
{
[<PositionalArgs>]
Args : Choice<string, string> list
}
[<ArgParser true>]
type ContainsBoolEnvVar =
{
[<ArgumentDefaultEnvironmentVariable "CONSUMEPLUGIN_THINGS">]
BoolVar : Choice<bool, bool>
}
[<RequireQualifiedAccess>]
module Consts =
[<Literal>]
let FALSE = false
[<Literal>]
let TRUE = true
type DryRunMode =
| [<ArgumentFlag(Consts.FALSE)>] Wet
| [<ArgumentFlag true>] Dry
[<ArgParser true>]
type WithFlagDu =
{
DryRun : DryRunMode
}
[<ArgParser true>]
type ContainsFlagEnvVar =
{
// This phrasing is odd, but it's for a test. Nobody's really going to have `--dry-run`
// controlled by an env var!
[<ArgumentDefaultEnvironmentVariable "CONSUMEPLUGIN_THINGS">]
DryRun : Choice<DryRunMode, DryRunMode>
}
[<ArgParser true>]
type ContainsFlagDefaultValue =
{
[<ArgumentDefaultFunction>]
DryRun : Choice<DryRunMode, DryRunMode>
}
static member DefaultDryRun () = DryRunMode.Wet
[<ArgParser true>]
type ManyLongForms =
{
[<ArgumentLongForm "do-something-else">]
[<ArgumentLongForm "anotherarg">]
DoTheThing : string
[<ArgumentLongForm "turn-it-on">]
[<ArgumentLongForm "dont-turn-it-off">]
SomeFlag : bool
}
[<RequireQualifiedAccess>]
type private IrrelevantDu =
| Foo
| Bar
[<ArgParser true>]
type FlagsIntoPositionalArgs =
{
A : string
[<PositionalArgs true>]
GrabEverything : string list
}
[<ArgParser true>]
type FlagsIntoPositionalArgsChoice =
{
A : string
[<PositionalArgs true>]
GrabEverything : Choice<string, string> list
}
[<ArgParser true>]
type FlagsIntoPositionalArgsInt =
{
A : string
[<PositionalArgs true>]
GrabEverything : int list
}
[<ArgParser true>]
type FlagsIntoPositionalArgsIntChoice =
{
A : string
[<PositionalArgs true>]
GrabEverything : Choice<int, int> list
}
[<ArgParser true>]
type FlagsIntoPositionalArgs' =
{
A : string
[<PositionalArgs false>]
DontGrabEverything : string list
}

View File

@@ -1,57 +0,0 @@
namespace SomeNamespace.CapturingMock
open System
open WoofWare.Myriad.Plugins
[<GenerateCapturingMock>]
type IPublicType =
abstract Mem1 : foo : string * int -> string list
abstract Mem2 : string -> int
abstract Mem3 : x : int * ?ct : System.Threading.CancellationToken -> string
[<GenerateCapturingMock false>]
type IPublicTypeInternalFalse =
abstract Mem1 : string * int -> string list
abstract Mem2 : string -> int
abstract Mem3 : x : int * ?ct : System.Threading.CancellationToken -> string
[<GenerateCapturingMock>]
type internal InternalType =
abstract Mem1 : string * int -> unit
abstract Mem2 : string -> int
[<GenerateCapturingMock>]
type private PrivateType =
abstract Mem1 : string * int -> unit
abstract Mem2 : string -> int
[<GenerateCapturingMock false>]
type private PrivateTypeInternalFalse =
abstract Mem1 : string * int -> unit
abstract Mem2 : string -> int
[<GenerateCapturingMock>]
type VeryPublicType<'a, 'b> =
abstract Mem1 : 'a -> 'b
[<GenerateCapturingMock>]
type Curried<'a> =
abstract Mem1 : bar : int -> 'a -> string
abstract Mem2 : int * string -> baz : 'a -> string
abstract Mem3 : quux : (int * string) -> flurb : 'a -> string
abstract Mem4 : (int * string) -> ('a * int) -> string
abstract Mem5 : x : int * string -> ('a * int) -> string
abstract Mem6 : int * string -> y : 'a * int -> string
[<GenerateCapturingMock>]
type TypeWithInterface =
inherit IDisposable
abstract Mem1 : string option -> string[] Async
abstract Mem2 : unit -> string[] Async
[<GenerateCapturingMock>]
type TypeWithProperties =
inherit IDisposable
abstract Mem1 : string option -> string[] Async
abstract Prop1 : int
abstract Prop2 : unit Async

View File

@@ -1,41 +0,0 @@
namespace SomeNamespace.CapturingMock
open System
type IPublicTypeNoAttr =
abstract Mem1 : string * int -> string list
abstract Mem2 : string -> int
abstract Mem3 : x : int * ?ct : System.Threading.CancellationToken -> string
type IPublicTypeInternalFalseNoAttr =
abstract Mem1 : string * int -> string list
abstract Mem2 : string -> int
abstract Mem3 : x : int * ?ct : System.Threading.CancellationToken -> string
type internal InternalTypeNoAttr =
abstract Mem1 : string * int -> unit
abstract Mem2 : string -> int
type private PrivateTypeNoAttr =
abstract Mem1 : string * int -> unit
abstract Mem2 : string -> int
type private PrivateTypeInternalFalseNoAttr =
abstract Mem1 : string * int -> unit
abstract Mem2 : string -> int
type VeryPublicTypeNoAttr<'a, 'b> =
abstract Mem1 : 'a -> 'b
type CurriedNoAttr<'a> =
abstract Mem1 : int -> 'a -> string
abstract Mem2 : int * string -> 'a -> string
abstract Mem3 : (int * string) -> 'a -> string
abstract Mem4 : (int * string) -> ('a * int) -> string
abstract Mem5 : x : int * string -> ('a * int) -> string
abstract Mem6 : int * string -> y : 'a * int -> string
type TypeWithInterfaceNoAttr =
inherit IDisposable
abstract Mem1 : string option -> string[] Async
abstract Mem2 : unit -> string[] Async

View File

@@ -1,22 +0,0 @@
namespace ConsumePlugin
open WoofWare.Myriad.Plugins
type Const<'a> =
| Verbatim of 'a
| String of string
type PairOpKind =
| NormalSeq
| ThenDoSeq
[<CreateCatamorphism "TreeCata">]
type Tree<'a, 'b> =
| Const of Const<'a> * 'b
| Pair of Tree<'a, 'b> * Tree<'a, 'b> * PairOpKind
| Sequential of Tree<'a, 'b> list
| Builder of Tree<'a, 'b> * TreeBuilder<'b, 'a>
and TreeBuilder<'b, 'a> =
| Child of TreeBuilder<'b, 'a>
| Parent of Tree<'a, 'b>

View File

@@ -1,10 +1,8 @@
<Project Sdk="Microsoft.NET.Sdk"> <Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup> <PropertyGroup>
<TargetFramework>net9.0</TargetFramework> <TargetFramework>net8.0</TargetFramework>
<IsPackable>false</IsPackable> <IsPackable>false</IsPackable>
<OtherFlags>--reflectionfree $(OtherFlags)</OtherFlags>
<Nullable>enable</Nullable>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<MyriadSdkGenerator Include="$(MSBuildThisFileDirectory)..\WoofWare.Myriad.Plugins\bin\$(Configuration)\net6.0\WoofWare.Myriad.Plugins.dll"/> <MyriadSdkGenerator Include="$(MSBuildThisFileDirectory)..\WoofWare.Myriad.Plugins\bin\$(Configuration)\net6.0\WoofWare.Myriad.Plugins.dll"/>
@@ -33,80 +31,17 @@
<Compile Include="GeneratedMock.fs"> <Compile Include="GeneratedMock.fs">
<MyriadFile>MockExample.fs</MyriadFile> <MyriadFile>MockExample.fs</MyriadFile>
</Compile> </Compile>
<Compile Include="CapturingMockExample.fs" />
<Compile Include="GeneratedCapturingMock.fs">
<MyriadFile>CapturingMockExample.fs</MyriadFile>
</Compile>
<Compile Include="MockExampleNoAttributes.fs" />
<Compile Include="GeneratedMockNoAttributes.fs">
<MyriadFile>MockExampleNoAttributes.fs</MyriadFile>
<MyriadParams>
<IPublicTypeNoAttr>GenerateMock</IPublicTypeNoAttr>
<IPublicTypeInternalFalseNoAttr>GenerateMock(false)</IPublicTypeInternalFalseNoAttr>
<InternalTypeNoAttr>GenerateMock</InternalTypeNoAttr>
<PrivateTypeNoAttr>GenerateMock</PrivateTypeNoAttr>
<PrivateTypeInternalFalseNoAttr>GenerateMock(false)</PrivateTypeInternalFalseNoAttr>
<VeryPublicTypeNoAttr>GenerateMock</VeryPublicTypeNoAttr>
<CurriedNoAttr>GenerateMock</CurriedNoAttr>
<TypeWithInterfaceNoAttr>GenerateMock</TypeWithInterfaceNoAttr>
</MyriadParams>
</Compile>
<Compile Include="CapturingMockExampleNoAttributes.fs" />
<Compile Include="GeneratedCapturingMockNoAttributes.fs">
<MyriadFile>CapturingMockExampleNoAttributes.fs</MyriadFile>
<MyriadParams>
<IPublicTypeNoAttr>GenerateCapturingMock</IPublicTypeNoAttr>
<IPublicTypeInternalFalseNoAttr>GenerateCapturingMock(false)</IPublicTypeInternalFalseNoAttr>
<InternalTypeNoAttr>GenerateCapturingMock</InternalTypeNoAttr>
<PrivateTypeNoAttr>GenerateCapturingMock</PrivateTypeNoAttr>
<PrivateTypeInternalFalseNoAttr>GenerateCapturingMock(false)</PrivateTypeInternalFalseNoAttr>
<VeryPublicTypeNoAttr>GenerateCapturingMock</VeryPublicTypeNoAttr>
<CurriedNoAttr>GenerateCapturingMock</CurriedNoAttr>
<TypeWithInterfaceNoAttr>GenerateCapturingMock</TypeWithInterfaceNoAttr>
</MyriadParams>
</Compile>
<Compile Include="Vault.fs" /> <Compile Include="Vault.fs" />
<Compile Include="GeneratedVault.fs"> <Compile Include="GeneratedVault.fs">
<MyriadFile>Vault.fs</MyriadFile> <MyriadFile>Vault.fs</MyriadFile>
</Compile> </Compile>
<Compile Include="SerializationAndDeserialization.fs" />
<Compile Include="GeneratedSerde.fs">
<MyriadFile>SerializationAndDeserialization.fs</MyriadFile>
</Compile>
<Compile Include="Catamorphism.fs" />
<Compile Include="GeneratedCatamorphism.fs">
<MyriadFile>Catamorphism.fs</MyriadFile>
</Compile>
<Compile Include="FSharpForFunAndProfitCata.fs" />
<Compile Include="GeneratedFileSystem.fs">
<MyriadFile>FSharpForFunAndProfitCata.fs</MyriadFile>
</Compile>
<Compile Include="List.fs" />
<Compile Include="ListCata.fs">
<MyriadFile>List.fs</MyriadFile>
</Compile>
<Compile Include="Args.fs" />
<Compile Include="GeneratedArgs.fs">
<MyriadFile>Args.fs</MyriadFile>
</Compile>
<None Include="swagger-gitea.json" />
<Compile Include="GeneratedSwaggerGitea.fs">
<MyriadFile>swagger-gitea.json</MyriadFile>
<MyriadParams>
<GenerateMockInternal>true</GenerateMockInternal>
<ClassName>Gitea</ClassName>
</MyriadParams>
</Compile>
<Compile Include="Generated2SwaggerGitea.fs">
<MyriadFile>GeneratedSwaggerGitea.fs</MyriadFile>
</Compile>
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="RestEase" Version="1.6.4"/> <PackageReference Include="RestEase" Version="1.6.4"/>
<ProjectReference Include="..\WoofWare.Myriad.Plugins.Attributes\WoofWare.Myriad.Plugins.Attributes.fsproj" /> <ProjectReference Include="..\WoofWare.Myriad.Plugins\WoofWare.Myriad.Plugins.fsproj"/>
<ProjectReference Include="..\WoofWare.Myriad.Plugins\WoofWare.Myriad.Plugins.fsproj" PrivateAssets="all" /> <PackageReference Include="Myriad.Sdk" Version="0.8.3"/>
<PackageReference Include="Myriad.Sdk" Version="0.8.3" PrivateAssets="all" /> <PackageReference Include="Myriad.Core" Version="0.8.3"/>
</ItemGroup> </ItemGroup>
</Project> </Project>

View File

@@ -1,64 +0,0 @@
namespace ConsumePlugin
open WoofWare.Myriad.Plugins
type File =
{
Name : string
FileSize : int
}
type Directory =
{
Name : string
DirSize : int
Contents : FileSystemItem list
}
and [<CreateCatamorphism "FileSystemCata">] FileSystemItem =
| Directory of Directory
| File of File
type Book =
{
title : string
price : decimal
}
type ChocolateType =
| Dark
| Milk
| SeventyPercent
override this.ToString () =
match this with
| ChocolateType.Dark -> "Dark"
| ChocolateType.Milk -> "Milk"
| ChocolateType.SeventyPercent -> "SeventyPercent"
type Chocolate =
{
chocType : ChocolateType
price : decimal
}
override this.ToString () = this.chocType.ToString ()
type WrappingPaperStyle =
| HappyBirthday
| HappyHolidays
| SolidColor
override this.ToString () =
match this with
| WrappingPaperStyle.HappyBirthday -> "HappyBirthday"
| WrappingPaperStyle.HappyHolidays -> "HappyHolidays"
| WrappingPaperStyle.SolidColor -> "SolidColor"
[<CreateCatamorphism "GiftCata">]
type Gift =
| Book of Book
| Chocolate of Chocolate
| Wrapped of Gift * WrappingPaperStyle
| Boxed of Gift
| WithACard of Gift * message : string

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -1,562 +0,0 @@
//------------------------------------------------------------------------------
// This code was generated by myriad.
// Changes to this file will be lost when the code is regenerated.
//------------------------------------------------------------------------------
namespace SomeNamespace.CapturingMock
open System
open WoofWare.Myriad.Plugins
[<RequireQualifiedAccess>]
module internal PublicTypeMockCalls =
/// All the calls made to a PublicTypeMock mock
type internal Calls =
{
Mem1 : ResizeArray<string * int>
Mem2 : ResizeArray<string>
Mem3 : ResizeArray<int * System.Threading.CancellationToken option>
}
/// A fresh calls object which has not yet had any calls made.
static member Empty () : Calls =
{
Mem1 = ResizeArray ()
Mem2 = ResizeArray ()
Mem3 = ResizeArray ()
}
/// Mock record type for an interface
type internal PublicTypeMock =
{
Calls : PublicTypeMockCalls.Calls
Mem1 : string * int -> string list
Mem2 : string -> int
Mem3 : int * System.Threading.CancellationToken option -> string
}
/// An implementation where every non-unit method throws.
static member Empty () : PublicTypeMock =
{
Calls = PublicTypeMockCalls.Calls.Empty ()
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
Mem3 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem3"))
}
interface IPublicType with
member this.Mem1 (arg_0_0, arg_0_1) =
lock this.Calls.Mem1 (fun _ -> this.Calls.Mem1.Add (arg_0_0, arg_0_1))
this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 arg_0_0 =
lock this.Calls.Mem2 (fun _ -> this.Calls.Mem2.Add (arg_0_0))
this.Mem2 (arg_0_0)
member this.Mem3 (arg_0_0, arg_0_1) =
lock this.Calls.Mem3 (fun _ -> this.Calls.Mem3.Add (arg_0_0, arg_0_1))
this.Mem3 (arg_0_0, arg_0_1)
namespace SomeNamespace.CapturingMock
open System
open WoofWare.Myriad.Plugins
[<RequireQualifiedAccess>]
module public PublicTypeInternalFalseMockCalls =
/// All the calls made to a PublicTypeInternalFalseMock mock
type public Calls =
{
Mem1 : ResizeArray<string * int>
Mem2 : ResizeArray<string>
Mem3 : ResizeArray<int * System.Threading.CancellationToken option>
}
/// A fresh calls object which has not yet had any calls made.
static member Empty () : Calls =
{
Mem1 = ResizeArray ()
Mem2 = ResizeArray ()
Mem3 = ResizeArray ()
}
/// Mock record type for an interface
type public PublicTypeInternalFalseMock =
{
Calls : PublicTypeInternalFalseMockCalls.Calls
Mem1 : string * int -> string list
Mem2 : string -> int
Mem3 : int * System.Threading.CancellationToken option -> string
}
/// An implementation where every non-unit method throws.
static member Empty () : PublicTypeInternalFalseMock =
{
Calls = PublicTypeInternalFalseMockCalls.Calls.Empty ()
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
Mem3 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem3"))
}
interface IPublicTypeInternalFalse with
member this.Mem1 (arg_0_0, arg_0_1) =
lock this.Calls.Mem1 (fun _ -> this.Calls.Mem1.Add (arg_0_0, arg_0_1))
this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 arg_0_0 =
lock this.Calls.Mem2 (fun _ -> this.Calls.Mem2.Add (arg_0_0))
this.Mem2 (arg_0_0)
member this.Mem3 (arg_0_0, arg_0_1) =
lock this.Calls.Mem3 (fun _ -> this.Calls.Mem3.Add (arg_0_0, arg_0_1))
this.Mem3 (arg_0_0, arg_0_1)
namespace SomeNamespace.CapturingMock
open System
open WoofWare.Myriad.Plugins
[<RequireQualifiedAccess>]
module internal InternalTypeMockCalls =
/// All the calls made to a InternalTypeMock mock
type internal Calls =
{
Mem1 : ResizeArray<string * int>
Mem2 : ResizeArray<string>
}
/// A fresh calls object which has not yet had any calls made.
static member Empty () : Calls =
{
Mem1 = ResizeArray ()
Mem2 = ResizeArray ()
}
/// Mock record type for an interface
type internal InternalTypeMock =
{
Calls : InternalTypeMockCalls.Calls
Mem1 : string * int -> unit
Mem2 : string -> int
}
/// An implementation where every non-unit method throws.
static member Empty () : InternalTypeMock =
{
Calls = InternalTypeMockCalls.Calls.Empty ()
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
}
interface InternalType with
member this.Mem1 (arg_0_0, arg_0_1) =
lock this.Calls.Mem1 (fun _ -> this.Calls.Mem1.Add (arg_0_0, arg_0_1))
this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 arg_0_0 =
lock this.Calls.Mem2 (fun _ -> this.Calls.Mem2.Add (arg_0_0))
this.Mem2 (arg_0_0)
namespace SomeNamespace.CapturingMock
open System
open WoofWare.Myriad.Plugins
[<RequireQualifiedAccess>]
module internal PrivateTypeMockCalls =
/// All the calls made to a PrivateTypeMock mock
type internal Calls =
{
Mem1 : ResizeArray<string * int>
Mem2 : ResizeArray<string>
}
/// A fresh calls object which has not yet had any calls made.
static member Empty () : Calls =
{
Mem1 = ResizeArray ()
Mem2 = ResizeArray ()
}
/// Mock record type for an interface
type private PrivateTypeMock =
{
Calls : PrivateTypeMockCalls.Calls
Mem1 : string * int -> unit
Mem2 : string -> int
}
/// An implementation where every non-unit method throws.
static member Empty () : PrivateTypeMock =
{
Calls = PrivateTypeMockCalls.Calls.Empty ()
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
}
interface PrivateType with
member this.Mem1 (arg_0_0, arg_0_1) =
lock this.Calls.Mem1 (fun _ -> this.Calls.Mem1.Add (arg_0_0, arg_0_1))
this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 arg_0_0 =
lock this.Calls.Mem2 (fun _ -> this.Calls.Mem2.Add (arg_0_0))
this.Mem2 (arg_0_0)
namespace SomeNamespace.CapturingMock
open System
open WoofWare.Myriad.Plugins
[<RequireQualifiedAccess>]
module internal PrivateTypeInternalFalseMockCalls =
/// All the calls made to a PrivateTypeInternalFalseMock mock
type internal Calls =
{
Mem1 : ResizeArray<string * int>
Mem2 : ResizeArray<string>
}
/// A fresh calls object which has not yet had any calls made.
static member Empty () : Calls =
{
Mem1 = ResizeArray ()
Mem2 = ResizeArray ()
}
/// Mock record type for an interface
type private PrivateTypeInternalFalseMock =
{
Calls : PrivateTypeInternalFalseMockCalls.Calls
Mem1 : string * int -> unit
Mem2 : string -> int
}
/// An implementation where every non-unit method throws.
static member Empty () : PrivateTypeInternalFalseMock =
{
Calls = PrivateTypeInternalFalseMockCalls.Calls.Empty ()
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
}
interface PrivateTypeInternalFalse with
member this.Mem1 (arg_0_0, arg_0_1) =
lock this.Calls.Mem1 (fun _ -> this.Calls.Mem1.Add (arg_0_0, arg_0_1))
this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 arg_0_0 =
lock this.Calls.Mem2 (fun _ -> this.Calls.Mem2.Add (arg_0_0))
this.Mem2 (arg_0_0)
namespace SomeNamespace.CapturingMock
open System
open WoofWare.Myriad.Plugins
[<RequireQualifiedAccess>]
module internal VeryPublicTypeMockCalls =
/// All the calls made to a VeryPublicTypeMock mock
type internal Calls<'a, 'b> =
{
Mem1 : ResizeArray<'a>
}
/// A fresh calls object which has not yet had any calls made.
static member Empty () : Calls<'a, 'b> =
{
Mem1 = ResizeArray ()
}
/// Mock record type for an interface
type internal VeryPublicTypeMock<'a, 'b> =
{
Calls : VeryPublicTypeMockCalls.Calls<'a, 'b>
Mem1 : 'a -> 'b
}
/// An implementation where every non-unit method throws.
static member Empty () : VeryPublicTypeMock<'a, 'b> =
{
Calls = VeryPublicTypeMockCalls.Calls.Empty ()
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
}
interface VeryPublicType<'a, 'b> with
member this.Mem1 arg_0_0 =
lock this.Calls.Mem1 (fun _ -> this.Calls.Mem1.Add (arg_0_0))
this.Mem1 (arg_0_0)
namespace SomeNamespace.CapturingMock
open System
open WoofWare.Myriad.Plugins
[<RequireQualifiedAccess>]
module internal CurriedMockCalls =
/// A single call to the Mem1 method
type internal Mem1Call<'a> =
{
bar : int
Arg1 : 'a
}
/// A single call to the Mem2 method
type internal Mem2Call<'a> =
{
Arg0 : int * string
baz : 'a
}
/// A single call to the Mem3 method
type internal Mem3Call<'a> =
{
quux : (int * string)
flurb : 'a
}
/// A single call to the Mem4 method
type internal Mem4Call<'a> =
{
Arg0 : int * string
Arg1 : 'a * int
}
/// A single call to the Mem5 method
type internal Mem5Call<'a> =
{
Arg0 : int * string
Arg1 : 'a * int
}
/// A single call to the Mem6 method
type internal Mem6Call<'a> =
{
Arg0 : int * string
Arg1 : 'a * int
}
/// All the calls made to a CurriedMock mock
type internal Calls<'a> =
{
Mem1 : ResizeArray<Mem1Call<'a>>
Mem2 : ResizeArray<Mem2Call<'a>>
Mem3 : ResizeArray<Mem3Call<'a>>
Mem4 : ResizeArray<Mem4Call<'a>>
Mem5 : ResizeArray<Mem5Call<'a>>
Mem6 : ResizeArray<Mem6Call<'a>>
}
/// A fresh calls object which has not yet had any calls made.
static member Empty () : Calls<'a> =
{
Mem1 = ResizeArray ()
Mem2 = ResizeArray ()
Mem3 = ResizeArray ()
Mem4 = ResizeArray ()
Mem5 = ResizeArray ()
Mem6 = ResizeArray ()
}
/// Mock record type for an interface
type internal CurriedMock<'a> =
{
Calls : CurriedMockCalls.Calls<'a>
Mem1 : int -> 'a -> string
Mem2 : int * string -> 'a -> string
Mem3 : (int * string) -> 'a -> string
Mem4 : (int * string) -> ('a * int) -> string
Mem5 : int * string -> ('a * int) -> string
Mem6 : int * string -> 'a * int -> string
}
/// An implementation where every non-unit method throws.
static member Empty () : CurriedMock<'a> =
{
Calls = CurriedMockCalls.Calls.Empty ()
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
Mem3 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem3"))
Mem4 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem4"))
Mem5 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem5"))
Mem6 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem6"))
}
interface Curried<'a> with
member this.Mem1 arg_0_0 arg_1_0 =
lock
this.Calls.Mem1
(fun _ ->
this.Calls.Mem1.Add
{
bar = arg_0_0
Arg1 = arg_1_0
}
)
this.Mem1 (arg_0_0) (arg_1_0)
member this.Mem2 (arg_0_0, arg_0_1) arg_1_0 =
lock
this.Calls.Mem2
(fun _ ->
this.Calls.Mem2.Add
{
Arg0 = arg_0_0, arg_0_1
baz = arg_1_0
}
)
this.Mem2 (arg_0_0, arg_0_1) (arg_1_0)
member this.Mem3 arg_0_0 arg_1_0 =
lock
this.Calls.Mem3
(fun _ ->
this.Calls.Mem3.Add
{
quux = arg_0_0
flurb = arg_1_0
}
)
this.Mem3 (arg_0_0) (arg_1_0)
member this.Mem4 ((arg_0_0, arg_0_1)) ((arg_1_0, arg_1_1)) =
lock
this.Calls.Mem4
(fun _ ->
this.Calls.Mem4.Add
{
Arg0 = arg_0_0, arg_0_1
Arg1 = arg_1_0, arg_1_1
}
)
this.Mem4 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1)
member this.Mem5 (arg_0_0, arg_0_1) ((arg_1_0, arg_1_1)) =
lock
this.Calls.Mem5
(fun _ ->
this.Calls.Mem5.Add
{
Arg0 = arg_0_0, arg_0_1
Arg1 = arg_1_0, arg_1_1
}
)
this.Mem5 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1)
member this.Mem6 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1) =
lock
this.Calls.Mem6
(fun _ ->
this.Calls.Mem6.Add
{
Arg0 = arg_0_0, arg_0_1
Arg1 = arg_1_0, arg_1_1
}
)
this.Mem6 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1)
namespace SomeNamespace.CapturingMock
open System
open WoofWare.Myriad.Plugins
[<RequireQualifiedAccess>]
module internal TypeWithInterfaceMockCalls =
/// All the calls made to a TypeWithInterfaceMock mock
type internal Calls =
{
Mem1 : ResizeArray<string option>
Mem2 : ResizeArray<unit>
}
/// A fresh calls object which has not yet had any calls made.
static member Empty () : Calls =
{
Mem1 = ResizeArray ()
Mem2 = ResizeArray ()
}
/// Mock record type for an interface
type internal TypeWithInterfaceMock =
{
Calls : TypeWithInterfaceMockCalls.Calls
/// Implementation of IDisposable.Dispose
Dispose : unit -> unit
Mem1 : string option -> string[] Async
Mem2 : unit -> string[] Async
}
/// An implementation where every non-unit method throws.
static member Empty () : TypeWithInterfaceMock =
{
Calls = TypeWithInterfaceMockCalls.Calls.Empty ()
Dispose = (fun () -> ())
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
}
interface TypeWithInterface with
member this.Mem1 arg_0_0 =
lock this.Calls.Mem1 (fun _ -> this.Calls.Mem1.Add (arg_0_0))
this.Mem1 (arg_0_0)
member this.Mem2 () =
lock this.Calls.Mem2 (fun _ -> this.Calls.Mem2.Add (()))
this.Mem2 (())
interface System.IDisposable with
member this.Dispose () : unit = this.Dispose ()
namespace SomeNamespace.CapturingMock
open System
open WoofWare.Myriad.Plugins
[<RequireQualifiedAccess>]
module internal TypeWithPropertiesMockCalls =
/// All the calls made to a TypeWithPropertiesMock mock
type internal Calls =
{
Mem1 : ResizeArray<string option>
Prop1 : ResizeArray<unit>
Prop2 : ResizeArray<unit>
}
/// A fresh calls object which has not yet had any calls made.
static member Empty () : Calls =
{
Mem1 = ResizeArray ()
Prop1 = ResizeArray ()
Prop2 = ResizeArray ()
}
/// Mock record type for an interface
type internal TypeWithPropertiesMock =
{
Calls : TypeWithPropertiesMockCalls.Calls
/// Implementation of IDisposable.Dispose
Dispose : unit -> unit
Mem1 : string option -> string[] Async
Prop1 : unit -> int
Prop2 : unit -> unit Async
}
/// An implementation where every non-unit method throws.
static member Empty () : TypeWithPropertiesMock =
{
Calls = TypeWithPropertiesMockCalls.Calls.Empty ()
Dispose = (fun () -> ())
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Prop1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Prop1"))
Prop2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Prop2"))
}
interface TypeWithProperties with
member this.Mem1 arg_0_0 =
lock this.Calls.Mem1 (fun _ -> this.Calls.Mem1.Add (arg_0_0))
this.Mem1 (arg_0_0)
member this.Prop1 = this.Prop1 ()
member this.Prop2 = this.Prop2 ()
interface System.IDisposable with
member this.Dispose () : unit = this.Dispose ()

View File

@@ -1,500 +0,0 @@
//------------------------------------------------------------------------------
// This code was generated by myriad.
// Changes to this file will be lost when the code is regenerated.
//------------------------------------------------------------------------------
namespace SomeNamespace.CapturingMock
open System
[<RequireQualifiedAccess>]
module internal PublicTypeNoAttrMockCalls =
/// All the calls made to a PublicTypeNoAttrMock mock
type internal Calls =
{
Mem1 : ResizeArray<string * int>
Mem2 : ResizeArray<string>
Mem3 : ResizeArray<int * System.Threading.CancellationToken option>
}
/// A fresh calls object which has not yet had any calls made.
static member Empty () : Calls =
{
Mem1 = ResizeArray ()
Mem2 = ResizeArray ()
Mem3 = ResizeArray ()
}
/// Mock record type for an interface
type internal PublicTypeNoAttrMock =
{
Calls : PublicTypeNoAttrMockCalls.Calls
Mem1 : string * int -> string list
Mem2 : string -> int
Mem3 : int * System.Threading.CancellationToken option -> string
}
/// An implementation where every non-unit method throws.
static member Empty () : PublicTypeNoAttrMock =
{
Calls = PublicTypeNoAttrMockCalls.Calls.Empty ()
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
Mem3 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem3"))
}
interface IPublicTypeNoAttr with
member this.Mem1 (arg_0_0, arg_0_1) =
lock this.Calls.Mem1 (fun _ -> this.Calls.Mem1.Add (arg_0_0, arg_0_1))
this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 arg_0_0 =
lock this.Calls.Mem2 (fun _ -> this.Calls.Mem2.Add (arg_0_0))
this.Mem2 (arg_0_0)
member this.Mem3 (arg_0_0, arg_0_1) =
lock this.Calls.Mem3 (fun _ -> this.Calls.Mem3.Add (arg_0_0, arg_0_1))
this.Mem3 (arg_0_0, arg_0_1)
namespace SomeNamespace.CapturingMock
open System
[<RequireQualifiedAccess>]
module public PublicTypeInternalFalseNoAttrMockCalls =
/// All the calls made to a PublicTypeInternalFalseNoAttrMock mock
type public Calls =
{
Mem1 : ResizeArray<string * int>
Mem2 : ResizeArray<string>
Mem3 : ResizeArray<int * System.Threading.CancellationToken option>
}
/// A fresh calls object which has not yet had any calls made.
static member Empty () : Calls =
{
Mem1 = ResizeArray ()
Mem2 = ResizeArray ()
Mem3 = ResizeArray ()
}
/// Mock record type for an interface
type public PublicTypeInternalFalseNoAttrMock =
{
Calls : PublicTypeInternalFalseNoAttrMockCalls.Calls
Mem1 : string * int -> string list
Mem2 : string -> int
Mem3 : int * System.Threading.CancellationToken option -> string
}
/// An implementation where every non-unit method throws.
static member Empty () : PublicTypeInternalFalseNoAttrMock =
{
Calls = PublicTypeInternalFalseNoAttrMockCalls.Calls.Empty ()
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
Mem3 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem3"))
}
interface IPublicTypeInternalFalseNoAttr with
member this.Mem1 (arg_0_0, arg_0_1) =
lock this.Calls.Mem1 (fun _ -> this.Calls.Mem1.Add (arg_0_0, arg_0_1))
this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 arg_0_0 =
lock this.Calls.Mem2 (fun _ -> this.Calls.Mem2.Add (arg_0_0))
this.Mem2 (arg_0_0)
member this.Mem3 (arg_0_0, arg_0_1) =
lock this.Calls.Mem3 (fun _ -> this.Calls.Mem3.Add (arg_0_0, arg_0_1))
this.Mem3 (arg_0_0, arg_0_1)
namespace SomeNamespace.CapturingMock
open System
[<RequireQualifiedAccess>]
module internal InternalTypeNoAttrMockCalls =
/// All the calls made to a InternalTypeNoAttrMock mock
type internal Calls =
{
Mem1 : ResizeArray<string * int>
Mem2 : ResizeArray<string>
}
/// A fresh calls object which has not yet had any calls made.
static member Empty () : Calls =
{
Mem1 = ResizeArray ()
Mem2 = ResizeArray ()
}
/// Mock record type for an interface
type internal InternalTypeNoAttrMock =
{
Calls : InternalTypeNoAttrMockCalls.Calls
Mem1 : string * int -> unit
Mem2 : string -> int
}
/// An implementation where every non-unit method throws.
static member Empty () : InternalTypeNoAttrMock =
{
Calls = InternalTypeNoAttrMockCalls.Calls.Empty ()
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
}
interface InternalTypeNoAttr with
member this.Mem1 (arg_0_0, arg_0_1) =
lock this.Calls.Mem1 (fun _ -> this.Calls.Mem1.Add (arg_0_0, arg_0_1))
this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 arg_0_0 =
lock this.Calls.Mem2 (fun _ -> this.Calls.Mem2.Add (arg_0_0))
this.Mem2 (arg_0_0)
namespace SomeNamespace.CapturingMock
open System
[<RequireQualifiedAccess>]
module internal PrivateTypeNoAttrMockCalls =
/// All the calls made to a PrivateTypeNoAttrMock mock
type internal Calls =
{
Mem1 : ResizeArray<string * int>
Mem2 : ResizeArray<string>
}
/// A fresh calls object which has not yet had any calls made.
static member Empty () : Calls =
{
Mem1 = ResizeArray ()
Mem2 = ResizeArray ()
}
/// Mock record type for an interface
type private PrivateTypeNoAttrMock =
{
Calls : PrivateTypeNoAttrMockCalls.Calls
Mem1 : string * int -> unit
Mem2 : string -> int
}
/// An implementation where every non-unit method throws.
static member Empty () : PrivateTypeNoAttrMock =
{
Calls = PrivateTypeNoAttrMockCalls.Calls.Empty ()
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
}
interface PrivateTypeNoAttr with
member this.Mem1 (arg_0_0, arg_0_1) =
lock this.Calls.Mem1 (fun _ -> this.Calls.Mem1.Add (arg_0_0, arg_0_1))
this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 arg_0_0 =
lock this.Calls.Mem2 (fun _ -> this.Calls.Mem2.Add (arg_0_0))
this.Mem2 (arg_0_0)
namespace SomeNamespace.CapturingMock
open System
[<RequireQualifiedAccess>]
module internal PrivateTypeInternalFalseNoAttrMockCalls =
/// All the calls made to a PrivateTypeInternalFalseNoAttrMock mock
type internal Calls =
{
Mem1 : ResizeArray<string * int>
Mem2 : ResizeArray<string>
}
/// A fresh calls object which has not yet had any calls made.
static member Empty () : Calls =
{
Mem1 = ResizeArray ()
Mem2 = ResizeArray ()
}
/// Mock record type for an interface
type private PrivateTypeInternalFalseNoAttrMock =
{
Calls : PrivateTypeInternalFalseNoAttrMockCalls.Calls
Mem1 : string * int -> unit
Mem2 : string -> int
}
/// An implementation where every non-unit method throws.
static member Empty () : PrivateTypeInternalFalseNoAttrMock =
{
Calls = PrivateTypeInternalFalseNoAttrMockCalls.Calls.Empty ()
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
}
interface PrivateTypeInternalFalseNoAttr with
member this.Mem1 (arg_0_0, arg_0_1) =
lock this.Calls.Mem1 (fun _ -> this.Calls.Mem1.Add (arg_0_0, arg_0_1))
this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 arg_0_0 =
lock this.Calls.Mem2 (fun _ -> this.Calls.Mem2.Add (arg_0_0))
this.Mem2 (arg_0_0)
namespace SomeNamespace.CapturingMock
open System
[<RequireQualifiedAccess>]
module internal VeryPublicTypeNoAttrMockCalls =
/// All the calls made to a VeryPublicTypeNoAttrMock mock
type internal Calls<'a, 'b> =
{
Mem1 : ResizeArray<'a>
}
/// A fresh calls object which has not yet had any calls made.
static member Empty () : Calls<'a, 'b> =
{
Mem1 = ResizeArray ()
}
/// Mock record type for an interface
type internal VeryPublicTypeNoAttrMock<'a, 'b> =
{
Calls : VeryPublicTypeNoAttrMockCalls.Calls<'a, 'b>
Mem1 : 'a -> 'b
}
/// An implementation where every non-unit method throws.
static member Empty () : VeryPublicTypeNoAttrMock<'a, 'b> =
{
Calls = VeryPublicTypeNoAttrMockCalls.Calls.Empty ()
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
}
interface VeryPublicTypeNoAttr<'a, 'b> with
member this.Mem1 arg_0_0 =
lock this.Calls.Mem1 (fun _ -> this.Calls.Mem1.Add (arg_0_0))
this.Mem1 (arg_0_0)
namespace SomeNamespace.CapturingMock
open System
[<RequireQualifiedAccess>]
module internal CurriedNoAttrMockCalls =
/// A single call to the Mem1 method
type internal Mem1Call<'a> =
{
Arg0 : int
Arg1 : 'a
}
/// A single call to the Mem2 method
type internal Mem2Call<'a> =
{
Arg0 : int * string
Arg1 : 'a
}
/// A single call to the Mem3 method
type internal Mem3Call<'a> =
{
Arg0 : int * string
Arg1 : 'a
}
/// A single call to the Mem4 method
type internal Mem4Call<'a> =
{
Arg0 : int * string
Arg1 : 'a * int
}
/// A single call to the Mem5 method
type internal Mem5Call<'a> =
{
Arg0 : int * string
Arg1 : 'a * int
}
/// A single call to the Mem6 method
type internal Mem6Call<'a> =
{
Arg0 : int * string
Arg1 : 'a * int
}
/// All the calls made to a CurriedNoAttrMock mock
type internal Calls<'a> =
{
Mem1 : ResizeArray<Mem1Call<'a>>
Mem2 : ResizeArray<Mem2Call<'a>>
Mem3 : ResizeArray<Mem3Call<'a>>
Mem4 : ResizeArray<Mem4Call<'a>>
Mem5 : ResizeArray<Mem5Call<'a>>
Mem6 : ResizeArray<Mem6Call<'a>>
}
/// A fresh calls object which has not yet had any calls made.
static member Empty () : Calls<'a> =
{
Mem1 = ResizeArray ()
Mem2 = ResizeArray ()
Mem3 = ResizeArray ()
Mem4 = ResizeArray ()
Mem5 = ResizeArray ()
Mem6 = ResizeArray ()
}
/// Mock record type for an interface
type internal CurriedNoAttrMock<'a> =
{
Calls : CurriedNoAttrMockCalls.Calls<'a>
Mem1 : int -> 'a -> string
Mem2 : int * string -> 'a -> string
Mem3 : (int * string) -> 'a -> string
Mem4 : (int * string) -> ('a * int) -> string
Mem5 : int * string -> ('a * int) -> string
Mem6 : int * string -> 'a * int -> string
}
/// An implementation where every non-unit method throws.
static member Empty () : CurriedNoAttrMock<'a> =
{
Calls = CurriedNoAttrMockCalls.Calls.Empty ()
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
Mem3 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem3"))
Mem4 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem4"))
Mem5 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem5"))
Mem6 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem6"))
}
interface CurriedNoAttr<'a> with
member this.Mem1 arg_0_0 arg_1_0 =
lock
this.Calls.Mem1
(fun _ ->
this.Calls.Mem1.Add
{
Arg0 = arg_0_0
Arg1 = arg_1_0
}
)
this.Mem1 (arg_0_0) (arg_1_0)
member this.Mem2 (arg_0_0, arg_0_1) arg_1_0 =
lock
this.Calls.Mem2
(fun _ ->
this.Calls.Mem2.Add
{
Arg0 = arg_0_0, arg_0_1
Arg1 = 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 =
lock
this.Calls.Mem3
(fun _ ->
this.Calls.Mem3.Add
{
Arg0 = arg_0_0, arg_0_1
Arg1 = 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)) =
lock
this.Calls.Mem4
(fun _ ->
this.Calls.Mem4.Add
{
Arg0 = arg_0_0, arg_0_1
Arg1 = arg_1_0, arg_1_1
}
)
this.Mem4 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1)
member this.Mem5 (arg_0_0, arg_0_1) ((arg_1_0, arg_1_1)) =
lock
this.Calls.Mem5
(fun _ ->
this.Calls.Mem5.Add
{
Arg0 = arg_0_0, arg_0_1
Arg1 = arg_1_0, arg_1_1
}
)
this.Mem5 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1)
member this.Mem6 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1) =
lock
this.Calls.Mem6
(fun _ ->
this.Calls.Mem6.Add
{
Arg0 = arg_0_0, arg_0_1
Arg1 = arg_1_0, arg_1_1
}
)
this.Mem6 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1)
namespace SomeNamespace.CapturingMock
open System
[<RequireQualifiedAccess>]
module internal TypeWithInterfaceNoAttrMockCalls =
/// All the calls made to a TypeWithInterfaceNoAttrMock mock
type internal Calls =
{
Mem1 : ResizeArray<string option>
Mem2 : ResizeArray<unit>
}
/// A fresh calls object which has not yet had any calls made.
static member Empty () : Calls =
{
Mem1 = ResizeArray ()
Mem2 = ResizeArray ()
}
/// Mock record type for an interface
type internal TypeWithInterfaceNoAttrMock =
{
Calls : TypeWithInterfaceNoAttrMockCalls.Calls
/// Implementation of IDisposable.Dispose
Dispose : unit -> unit
Mem1 : string option -> string[] Async
Mem2 : unit -> string[] Async
}
/// An implementation where every non-unit method throws.
static member Empty () : TypeWithInterfaceNoAttrMock =
{
Calls = TypeWithInterfaceNoAttrMockCalls.Calls.Empty ()
Dispose = (fun () -> ())
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
}
interface TypeWithInterfaceNoAttr with
member this.Mem1 arg_0_0 =
lock this.Calls.Mem1 (fun _ -> this.Calls.Mem1.Add (arg_0_0))
this.Mem1 (arg_0_0)
member this.Mem2 () =
lock this.Calls.Mem2 (fun _ -> this.Calls.Mem2.Add (()))
this.Mem2 (())
interface System.IDisposable with
member this.Dispose () : unit = this.Dispose ()

View File

@@ -1,139 +0,0 @@
//------------------------------------------------------------------------------
// This code was generated by myriad.
// Changes to this file will be lost when the code is regenerated.
//------------------------------------------------------------------------------
namespace ConsumePlugin
open WoofWare.Myriad.Plugins
/// Description of how to combine cases during a fold
type TreeBuilderCataCase<'b, 'a, 'TreeBuilder, 'Tree> =
/// How to operate on the Child case
abstract Child : 'TreeBuilder -> 'TreeBuilder
/// How to operate on the Parent case
abstract Parent : 'Tree -> 'TreeBuilder
/// Description of how to combine cases during a fold
type TreeCataCase<'a, 'b, 'TreeBuilder, 'Tree> =
/// How to operate on the Const case
abstract Const : Const<'a> -> 'b -> 'Tree
/// How to operate on the Pair case
abstract Pair : 'Tree -> 'Tree -> PairOpKind -> 'Tree
/// How to operate on the Sequential case
abstract Sequential : 'Tree list -> 'Tree
/// How to operate on the Builder case
abstract Builder : 'Tree -> 'TreeBuilder -> 'Tree
/// Specifies how to perform a fold (catamorphism) over the type Tree and its friends.
type TreeCata<'b, 'a, 'TreeBuilder, 'Tree> =
{
/// How to perform a fold (catamorphism) over the type TreeBuilder
TreeBuilder : TreeBuilderCataCase<'b, 'a, 'TreeBuilder, 'Tree>
/// How to perform a fold (catamorphism) over the type Tree
Tree : TreeCataCase<'a, 'b, 'TreeBuilder, 'Tree>
}
/// Methods to perform a catamorphism over the type Tree
[<RequireQualifiedAccess>]
module TreeCata =
[<RequireQualifiedAccess>]
type private Instruction<'b, 'a> =
| Process__TreeBuilder of TreeBuilder<'b, 'a>
| Process__Tree of Tree<'a, 'b>
| TreeBuilder_Child
| TreeBuilder_Parent
| Tree_Pair of PairOpKind
| Tree_Sequential of int
| Tree_Builder
let private loop (cata : TreeCata<'b, 'a, 'TreeBuilder, 'Tree>) (instructions : ResizeArray<Instruction<'b, 'a>>) =
let treeStack = ResizeArray<'Tree> ()
let treeBuilderStack = ResizeArray<'TreeBuilder> ()
while instructions.Count > 0 do
let currentInstruction = instructions.[instructions.Count - 1]
instructions.RemoveAt (instructions.Count - 1)
match currentInstruction with
| Instruction.Process__TreeBuilder x ->
match x with
| TreeBuilder.Child (arg0_0) ->
instructions.Add Instruction.TreeBuilder_Child
instructions.Add (Instruction.Process__TreeBuilder arg0_0)
| TreeBuilder.Parent (arg0_0) ->
instructions.Add Instruction.TreeBuilder_Parent
instructions.Add (Instruction.Process__Tree arg0_0)
| 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) ->
instructions.Add (Instruction.Tree_Pair (arg2_0))
instructions.Add (Instruction.Process__Tree arg0_0)
instructions.Add (Instruction.Process__Tree arg1_0)
| Tree.Sequential (arg0_0) ->
instructions.Add (Instruction.Tree_Sequential ((List.length arg0_0)))
for elt in arg0_0 do
instructions.Add (Instruction.Process__Tree elt)
| Tree.Builder (arg0_0, arg1_0) ->
instructions.Add Instruction.Tree_Builder
instructions.Add (Instruction.Process__Tree arg0_0)
instructions.Add (Instruction.Process__TreeBuilder arg1_0)
| Instruction.TreeBuilder_Child ->
let arg0_0 = treeBuilderStack.[treeBuilderStack.Count - 1]
treeBuilderStack.RemoveAt (treeBuilderStack.Count - 1)
cata.TreeBuilder.Child arg0_0 |> treeBuilderStack.Add
| Instruction.TreeBuilder_Parent ->
let arg0_0 = treeStack.[treeStack.Count - 1]
treeStack.RemoveAt (treeStack.Count - 1)
cata.TreeBuilder.Parent arg0_0 |> treeBuilderStack.Add
| Instruction.Tree_Pair arg2_0 ->
let arg0_0 = treeStack.[treeStack.Count - 1]
treeStack.RemoveAt (treeStack.Count - 1)
let arg1_0 = treeStack.[treeStack.Count - 1]
treeStack.RemoveAt (treeStack.Count - 1)
cata.Tree.Pair arg0_0 arg1_0 arg2_0 |> treeStack.Add
| Instruction.Tree_Sequential arg0_0 ->
let arg0_0_len = arg0_0
let arg0_0 =
seq {
for i = treeStack.Count - 1 downto treeStack.Count - arg0_0 do
yield treeStack.[i]
}
|> Seq.toList
treeStack.RemoveRange (treeStack.Count - arg0_0_len, arg0_0_len)
cata.Tree.Sequential arg0_0 |> treeStack.Add
| Instruction.Tree_Builder ->
let arg0_0 = treeStack.[treeStack.Count - 1]
treeStack.RemoveAt (treeStack.Count - 1)
let arg1_0 = treeBuilderStack.[treeBuilderStack.Count - 1]
treeBuilderStack.RemoveAt (treeBuilderStack.Count - 1)
cata.Tree.Builder arg0_0 arg1_0 |> treeStack.Add
treeBuilderStack, treeStack
/// Execute the catamorphism.
let runTreeBuilder
(cata : TreeCata<'b, 'a, 'TreeBuilderRet, 'TreeRet>)
(x : TreeBuilder<'b, 'a>)
: 'TreeBuilderRet
=
let instructions = ResizeArray ()
instructions.Add (Instruction.Process__TreeBuilder x)
let treeBuilderRetStack, treeRetStack = loop cata instructions
Seq.exactlyOne treeBuilderRetStack
/// Execute the catamorphism.
let runTree (cata : TreeCata<'b, 'a, 'TreeBuilderRet, 'TreeRet>) (x : Tree<'a, 'b>) : 'TreeRet =
let instructions = ResizeArray ()
instructions.Add (Instruction.Process__Tree x)
let treeBuilderRetStack, treeRetStack = loop cata instructions
Seq.exactlyOne treeRetStack

View File

@@ -1,153 +0,0 @@
//------------------------------------------------------------------------------
// This code was generated by myriad.
// Changes to this file will be lost when the code is regenerated.
//------------------------------------------------------------------------------
namespace ConsumePlugin
open WoofWare.Myriad.Plugins
/// Description of how to combine cases during a fold
type FileSystemItemCataCase<'FileSystemItem> =
/// How to operate on the Directory case
abstract Directory : name : string -> dirSize : int -> contents : 'FileSystemItem list -> 'FileSystemItem
/// How to operate on the File case
abstract File : File -> 'FileSystemItem
/// Specifies how to perform a fold (catamorphism) over the type FileSystemItem and its friends.
type FileSystemCata<'FileSystemItem> =
{
/// How to perform a fold (catamorphism) over the type FileSystemItem
FileSystemItem : FileSystemItemCataCase<'FileSystemItem>
}
/// Methods to perform a catamorphism over the type FileSystemItem
[<RequireQualifiedAccess>]
module FileSystemItemCata =
[<RequireQualifiedAccess>]
type private Instruction =
| Process__FileSystemItem of FileSystemItem
| FileSystemItem_Directory of name : string * dirSize : int * contents : int
let private loop (cata : FileSystemCata<'FileSystemItem>) (instructions : ResizeArray<Instruction>) =
let fileSystemItemStack = ResizeArray<'FileSystemItem> ()
while instructions.Count > 0 do
let currentInstruction = instructions.[instructions.Count - 1]
instructions.RemoveAt (instructions.Count - 1)
match currentInstruction with
| Instruction.Process__FileSystemItem x ->
match x with
| FileSystemItem.Directory ({
Name = name
DirSize = dirSize
Contents = contents
}) ->
instructions.Add (Instruction.FileSystemItem_Directory (name, dirSize, (List.length contents)))
for elt in contents do
instructions.Add (Instruction.Process__FileSystemItem elt)
| FileSystemItem.File (arg0_0) -> cata.FileSystemItem.File arg0_0 |> fileSystemItemStack.Add
| Instruction.FileSystemItem_Directory (name, dirSize, contents) ->
let contents_len = contents
let contents =
seq {
for i = fileSystemItemStack.Count - 1 downto fileSystemItemStack.Count - contents do
yield fileSystemItemStack.[i]
}
|> Seq.toList
fileSystemItemStack.RemoveRange (fileSystemItemStack.Count - contents_len, contents_len)
cata.FileSystemItem.Directory name dirSize contents |> fileSystemItemStack.Add
fileSystemItemStack
/// Execute the catamorphism.
let runFileSystemItem (cata : FileSystemCata<'FileSystemItemRet>) (x : FileSystemItem) : 'FileSystemItemRet =
let instructions = ResizeArray ()
instructions.Add (Instruction.Process__FileSystemItem x)
let fileSystemItemRetStack = loop cata instructions
Seq.exactlyOne fileSystemItemRetStack
namespace ConsumePlugin
open WoofWare.Myriad.Plugins
/// Description of how to combine cases during a fold
type GiftCataCase<'Gift> =
/// How to operate on the Book case
abstract Book : Book -> 'Gift
/// How to operate on the Chocolate case
abstract Chocolate : Chocolate -> 'Gift
/// How to operate on the Wrapped case
abstract Wrapped : 'Gift -> WrappingPaperStyle -> 'Gift
/// How to operate on the Boxed case
abstract Boxed : 'Gift -> 'Gift
/// How to operate on the WithACard case
abstract WithACard : 'Gift -> message : string -> 'Gift
/// Specifies how to perform a fold (catamorphism) over the type Gift and its friends.
type GiftCata<'Gift> =
{
/// How to perform a fold (catamorphism) over the type Gift
Gift : GiftCataCase<'Gift>
}
/// Methods to perform a catamorphism over the type Gift
[<RequireQualifiedAccess>]
module GiftCata =
[<RequireQualifiedAccess>]
type private Instruction =
| Process__Gift of Gift
| Gift_Wrapped of WrappingPaperStyle
| Gift_Boxed
| Gift_WithACard of message : string
let private loop (cata : GiftCata<'Gift>) (instructions : ResizeArray<Instruction>) =
let giftStack = ResizeArray<'Gift> ()
while instructions.Count > 0 do
let currentInstruction = instructions.[instructions.Count - 1]
instructions.RemoveAt (instructions.Count - 1)
match currentInstruction with
| 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
| Gift.Wrapped (arg0_0, arg1_0) ->
instructions.Add (Instruction.Gift_Wrapped (arg1_0))
instructions.Add (Instruction.Process__Gift arg0_0)
| Gift.Boxed (arg0_0) ->
instructions.Add Instruction.Gift_Boxed
instructions.Add (Instruction.Process__Gift arg0_0)
| Gift.WithACard (arg0_0, message) ->
instructions.Add (Instruction.Gift_WithACard (message))
instructions.Add (Instruction.Process__Gift arg0_0)
| Instruction.Gift_Wrapped arg1_0 ->
let arg0_0 = giftStack.[giftStack.Count - 1]
giftStack.RemoveAt (giftStack.Count - 1)
cata.Gift.Wrapped arg0_0 arg1_0 |> giftStack.Add
| Instruction.Gift_Boxed ->
let arg0_0 = giftStack.[giftStack.Count - 1]
giftStack.RemoveAt (giftStack.Count - 1)
cata.Gift.Boxed arg0_0 |> giftStack.Add
| Instruction.Gift_WithACard message ->
let arg0_0 = giftStack.[giftStack.Count - 1]
giftStack.RemoveAt (giftStack.Count - 1)
cata.Gift.WithACard arg0_0 message |> giftStack.Add
giftStack
/// Execute the catamorphism.
let runGift (cata : GiftCata<'GiftRet>) (x : Gift) : 'GiftRet =
let instructions = ResizeArray ()
instructions.Add (Instruction.Process__Gift x)
let giftRetStack = loop cata instructions
Seq.exactlyOne giftRetStack

View File

@@ -4,480 +4,182 @@
//------------------------------------------------------------------------------ //------------------------------------------------------------------------------
namespace ConsumePlugin
open System.Text.Json.Serialization
/// Module containing JSON serializing methods for the InternalTypeNotExtensionSerial type
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module internal InternalTypeNotExtensionSerial =
/// Serialize to a JSON node
let toJsonNode (input : InternalTypeNotExtensionSerial) : System.Text.Json.Nodes.JsonNode =
let node = System.Text.Json.Nodes.JsonObject ()
do
node.Add (
(Literals.something),
(input.InternalThing2
|> (fun field ->
let field = System.Text.Json.Nodes.JsonValue.Create<string> field
(match field with
| null ->
raise (
System.ArgumentNullException
"Expected type string to be non-null, but received a null value when serialising"
)
| field -> field)
))
)
node :> _
namespace ConsumePlugin
open System.Text.Json.Serialization
/// Module containing JSON serializing extension members for the InternalTypeExtension type
[<AutoOpen>]
module internal InternalTypeExtensionJsonSerializeExtension =
/// Extension methods for JSON parsing
type InternalTypeExtension with
/// Serialize to a JSON node
static member toJsonNode (input : InternalTypeExtension) : System.Text.Json.Nodes.JsonNode =
let node = System.Text.Json.Nodes.JsonObject ()
do
node.Add (
(Literals.something),
(input.ExternalThing
|> (fun field ->
let field = System.Text.Json.Nodes.JsonValue.Create<string> field
(match field with
| null ->
raise (
System.ArgumentNullException
"Expected type string to be non-null, but received a null value when serialising"
)
| field -> field)
))
)
node :> _
namespace ConsumePlugin namespace ConsumePlugin
/// Module containing JSON parsing methods for the InnerType type /// Module containing JSON parsing methods for the InnerType type
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>] [<RequireQualifiedAccess>]
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module InnerType = module InnerType =
/// Parse from a JSON node. /// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : InnerType = let jsonParse (node : System.Text.Json.Nodes.JsonNode) : InnerType =
let arg_0 = let Thing =
match node.[(Literals.something)] |> Option.ofObj with (match node.[(Literals.something)] with
| None -> | null ->
raise ( raise (
System.Collections.Generic.KeyNotFoundException ( System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ((Literals.something)) sprintf "Required key '%s' not found on JSON object" ((Literals.something))
) )
) )
| Some node -> node.AsValue().GetValue<System.String> () | v -> v)
.AsValue()
.GetValue<string> ()
{ {
Thing = arg_0 Thing = Thing
} }
namespace ConsumePlugin namespace ConsumePlugin
/// Module containing JSON parsing methods for the JsonRecordType type /// Module containing JSON parsing methods for the JsonRecordType type
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>] [<RequireQualifiedAccess>]
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module JsonRecordType = module JsonRecordType =
/// Parse from a JSON node. /// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordType = let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordType =
let arg_5 = let F =
match node.["f"] |> Option.ofObj with (match node.["f"] with
| None -> | null ->
raise ( raise (
System.Collections.Generic.KeyNotFoundException ( System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("f") sprintf "Required key '%s' not found on JSON object" ("f")
) )
) )
| Some node -> | v -> v)
node.AsArray () .AsArray ()
|> Seq.map (fun elt -> |> Seq.map (fun elt -> elt.AsValue().GetValue<int> ())
(match elt with |> Array.ofSeq
| null ->
raise (
System.ArgumentNullException
"Expected element of array (element type int32) to be non-null, but found a null element"
)
| elt -> elt.AsValue().GetValue<System.Int32> ())
)
|> Array.ofSeq
let arg_4 = let E =
match node.["e"] |> Option.ofObj with (match node.["e"] with
| None -> | null ->
raise ( raise (
System.Collections.Generic.KeyNotFoundException ( System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("e") sprintf "Required key '%s' not found on JSON object" ("e")
) )
) )
| Some node -> | v -> v)
node.AsArray () .AsArray ()
|> Seq.map (fun elt -> |> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
(match elt with |> Array.ofSeq
| null ->
raise (
System.ArgumentNullException
"Expected element of array (element type string) to be non-null, but found a null element"
)
| elt -> elt.AsValue().GetValue<System.String> ())
)
|> Array.ofSeq
let arg_3 = let D =
match node.["d"] |> Option.ofObj with InnerType.jsonParse (
| None -> match node.["d"] with
raise ( | null ->
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("d")
)
)
| Some node -> InnerType.jsonParse node
let arg_2 =
match node.["hi"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("hi")
)
)
| Some node ->
node.AsArray ()
|> Seq.map (fun elt ->
(match elt with
| null ->
raise (
System.ArgumentNullException
"Expected element of array (element type int32) to be non-null, but found a null element"
)
| elt -> elt.AsValue().GetValue<System.Int32> ())
)
|> List.ofSeq
let arg_1 =
match node.["another-thing"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("another-thing")
)
)
| Some node -> node.AsValue().GetValue<System.String> ()
let arg_0 =
match node.["a"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("a")
)
)
| Some node -> node.AsValue().GetValue<System.Int32> ()
{
A = arg_0
B = arg_1
C = arg_2
D = arg_3
E = arg_4
F = arg_5
}
namespace ConsumePlugin
/// Module containing JSON parsing methods for the InternalTypeNotExtension type
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module internal InternalTypeNotExtension =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : InternalTypeNotExtension =
let arg_0 =
match node.[(Literals.something)] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ((Literals.something))
)
)
| Some node -> node.AsValue().GetValue<System.String> ()
{
InternalThing = arg_0
}
namespace ConsumePlugin
/// Module containing JSON parsing extension members for the InternalTypeExtension type
[<AutoOpen>]
module internal InternalTypeExtensionJsonParseExtension =
/// Extension methods for JSON parsing
type InternalTypeExtension with
/// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : InternalTypeExtension =
let arg_0 =
match node.[(Literals.something)] |> Option.ofObj with
| None ->
raise ( raise (
System.Collections.Generic.KeyNotFoundException ( System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ((Literals.something)) sprintf "Required key '%s' not found on JSON object" ("d")
) )
) )
| Some node -> node.AsValue().GetValue<System.String> () | v -> v
)
{ let C =
ExternalThing = arg_0 (match node.["hi"] with
} | null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("hi")
)
)
| v -> v)
.AsArray ()
|> Seq.map (fun elt -> elt.AsValue().GetValue<int> ())
|> List.ofSeq
let B =
(match node.["another-thing"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("another-thing")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
let A =
(match node.["a"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("a")
)
)
| v -> v)
.AsValue()
.GetValue<int> ()
{
A = A
B = B
C = C
D = D
E = E
F = F
}
namespace ConsumePlugin namespace ConsumePlugin
/// Module containing JSON parsing extension members for the ToGetExtensionMethod type /// Module containing JSON parsing extension members for the ToGetExtensionMethod type
[<AutoOpen>] [<AutoOpen>]
module ToGetExtensionMethodJsonParseExtension = module ToGetExtensionMethodJsonParseExtension =
/// Extension methods for JSON parsing ///Extension methods for JSON parsing
type ToGetExtensionMethod with type ToGetExtensionMethod with
/// Parse from a JSON node. /// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : ToGetExtensionMethod = static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : ToGetExtensionMethod =
let arg_20 = let Sailor =
match node.["whiskey"] |> Option.ofObj with (match node.["sailor"] with
| None -> | null ->
raise ( raise (
System.Collections.Generic.KeyNotFoundException ( System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("whiskey") sprintf "Required key '%s' not found on JSON object" ("sailor")
) )
) )
| Some node -> System.Numerics.BigInteger.Parse (node.ToJsonString ()) | v -> v)
.AsValue()
.GetValue<float> ()
let arg_19 = let Soldier =
match node.["victor"] |> Option.ofObj with (match node.["soldier"] with
| None -> | null ->
raise ( raise (
System.Collections.Generic.KeyNotFoundException ( System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("victor") sprintf "Required key '%s' not found on JSON object" ("soldier")
) )
) )
| Some node -> node.AsValue().GetValue<System.Char> () | v -> v)
.AsValue()
.GetValue<string> ()
|> System.Uri
let arg_18 = let Tailor =
match node.["uniform"] |> Option.ofObj with (match node.["tailor"] with
| None -> | null ->
raise ( raise (
System.Collections.Generic.KeyNotFoundException ( System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("uniform") sprintf "Required key '%s' not found on JSON object" ("tailor")
) )
) )
| Some node -> node.AsValue().GetValue<System.Decimal> () | v -> v)
.AsValue()
.GetValue<int> ()
let arg_17 = let Tinker =
match node.["tango"] |> Option.ofObj with (match node.["tinker"] with
| None -> | null ->
raise ( raise (
System.Collections.Generic.KeyNotFoundException ( System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("tango") sprintf "Required key '%s' not found on JSON object" ("tinker")
) )
) )
| Some node -> node.AsValue().GetValue<System.SByte> () | v -> v)
.AsValue()
let arg_16 = .GetValue<string> ()
match node.["quebec"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("quebec")
)
)
| Some node -> node.AsValue().GetValue<System.Byte> ()
let arg_15 =
match node.["papa"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("papa")
)
)
| Some node -> node.AsValue().GetValue<System.Byte> ()
let arg_14 =
match node.["oscar"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("oscar")
)
)
| Some node -> node.AsValue().GetValue<System.SByte> ()
let arg_13 =
match node.["november"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("november")
)
)
| Some node -> node.AsValue().GetValue<System.UInt16> ()
let arg_12 =
match node.["mike"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("mike")
)
)
| Some node -> node.AsValue().GetValue<System.Int16> ()
let arg_11 =
match node.["lima"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lima")
)
)
| Some node -> node.AsValue().GetValue<System.UInt32> ()
let arg_10 =
match node.["kilo"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("kilo")
)
)
| Some node -> node.AsValue().GetValue<System.Int32> ()
let arg_9 =
match node.["juliette"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("juliette")
)
)
| Some node -> node.AsValue().GetValue<System.UInt32> ()
let arg_8 =
match node.["india"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("india")
)
)
| Some node -> node.AsValue().GetValue<System.Int32> ()
let arg_7 =
match node.["hotel"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("hotel")
)
)
| Some node -> node.AsValue().GetValue<System.UInt64> ()
let arg_6 =
match node.["golf"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("golf")
)
)
| Some node -> node.AsValue().GetValue<System.Int64> ()
let arg_5 =
match node.["foxtrot"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("foxtrot")
)
)
| Some node -> node.AsValue().GetValue<System.Double> ()
let arg_4 =
match node.["echo"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("echo")
)
)
| Some node -> node.AsValue().GetValue<System.Single> ()
let arg_3 =
match node.["delta"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("delta")
)
)
| Some node -> node.AsValue().GetValue<System.Single> ()
let arg_2 =
match node.["charlie"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("charlie")
)
)
| Some node -> node.AsValue().GetValue<System.Double> ()
let arg_1 =
match node.["bravo"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("bravo")
)
)
| Some node -> node.AsValue().GetValue<string> () |> System.Uri
let arg_0 =
match node.["alpha"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("alpha")
)
)
| Some node -> node.AsValue().GetValue<System.String> ()
{ {
Alpha = arg_0 Tinker = Tinker
Bravo = arg_1 Tailor = Tailor
Charlie = arg_2 Soldier = Soldier
Delta = arg_3 Sailor = Sailor
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,9 +5,6 @@
namespace SomeNamespace namespace SomeNamespace
open System
open WoofWare.Myriad.Plugins
/// Mock record type for an interface /// Mock record type for an interface
type internal PublicTypeMock = type internal PublicTypeMock =
{ {
@@ -16,48 +13,19 @@ type internal PublicTypeMock =
Mem3 : int * option<System.Threading.CancellationToken> -> string Mem3 : int * option<System.Threading.CancellationToken> -> string
} }
/// An implementation where every method throws.
static member Empty : PublicTypeMock = static member Empty : PublicTypeMock =
{ {
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1")) Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2")) Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem3 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem3")) Mem3 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
} }
interface IPublicType with interface IPublicType with
member this.Mem1 (arg_0_0, arg_0_1) = this.Mem1 (arg_0_0, arg_0_1) 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) member this.Mem3 (arg_0_0, arg_0_1) = this.Mem3 (arg_0_0, arg_0_1)
namespace SomeNamespace namespace SomeNamespace
open System
open WoofWare.Myriad.Plugins
/// Mock record type for an interface
type public PublicTypeInternalFalseMock =
{
Mem1 : string * int -> string list
Mem2 : string -> int
Mem3 : int * option<System.Threading.CancellationToken> -> string
}
/// An implementation where every method throws.
static member Empty : PublicTypeInternalFalseMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
Mem3 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem3"))
}
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.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 /// Mock record type for an interface
type internal InternalTypeMock = type internal InternalTypeMock =
{ {
@@ -65,21 +33,17 @@ type internal InternalTypeMock =
Mem2 : string -> int Mem2 : string -> int
} }
/// An implementation where every method throws.
static member Empty : InternalTypeMock = static member Empty : InternalTypeMock =
{ {
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1")) Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2")) Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
} }
interface InternalType with interface InternalType with
member this.Mem1 (arg_0_0, arg_0_1) = this.Mem1 (arg_0_0, arg_0_1) 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 namespace SomeNamespace
open System
open WoofWare.Myriad.Plugins
/// Mock record type for an interface /// Mock record type for an interface
type private PrivateTypeMock = type private PrivateTypeMock =
{ {
@@ -87,62 +51,32 @@ type private PrivateTypeMock =
Mem2 : string -> int Mem2 : string -> int
} }
/// An implementation where every method throws.
static member Empty : PrivateTypeMock = static member Empty : PrivateTypeMock =
{ {
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1")) Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2")) Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
} }
interface PrivateType with interface PrivateType with
member this.Mem1 (arg_0_0, arg_0_1) = this.Mem1 (arg_0_0, arg_0_1) 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 namespace SomeNamespace
open System
open WoofWare.Myriad.Plugins
/// Mock record type for an interface
type private PrivateTypeInternalFalseMock =
{
Mem1 : string * int -> unit
Mem2 : string -> int
}
/// An implementation where every method throws.
static member Empty : PrivateTypeInternalFalseMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
}
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)
namespace SomeNamespace
open System
open WoofWare.Myriad.Plugins
/// Mock record type for an interface /// Mock record type for an interface
type internal VeryPublicTypeMock<'a, 'b> = type internal VeryPublicTypeMock<'a, 'b> =
{ {
Mem1 : 'a -> 'b Mem1 : 'a -> 'b
} }
/// An implementation where every method throws.
static member Empty () : VeryPublicTypeMock<'a, 'b> = static member Empty () : VeryPublicTypeMock<'a, 'b> =
{ {
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1")) Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
} }
interface VeryPublicType<'a, 'b> with 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 namespace SomeNamespace
open System
open WoofWare.Myriad.Plugins
/// Mock record type for an interface /// Mock record type for an interface
type internal CurriedMock<'a> = type internal CurriedMock<'a> =
{ {
@@ -154,21 +88,20 @@ type internal CurriedMock<'a> =
Mem6 : int * string -> 'a * int -> string Mem6 : int * string -> 'a * int -> string
} }
/// An implementation where every method throws.
static member Empty () : CurriedMock<'a> = static member Empty () : CurriedMock<'a> =
{ {
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1")) Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2")) Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem3 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem3")) Mem3 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem4 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem4")) Mem4 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem5 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem5")) Mem5 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem6 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem6")) Mem6 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function"))
} }
interface Curried<'a> with interface Curried<'a> with
member this.Mem1 arg_0_0 arg_1_0 = this.Mem1 (arg_0_0) (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.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.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)) = 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) this.Mem4 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1)
@@ -178,62 +111,3 @@ type internal CurriedMock<'a> =
member this.Mem6 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1) = member this.Mem6 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1) =
this.Mem6 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1) 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: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
}
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 ()
namespace SomeNamespace
open System
open WoofWare.Myriad.Plugins
/// Mock record type for an interface
type internal TypeWithPropertiesMock =
{
/// Implementation of IDisposable.Dispose
Dispose : unit -> unit
Prop1 : unit -> int
Prop2 : unit -> unit Async
Mem1 : string option -> string[] Async
}
/// An implementation where every method throws.
static member Empty : TypeWithPropertiesMock =
{
Dispose = (fun () -> ())
Prop1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Prop1"))
Prop2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Prop2"))
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
}
interface TypeWithProperties with
member this.Mem1 arg_0_0 = this.Mem1 (arg_0_0)
member this.Prop1 = this.Prop1 ()
member this.Prop2 = this.Prop2 ()
interface System.IDisposable with
member this.Dispose () : unit = this.Dispose ()

View File

@@ -1,200 +0,0 @@
//------------------------------------------------------------------------------
// This code was generated by myriad.
// Changes to this file will be lost when the code is regenerated.
//------------------------------------------------------------------------------
namespace SomeNamespace
open System
/// Mock record type for an interface
type internal PublicTypeNoAttrMock =
{
Mem1 : string * int -> string list
Mem2 : string -> int
Mem3 : int * option<System.Threading.CancellationToken> -> string
}
/// An implementation where every method throws.
static member Empty : PublicTypeNoAttrMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
Mem3 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem3"))
}
interface IPublicTypeNoAttr with
member this.Mem1 (arg_0_0, arg_0_1) = this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 arg_0_0 = this.Mem2 (arg_0_0)
member this.Mem3 (arg_0_0, arg_0_1) = this.Mem3 (arg_0_0, arg_0_1)
namespace SomeNamespace
open System
/// Mock record type for an interface
type public PublicTypeInternalFalseNoAttrMock =
{
Mem1 : string * int -> string list
Mem2 : string -> int
Mem3 : int * option<System.Threading.CancellationToken> -> string
}
/// An implementation where every method throws.
static member Empty : PublicTypeInternalFalseNoAttrMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
Mem3 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem3"))
}
interface IPublicTypeInternalFalseNoAttr with
member this.Mem1 (arg_0_0, arg_0_1) = this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 arg_0_0 = this.Mem2 (arg_0_0)
member this.Mem3 (arg_0_0, arg_0_1) = this.Mem3 (arg_0_0, arg_0_1)
namespace SomeNamespace
open System
/// Mock record type for an interface
type internal InternalTypeNoAttrMock =
{
Mem1 : string * int -> unit
Mem2 : string -> int
}
/// An implementation where every method throws.
static member Empty : InternalTypeNoAttrMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
}
interface InternalTypeNoAttr with
member this.Mem1 (arg_0_0, arg_0_1) = this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 arg_0_0 = this.Mem2 (arg_0_0)
namespace SomeNamespace
open System
/// Mock record type for an interface
type private PrivateTypeNoAttrMock =
{
Mem1 : string * int -> unit
Mem2 : string -> int
}
/// An implementation where every method throws.
static member Empty : PrivateTypeNoAttrMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
}
interface PrivateTypeNoAttr with
member this.Mem1 (arg_0_0, arg_0_1) = this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 arg_0_0 = this.Mem2 (arg_0_0)
namespace SomeNamespace
open System
/// Mock record type for an interface
type private PrivateTypeInternalFalseNoAttrMock =
{
Mem1 : string * int -> unit
Mem2 : string -> int
}
/// An implementation where every method throws.
static member Empty : PrivateTypeInternalFalseNoAttrMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
}
interface PrivateTypeInternalFalseNoAttr with
member this.Mem1 (arg_0_0, arg_0_1) = this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 arg_0_0 = this.Mem2 (arg_0_0)
namespace SomeNamespace
open System
/// Mock record type for an interface
type internal VeryPublicTypeNoAttrMock<'a, 'b> =
{
Mem1 : 'a -> 'b
}
/// An implementation where every method throws.
static member Empty () : VeryPublicTypeNoAttrMock<'a, 'b> =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
}
interface VeryPublicTypeNoAttr<'a, 'b> with
member this.Mem1 arg_0_0 = this.Mem1 (arg_0_0)
namespace SomeNamespace
open System
/// Mock record type for an interface
type internal CurriedNoAttrMock<'a> =
{
Mem1 : int -> 'a -> string
Mem2 : int * string -> 'a -> string
Mem3 : (int * string) -> 'a -> string
Mem4 : (int * string) -> ('a * int) -> string
Mem5 : int * string -> ('a * int) -> string
Mem6 : int * string -> 'a * int -> string
}
/// An implementation where every method throws.
static member Empty () : CurriedNoAttrMock<'a> =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
Mem3 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem3"))
Mem4 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem4"))
Mem5 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem5"))
Mem6 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem6"))
}
interface CurriedNoAttr<'a> with
member this.Mem1 arg_0_0 arg_1_0 = this.Mem1 (arg_0_0) (arg_1_0)
member this.Mem2 (arg_0_0, arg_0_1) arg_1_0 = this.Mem2 (arg_0_0, arg_0_1) (arg_1_0)
member this.Mem3 ((arg_0_0, arg_0_1)) arg_1_0 = this.Mem3 (arg_0_0, arg_0_1) (arg_1_0)
member this.Mem4 ((arg_0_0, arg_0_1)) ((arg_1_0, arg_1_1)) =
this.Mem4 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1)
member this.Mem5 (arg_0_0, arg_0_1) ((arg_1_0, arg_1_1)) =
this.Mem5 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1)
member this.Mem6 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1) =
this.Mem6 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1)
namespace SomeNamespace
open System
/// Mock record type for an interface
type internal TypeWithInterfaceNoAttrMock =
{
/// 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 : TypeWithInterfaceNoAttrMock =
{
Dispose = (fun () -> ())
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
}
interface TypeWithInterfaceNoAttr 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 ()

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -29,52 +29,13 @@ type JsonRecordType =
F : int[] F : int[]
} }
[<WoofWare.Myriad.Plugins.JsonParse>]
type internal InternalTypeNotExtension =
{
[<JsonPropertyName(Literals.something)>]
InternalThing : string
}
[<WoofWare.Myriad.Plugins.JsonSerialize>]
type internal InternalTypeNotExtensionSerial =
{
[<JsonPropertyName(Literals.something)>]
InternalThing2 : string
}
[<WoofWare.Myriad.Plugins.JsonParse true>]
[<WoofWare.Myriad.Plugins.JsonSerialize true>]
type internal InternalTypeExtension =
{
[<JsonPropertyName(Literals.something)>]
ExternalThing : string
}
[<WoofWare.Myriad.Plugins.JsonParse true>] [<WoofWare.Myriad.Plugins.JsonParse true>]
type ToGetExtensionMethod = type ToGetExtensionMethod =
{ {
Alpha : string Tinker : string
Bravo : System.Uri Tailor : int
Charlie : float Soldier : System.Uri
Delta : float32 Sailor : float
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>] [<RequireQualifiedAccess>]

View File

@@ -1,19 +0,0 @@
namespace ConsumePlugin
open WoofWare.Myriad.Plugins
[<CreateCatamorphism "MyListCata">]
type MyList<'a> =
| Nil
| Cons of ConsCase<'a>
and ConsCase<'a> =
{
Head : 'a
Tail : MyList<'a>
}
[<CreateCatamorphism "MyList2Cata">]
type MyList2<'a> =
| Nil
| Cons of 'a * MyList2<'a>

View File

@@ -1,119 +0,0 @@
//------------------------------------------------------------------------------
// This code was generated by myriad.
// Changes to this file will be lost when the code is regenerated.
//------------------------------------------------------------------------------
namespace ConsumePlugin
open WoofWare.Myriad.Plugins
/// Description of how to combine cases during a fold
type MyListCataCase<'a, 'MyList> =
/// How to operate on the Nil case
abstract Nil : 'MyList
/// How to operate on the Cons case
abstract Cons : head : 'a -> tail : 'MyList -> 'MyList
/// Specifies how to perform a fold (catamorphism) over the type MyList and its friends.
type MyListCata<'a, 'MyList> =
{
/// How to perform a fold (catamorphism) over the type MyList
MyList : MyListCataCase<'a, 'MyList>
}
/// Methods to perform a catamorphism over the type MyList
[<RequireQualifiedAccess>]
module MyListCata =
[<RequireQualifiedAccess>]
type private Instruction<'a> =
| Process__MyList of MyList<'a>
| MyList_Cons of head : 'a
let private loop (cata : MyListCata<'a, 'MyList>) (instructions : ResizeArray<Instruction<'a>>) =
let myListStack = ResizeArray<'MyList> ()
while instructions.Count > 0 do
let currentInstruction = instructions.[instructions.Count - 1]
instructions.RemoveAt (instructions.Count - 1)
match currentInstruction with
| Instruction.Process__MyList x ->
match x with
| MyList.Nil -> cata.MyList.Nil |> myListStack.Add
| MyList.Cons ({
Head = head
Tail = tail
}) ->
instructions.Add (Instruction.MyList_Cons (head))
instructions.Add (Instruction.Process__MyList tail)
| Instruction.MyList_Cons head ->
let tail = myListStack.[myListStack.Count - 1]
myListStack.RemoveAt (myListStack.Count - 1)
cata.MyList.Cons head tail |> myListStack.Add
myListStack
/// Execute the catamorphism.
let runMyList (cata : MyListCata<'a, 'MyListRet>) (x : MyList<'a>) : 'MyListRet =
let instructions = ResizeArray ()
instructions.Add (Instruction.Process__MyList x)
let myListRetStack = loop cata instructions
Seq.exactlyOne myListRetStack
namespace ConsumePlugin
open WoofWare.Myriad.Plugins
/// Description of how to combine cases during a fold
type MyList2CataCase<'a, 'MyList2> =
/// How to operate on the Nil case
abstract Nil : 'MyList2
/// How to operate on the Cons case
abstract Cons : 'a -> 'MyList2 -> 'MyList2
/// Specifies how to perform a fold (catamorphism) over the type MyList2 and its friends.
type MyList2Cata<'a, 'MyList2> =
{
/// How to perform a fold (catamorphism) over the type MyList2
MyList2 : MyList2CataCase<'a, 'MyList2>
}
/// Methods to perform a catamorphism over the type MyList2
[<RequireQualifiedAccess>]
module MyList2Cata =
[<RequireQualifiedAccess>]
type private Instruction<'a> =
| Process__MyList2 of MyList2<'a>
| MyList2_Cons of 'a
let private loop (cata : MyList2Cata<'a, 'MyList2>) (instructions : ResizeArray<Instruction<'a>>) =
let myList2Stack = ResizeArray<'MyList2> ()
while instructions.Count > 0 do
let currentInstruction = instructions.[instructions.Count - 1]
instructions.RemoveAt (instructions.Count - 1)
match currentInstruction with
| Instruction.Process__MyList2 x ->
match x with
| MyList2.Nil -> cata.MyList2.Nil |> myList2Stack.Add
| MyList2.Cons (arg0_0, arg1_0) ->
instructions.Add (Instruction.MyList2_Cons (arg0_0))
instructions.Add (Instruction.Process__MyList2 arg1_0)
| Instruction.MyList2_Cons arg0_0 ->
let arg1_0 = myList2Stack.[myList2Stack.Count - 1]
myList2Stack.RemoveAt (myList2Stack.Count - 1)
cata.MyList2.Cons arg0_0 arg1_0 |> myList2Stack.Add
myList2Stack
/// Execute the catamorphism.
let runMyList2 (cata : MyList2Cata<'a, 'MyList2Ret>) (x : MyList2<'a>) : 'MyList2Ret =
let instructions = ResizeArray ()
instructions.Add (Instruction.Process__MyList2 x)
let myList2RetStack = loop cata instructions
Seq.exactlyOne myList2RetStack

View File

@@ -1,6 +1,5 @@
namespace SomeNamespace namespace SomeNamespace
open System
open WoofWare.Myriad.Plugins open WoofWare.Myriad.Plugins
[<GenerateMock>] [<GenerateMock>]
@@ -9,12 +8,6 @@ type IPublicType =
abstract Mem2 : string -> int abstract Mem2 : string -> int
abstract Mem3 : x : int * ?ct : System.Threading.CancellationToken -> string abstract Mem3 : x : int * ?ct : System.Threading.CancellationToken -> string
[<GenerateMock false>]
type IPublicTypeInternalFalse =
abstract Mem1 : string * int -> string list
abstract Mem2 : string -> int
abstract Mem3 : x : int * ?ct : System.Threading.CancellationToken -> string
[<GenerateMock>] [<GenerateMock>]
type internal InternalType = type internal InternalType =
abstract Mem1 : string * int -> unit abstract Mem1 : string * int -> unit
@@ -25,11 +18,6 @@ type private PrivateType =
abstract Mem1 : string * int -> unit abstract Mem1 : string * int -> unit
abstract Mem2 : string -> int abstract Mem2 : string -> int
[<GenerateMock false>]
type private PrivateTypeInternalFalse =
abstract Mem1 : string * int -> unit
abstract Mem2 : string -> int
[<GenerateMock>] [<GenerateMock>]
type VeryPublicType<'a, 'b> = type VeryPublicType<'a, 'b> =
abstract Mem1 : 'a -> 'b abstract Mem1 : 'a -> 'b
@@ -42,16 +30,3 @@ type Curried<'a> =
abstract Mem4 : (int * string) -> ('a * int) -> string abstract Mem4 : (int * string) -> ('a * int) -> string
abstract Mem5 : x : int * string -> ('a * int) -> string abstract Mem5 : x : int * string -> ('a * int) -> string
abstract Mem6 : int * string -> y : '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
[<GenerateMock>]
type TypeWithProperties =
inherit IDisposable
abstract Mem1 : string option -> string[] Async
abstract Prop1 : int
abstract Prop2 : unit Async

View File

@@ -1,41 +0,0 @@
namespace SomeNamespace
open System
type IPublicTypeNoAttr =
abstract Mem1 : string * int -> string list
abstract Mem2 : string -> int
abstract Mem3 : x : int * ?ct : System.Threading.CancellationToken -> string
type IPublicTypeInternalFalseNoAttr =
abstract Mem1 : string * int -> string list
abstract Mem2 : string -> int
abstract Mem3 : x : int * ?ct : System.Threading.CancellationToken -> string
type internal InternalTypeNoAttr =
abstract Mem1 : string * int -> unit
abstract Mem2 : string -> int
type private PrivateTypeNoAttr =
abstract Mem1 : string * int -> unit
abstract Mem2 : string -> int
type private PrivateTypeInternalFalseNoAttr =
abstract Mem1 : string * int -> unit
abstract Mem2 : string -> int
type VeryPublicTypeNoAttr<'a, 'b> =
abstract Mem1 : 'a -> 'b
type CurriedNoAttr<'a> =
abstract Mem1 : int -> 'a -> string
abstract Mem2 : int * string -> 'a -> string
abstract Mem3 : (int * string) -> 'a -> string
abstract Mem4 : (int * string) -> ('a * int) -> string
abstract Mem5 : x : int * string -> ('a * int) -> string
abstract Mem6 : int * string -> y : 'a * int -> string
type TypeWithInterfaceNoAttr =
inherit IDisposable
abstract Mem1 : string option -> string[] Async
abstract Mem2 : unit -> string[] Async

View File

@@ -19,16 +19,13 @@ type GymAccessOptions =
QrCodeAccess : bool QrCodeAccess : bool
} }
[<Measure>]
type measure
[<WoofWare.Myriad.Plugins.JsonParse>] [<WoofWare.Myriad.Plugins.JsonParse>]
type GymLocation = type GymLocation =
{ {
[<JsonNumberHandling(JsonNumberHandling.AllowReadingFromString)>] [<JsonNumberHandling(JsonNumberHandling.AllowReadingFromString)>]
Longitude : float Longitude : float
[<JsonNumberHandling(JsonNumberHandling.AllowReadingFromString)>] [<JsonNumberHandling(JsonNumberHandling.AllowReadingFromString)>]
Latitude : float<measure> Latitude : float
} }
[<WoofWare.Myriad.Plugins.JsonParse>] [<WoofWare.Myriad.Plugins.JsonParse>]
@@ -71,8 +68,7 @@ type Gym =
ReopenDate : string ReopenDate : string
} }
[<WoofWare.Myriad.Plugins.JsonParse true>] [<WoofWare.Myriad.Plugins.JsonParse>]
[<WoofWare.Myriad.Plugins.JsonSerialize true>]
type Member = type Member =
{ {
Id : int Id : int

View File

@@ -1,5 +1,9 @@
namespace ConsumePlugin namespace ConsumePlugin
type ParseState =
| AwaitingKey
| AwaitingValue of string
/// My whatnot /// My whatnot
[<WoofWare.Myriad.Plugins.RemoveOptions>] [<WoofWare.Myriad.Plugins.RemoveOptions>]
type RecordType = type RecordType =

View File

@@ -11,20 +11,17 @@ open RestEase
[<WoofWare.Myriad.Plugins.HttpClient>] [<WoofWare.Myriad.Plugins.HttpClient>]
[<BaseAddress "https://whatnot.com">] [<BaseAddress "https://whatnot.com">]
type IPureGymApi = type IPureGymApi =
[<Get("v1/gyms/")>] [<Get "v1/gyms/">]
abstract GetGyms : ?ct : CancellationToken -> Task<Gym list> abstract GetGyms : ?ct : CancellationToken -> Task<Gym list>
[<Get "v1/gyms/{gym_id}/attendance">] [<Get "v1/gyms/{gym_id}/attendance">]
abstract GetGymAttendance : [<Path "gym_id">] gymId : int * ?ct : CancellationToken -> Task<GymAttendance> abstract GetGymAttendance : [<Path "gym_id">] gymId : int * ?ct : CancellationToken -> Task<GymAttendance>
[<Get "v1/gyms/{gym_id}/attendance">]
abstract GetGymAttendance' : [<Path("gym_id")>] gymId : int * ?ct : CancellationToken -> Task<GymAttendance>
[<RestEase.GetAttribute "v1/member">] [<RestEase.GetAttribute "v1/member">]
abstract GetMember : ?ct : CancellationToken -> Member Task abstract GetMember : ?ct : CancellationToken -> Member Task
[<RestEase.Get "v1/gyms/{gym}">] [<RestEase.Get "v1/gyms/{gym_id}">]
abstract GetGym : [<Path>] gym : int * ?ct : CancellationToken -> Task<Gym> abstract GetGym : [<Path "gym_id">] gymId : int * ?ct : CancellationToken -> Task<Gym>
[<GetAttribute "v1/member/activity">] [<GetAttribute "v1/member/activity">]
abstract GetMemberActivity : ?ct : CancellationToken -> Task<MemberActivityDto> abstract GetMemberActivity : ?ct : CancellationToken -> Task<MemberActivityDto>
@@ -32,19 +29,11 @@ type IPureGymApi =
[<Get "some/url">] [<Get "some/url">]
abstract GetUrl : ?ct : CancellationToken -> Task<UriThing> abstract GetUrl : ?ct : CancellationToken -> Task<UriThing>
[<Post "some/url">]
abstract PostStringToString :
[<Body>] foo : Map<string, string> option * ?ct : CancellationToken -> Task<Map<string, string> option>
// We'll use this one to check handling of absolute URIs too // We'll use this one to check handling of absolute URIs too
[<Get "/v2/gymSessions/member">] [<Get "/v2/gymSessions/member">]
abstract GetSessions : abstract GetSessions :
[<Query>] fromDate : DateOnly * [<Query>] toDate : DateOnly * ?ct : CancellationToken -> Task<Sessions> [<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 // An example from RestEase's own docs
[<Post "users/new">] [<Post "users/new">]
abstract CreateUserString : [<Body>] user : string * ?ct : CancellationToken -> Task<string> abstract CreateUserString : [<Body>] user : string * ?ct : CancellationToken -> Task<string>
@@ -61,15 +50,6 @@ type IPureGymApi =
[<Post "users/new">] [<Post "users/new">]
abstract CreateUserByteArr'' : [<Body>] user : byte array * ?ct : CancellationToken -> Task<Stream> abstract CreateUserByteArr'' : [<Body>] user : byte array * ?ct : CancellationToken -> Task<Stream>
[<Post "users/new">]
abstract CreateUserSerialisedBody : [<Body>] user : PureGym.Member * ?ct : CancellationToken -> Task<string>
[<Post "users/new">]
abstract CreateUserSerialisedUrlBody : [<Body>] user : Uri * ?ct : CancellationToken -> Task<string>
[<Post "users/new">]
abstract CreateUserSerialisedIntBody : [<Body>] user : int * ?ct : CancellationToken -> Task<string>
[<Post "users/new">] [<Post "users/new">]
abstract CreateUserHttpContent : abstract CreateUserHttpContent :
[<Body>] user : System.Net.Http.HttpContent * ?ct : CancellationToken -> Task<string> [<Body>] user : System.Net.Http.HttpContent * ?ct : CancellationToken -> Task<string>
@@ -122,116 +102,17 @@ type internal IApiWithoutBaseAddress =
[<Get "endpoint/{param}">] [<Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string> abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
// TODO: implement BasePath support
[<WoofWare.Myriad.Plugins.HttpClient>] [<WoofWare.Myriad.Plugins.HttpClient>]
[<BasePath "foo">] [<BasePath "foo">]
type IApiWithBasePath = type IApiWithBasePath =
// Example where we use the bundled attributes rather than RestEase's [<Get "endpoint/{param}">]
[<WoofWare.Myriad.Plugins.RestEase.Get "endpoint/{param}">] abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
abstract GetPathParam : [<Path "param">] parameter : string * ?cancellationToken : CancellationToken -> Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>] [<WoofWare.Myriad.Plugins.HttpClient>]
[<BaseAddress "https://whatnot.com/thing">] [<BaseAddress "https://whatnot.com">]
[<BasePath "foo">] [<BasePath "foo">]
type IApiWithBasePathAndAddress = type IApiWithBasePathAndAddress =
[<Get "endpoint/{param}">] [<Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string> abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>]
[<BasePath "/foo">]
type IApiWithAbsoluteBasePath =
// 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>]
[<BaseAddress "https://whatnot.com/thing">]
[<BasePath "/foo">]
type IApiWithAbsoluteBasePathAndAddress =
[<Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>]
[<BasePath "foo">]
type IApiWithBasePathAndAbsoluteEndpoint =
// 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>]
[<BaseAddress "https://whatnot.com/thing">]
[<BasePath "foo">]
type IApiWithBasePathAndAddressAndAbsoluteEndpoint =
[<Get "/endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>]
[<BasePath "/foo">]
type IApiWithAbsoluteBasePathAndAbsoluteEndpoint =
// 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>]
[<BaseAddress "https://whatnot.com/thing">]
[<BasePath "/foo">]
type IApiWithAbsoluteBasePathAndAddressAndAbsoluteEndpoint =
[<Get "/endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>]
[<Header("Header-Name", "Header-Value")>]
type IApiWithHeaders =
[<Header "X-Foo">]
abstract SomeHeader : string
[<Header "Authorization">]
abstract SomeOtherHeader : int
[<Get "endpoint/{param}">]
[<Header("Something-Else", "val")>]
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>
[<WoofWare.Myriad.Plugins.HttpClient>]
type IClientWithJsonBody =
// As a POST request of a JSON-serialised body, we automatically set Content-Type: application/json.
[<Post "endpoint/{param}">]
abstract GetPathParam :
[<RestEase.Path "param">] parameter : string *
[<WoofWare.Myriad.Plugins.RestEase.Body>] mem : PureGym.Member *
?ct : CancellationToken ->
Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>]
type IClientWithJsonBodyOverridden =
// As a POST request of a JSON-serialised body, we *would* automatically set Content-Type: application/json,
// but this method has overridden it.
[<Post "endpoint/{param}">]
[<Header("Content-Type", "application/ecmascript")>]
abstract GetPathParam :
[<RestEase.Path "param">] parameter : string *
[<WoofWare.Myriad.Plugins.RestEase.Body>] mem : PureGym.Member *
?ct : CancellationToken ->
Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>]
type IClientWithStringBody =
// As a POST request of a bare string body, we don't override the Content-Type.
[<Post "endpoint/{param}">]
abstract GetPathParam :
[<RestEase.Path "param">] parameter : string *
[<WoofWare.Myriad.Plugins.RestEase.Body>] mem : string *
?ct : CancellationToken ->
Task<string>

View File

@@ -1,94 +0,0 @@
namespace ConsumePlugin
open System
open System.Collections.Generic
open System.Text.Json.Serialization
[<WoofWare.Myriad.Plugins.JsonParse true>]
[<WoofWare.Myriad.Plugins.JsonSerialize true>]
type InnerTypeWithBoth =
{
[<JsonPropertyName("it's-a-me")>]
Thing : Guid
Map : Map<string, Uri>
ReadOnlyDict : IReadOnlyDictionary<string, char list>
Dict : IDictionary<Uri, bool>
ConcreteDict : Dictionary<string, InnerTypeWithBoth>
}
[<WoofWare.Myriad.Plugins.JsonParse true>]
[<WoofWare.Myriad.Plugins.JsonSerialize true>]
type SomeEnum =
| Blah = 1
| Thing = 0
[<Measure>]
type measure
[<WoofWare.Myriad.Plugins.JsonParse true>]
[<WoofWare.Myriad.Plugins.JsonSerialize true>]
type JsonRecordTypeWithBoth =
{
A : int
B : string
C : int list
D : InnerTypeWithBoth
E : string array
Arr : int[]
Byte : byte<measure>
Sbyte : sbyte<measure>
I : int<measure>
I32 : int32<measure>
I64 : int64<measure>
U : uint<measure>
U32 : uint32<measure>
U64 : uint64<measure>
F : float<measure>
F32 : float32<measure>
Single : single<measure>
IntMeasureOption : int<measure> option
IntMeasureNullable : int<measure> Nullable
Enum : SomeEnum
Timestamp : DateTimeOffset
Unit : unit
}
[<WoofWare.Myriad.Plugins.JsonSerialize true>]
[<WoofWare.Myriad.Plugins.JsonParse true>]
type FirstDu =
| EmptyCase
| Case1 of data : string
| Case2 of record : JsonRecordTypeWithBoth * i : int
[<WoofWare.Myriad.Plugins.JsonParse true>]
[<WoofWare.Myriad.Plugins.JsonSerialize true>]
type HeaderAndValue =
{
Header : string
Value : string
}
[<WoofWare.Myriad.Plugins.JsonSerialize true>]
[<WoofWare.Myriad.Plugins.JsonParse true>]
type Foo =
{
Message : HeaderAndValue option
}
[<WoofWare.Myriad.Plugins.JsonSerialize true>]
[<WoofWare.Myriad.Plugins.JsonParse true>]
type CollectRemaining =
{
Message : HeaderAndValue option
[<JsonExtensionData>]
Rest : Dictionary<string, System.Text.Json.Nodes.JsonNode>
}
[<WoofWare.Myriad.Plugins.JsonSerialize true>]
[<WoofWare.Myriad.Plugins.JsonParse true>]
type OuterCollectRemaining =
{
[<JsonExtensionData>]
Others : Dictionary<string, int>
Remaining : CollectRemaining
}

View File

@@ -76,33 +76,3 @@ type IVaultClient =
[<Get "v1/auth/jwt/login">] [<Get "v1/auth/jwt/login">]
abstract GetJwt : role : string * jwt : string * ?ct : CancellationToken -> Task<JwtVaultResponse> 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

File diff suppressed because it is too large Load Diff

View File

@@ -10,10 +10,19 @@
<WarnOn>FS3388,FS3559</WarnOn> <WarnOn>FS3388,FS3559</WarnOn>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="Nerdbank.GitVersioning" Version="3.8.118" PrivateAssets="all" /> <PackageReference Include="Nerdbank.GitVersioning" Version="3.6.133" PrivateAssets="all"/>
<SourceLinkGitHubHost Include="github.com" ContentUrl="https://raw.githubusercontent.com" /> <PackageReference Include="Microsoft.SourceLink.GitHub" Version="8.0.0" PrivateAssets="All"/>
<SourceLinkGitHubHost Include="github.com" ContentUrl="https://raw.githubusercontent.com"/>
</ItemGroup> </ItemGroup>
<PropertyGroup Condition="'$(GITHUB_ACTION)' != ''"> <!--
<ContinuousIntegrationBuild>true</ContinuousIntegrationBuild> SourceLink doesn't support F# deterministic builds out of the box,
</PropertyGroup> so tell SourceLink that our source root is going to be remapped.
-->
<Target Name="MapSourceRoot" BeforeTargets="_GenerateSourceLinkFile" Condition="'$(SourceRootMappedPathsFeatureSupported)' != 'true'">
<ItemGroup>
<SourceRoot Update="@(SourceRoot)">
<MappedPath>Z:\CheckoutRoot\WoofWare.Myriad\</MappedPath>
</SourceRoot>
</ItemGroup>
</Target>
</Project> </Project>

1054
README.md

File diff suppressed because it is too large Load Diff

View File

@@ -1,102 +0,0 @@
namespace WoofWare.Myriad.Plugins
open System
/// Attribute indicating a record type to which the "build arg parser" Myriad
/// generator should apply during build.
///
/// 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 ArgParserAttribute (isExtensionMethod : bool) =
inherit Attribute ()
/// The default value of `isExtensionMethod`, the optional argument to the ArgParserAttribute constructor.
static member DefaultIsExtensionMethod = false
/// Shorthand for the "isExtensionMethod = false" constructor; see documentation there for details.
new () = ArgParserAttribute ArgParserAttribute.DefaultIsExtensionMethod
/// Attribute indicating that this field shall accumulate all unmatched args,
/// as well as any that appear after a bare `--`.
///
/// Set `includeFlagLike = true` to include args that begin `--` in the
/// positional args.
/// (By default, `includeFlagLike = false` and we throw when encountering
/// an argument which looks like a flag but which we don't recognise.)
/// We will still interpret `--help` as requesting help, unless it comes after
/// a standalone `--` separator.
///
/// If the type of the PositionalArgs field is `Choice<'a, 'a>`, then we will
/// tell you whether each arg came before or after a standalone `--` separator.
/// For example, `MyApp foo bar -- baz` with PositionalArgs of `Choice<string, string>`
/// would yield `Choice1Of2 foo, Choice1Of2 bar, Choice2Of2 baz`.
type PositionalArgsAttribute (includeFlagLike : bool) =
inherit Attribute ()
/// The default value of `isExtensionMethod`, the optional argument to the ArgParserAttribute constructor.
static member DefaultIncludeFlagLike = false
/// Shorthand for the "includeFlagLike = false" constructor; see documentation there for details.
new () = PositionalArgsAttribute PositionalArgsAttribute.DefaultIncludeFlagLike
/// Attribute indicating that this field shall have a default value derived
/// from calling an appropriately named static method on the type.
///
/// This attribute can only be placed on fields of type `Choice<_, _>` where both type parameters
/// are the same.
/// After a successful parse, the value is Choice1Of2 if the user supplied an input,
/// or Choice2Of2 if the input was obtained by calling the default function.
///
/// The static method we call for field `FieldName : 'a` is `DefaultFieldName : unit -> 'a`.
type ArgumentDefaultFunctionAttribute () =
inherit Attribute ()
/// Attribute indicating that this field shall have a default value derived
/// from an environment variable (whose name you give in the attribute constructor).
///
/// This attribute can only be placed on fields of type `Choice<_, _>` where both type parameters
/// are the same.
/// After a successful parse, the value is Choice1Of2 if the user supplied an input,
/// or Choice2Of2 if the input was obtained by pulling a value from `Environment.GetEnvironmentVariable`.
type ArgumentDefaultEnvironmentVariableAttribute (envVar : string) =
inherit Attribute ()
/// Attribute indicating that this field shall have the given help text, when `--help` is invoked
/// or when a parse error causes us to print help text.
type ArgumentHelpTextAttribute (helpText : string) =
inherit Attribute ()
/// Attribute indicating that this field should be parsed with a ParseExact method on its type.
/// For example, on a TimeSpan field, with [<ArgumentParseExact @"hh\:mm\:ss">], we will call
/// `TimeSpan.ParseExact (s, @"hh\:mm\:ss", CultureInfo.CurrentCulture).
type ParseExactAttribute (format : string) =
inherit Attribute ()
/// Attribute indicating that this field should be parsed in the invariant culture, rather than the
/// default current culture.
/// For example, on a TimeSpan field, with [<InvariantCulture>] and [<ArgumentParseExact @"hh\:mm\:ss">], we will call
/// `TimeSpan.ParseExact (s, @"hh\:mm\:ss", CultureInfo.InvariantCulture).
type InvariantCultureAttribute () =
inherit Attribute ()
/// Attribute placed on a field of a two-case no-data discriminated union, indicating that this is "basically a bool".
/// For example: `type DryRun = | [<ArgumentFlag true>] Dry | [<ArgumentFlag false>] Wet`
/// A record with `{ DryRun : DryRun }` will then be parsed like `{ DryRun : bool }` (so the user supplies `--dry-run`),
/// but that you get this strongly-typed value directly in the code (so you `match args.DryRun with | DryRun.Dry ...`).
///
/// You must put this attribute on both cases of the discriminated union, with opposite values in each case.
type ArgumentFlagAttribute (flagValue : bool) =
inherit Attribute ()
/// Attribute placed on a field of a record to specify a different long form from the default. If you place this
/// attribute, you won't get the default: ArgFoo would normally be expressed as `--arg-foo`, but if you instead
/// say `[<ArgumentLongForm "thingy-blah">]` or `[<ArgumentLongForm "thingy">]`, you instead use `--thingy-blah`
/// or `--thingy` respectively.
///
/// You can place this argument multiple times.
///
/// Omit the initial `--` that you expect the user to type.
[<AttributeUsage(AttributeTargets.Field, AllowMultiple = true)>]
type ArgumentLongForm (s : string) =
inherit Attribute ()

View File

@@ -1,104 +0,0 @@
namespace WoofWare.Myriad.Plugins
open System
/// Attribute indicating a record type to which the "Remove Options" Myriad
/// generator should apply during build.
/// The purpose of this generator is to strip the `option` modifier from types.
type RemoveOptionsAttribute () =
inherit Attribute ()
/// Attribute indicating an interface type for which the "Generate Mock" Myriad
/// generator should apply during build.
/// This generator creates a record which implements the interface,
/// but where each method is represented as a record field, so you can use
/// record update syntax to easily specify partially-implemented mock objects.
/// You may optionally specify `isInternal = false` to get a mock with the public visibility modifier.
///
/// The default implementation of each field throws (except for default implementations of IDisposable, which are
/// no-ops).
type GenerateMockAttribute (isInternal : bool) =
inherit Attribute ()
/// The default value of `isInternal`, the optional argument to the GenerateMockAttribute constructor.
static member DefaultIsInternal = true
/// Shorthand for the "isExtensionMethod = false" constructor; see documentation there for details.
new () = GenerateMockAttribute GenerateMockAttribute.DefaultIsInternal
/// Attribute indicating an interface type for which the "Generate Capturing Mock" Myriad
/// generator should apply during build.
/// This generator creates a record which implements the interface,
/// but where each method is represented as a record field, so you can use
/// record update syntax to easily specify partially-implemented mock objects.
/// You may optionally specify `isInternal = false` to get a mock with the public visibility modifier.
///
/// The default implementation of each field throws.
///
/// The generated interface methods capture all calls made to them, before passing through to the relevant
/// field of the mock record; the calls can be accessed later through the `Calls` field of the generated
/// mock record.
type GenerateCapturingMockAttribute (isInternal : bool) =
inherit Attribute ()
/// The default value of `isInternal`, the optional argument to the GenerateCapturingMockAttribute constructor.
static member DefaultIsInternal = true
/// Shorthand for the "isExtensionMethod = false" constructor; see documentation there for details.
new () = GenerateCapturingMockAttribute GenerateCapturingMockAttribute.DefaultIsInternal
/// Attribute indicating a record type to which the "Add JSON serializer" Myriad
/// generator should apply during build.
/// The purpose of this generator is to create methods (possibly extension methods) of the form
/// `{TypeName}.toJsonNode : {TypeName} -> System.Text.Json.Nodes.JsonNode`.
///
/// 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 JsonSerializeAttribute (isExtensionMethod : bool) =
inherit Attribute ()
/// The default value of `isExtensionMethod`, the optional argument to the JsonSerializeAttribute constructor.
static member DefaultIsExtensionMethod = false
/// Shorthand for the "isExtensionMethod = false" constructor; see documentation there for details.
new () = JsonSerializeAttribute JsonSerializeAttribute.DefaultIsExtensionMethod
/// Attribute indicating a record type to which the "Add JSON parse" Myriad
/// generator should apply during build.
/// The purpose of this generator is to create methods (possibly extension methods) of the form
/// `{TypeName}.jsonParse : System.Text.Json.Nodes.JsonNode -> {TypeName}`.
///
/// If you supply isExtensionMethod = true, you will get extension methods.
/// These can only be consumed from F#, but the benefit is that they don't use up the module name
/// (since by default we create a module called "{TypeName}").
type JsonParseAttribute (isExtensionMethod : bool) =
inherit Attribute ()
/// The default value of `isExtensionMethod`, the optional argument to the JsonParseAttribute constructor.
static member DefaultIsExtensionMethod = false
/// Shorthand for the "isExtensionMethod = false" constructor; see documentation there for details.
new () = JsonParseAttribute JsonParseAttribute.DefaultIsExtensionMethod
/// Attribute indicating a record type to which the "create HTTP client" Myriad
/// generator should apply during build.
/// This generator is intended to replicate much of the functionality of RestEase,
/// i.e. to stamp out HTTP REST clients from interfaces defining the API.
///
/// 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.
/// Supply the `typeName` for the name of the record type we will generate, which contains
/// all the catas required; for example, "MyThing" would generate:
/// type MyThing<'a, 'b> = { Du1 : Du1Cata<'a, 'b> ; Du2 : Du2Cata<'a, 'b> }.
type CreateCatamorphismAttribute (typeName : string) =
inherit Attribute ()

View File

@@ -1,84 +0,0 @@
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.
///
/// We will essentially unconditionally append a slash to this for you, on the grounds that you probably don't
/// intend the base path *itself* to be an endpoint.
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
/// Indicates that this argument to a method is passed to the remote API by being serialised into the request
/// body.
type BodyAttribute () =
inherit Attribute ()
/// This is interpolated into every URL, between the BaseAddress and the path specified by e.g. [<Get>].
/// Note that if the [<Get>]-specified path starts with a slash, the BasePath is ignored, because then [<Get>]
/// is considered to be relative to the URL root (i.e. the host part of the BaseAddress).
/// Similarly, if the [<BasePath>] starts with a slash, then any path component of the BaseAddress is ignored.
///
/// We will essentially unconditionally append a slash to this for you, on the grounds that you probably don't
/// intend the base path *itself* to be an endpoint.
///
/// Can contain {placeholders}; hopefully your methods define values for those placeholders with [<Path>]
/// attributes!
type BasePathAttribute (path : string) =
inherit Attribute ()

View File

@@ -1,86 +0,0 @@
WoofWare.Myriad.Plugins.ArgParserAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.ArgParserAttribute..ctor [constructor]: bool
WoofWare.Myriad.Plugins.ArgParserAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.ArgParserAttribute.DefaultIsExtensionMethod [static property]: [read-only] bool
WoofWare.Myriad.Plugins.ArgParserAttribute.get_DefaultIsExtensionMethod [static method]: unit -> bool
WoofWare.Myriad.Plugins.ArgumentDefaultEnvironmentVariableAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.ArgumentDefaultEnvironmentVariableAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.ArgumentDefaultFunctionAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.ArgumentDefaultFunctionAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.ArgumentFlagAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.ArgumentFlagAttribute..ctor [constructor]: bool
WoofWare.Myriad.Plugins.ArgumentHelpTextAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.ArgumentHelpTextAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.ArgumentLongForm inherit System.Attribute
WoofWare.Myriad.Plugins.ArgumentLongForm..ctor [constructor]: string
WoofWare.Myriad.Plugins.CreateCatamorphismAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.CreateCatamorphismAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.GenerateCapturingMockAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.GenerateCapturingMockAttribute..ctor [constructor]: bool
WoofWare.Myriad.Plugins.GenerateCapturingMockAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.GenerateCapturingMockAttribute.DefaultIsInternal [static property]: [read-only] bool
WoofWare.Myriad.Plugins.GenerateCapturingMockAttribute.get_DefaultIsInternal [static method]: unit -> bool
WoofWare.Myriad.Plugins.GenerateMockAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.GenerateMockAttribute..ctor [constructor]: bool
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.InvariantCultureAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.InvariantCultureAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.JsonParseAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.JsonParseAttribute..ctor [constructor]: bool
WoofWare.Myriad.Plugins.JsonParseAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.JsonParseAttribute.DefaultIsExtensionMethod [static property]: [read-only] bool
WoofWare.Myriad.Plugins.JsonParseAttribute.get_DefaultIsExtensionMethod [static method]: unit -> bool
WoofWare.Myriad.Plugins.JsonSerializeAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.JsonSerializeAttribute..ctor [constructor]: bool
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.ParseExactAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.ParseExactAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.PositionalArgsAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.PositionalArgsAttribute..ctor [constructor]: bool
WoofWare.Myriad.Plugins.PositionalArgsAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.PositionalArgsAttribute.DefaultIncludeFlagLike [static property]: [read-only] bool
WoofWare.Myriad.Plugins.PositionalArgsAttribute.get_DefaultIncludeFlagLike [static method]: unit -> bool
WoofWare.Myriad.Plugins.RemoveOptionsAttribute inherit System.Attribute
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+BasePathAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.RestEase+BasePathAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.RestEase+BodyAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.RestEase+BodyAttribute..ctor [constructor]: unit
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

@@ -1,24 +0,0 @@
namespace WoofWare.Myriad.Plugins.Attributes.Test
open NUnit.Framework
open WoofWare.Myriad.Plugins
open ApiSurface
[<TestFixture>]
module TestSurface =
let assembly = typeof<RemoveOptionsAttribute>.Assembly
[<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`` () =
ApiSurface.writeAssemblyBaseline assembly
[<Test>]
let ``Ensure public API is fully documented`` () =
DocCoverage.assertFullyDocumented assembly

View File

@@ -1,30 +0,0 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net9.0</TargetFramework>
<IsPackable>false</IsPackable>
<IsTestProject>true</IsTestProject>
<!--
Known high severity vulnerability
I have not yet seen a single instance where I care about this warning
-->
<NoWarn>$(NoWarn),NU1903</NoWarn>
</PropertyGroup>
<ItemGroup>
<Compile Include="TestSurface.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="ApiSurface" Version="5.0.2" />
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="18.0.0"/>
<PackageReference Include="NUnit" Version="4.3.2"/>
<PackageReference Include="NUnit3TestAdapter" Version="5.2.0"/>
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\WoofWare.Myriad.Plugins.Attributes.fsproj" />
</ItemGroup>
</Project>

View File

@@ -1,40 +0,0 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>netstandard2.0</TargetFramework>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
<Authors>Patrick Stevens</Authors>
<Copyright>Copyright (c) Patrick Stevens 2024</Copyright>
<Description>Attributes to accompany the WoofWare.Myriad.Plugins source generator, so that you need take no runtime dependencies to use them.</Description>
<RepositoryType>git</RepositoryType>
<RepositoryUrl>https://github.com/Smaug123/WoofWare.Myriad</RepositoryUrl>
<PackageLicenseExpression>MIT</PackageLicenseExpression>
<PackageReadmeFile>README.md</PackageReadmeFile>
<PackageTags>myriad;fsharp;source-generator;source-gen;json</PackageTags>
<TreatWarningsAsErrors>true</TreatWarningsAsErrors>
<WarnOn>FS3559</WarnOn>
<PackageId>WoofWare.Myriad.Plugins.Attributes</PackageId>
<PackageIcon>logo.png</PackageIcon>
</PropertyGroup>
<ItemGroup>
<Compile Include="Attributes.fs"/>
<Compile Include="ArgParserAttributes.fs" />
<Compile Include="RestEase.fs" />
<EmbeddedResource Include="version.json"/>
<EmbeddedResource Include="SurfaceBaseline.txt"/>
<None Include="..\README.md">
<Pack>True</Pack>
<PackagePath>\</PackagePath>
</None>
<None Include="../WoofWare.Myriad.Plugins/logo.png">
<Pack>True</Pack>
<PackagePath>\</PackagePath>
</None>
</ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="4.3.4"/>
</ItemGroup>
</Project>

View File

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

View File

@@ -1,22 +0,0 @@
namespace WoofWare.Myriad.Plugins.Test
open System
open System.IO
open System.Reflection
[<RequireQualifiedAccess>]
module Assembly =
let getEmbeddedResource (assembly : Assembly) (name : string) : string =
let names = assembly.GetManifestResourceNames ()
let names =
names |> Seq.filter (fun s -> s.EndsWith (name, StringComparison.Ordinal))
use s =
names
|> Seq.exactlyOne
|> assembly.GetManifestResourceStream
|> fun s -> new StreamReader (s)
s.ReadToEnd ()

View File

@@ -58,7 +58,7 @@ module PureGymDtos =
[ [
"""{"latitude": 1.0, "longitude": 3.0}""", """{"latitude": 1.0, "longitude": 3.0}""",
{ {
GymLocation.Latitude = 1.0<measure> GymLocation.Latitude = 1.0
Longitude = 3.0 Longitude = 3.0
} }
] ]
@@ -96,7 +96,7 @@ module PureGymDtos =
Location = Location =
{ {
Longitude = -0.110252 Longitude = -0.110252
Latitude = 51.480401<measure> Latitude = 51.480401
} }
TimeZone = "Europe/London" TimeZone = "Europe/London"
ReopenDate = "2021-04-12T00:00:00+01 Europe/London" ReopenDate = "2021-04-12T00:00:00+01 Europe/London"

View File

@@ -1,706 +0,0 @@
namespace WoofWare.Myriad.Plugins.Test
open System
open System.Threading
open NUnit.Framework
open FsUnitTyped
open ConsumePlugin
open FsCheck
[<TestFixture>]
module TestArgParser =
[<TestCase true>]
[<TestCase false>]
let ``Positionals get parsed: they don't have to be strings`` (sep : bool) =
let getEnvVar (_ : string) = failwith "should not call"
let property
(fooSep : bool)
(barSep : bool)
(bazSep : bool)
(pos0 : int list)
(pos1 : int list)
(pos2 : int list)
(pos3 : int list)
(pos4 : int list)
=
let args =
[
yield! pos0 |> List.map string<int>
if fooSep then
yield "--foo=3"
else
yield "--foo"
yield "3"
yield! pos1 |> List.map string<int>
if barSep then
yield "--bar=4"
else
yield "--bar"
yield "4"
yield! pos2 |> List.map string<int>
if bazSep then
yield "--baz=true"
else
yield "--baz"
yield "true"
yield! pos3 |> List.map string<int>
if sep then
yield "--"
yield! pos4 |> List.map string<int>
]
BasicWithIntPositionals.parse' getEnvVar args
|> shouldEqual
{
Foo = 3
Bar = "4"
Baz = true
Rest = pos0 @ pos1 @ pos2 @ pos3 @ pos4
}
Check.QuickThrowOnFailure property
[<Test>]
let ``Arg-like thing appearing before double dash`` () =
let envCalls = ref 0
let getEnvVar (_ : string) =
Interlocked.Increment envCalls |> ignore<int>
None
let args = [ "--foo=3" ; "--non-existent" ; "--bar=4" ; "--baz=true" ]
let exc =
Assert.Throws<exn> (fun () -> Basic.parse' getEnvVar args |> ignore<Basic>)
envCalls.Value |> shouldEqual 0
exc.Message
|> shouldEqual
"""Unable to process supplied arg --non-existent. Help text follows.
--foo int32 : This is a foo!
--bar string
--baz bool
--rest string (positional args) (can be repeated) : Here's where the rest of the args go"""
[<Test>]
let ``Can supply positional args with key`` () =
let envCalls = ref 0
let getEnvVar (_ : string) =
Interlocked.Increment envCalls |> ignore<int>
None
let property (args : (int * bool) list) (afterDoubleDash : int list option) =
let flatArgs =
args
|> List.collect (fun (value, sep) ->
if sep then
[ $"--rest=%i{value}" ]
else
[ "--rest" ; string<int> value ]
)
|> fun l -> l @ [ "--foo=3" ; "--bar=4" ; "--baz=true" ]
let flatArgs, expected =
match afterDoubleDash with
| None -> flatArgs, List.map fst args
| Some rest -> flatArgs @ [ "--" ] @ (List.map string<int> rest), List.map fst args @ rest
BasicWithIntPositionals.parse' getEnvVar flatArgs
|> shouldEqual
{
Foo = 3
Bar = "4"
Baz = true
Rest = expected
}
Check.QuickThrowOnFailure property
envCalls.Value |> shouldEqual 0
[<Test>]
let ``Consume multiple occurrences of required arg`` () =
let envCalls = ref 0
let getEnvVar (_ : string) =
Interlocked.Increment envCalls |> ignore<int>
None
let args = [ "--foo=3" ; "--rest" ; "7" ; "--bar=4" ; "--baz=true" ; "--rest=8" ]
let result = BasicNoPositionals.parse' getEnvVar args
envCalls.Value |> shouldEqual 0
result
|> shouldEqual
{
Foo = 3
Bar = "4"
Baz = true
Rest = [ 7 ; 8 ]
}
[<Test>]
let ``Gracefully handle invalid multiple occurrences of required arg`` () =
let envCalls = ref 0
let getEnvVar (_ : string) =
Interlocked.Increment envCalls |> ignore<int>
None
let args = [ "--foo=3" ; "--foo" ; "9" ; "--bar=4" ; "--baz=true" ; "--baz=false" ]
let exc =
Assert.Throws<exn> (fun () -> Basic.parse' getEnvVar args |> ignore<Basic>)
envCalls.Value |> shouldEqual 0
exc.Message
|> shouldEqual
"""Errors during parse!
Argument '--foo' was supplied multiple times: 3 and 9
Argument '--baz' was supplied multiple times: True and false"""
[<Test>]
let ``Args appearing after double dash are positional`` () =
let envCalls = ref 0
let getEnvVar (_ : string) =
Interlocked.Increment envCalls |> ignore<int>
None
let args = [ "--" ; "--foo=3" ; "--bar=4" ; "--baz=true" ]
let exc =
Assert.Throws<exn> (fun () -> Basic.parse' getEnvVar args |> ignore<Basic>)
exc.Message
|> shouldEqual
"""Errors during parse!
Required argument '--foo' received no value
Required argument '--bar' received no value
Required argument '--baz' received no value"""
envCalls.Value |> shouldEqual 0
[<Test>]
let ``Help text`` () =
let getEnvVar (s : string) =
s |> shouldEqual "CONSUMEPLUGIN_THINGS"
Some "hi!"
let exc =
Assert.Throws<exn> (fun () -> Basic.parse' getEnvVar [ "--help" ] |> ignore<Basic>)
exc.Message
|> shouldEqual
"""Help text requested.
--foo int32 : This is a foo!
--bar string
--baz bool
--rest string (positional args) (can be repeated) : Here's where the rest of the args go"""
[<Test>]
let ``Help text, with default values`` () =
let envVars = ref 0
let getEnvVar (_ : string) =
Interlocked.Increment envVars |> ignore<int>
None
let exc =
Assert.Throws<exn> (fun () -> LoadsOfTypes.parse' getEnvVar [ "--help" ] |> ignore<LoadsOfTypes>)
exc.Message
|> shouldEqual
"""Help text requested.
--foo int32
--bar string
--baz bool
--some-file FileInfo
--some-directory DirectoryInfo
--some-list DirectoryInfo (can be repeated)
--optional-thing-with-no-default int32 (optional)
--optional-thing bool (default value: True)
--another-optional-thing int32 (default value: 3)
--yet-another-optional-thing string (default value populated from env var CONSUMEPLUGIN_THINGS)
--positionals int32 (positional args) (can be repeated)"""
envVars.Value |> shouldEqual 0
[<Test>]
let ``Default values`` () =
let getEnvVar (s : string) =
s |> shouldEqual "CONSUMEPLUGIN_THINGS"
Some "hi!"
let args =
[
"--foo"
"3"
"--bar=some string"
"--baz"
"--some-file=/path/to/file"
"--some-directory"
"/a/dir"
"--another-optional-thing"
"3000"
]
let result = LoadsOfTypes.parse' getEnvVar args
result.OptionalThing |> shouldEqual (Choice2Of2 true)
result.OptionalThingWithNoDefault |> shouldEqual None
result.AnotherOptionalThing |> shouldEqual (Choice1Of2 3000)
result.YetAnotherOptionalThing |> shouldEqual (Choice2Of2 "hi!")
[<Test>]
let ``ParseExact and help`` () =
let count = ref 0
let getEnvVar (_ : string) =
Interlocked.Increment count |> ignore<int>
None
let exc =
Assert.Throws<exn> (fun () -> DatesAndTimes.parse' getEnvVar [ "--help" ] |> ignore<DatesAndTimes>)
exc.Message
|> shouldEqual
@"Help text requested.
--plain TimeSpan
--invariant TimeSpan
--exact TimeSpan : An exact time please [Parse format (.NET): hh\:mm\:ss]
--invariant-exact TimeSpan : [Parse format (.NET): hh\:mm\:ss]"
count.Value |> shouldEqual 0
[<Test>]
let rec ``TimeSpans and their attributes`` () =
let count = ref 0
let getEnvVar (_ : string) =
Interlocked.Increment count |> ignore<int>
None
let parsed =
DatesAndTimes.parse'
getEnvVar
[
"--exact=11:34:00"
"--plain=1"
"--invariant=23:59"
"--invariant-exact=23:59:00"
]
parsed.Plain |> shouldEqual (TimeSpan (1, 0, 0, 0))
parsed.Invariant |> shouldEqual (TimeSpan (23, 59, 00))
parsed.Exact |> shouldEqual (TimeSpan (11, 34, 00))
parsed.InvariantExact |> shouldEqual (TimeSpan (23, 59, 00))
let exc =
Assert.Throws<exn> (fun () ->
DatesAndTimes.parse'
getEnvVar
[
"--exact=11:34:00"
"--plain=1"
"--invariant=23:59"
"--invariant-exact=23:59"
]
|> ignore<DatesAndTimes>
)
exc.Message
|> shouldEqual
"""Errors during parse!
Input string was not in a correct format. (at arg --invariant-exact=23:59)
Required argument '--invariant-exact' received no value"""
let exc =
Assert.Throws<exn> (fun () ->
DatesAndTimes.parse'
getEnvVar
[
"--exact=11:34"
"--plain=1"
"--invariant=23:59"
"--invariant-exact=23:59:00"
]
|> ignore<DatesAndTimes>
)
exc.Message
|> shouldEqual
"""Errors during parse!
Input string was not in a correct format. (at arg --exact=11:34)
Required argument '--exact' received no value"""
count.Value |> shouldEqual 0
[<Test>]
let ``Can consume stacked record without positionals`` () =
let getEnvVar (_ : string) = failwith "should not call"
let parsed =
ParentRecord.parse' getEnvVar [ "--and-another=true" ; "--thing1=9" ; "--thing2=a thing!" ]
parsed
|> shouldEqual
{
Child =
{
Thing1 = 9
Thing2 = "a thing!"
}
AndAnother = true
}
[<Test>]
let ``Can consume stacked record, child has positionals`` () =
let getEnvVar (_ : string) = failwith "should not call"
let parsed =
ParentRecordChildPos.parse'
getEnvVar
[
"--and-another=true"
"--thing1=9"
"--thing2=https://example.com"
"--thing2=http://example.com"
]
parsed.AndAnother |> shouldEqual true
parsed.Child.Thing1 |> shouldEqual 9
parsed.Child.Thing2
|> List.map (fun (x : Uri) -> x.ToString ())
|> shouldEqual [ "https://example.com/" ; "http://example.com/" ]
[<Test>]
let ``Can consume stacked record, child has no positionals, parent has positionals`` () =
let getEnvVar (_ : string) = failwith "should not call"
let parsed =
ParentRecordSelfPos.parse'
getEnvVar
[
"--and-another=true"
"--and-another=false"
"--and-another=true"
"--thing1=9"
"--thing2=some"
]
parsed
|> shouldEqual
{
Child =
{
Thing1 = 9
Thing2 = "some"
}
AndAnother = [ true ; false ; true ]
}
[<Test>]
let ``Help text for stacked records`` () =
let getEnvVar (_ : string) = failwith "should not call"
let exc =
Assert.Throws<exn> (fun () ->
ParentRecordSelfPos.parse' getEnvVar [ "--help" ] |> ignore<ParentRecordSelfPos>
)
exc.Message
|> shouldEqual
"""Help text requested.
--thing1 int32
--thing2 string
--and-another bool (positional args) (can be repeated)"""
[<Test>]
let ``Positionals are tagged with Choice`` () =
let getEnvVar (_ : string) = failwith "should not call"
ChoicePositionals.parse' getEnvVar [ "a" ; "b" ; "--" ; "--c" ; "--help" ]
|> shouldEqual
{
Args = [ Choice1Of2 "a" ; Choice1Of2 "b" ; Choice2Of2 "--c" ; Choice2Of2 "--help" ]
}
let boolCases =
[
"1", true
"0", false
"true", true
"false", false
"TRUE", true
"FALSE", false
]
|> List.map TestCaseData
[<TestCaseSource(nameof (boolCases))>]
let ``Bool env vars can be populated`` (envValue : string, boolValue : bool) =
let getEnvVar (s : string) =
s |> shouldEqual "CONSUMEPLUGIN_THINGS"
Some envValue
ContainsBoolEnvVar.parse' getEnvVar []
|> shouldEqual
{
BoolVar = Choice2Of2 boolValue
}
[<Test>]
let ``Bools can be treated with arity 0`` () =
let getEnvVar (_ : string) = failwith "do not call"
ContainsBoolEnvVar.parse' getEnvVar [ "--bool-var" ]
|> shouldEqual
{
BoolVar = Choice1Of2 true
}
[<TestCaseSource(nameof boolCases)>]
let ``Flag DUs can be parsed from env var`` (envValue : string, boolValue : bool) =
let getEnvVar (s : string) =
s |> shouldEqual "CONSUMEPLUGIN_THINGS"
Some envValue
let boolValue = if boolValue then DryRunMode.Dry else DryRunMode.Wet
ContainsFlagEnvVar.parse' getEnvVar []
|> shouldEqual
{
DryRun = Choice2Of2 boolValue
}
let dryRunData =
[
[ "--dry-run" ], DryRunMode.Dry
[ "--dry-run" ; "true" ], DryRunMode.Dry
[ "--dry-run=true" ], DryRunMode.Dry
[ "--dry-run" ; "True" ], DryRunMode.Dry
[ "--dry-run=True" ], DryRunMode.Dry
[ "--dry-run" ; "false" ], DryRunMode.Wet
[ "--dry-run=false" ], DryRunMode.Wet
[ "--dry-run" ; "False" ], DryRunMode.Wet
[ "--dry-run=False" ], DryRunMode.Wet
]
|> List.map TestCaseData
[<TestCaseSource(nameof dryRunData)>]
let ``Flag DUs can be parsed`` (args : string list, expected : DryRunMode) =
let getEnvVar (_ : string) = failwith "do not call"
ContainsFlagEnvVar.parse' getEnvVar args
|> shouldEqual
{
DryRun = Choice1Of2 expected
}
[<TestCaseSource(nameof dryRunData)>]
let ``Flag DUs can be parsed, ArgumentDefaultFunction`` (args : string list, expected : DryRunMode) =
let getEnvVar (_ : string) = failwith "do not call"
ContainsFlagDefaultValue.parse' getEnvVar args
|> shouldEqual
{
DryRun = Choice1Of2 expected
}
[<Test>]
let ``Flag DUs can be given a default value`` () =
let getEnvVar (_ : string) = failwith "do not call"
ContainsFlagDefaultValue.parse' getEnvVar []
|> shouldEqual
{
DryRun = Choice2Of2 DryRunMode.Wet
}
[<Test>]
let ``Help text for flag DU`` () =
let getEnvVar (_ : string) = failwith "do not call"
let exc =
Assert.Throws<exn> (fun () ->
ContainsFlagDefaultValue.parse' getEnvVar [ "--help" ]
|> ignore<ContainsFlagDefaultValue>
)
exc.Message
|> shouldEqual
"""Help text requested.
--dry-run bool (default value: false)"""
[<Test>]
let ``Help text for flag DU, non default`` () =
let getEnvVar (_ : string) = failwith "do not call"
let exc =
Assert.Throws<exn> (fun () -> WithFlagDu.parse' getEnvVar [ "--help" ] |> ignore<WithFlagDu>)
exc.Message
|> shouldEqual
"""Help text requested.
--dry-run bool"""
let longFormCases =
let doTheThing =
[
[ "--do-something-else=foo" ]
[ "--anotherarg=foo" ]
[ "--do-something-else" ; "foo" ]
[ "--anotherarg" ; "foo" ]
]
let someFlag =
[
[ "--turn-it-on" ], true
[ "--dont-turn-it-off" ], true
[ "--turn-it-on=true" ], true
[ "--dont-turn-it-off=true" ], true
[ "--turn-it-on=false" ], false
[ "--dont-turn-it-off=false" ], false
[ "--turn-it-on" ; "true" ], true
[ "--dont-turn-it-off" ; "true" ], true
[ "--turn-it-on" ; "false" ], false
[ "--dont-turn-it-off" ; "false" ], false
]
List.allPairs doTheThing someFlag
|> List.map (fun (doTheThing, (someFlag, someFlagResult)) ->
let args = doTheThing @ someFlag
let expected =
{
DoTheThing = "foo"
SomeFlag = someFlagResult
}
args, expected
)
|> List.map TestCaseData
[<TestCaseSource(nameof longFormCases)>]
let ``Long-form args`` (args : string list, expected : ManyLongForms) =
let getEnvVar (_ : string) = failwith "do not call"
ManyLongForms.parse' getEnvVar args |> shouldEqual expected
[<Test>]
let ``Long-form args can't be referred to by their original name`` () =
let getEnvVar (_ : string) = failwith "do not call"
let exc =
Assert.Throws<exn> (fun () ->
ManyLongForms.parse' getEnvVar [ "--do-the-thing=foo" ] |> ignore<ManyLongForms>
)
exc.Message
|> shouldEqual """Unable to process argument --do-the-thing=foo as key --do-the-thing and value foo"""
[<Test>]
let ``Long-form args help text`` () =
let getEnvVar (_ : string) = failwith "do not call"
let exc =
Assert.Throws<exn> (fun () -> ManyLongForms.parse' getEnvVar [ "--help" ] |> ignore<ManyLongForms>)
exc.Message
|> shouldEqual
"""Help text requested.
--do-something-else / --anotherarg string
--turn-it-on / --dont-turn-it-off bool"""
[<Test>]
let ``Can collect *all* non-help args into positional args with includeFlagLike`` () =
let getEnvVar (_ : string) = failwith "do not call"
FlagsIntoPositionalArgs.parse' getEnvVar [ "--a" ; "foo" ; "--b=false" ; "--c" ; "hi" ; "--" ; "--help" ]
|> shouldEqual
{
A = "foo"
GrabEverything = [ "--b=false" ; "--c" ; "hi" ; "--help" ]
}
// Users might consider this eccentric!
// But we're only a simple arg parser; we don't look around to see whether this is "almost"
// a valid parse.
FlagsIntoPositionalArgs.parse' getEnvVar [ "--a" ; "--b=false" ; "--c" ; "hi" ; "--" ; "--help" ]
|> shouldEqual
{
A = "--b=false"
GrabEverything = [ "--c" ; "hi" ; "--help" ]
}
[<Test>]
let ``Can collect non-help args into positional args with Choice`` () =
let getEnvVar (_ : string) = failwith "do not call"
FlagsIntoPositionalArgsChoice.parse' getEnvVar [ "--a" ; "foo" ; "--b=false" ; "--c" ; "hi" ; "--" ; "--help" ]
|> shouldEqual
{
A = "foo"
GrabEverything =
[
Choice1Of2 "--b=false"
Choice1Of2 "--c"
Choice1Of2 "hi"
Choice2Of2 "--help"
]
}
[<Test>]
let ``Can collect non-help args into positional args, and we parse on the way`` () =
let getEnvVar (_ : string) = failwith "do not call"
FlagsIntoPositionalArgsInt.parse' getEnvVar [ "3" ; "--a" ; "foo" ; "5" ; "--" ; "98" ]
|> shouldEqual
{
A = "foo"
GrabEverything = [ 3 ; 5 ; 98 ]
}
[<Test>]
let ``Can collect non-help args into positional args with Choice, and we parse on the way`` () =
let getEnvVar (_ : string) = failwith "do not call"
FlagsIntoPositionalArgsIntChoice.parse' getEnvVar [ "3" ; "--a" ; "foo" ; "5" ; "--" ; "98" ]
|> shouldEqual
{
A = "foo"
GrabEverything = [ Choice1Of2 3 ; Choice1Of2 5 ; Choice2Of2 98 ]
}
[<Test>]
let ``Can refuse to collect non-help args with PositionalArgs false`` () =
let getEnvVar (_ : string) = failwith "do not call"
let exc =
Assert.Throws<exn> (fun () ->
FlagsIntoPositionalArgs'.parse'
getEnvVar
[ "--a" ; "foo" ; "--b=false" ; "--c" ; "hi" ; "--" ; "--help" ]
|> ignore<FlagsIntoPositionalArgs'>
)
exc.Message
|> shouldEqual """Unable to process argument --b=false as key --b and value false"""
let exc =
Assert.Throws<exn> (fun () ->
FlagsIntoPositionalArgs'.parse' getEnvVar [ "--a" ; "--b=false" ; "--c=hi" ; "--" ; "--help" ]
|> ignore<FlagsIntoPositionalArgs'>
)
// Again perhaps eccentric!
// Again, we don't try to detect that the user has missed out the desired argument to `--a`.
exc.Message
|> shouldEqual """Unable to process argument --c=hi as key --c and value hi"""

View File

@@ -1,72 +0,0 @@
namespace WoofWare.Myriad.Plugins.Test
open System
open SomeNamespace.CapturingMock
open NUnit.Framework
open FsUnitTyped
[<TestFixture>]
module TestCapturingMockGenerator =
[<Test>]
let ``Example of use: IPublicType`` () =
let mock : IPublicType =
{ PublicTypeMock.Empty () with
Mem1 = fun (s, count) -> List.replicate count s
}
:> _
let _ =
Assert.Throws<NotImplementedException> (fun () -> mock.Mem2 "hi" |> ignore<int>)
mock.Mem1 ("hi", 3) |> shouldEqual [ "hi" ; "hi" ; "hi" ]
[<Test>]
let ``Example of use: curried args`` () =
let mock : Curried<_> =
{ CurriedMock.Empty () with
Mem1 = fun i c -> Array.replicate i c |> String
Mem2 = fun (i, s) c -> String.concat $"%c{c}" (List.replicate i s)
Mem3 = fun (i, s) c -> String.concat $"%c{c}" (List.replicate i s)
}
:> _
mock.Mem1 3 'a' |> shouldEqual "aaa"
mock.Mem2 (3, "hi") 'a' |> shouldEqual "hiahiahi"
mock.Mem3 (3, "hi") 'a' |> shouldEqual "hiahiahi"
[<Test>]
let ``Example of use: properties`` () =
let mock : TypeWithProperties =
{ TypeWithPropertiesMock.Empty () with
Mem1 = fun i -> async { return Option.toArray i }
Prop1 = fun () -> 44
}
:> _
mock.Mem1 (Some "hi") |> Async.RunSynchronously |> shouldEqual [| "hi" |]
mock.Prop1 |> shouldEqual 44
[<Test>]
let ``Example of curried use`` () =
let mock' =
{ CurriedMock<string>.Empty () with
Mem1 =
fun x y ->
x |> shouldEqual 3
y |> shouldEqual "hello"
"it's me"
}
let mock = mock' :> Curried<_>
mock.Mem1 3 "hello" |> shouldEqual "it's me"
lock mock'.Calls.Mem1 (fun () -> Seq.toList mock'.Calls.Mem1)
|> List.exactlyOne
|> shouldEqual
{
bar = 3
Arg1 = "hello"
}

View File

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

View File

@@ -1,47 +0,0 @@
namespace WoofWare.Myriad.Plugins.Test
open System.Threading
open NUnit.Framework
open FsUnitTyped
open ConsumePlugin
open FsCheck
[<TestFixture>]
module TestCataGenerator =
let idCata<'a, 'b> : TreeCata<'a, 'b, _, _> =
{
Tree =
{ new TreeCataCase<_, _, _, _> with
member _.Const x y = Const (x, y)
member _.Pair x y z = Pair (x, y, z)
member _.Sequential xs = Sequential xs
member _.Builder x b = Builder (x, b)
}
TreeBuilder =
{ new TreeBuilderCataCase<_, _, _, _> with
member _.Child x = Child x
member _.Parent x = Parent x
}
}
[<Test>]
let ``Example`` () =
let x =
Tree.Pair (Tree.Const (Const.Verbatim 0, "hi"), Tree.Const (Const.String "", "bye"), PairOpKind.ThenDoSeq)
TreeCata.runTree idCata x |> shouldEqual x
[<Test>]
let ``Cata works`` () =
let builderCases = ref 0
let property (x : Tree<int, string>) =
match x with
| Tree.Builder _ -> Interlocked.Increment builderCases |> ignore
| _ -> ()
TreeCata.runTree idCata x = x
Check.QuickThrowOnFailure property
builderCases.Value |> shouldBeGreaterThan 10

View File

@@ -1,37 +0,0 @@
namespace WoofWare.Myriad.Plugins.Test
open NUnit.Framework
open ConsumePlugin
open FsCheck
[<TestFixture>]
module TestDirectory =
let idCata : FileSystemCata<_> =
{
FileSystemItem =
{ new FileSystemItemCataCase<_> with
member _.File file = FileSystemItem.File file
member _.Directory name dirSize results =
FileSystemItem.Directory
{
Name = name
DirSize = dirSize
Contents = results
}
}
}
// Note: this file is preserved as an example of writing an identity cata.
// Don't add anything else to this file, because that will muddy the example.
[<Test>]
let ``Cata works`` () =
let property (x : FileSystemItem) =
FileSystemItemCata.runFileSystemItem idCata x = x
Check.QuickThrowOnFailure property
// Note: this file is preserved as an example of writing an identity cata.
// Don't add anything else to this file, because that will muddy the example.

View File

@@ -1,99 +0,0 @@
namespace WoofWare.Myriad.Plugins.Test
open NUnit.Framework
open ConsumePlugin
open FsCheck
open FsUnitTyped
[<TestFixture>]
module TestGift =
let idCata : GiftCata<_> =
{
Gift =
{ new GiftCataCase<_> with
member _.Book b = Gift.Book b
member _.Boxed g = Gift.Boxed g
member _.Chocolate g = Gift.Chocolate g
member _.WithACard g message = Gift.WithACard (g, message)
member _.Wrapped g paper = Gift.Wrapped (g, paper)
}
}
let totalCostCata : GiftCata<_> =
{
Gift =
{ new GiftCataCase<_> with
member _.Book b = b.price
member _.Boxed g = g + 1.0m
member _.Chocolate c = c.price
member _.WithACard g message = g + 2.0m
member _.Wrapped g paper = g + 0.5m
}
}
let descriptionCata : GiftCata<_> =
{
Gift =
{ new GiftCataCase<_> with
member _.Book b = b.title
member _.Boxed g = $"%s{g} in a box"
member _.Chocolate c = $"%O{c} chocolate"
member _.WithACard g message =
$"%s{g} with a card saying '%s{message}'"
member _.Wrapped g paper = $"%s{g} wrapped in %O{paper} paper"
}
}
[<Test>]
let ``Cata works`` () =
let property (x : Gift) = GiftCata.runGift idCata x = x
Check.QuickThrowOnFailure property
[<Test>]
let ``Example from docs`` () =
let wolfHall =
{
title = "Wolf Hall"
price = 20m
}
let yummyChoc =
{
chocType = SeventyPercent
price = 5m
}
let birthdayPresent =
WithACard (Wrapped (Book wolfHall, HappyBirthday), "Happy Birthday")
let christmasPresent = Wrapped (Boxed (Chocolate yummyChoc), HappyHolidays)
GiftCata.runGift totalCostCata birthdayPresent |> shouldEqual 22.5m
GiftCata.runGift descriptionCata christmasPresent
|> shouldEqual "SeventyPercent chocolate in a box wrapped in HappyHolidays paper"
let deeplyNestedBox depth =
let rec loop depth boxSoFar =
match depth with
| 0 -> boxSoFar
| n -> loop (n - 1) (Boxed boxSoFar)
loop depth (Book wolfHall)
deeplyNestedBox 10 |> GiftCata.runGift totalCostCata |> shouldEqual 30.0M
deeplyNestedBox 100 |> GiftCata.runGift totalCostCata |> shouldEqual 120.0M
deeplyNestedBox 1000 |> GiftCata.runGift totalCostCata |> shouldEqual 1020.0M
deeplyNestedBox 10000 |> GiftCata.runGift totalCostCata |> shouldEqual 10020.0M
deeplyNestedBox 100000
|> GiftCata.runGift totalCostCata
|> shouldEqual 100020.0M
deeplyNestedBox 1000000
|> GiftCata.runGift totalCostCata
|> shouldEqual 1000020.0M

View File

@@ -1,77 +0,0 @@
namespace WoofWare.Myriad.Plugins.Test
open NUnit.Framework
open FsCheck
open FsUnitTyped
open ConsumePlugin
[<TestFixture>]
module TestMyList =
let idCata<'a> : MyListCata<'a, _> =
{
MyList =
{ new MyListCataCase<'a, _> with
member _.Nil = MyList.Nil
member _.Cons head tail =
MyList.Cons
{
Head = head
Tail = tail
}
}
}
[<Test>]
let ``Cata works`` () =
let property (x : MyList<int>) = MyListCata.runMyList idCata x = x
Check.QuickThrowOnFailure property
let toListCata<'a> =
{
MyList =
{ new MyListCataCase<'a, 'a list> with
member _.Nil = []
member _.Cons (head : 'a) (tail : 'a list) = head :: tail
}
}
let toListViaCata<'a> (l : MyList<'a>) : 'a list = MyListCata.runMyList toListCata l
[<Test>]
let ``Example of a fold converting to a new data structure`` () =
let rec toListNaive (l : MyList<int>) : int list =
match l with
| MyList.Nil -> []
| MyList.Cons consCell -> consCell.Head :: toListNaive consCell.Tail
Check.QuickThrowOnFailure (fun l -> toListNaive l = toListViaCata l)
[<Test>]
let ``Example of equivalence with FoldBack`` () =
let baseCase = 0L
let atLeaf (head : int) (tail : int64) : int64 = int64 head + tail
let sumCata =
{
MyList =
{ new MyListCataCase<int, int64> with
member _.Nil = baseCase
member _.Cons (head : int) (tail : int64) = atLeaf head tail
}
}
let viaCata (l : MyList<int>) : int64 = MyListCata.runMyList sumCata l
let viaFold (l : MyList<int>) : int64 =
// choose your favourite "to list" method - here I use the cata
// but that could have been done naively
(toListViaCata l, baseCase)
||> List.foldBack (fun elt state -> atLeaf elt state)
let property (l : MyList<int>) = viaCata l = viaFold l
Check.QuickThrowOnFailure property

View File

@@ -1,25 +0,0 @@
namespace WoofWare.Myriad.Plugins.Test
open NUnit.Framework
open FsCheck
open FsUnitTyped
open ConsumePlugin
[<TestFixture>]
module TestMyList2 =
let idCata<'a> : MyList2Cata<'a, _> =
{
MyList2 =
{ new MyList2CataCase<'a, _> with
member _.Nil = MyList2.Nil
member _.Cons (head : 'a) (tail : MyList2<'a>) = MyList2.Cons (head, tail)
}
}
[<Test>]
let ``Cata works`` () =
let property (x : MyList2<int>) = MyList2Cata.runMyList2 idCata x = x
Check.QuickThrowOnFailure property

View File

@@ -9,18 +9,18 @@ open FsUnitTyped
[<TestFixture>] [<TestFixture>]
module TestBasePath = module TestBasePath =
let replyWithUrl (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
let content = new StringContent (message.RequestUri.ToString ())
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
[<Test>] [<Test>]
let ``Base address is respected`` () = let ``Base address is respected`` () =
use client = HttpClientMock.makeNoUri replyWithUrl let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
let content = new StringContent (message.RequestUri.ToString ())
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.makeNoUri proc
let api = PureGymApi.make client let api = PureGymApi.make client
let observedUri = api.GetPathParam("param").Result let observedUri = api.GetPathParam("param").Result
@@ -28,28 +28,38 @@ module TestBasePath =
[<Test>] [<Test>]
let ``Without a base address attr but with BaseAddress on client, request goes through`` () = let ``Without a base address attr but with BaseAddress on client, request goes through`` () =
use client = HttpClientMock.make (Uri "https://baseaddress.com") replyWithUrl let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
let content = new StringContent (message.RequestUri.ToString ())
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make (System.Uri "https://baseaddress.com") proc
let api = ApiWithoutBaseAddress.make client let api = ApiWithoutBaseAddress.make client
let observedUri = api.GetPathParam("param").Result let observedUri = api.GetPathParam("param").Result
observedUri |> shouldEqual "https://baseaddress.com/endpoint/param" observedUri |> shouldEqual "https://baseaddress.com/endpoint/param"
[<Test>]
let ``Base address on client takes precedence`` () =
use client = HttpClientMock.make (Uri "https://baseaddress.com") replyWithUrl
let api = PureGymApi.make client
let observedUri = api.GetPathParam("param").Result
observedUri |> shouldEqual "https://baseaddress.com/endpoint/param"
[<Test>] [<Test>]
let ``Without a base address attr or BaseAddress on client, request throws`` () = let ``Without a base address attr or BaseAddress on client, request throws`` () =
use client = HttpClientMock.makeNoUri replyWithUrl let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
let content = new StringContent (message.RequestUri.ToString ())
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.makeNoUri proc
let api = ApiWithoutBaseAddress.make client let api = ApiWithoutBaseAddress.make client
let observedExc = let observedExc =
async { async {
let! result = api.GetPathParam "param" |> Async.AwaitTask |> Async.Catch let! result = api.GetPathParam ("param") |> Async.AwaitTask |> Async.Catch
match result with match result with
| Choice1Of2 _ -> return failwith "test failure" | Choice1Of2 _ -> return failwith "test failure"
@@ -68,103 +78,3 @@ module TestBasePath =
observedExc.Message observedExc.Message
|> shouldEqual |> shouldEqual
"No base address was supplied on the type, and no BaseAddress was on the HttpClient. (Parameter 'BaseAddress')" "No base address was supplied on the type, and no BaseAddress was on the HttpClient. (Parameter 'BaseAddress')"
[<Test>]
let ``Relative base path, no base address, relative attribute`` () : unit =
do
use client = HttpClientMock.makeNoUri replyWithUrl
let api = ApiWithBasePath.make client
let exc =
Assert.Throws<AggregateException> (fun () -> api.GetPathParam("hi").Result |> ignore<string>)
exc.InnerException.Message
|> shouldEqual
"No base address was supplied on the type, and no BaseAddress was on the HttpClient. (Parameter 'BaseAddress')"
use client = HttpClientMock.make (Uri "https://whatnot.com/thing/") replyWithUrl
let api = ApiWithBasePath.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/thing/foo/endpoint/hi"
[<Test>]
let ``Relative base path, base address, relative attribute`` () : unit =
use client = HttpClientMock.makeNoUri replyWithUrl
let api = ApiWithBasePathAndAddress.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/thing/foo/endpoint/hi"
[<Test>]
let ``Absolute base path, no base address, relative attribute`` () : unit =
do
use client = HttpClientMock.makeNoUri replyWithUrl
let api = ApiWithAbsoluteBasePath.make client
let exc =
Assert.Throws<AggregateException> (fun () -> api.GetPathParam("hi").Result |> ignore<string>)
exc.InnerException.Message
|> shouldEqual
"No base address was supplied on the type, and no BaseAddress was on the HttpClient. (Parameter 'BaseAddress')"
use client = HttpClientMock.make (Uri "https://whatnot.com/thing/") replyWithUrl
let api = ApiWithAbsoluteBasePath.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/foo/endpoint/hi"
[<Test>]
let ``Absolute base path, base address, relative attribute`` () : unit =
use client = HttpClientMock.makeNoUri replyWithUrl
let api = ApiWithAbsoluteBasePathAndAddress.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/foo/endpoint/hi"
[<Test>]
let ``Relative base path, no base address, absolute attribute`` () : unit =
do
use client = HttpClientMock.makeNoUri replyWithUrl
let api = ApiWithBasePathAndAbsoluteEndpoint.make client
let exc =
Assert.Throws<AggregateException> (fun () -> api.GetPathParam("hi").Result |> ignore<string>)
exc.InnerException.Message
|> shouldEqual
"No base address was supplied on the type, and no BaseAddress was on the HttpClient. (Parameter 'BaseAddress')"
use client = HttpClientMock.make (Uri "https://whatnot.com/thing/") replyWithUrl
let api = ApiWithBasePathAndAbsoluteEndpoint.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/endpoint/hi"
[<Test>]
let ``Relative base path, base address, absolute attribute`` () : unit =
use client = HttpClientMock.makeNoUri replyWithUrl
let api = ApiWithBasePathAndAddressAndAbsoluteEndpoint.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/endpoint/hi"
[<Test>]
let ``Absolute base path, no base address, absolute attribute`` () : unit =
do
use client = HttpClientMock.makeNoUri replyWithUrl
let api = ApiWithAbsoluteBasePathAndAbsoluteEndpoint.make client
let exc =
Assert.Throws<AggregateException> (fun () -> api.GetPathParam("hi").Result |> ignore<string>)
exc.InnerException.Message
|> shouldEqual
"No base address was supplied on the type, and no BaseAddress was on the HttpClient. (Parameter 'BaseAddress')"
use client = HttpClientMock.make (Uri "https://whatnot.com/thing/") replyWithUrl
let api = ApiWithAbsoluteBasePathAndAbsoluteEndpoint.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/endpoint/hi"
[<Test>]
let ``Absolute base path, base address, absolute attribute`` () : unit =
use client = HttpClientMock.makeNoUri replyWithUrl
let api = ApiWithAbsoluteBasePathAndAddressAndAbsoluteEndpoint.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/endpoint/hi"

View File

@@ -4,6 +4,7 @@ open System
open System.IO open System.IO
open System.Net open System.Net
open System.Net.Http open System.Net.Http
open System.Text.Json.Nodes
open NUnit.Framework open NUnit.Framework
open PureGym open PureGym
open FsUnitTyped open FsUnitTyped
@@ -102,87 +103,3 @@ module TestBodyParam =
let buf = Array.zeroCreate 10 let buf = Array.zeroCreate 10
let written = observedContent.ReadAtLeast (buf.AsSpan (), 5, false) let written = observedContent.ReadAtLeast (buf.AsSpan (), 5, false)
buf |> Array.take written |> shouldEqual contents buf |> Array.take written |> shouldEqual contents
[<Test>]
let ``Body param of serialised thing`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Post
let! content = message.Content.ReadAsStringAsync () |> Async.AwaitTask
let content = new StringContent ("Done! " + content)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make (Uri "https://example.com") proc
let api = PureGymApi.make client
let expected =
{
Id = 3
CompoundMemberId = "compound!"
FirstName = "Patrick"
LastName = "Stevens"
HomeGymId = 100
HomeGymName = "Big Boy Gym"
EmailAddress = "woof@ware"
GymAccessPin = "l3tm31n"
// To the reader: what's the significance of this date?
// answer rot13: ghevatpbzchgnovyvglragfpurvqhatfceboyrzcncre
DateOfBirth = DateOnly (1936, 05, 28)
MobileNumber = "+44-GHOST-BUSTERS"
Postcode = "W1A 111"
MembershipName = "mario"
MembershipLevel = 4
SuspendedReason = 1090
MemberStatus = -3
}
let result = api.CreateUserSerialisedBody(expected).Result
result.StartsWith ("Done! ", StringComparison.Ordinal) |> shouldEqual true
let result = result.[6..]
result
|> System.Text.Json.Nodes.JsonNode.Parse
|> PureGym.Member.jsonParse
|> shouldEqual expected
[<Test>]
let ``Body param of primitive: int`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Post
let! content = message.Content.ReadAsStringAsync () |> Async.AwaitTask
let content = new StringContent ("Done! " + content)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make (Uri "https://example.com") proc
let api = PureGymApi.make client
let result = api.CreateUserSerialisedIntBody(3).Result
result |> shouldEqual "Done! 3"
[<Test>]
let ``Body param of primitive: Uri`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Post
let! content = message.Content.ReadAsStringAsync () |> Async.AwaitTask
let content = new StringContent ("Done! " + content)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make (Uri "https://example.com") proc
let api = PureGymApi.make client
let result = api.CreateUserSerialisedUrlBody(Uri "https://mything.com/blah").Result
result |> shouldEqual "Done! \"https://mything.com/blah\""

View File

@@ -33,4 +33,4 @@ module TestPathParam =
let api = PureGymApi.make client let api = PureGymApi.make client
api.GetPathParam("hello/world?(hi)").Result api.GetPathParam("hello/world?(hi)").Result
|> shouldEqual "hello%2Fworld%3F%28hi%29" |> shouldEqual "hello%2fworld%3f(hi)"

View File

@@ -89,7 +89,6 @@ module TestPureGymRestApi =
let api = PureGymApi.make client let api = PureGymApi.make client
api.GetGymAttendance(requestedGym).Result |> shouldEqual expected api.GetGymAttendance(requestedGym).Result |> shouldEqual expected
api.GetGymAttendance'(requestedGym).Result |> shouldEqual expected
let memberCases = let memberCases =
PureGymDtos.memberCases |> List.allPairs baseUris |> List.map TestCaseData PureGymDtos.memberCases |> List.allPairs baseUris |> List.map TestCaseData
@@ -210,7 +209,10 @@ module TestPureGymRestApi =
[<TestCaseSource(nameof sessionsCases)>] [<TestCaseSource(nameof sessionsCases)>]
let ``Test GetSessions`` let ``Test GetSessions``
(baseUri : Uri, (startDate : DateOnly, (endDate : DateOnly, (json : string, expected : Sessions)))) (
baseUri : Uri,
(startDate : DateOnly, (endDate : DateOnly, (json : string, expected : Sessions)))
)
= =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async = let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async { async {
@@ -235,33 +237,6 @@ module TestPureGymRestApi =
api.GetSessions(startDate, endDate).Result |> shouldEqual expected 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>] [<Test>]
let ``URI example`` () = let ``URI example`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async = let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
@@ -285,37 +260,3 @@ module TestPureGymRestApi =
uri.ToString () |> shouldEqual "https://patrick@en.wikipedia.org/wiki/foo" uri.ToString () |> shouldEqual "https://patrick@en.wikipedia.org/wiki/foo"
uri.UserInfo |> shouldEqual "patrick" uri.UserInfo |> shouldEqual "patrick"
uri.Host |> shouldEqual "en.wikipedia.org" uri.Host |> shouldEqual "en.wikipedia.org"
[<TestCase false>]
[<TestCase true>]
let ``Map<string, string> option example`` (isSome : bool) =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Post
message.RequestUri.ToString () |> shouldEqual "https://whatnot.com/some/url"
let! content = message.Content.ReadAsStringAsync () |> Async.AwaitTask
if isSome then
content |> shouldEqual """{"hi":"bye"}"""
else
content |> shouldEqual "null"
let content = new StringContent (content)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.makeNoUri proc
let api = PureGymApi.make client
let expected =
if isSome then
[ "hi", "bye" ] |> Map.ofList |> Some
else
None
let actual = api.PostStringToString(expected).Result
actual |> shouldEqual expected

View File

@@ -1,261 +0,0 @@
namespace WoofWare.Myriad.Plugins.Test
open System
open System.Net
open System.Net.Http
open System.Text.Json.Nodes
open System.Threading
open NUnit.Framework
open FsUnitTyped
open PureGym
open WoofWare.Expect
[<TestFixture>]
module TestVariableHeader =
[<Test>]
let ``Headers are set`` () : unit =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
message.RequestUri.ToString ()
|> shouldEqual "https://example.com/endpoint/param"
let headers =
[
for h in message.Headers do
yield $"%s{h.Key}: %s{Seq.exactlyOne h.Value}"
]
|> String.concat "\n"
let content = new StringContent (headers)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make (Uri "https://example.com") proc
let someHeaderCount = ref 10
let someHeader () =
(Interlocked.Increment someHeaderCount : int).ToString ()
let someOtherHeaderCount = ref -100
let someOtherHeader () =
Interlocked.Increment someOtherHeaderCount
let api = ApiWithHeaders.make someHeader someOtherHeader client
someHeaderCount.Value |> shouldEqual 10
someOtherHeaderCount.Value |> shouldEqual -100
expect {
snapshotJson
@"[
""Authorization: -99"",
""Header-Name: Header-Value"",
""Something-Else: val"",
""X-Foo: 11""
]"
return api.GetPathParam("param").Result.Split "\n" |> Array.sort
}
someHeaderCount.Value |> shouldEqual 11
someOtherHeaderCount.Value |> shouldEqual -99
[<Test>]
let ``Headers get re-evaluated every time`` () : unit =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
message.RequestUri.ToString ()
|> shouldEqual "https://example.com/endpoint/param"
let headers =
[
for h in message.Headers do
yield $"%s{h.Key}: %s{Seq.exactlyOne h.Value}"
]
|> String.concat "\n"
let content = new StringContent (headers)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make (Uri "https://example.com") proc
let someHeaderCount = ref 10
let someHeader () =
(Interlocked.Increment someHeaderCount : int).ToString ()
let someOtherHeaderCount = ref -100
let someOtherHeader () =
Interlocked.Increment someOtherHeaderCount
let api = ApiWithHeaders.make someHeader someOtherHeader client
someHeaderCount.Value |> shouldEqual 10
someOtherHeaderCount.Value |> shouldEqual -100
expect {
snapshotJson
@"[
""Authorization: -99"",
""Header-Name: Header-Value"",
""Something-Else: val"",
""X-Foo: 11""
]"
return api.GetPathParam("param").Result.Split "\n" |> Array.sort
}
expect {
snapshotJson
@"[
""Authorization: -98"",
""Header-Name: Header-Value"",
""Something-Else: val"",
""X-Foo: 12""
]"
return api.GetPathParam("param").Result.Split "\n" |> Array.sort
}
someHeaderCount.Value |> shouldEqual 12
someOtherHeaderCount.Value |> shouldEqual -98
let pureGymMember =
{
Id = 3
CompoundMemberId = "compound"
FirstName = "Patrick"
LastName = "Stevens"
HomeGymId = 1223
HomeGymName = "Arnie's Temple o' Gainz"
EmailAddress = "patrick@home"
GymAccessPin = "1234"
DateOfBirth = DateOnly (1992, 03, 04)
MobileNumber = "number"
Postcode = "postcode"
MembershipName = "member"
MembershipLevel = 9999
SuspendedReason = -1
MemberStatus = 100
}
[<Test>]
let ``Content-Type header is automatically inserted`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Post
message.RequestUri.ToString ()
|> shouldEqual "https://example.com/endpoint/param"
let headers =
[
for h in message.Content.Headers do
yield $"%s{h.Key}: %s{Seq.exactlyOne h.Value}"
]
|> String.concat "\n"
let! ct = Async.CancellationToken
let! content = message.Content.ReadAsStringAsync ct |> Async.AwaitTask
content |> JsonNode.Parse |> Member.jsonParse |> shouldEqual pureGymMember
let content = new StringContent (headers)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make (Uri "https://example.com") proc
let api = ClientWithJsonBody.make client
let result = api.GetPathParam ("param", pureGymMember) |> _.Result
expect {
snapshot @"Content-Type: application/json; charset=utf-8"
return result
}
[<Test>]
let ``Content-Type header is respected if overridden`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Post
message.RequestUri.ToString ()
|> shouldEqual "https://example.com/endpoint/param"
let headers =
[
for h in message.Content.Headers do
yield $"%s{h.Key}: %s{Seq.exactlyOne h.Value}"
]
|> String.concat "\n"
let! ct = Async.CancellationToken
let! content = message.Content.ReadAsStringAsync ct |> Async.AwaitTask
content |> JsonNode.Parse |> Member.jsonParse |> shouldEqual pureGymMember
let content = new StringContent (headers)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make (Uri "https://example.com") proc
let api = ClientWithJsonBodyOverridden.make client
let result = api.GetPathParam ("param", pureGymMember) |> _.Result
expect {
snapshot @"Content-Type: application/ecmascript; charset=utf-8"
return result
}
[<Test>]
let ``Content-Type header is the default for strings`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Post
message.RequestUri.ToString ()
|> shouldEqual "https://example.com/endpoint/param"
let headers =
[
for h in message.Content.Headers do
yield $"%s{h.Key}: %s{Seq.exactlyOne h.Value}"
]
|> String.concat "\n"
let! ct = Async.CancellationToken
let! content = message.Content.ReadAsStringAsync ct |> Async.AwaitTask
content |> shouldEqual "hello!"
let content = new StringContent (headers)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make (Uri "https://example.com") proc
let api = ClientWithStringBody.make client
let result = api.GetPathParam ("param", "hello!") |> _.Result
expect {
snapshot @"Content-Type: text/plain; charset=utf-8"
return result
}

View File

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

View File

@@ -1,7 +1,6 @@
namespace WoofWare.Myriad.Plugins.Test namespace WoofWare.Myriad.Plugins.Test
open System open System
open System.Numerics
open System.Text.Json.Nodes open System.Text.Json.Nodes
open ConsumePlugin open ConsumePlugin
open NUnit.Framework open NUnit.Framework
@@ -13,62 +12,15 @@ module TestExtensionMethod =
[<Test>] [<Test>]
let ``Parse via extension method`` () = let ``Parse via extension method`` () =
let json = 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 |> JsonNode.Parse
let expected = let expected =
{ {
Alpha = "hello!" Tinker = "job"
Bravo = Uri "https://example.com" Tailor = 3
Charlie = 0.3341 Soldier = Uri "https://example.com"
Delta = 110033.4f Sailor = 3.1
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
} }
let actual = ToGetExtensionMethod.jsonParse json ToGetExtensionMethod.jsonParse json |> shouldEqual expected
actual |> shouldEqual expected

View File

@@ -7,8 +7,6 @@ open FsUnitTyped
[<TestFixture>] [<TestFixture>]
module TestJsonParse = module TestJsonParse =
let _canSeePastExtensionMethod = ToGetExtensionMethod.thisModuleWouldClash
[<Test>] [<Test>]
let ``Single example`` () = let ``Single example`` () =
let s = let s =
@@ -49,15 +47,3 @@ module TestJsonParse =
let actual = s |> JsonNode.Parse |> InnerType.jsonParse let actual = s |> JsonNode.Parse |> InnerType.jsonParse
actual |> shouldEqual expected actual |> shouldEqual expected
[<TestCase("thing", SomeEnum.Thing)>]
[<TestCase("Thing", SomeEnum.Thing)>]
[<TestCase("THING", SomeEnum.Thing)>]
[<TestCase("blah", SomeEnum.Blah)>]
[<TestCase("Blah", SomeEnum.Blah)>]
[<TestCase("BLAH", SomeEnum.Blah)>]
let ``Can deserialise enum`` (str : string, expected : SomeEnum) =
sprintf "\"%s\"" str
|> JsonNode.Parse
|> SomeEnum.jsonParse
|> shouldEqual expected

View File

@@ -1,488 +0,0 @@
namespace WoofWare.Myriad.Plugins.Test
open System
open System.Collections.Generic
open System.Text.Json.Nodes
open FsCheck.FSharp
open Microsoft.FSharp.Reflection
open NUnit.Framework
open FsCheck
open FsUnitTyped
open ConsumePlugin
[<TestFixture>]
module TestJsonSerde =
let uriGen : Gen<Uri> =
gen {
let! suffix = ArbMap.generate<int> ArbMap.defaults
return Uri $"https://example.com/%i{suffix}"
}
let rec innerGen (count : int) : Gen<InnerTypeWithBoth> =
gen {
let! guid = ArbMap.generate<Guid> ArbMap.defaults
let! mapKeys = Gen.listOf (ArbMap.generate<NonNull<string>> ArbMap.defaults)
let mapKeys = mapKeys |> List.map _.Get |> List.distinct
let! mapValues = Gen.listOfLength mapKeys.Length uriGen
let map = List.zip mapKeys mapValues |> Map.ofList
let! concreteDictKeys =
if count > 0 then
Gen.listOf (ArbMap.generate<NonNull<string>> ArbMap.defaults)
else
Gen.constant []
let concreteDictKeys =
concreteDictKeys
|> List.map _.Get
|> List.distinct
|> fun x -> List.take (min 3 x.Length) x
let! concreteDictValues =
if count > 0 then
Gen.listOfLength concreteDictKeys.Length (innerGen (count - 1))
else
Gen.constant []
let concreteDict =
List.zip concreteDictKeys concreteDictValues
|> List.map KeyValuePair
|> Dictionary
let! readOnlyDictKeys = Gen.listOf (ArbMap.generate<NonNull<string>> ArbMap.defaults)
let readOnlyDictKeys = readOnlyDictKeys |> List.map _.Get |> List.distinct
let! readOnlyDictValues =
Gen.listOfLength readOnlyDictKeys.Length (Gen.listOf (ArbMap.generate<char> ArbMap.defaults))
let readOnlyDict = List.zip readOnlyDictKeys readOnlyDictValues |> readOnlyDict
let! dictKeys = Gen.listOf uriGen
let! dictValues = Gen.listOfLength dictKeys.Length (ArbMap.generate<bool> ArbMap.defaults)
let dict = List.zip dictKeys dictValues |> dict
return
{
Thing = guid
Map = map
ReadOnlyDict = readOnlyDict
Dict = dict
ConcreteDict = concreteDict
}
}
let outerGen : Gen<JsonRecordTypeWithBoth> =
gen {
let! a = ArbMap.generate<int> ArbMap.defaults
let! b = ArbMap.generate<NonNull<string>> ArbMap.defaults
let! c = Gen.listOf (ArbMap.generate<int> ArbMap.defaults)
let! depth = Gen.choose (0, 2)
let! d = innerGen depth
let! e = Gen.arrayOf (ArbMap.generate<NonNull<string>> ArbMap.defaults)
let! arr = Gen.arrayOf (ArbMap.generate<int> ArbMap.defaults)
let! byte = ArbMap.generate ArbMap.defaults
let! sbyte = ArbMap.generate ArbMap.defaults
let! i = ArbMap.generate ArbMap.defaults
let! i32 = ArbMap.generate ArbMap.defaults
let! i64 = ArbMap.generate ArbMap.defaults
let! u = ArbMap.generate ArbMap.defaults
let! u32 = ArbMap.generate ArbMap.defaults
let! u64 = ArbMap.generate ArbMap.defaults
let! f =
ArbMap.generate ArbMap.defaults
|> Gen.filter (fun s -> Double.IsFinite (s / 1.0<measure>))
let! f32 =
ArbMap.generate ArbMap.defaults
|> Gen.filter (fun s -> Single.IsFinite (s / 1.0f<measure>))
let! single =
ArbMap.generate ArbMap.defaults
|> Gen.filter (fun s -> Single.IsFinite (s / 1.0f<measure>))
let! intMeasureOption = ArbMap.generate ArbMap.defaults
let! intMeasureNullable = ArbMap.generate ArbMap.defaults
let! someEnum = Gen.choose (0, 1)
let! timestamp = ArbMap.generate ArbMap.defaults
return
{
A = a
B = b.Get
C = c
D = d
E = e |> Array.map _.Get
Arr = arr
Byte = byte
Sbyte = sbyte
I = i
I32 = i32
I64 = i64
U = u
U32 = u32
U64 = u64
F = f
F32 = f32
Single = single
IntMeasureOption = intMeasureOption
IntMeasureNullable = intMeasureNullable
Enum = enum<SomeEnum> someEnum
Timestamp = timestamp
Unit = ()
}
}
[<Test>]
let ``It just works`` () =
let property (o : JsonRecordTypeWithBoth) : bool =
o
|> JsonRecordTypeWithBoth.toJsonNode
|> fun s -> s.ToJsonString ()
|> JsonNode.Parse
|> JsonRecordTypeWithBoth.jsonParse
|> shouldEqual o
true
property |> Prop.forAll (Arb.fromGen outerGen) |> Check.QuickThrowOnFailure
[<Test>]
let ``Single example of big record`` () =
let guid = Guid.Parse "dfe24db5-9f8d-447b-8463-4c0bcf1166d5"
let data =
{
A = 3
B = "hello!"
C = [ 1 ; -9 ]
D =
{
Thing = guid
Map = Map.ofList []
ReadOnlyDict = readOnlyDict []
Dict = dict []
ConcreteDict = Dictionary ()
}
E = [| "I'm-a-string" |]
Arr = [| -18883 ; 9100 |]
Byte = 87uy<measure>
Sbyte = 89y<measure>
I = 199993345<measure>
I32 = -485832<measure>
I64 = -13458625689L<measure>
U = 458582u<measure>
U32 = 857362147u<measure>
U64 = 1234567892123414596UL<measure>
F = 8833345667.1<measure>
F32 = 1000.98f<measure>
Single = 0.334f<measure>
IntMeasureOption = Some 981<measure>
IntMeasureNullable = Nullable -883<measure>
Enum = enum<SomeEnum> 1
Timestamp = DateTimeOffset (2024, 07, 01, 17, 54, 00, TimeSpan.FromHours 1.0)
Unit = ()
}
let expected =
"""{
"a": 3,
"b": "hello!",
"c": [1, -9],
"d": {
"it\u0027s-a-me": "dfe24db5-9f8d-447b-8463-4c0bcf1166d5",
"map": {},
"readOnlyDict": {},
"dict": {},
"concreteDict": {}
},
"e": ["I\u0027m-a-string"],
"arr": [-18883, 9100],
"byte": 87,
"sbyte": 89,
"i": 199993345,
"i32": -485832,
"i64": -13458625689,
"u": 458582,
"u32": 857362147,
"u64": 1234567892123414596,
"f": 8833345667.1,
"f32": 1000.98,
"single": 0.334,
"intMeasureOption": 981,
"intMeasureNullable": -883,
"enum": 1,
"timestamp": "2024-07-01T17:54:00.0000000\u002B01:00",
"unit": {}
}
"""
|> fun s -> s.ToCharArray ()
|> Array.filter (fun c -> not (Char.IsWhiteSpace c))
|> fun s -> new String (s)
JsonRecordTypeWithBoth.toJsonNode(data).ToJsonString () |> shouldEqual expected
JsonRecordTypeWithBoth.jsonParse (JsonNode.Parse expected) |> shouldEqual data
[<Test>]
let ``Guids are treated just like strings`` () =
let guidStr = "b1e7496e-6e79-4158-8579-a01de355d3b2"
let guid = Guid.Parse guidStr
let node =
{
Thing = guid
Map = Map.empty
ReadOnlyDict = readOnlyDict []
Dict = dict []
ConcreteDict = Dictionary ()
}
|> InnerTypeWithBoth.toJsonNode
node.ToJsonString ()
|> 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 =
{ r with
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
Arr =
if Object.ReferenceEquals (r.Arr, (null : obj)) then
[||]
else
r.Arr
}
let duGen =
gen {
let! case = Gen.choose (0, 2)
match case with
| 0 -> return FirstDu.EmptyCase
| 1 ->
let! s = ArbMap.generate<NonNull<string>> ArbMap.defaults
return FirstDu.Case1 s.Get
| 2 ->
let! i = ArbMap.generate<int> ArbMap.defaults
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 cases = FSharpType.GetUnionCases typeof<FirstDu>
let counts = Array.zeroCreate<int> cases.Length
let decompose = FSharpValue.PreComputeUnionTagReader typeof<FirstDu>
let mutable i = 0
let property (du : FirstDu) =
let tag = decompose du
counts.[tag] <- counts.[tag] + 1
i <- i + 1
true
Check.One (Config.Quick, Prop.forAll (Arb.fromGen duGen) property)
for i in counts do
i |> shouldBeGreaterThan 0
let dict<'a, 'b when 'a : equality> (xs : ('a * 'b) seq) : Dictionary<'a, 'b> =
let result = Dictionary ()
for k, v in xs do
result.Add (k, v)
result
let inline makeJsonArr< ^t, ^u when ^u : (static member op_Implicit : ^t -> JsonNode) and ^u :> JsonNode>
(arr : ^t seq)
: JsonNode
=
let result = JsonArray ()
for a in arr do
result.Add a
result :> JsonNode
let normalise (d : Dictionary<'a, 'b>) : ('a * 'b) list =
d |> Seq.map (fun (KeyValue (a, b)) -> a, b) |> Seq.toList |> List.sortBy fst
[<Test>]
let ``Can collect extension data`` () =
let str =
"""{
"message": { "header": "hi", "value": "bye" },
"something": 3,
"arr": ["egg", "toast"],
"str": "whatnot"
}"""
|> JsonNode.Parse
let expected =
{
Rest =
[
"something", JsonNode.op_Implicit 3
"arr", makeJsonArr [| "egg" ; "toast" |]
"str", JsonNode.op_Implicit "whatnot"
]
|> dict
Message =
Some
{
Header = "hi"
Value = "bye"
}
}
let actual = CollectRemaining.jsonParse str
actual.Message |> shouldEqual expected.Message
normalise actual.Rest
|> List.map (fun (k, v) -> k, v.ToJsonString ())
|> shouldEqual (normalise expected.Rest |> List.map (fun (k, v) -> k, v.ToJsonString ()))
[<Test>]
let ``Can write out extension data`` () =
let expected =
"""{"message":{"header":"hi","value":"bye"},"something":3,"arr":["egg","toast"],"str":"whatnot"}"""
let toWrite =
{
Rest =
[
"something", JsonNode.op_Implicit 3
"arr", makeJsonArr [| "egg" ; "toast" |]
"str", JsonNode.op_Implicit "whatnot"
]
|> dict
Message =
Some
{
Header = "hi"
Value = "bye"
}
}
let actual = CollectRemaining.toJsonNode toWrite |> fun s -> s.ToJsonString ()
actual |> shouldEqual expected
[<Test>]
let ``Can collect extension data, nested`` () =
let str =
"""{
"thing": 99,
"baz": -123,
"remaining": {
"message": { "header": "hi", "value": "bye" },
"something": 3,
"arr": ["egg", "toast"],
"str": "whatnot"
}
}"""
|> JsonNode.Parse
let expected : OuterCollectRemaining =
{
Remaining =
{
Message =
Some
{
Header = "hi"
Value = "bye"
}
Rest =
[
"something", JsonNode.op_Implicit 3
"arr", makeJsonArr [| "egg" ; "toast" |]
"str", JsonNode.op_Implicit "whatnot"
]
|> dict
}
Others = [ "thing", 99 ; "baz", -123 ] |> dict
}
let actual = OuterCollectRemaining.jsonParse str
normalise actual.Others |> shouldEqual (normalise expected.Others)
let actual = actual.Remaining
let expected = expected.Remaining
actual.Message |> shouldEqual expected.Message
normalise actual.Rest
|> List.map (fun (k, v) -> k, v.ToJsonString ())
|> shouldEqual (normalise expected.Rest |> List.map (fun (k, v) -> k, v.ToJsonString ()))
[<Test>]
let ``Can write out extension data, nested`` () =
let expected =
"""{"thing":99,"baz":-123,"remaining":{"message":{"header":"hi","value":"bye"},"something":3,"arr":["egg","toast"],"str":"whatnot"}}"""
let toWrite : OuterCollectRemaining =
{
Others = [ "thing", 99 ; "baz", -123 ] |> dict
Remaining =
{
Rest =
[
"something", JsonNode.op_Implicit 3
"arr", makeJsonArr [| "egg" ; "toast" |]
"str", JsonNode.op_Implicit "whatnot"
]
|> dict
Message =
Some
{
Header = "hi"
Value = "bye"
}
}
}
let actual = OuterCollectRemaining.toJsonNode toWrite |> fun s -> s.ToJsonString ()
actual |> shouldEqual expected

View File

@@ -34,16 +34,3 @@ module TestMockGenerator =
mock.Mem1 3 'a' |> shouldEqual "aaa" mock.Mem1 3 'a' |> shouldEqual "aaa"
mock.Mem2 (3, "hi") 'a' |> shouldEqual "hiahiahi" mock.Mem2 (3, "hi") 'a' |> shouldEqual "hiahiahi"
mock.Mem3 (3, "hi") 'a' |> shouldEqual "hiahiahi" mock.Mem3 (3, "hi") 'a' |> shouldEqual "hiahiahi"
[<Test>]
let ``Example of use: properties`` () =
let mock : TypeWithProperties =
{ TypeWithPropertiesMock.Empty with
Mem1 = fun i -> async { return Option.toArray i }
Prop1 = fun () -> 44
}
:> _
mock.Mem1 (Some "hi") |> Async.RunSynchronously |> shouldEqual [| "hi" |]
mock.Prop1 |> shouldEqual 44

View File

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

View File

@@ -6,14 +6,13 @@ open ApiSurface
[<TestFixture>] [<TestFixture>]
module TestSurface = module TestSurface =
let assembly = typeof<RemoveOptionsGenerator>.Assembly let assembly = typeof<RemoveOptionsAttribute>.Assembly
[<Test>] [<Test>]
let ``Ensure API surface has not been modified`` () = ApiSurface.assertIdentical assembly let ``Ensure API surface has not been modified`` () = ApiSurface.assertIdentical assembly
[<Test>] [<Test>]
// https://github.com/nunit/nunit3-vs-adapter/issues/876 let ``Check version against remote`` () =
let CheckVersionAgainstRemote () =
MonotonicVersion.validate assembly "WoofWare.Myriad.Plugins" MonotonicVersion.validate assembly "WoofWare.Myriad.Plugins"
[<Test ; Explicit>] [<Test ; Explicit>]

File diff suppressed because it is too large Load Diff

View File

@@ -1,84 +0,0 @@
namespace WoofWare.Myriad.Plugins.Test
open System.Text.Json.Nodes
open NUnit.Framework
open FsUnitTyped
open WoofWare.Myriad.Plugins.SwaggerV2
[<TestFixture>]
module TestSwaggerParse =
[<Test>]
let ``Can parse parameters`` () : unit =
let s =
"""{
"tags": [
"organization"
],
"summary": "Check if a user is a member of an organization",
"operationId": "orgIsMember",
"parameters": [
{
"type": "string",
"description": "name of the organization",
"name": "org",
"in": "path",
"required": true
},
{
"type": "string",
"description": "username of the user",
"name": "username",
"in": "path",
"required": true
}
],
"responses": {
"204": {
"description": "user is a member"
},
"303": {
"description": "redirection to /orgs/{org}/public_members/{username}"
},
"404": {
"description": "user is not a member"
}
}
}
"""
|> JsonNode.Parse
s.AsObject ()
|> SwaggerEndpoint.Parse
|> shouldEqual
{
Consumes = None
Produces = None
Tags = [ "organization" ]
Summary = "Check if a user is a member of an organization"
OperationId = OperationId "orgIsMember"
Parameters =
[
{
Type = Definition.String
Description = Some "name of the organization"
Name = "org"
In = ParameterIn.Path "org"
Required = Some true
}
{
Type = Definition.String
Description = Some "username of the user"
Name = "username"
In = ParameterIn.Path "username"
Required = Some true
}
]
|> Some
Responses =
[
204, Definition.Unspecified
303, Definition.Unspecified
404, Definition.Unspecified
]
|> Map.ofList
}

View File

@@ -1,192 +0,0 @@
{
"openapi": "3.0.0",
"info": {
"title": "Simple API overview",
"version": "2.0.0"
},
"paths": {
"/": {
"get": {
"operationId": "listVersionsv2",
"summary": "List API versions",
"responses": {
"200": {
"description": "200 response",
"content": {
"application/json": {
"examples": {
"foo": {
"value": {
"versions": [
{
"status": "CURRENT",
"updated": "2011-01-21T11:33:21Z",
"id": "v2.0",
"links": [
{
"href": "http://127.0.0.1:8774/v2/",
"rel": "self"
}
]
},
{
"status": "EXPERIMENTAL",
"updated": "2013-07-23T11:33:21Z",
"id": "v3.0",
"links": [
{
"href": "http://127.0.0.1:8774/v3/",
"rel": "self"
}
]
}
]
}
}
}
}
}
},
"300": {
"description": "300 response",
"content": {
"application/json": {
"examples": {
"foo": {
"value": {
"versions": [
{
"status": "CURRENT",
"updated": "2011-01-21T11:33:21Z",
"id": "v2.0",
"links": [
{
"href": "http://127.0.0.1:8774/v2/",
"rel": "self"
}
]
},
{
"status": "EXPERIMENTAL",
"updated": "2013-07-23T11:33:21Z",
"id": "v3.0",
"links": [
{
"href": "http://127.0.0.1:8774/v3/",
"rel": "self"
}
]
}
]
}
}
}
}
}
}
}
}
},
"/v2": {
"get": {
"operationId": "getVersionDetailsv2",
"summary": "Show API version details",
"responses": {
"200": {
"description": "200 response",
"content": {
"application/json": {
"examples": {
"foo": {
"value": {
"version": {
"status": "CURRENT",
"updated": "2011-01-21T11:33:21Z",
"media-types": [
{
"base": "application/xml",
"type": "application/vnd.openstack.compute+xml;version=2"
},
{
"base": "application/json",
"type": "application/vnd.openstack.compute+json;version=2"
}
],
"id": "v2.0",
"links": [
{
"href": "http://127.0.0.1:8774/v2/",
"rel": "self"
},
{
"href": "http://docs.openstack.org/api/openstack-compute/2/os-compute-devguide-2.pdf",
"type": "application/pdf",
"rel": "describedby"
},
{
"href": "http://docs.openstack.org/api/openstack-compute/2/wadl/os-compute-2.wadl",
"type": "application/vnd.sun.wadl+xml",
"rel": "describedby"
},
{
"href": "http://docs.openstack.org/api/openstack-compute/2/wadl/os-compute-2.wadl",
"type": "application/vnd.sun.wadl+xml",
"rel": "describedby"
}
]
}
}
}
}
}
}
},
"203": {
"description": "203 response",
"content": {
"application/json": {
"examples": {
"foo": {
"value": {
"version": {
"status": "CURRENT",
"updated": "2011-01-21T11:33:21Z",
"media-types": [
{
"base": "application/xml",
"type": "application/vnd.openstack.compute+xml;version=2"
},
{
"base": "application/json",
"type": "application/vnd.openstack.compute+json;version=2"
}
],
"id": "v2.0",
"links": [
{
"href": "http://23.253.228.211:8774/v2/",
"rel": "self"
},
{
"href": "http://docs.openstack.org/api/openstack-compute/2/os-compute-devguide-2.pdf",
"type": "application/pdf",
"rel": "describedby"
},
{
"href": "http://docs.openstack.org/api/openstack-compute/2/wadl/os-compute-2.wadl",
"type": "application/vnd.sun.wadl+xml",
"rel": "describedby"
}
]
}
}
}
}
}
}
}
}
}
}
}
}

View File

@@ -1,82 +0,0 @@
{
"openapi": "3.0.0",
"info": {
"title": "Callback Example",
"version": "1.0.0"
},
"paths": {
"/streams": {
"post": {
"description": "subscribes a client to receive out-of-band data",
"parameters": [
{
"name": "callbackUrl",
"in": "query",
"required": true,
"description": "the location where data will be sent. Must be network accessible\nby the source server\n",
"schema": {
"type": "string",
"format": "uri",
"example": "https://tonys-server.com"
}
}
],
"responses": {
"201": {
"description": "subscription successfully created",
"content": {
"application/json": {
"schema": {
"description": "subscription information",
"required": ["subscriptionId"],
"properties": {
"subscriptionId": {
"description": "this unique identifier allows management of the subscription",
"type": "string",
"example": "2531329f-fb09-4ef7-887e-84e648214436"
}
}
}
}
}
}
},
"callbacks": {
"onData": {
"{$request.query.callbackUrl}/data": {
"post": {
"requestBody": {
"description": "subscription payload",
"content": {
"application/json": {
"schema": {
"type": "object",
"properties": {
"timestamp": {
"type": "string",
"format": "date-time"
},
"userData": {
"type": "string"
}
}
}
}
}
},
"responses": {
"202": {
"description": "Your server implementation should return this HTTP status code\nif the data was received successfully\n"
},
"204": {
"description": "Your server should return this HTTP status code if no longer interested\nin further updates\n"
}
}
}
}
}
}
}
}
}
}

View File

@@ -1,319 +0,0 @@
{
"openapi": "3.0.0",
"info": {
"title": "Link Example",
"version": "1.0.0"
},
"paths": {
"/2.0/users/{username}": {
"get": {
"operationId": "getUserByName",
"parameters": [
{
"name": "username",
"in": "path",
"required": true,
"schema": {
"type": "string"
}
}
],
"responses": {
"200": {
"description": "The User",
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/user"
}
}
},
"links": {
"userRepositories": {
"$ref": "#/components/links/UserRepositories"
}
}
}
}
}
},
"/2.0/repositories/{username}": {
"get": {
"operationId": "getRepositoriesByOwner",
"parameters": [
{
"name": "username",
"in": "path",
"required": true,
"schema": {
"type": "string"
}
}
],
"responses": {
"200": {
"description": "repositories owned by the supplied user",
"content": {
"application/json": {
"schema": {
"type": "array",
"items": {
"$ref": "#/components/schemas/repository"
}
}
}
},
"links": {
"userRepository": {
"$ref": "#/components/links/UserRepository"
}
}
}
}
}
},
"/2.0/repositories/{username}/{slug}": {
"get": {
"operationId": "getRepository",
"parameters": [
{
"name": "username",
"in": "path",
"required": true,
"schema": {
"type": "string"
}
},
{
"name": "slug",
"in": "path",
"required": true,
"schema": {
"type": "string"
}
}
],
"responses": {
"200": {
"description": "The repository",
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/repository"
}
}
},
"links": {
"repositoryPullRequests": {
"$ref": "#/components/links/RepositoryPullRequests"
}
}
}
}
}
},
"/2.0/repositories/{username}/{slug}/pullrequests": {
"get": {
"operationId": "getPullRequestsByRepository",
"parameters": [
{
"name": "username",
"in": "path",
"required": true,
"schema": {
"type": "string"
}
},
{
"name": "slug",
"in": "path",
"required": true,
"schema": {
"type": "string"
}
},
{
"name": "state",
"in": "query",
"schema": {
"type": "string",
"enum": ["open", "merged", "declined"]
}
}
],
"responses": {
"200": {
"description": "an array of pull request objects",
"content": {
"application/json": {
"schema": {
"type": "array",
"items": {
"$ref": "#/components/schemas/pullrequest"
}
}
}
}
}
}
}
},
"/2.0/repositories/{username}/{slug}/pullrequests/{pid}": {
"get": {
"operationId": "getPullRequestsById",
"parameters": [
{
"name": "username",
"in": "path",
"required": true,
"schema": {
"type": "string"
}
},
{
"name": "slug",
"in": "path",
"required": true,
"schema": {
"type": "string"
}
},
{
"name": "pid",
"in": "path",
"required": true,
"schema": {
"type": "string"
}
}
],
"responses": {
"200": {
"description": "a pull request object",
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/pullrequest"
}
}
},
"links": {
"pullRequestMerge": {
"$ref": "#/components/links/PullRequestMerge"
}
}
}
}
}
},
"/2.0/repositories/{username}/{slug}/pullrequests/{pid}/merge": {
"post": {
"operationId": "mergePullRequest",
"parameters": [
{
"name": "username",
"in": "path",
"required": true,
"schema": {
"type": "string"
}
},
{
"name": "slug",
"in": "path",
"required": true,
"schema": {
"type": "string"
}
},
{
"name": "pid",
"in": "path",
"required": true,
"schema": {
"type": "string"
}
}
],
"responses": {
"204": {
"description": "the PR was successfully merged"
}
}
}
}
},
"components": {
"links": {
"UserRepositories": {
"operationId": "getRepositoriesByOwner",
"parameters": {
"username": "$response.body#/username"
}
},
"UserRepository": {
"operationId": "getRepository",
"parameters": {
"username": "$response.body#/owner/username",
"slug": "$response.body#/slug"
}
},
"RepositoryPullRequests": {
"operationId": "getPullRequestsByRepository",
"parameters": {
"username": "$response.body#/owner/username",
"slug": "$response.body#/slug"
}
},
"PullRequestMerge": {
"operationId": "mergePullRequest",
"parameters": {
"username": "$response.body#/author/username",
"slug": "$response.body#/repository/slug",
"pid": "$response.body#/id"
}
}
},
"schemas": {
"user": {
"type": "object",
"properties": {
"username": {
"type": "string"
},
"uuid": {
"type": "string"
}
}
},
"repository": {
"type": "object",
"properties": {
"slug": {
"type": "string"
},
"owner": {
"$ref": "#/components/schemas/user"
}
}
},
"pullrequest": {
"type": "object",
"properties": {
"id": {
"type": "integer"
},
"title": {
"type": "string"
},
"repository": {
"$ref": "#/components/schemas/repository"
},
"author": {
"$ref": "#/components/schemas/user"
}
}
}
}
}
}

View File

@@ -1,28 +0,0 @@
{
"openapi": "3.1.0",
"info": {
"title": "Non-oAuth Scopes example",
"version": "1.0.0"
},
"paths": {
"/users": {
"get": {
"security": [
{
"bearerAuth": ["read:users", "public"]
}
]
}
}
},
"components": {
"securitySchemes": {
"bearerAuth": {
"type": "http",
"scheme": "bearer",
"bearerFormat": "jwt",
"description": "note: non-oauth scopes are not defined at the securityScheme level"
}
}
}
}

View File

@@ -1,235 +0,0 @@
{
"openapi": "3.0.0",
"info": {
"version": "1.0.0",
"title": "Swagger Petstore",
"description": "A sample API that uses a petstore as an example to demonstrate features in the OpenAPI 3.0 specification",
"termsOfService": "http://swagger.io/terms/",
"contact": {
"name": "Swagger API Team",
"email": "apiteam@swagger.io",
"url": "http://swagger.io"
},
"license": {
"name": "Apache 2.0",
"url": "https://www.apache.org/licenses/LICENSE-2.0.html"
}
},
"servers": [
{
"url": "https://petstore.swagger.io/v2"
}
],
"paths": {
"/pets": {
"get": {
"description": "Returns all pets from the system that the user has access to\nNam sed condimentum est. Maecenas tempor sagittis sapien, nec rhoncus sem sagittis sit amet. Aenean at gravida augue, ac iaculis sem. Curabitur odio lorem, ornare eget elementum nec, cursus id lectus. Duis mi turpis, pulvinar ac eros ac, tincidunt varius justo. In hac habitasse platea dictumst. Integer at adipiscing ante, a sagittis ligula. Aenean pharetra tempor ante molestie imperdiet. Vivamus id aliquam diam. Cras quis velit non tortor eleifend sagittis. Praesent at enim pharetra urna volutpat venenatis eget eget mauris. In eleifend fermentum facilisis. Praesent enim enim, gravida ac sodales sed, placerat id erat. Suspendisse lacus dolor, consectetur non augue vel, vehicula interdum libero. Morbi euismod sagittis libero sed lacinia.\n\nSed tempus felis lobortis leo pulvinar rutrum. Nam mattis velit nisl, eu condimentum ligula luctus nec. Phasellus semper velit eget aliquet faucibus. In a mattis elit. Phasellus vel urna viverra, condimentum lorem id, rhoncus nibh. Ut pellentesque posuere elementum. Sed a varius odio. Morbi rhoncus ligula libero, vel eleifend nunc tristique vitae. Fusce et sem dui. Aenean nec scelerisque tortor. Fusce malesuada accumsan magna vel tempus. Quisque mollis felis eu dolor tristique, sit amet auctor felis gravida. Sed libero lorem, molestie sed nisl in, accumsan tempor nisi. Fusce sollicitudin massa ut lacinia mattis. Sed vel eleifend lorem. Pellentesque vitae felis pretium, pulvinar elit eu, euismod sapien.\n",
"operationId": "findPets",
"parameters": [
{
"name": "tags",
"in": "query",
"description": "tags to filter by",
"required": false,
"style": "form",
"schema": {
"type": "array",
"items": {
"type": "string"
}
}
},
{
"name": "limit",
"in": "query",
"description": "maximum number of results to return",
"required": false,
"schema": {
"type": "integer",
"format": "int32"
}
}
],
"responses": {
"200": {
"description": "pet response",
"content": {
"application/json": {
"schema": {
"type": "array",
"items": {
"$ref": "#/components/schemas/Pet"
}
}
}
}
},
"default": {
"description": "unexpected error",
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/Error"
}
}
}
}
}
},
"post": {
"description": "Creates a new pet in the store. Duplicates are allowed",
"operationId": "addPet",
"requestBody": {
"description": "Pet to add to the store",
"required": true,
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/NewPet"
}
}
}
},
"responses": {
"200": {
"description": "pet response",
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/Pet"
}
}
}
},
"default": {
"description": "unexpected error",
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/Error"
}
}
}
}
}
}
},
"/pets/{id}": {
"get": {
"description": "Returns a user based on a single ID, if the user does not have access to the pet",
"operationId": "find pet by id",
"parameters": [
{
"name": "id",
"in": "path",
"description": "ID of pet to fetch",
"required": true,
"schema": {
"type": "integer",
"format": "int64"
}
}
],
"responses": {
"200": {
"description": "pet response",
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/Pet"
}
}
}
},
"default": {
"description": "unexpected error",
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/Error"
}
}
}
}
}
},
"delete": {
"description": "deletes a single pet based on the ID supplied",
"operationId": "deletePet",
"parameters": [
{
"name": "id",
"in": "path",
"description": "ID of pet to delete",
"required": true,
"schema": {
"type": "integer",
"format": "int64"
}
}
],
"responses": {
"204": {
"description": "pet deleted"
},
"default": {
"description": "unexpected error",
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/Error"
}
}
}
}
}
}
}
},
"components": {
"schemas": {
"Pet": {
"allOf": [
{
"$ref": "#/components/schemas/NewPet"
},
{
"type": "object",
"required": ["id"],
"properties": {
"id": {
"type": "integer",
"format": "int64"
}
}
}
]
},
"NewPet": {
"type": "object",
"required": ["name"],
"properties": {
"name": {
"type": "string"
},
"tag": {
"type": "string"
}
}
},
"Error": {
"type": "object",
"required": ["code", "message"],
"properties": {
"code": {
"type": "integer",
"format": "int32"
},
"message": {
"type": "string"
}
}
}
}
}
}

View File

@@ -1,177 +0,0 @@
{
"openapi": "3.0.0",
"info": {
"version": "1.0.0",
"title": "Swagger Petstore",
"license": {
"name": "MIT"
}
},
"servers": [
{
"url": "http://petstore.swagger.io/v1"
}
],
"paths": {
"/pets": {
"get": {
"summary": "List all pets",
"operationId": "listPets",
"tags": ["pets"],
"parameters": [
{
"name": "limit",
"in": "query",
"description": "How many items to return at one time (max 100)",
"required": false,
"schema": {
"type": "integer",
"maximum": 100,
"format": "int32"
}
}
],
"responses": {
"200": {
"description": "A paged array of pets",
"headers": {
"x-next": {
"description": "A link to the next page of responses",
"schema": {
"type": "string"
}
}
},
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/Pets"
}
}
}
},
"default": {
"description": "unexpected error",
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/Error"
}
}
}
}
}
},
"post": {
"summary": "Create a pet",
"operationId": "createPets",
"tags": ["pets"],
"requestBody": {
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/Pet"
}
}
},
"required": true
},
"responses": {
"201": {
"description": "Null response"
},
"default": {
"description": "unexpected error",
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/Error"
}
}
}
}
}
}
},
"/pets/{petId}": {
"get": {
"summary": "Info for a specific pet",
"operationId": "showPetById",
"tags": ["pets"],
"parameters": [
{
"name": "petId",
"in": "path",
"required": true,
"description": "The id of the pet to retrieve",
"schema": {
"type": "string"
}
}
],
"responses": {
"200": {
"description": "Expected response to a valid request",
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/Pet"
}
}
}
},
"default": {
"description": "unexpected error",
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/Error"
}
}
}
}
}
}
}
},
"components": {
"schemas": {
"Pet": {
"type": "object",
"required": ["id", "name"],
"properties": {
"id": {
"type": "integer",
"format": "int64"
},
"name": {
"type": "string"
},
"tag": {
"type": "string"
}
}
},
"Pets": {
"type": "array",
"maxItems": 100,
"items": {
"$ref": "#/components/schemas/Pet"
}
},
"Error": {
"type": "object",
"required": ["code", "message"],
"properties": {
"code": {
"type": "integer",
"format": "int32"
},
"message": {
"type": "string"
}
}
}
}
}
}

View File

@@ -1,261 +0,0 @@
{
"openapi": "3.1.0",
"info": {
"title": "Tic Tac Toe",
"description": "This API allows writing down marks on a Tic Tac Toe board\nand requesting the state of the board or of individual squares.\n",
"version": "1.0.0"
},
"tags": [
{
"name": "Gameplay"
}
],
"paths": {
"/board": {
"get": {
"summary": "Get the whole board",
"description": "Retrieves the current state of the board and the winner.",
"tags": ["Gameplay"],
"operationId": "get-board",
"responses": {
"200": {
"description": "OK",
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/status"
}
}
}
}
},
"security": [
{
"defaultApiKey": []
},
{
"app2AppOauth": ["board:read"]
}
]
}
},
"/board/{row}/{column}": {
"parameters": [
{
"$ref": "#/components/parameters/rowParam"
},
{
"$ref": "#/components/parameters/columnParam"
}
],
"get": {
"summary": "Get a single board square",
"description": "Retrieves the requested square.",
"tags": ["Gameplay"],
"operationId": "get-square",
"responses": {
"200": {
"description": "OK",
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/mark"
}
}
}
},
"400": {
"description": "The provided parameters are incorrect",
"content": {
"text/html": {
"schema": {
"$ref": "#/components/schemas/errorMessage"
},
"example": "Illegal coordinates"
}
}
}
},
"security": [
{
"bearerHttpAuthentication": []
},
{
"user2AppOauth": ["board:read"]
}
]
},
"put": {
"summary": "Set a single board square",
"description": "Places a mark on the board and retrieves the whole board and the winner (if any).",
"tags": ["Gameplay"],
"operationId": "put-square",
"requestBody": {
"required": true,
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/mark"
}
}
}
},
"responses": {
"200": {
"description": "OK",
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/status"
}
}
}
},
"400": {
"description": "The provided parameters are incorrect",
"content": {
"text/html": {
"schema": {
"$ref": "#/components/schemas/errorMessage"
},
"examples": {
"illegalCoordinates": {
"value": "Illegal coordinates."
},
"notEmpty": {
"value": "Square is not empty."
},
"invalidMark": {
"value": "Invalid Mark (X or O)."
}
}
}
}
}
},
"security": [
{
"bearerHttpAuthentication": []
},
{
"user2AppOauth": ["board:write"]
}
]
}
}
},
"components": {
"parameters": {
"rowParam": {
"description": "Board row (vertical coordinate)",
"name": "row",
"in": "path",
"required": true,
"schema": {
"$ref": "#/components/schemas/coordinate"
}
},
"columnParam": {
"description": "Board column (horizontal coordinate)",
"name": "column",
"in": "path",
"required": true,
"schema": {
"$ref": "#/components/schemas/coordinate"
}
}
},
"schemas": {
"errorMessage": {
"type": "string",
"maxLength": 256,
"description": "A text message describing an error"
},
"coordinate": {
"type": "integer",
"minimum": 1,
"maximum": 3,
"example": 1
},
"mark": {
"type": "string",
"enum": [".", "X", "O"],
"description": "Possible values for a board square. `.` means empty square.",
"example": "."
},
"board": {
"type": "array",
"maxItems": 3,
"minItems": 3,
"items": {
"type": "array",
"maxItems": 3,
"minItems": 3,
"items": {
"$ref": "#/components/schemas/mark"
}
}
},
"winner": {
"type": "string",
"enum": [".", "X", "O"],
"description": "Winner of the game. `.` means nobody has won yet.",
"example": "."
},
"status": {
"type": "object",
"properties": {
"winner": {
"$ref": "#/components/schemas/winner"
},
"board": {
"$ref": "#/components/schemas/board"
}
}
}
},
"securitySchemes": {
"defaultApiKey": {
"description": "API key provided in console",
"type": "apiKey",
"name": "api-key",
"in": "header"
},
"basicHttpAuthentication": {
"description": "Basic HTTP Authentication",
"type": "http",
"scheme": "Basic"
},
"bearerHttpAuthentication": {
"description": "Bearer token using a JWT",
"type": "http",
"scheme": "Bearer",
"bearerFormat": "JWT"
},
"app2AppOauth": {
"type": "oauth2",
"flows": {
"clientCredentials": {
"tokenUrl": "https://learn.openapis.org/oauth/2.0/token",
"scopes": {
"board:read": "Read the board"
}
}
}
},
"user2AppOauth": {
"type": "oauth2",
"flows": {
"authorizationCode": {
"authorizationUrl": "https://learn.openapis.org/oauth/2.0/auth",
"tokenUrl": "https://learn.openapis.org/oauth/2.0/token",
"scopes": {
"board:read": "Read the board",
"board:write": "Write to the board"
}
}
}
}
}
}
}

View File

@@ -1,241 +0,0 @@
{
"openapi": "3.0.1",
"servers": [
{
"url": "{scheme}://developer.uspto.gov/ds-api",
"variables": {
"scheme": {
"description": "The Data Set API is accessible via https and http",
"enum": ["https", "http"],
"default": "https"
}
}
}
],
"info": {
"description": "The Data Set API (DSAPI) allows the public users to discover and search USPTO exported data sets. This is a generic API that allows USPTO users to make any CSV based data files searchable through API. With the help of GET call, it returns the list of data fields that are searchable. With the help of POST call, data can be fetched based on the filters on the field names. Please note that POST call is used to search the actual data. The reason for the POST call is that it allows users to specify any complex search criteria without worry about the GET size limitations as well as encoding of the input parameters.",
"version": "1.0.0",
"title": "USPTO Data Set API",
"contact": {
"name": "Open Data Portal",
"url": "https://developer.uspto.gov",
"email": "developer@uspto.gov"
}
},
"tags": [
{
"name": "metadata",
"description": "Find out about the data sets"
},
{
"name": "search",
"description": "Search a data set"
}
],
"paths": {
"/": {
"get": {
"tags": ["metadata"],
"operationId": "list-data-sets",
"summary": "List available data sets",
"responses": {
"200": {
"description": "Returns a list of data sets",
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/dataSetList"
},
"example": {
"total": 2,
"apis": [
{
"apiKey": "oa_citations",
"apiVersionNumber": "v1",
"apiUrl": "https://developer.uspto.gov/ds-api/oa_citations/v1/fields",
"apiDocumentationUrl": "https://developer.uspto.gov/ds-api-docs/index.html?url=https://developer.uspto.gov/ds-api/swagger/docs/oa_citations.json"
},
{
"apiKey": "cancer_moonshot",
"apiVersionNumber": "v1",
"apiUrl": "https://developer.uspto.gov/ds-api/cancer_moonshot/v1/fields",
"apiDocumentationUrl": "https://developer.uspto.gov/ds-api-docs/index.html?url=https://developer.uspto.gov/ds-api/swagger/docs/cancer_moonshot.json"
}
]
}
}
}
}
}
}
},
"/{dataset}/{version}/fields": {
"get": {
"tags": ["metadata"],
"summary": "Provides the general information about the API and the list of fields that can be used to query the dataset.",
"description": "This GET API returns the list of all the searchable field names that are in the oa_citations. Please see the 'fields' attribute which returns an array of field names. Each field or a combination of fields can be searched using the syntax options shown below.",
"operationId": "list-searchable-fields",
"parameters": [
{
"name": "dataset",
"in": "path",
"description": "Name of the dataset.",
"required": true,
"example": "oa_citations",
"schema": {
"type": "string"
}
},
{
"name": "version",
"in": "path",
"description": "Version of the dataset.",
"required": true,
"example": "v1",
"schema": {
"type": "string"
}
}
],
"responses": {
"200": {
"description": "The dataset API for the given version is found and it is accessible to consume.",
"content": {
"application/json": {
"schema": {
"type": "string"
}
}
}
},
"404": {
"description": "The combination of dataset name and version is not found in the system or it is not published yet to be consumed by public.",
"content": {
"application/json": {
"schema": {
"type": "string"
}
}
}
}
}
}
},
"/{dataset}/{version}/records": {
"post": {
"tags": ["search"],
"summary": "Provides search capability for the data set with the given search criteria.",
"description": "This API is based on Solr/Lucene Search. The data is indexed using SOLR. This GET API returns the list of all the searchable field names that are in the Solr Index. Please see the 'fields' attribute which returns an array of field names. Each field or a combination of fields can be searched using the Solr/Lucene Syntax. Please refer https://lucene.apache.org/core/3_6_2/queryparsersyntax.html#Overview for the query syntax. List of field names that are searchable can be determined using above GET api.",
"operationId": "perform-search",
"parameters": [
{
"name": "version",
"in": "path",
"description": "Version of the dataset.",
"required": true,
"schema": {
"type": "string",
"default": "v1"
}
},
{
"name": "dataset",
"in": "path",
"description": "Name of the dataset. In this case, the default value is oa_citations",
"required": true,
"schema": {
"type": "string",
"default": "oa_citations"
}
}
],
"responses": {
"200": {
"description": "successful operation",
"content": {
"application/json": {
"schema": {
"type": "array",
"items": {
"type": "object",
"additionalProperties": {
"type": "object"
}
}
}
}
}
},
"404": {
"description": "No matching record found for the given criteria."
}
},
"requestBody": {
"content": {
"application/x-www-form-urlencoded": {
"schema": {
"type": "object",
"properties": {
"criteria": {
"description": "Uses Lucene Query Syntax in the format of propertyName:value, propertyName:[num1 TO num2] and date range format: propertyName:[yyyyMMdd TO yyyyMMdd]. In the response please see the 'docs' element which has the list of record objects. Each record structure would consist of all the fields and their corresponding values.",
"type": "string",
"default": "*:*"
},
"start": {
"description": "Starting record number. Default value is 0.",
"type": "integer",
"default": 0
},
"rows": {
"description": "Specify number of rows to be returned. If you run the search with default values, in the response you will see 'numFound' attribute which will tell the number of records available in the dataset.",
"type": "integer",
"default": 100
}
},
"required": ["criteria"]
}
}
}
}
}
}
},
"components": {
"schemas": {
"dataSetList": {
"type": "object",
"properties": {
"total": {
"type": "integer"
},
"apis": {
"type": "array",
"items": {
"type": "object",
"properties": {
"apiKey": {
"type": "string",
"description": "To be used as a dataset parameter value"
},
"apiVersionNumber": {
"type": "string",
"description": "To be used as a version parameter value"
},
"apiUrl": {
"type": "string",
"format": "uriref",
"description": "The URL describing the dataset's fields"
},
"apiDocumentationUrl": {
"type": "string",
"format": "uriref",
"description": "A URL to the API console for each API"
}
}
}
}
}
}
}
}
}

View File

@@ -1,47 +0,0 @@
{
"openapi": "3.1.0",
"info": {
"title": "Webhook Example",
"version": "1.0.0"
},
"webhooks": {
"newPet": {
"post": {
"requestBody": {
"description": "Information about a new pet in the system",
"content": {
"application/json": {
"schema": {
"$ref": "#/components/schemas/Pet"
}
}
}
},
"responses": {
"200": {
"description": "Return a 200 status to indicate that the data was received successfully"
}
}
}
}
},
"components": {
"schemas": {
"Pet": {
"required": ["id", "name"],
"properties": {
"id": {
"type": "integer",
"format": "int64"
},
"name": {
"type": "string"
},
"tag": {
"type": "string"
}
}
}
}
}
}

View File

@@ -1,21 +1,14 @@
<Project Sdk="Microsoft.NET.Sdk"> <Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup> <PropertyGroup>
<TargetFramework>net9.0</TargetFramework> <TargetFramework>net8.0</TargetFramework>
<IsPackable>false</IsPackable> <IsPackable>false</IsPackable>
<IsTestProject>true</IsTestProject> <IsTestProject>true</IsTestProject>
<!--
Known high severity vulnerability
I have not yet seen a single instance where I care about this warning
-->
<NoWarn>$(NoWarn),NU1903</NoWarn>
<TestingPlatformDotnetTestSupport>true</TestingPlatformDotnetTestSupport>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<Compile Include="Assembly.fs" /> <Compile Include="HttpClient.fs"/>
<Compile Include="HttpClient.fs" /> <Compile Include="PureGymDtos.fs"/>
<Compile Include="PureGymDtos.fs" />
<Compile Include="TestJsonParse\TestJsonParse.fs" /> <Compile Include="TestJsonParse\TestJsonParse.fs" />
<Compile Include="TestJsonParse\TestPureGymJson.fs" /> <Compile Include="TestJsonParse\TestPureGymJson.fs" />
<Compile Include="TestJsonParse\TestExtensionMethod.fs" /> <Compile Include="TestJsonParse\TestExtensionMethod.fs" />
@@ -26,47 +19,25 @@
<Compile Include="TestHttpClient\TestBasePath.fs" /> <Compile Include="TestHttpClient\TestBasePath.fs" />
<Compile Include="TestHttpClient\TestBodyParam.fs" /> <Compile Include="TestHttpClient\TestBodyParam.fs" />
<Compile Include="TestHttpClient\TestVaultClient.fs" /> <Compile Include="TestHttpClient\TestVaultClient.fs" />
<Compile Include="TestHttpClient\TestVariableHeader.fs" />
<Compile Include="TestMockGenerator\TestMockGenerator.fs" /> <Compile Include="TestMockGenerator\TestMockGenerator.fs" />
<Compile Include="TestMockGenerator\TestMockGeneratorNoAttr.fs" /> <Compile Include="TestRemoveOptions.fs"/>
<Compile Include="TestCapturingMockGenerator\TestCapturingMockGenerator.fs" /> <Compile Include="TestSurface.fs"/>
<Compile Include="TestCapturingMockGenerator\TestCapturingMockGeneratorNoAttr.fs" />
<Compile Include="TestJsonSerialize\TestJsonSerde.fs" />
<Compile Include="TestCataGenerator\TestCataGenerator.fs" />
<Compile Include="TestCataGenerator\TestDirectory.fs" />
<Compile Include="TestCataGenerator\TestGift.fs" />
<Compile Include="TestCataGenerator\TestMyList.fs" />
<Compile Include="TestCataGenerator\TestMyList2.fs" />
<Compile Include="TestArgParser\TestArgParser.fs" />
<Compile Include="TestSwagger\TestSwaggerParse.fs" />
<Compile Include="TestSwagger\TestOpenApi3Parse.fs" />
<EmbeddedResource Include="TestSwagger\api-with-examples.json" />
<EmbeddedResource Include="TestSwagger\callback-example.json" />
<EmbeddedResource Include="TestSwagger\link-example.json" />
<EmbeddedResource Include="TestSwagger\non-oauth-scopes.json" />
<EmbeddedResource Include="TestSwagger\petstore.json" />
<EmbeddedResource Include="TestSwagger\petstore-expanded.json" />
<EmbeddedResource Include="TestSwagger\tictactoe.json" />
<EmbeddedResource Include="TestSwagger\uspto.json" />
<EmbeddedResource Include="TestSwagger\webhook-example.json" />
<Compile Include="TestRemoveOptions.fs" />
<Compile Include="TestSurface.fs" />
<None Include="../.github/workflows/dotnet.yaml" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="ApiSurface" Version="5.0.2" /> <PackageReference Include="ApiSurface" Version="4.0.25"/>
<PackageReference Include="FsCheck" Version="3.3.1" /> <PackageReference Include="FsCheck" Version="2.16.6"/>
<PackageReference Include="FsUnit" Version="7.1.1" /> <PackageReference Include="FsUnit" Version="6.0.0"/>
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="18.0.0" /> <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.8.0"/>
<PackageReference Include="NUnit" Version="4.3.2" /> <PackageReference Include="NUnit" Version="4.0.1"/>
<PackageReference Include="NUnit3TestAdapter" Version="5.2.0" /> <PackageReference Include="NUnit3TestAdapter" Version="4.5.0"/>
<PackageReference Include="WoofWare.Expect" Version="0.8.4" /> <PackageReference Include="NUnit.Analyzers" Version="3.10.0"/>
<PackageReference Include="coverlet.collector" Version="6.0.0"/>
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<ProjectReference Include="..\WoofWare.Myriad.Plugins\WoofWare.Myriad.Plugins.fsproj" /> <ProjectReference Include="..\WoofWare.Myriad.Plugins\WoofWare.Myriad.Plugins.fsproj"/>
<ProjectReference Include="..\ConsumePlugin\ConsumePlugin.fsproj" /> <ProjectReference Include="..\ConsumePlugin\ConsumePlugin.fsproj"/>
</ItemGroup> </ItemGroup>
</Project> </Project>

File diff suppressed because it is too large Load Diff

View File

@@ -1,6 +0,0 @@
module internal WoofWare.Myriad.Plugins.AssemblyInfo
open System.Runtime.CompilerServices
[<assembly : InternalsVisibleTo("WoofWare.Myriad.Plugins.Test")>]
do ()

View File

@@ -1,53 +1,137 @@
namespace WoofWare.Myriad.Plugins namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Text.Range open Fantomas.FCS.Text.Range
open WoofWare.Whippet.Fantomas open Fantomas.FCS.Xml
open Myriad.Core.AstExtensions
/// Anything that is part of an ADT. type internal ParameterInfo =
/// A record is a product of stuff; this type represents one of those stuffs.
type internal AdtNode =
{ {
Attributes : SynAttribute list
IsOptional : bool
Id : Ident option
Type : SynType Type : SynType
Name : Ident option
/// An ordered list, so you can look up any given generic within `this.Type`
/// to discover what its index is in the parent DU which defined it.
GenericsOfParent : SynTyparDecl list
} }
/// A DU is a sum of products (e.g. `type Thing = Foo of a * b`); type internal TupledArg =
/// similarly a record is a product.
/// This type represents a product in that sense.
type internal AdtProduct =
{ {
Name : SynIdent HasParen : bool
Fields : AdtNode list Args : ParameterInfo list
/// This AdtProduct represents a product in which there might be }
/// some bound type parameters. This field lists the bound
/// type parameters in the order they appeared on the parent type. type internal MemberInfo =
Generics : SynTyparDecl list {
ReturnType : SynType
Accessibility : SynAccess option
/// Each element of this list is a list of args in a tuple, or just one arg if not a tuple.
Args : TupledArg list
Identifier : Ident
Attributes : SynAttribute list
XmlDoc : PreXmlDoc option
IsInline : bool
IsMutable : bool
}
type internal InterfaceType =
{
Attributes : SynAttribute list
Name : LongIdent
Members : MemberInfo list
Generics : SynTyparDecls option
Accessibility : SynAccess option
}
type internal RecordType =
{
Name : Ident
Fields : SynField seq
Members : SynMemberDefns option
XmlDoc : PreXmlDoc option
Generics : SynTyparDecls option
Accessibility : SynAccess option
} }
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module internal AstHelper = module internal AstHelper =
let isEnum (SynTypeDefn.SynTypeDefn (_, repr, _, _, _, _)) : bool = let instantiateRecord (fields : (RecordFieldName * SynExpr option) list) : SynExpr =
match repr with let fields =
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Enum _, _) -> true fields
| _ -> false |> List.map (fun (rfn, synExpr) -> SynExprRecordField (rfn, Some range0, synExpr, None))
SynExpr.Record (None, None, fields, range0)
let defineRecordType (record : RecordType) : SynTypeDefn = let defineRecordType (record : RecordType) : SynTypeDefn =
let name = let repr =
SynComponentInfo.create record.Name SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (None, Seq.toList record.Fields, range0), range0)
|> SynComponentInfo.setAccessibility record.TypeAccessibility
|> match record.XmlDoc with
| None -> id
| Some doc -> SynComponentInfo.withDocString doc
|> SynComponentInfo.setGenerics record.Generics
SynTypeDefnRepr.recordWithAccess record.ImplAccessibility (Seq.toList record.Fields) let name =
|> SynTypeDefn.create name SynComponentInfo.Create (
|> SynTypeDefn.withMemberDefns (defaultArg record.Members SynMemberDefns.Empty) [ record.Name ],
?xmldoc = record.XmlDoc,
?parameters = record.Generics,
access = record.Accessibility
)
let trivia : SynTypeDefnTrivia =
{
LeadingKeyword = SynTypeDefnLeadingKeyword.Type range0
EqualsRange = Some range0
WithKeyword = Some range0
}
SynTypeDefn (name, repr, defaultArg record.Members SynMemberDefns.Empty, None, range0, trivia)
let isOptionIdent (ident : SynLongIdent) : bool =
match ident.LongIdent with
| [ i ] when System.String.Equals (i.idText, "option", System.StringComparison.OrdinalIgnoreCase) -> true
// TODO: consider Microsoft.FSharp.Option or whatever it is
| _ -> false
let isListIdent (ident : SynLongIdent) : bool =
match ident.LongIdent with
| [ i ] when System.String.Equals (i.idText, "list", System.StringComparison.OrdinalIgnoreCase) -> true
// TODO: consider FSharpList or whatever it is
| _ -> false
let isArrayIdent (ident : SynLongIdent) : bool =
match ident.LongIdent with
| [ i ] when
System.String.Equals (i.idText, "array", System.StringComparison.OrdinalIgnoreCase)
|| System.String.Equals (i.idText, "[]", System.StringComparison.Ordinal)
->
true
| _ -> false
let isMapIdent (ident : SynLongIdent) : bool =
match ident.LongIdent |> List.map _.idText with
| [ "Map" ] -> true
| _ -> false
let isReadOnlyDictionaryIdent (ident : SynLongIdent) : bool =
match ident.LongIdent |> List.map _.idText with
| [ "IReadOnlyDictionary" ]
| [ "Generic" ; "IReadOnlyDictionary" ]
| [ "Collections" ; "Generic" ; "IReadOnlyDictionary" ]
| [ "System" ; "Collections" ; "Generic" ; "IReadOnlyDictionary" ] -> true
| _ -> false
let isDictionaryIdent (ident : SynLongIdent) : bool =
match ident.LongIdent |> List.map _.idText with
| [ "Dictionary" ]
| [ "Generic" ; "Dictionary" ]
| [ "Collections" ; "Generic" ; "Dictionary" ]
| [ "System" ; "Collections" ; "Generic" ; "Dictionary" ] -> true
| _ -> false
let isIDictionaryIdent (ident : SynLongIdent) : bool =
match ident.LongIdent |> List.map _.idText with
| [ "IDictionary" ]
| [ "Generic" ; "IDictionary" ]
| [ "Collections" ; "Generic" ; "IDictionary" ]
| [ "System" ; "Collections" ; "Generic" ; "IDictionary" ] -> true
| _ -> false
let rec private extractOpensFromDecl (moduleDecls : SynModuleDecl list) : SynOpenDeclTarget list = let rec private extractOpensFromDecl (moduleDecls : SynModuleDecl list) : SynOpenDeclTarget list =
moduleDecls moduleDecls
@@ -69,12 +153,12 @@ module internal AstHelper =
| SynType.Paren (inner, _) -> | SynType.Paren (inner, _) ->
let result, _ = convertSigParam inner let result, _ = convertSigParam inner
result, true result, true
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) -> | SynType.LongIdent ident ->
{ {
Attributes = [] Attributes = []
IsOptional = false IsOptional = false
Id = None Id = None
Type = SynType.createLongIdent ident Type = SynType.CreateLongIdent ident
}, },
false false
| SynType.SignatureParameter (attrs, opt, id, usedType, _) -> | SynType.SignatureParameter (attrs, opt, id, usedType, _) ->
@@ -92,7 +176,7 @@ module internal AstHelper =
Attributes = [] Attributes = []
IsOptional = false IsOptional = false
Id = None Id = None
Type = SynType.var typar Type = SynType.Var (typar, range0)
}, },
false false
| _ -> failwithf "expected SignatureParameter, got: %+A" ty | _ -> failwithf "expected SignatureParameter, got: %+A" ty
@@ -121,6 +205,10 @@ module internal AstHelper =
} }
| _ -> failwithf "Didn't have alternating type-and-star in interface member definition: %+A" tupleType | _ -> failwithf "Didn't have alternating type-and-star in interface member definition: %+A" tupleType
let toFun (inputs : SynType list) (ret : SynType) : SynType =
(ret, List.rev inputs)
||> List.fold (fun ty input -> SynType.CreateFun (input, ty))
/// Returns the args (where these are tuple types if curried) in order, and the return type. /// Returns the args (where these are tuple types if curried) in order, and the return type.
let rec getType (ty : SynType) : (SynType * bool) list * SynType = let rec getType (ty : SynType) : (SynType * bool) list * SynType =
match ty with match ty with
@@ -133,122 +221,9 @@ module internal AstHelper =
| SynType.Paren (argType, _) -> getType argType, true | SynType.Paren (argType, _) -> getType argType, true
| _ -> getType argType, false | _ -> getType argType, false
((SynType.toFun (List.map fst inputArgs) inputRet), hasParen) :: args, ret ((toFun (List.map fst inputArgs) inputRet), hasParen) :: args, ret
| _ -> [], ty | _ -> [], ty
let private parseMember (slotSig : SynValSig) (flags : SynMemberFlags) : Choice<MemberInfo, PropertyInfo> =
if not flags.IsInstance then
failwith "member was not an instance member"
let propertyAccessors =
match flags.MemberKind with
| SynMemberKind.Member -> None
| SynMemberKind.PropertyGet -> Some PropertyAccessors.Get
| SynMemberKind.PropertySet -> Some PropertyAccessors.Set
| SynMemberKind.PropertyGetSet -> Some PropertyAccessors.GetSet
| kind -> failwithf "Unrecognised member kind: %+A" kind
match slotSig with
| SynValSig (attrs,
SynIdent.SynIdent (ident, _),
_typeParams,
synType,
_arity,
isInline,
isMutable,
xmlDoc,
accessibility,
synExpr,
_,
_) ->
match synExpr with
| Some _ -> failwith "literal members are not supported"
| None -> ()
let attrs = attrs |> List.collect _.Attributes
let args, ret = getType synType
let args =
args
|> List.map (fun (args, hasParen) ->
match args with
| SynType.Tuple (false, path, _) -> extractTupledTypes path
| SynType.SignatureParameter _ ->
let arg, hasParen = convertSigParam args
{
HasParen = hasParen
Args = [ arg ]
}
| SynType.LongIdent (SynLongIdent (ident, _, _)) ->
{
HasParen = false
Args =
{
Attributes = []
IsOptional = false
Id = None
Type = SynType.createLongIdent ident
}
|> List.singleton
}
| SynType.Var (typar, _) ->
{
HasParen = false
Args =
{
Attributes = []
IsOptional = false
Id = None
Type = SynType.var typar
}
|> List.singleton
}
| arg ->
{
HasParen = false
Args =
{
Attributes = []
IsOptional = false
Id = None
Type = arg
}
|> List.singleton
}
|> fun ty ->
{ ty with
HasParen = ty.HasParen || hasParen
}
)
match propertyAccessors with
| None ->
{
ReturnType = ret
Args = args
Identifier = ident
Attributes = attrs
XmlDoc = Some xmlDoc
Accessibility = accessibility
IsInline = isInline
IsMutable = isMutable
}
|> Choice1Of2
| Some accessors ->
{
Type = ret
Accessibility = accessibility
Attributes = attrs
XmlDoc = Some xmlDoc
Accessors = accessors
IsInline = isInline
Identifier = ident
}
|> Choice2Of2
/// Assumes that the input type is an ObjectModel, i.e. a `type Foo = member ...` /// Assumes that the input type is an ObjectModel, i.e. a `type Foo = member ...`
let parseInterface (interfaceType : SynTypeDefn) : InterfaceType = let parseInterface (interfaceType : SynTypeDefn) : InterfaceType =
let (SynTypeDefn (SynComponentInfo (attrs, typars, _, interfaceName, _, _, accessibility, _), let (SynTypeDefn (SynComponentInfo (attrs, typars, _, interfaceName, _, _, accessibility, _),
@@ -261,98 +236,270 @@ module internal AstHelper =
let attrs = attrs |> List.collect (fun s -> s.Attributes) let attrs = attrs |> List.collect (fun s -> s.Attributes)
let members, inherits = let members =
match synTypeDefnRepr with match synTypeDefnRepr with
| SynTypeDefnRepr.ObjectModel (_kind, members, _) -> | SynTypeDefnRepr.ObjectModel (_kind, members, _) ->
members members
|> List.map (fun defn -> |> List.map (fun defn ->
match defn with match defn with
| SynMemberDefn.AbstractSlot (slotSig, flags, _, _) -> Choice1Of2 (parseMember slotSig flags) | SynMemberDefn.AbstractSlot (slotSig, flags, _, _) ->
| SynMemberDefn.Inherit (baseType, _asIdent, _) -> Choice2Of2 baseType match flags.MemberKind with
| SynMemberKind.Member -> ()
| kind -> failwithf "Unrecognised member kind: %+A" kind
if not flags.IsInstance then
failwith "member was not an instance member"
match slotSig with
| SynValSig (attrs,
SynIdent.SynIdent (ident, _),
_typeParams,
synType,
arity,
isInline,
isMutable,
xmlDoc,
accessibility,
synExpr,
_,
_) ->
match synExpr with
| Some _ -> failwith "literal members are not supported"
| None -> ()
let attrs = attrs |> List.collect (fun attr -> attr.Attributes)
let args, ret = getType synType
let args =
args
|> List.map (fun (args, hasParen) ->
match args with
| SynType.Tuple (false, path, _) -> extractTupledTypes path
| SynType.SignatureParameter _ ->
let arg, hasParen = convertSigParam args
{
HasParen = hasParen
Args = [ arg ]
}
| SynType.LongIdent (SynLongIdent (ident, _, _)) ->
{
HasParen = false
Args =
{
Attributes = []
IsOptional = false
Id = None
Type =
SynType.CreateLongIdent (
SynLongIdent.CreateFromLongIdent ident
)
}
|> List.singleton
}
| SynType.Var (typar, _) ->
{
HasParen = false
Args =
{
Attributes = []
IsOptional = false
Id = None
Type = SynType.Var (typar, range0)
}
|> List.singleton
}
| _ -> failwith $"Unrecognised args in interface method declaration: %+A{args}"
|> fun ty ->
{ ty with
HasParen = ty.HasParen || hasParen
}
)
{
ReturnType = ret
Args = args
Identifier = ident
Attributes = attrs
XmlDoc = Some xmlDoc
Accessibility = accessibility
IsInline = isInline
IsMutable = isMutable
}
| _ -> failwith $"Unrecognised member definition: %+A{defn}" | _ -> failwith $"Unrecognised member definition: %+A{defn}"
) )
| _ -> failwith $"Unrecognised SynTypeDefnRepr for an interface type: %+A{synTypeDefnRepr}" | _ -> failwith $"Unrecognised SynTypeDefnRepr for an interface type: %+A{synTypeDefnRepr}"
|> List.partitionChoice
let members, properties = members |> List.partitionChoice
{ {
Members = members Members = members
Properties = properties
Name = interfaceName Name = interfaceName
Inherits = inherits
Attributes = attrs Attributes = attrs
Generics = typars Generics = typars
Accessibility = accessibility Accessibility = accessibility
} }
let getUnionCases
(SynTypeDefn.SynTypeDefn (info, repr, _, _, _, _))
: AdtProduct list * SynTyparDecl list * SynAccess option
=
let typars, access =
match info with
| SynComponentInfo (_, typars, _, _, _, _, access, _) -> typars, access
let typars = [<AutoOpen>]
match typars with module internal SynTypePatterns =
| None -> [] let (|OptionType|_|) (fieldType : SynType) =
| Some (SynTyparDecls.PrefixList (decls, _)) -> decls match fieldType with
| Some (SynTyparDecls.SinglePrefix (l, _)) -> [ l ] | SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when AstHelper.isOptionIdent ident ->
| Some (SynTyparDecls.PostfixList (decls, constraints, _)) -> Some innerType
if not constraints.IsEmpty then | _ -> None
failwith "Constrained type parameters not currently supported"
decls let (|ListType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when AstHelper.isListIdent ident ->
Some innerType
| _ -> None
match repr with let (|ArrayType|_|) (fieldType : SynType) =
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (_, cases, _), _) -> match fieldType with
let cases = | SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when AstHelper.isArrayIdent ident ->
cases Some innerType
|> List.map (fun (SynUnionCase.SynUnionCase (_, ident, kind, _, _, _, _)) -> | SynType.Array (1, innerType, _) -> Some innerType
match kind with | _ -> None
| SynUnionCaseKind.FullType _ -> failwith "FullType union cases not supported"
| SynUnionCaseKind.Fields fields ->
{
Name = ident
Fields =
fields
|> List.map (fun (SynField.SynField (_, _, id, ty, _, _, _, _, _)) ->
{
Type = ty
Name = id
GenericsOfParent = typars
}
)
Generics = typars
}
)
cases, typars, access let (|RestEaseResponseType|_|) (fieldType : SynType) =
| _ -> failwithf "Failed to get union cases for type that was: %+A" repr match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when AstHelper.isArrayIdent ident ->
Some innerType
| SynType.Array (1, innerType, _) -> Some innerType
| _ -> None
let getRecordFields (SynTypeDefn.SynTypeDefn (typeInfo, repr, _, _, _, _)) : AdtNode list = let (|DictionaryType|_|) (fieldType : SynType) =
let (SynComponentInfo.SynComponentInfo (typeParams = typars)) = typeInfo match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when AstHelper.isDictionaryIdent ident ->
Some (key, value)
| _ -> None
let typars = let (|IDictionaryType|_|) (fieldType : SynType) =
match typars with match fieldType with
| None -> [] | SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when AstHelper.isIDictionaryIdent ident ->
| Some (SynTyparDecls.PrefixList (decls, _)) -> decls Some (key, value)
| Some (SynTyparDecls.SinglePrefix (l, _)) -> [ l ] | _ -> None
| Some (SynTyparDecls.PostfixList (decls, constraints, _)) ->
if not constraints.IsEmpty then
failwith "Constrained type parameters not currently supported"
decls let (|IReadOnlyDictionaryType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when
AstHelper.isReadOnlyDictionaryIdent ident
->
Some (key, value)
| _ -> None
match repr with let (|MapType|_|) (fieldType : SynType) =
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_, fields, _), _) -> match fieldType with
fields | SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when AstHelper.isMapIdent ident ->
|> List.map (fun (SynField.SynField (_, _, ident, ty, _, _, _, _, _)) -> Some (key, value)
{ | _ -> None
Name = ident
Type = ty /// Returns the string name of the type.
GenericsOfParent = typars let (|PrimitiveType|_|) (fieldType : SynType) =
} match fieldType with
) | SynType.LongIdent ident ->
| _ -> failwithf "Failed to get record elements for type that was: %+A" repr match ident.LongIdent with
| [ i ] -> [ "string" ; "float" ; "int" ; "bool" ] |> List.tryFind (fun s -> s = i.idText)
| _ -> None
| _ -> None
let (|String|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent with
| [ i ] ->
[ "string" ]
|> List.tryFind (fun s -> s = i.idText)
|> Option.map ignore<string>
| _ -> None
| _ -> None
let (|Byte|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent with
| [ i ] -> [ "byte" ] |> List.tryFind (fun s -> s = i.idText) |> Option.map ignore<string>
| _ -> None
| _ -> None
let (|HttpResponseMessage|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent |> List.map (fun i -> i.idText) with
| [ "System" ; "Net" ; "Http" ; "HttpResponseMessage" ]
| [ "Net" ; "Http" ; "HttpResponseMessage" ]
| [ "Http" ; "HttpResponseMessage" ]
| [ "HttpResponseMessage" ] -> Some ()
| _ -> None
| _ -> None
let (|HttpContent|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent |> List.map (fun i -> i.idText) with
| [ "System" ; "Net" ; "Http" ; "HttpContent" ]
| [ "Net" ; "Http" ; "HttpContent" ]
| [ "Http" ; "HttpContent" ]
| [ "HttpContent" ] -> Some ()
| _ -> None
| _ -> None
let (|Stream|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent |> List.map (fun i -> i.idText) with
| [ "System" ; "IO" ; "Stream" ]
| [ "IO" ; "Stream" ]
| [ "Stream" ] -> Some ()
| _ -> None
| _ -> None
let (|NumberType|_|) (fieldType : SynType) =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent with
| [ i ] -> [ "string" ; "float" ; "int" ; "bool" ] |> List.tryFind (fun s -> s = i.idText)
| _ -> None
| _ -> None
let (|DateOnly|_|) (fieldType : SynType) =
match fieldType with
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
match ident |> List.map (fun i -> i.idText) with
| [ "System" ; "DateOnly" ]
| [ "DateOnly" ] -> Some ()
| _ -> None
| _ -> None
let (|DateTime|_|) (fieldType : SynType) =
match fieldType with
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
match ident |> List.map (fun i -> i.idText) with
| [ "System" ; "DateTime" ]
| [ "DateTime" ] -> Some ()
| _ -> None
| _ -> None
let (|Uri|_|) (fieldType : SynType) =
match fieldType with
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
match ident |> List.map (fun i -> i.idText) with
| [ "System" ; "Uri" ]
| [ "Uri" ] -> Some ()
| _ -> None
| _ -> None
let (|Task|_|) (fieldType : SynType) : SynType option =
match fieldType with
| SynType.App (SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)), _, args, _, _, _, _) ->
match ident |> List.map (fun i -> i.idText) with
| [ "Task" ]
| [ "Tasks" ; "Task" ]
| [ "Threading" ; "Tasks" ; "Task" ]
| [ "System" ; "Threading" ; "Tasks" ; "Task" ] ->
match args with
| [ arg ] -> Some arg
| _ -> failwithf "Expected Task to be applied to exactly one arg, but got: %+A" args
| _ -> None
| _ -> None

View File

@@ -1,677 +0,0 @@
namespace WoofWare.Myriad.Plugins
open System
open Fantomas.FCS.Syntax
open Fantomas.FCS.Xml
open WoofWare.Whippet.Fantomas
type internal CapturingInterfaceMockOutputSpec =
{
IsInternal : bool
}
type private CallField =
| ArgsObject of Ident * SynTypeDefn * SynTyparDecls option
| Original of SynType
[<RequireQualifiedAccess>]
module internal CapturingInterfaceMockGenerator =
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
type private KnownInheritance = | IDisposable
/// Expects the input `args` list to have more than one element.
let private createTypeForArgs
(spec : CapturingInterfaceMockOutputSpec)
(memberName : Ident)
(generics : SynTyparDecls option)
(args : TupledArg list)
: Ident * SynTypeDefn
=
let name = memberName.idText + "Call" |> Ident.create
let access =
if spec.IsInternal then
SynAccess.Internal range0
else
SynAccess.Public range0
let recordFields =
args
|> List.mapi (fun i tupledArg ->
{
SynFieldData.Ident =
match tupledArg.Args with
| [ arg ] -> arg.Id
| _ -> None
|> Option.defaultValue (Ident.create $"Arg%i{i}")
|> Some
Attrs = []
Type =
tupledArg.Args
|> List.map (fun pi ->
if pi.IsOptional then
pi.Type |> SynType.appPostfix "option"
else
pi.Type
)
|> SynType.tupleNoParen
|> Option.get
}
|> SynField.make
)
let record =
{
Name = name
Fields = recordFields
Members = None
XmlDoc = Some (PreXmlDoc.create $"A single call to the %s{memberName.idText} method")
Generics = generics
TypeAccessibility = Some access
ImplAccessibility = None
Attributes = []
}
let typeDecl = AstHelper.defineRecordType record
name, typeDecl
let private buildType (x : ParameterInfo) : SynType =
if x.IsOptional then
SynType.appPostfix "option" x.Type
else
x.Type
let private constructMemberSinglePlace (tuple : TupledArg) : SynType =
tuple.Args
|> List.map buildType
|> SynType.tupleNoParen
|> Option.defaultWith (fun () -> failwith "no-arg functions not supported yet")
|> if tuple.HasParen then SynType.paren else id
let rec private collectGenerics' (ty : SynType) : Ident list =
match ty with
| SynType.Var (typar = SynTypar (ident = typar)) -> [ typar ]
| SynType.HashConstraint (innerType = ty)
| SynType.WithGlobalConstraints (typeName = ty)
| SynType.Paren (innerType = ty)
| SynType.MeasurePower (baseMeasure = ty)
| SynType.SignatureParameter (usedType = ty)
| SynType.Array (elementType = ty) -> collectGenerics' ty
| SynType.StaticConstant _
| SynType.StaticConstantNamed _
| SynType.StaticConstantExpr _
| SynType.FromParseError _
| SynType.Anon _
| SynType.LongIdent _ -> []
| SynType.LongIdentApp (typeArgs = tys)
| SynType.App (typeArgs = tys) -> tys |> List.collect collectGenerics'
| SynType.Tuple (path = path) ->
path
|> List.collect (fun seg ->
match seg with
| SynTupleTypeSegment.Type ty -> collectGenerics' ty
| SynTupleTypeSegment.Star _
| SynTupleTypeSegment.Slash _ -> []
)
| SynType.AnonRecd (fields = fields) -> fields |> List.collect (fun (_, ty) -> collectGenerics' ty)
| SynType.Fun (argType = t1 ; returnType = t2)
| SynType.Or (lhsType = t1 ; rhsType = t2) -> collectGenerics' t1 @ collectGenerics' t2
let private collectGenerics (ty : SynType) =
collectGenerics' ty |> List.distinctBy _.idText
/// Builds the record field for the mock object, and also if applicable a type representing a single call to
/// that object (packaging up the args of the call).
let private constructMember (spec : CapturingInterfaceMockOutputSpec) (mem : MemberInfo) : SynField * CallField =
let inputType = mem.Args |> List.map constructMemberSinglePlace
let funcType = SynType.toFun inputType mem.ReturnType
let field =
{
Type = funcType
Attrs = []
Ident = Some mem.Identifier
}
|> SynField.make
|> SynField.withDocString (mem.XmlDoc |> Option.defaultValue PreXmlDoc.Empty)
let argsType =
match mem.Args with
| [] -> failwith "expected args in member"
| [ ty ] ->
ty.Args
|> List.map (fun pi ->
if pi.IsOptional then
SynType.appPostfix "option" pi.Type
else
pi.Type
)
|> SynType.tupleNoParen
|> Option.get
|> CallField.Original
| args ->
let genericsUsed =
args
|> List.collect (fun arg -> arg.Args |> List.map _.Type |> List.collect collectGenerics)
|> List.distinctBy _.idText
let genericsUsed =
match genericsUsed with
| [] -> None
| genericsUsed ->
genericsUsed
|> List.map (fun i ->
SynTyparDecl.SynTyparDecl ([], SynTypar.SynTypar (i, TyparStaticReq.None, false))
)
|> fun l -> SynTyparDecls.PostfixList (l, [], range0)
|> Some
let name, defn = createTypeForArgs spec mem.Identifier genericsUsed args
CallField.ArgsObject (name, defn, genericsUsed)
field, argsType
let constructProperty (prop : PropertyInfo) : SynField =
{
Attrs = []
Ident = Some prop.Identifier
Type = SynType.toFun [ SynType.unit ] prop.Type
}
|> SynField.make
|> SynField.withDocString (prop.XmlDoc |> Option.defaultValue PreXmlDoc.Empty)
let createType
(spec : CapturingInterfaceMockOutputSpec)
(name : string)
(interfaceType : InterfaceType)
(xmlDoc : PreXmlDoc)
: SynModuleDecl option * SynModuleDecl
=
let fields =
interfaceType.Members
|> List.map (constructMember spec)
|> List.append (
interfaceType.Properties
|> List.map constructProperty
|> List.map (Tuple.withRight (CallField.Original SynType.unit))
)
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
// TODO: for each field, if there are multiple arguments to the member, stamp out a new type to represent them;
// then store that type name in this list alongside the field name
let fields =
fields
|> List.map (fun (SynField (idOpt = idOpt) as f, extraType) ->
let fieldName =
match idOpt with
| None -> failwith $"unexpectedly got a field with no identifier: %O{f}"
| Some idOpt -> idOpt.idText
fieldName, (f, extraType)
)
|> Map.ofList
let failwithNotImplemented (fieldName : string) =
let failString = SynExpr.CreateConst $"Unimplemented mock function: %s{fieldName}"
SynExpr.createLongIdent [ "System" ; "NotImplementedException" ]
|> SynExpr.applyTo failString
|> SynExpr.paren
|> SynExpr.applyFunction (SynExpr.createIdent "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)
SynType.app name generics
let emptyRecordFieldInstantiations =
let interfaceExtras =
if inherits.Contains KnownInheritance.IDisposable then
let unitFun = SynExpr.createThunk (SynExpr.CreateConst ())
[ SynLongIdent.createS "Dispose", unitFun ]
else
[]
let originalMembers =
fields
|> Map.toList
|> List.map (fun (fieldName, _) -> SynLongIdent.createS fieldName, failwithNotImplemented fieldName)
let callsObject =
SynLongIdent.createS "Calls",
SynExpr.applyFunction
(SynExpr.createLongIdent [ $"%s{name}Calls" ; "Calls" ; "Empty" ])
(SynExpr.CreateConst ())
callsObject :: interfaceExtras @ originalMembers
let staticMemberEmpty =
SynBinding.basic
[ Ident.create "Empty" ]
[ SynPat.unit ]
(SynExpr.createRecord None emptyRecordFieldInstantiations)
|> SynBinding.withXmlDoc (PreXmlDoc.create "An implementation where every non-unit method throws.")
|> SynBinding.withReturnAnnotation constructorReturnType
|> SynMemberDefn.staticMember
let recordFields =
let extras =
if inherits.Contains KnownInheritance.IDisposable then
{
Attrs = []
Ident = Some (Ident.create "Dispose")
Type = SynType.funFromDomain SynType.unit SynType.unit
}
|> SynField.make
|> SynField.withDocString (PreXmlDoc.create "Implementation of IDisposable.Dispose")
|> List.singleton
else
[]
let nonExtras =
fields |> Map.toSeq |> Seq.map (fun (_, (field, _)) -> field) |> Seq.toList
let calls =
let ty =
match interfaceType.Generics with
| None -> SynType.createLongIdent' [ $"%s{name}Calls" ; "Calls" ]
| Some generics ->
generics.TyparDecls
|> List.map (fun (SynTyparDecl (_, typar)) -> SynType.var typar)
|> SynType.app' (SynType.createLongIdent' [ $"%s{name}Calls" ; "Calls" ])
{
Attrs = []
Ident = Ident.create "Calls" |> Some
Type = ty
}
|> SynField.make
calls :: extras @ nonExtras
let access =
match interfaceType.Accessibility, spec.IsInternal with
| Some (SynAccess.Public _), true
| None, true -> SynAccess.Internal range0
| Some (SynAccess.Public _), false -> SynAccess.Public range0
| None, false -> SynAccess.Public range0
| Some (SynAccess.Internal _), _ -> SynAccess.Internal range0
| Some (SynAccess.Private _), _ -> SynAccess.Private range0
let accessAtLeastInternal =
match access with
| SynAccess.Private _ -> SynAccess.Internal range0
| access -> access
let callsObject =
let fields' =
fields
|> Map.toSeq
|> Seq.map (fun (fieldName, (_, callType)) ->
match callType with
| CallField.Original ty ->
{
Attrs = []
Ident = Some (fieldName |> Ident.create)
Type = SynType.app "ResizeArray" [ ty ]
}
|> SynField.make
| CallField.ArgsObject (argsObjectName, _, generics) ->
{
Attrs = []
Ident = Some (fieldName |> Ident.create)
Type =
match generics with
| None -> SynType.named argsObjectName.idText
| Some generics ->
generics.TyparDecls
|> List.map (fun (SynTyparDecl.SynTyparDecl (_, typar)) -> SynType.var typar)
|> SynType.app' (SynType.createLongIdent' [ argsObjectName.idText ])
|> List.singleton
|> SynType.app "ResizeArray"
}
|> SynField.make
)
|> Seq.toList
let emptyMember =
let returnType =
match interfaceType.Generics with
| None -> SynType.named "Calls"
| Some generics ->
let generics =
match generics with
| SynTyparDecls.PostfixList (decls = decls)
| SynTyparDecls.PrefixList (decls = decls) -> decls
| SynTyparDecls.SinglePrefix (decl = decl) -> [ decl ]
|> List.map (fun (SynTyparDecl.SynTyparDecl (_, typar)) -> SynType.var typar)
SynType.app "Calls" generics
fields
|> Map.toSeq
|> Seq.map (fun (name, _) ->
SynLongIdent.createS name,
SynExpr.applyFunction (SynExpr.createIdent "ResizeArray") (SynExpr.CreateConst ())
)
|> Seq.toList
|> SynExpr.createRecord None
|> SynBinding.basic [ Ident.create "Empty" ] [ SynPat.unit ]
|> SynBinding.withXmlDoc (PreXmlDoc.create "A fresh calls object which has not yet had any calls made.")
|> SynBinding.withReturnAnnotation returnType
|> SynMemberDefn.staticMember
{
RecordType.Name = Ident.create "Calls"
Fields = fields'
Members = Some [ emptyMember ]
XmlDoc = PreXmlDoc.create $"All the calls made to a %s{name} mock" |> Some
Generics = interfaceType.Generics
TypeAccessibility = Some accessAtLeastInternal
ImplAccessibility = None
Attributes = [ SynAttribute.requireQualifiedAccess ]
}
|> AstHelper.defineRecordType
let interfaceMembers =
let members =
interfaceType.Members
|> List.map (fun memberInfo ->
let headArgs =
memberInfo.Args
|> List.mapi (fun i tupledArgs ->
let args =
tupledArgs.Args
|> List.mapi (fun j ty ->
match ty.Type with
| UnitType -> SynPat.unit
| _ -> SynPat.named $"arg_%i{i}_%i{j}"
)
match args with
| [] -> failwith "somehow got no args at all"
| [ arg ] -> arg
| args -> SynPat.tuple args
|> fun i -> if tupledArgs.HasParen then SynPat.paren i else i
)
let body, addToCalls =
let tupleContents =
memberInfo.Args
|> List.mapi (fun i args ->
args.Args
|> List.mapi (fun j arg ->
match arg.Type with
| UnitType -> SynExpr.CreateConst (), arg.Id
| _ -> SynExpr.createIdent $"arg_%i{i}_%i{j}", arg.Id
)
)
let tuples = tupleContents |> List.map (List.map fst >> SynExpr.tuple)
match tuples |> List.rev with
| [] -> failwith "expected args but got none"
| last :: rest ->
let tuples = (last, rest) ||> List.fold SynExpr.applyTo
let body =
tuples
|> SynExpr.applyFunction (
SynExpr.createLongIdent' [ Ident.create "this" ; memberInfo.Identifier ]
)
let addToCalls =
match Map.tryFind memberInfo.Identifier.idText fields with
| None ->
failwith
$"unexpectedly looking up a nonexistent field %s{memberInfo.Identifier.idText}"
| Some (_, result) ->
match result with
| CallField.Original _ -> tuples
| CallField.ArgsObject _ ->
tupleContents
|> List.mapi (fun i fields ->
match fields with
| [ contents, Some ident ] -> SynLongIdent.create [ ident ], contents
| [ contents, None ] -> SynLongIdent.createS $"Arg%i{i}", contents
| _ ->
SynLongIdent.createS $"Arg%i{i}",
SynExpr.tupleNoParen (fields |> List.map fst)
)
|> SynExpr.createRecord None
|> SynExpr.applyFunction (
SynExpr.createLongIdent [ "this" ; "Calls" ; memberInfo.Identifier.idText ; "Add" ]
)
|> SynExpr.createLambda "_"
|> SynExpr.applyFunction (
SynExpr.createIdent "lock"
|> SynExpr.applyTo (
SynExpr.createLongIdent [ "this" ; "Calls" ; memberInfo.Identifier.idText ]
)
)
body, addToCalls
let body = [ addToCalls ; body ] |> SynExpr.sequential
SynBinding.basic [ Ident.create "this" ; memberInfo.Identifier ] headArgs body
|> SynMemberDefn.memberImplementation
)
let properties =
interfaceType.Properties
|> List.map (fun pi ->
SynExpr.createLongIdent' [ Ident.create "this" ; pi.Identifier ]
|> SynExpr.applyTo (SynExpr.CreateConst ())
|> SynBinding.basic [ Ident.create "this" ; pi.Identifier ] []
|> SynMemberDefn.memberImplementation
)
let interfaceName =
let baseName = SynType.createLongIdent interfaceType.Name
match interfaceType.Generics with
| None -> baseName
| Some generics ->
let generics =
match generics with
| SynTyparDecls.PostfixList (decls, _, _) -> decls
| SynTyparDecls.PrefixList (decls, _) -> decls
| SynTyparDecls.SinglePrefix (decl, _) -> [ decl ]
|> List.map (fun (SynTyparDecl (_, typar)) -> SynType.var typar)
SynType.app' baseName generics
SynMemberDefn.Interface (interfaceName, Some range0, Some (members @ properties), range0)
let extraInterfaces =
inherits
|> Seq.map (fun inheritance ->
match inheritance with
| KnownInheritance.IDisposable ->
let mem =
SynExpr.createLongIdent [ "this" ; "Dispose" ]
|> SynExpr.applyTo (SynExpr.CreateConst ())
|> SynBinding.basic [ Ident.create "this" ; Ident.create "Dispose" ] [ SynPat.unit ]
|> SynBinding.withReturnAnnotation SynType.unit
|> SynMemberDefn.memberImplementation
SynMemberDefn.Interface (
SynType.createLongIdent' [ "System" ; "IDisposable" ],
Some range0,
Some [ mem ],
range0
)
)
|> Seq.toList
let record =
{
Name = Ident.create name
Fields = recordFields
Members = Some ([ staticMemberEmpty ; interfaceMembers ] @ extraInterfaces)
XmlDoc = Some xmlDoc
Generics = interfaceType.Generics
TypeAccessibility = Some access
ImplAccessibility = None
Attributes = []
}
let typeDecl = AstHelper.defineRecordType record
let callsModule =
let types =
fields
|> Map.toSeq
|> Seq.choose (fun (_, (_, field)) ->
match field with
| CallField.Original _ -> None
| CallField.ArgsObject (_, callType, _) -> Some (SynModuleDecl.Types ([ callType ], range0))
)
|> Seq.toList
types @ [ SynModuleDecl.Types ([ callsObject ], range0) ]
|> SynModuleDecl.nestedModule (
SynComponentInfo.create (Ident.create $"%s{name}Calls")
|> SynComponentInfo.withAccessibility accessAtLeastInternal
|> SynComponentInfo.addAttributes [ SynAttribute.requireQualifiedAccess ]
)
|> Some
(callsModule, SynModuleDecl.Types ([ typeDecl ], range0))
let createRecord
(namespaceId : LongIdent)
(opens : SynOpenDeclTarget list)
(interfaceType : SynTypeDefn, spec : CapturingInterfaceMockOutputSpec)
: SynModuleOrNamespace
=
let interfaceType = AstHelper.parseInterface interfaceType
let docString = PreXmlDoc.create "Mock record type for an interface"
let name =
List.last interfaceType.Name
|> _.idText
|> fun s ->
if s.StartsWith 'I' && s.Length > 1 && Char.IsUpper s.[1] then
s.Substring 1
else
s
|> fun s -> s + "Mock"
let callsTypes, typeDecl = createType spec name interfaceType docString
[
yield! opens |> List.map SynModuleDecl.openAny
match callsTypes with
| None -> ()
| Some c -> yield c
yield typeDecl
]
|> SynModuleOrNamespace.createNamespace namespaceId
open Myriad.Core
/// Myriad generator that creates a record which implements the given interface,
/// but with every field mocked out.
[<MyriadGenerator("capturing-interface-mock")>]
type CapturingInterfaceMockGenerator () =
interface IMyriadGenerator with
member _.ValidInputExtensions = [ ".fs" ]
member _.Generate (context : GeneratorContext) =
let targetedTypes =
MyriadParamParser.render context.AdditionalParameters
|> Map.map (fun _ v -> v.Split '!' |> Array.toList |> List.map DesiredGenerator.Parse)
let ast, _ =
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
let types = Ast.getTypes ast
let namespaceAndInterfaces =
types
|> List.choose (fun (ns, types) ->
types
|> List.choose (fun typeDef ->
match SynTypeDefn.getAttribute typeof<GenerateCapturingMockAttribute>.Name typeDef with
| None ->
let name = SynTypeDefn.getName typeDef |> List.map _.idText |> String.concat "."
match Map.tryFind name targetedTypes with
| Some desired ->
desired
|> List.tryPick (fun generator ->
match generator with
| DesiredGenerator.CapturingInterfaceMock arg ->
let spec =
{
IsInternal =
arg
|> Option.defaultValue
GenerateCapturingMockAttribute.DefaultIsInternal
}
Some (typeDef, spec)
| _ -> None
)
| _ -> None
| Some attr ->
let arg =
match SynExpr.stripOptionalParen attr.ArgExpr with
| SynExpr.Const (SynConst.Bool value, _) -> value
| SynExpr.Const (SynConst.Unit, _) -> GenerateCapturingMockAttribute.DefaultIsInternal
| arg ->
failwith
$"Unrecognised argument %+A{arg} to [<%s{nameof GenerateCapturingMockAttribute}>]. Literals are not supported. Use `true` or `false` (or unit) only."
let spec =
{
IsInternal = arg
}
Some (typeDef, spec)
)
|> function
| [] -> None
| ty -> Some (ns, ty)
)
let opens = AstHelper.extractOpens ast
let modules =
namespaceAndInterfaces
|> List.collect (fun (ns, records) ->
records |> List.map (CapturingInterfaceMockGenerator.createRecord ns opens)
)
Output.Ast modules

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -1,66 +0,0 @@
namespace WoofWare.Myriad.Plugins
open System
/// An HTTP method. This is System.Net.Http.HttpMethod, but
/// a proper discriminated union.
type HttpMethod =
/// HTTP Get
| Get
/// HTTP Post
| Post
/// HTTP Delete
| Delete
/// HTTP Patch
| Patch
/// HTTP Options
| Options
/// HTTP Head
| Head
/// HTTP Put
| Put
/// HTTP Trace
| Trace
/// Convert to the standard library's enum type.
member this.ToDotNet () : System.Net.Http.HttpMethod =
match this with
| HttpMethod.Get -> System.Net.Http.HttpMethod.Get
| HttpMethod.Post -> System.Net.Http.HttpMethod.Post
| HttpMethod.Delete -> System.Net.Http.HttpMethod.Delete
| HttpMethod.Patch -> System.Net.Http.HttpMethod.Patch
| HttpMethod.Options -> System.Net.Http.HttpMethod.Options
| HttpMethod.Head -> System.Net.Http.HttpMethod.Head
| HttpMethod.Put -> System.Net.Http.HttpMethod.Put
| HttpMethod.Trace -> System.Net.Http.HttpMethod.Trace
/// Human-readable string representation.
override this.ToString () : string =
match this with
| HttpMethod.Get -> "Get"
| HttpMethod.Post -> "Post"
| HttpMethod.Delete -> "Delete"
| HttpMethod.Patch -> "Patch"
| HttpMethod.Options -> "Options"
| HttpMethod.Head -> "Head"
| HttpMethod.Put -> "Put"
| HttpMethod.Trace -> "Trace"
/// Throws on invalid inputs.
static member Parse (s : string) : HttpMethod =
if String.Equals (s, "get", StringComparison.OrdinalIgnoreCase) then
HttpMethod.Get
elif String.Equals (s, "post", StringComparison.OrdinalIgnoreCase) then
HttpMethod.Post
elif String.Equals (s, "patch", StringComparison.OrdinalIgnoreCase) then
HttpMethod.Patch
elif String.Equals (s, "delete", StringComparison.OrdinalIgnoreCase) then
HttpMethod.Delete
elif String.Equals (s, "head", StringComparison.OrdinalIgnoreCase) then
HttpMethod.Head
elif String.Equals (s, "options", StringComparison.OrdinalIgnoreCase) then
HttpMethod.Options
elif String.Equals (s, "put", StringComparison.OrdinalIgnoreCase) then
HttpMethod.Put
else
failwith $"Unrecognised method: %s{s}"

View File

@@ -2,134 +2,186 @@ namespace WoofWare.Myriad.Plugins
open System open System
open Fantomas.FCS.Syntax open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Xml open Fantomas.FCS.Xml
open WoofWare.Whippet.Fantomas open Myriad.Core
type internal GenerateMockOutputSpec = /// Attribute indicating an interface type for which the "Generate Mock" Myriad
{ /// generator should apply during build.
IsInternal : bool /// This generator creates a record which implements the interface,
} /// but where each method is represented as a record field, so you can use
/// record update syntax to easily specify partially-implemented mock objects.
type GenerateMockAttribute () =
inherit Attribute ()
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module internal InterfaceMockGenerator = module internal InterfaceMockGenerator =
open Fantomas.FCS.Text.Range open Fantomas.FCS.Text.Range
open Myriad.Core.Ast
let private getName (SynField (_, _, id, _, _, _, _, _, _)) = let private getName (SynField (_, _, id, _, _, _, _, _, _)) =
match id with match id with
| None -> failwith "Expected record field to have a name, but it was somehow anonymous" | None -> failwith "Expected record field to have a name, but it was somehow anonymous"
| Some id -> id | Some id -> id
[<RequireQualifiedAccess>]
type private KnownInheritance = | IDisposable
let createType let createType
(spec : GenerateMockOutputSpec)
(name : string) (name : string)
(interfaceType : InterfaceType) (interfaceType : InterfaceType)
(xmlDoc : PreXmlDoc) (xmlDoc : PreXmlDoc)
(fields : SynField list) (fields : SynField list)
: SynModuleDecl : SynModuleDecl
= =
let inherits = let synValData =
interfaceType.Inherits {
|> Seq.map (fun ty -> SynMemberFlags.IsInstance = false
match ty with SynMemberFlags.IsDispatchSlot = false
| SynType.LongIdent (SynLongIdent.SynLongIdent (name, _, _)) -> SynMemberFlags.IsOverrideOrExplicitImpl = false
match name |> List.map _.idText with SynMemberFlags.IsFinal = false
| [] -> failwith "Unexpected empty identifier in inheritance declaration" SynMemberFlags.GetterOrSetterIsCompilerGenerated = false
| [ "IDisposable" ] SynMemberFlags.MemberKind = SynMemberKind.Member
| [ "System" ; "IDisposable" ] -> KnownInheritance.IDisposable }
| _ -> failwithf "Unrecognised inheritance identifier: %+A" name
| x -> failwithf "Unrecognised type in inheritance: %+A" x 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
) )
|> Set.ofSeq
let failwithFun (SynField (_, _, idOpt, _, _, _, _, _, _)) =
let failString =
match idOpt with
| None -> SynExpr.CreateConst "Unimplemented mock function"
| Some ident -> SynExpr.CreateConst $"Unimplemented mock function: %s{ident.idText}"
SynExpr.createLongIdent [ "System" ; "NotImplementedException" ]
|> SynExpr.applyTo failString
|> SynExpr.paren
|> SynExpr.applyFunction (SynExpr.createIdent "raise")
|> SynExpr.createLambda "_"
let constructorReturnType = let constructorReturnType =
match interfaceType.Generics with match interfaceType.Generics with
| None -> SynType.createLongIdent' [ name ] | None -> SynType.CreateLongIdent name
| Some generics -> | Some generics ->
let generics =
generics.TyparDecls
|> List.map (fun (SynTyparDecl (_, typar)) -> SynType.Var (typar, range0))
let generics = SynType.App (
generics.TyparDecls SynType.CreateLongIdent name,
|> List.map (fun (SynTyparDecl (_, typar)) -> SynType.var typar) Some range0,
generics,
SynType.app name generics List.replicate (generics.Length - 1) range0,
Some range0,
let constructorFields = false,
let extras = range0
if inherits.Contains KnownInheritance.IDisposable then )
let unitFun = SynExpr.createThunk (SynExpr.CreateConst ()) |> SynBindingReturnInfo.Create
[ SynLongIdent.createS "Dispose", unitFun ]
else
[]
let nonExtras =
fields
|> List.map (fun field -> SynLongIdent.createI (getName field), failwithFun field)
extras @ nonExtras
let constructor = let constructor =
SynBinding.basic SynMemberDefn.Member (
[ Ident.create "Empty" ] SynBinding.SynBinding (
(if interfaceType.Generics.IsNone then None,
[] SynBindingKind.Normal,
else false,
[ SynPat.unit ]) false,
(SynExpr.createRecord None constructorFields) [],
|> SynBinding.withXmlDoc (PreXmlDoc.create "An implementation where every method throws.") PreXmlDoc.Empty,
|> SynBinding.withReturnAnnotation constructorReturnType SynValData.SynValData (Some synValData, SynValInfo.Empty, None),
|> SynMemberDefn.staticMember constructorIdent,
Some constructorReturnType,
let fields = AstHelper.instantiateRecord (
let extras = fields
if inherits.Contains KnownInheritance.IDisposable then |> List.map (fun field ->
{ ((SynLongIdent.CreateFromLongIdent [ getName field ], true), Some failwithFun)
Attrs = [] )
Ident = Some (Ident.create "Dispose") ),
Type = SynType.funFromDomain SynType.unit SynType.unit range0,
DebugPointAtBinding.Yes range0,
{ SynExpr.synBindingTriviaZero true with
LeadingKeyword = SynLeadingKeyword.StaticMember (range0, range0)
} }
|> SynField.make ),
|> SynField.withDocString (PreXmlDoc.create "Implementation of IDisposable.Dispose") range0
|> List.singleton )
else
[]
extras @ fields
let interfaceMembers = let interfaceMembers =
let members = let members =
interfaceType.Members interfaceType.Members
|> List.map (fun memberInfo -> |> List.map (fun memberInfo ->
let synValData =
SynValData.SynValData (
Some
{
IsInstance = true
IsDispatchSlot = false
IsOverrideOrExplicitImpl = true
IsFinal = false
GetterOrSetterIsCompilerGenerated = false
MemberKind = SynMemberKind.Member
},
valInfo =
SynValInfo.SynValInfo (
curriedArgInfos =
[
yield
[
SynArgInfo.SynArgInfo (
attributes = [],
optional = false,
ident = None
)
]
yield!
memberInfo.Args
|> List.mapi (fun i arg ->
arg.Args
|> List.mapi (fun j arg ->
SynArgInfo.CreateIdString $"arg_%i{i}_%i{j}"
)
)
],
returnInfo =
SynArgInfo.SynArgInfo (attributes = [], optional = false, ident = None)
),
thisIdOpt = None
)
let headArgs = let headArgs =
memberInfo.Args memberInfo.Args
|> List.mapi (fun i tupledArgs -> |> List.mapi (fun i tupledArgs ->
let args = let args =
tupledArgs.Args tupledArgs.Args
|> List.mapi (fun j ty -> |> List.mapi (fun j _ -> SynPat.CreateNamed (Ident.Create $"arg_%i{i}_%i{j}"))
match ty.Type with
| UnitType -> SynPat.unit
| _ -> SynPat.named $"arg_%i{i}_%i{j}"
)
match args with SynPat.Tuple (false, args, List.replicate (args.Length - 1) range0, range0)
| [] -> failwith "somehow got no args at all" |> SynPat.CreateParen
| [ arg ] -> arg |> fun i -> if tupledArgs.HasParen then SynPat.Paren (i, range0) else i
| args -> SynPat.tuple args )
|> fun i -> if tupledArgs.HasParen then SynPat.paren i else i
let headPat =
SynPat.LongIdent (
SynLongIdent.CreateFromLongIdent [ Ident.Create "this" ; memberInfo.Identifier ],
None,
None,
SynArgPats.Pats headArgs,
None,
range0
) )
let body = let body =
@@ -137,12 +189,8 @@ module internal InterfaceMockGenerator =
memberInfo.Args memberInfo.Args
|> List.mapi (fun i args -> |> List.mapi (fun i args ->
args.Args args.Args
|> List.mapi (fun j arg -> |> List.mapi (fun j args -> SynExpr.CreateIdentString $"arg_%i{i}_%i{j}")
match arg.Type with |> SynExpr.CreateParenedTuple
| UnitType -> SynExpr.CreateConst ()
| _ -> SynExpr.createIdent $"arg_%i{i}_%i{j}"
)
|> SynExpr.tuple
) )
match tuples |> List.rev with match tuples |> List.rev with
@@ -150,26 +198,42 @@ module internal InterfaceMockGenerator =
| last :: rest -> | last :: rest ->
(last, rest) (last, rest)
||> List.fold SynExpr.applyTo ||> List.fold (fun trail next -> SynExpr.CreateApp (next, trail))
|> SynExpr.applyFunction ( |> fun args ->
SynExpr.createLongIdent' [ Ident.create "this" ; memberInfo.Identifier ] SynExpr.CreateApp (
) SynExpr.CreateLongIdent (
SynLongIdent.CreateFromLongIdent [ Ident.Create "this" ; memberInfo.Identifier ]
),
args
)
SynBinding.basic [ Ident.create "this" ; memberInfo.Identifier ] headArgs body SynMemberDefn.Member (
|> SynMemberDefn.memberImplementation SynBinding.SynBinding (
) None,
SynBindingKind.Normal,
let properties = false,
interfaceType.Properties false,
|> List.map (fun pi -> [],
SynExpr.createLongIdent' [ Ident.create "this" ; pi.Identifier ] PreXmlDoc.Empty,
|> SynExpr.applyTo (SynExpr.CreateConst ()) synValData,
|> SynBinding.basic [ Ident.create "this" ; pi.Identifier ] [] headPat,
|> SynMemberDefn.memberImplementation None,
body,
range0,
DebugPointAtBinding.Yes range0,
{
LeadingKeyword = SynLeadingKeyword.Member range0
InlineKeyword = None
EqualsRange = Some range0
}
),
range0
)
) )
let interfaceName = let interfaceName =
let baseName = SynType.createLongIdent interfaceType.Name let baseName =
SynType.CreateLongIdent (SynLongIdent.CreateFromLongIdent interfaceType.Name)
match interfaceType.Generics with match interfaceType.Generics with
| None -> baseName | None -> baseName
@@ -179,52 +243,36 @@ module internal InterfaceMockGenerator =
| SynTyparDecls.PostfixList (decls, _, _) -> decls | SynTyparDecls.PostfixList (decls, _, _) -> decls
| SynTyparDecls.PrefixList (decls, _) -> decls | SynTyparDecls.PrefixList (decls, _) -> decls
| SynTyparDecls.SinglePrefix (decl, _) -> [ decl ] | SynTyparDecls.SinglePrefix (decl, _) -> [ decl ]
|> List.map (fun (SynTyparDecl (_, typar)) -> SynType.var typar) |> List.map (fun (SynTyparDecl (_, typar)) -> SynType.Var (typar, range0))
SynType.app' baseName generics SynType.App (
baseName,
SynMemberDefn.Interface (interfaceName, Some range0, Some (members @ properties), range0)
let access =
match interfaceType.Accessibility, spec.IsInternal with
| Some (SynAccess.Public _), true
| None, true -> SynAccess.Internal range0
| Some (SynAccess.Public _), false -> SynAccess.Public range0
| None, false -> SynAccess.Public range0
| 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 mem =
SynExpr.createLongIdent [ "this" ; "Dispose" ]
|> SynExpr.applyTo (SynExpr.CreateConst ())
|> SynBinding.basic [ Ident.create "this" ; Ident.create "Dispose" ] [ SynPat.unit ]
|> SynBinding.withReturnAnnotation SynType.unit
|> SynMemberDefn.memberImplementation
SynMemberDefn.Interface (
SynType.createLongIdent' [ "System" ; "IDisposable" ],
Some range0, Some range0,
Some [ mem ], generics,
List.replicate (generics.Length - 1) range0,
Some range0,
false,
range0 range0
) )
)
|> Seq.toList SynMemberDefn.Interface (interfaceName, Some range0, Some members, range0)
// TODO: allow an arg to the attribute, specifying a custom visibility
let access =
match interfaceType.Accessibility with
| Some (SynAccess.Public _)
| Some (SynAccess.Internal _)
| None -> SynAccess.Internal range0
| Some (SynAccess.Private _) -> SynAccess.Private range0
let record = let record =
{ {
Name = Ident.create name Name = Ident.Create name
Fields = fields Fields = fields
Members = Some ([ constructor ; interfaceMembers ] @ extraInterfaces) Members = Some [ constructor ; interfaceMembers ]
XmlDoc = Some xmlDoc XmlDoc = Some xmlDoc
Generics = interfaceType.Generics Generics = interfaceType.Generics
TypeAccessibility = Some access Accessibility = Some access
ImplAccessibility = None
Attributes = []
} }
let typeDecl = AstHelper.defineRecordType record let typeDecl = AstHelper.defineRecordType record
@@ -233,70 +281,55 @@ module internal InterfaceMockGenerator =
let private buildType (x : ParameterInfo) : SynType = let private buildType (x : ParameterInfo) : SynType =
if x.IsOptional then if x.IsOptional then
SynType.app "option" [ x.Type ] SynType.App (SynType.CreateLongIdent "option", Some range0, [ x.Type ], [], Some range0, false, range0)
else else
x.Type x.Type
let private constructMemberSinglePlace (tuple : TupledArg) : SynType = let private constructMemberSinglePlace (tuple : TupledArg) : SynType =
tuple.Args match tuple.Args |> List.rev |> List.map buildType with
|> List.map buildType | [] -> failwith "no-arg functions not supported yet"
|> SynType.tupleNoParen | [ x ] -> x
|> Option.defaultWith (fun () -> failwith "no-arg functions not supported yet") | last :: rest ->
|> if tuple.HasParen then SynType.paren else id ([ SynTupleTypeSegment.Type last ], rest)
||> List.fold (fun ty nextArg -> SynTupleTypeSegment.Type nextArg :: SynTupleTypeSegment.Star range0 :: ty)
|> fun segs -> SynType.Tuple (false, segs, range0)
|> fun ty -> if tuple.HasParen then SynType.Paren (ty, range0) else ty
let constructMember (mem : MemberInfo) : SynField = let constructMember (mem : MemberInfo) : SynField =
let inputType = mem.Args |> List.map constructMemberSinglePlace let inputType = mem.Args |> List.map constructMemberSinglePlace
let funcType = SynType.toFun inputType mem.ReturnType let funcType = AstHelper.toFun inputType mem.ReturnType
{ SynField.SynField (
Type = funcType [],
Attrs = [] false,
Ident = Some mem.Identifier Some mem.Identifier,
} funcType,
|> SynField.make false,
|> SynField.withDocString (mem.XmlDoc |> Option.defaultValue PreXmlDoc.Empty) mem.XmlDoc |> Option.defaultValue PreXmlDoc.Empty,
None,
range0,
SynFieldTrivia.Zero
)
let constructProperty (prop : PropertyInfo) : SynField = let createRecord (namespaceId : LongIdent) (interfaceType : SynTypeDefn) : SynModuleOrNamespace =
{
Attrs = []
Ident = Some prop.Identifier
Type = SynType.toFun [ SynType.unit ] prop.Type
}
|> SynField.make
|> SynField.withDocString (prop.XmlDoc |> Option.defaultValue PreXmlDoc.Empty)
let createRecord
(namespaceId : LongIdent)
(opens : SynOpenDeclTarget list)
(interfaceType : SynTypeDefn, spec : GenerateMockOutputSpec)
: SynModuleOrNamespace
=
let interfaceType = AstHelper.parseInterface interfaceType let interfaceType = AstHelper.parseInterface interfaceType
let fields = interfaceType.Members |> List.map constructMember
let fields = let docString = PreXmlDoc.Create " Mock record type for an interface"
interfaceType.Members
|> List.map constructMember
|> List.append (interfaceType.Properties |> List.map constructProperty)
let docString = PreXmlDoc.create "Mock record type for an interface"
let name = let name =
List.last interfaceType.Name List.last interfaceType.Name
|> _.idText |> fun s -> s.idText
|> fun s -> |> fun s ->
if s.StartsWith 'I' && s.Length > 1 && Char.IsUpper s.[1] then if s.StartsWith 'I' && s.Length > 1 && Char.IsUpper s.[1] then
s.Substring 1 s.[1..]
else else
s s
|> fun s -> s + "Mock" |> fun s -> s + "Mock"
let typeDecl = createType spec name interfaceType docString fields let typeDecl = createType name interfaceType docString fields
[ yield! opens |> List.map SynModuleDecl.openAny ; yield typeDecl ] SynModuleOrNamespace.CreateNamespace (namespaceId, decls = [ typeDecl ])
|> SynModuleOrNamespace.createNamespace namespaceId
open Myriad.Core
/// Myriad generator that creates a record which implements the given interface, /// Myriad generator that creates a record which implements the given interface,
/// but with every field mocked out. /// but with every field mocked out.
@@ -307,69 +340,23 @@ type InterfaceMockGenerator () =
member _.ValidInputExtensions = [ ".fs" ] member _.ValidInputExtensions = [ ".fs" ]
member _.Generate (context : GeneratorContext) = member _.Generate (context : GeneratorContext) =
let targetedTypes =
MyriadParamParser.render context.AdditionalParameters
|> Map.map (fun _ v -> v.Split '!' |> Array.toList |> List.map DesiredGenerator.Parse)
let ast, _ = let ast, _ =
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
let types = Ast.getTypes ast let types = Ast.extractTypeDefn ast
let namespaceAndInterfaces = let namespaceAndInterfaces =
types types
|> List.choose (fun (ns, types) -> |> List.choose (fun (ns, types) ->
types match types |> List.filter Ast.hasAttribute<GenerateMockAttribute> with
|> List.choose (fun typeDef -> | [] -> None
match SynTypeDefn.getAttribute typeof<GenerateMockAttribute>.Name typeDef with | types -> Some (ns, types)
| None ->
let name = SynTypeDefn.getName typeDef |> List.map _.idText |> String.concat "."
match Map.tryFind name targetedTypes with
| Some desired ->
desired
|> List.tryPick (fun generator ->
match generator with
| DesiredGenerator.InterfaceMock arg ->
let spec =
{
IsInternal =
arg
|> Option.defaultValue GenerateMockAttribute.DefaultIsInternal
}
Some (typeDef, spec)
| _ -> None
)
| _ -> None
| Some attr ->
let arg =
match SynExpr.stripOptionalParen attr.ArgExpr with
| SynExpr.Const (SynConst.Bool value, _) -> value
| SynExpr.Const (SynConst.Unit, _) -> GenerateMockAttribute.DefaultIsInternal
| arg ->
failwith
$"Unrecognised argument %+A{arg} to [<%s{nameof GenerateMockAttribute}>]. Literals are not supported. Use `true` or `false` (or unit) only."
let spec =
{
IsInternal = arg
}
Some (typeDef, spec)
)
|> function
| [] -> None
| ty -> Some (ns, ty)
) )
let opens = AstHelper.extractOpens ast let opens = AstHelper.extractOpens ast
let modules = let modules =
namespaceAndInterfaces namespaceAndInterfaces
|> List.collect (fun (ns, records) -> |> List.collect (fun (ns, records) -> records |> List.map (InterfaceMockGenerator.createRecord ns))
records |> List.map (InterfaceMockGenerator.createRecord ns opens)
)
Output.Ast modules Output.Ast modules

View File

@@ -1,48 +0,0 @@
namespace WoofWare.Myriad.Plugins
open System.Text.Json.Nodes
[<AutoOpen>]
module internal JsonHelpers =
let inline asString (n : JsonNode) (key : string) : string =
match n.[key] with
| null -> failwith $"Expected node to have a key '%s{key}', but it did not: %s{n.ToJsonString ()}"
| s -> s.GetValue<string> ()
[<RequiresExplicitTypeArguments>]
let inline asOpt<'ret> (n : JsonNode) (key : string) : 'ret option =
match n.[key] with
| null -> None
| s -> s.GetValue<'ret> () |> Some
let inline asObj (n : JsonNode) (key : string) : JsonObject =
match n.[key] with
| null -> failwith $"Expected node to have a key '%s{key}', but it did not: %s{n.ToJsonString ()}"
| o -> o.AsObject ()
let inline asObjOpt (n : JsonNode) (key : string) : JsonObject option =
match n.[key] with
| null -> None
| o -> o.AsObject () |> Some
let inline asArr (n : JsonNode) (key : string) : JsonArray =
match n.[key] with
| null -> failwith $"Expected node to have a key '%s{key}', but it did not: %s{n.ToJsonString ()}"
| o -> o.AsArray ()
let inline asArrOpt (n : JsonNode) (key : string) : JsonArray option =
match n.[key] with
| null -> None
| o -> o.AsArray () |> Some
[<RequiresExplicitTypeArguments>]
let inline asArr'<'v> (n : JsonNode) (key : string) : 'v list =
match n.[key] with
| null -> failwith $"Expected node to have a key '%s{key}', but it did not: %s{n.ToJsonString ()}"
| o -> o.AsArray () |> Seq.map (fun v -> v.GetValue<'v> ()) |> Seq.toList
[<RequiresExplicitTypeArguments>]
let inline asArrOpt'<'v> (n : JsonNode) (key : string) : 'v list option =
match n.[key] with
| null -> None
| o -> o.AsArray () |> Seq.map (fun v -> v.GetValue<'v> ()) |> Seq.toList |> Some

File diff suppressed because it is too large Load Diff

View File

@@ -1,732 +0,0 @@
namespace WoofWare.Myriad.Plugins
open System
open System.Text
open Fantomas.FCS.Syntax
open WoofWare.Whippet.Fantomas
type internal JsonSerializeOutputSpec =
{
ExtensionMethods : bool
}
/// https://github.com/Smaug123/WoofWare.Myriad/issues/364
/// The insane design of System.Text.Json is finally causing us to
/// do vast amounts of coding rather than merely being very annoying.
type internal JsonNodeWithNullability =
| CannotBeNull
| Nullable
static member Identify (ty : SynType) : JsonNodeWithNullability =
match ty with
| OptionType _
| NullableType _ -> JsonNodeWithNullability.Nullable
| _ -> JsonNodeWithNullability.CannotBeNull
[<RequireQualifiedAccess>]
module internal JsonSerializeGenerator =
open Fantomas.FCS.Text.Range
// The absolutely galaxy-brained implementation of JsonValue has `JsonValue.Parse "null"`
// identically equal to null, so it's hard to use that type. We use `None` instead to represent
// the JSON null value.
let private jsonNull () = SynExpr.createIdent "None"
let assertNotNull (boundIdent : Ident) (message : SynExpr) (body : SynExpr) : SynExpr =
let raiseExpr =
message
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "ArgumentNullException" ])
|> SynExpr.paren
|> SynExpr.applyFunction (SynExpr.createIdent "raise")
[
SynMatchClause.create SynPat.createNull raiseExpr
SynMatchClause.create (SynPat.namedI boundIdent) body
]
|> SynExpr.createMatch (SynExpr.createIdent' boundIdent)
|> SynExpr.paren
/// The output of this will be an *optional* JsonNode.
let rec serializeNodeNullable (fieldType : SynType) : SynExpr * bool =
match fieldType with
| NullableType ty ->
// fun field -> if field.HasValue then {serializeNode ty} field.Value else JsonValue.Create null
match JsonNodeWithNullability.Identify ty with
| JsonNodeWithNullability.Nullable ->
failwith
$"We don't support nested nullable types, because we can't tell the difference between None and Some None: %s{SynType.toHumanReadableString ty}"
| JsonNodeWithNullability.CannotBeNull ->
let inner, innerIsJsonNode = serializeNodeNonNullable ty
SynExpr.applyFunction inner (SynExpr.createLongIdent [ "field" ; "Value" ])
|> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some")
|> SynExpr.ifThenElse (SynExpr.createLongIdent [ "field" ; "HasValue" ]) (jsonNull ())
|> SynExpr.createLambda "field"
|> fun e -> e, innerIsJsonNode
| OptionType ty ->
// fun field -> match field with | None -> None | Some v -> {serializeNode ty} field |> Some
match JsonNodeWithNullability.Identify ty with
| JsonNodeWithNullability.Nullable ->
failwith
$"We don't support nested nullable types, because we can't tell the difference between None and Some None: %s{SynType.toHumanReadableString ty}"
| JsonNodeWithNullability.CannotBeNull ->
let noneClause = jsonNull () |> SynMatchClause.create (SynPat.named "None")
let someClause =
let inner, innerIsJsonNode = serializeNodeNonNullable ty
let target = SynExpr.pipeThroughFunction inner (SynExpr.createIdent "field")
if innerIsJsonNode then
target
else
target
|> SynExpr.paren
|> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some")
|> SynMatchClause.create (SynPat.nameWithArgs "Some" [ SynPat.named "field" ])
[ noneClause ; someClause ]
|> SynExpr.createMatch (SynExpr.createIdent "field")
|> SynExpr.createLambda "field"
|> fun e -> e, true
| _ -> failwith $"Did not recognise type %s{SynType.toHumanReadableString fieldType} as nullable"
/// Given `input.Ident`, for example, choose how to add it to the ambient `node`.
/// The result is a line like `(fun ident -> InnerType.toJsonNode ident)` or `(fun ident -> JsonValue.Create ident)`.
/// Returns also a bool which is true if the resulting SynExpr represents something of type JsonNode.
and serializeNodeNonNullable (fieldType : SynType) : SynExpr * bool =
// TODO: serialization format for DateTime etc
match fieldType with
| OptionType _
| NullableType _ ->
failwith $"Tried to treat the type %s{SynType.toHumanReadableString fieldType} as non-nullable"
| DateOnly
| DateTime
| NumberType _
| Measure _
| PrimitiveType _
| Guid
| Uri ->
// JsonValue.Create<type>
(SynExpr.createIdent "field")
|> assertNotNull
(Ident.create "field")
(SynExpr.CreateConst
$"Expected type %s{SynType.toHumanReadableString fieldType} to be non-null, but received a null value when serialising")
|> SynExpr.createLet
[
SynBinding.basic
[ Ident.create "field" ]
[]
(SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonValue" ; "Create" ]
|> SynExpr.typeApp [ fieldType ]
|> SynExpr.applyTo (SynExpr.createIdent "field"))
]
|> SynExpr.createLambda "field"
|> fun e -> e, false
| DateTimeOffset ->
// fun field -> field.ToString("o") |> JsonValue.Create<string>
let create =
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonValue" ; "Create" ]
|> SynExpr.typeApp [ SynType.named "string" ]
SynExpr.createIdent "field"
|> SynExpr.callMethodArg "ToString" (SynExpr.CreateConst "o")
|> SynExpr.pipeThroughFunction create
|> SynExpr.createLambda "field"
|> fun e -> e, false
| ArrayType ty
| ListType ty ->
// fun field ->
// let arr = JsonArray ()
// for mem in field do arr.Add ({serializeNode} mem)
// arr
let isNullableChild =
match JsonNodeWithNullability.Identify ty with
| CannotBeNull -> false
| Nullable -> true
[
SynExpr.ForEach (
DebugPointAtFor.Yes range0,
DebugPointAtInOrTo.Yes range0,
SeqExprOnly.SeqExprOnly false,
true,
SynPat.named "mem",
SynExpr.createIdent "field",
SynExpr.applyFunction
(SynExpr.createLongIdent [ "arr" ; "Add" ])
(SynExpr.paren (
SynExpr.applyFunction
(fst (
(if isNullableChild then
serializeNodeNullable
else
serializeNodeNonNullable)
ty
))
(SynExpr.createIdent "mem")
)),
range0
)
SynExpr.createIdent "arr"
]
|> SynExpr.sequential
|> SynExpr.createLet
[
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonArray" ]
|> SynExpr.applyTo (SynExpr.CreateConst ())
|> SynBinding.basic [ Ident.create "arr" ] []
]
|> SynExpr.createLambda "field"
|> fun e -> e, false
| 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
let isNullableValueField =
match JsonNodeWithNullability.Identify valueType with
| CannotBeNull -> false
| Nullable -> true
// TODO: this is a bit dubious, because user-defined types will
// by default have non-null ToString
let keyTypeHasNonNullToString =
match keyType with
| String
| Uri -> true
| _ -> false
[
SynExpr.ForEach (
DebugPointAtFor.Yes range0,
DebugPointAtInOrTo.Yes range0,
SeqExprOnly.SeqExprOnly false,
true,
SynPat.paren (SynPat.nameWithArgs "KeyValue" [ SynPat.named "key" ; SynPat.named "value" ]),
SynExpr.createIdent "field",
SynExpr.applyFunction
(SynExpr.createLongIdent [ "ret" ; "Add" ])
(SynExpr.tuple
[
SynExpr.createIdent "key"
|> if keyTypeHasNonNullToString then
id
else
assertNotNull
(Ident.create "key")
(SynExpr.CreateConst
"A map key unexpectedly yielded null when we `ToString`'ed it. Map keys must yield non-null strings on `ToString`.")
SynExpr.applyFunction
(fst (
(if isNullableValueField then
serializeNodeNullable
else
serializeNodeNonNullable)
valueType
))
(SynExpr.createIdent "value")
])
|> SynExpr.createLet
[
SynBinding.basic
[ Ident.create "key" ]
[]
(SynExpr.createLongIdent [ "key" ; "ToString" ]
|> SynExpr.applyTo (SynExpr.CreateConst ()))
],
range0
)
SynExpr.createIdent "ret"
]
|> SynExpr.sequential
|> SynExpr.createLet
[
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
|> SynExpr.applyTo (SynExpr.CreateConst ())
|> SynBinding.basic [ Ident.create "ret" ] []
]
|> SynExpr.createLambda "field"
|> fun e -> e, false
| JsonNode -> SynExpr.createIdent "id", true
| UnitType ->
SynExpr.createLambda
"value"
(SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
|> SynExpr.applyTo (SynExpr.CreateConst ())),
false
| _ ->
// {type}.toJsonNode
let typeName =
match fieldType with
| SynType.LongIdent ident -> ident.LongIdent
| _ -> failwith $"Unrecognised type: %+A{fieldType}"
SynExpr.createLongIdent' (typeName @ [ Ident.create "toJsonNode" ]), true
/// propertyName is probably a string literal, but it could be a [<Literal>] variable
/// `node.Add ({propertyName}, {toJsonNode})`
let createSerializeRhsRecord (propertyName : SynExpr) (fieldId : Ident) (fieldType : SynType) : SynExpr =
let isNullableField =
match JsonNodeWithNullability.Identify fieldType with
| CannotBeNull -> false
| Nullable -> true
let serialised =
if isNullableField then
let value =
serializeNodeNullable fieldType
|> fst
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Option" ; "toObj" ])
SynExpr.pipeThroughFunction value (SynExpr.createLongIdent' [ Ident.create "input" ; fieldId ])
else
let value = serializeNodeNonNullable fieldType |> fst
SynExpr.pipeThroughFunction value (SynExpr.createLongIdent' [ Ident.create "input" ; fieldId ])
[ propertyName ; SynExpr.paren serialised ]
|> SynExpr.tuple
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ])
let getPropertyName (fieldId : Ident) (attrs : SynAttribute list) : SynExpr =
let propertyNameAttr =
attrs
|> List.tryFind (fun attr ->
(SynLongIdent.toString attr.TypeName).EndsWith ("JsonPropertyName", StringComparison.Ordinal)
)
match propertyNameAttr with
| None ->
let sb = StringBuilder fieldId.idText.Length
sb.Append (Char.ToLowerInvariant fieldId.idText.[0]) |> ignore
if fieldId.idText.Length > 1 then
sb.Append fieldId.idText.[1..] |> ignore
sb.ToString () |> SynExpr.CreateConst
| Some name -> name.ArgExpr
let getIsJsonExtension (attrs : SynAttribute list) : bool =
attrs
|> List.tryFind (fun attr ->
(SynLongIdent.toString attr.TypeName).EndsWith ("JsonExtensionData", StringComparison.Ordinal)
)
|> Option.isSome
/// `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 =
SynLongIdent.createS' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
|> SynType.LongIdent
let functionName = Ident.create "toJsonNode"
let assignments =
[
populateNode
SynExpr.Upcast (SynExpr.createIdent "node", SynType.Anon range0, range0)
]
|> SynExpr.sequential
|> SynExpr.createLet
[
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
|> SynExpr.applyTo (SynExpr.CreateConst ())
|> SynBinding.basic [ Ident.create "node" ] []
]
let pattern =
SynPat.namedI inputArgName
|> SynPat.annotateType (SynType.LongIdent (SynLongIdent.create typeName))
if spec.ExtensionMethods then
let componentInfo =
SynComponentInfo.createLong typeName
|> SynComponentInfo.withDocString (PreXmlDoc.create "Extension methods for JSON parsing")
let memberDef =
assignments
|> SynBinding.basic [ functionName ] [ pattern ]
|> SynBinding.withXmlDoc xmlDoc
|> SynBinding.withReturnAnnotation returnInfo
|> SynMemberDefn.staticMember
let containingType =
SynTypeDefnRepr.augmentation ()
|> SynTypeDefn.create componentInfo
|> SynTypeDefn.withMemberDefns [ memberDef ]
SynModuleDecl.Types ([ containingType ], range0)
else
assignments
|> SynBinding.basic [ functionName ] [ pattern ]
|> SynBinding.withReturnAnnotation returnInfo
|> SynBinding.withXmlDoc xmlDoc
|> SynModuleDecl.createLet
let recordModule (spec : JsonSerializeOutputSpec) (_typeName : LongIdent) (fields : SynField list) =
let fields = fields |> List.map SynField.extractWithIdent
fields
|> List.map (fun fieldData ->
let propertyName = getPropertyName fieldData.Ident fieldData.Attrs
let isJsonExtension = getIsJsonExtension fieldData.Attrs
if isJsonExtension then
let valType =
match fieldData.Type with
| DictionaryType (String, v) -> v
| _ -> failwith "Expected JsonExtensionData to be a Dictionary<string, something>"
let serialise =
match JsonNodeWithNullability.Identify valType with
| CannotBeNull -> fst (serializeNodeNonNullable valType)
| Nullable -> fst (serializeNodeNullable valType)
SynExpr.createIdent "node"
|> SynExpr.callMethodArg
"Add"
(SynExpr.tuple
[
SynExpr.createIdent "key"
SynExpr.applyFunction serialise (SynExpr.createIdent "value")
])
|> SynExpr.createForEach
(SynPat.identWithArgs
[ Ident.create "KeyValue" ]
(SynArgPats.create [ SynPat.named "key" ; SynPat.named "value" ]))
(SynExpr.createLongIdent' [ Ident.create "input" ; fieldData.Ident ])
else
createSerializeRhsRecord propertyName fieldData.Ident fieldData.Type
)
|> SynExpr.sequential
|> fun expr -> SynExpr.Do (expr, range0)
let unionModule (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (cases : SynUnionCase list) =
let inputArg = Ident.create "input"
let fields = cases |> List.map UnionCase.ofSynUnionCase
fields
|> List.map (fun unionCase ->
let propertyName = getPropertyName unionCase.Name unionCase.Attributes
let caseNames = unionCase.Fields |> List.mapi (fun i _ -> $"arg%i{i}")
let argPats = SynArgPats.createNamed caseNames
let pattern =
SynPat.LongIdent (
SynLongIdent.create (typeName @ [ unionCase.Name ]),
None,
None,
argPats,
None,
range0
)
let typeLine =
[
SynExpr.CreateConst "type"
SynExpr.applyFunction
(SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonValue" ; "Create" ])
propertyName
]
|> SynExpr.tuple
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ])
let dataNode =
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
|> SynExpr.applyTo (SynExpr.CreateConst ())
|> SynBinding.basic [ Ident.create "dataNode" ] []
let dataBindings =
(unionCase.Fields, caseNames)
||> List.zip
|> List.map (fun (fieldData, caseName) ->
let propertyName = getPropertyName (Option.get fieldData.Ident) fieldData.Attrs
let node =
match JsonNodeWithNullability.Identify fieldData.Type with
| CannotBeNull ->
SynExpr.applyFunction
(fst (serializeNodeNonNullable fieldData.Type))
(SynExpr.createIdent caseName)
| Nullable ->
SynExpr.applyFunction
(fst (serializeNodeNullable fieldData.Type))
(SynExpr.createIdent caseName)
[ propertyName ; node ]
|> SynExpr.tuple
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "dataNode" ; "Add" ])
)
let assignToNode =
[ SynExpr.CreateConst "data" ; SynExpr.createIdent "dataNode" ]
|> SynExpr.tuple
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ])
let dataNode =
SynExpr.sequential (dataBindings @ [ assignToNode ])
|> SynExpr.createLet [ dataNode ]
let action =
[
yield typeLine
if not dataBindings.IsEmpty then
yield dataNode
]
|> SynExpr.sequential
SynMatchClause.create pattern action
)
|> SynExpr.createMatch (SynExpr.createIdent' inputArg)
let enumModule
(spec : JsonSerializeOutputSpec)
(typeName : LongIdent)
(cases : (Ident * SynExpr) list)
: SynModuleDecl
=
let fail =
SynExpr.CreateConst "Unrecognised value for enum: %O"
|> SynExpr.applyFunction (SynExpr.createIdent "sprintf")
|> SynExpr.applyTo (SynExpr.createIdent "v")
|> SynExpr.paren
|> SynExpr.applyFunction (SynExpr.createIdent "failwith")
let body =
cases
|> List.map (fun (caseName, value) ->
value
|> SynExpr.applyFunction (
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonValue" ; "Create" ]
)
|> SynMatchClause.create (SynPat.identWithArgs (typeName @ [ caseName ]) (SynArgPats.create []))
)
|> fun l -> l @ [ SynMatchClause.create (SynPat.named "v") fail ]
|> SynExpr.createMatch (SynExpr.createIdent "input")
let xmlDoc = PreXmlDoc.create "Serialize to a JSON node"
let returnInfo =
SynLongIdent.createS' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
|> SynType.LongIdent
let functionName = Ident.create "toJsonNode"
let pattern =
SynPat.named "input"
|> SynPat.annotateType (SynType.LongIdent (SynLongIdent.create typeName))
if spec.ExtensionMethods then
let componentInfo =
SynComponentInfo.createLong typeName
|> SynComponentInfo.withDocString (PreXmlDoc.create "Extension methods for JSON parsing")
let memberDef =
body
|> SynBinding.basic [ functionName ] [ pattern ]
|> SynBinding.withXmlDoc xmlDoc
|> SynBinding.withReturnAnnotation returnInfo
|> SynMemberDefn.staticMember
let containingType =
SynTypeDefnRepr.augmentation ()
|> SynTypeDefn.create componentInfo
|> SynTypeDefn.withMemberDefns [ memberDef ]
SynModuleDecl.Types ([ containingType ], range0)
else
body
|> SynBinding.basic [ functionName ] [ pattern ]
|> SynBinding.withReturnAnnotation returnInfo
|> SynBinding.withXmlDoc xmlDoc
|> SynModuleDecl.createLet
let createModule
(namespaceId : LongIdent)
(opens : SynOpenDeclTarget list)
(spec : JsonSerializeOutputSpec)
(typeDefn : SynTypeDefn)
=
let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) =
typeDefn
let (SynComponentInfo (_attributes, _typeParams, _constraints, ident, _, _preferPostfix, access, _)) =
synComponentInfo
let attributes =
if spec.ExtensionMethods then
[ SynAttribute.autoOpen ]
else
[ SynAttribute.requireQualifiedAccess ; SynAttribute.compilationRepresentation ]
let xmlDoc =
let fullyQualified = ident |> Seq.map (fun i -> i.idText) |> String.concat "."
let description =
if spec.ExtensionMethods then
"extension members"
else
"methods"
$"Module containing JSON serializing %s{description} for the %s{fullyQualified} type"
|> PreXmlDoc.create
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
List.take (List.length ident - 1) ident @ [ expanded ]
else
ident
let info =
SynComponentInfo.createLong moduleName
|> SynComponentInfo.addAttributes attributes
|> SynComponentInfo.setAccessibility access
|> SynComponentInfo.withDocString xmlDoc
let decls =
match synTypeDefnRepr with
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, recordFields, _range), _) ->
recordModule spec ident recordFields
|> scaffolding spec ident (Ident.create "input")
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (_accessibility, unionFields, _range), _) ->
unionModule spec ident unionFields
|> scaffolding spec ident (Ident.create "input")
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Enum (cases, _range), _) ->
cases
|> List.map (fun c ->
match c with
| SynEnumCase.SynEnumCase (_, SynIdent.SynIdent (ident, _), value, _, _, _) -> ident, value
)
|> enumModule spec ident
| ty -> failwithf "Unsupported type: got %O" ty
[
yield! opens |> List.map SynModuleDecl.openAny
yield decls |> List.singleton |> SynModuleDecl.nestedModule info
]
|> SynModuleOrNamespace.createNamespace namespaceId
open Myriad.Core
/// Myriad generator that provides a method (possibly an extension method) for a record type,
/// containing a JSON serialization function.
[<MyriadGenerator("json-serialize")>]
type JsonSerializeGenerator () =
interface IMyriadGenerator with
member _.ValidInputExtensions = [ ".fs" ]
member _.Generate (context : GeneratorContext) =
let targetedTypes =
MyriadParamParser.render context.AdditionalParameters
|> Map.map (fun _ v -> v.Split '!' |> Array.toList |> List.map DesiredGenerator.Parse)
let ast, _ =
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
let relevantTypes =
Ast.getTypes ast
|> List.map (fun (name, defns) ->
defns
|> List.choose (fun defn ->
if SynTypeDefn.isRecord defn then Some defn
elif SynTypeDefn.isDu defn then Some defn
elif SynTypeDefn.isEnum defn then Some defn
else None
)
|> fun defns -> name, defns
)
let namespaceAndTypes =
relevantTypes
|> List.choose (fun (ns, types) ->
types
|> List.choose (fun typeDef ->
match SynTypeDefn.getAttribute typeof<JsonSerializeAttribute>.Name typeDef with
| None ->
let name = SynTypeDefn.getName typeDef |> List.map _.idText |> String.concat "."
match Map.tryFind name targetedTypes with
| Some desired ->
desired
|> List.tryPick (fun generator ->
match generator with
| DesiredGenerator.JsonSerialize arg ->
let spec =
{
ExtensionMethods =
arg
|> Option.defaultValue
JsonSerializeAttribute.DefaultIsExtensionMethod
}
Some (typeDef, spec)
| _ -> None
)
| _ -> None
| Some attr ->
let arg =
match SynExpr.stripOptionalParen attr.ArgExpr with
| SynExpr.Const (SynConst.Bool value, _) -> value
| SynExpr.Const (SynConst.Unit, _) -> JsonSerializeAttribute.DefaultIsExtensionMethod
| arg ->
failwith
$"Unrecognised argument %+A{arg} to [<%s{nameof JsonSerializeAttribute}>]. 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 opens = AstHelper.extractOpens ast
let modules =
namespaceAndTypes
|> List.collect (fun (ns, types) ->
types
|> List.map (fun (ty, spec) -> JsonSerializeGenerator.createModule ns opens spec ty)
)
Output.Ast modules

View File

@@ -1,23 +0,0 @@
namespace WoofWare.Myriad.Plugins
[<RequireQualifiedAccess>]
module private List =
let partitionChoice<'a, 'b> (xs : Choice<'a, 'b> list) : 'a list * 'b list =
let xs, ys =
(([], []), xs)
||> List.fold (fun (xs, ys) v ->
match v with
| Choice1Of2 x -> x :: xs, ys
| Choice2Of2 y -> xs, y :: ys
)
List.rev xs, List.rev ys
let allSome<'a> (l : 'a option list) : 'a list option =
let rec go acc (l : 'a option list) =
match l with
| [] -> Some (List.rev acc)
| None :: _ -> None
| Some head :: tail -> go (head :: acc) tail
go [] l

View File

@@ -1,24 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open WoofWare.Whippet.Fantomas
[<RequireQualifiedAccess>]
module internal Measure =
let getLanguagePrimitivesMeasure (typeName : LongIdent) : SynExpr =
match typeName |> List.map _.idText with
| [ "System" ; "Single" ] -> [ "LanguagePrimitives" ; "Float32WithMeasure" ]
| [ "System" ; "Double" ] -> [ "LanguagePrimitives" ; "FloatWithMeasure" ]
| [ "System" ; "Byte" ] -> [ "LanguagePrimitives" ; "ByteWithMeasure" ]
| [ "System" ; "SByte" ] -> [ "LanguagePrimitives" ; "SByteWithMeasure" ]
| [ "System" ; "Int16" ] -> [ "LanguagePrimitives" ; "Int16WithMeasure" ]
| [ "System" ; "Int32" ] -> [ "LanguagePrimitives" ; "Int32WithMeasure" ]
| [ "System" ; "Int64" ] -> [ "LanguagePrimitives" ; "Int64WithMeasure" ]
| [ "System" ; "UInt16" ] -> [ "LanguagePrimitives" ; "UInt16WithMeasure" ]
| [ "System" ; "UInt32" ] -> [ "LanguagePrimitives" ; "UInt32WithMeasure" ]
| [ "System" ; "UInt64" ] -> [ "LanguagePrimitives" ; "UInt64WithMeasure" ]
| l ->
let l = String.concat "." l
failwith $"unrecognised type for measure: %s{l}"
|> SynExpr.createLongIdent

View File

@@ -1,42 +0,0 @@
namespace WoofWare.Myriad.Plugins
open System.Collections.Generic
[<RequireQualifiedAccess>]
module internal MyriadParamParser =
(*
An apparent bug in Myriad's argument parsing means that this:
<MyriadParams>
<Foo>bar</Foo>
<Baz>quux</Baz>
</MyriadParams>
leads to this:
Foo = "bar;Baz=quux"
I'm not going to put effort into fixing Myriad, though, because I want
to build something much more powerful instead.
*)
/// Call this with `context.AdditionalParameters`.
let render (pars : IDictionary<string, string>) : Map<string, string> =
match pars.Count with
| 0 -> Map.empty
| 1 ->
let (KeyValue (key, value)) = pars |> Seq.exactlyOne
match value.Split ';' |> Seq.toList with
| [] -> failwith "LOGIC ERROR"
| value :: rest ->
rest
|> Seq.map (fun v ->
let split = v.Split '='
split.[0], String.concat "=" split.[1..]
)
|> Seq.append (Seq.singleton (key, value))
|> Map.ofSeq
| _ ->
// assume the Myriad bug is fixed!
pars |> Seq.map (fun (KeyValue (k, v)) -> k, v) |> Map.ofSeq

File diff suppressed because it is too large Load Diff

Some files were not shown because too many files have changed in this diff Show More