mirror of
				https://github.com/Smaug123/WoofWare.Myriad
				synced 2025-10-25 22:08:40 +00:00 
			
		
		
		
	Compare commits
	
		
			144 Commits
		
	
	
		
			f83ac24a73
			...
			WoofWare.M
		
	
	| Author | SHA1 | Date | |
|---|---|---|---|
|  | 16e6b91548 | ||
|  | 8488883835 | ||
|  | 0652744c57 | ||
|  | 9252979673 | ||
|  | 1120a3752d | ||
|  | 7ca6b0c0eb | ||
|  | 50efb8d9bc | ||
|  | 93a1b630c8 | ||
|  | 4482038e8a | ||
|  | a41fa9dd37 | ||
|  | fc5acc2f58 | ||
|  | 0a1783d6ed | ||
|  | 9a3ebbf28f | ||
|  | e22525c200 | ||
|  | 09b7109c84 | ||
|  | 693b95106a | ||
|  | 49ecfbf5e5 | ||
|  | 5748ac3d5b | ||
|  | 913959a740 | ||
|  | 93ffc065cd | ||
|  | d14efba7e7 | ||
|  | f5cf0b79dd | ||
|  | 029e3746bb | ||
|  | 8ae749c529 | ||
|  | e4cbab3209 | ||
|  | bdce82fb7a | ||
|  | 8f9f933971 | ||
|  | 3a55ba1242 | ||
|  | 047b2eda99 | ||
|  | 2220f88053 | ||
|  | 86b938c81e | ||
|  | 1832a57bdf | ||
|  | 38f4821fa4 | ||
|  | 70aaf8c408 | ||
|  | 417ca45c37 | ||
|  | 569b3cc553 | ||
|  | 20226b9da9 | ||
|  | f800e53bff | ||
|  | 5358f5da0e | ||
|  | a868b8c08e | ||
|  | a4f945a3ee | ||
|  | 8434730ba7 | ||
|  | 811026996c | ||
|  | 25b2b160bb | ||
|  | 4679474604 | ||
|  | e16e241785 | ||
|  | a52e4a46b0 | ||
|  | f40a368948 | ||
|  | adaee61fbf | ||
|  | d388660bfe | ||
|  | d0e9ba0efd | ||
|  | d7d6c57910 | ||
|  | 98e52743f5 | ||
|  | 896696e002 | ||
|  | 654f760f3a | ||
|  | 31bd9e22f2 | ||
|  | b7a240bbb9 | ||
|  | ebbe10ad81 | ||
|  | 8f9af9af67 | ||
|  | 2c7cd91cbc | ||
|  | ffaa373da9 | ||
|  | 9f8459a7d3 | ||
|  | 362542d5ee | ||
|  | 18309becbd | ||
|  | e96803e303 | ||
|  | b53b410feb | ||
|  | 398cd04a2a | ||
|  | 434c042510 | ||
|  | c590db2a65 | ||
|  | 6a81513a93 | ||
|  | ba31689145 | ||
|  | 85929d49d5 | ||
|  | db4694f6e7 | ||
|  | 669eccbdef | ||
|  | 1bb87e55da | ||
|  | 4901e7cdf4 | ||
|  | 68bd4bc1fd | ||
|  | 8da0fd01fe | ||
|  | 18c7a2e920 | ||
|  | f371ee59fe | ||
|  | f8296e54bc | ||
|  | adf497c5db | ||
|  | 04ecbe6002 | ||
|  | 7b14e52e9d | ||
|  | 8e47f39efc | ||
|  | 6942ba42b9 | ||
|  | b98080690d | ||
|  | 81b7e5361d | ||
|  | 94b88a4143 | ||
|  | ed3ffecb52 | ||
|  | c696dcf31f | ||
|  | d5bb2726d3 | ||
|  | f17290d0f1 | ||
|  | 35cd94cba1 | ||
|  | 1b3eb03380 | ||
|  | b846ce08a3 | ||
|  | 4b9f63d374 | ||
|  | b9ba07a8a7 | ||
|  | e80ed51498 | ||
|  | 61b07ad802 | ||
|  | 59369bcb94 | ||
|  | 072169e4e3 | ||
|  | 91136a25ab | ||
|  | c51038448a | ||
|  | 09780efb07 | ||
|  | f562271c12 | ||
|  | e3081c3136 | ||
|  | 232d2ba5ec | ||
|  | f7458f521e | ||
|  | bfc25a672b | ||
|  | af7fcb3028 | ||
|  | 91853b1fff | ||
|  | 1144e93c1c | ||
|  | d899d77ae2 | ||
|  | a2ad430b2f | ||
|  | 9e36986bc7 | ||
|  | 679c66885d | ||
|  | 246da41672 | ||
|  | d07541c2c2 | ||
|  | 7b49505064 | ||
|  | 3209372b5b | ||
|  | 1bbbf4bd06 | ||
|  | 3ea1c7ab79 | ||
|  | f55a810608 | ||
|  | afc952241d | ||
|  | c3af52596f | ||
|  | 8bd13c0bb4 | ||
|  | ebd6f980de | ||
|  | 690a47488d | ||
|  | 82b40ee559 | ||
|  | 5a0a7e0d17 | ||
|  | 7ef393a28d | ||
|  | 4e18e8b1bf | ||
|  | a0fb7ee43a | ||
|  | 3d5cd7374f | ||
|  | 1215834795 | ||
|  | e453a6f07c | ||
|  | 3dfb89d086 | ||
|  | 626f6ef137 | ||
|  | f803b44311 | ||
|  | 5c1841c3d2 | ||
|  | bea584e3cc | ||
|  | f8fdcb805e | ||
|  | 0f7724903b | 
| @@ -3,13 +3,13 @@ | ||||
|   "isRoot": true, | ||||
|   "tools": { | ||||
|     "fantomas": { | ||||
|       "version": "6.3.0-alpha-005", | ||||
|       "version": "6.3.15", | ||||
|       "commands": [ | ||||
|         "fantomas" | ||||
|       ] | ||||
|     }, | ||||
|     "fsharp-analyzers": { | ||||
|       "version": "0.23.0", | ||||
|       "version": "0.27.0", | ||||
|       "commands": [ | ||||
|         "fsharp-analyzers" | ||||
|       ] | ||||
|   | ||||
| @@ -2,7 +2,6 @@ root=true | ||||
|  | ||||
| [*] | ||||
| charset=utf-8 | ||||
| end_of_line=crlf | ||||
| trim_trailing_whitespace=true | ||||
| insert_final_newline=true | ||||
| indent_style=space | ||||
|   | ||||
							
								
								
									
										1
									
								
								.fantomasignore
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										1
									
								
								.fantomasignore
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1 @@ | ||||
| .direnv/ | ||||
							
								
								
									
										10
									
								
								.gitattributes
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										10
									
								
								.gitattributes
									
									
									
									
										vendored
									
									
								
							| @@ -1,5 +1,5 @@ | ||||
| * eol=auto | ||||
| *.sh text eol=lf | ||||
| *.yaml text | ||||
| *.nix text eol=lf | ||||
| hooks/pre-push text eol=lf | ||||
| * eol=auto | ||||
| *.sh text eol=lf | ||||
| *.yaml text | ||||
| *.nix text eol=lf | ||||
| hooks/pre-push text eol=lf | ||||
|   | ||||
							
								
								
									
										211
									
								
								.github/workflows/dotnet.yaml
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										211
									
								
								.github/workflows/dotnet.yaml
									
									
									
									
										vendored
									
									
								
							| @@ -1,3 +1,4 @@ | ||||
| # yaml-language-server: $schema=https://raw.githubusercontent.com/SchemaStore/schemastore/master/src/schemas/json/github-workflow.json | ||||
| name: .NET | ||||
|  | ||||
| on: | ||||
| @@ -28,7 +29,7 @@ jobs: | ||||
|       with: | ||||
|         fetch-depth: 0 # so that NerdBank.GitVersioning has access to history | ||||
|     - name: Install Nix | ||||
|       uses: cachix/install-nix-action@v25 | ||||
|       uses: cachix/install-nix-action@v29 | ||||
|       with: | ||||
|         extra_nix_config: | | ||||
|           access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} | ||||
| @@ -49,7 +50,7 @@ jobs: | ||||
|         with: | ||||
|           fetch-depth: 0 # so that NerdBank.GitVersioning has access to history | ||||
|       - name: Install Nix | ||||
|         uses: cachix/install-nix-action@v25 | ||||
|         uses: cachix/install-nix-action@v29 | ||||
|         with: | ||||
|           extra_nix_config: | | ||||
|             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} | ||||
| @@ -58,7 +59,7 @@ jobs: | ||||
|       - name: Build project | ||||
|         run: nix develop --command dotnet build ./WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj | ||||
|       - name: Run analyzers | ||||
|         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 | ||||
|         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 | ||||
|  | ||||
|   build-nix: | ||||
|     runs-on: ubuntu-latest | ||||
| @@ -66,12 +67,14 @@ jobs: | ||||
|       - name: Checkout | ||||
|         uses: actions/checkout@v4 | ||||
|       - name: Install Nix | ||||
|         uses: cachix/install-nix-action@v25 | ||||
|         uses: cachix/install-nix-action@v29 | ||||
|         with: | ||||
|           extra_nix_config: | | ||||
|             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} | ||||
|       - name: Build | ||||
|         run: nix build | ||||
|       - name: Reproducibility check | ||||
|         run: nix build --rebuild | ||||
|  | ||||
|   check-dotnet-format: | ||||
|     runs-on: ubuntu-latest | ||||
| @@ -79,20 +82,41 @@ jobs: | ||||
|       - name: Checkout | ||||
|         uses: actions/checkout@v4 | ||||
|       - name: Install Nix | ||||
|         uses: cachix/install-nix-action@v25 | ||||
|         uses: cachix/install-nix-action@v29 | ||||
|         with: | ||||
|           extra_nix_config: | | ||||
|             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} | ||||
|       - name: Run Fantomas | ||||
|         run: nix run .#fantomas -- --check . | ||||
|  | ||||
|   check-accurate-generations: | ||||
|     runs-on: ubuntu-latest | ||||
|     steps: | ||||
|       - name: Checkout | ||||
|         uses: actions/checkout@v4 | ||||
|         with: | ||||
|           fetch-depth: 0 # so that NerdBank.GitVersioning has access to history | ||||
|       - name: Install Nix | ||||
|         uses: cachix/install-nix-action@v29 | ||||
|         with: | ||||
|           extra_nix_config: | | ||||
|             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} | ||||
|       - name: Whitespace change | ||||
|         run: "echo ' ' >> ConsumePlugin/List.fs" | ||||
|       - name: Generate code | ||||
|         run: nix develop --command dotnet build | ||||
|       - name: Run Fantomas | ||||
|         run: nix run .#fantomas -- . | ||||
|       - name: Verify there is no diff | ||||
|         run: git diff --name-only --no-color --exit-code | ||||
|  | ||||
|   check-nix-format: | ||||
|     runs-on: ubuntu-latest | ||||
|     steps: | ||||
|       - name: Checkout | ||||
|         uses: actions/checkout@v4 | ||||
|       - name: Install Nix | ||||
|         uses: cachix/install-nix-action@v25 | ||||
|         uses: cachix/install-nix-action@v29 | ||||
|         with: | ||||
|           extra_nix_config: | | ||||
|             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} | ||||
| @@ -105,7 +129,7 @@ jobs: | ||||
|     steps: | ||||
|       - uses: actions/checkout@master | ||||
|       - name: Install Nix | ||||
|         uses: cachix/install-nix-action@v25 | ||||
|         uses: cachix/install-nix-action@v29 | ||||
|         with: | ||||
|           extra_nix_config: | | ||||
|             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} | ||||
| @@ -118,7 +142,7 @@ jobs: | ||||
|     steps: | ||||
|       - uses: actions/checkout@master | ||||
|       - name: Install Nix | ||||
|         uses: cachix/install-nix-action@v25 | ||||
|         uses: cachix/install-nix-action@v29 | ||||
|         with: | ||||
|           extra_nix_config: | | ||||
|             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} | ||||
| @@ -132,7 +156,7 @@ jobs: | ||||
|       with: | ||||
|         fetch-depth: 0 # so that NerdBank.GitVersioning has access to history | ||||
|     - name: Install Nix | ||||
|       uses: cachix/install-nix-action@v25 | ||||
|       uses: cachix/install-nix-action@v29 | ||||
|       with: | ||||
|         extra_nix_config: | | ||||
|           access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} | ||||
| @@ -142,45 +166,188 @@ jobs: | ||||
|       run: nix develop --command dotnet build --no-restore --configuration Release | ||||
|     - name: Pack | ||||
|       run: nix develop --command dotnet pack --configuration Release | ||||
|     - name: Upload NuGet artifact | ||||
|     - name: Upload NuGet artifact (plugin) | ||||
|       uses: actions/upload-artifact@v4 | ||||
|       with: | ||||
|         name: nuget-package | ||||
|         name: nuget-package-plugin | ||||
|         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: | ||||
|     needs: [nuget-pack] | ||||
|     runs-on: ubuntu-latest | ||||
|     steps: | ||||
|       - name: Download NuGet artifact (plugin) | ||||
|         uses: actions/download-artifact@v4 | ||||
|         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@v4 | ||||
|         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-plugin-dry-run: | ||||
|     needs: [nuget-pack] | ||||
|     runs-on: ubuntu-latest | ||||
|     steps: | ||||
|       - uses: actions/checkout@v4 | ||||
|       - name: Download NuGet artifact (plugin) | ||||
|         uses: actions/download-artifact@v4 | ||||
|         with: | ||||
|           name: nuget-package-plugin | ||||
|       - name: Download NuGet artifact (attribute) | ||||
|         uses: actions/download-artifact@v4 | ||||
|         with: | ||||
|           name: nuget-package-attribute | ||||
|       - name: Tag and release plugin | ||||
|         env: | ||||
|           DRY_RUN: 1 | ||||
|           GITHUB_TOKEN: mock-token | ||||
|         run: sh .github/workflows/tag.sh | ||||
|  | ||||
|   all-required-checks-complete: | ||||
|     needs: [check-dotnet-format, check-nix-format, check-accurate-generations, build, build-nix, linkcheck, flake-check, analyzers, nuget-pack, expected-pack, github-release-plugin-dry-run] | ||||
|     if: ${{ always() }} | ||||
|     runs-on: ubuntu-latest | ||||
|     steps: | ||||
|       - uses: G-Research/common-actions/check-required-lite@2b7dc49cb14f3344fbe6019c14a31165e258c059 | ||||
|         with: | ||||
|           needs-context: ${{ toJSON(needs) }} | ||||
|  | ||||
|   attestation-attribute: | ||||
|     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@v4 | ||||
|         with: | ||||
|           name: nuget-package | ||||
|       - name: Check NuGet contents | ||||
|         # Verify that there is exactly one nupkg in the artifact that would be NuGet published | ||||
|         run: if [[ $(find . -maxdepth 1 -name 'WoofWare.Myriad.Plugins.*.nupkg' -printf c | wc -c) -ne "1" ]]; then exit 1; fi | ||||
|           name: nuget-package-attribute | ||||
|           path: packed | ||||
|       - name: Attest Build Provenance | ||||
|         uses: actions/attest-build-provenance@1c608d11d69870c2092266b3f9a6f3abbf17002c # v1.4.3 | ||||
|         with: | ||||
|           subject-path: "packed/*.nupkg" | ||||
|  | ||||
|   all-required-checks-complete: | ||||
|     needs: [check-dotnet-format, check-nix-format, build, build-nix, linkcheck, flake-check, analyzers, nuget-pack, expected-pack] | ||||
|   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: | ||||
|       - run: echo "All required checks complete." | ||||
|       - name: Download NuGet artifact | ||||
|         uses: actions/download-artifact@v4 | ||||
|         with: | ||||
|           name: nuget-package-plugin | ||||
|           path: packed | ||||
|       - name: Attest Build Provenance | ||||
|         uses: actions/attest-build-provenance@1c608d11d69870c2092266b3f9a6f3abbf17002c # v1.4.3 | ||||
|         with: | ||||
|           subject-path: "packed/*.nupkg" | ||||
|  | ||||
|   nuget-publish: | ||||
|   nuget-publish-attribute: | ||||
|     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@v4 | ||||
|       - name: Install Nix | ||||
|         uses: cachix/install-nix-action@v25 | ||||
|         uses: cachix/install-nix-action@v29 | ||||
|         with: | ||||
|           extra_nix_config: | | ||||
|             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} | ||||
|       - name: Download NuGet artifact | ||||
|         uses: actions/download-artifact@v4 | ||||
|         with: | ||||
|           name: nuget-package | ||||
|           name: nuget-package-attribute | ||||
|           path: packed | ||||
|       - name: Identify `dotnet` | ||||
|         id: dotnet-identify | ||||
|         run: nix develop --command bash -c 'echo "dotnet=$(which dotnet)" >> $GITHUB_OUTPUT' | ||||
|       - name: Publish to NuGet | ||||
|         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 | ||||
|         id: publish-success | ||||
|         uses: G-Research/common-actions/publish-nuget@2b7dc49cb14f3344fbe6019c14a31165e258c059 | ||||
|         with: | ||||
|           package-name: WoofWare.Myriad.Plugins.Attributes | ||||
|           nuget-key: ${{ secrets.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@v4 | ||||
|       - name: Install Nix | ||||
|         uses: cachix/install-nix-action@v29 | ||||
|         with: | ||||
|           extra_nix_config: | | ||||
|             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} | ||||
|       - name: Download NuGet artifact | ||||
|         uses: actions/download-artifact@v4 | ||||
|         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: Publish to NuGet | ||||
|         id: publish-success | ||||
|         uses: G-Research/common-actions/publish-nuget@2b7dc49cb14f3344fbe6019c14a31165e258c059 | ||||
|         with: | ||||
|           package-name: WoofWare.Myriad.Plugins | ||||
|           nuget-key: ${{ secrets.NUGET_API_KEY }} | ||||
|           nupkg-dir: packed/ | ||||
|           dotnet: ${{ steps.dotnet-identify.outputs.dotnet }} | ||||
|  | ||||
|   github-release-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@v4 | ||||
|       - name: Download NuGet artifact (plugin) | ||||
|         uses: actions/download-artifact@v4 | ||||
|         with: | ||||
|           name: nuget-package-plugin | ||||
|       - name: Download NuGet artifact (attribute) | ||||
|         uses: actions/download-artifact@v4 | ||||
|         with: | ||||
|           name: nuget-package-attribute | ||||
|       - name: Tag and release plugin | ||||
|         env: | ||||
|           GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} | ||||
|         run: sh .github/workflows/tag.sh | ||||
|   | ||||
							
								
								
									
										56
									
								
								.github/workflows/flake_update.yaml
									
									
									
									
										vendored
									
									
										Normal file
									
								
							
							
						
						
									
										56
									
								
								.github/workflows/flake_update.yaml
									
									
									
									
										vendored
									
									
										Normal file
									
								
							| @@ -0,0 +1,56 @@ | ||||
| # 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@v4 | ||||
|  | ||||
|       - 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 passthru | ||||
|         run: 'nix build ".#default.passthru.fetch-deps"' | ||||
|  | ||||
|       - name: Run passthru | ||||
|         run: | | ||||
|             set -o pipefail | ||||
|             ./result nix/deps.nix | ||||
|  | ||||
|       - name: Format | ||||
|         run: 'nix develop --command alejandra .' | ||||
|  | ||||
|       - name: Create token | ||||
|         id: generate-token | ||||
|         uses: actions/create-github-app-token@v1 | ||||
|         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@cc25e6d80a796c49669dda4a0aa36c54c573983d | ||||
|         id: cpr | ||||
|         with: | ||||
|             bearer-token: ${{ steps.generate-token.outputs.token }} | ||||
|             pr-title: "Upgrade Nix flake and deps" | ||||
|  | ||||
|       - 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 | ||||
							
								
								
									
										120
									
								
								.github/workflows/tag.sh
									
									
									
									
										vendored
									
									
										Normal file
									
								
							
							
						
						
									
										120
									
								
								.github/workflows/tag.sh
									
									
									
									
										vendored
									
									
										Normal file
									
								
							| @@ -0,0 +1,120 @@ | ||||
| #!/bin/bash | ||||
|  | ||||
| echo "Dry-run? $DRY_RUN!" | ||||
|  | ||||
| find . -maxdepth 1 -type f ! -name "$(printf "*\n*")" -name '*.nupkg' | while IFS= read -r file | ||||
| do | ||||
|     tag=$(basename "$file" .nupkg) | ||||
|     git tag "$tag" | ||||
|     ${DRY_RUN:+echo} git push origin "$tag" | ||||
| done | ||||
|  | ||||
| export TAG | ||||
| TAG=$(find . -maxdepth 1 -type f -name 'WoofWare.Myriad.Plugins.*.nupkg' -exec sh -c 'basename "$1" .nupkg' shell {} \; | grep -v Attributes) | ||||
|  | ||||
| case "$TAG" in | ||||
|   *" | ||||
| "*) | ||||
|     echo "Error: TAG contains a newline; multiple plugins found." | ||||
|     exit 1 | ||||
|     ;; | ||||
| esac | ||||
|  | ||||
| # target_commitish empty indicates the repo default branch | ||||
| curl_body='{"tag_name":"'"$TAG"'","target_commitish":"","name":"'"$TAG"'","draft":false,"prerelease":false,"generate_release_notes":false}' | ||||
|  | ||||
| echo "cURL body: $curl_body" | ||||
|  | ||||
| failed_output=$(cat <<'EOF' | ||||
| { | ||||
|   "message": "Validation Failed", | ||||
|   "errors": [ | ||||
|     { | ||||
|       "resource": "Release", | ||||
|       "code": "already_exists", | ||||
|       "field": "tag_name" | ||||
|     } | ||||
|   ], | ||||
|   "documentation_url": "https://docs.github.com/rest/releases/releases#create-a-release" | ||||
| } | ||||
| EOF | ||||
| ) | ||||
|  | ||||
| success_output=$(cat <<'EOF' | ||||
| { | ||||
|   "url": "https://api.github.com/repos/Smaug123/WoofWare.Myriad/releases/158152116", | ||||
|   "assets_url": "https://api.github.com/repos/Smaug123/WoofWare.Myriad/releases/158152116/assets", | ||||
|   "upload_url": "https://uploads.github.com/repos/Smaug123/WoofWare.Myriad/releases/158152116/assets{?name,label}", | ||||
|   "html_url": "https://github.com/Smaug123/WoofWare.Myriad/releases/tag/WoofWare.Myriad.Plugins.2.1.30", | ||||
|   "id": 158152116, | ||||
|   "author": { | ||||
|     "login": "github-actions[bot]", | ||||
|     "id": 41898282, | ||||
|     "node_id": "MDM6Qm90NDE4OTgyODI=", | ||||
|     "avatar_url": "https://avatars.githubusercontent.com/in/15368?v=4", | ||||
|     "gravatar_id": "", | ||||
|     "url": "https://api.github.com/users/github-actions%5Bbot%5D", | ||||
|     "html_url": "https://github.com/apps/github-actions", | ||||
|     "followers_url": "https://api.github.com/users/github-actions%5Bbot%5D/followers", | ||||
|     "following_url": "https://api.github.com/users/github-actions%5Bbot%5D/following{/other_user}", | ||||
|     "gists_url": "https://api.github.com/users/github-actions%5Bbot%5D/gists{/gist_id}", | ||||
|     "starred_url": "https://api.github.com/users/github-actions%5Bbot%5D/starred{/owner}{/repo}", | ||||
|     "subscriptions_url": "https://api.github.com/users/github-actions%5Bbot%5D/subscriptions", | ||||
|     "organizations_url": "https://api.github.com/users/github-actions%5Bbot%5D/orgs", | ||||
|     "repos_url": "https://api.github.com/users/github-actions%5Bbot%5D/repos", | ||||
|     "events_url": "https://api.github.com/users/github-actions%5Bbot%5D/events{/privacy}", | ||||
|     "received_events_url": "https://api.github.com/users/github-actions%5Bbot%5D/received_events", | ||||
|     "type": "Bot", | ||||
|     "site_admin": false | ||||
|   }, | ||||
|   "node_id": "RE_kwDOJfksgc4JbTW0", | ||||
|   "tag_name": "WoofWare.Myriad.Plugins.2.1.30", | ||||
|   "target_commitish": "main", | ||||
|   "name": "WoofWare.Myriad.Plugins.2.1.30", | ||||
|   "draft": false, | ||||
|   "prerelease": false, | ||||
|   "created_at": "2024-05-30T11:00:55Z", | ||||
|   "published_at": "2024-05-30T11:03:02Z", | ||||
|   "assets": [ | ||||
|  | ||||
|   ], | ||||
|   "tarball_url": "https://api.github.com/repos/Smaug123/WoofWare.Myriad/tarball/WoofWare.Myriad.Plugins.2.1.30", | ||||
|   "zipball_url": "https://api.github.com/repos/Smaug123/WoofWare.Myriad/zipball/WoofWare.Myriad.Plugins.2.1.30", | ||||
|   "body": null | ||||
| } | ||||
| EOF | ||||
| ) | ||||
|  | ||||
| HANDLE_OUTPUT='' | ||||
| handle_error() { | ||||
|     ERROR_OUTPUT="$1" | ||||
|     exit_message=$(echo "$ERROR_OUTPUT" | jq -r --exit-status 'if .errors | length == 1 then .errors[0].code else null end') | ||||
|     if [ "$exit_message" = "already_exists" ] ; then | ||||
|         HANDLE_OUTPUT="Did not create GitHub release because it already exists at this version." | ||||
|     else | ||||
|         echo "Unexpected error output from curl: $(cat curl_output.json)" | ||||
|         echo "JQ output: $(exit_message)" | ||||
|         exit 2 | ||||
|     fi | ||||
| } | ||||
|  | ||||
| run_tests() { | ||||
|     handle_error "$failed_output" | ||||
|     if [ "$HANDLE_OUTPUT" != "Did not create GitHub release because it already exists at this version." ]; then | ||||
|         echo "Bad output from handler: $HANDLE_OUTPUT" | ||||
|         exit 3 | ||||
|     fi | ||||
|     HANDLE_OUTPUT='' | ||||
|     echo "Tests passed." | ||||
| } | ||||
|  | ||||
| run_tests | ||||
|  | ||||
| if [ "$DRY_RUN" != 1 ] ; then | ||||
|     if curl --fail-with-body -L -X POST -H "Accept: application/vnd.github+json" -H "Authorization: Bearer $GITHUB_TOKEN" -H "X-GitHub-Api-Version: 2022-11-28" https://api.github.com/repos/Smaug123/WoofWare.Myriad/releases -d "$curl_body" > curl_output.json; then | ||||
|         echo "Curl succeeded." | ||||
|     else | ||||
|         handle_error "$(cat curl_output.json)" | ||||
|         echo "$HANDLE_OUTPUT" | ||||
|     fi | ||||
| fi | ||||
							
								
								
									
										25
									
								
								.gitignore
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										25
									
								
								.gitignore
									
									
									
									
										vendored
									
									
								
							| @@ -1,11 +1,14 @@ | ||||
| bin/ | ||||
| obj/ | ||||
| /packages/ | ||||
| riderModule.iml | ||||
| /_ReSharper.Caches/ | ||||
| .idea/ | ||||
| *.sln.DotSettings.user | ||||
| .DS_Store | ||||
| result | ||||
| .analyzerpackages/ | ||||
| analysis.sarif | ||||
| bin/ | ||||
| obj/ | ||||
| /packages/ | ||||
| riderModule.iml | ||||
| /_ReSharper.Caches/ | ||||
| .idea/ | ||||
| *.sln.DotSettings.user | ||||
| .DS_Store | ||||
| result | ||||
| .analyzerpackages/ | ||||
| analysis.sarif | ||||
| .direnv/ | ||||
| .venv/ | ||||
| .vs/ | ||||
|   | ||||
							
								
								
									
										45
									
								
								CHANGELOG.md
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										45
									
								
								CHANGELOG.md
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,45 @@ | ||||
| Notable changes are recorded here. | ||||
|  | ||||
| # 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. | ||||
							
								
								
									
										237
									
								
								ConsumePlugin/Args.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										237
									
								
								ConsumePlugin/Args.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,237 @@ | ||||
| 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 | ||||
|     } | ||||
							
								
								
									
										22
									
								
								ConsumePlugin/Catamorphism.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										22
									
								
								ConsumePlugin/Catamorphism.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,22 @@ | ||||
| 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> | ||||
| @@ -3,6 +3,7 @@ | ||||
|   <PropertyGroup> | ||||
|     <TargetFramework>net8.0</TargetFramework> | ||||
|     <IsPackable>false</IsPackable> | ||||
|     <OtherFlags>--reflectionfree $(OtherFlags)</OtherFlags> | ||||
|   </PropertyGroup> | ||||
|   <ItemGroup> | ||||
|     <MyriadSdkGenerator Include="$(MSBuildThisFileDirectory)..\WoofWare.Myriad.Plugins\bin\$(Configuration)\net6.0\WoofWare.Myriad.Plugins.dll"/> | ||||
| @@ -31,6 +32,20 @@ | ||||
|     <Compile Include="GeneratedMock.fs"> | ||||
|       <MyriadFile>MockExample.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="Vault.fs" /> | ||||
|     <Compile Include="GeneratedVault.fs"> | ||||
|       <MyriadFile>Vault.fs</MyriadFile> | ||||
| @@ -39,13 +54,40 @@ | ||||
|     <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> | ||||
|     <PackageReference Include="RestEase" Version="1.6.4"/> | ||||
|     <ProjectReference Include="..\WoofWare.Myriad.Plugins\WoofWare.Myriad.Plugins.fsproj"/> | ||||
|     <PackageReference Include="Myriad.Sdk" Version="0.8.3"/> | ||||
|     <PackageReference Include="Myriad.Core" Version="0.8.3"/> | ||||
|     <ProjectReference Include="..\WoofWare.Myriad.Plugins.Attributes\WoofWare.Myriad.Plugins.Attributes.fsproj" /> | ||||
|     <ProjectReference Include="..\WoofWare.Myriad.Plugins\WoofWare.Myriad.Plugins.fsproj" PrivateAssets="all" /> | ||||
|     <PackageReference Include="Myriad.Sdk" Version="0.8.3" PrivateAssets="all" /> | ||||
|   </ItemGroup> | ||||
|  | ||||
| </Project> | ||||
|   | ||||
							
								
								
									
										64
									
								
								ConsumePlugin/FSharpForFunAndProfitCata.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										64
									
								
								ConsumePlugin/FSharpForFunAndProfitCata.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,64 @@ | ||||
| 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 | ||||
							
								
								
									
										42444
									
								
								ConsumePlugin/Generated2SwaggerGitea.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										42444
									
								
								ConsumePlugin/Generated2SwaggerGitea.fs
									
									
									
									
									
										Normal file
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							
							
								
								
									
										4327
									
								
								ConsumePlugin/GeneratedArgs.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										4327
									
								
								ConsumePlugin/GeneratedArgs.fs
									
									
									
									
									
										Normal file
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							
							
								
								
									
										138
									
								
								ConsumePlugin/GeneratedCatamorphism.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										138
									
								
								ConsumePlugin/GeneratedCatamorphism.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,138 @@ | ||||
| //------------------------------------------------------------------------------ | ||||
| //        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 | ||||
							
								
								
									
										152
									
								
								ConsumePlugin/GeneratedFileSystem.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										152
									
								
								ConsumePlugin/GeneratedFileSystem.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,152 @@ | ||||
| //------------------------------------------------------------------------------ | ||||
| //        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 | ||||
| @@ -4,16 +4,42 @@ | ||||
| //------------------------------------------------------------------------------ | ||||
|  | ||||
|  | ||||
| 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 |> System.Text.Json.Nodes.JsonValue.Create<string>)) | ||||
|         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 |> System.Text.Json.Nodes.JsonValue.Create<string>)) | ||||
|             node :> _ | ||||
|  | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| /// Module containing JSON parsing methods for the InnerType type | ||||
| [<RequireQualifiedAccess>] | ||||
| [<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>] | ||||
| [<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>] | ||||
| module InnerType = | ||||
|     /// Parse from a JSON node. | ||||
|     let jsonParse (node : System.Text.Json.Nodes.JsonNode) : InnerType = | ||||
|         let Thing = | ||||
|         let arg_0 = | ||||
|             (match node.[(Literals.something)] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -23,20 +49,19 @@ module InnerType = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsValue() | ||||
|                 .GetValue<string> () | ||||
|                 .GetValue<System.String> () | ||||
|  | ||||
|         { | ||||
|             Thing = Thing | ||||
|             Thing = arg_0 | ||||
|         } | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| /// Module containing JSON parsing methods for the JsonRecordType type | ||||
| [<RequireQualifiedAccess>] | ||||
| [<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>] | ||||
| [<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>] | ||||
| module JsonRecordType = | ||||
|     /// Parse from a JSON node. | ||||
|     let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordType = | ||||
|         let F = | ||||
|         let arg_5 = | ||||
|             (match node.["f"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -46,10 +71,10 @@ module JsonRecordType = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsArray () | ||||
|             |> Seq.map (fun elt -> elt.AsValue().GetValue<int> ()) | ||||
|             |> Seq.map (fun elt -> elt.AsValue().GetValue<System.Int32> ()) | ||||
|             |> Array.ofSeq | ||||
|  | ||||
|         let E = | ||||
|         let arg_4 = | ||||
|             (match node.["e"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -59,10 +84,10 @@ module JsonRecordType = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsArray () | ||||
|             |> Seq.map (fun elt -> elt.AsValue().GetValue<string> ()) | ||||
|             |> Seq.map (fun elt -> elt.AsValue().GetValue<System.String> ()) | ||||
|             |> Array.ofSeq | ||||
|  | ||||
|         let D = | ||||
|         let arg_3 = | ||||
|             InnerType.jsonParse ( | ||||
|                 match node.["d"] with | ||||
|                 | null -> | ||||
| @@ -74,7 +99,7 @@ module JsonRecordType = | ||||
|                 | v -> v | ||||
|             ) | ||||
|  | ||||
|         let C = | ||||
|         let arg_2 = | ||||
|             (match node.["hi"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -84,10 +109,10 @@ module JsonRecordType = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsArray () | ||||
|             |> Seq.map (fun elt -> elt.AsValue().GetValue<int> ()) | ||||
|             |> Seq.map (fun elt -> elt.AsValue().GetValue<System.Int32> ()) | ||||
|             |> List.ofSeq | ||||
|  | ||||
|         let B = | ||||
|         let arg_1 = | ||||
|             (match node.["another-thing"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -97,9 +122,9 @@ module JsonRecordType = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsValue() | ||||
|                 .GetValue<string> () | ||||
|                 .GetValue<System.String> () | ||||
|  | ||||
|         let A = | ||||
|         let arg_0 = | ||||
|             (match node.["a"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -109,18 +134,65 @@ module JsonRecordType = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsValue() | ||||
|                 .GetValue<int> () | ||||
|                 .GetValue<System.Int32> () | ||||
|  | ||||
|         { | ||||
|             A = A | ||||
|             B = B | ||||
|             C = C | ||||
|             D = D | ||||
|             E = E | ||||
|             F = F | ||||
|             A = arg_0 | ||||
|             B = arg_1 | ||||
|             C = arg_2 | ||||
|             D = arg_3 | ||||
|             E = arg_4 | ||||
|             F = arg_5 | ||||
|         } | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| /// Module containing JSON parsing 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)] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
|                      System.Collections.Generic.KeyNotFoundException ( | ||||
|                          sprintf "Required key '%s' not found on JSON object" ((Literals.something)) | ||||
|                      ) | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .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)] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ((Literals.something)) | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.String> () | ||||
|  | ||||
|             { | ||||
|                 ExternalThing = arg_0 | ||||
|             } | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| /// Module containing JSON parsing extension members for the ToGetExtensionMethod type | ||||
| [<AutoOpen>] | ||||
| module ToGetExtensionMethodJsonParseExtension = | ||||
| @@ -129,24 +201,230 @@ module ToGetExtensionMethodJsonParseExtension = | ||||
|  | ||||
|         /// Parse from a JSON node. | ||||
|         static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : ToGetExtensionMethod = | ||||
|             let Sailor = | ||||
|                 (match node.["sailor"] with | ||||
|             let arg_20 = System.Numerics.BigInteger.Parse (node.["whiskey"].ToJsonString ()) | ||||
|  | ||||
|             let arg_19 = | ||||
|                 (match node.["victor"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("sailor") | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("victor") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<float> () | ||||
|                     .GetValue<System.Char> () | ||||
|  | ||||
|             let Soldier = | ||||
|                 (match node.["soldier"] with | ||||
|             let arg_18 = | ||||
|                 (match node.["uniform"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("soldier") | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("uniform") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.Decimal> () | ||||
|  | ||||
|             let arg_17 = | ||||
|                 (match node.["tango"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("tango") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.SByte> () | ||||
|  | ||||
|             let arg_16 = | ||||
|                 (match node.["quebec"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("quebec") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.Byte> () | ||||
|  | ||||
|             let arg_15 = | ||||
|                 (match node.["papa"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("papa") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.Byte> () | ||||
|  | ||||
|             let arg_14 = | ||||
|                 (match node.["oscar"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("oscar") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.SByte> () | ||||
|  | ||||
|             let arg_13 = | ||||
|                 (match node.["november"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("november") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.UInt16> () | ||||
|  | ||||
|             let arg_12 = | ||||
|                 (match node.["mike"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("mike") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.Int16> () | ||||
|  | ||||
|             let arg_11 = | ||||
|                 (match node.["lima"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("lima") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.UInt32> () | ||||
|  | ||||
|             let arg_10 = | ||||
|                 (match node.["kilo"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("kilo") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.Int32> () | ||||
|  | ||||
|             let arg_9 = | ||||
|                 (match node.["juliette"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("juliette") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.UInt32> () | ||||
|  | ||||
|             let arg_8 = | ||||
|                 (match node.["india"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("india") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.Int32> () | ||||
|  | ||||
|             let arg_7 = | ||||
|                 (match node.["hotel"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("hotel") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.UInt64> () | ||||
|  | ||||
|             let arg_6 = | ||||
|                 (match node.["golf"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("golf") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.Int64> () | ||||
|  | ||||
|             let arg_5 = | ||||
|                 (match node.["foxtrot"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("foxtrot") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.Double> () | ||||
|  | ||||
|             let arg_4 = | ||||
|                 (match node.["echo"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("echo") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.Single> () | ||||
|  | ||||
|             let arg_3 = | ||||
|                 (match node.["delta"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("delta") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.Single> () | ||||
|  | ||||
|             let arg_2 = | ||||
|                 (match node.["charlie"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("charlie") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.Double> () | ||||
|  | ||||
|             let arg_1 = | ||||
|                 (match node.["bravo"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("bravo") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
| @@ -154,33 +432,38 @@ module ToGetExtensionMethodJsonParseExtension = | ||||
|                     .GetValue<string> () | ||||
|                 |> System.Uri | ||||
|  | ||||
|             let Tailor = | ||||
|                 (match node.["tailor"] with | ||||
|             let arg_0 = | ||||
|                 (match node.["alpha"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("tailor") | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("alpha") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<int> () | ||||
|  | ||||
|             let Tinker = | ||||
|                 (match node.["tinker"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("tinker") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<string> () | ||||
|                     .GetValue<System.String> () | ||||
|  | ||||
|             { | ||||
|                 Tinker = Tinker | ||||
|                 Tailor = Tailor | ||||
|                 Soldier = Soldier | ||||
|                 Sailor = Sailor | ||||
|                 Alpha = arg_0 | ||||
|                 Bravo = arg_1 | ||||
|                 Charlie = arg_2 | ||||
|                 Delta = arg_3 | ||||
|                 Echo = arg_4 | ||||
|                 Foxtrot = arg_5 | ||||
|                 Golf = arg_6 | ||||
|                 Hotel = arg_7 | ||||
|                 India = arg_8 | ||||
|                 Juliette = arg_9 | ||||
|                 Kilo = arg_10 | ||||
|                 Lima = arg_11 | ||||
|                 Mike = arg_12 | ||||
|                 November = arg_13 | ||||
|                 Oscar = arg_14 | ||||
|                 Papa = arg_15 | ||||
|                 Quebec = arg_16 | ||||
|                 Tango = arg_17 | ||||
|                 Uniform = arg_18 | ||||
|                 Victor = arg_19 | ||||
|                 Whiskey = arg_20 | ||||
|             } | ||||
|   | ||||
| @@ -5,6 +5,9 @@ | ||||
|  | ||||
| namespace SomeNamespace | ||||
|  | ||||
| open System | ||||
| open WoofWare.Myriad.Plugins | ||||
|  | ||||
| /// Mock record type for an interface | ||||
| type internal PublicTypeMock = | ||||
|     { | ||||
| @@ -13,19 +16,48 @@ type internal PublicTypeMock = | ||||
|         Mem3 : int * option<System.Threading.CancellationToken> -> string | ||||
|     } | ||||
|  | ||||
|     /// An implementation where every method throws. | ||||
|     static member Empty : PublicTypeMock = | ||||
|         { | ||||
|             Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) | ||||
|             Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) | ||||
|             Mem3 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) | ||||
|             Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: 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) = this.Mem1 (arg_0_0, arg_0_1) | ||||
|         member this.Mem2 (arg_0_0) = this.Mem2 (arg_0_0) | ||||
|         member this.Mem2 arg_0_0 = this.Mem2 (arg_0_0) | ||||
|         member this.Mem3 (arg_0_0, arg_0_1) = this.Mem3 (arg_0_0, arg_0_1) | ||||
| namespace SomeNamespace | ||||
|  | ||||
| open System | ||||
| open WoofWare.Myriad.Plugins | ||||
|  | ||||
| /// Mock record type for an interface | ||||
| 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 | ||||
| type internal InternalTypeMock = | ||||
|     { | ||||
| @@ -33,17 +65,21 @@ type internal InternalTypeMock = | ||||
|         Mem2 : string -> int | ||||
|     } | ||||
|  | ||||
|     /// An implementation where every method throws. | ||||
|     static member Empty : InternalTypeMock = | ||||
|         { | ||||
|             Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) | ||||
|             Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) | ||||
|             Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1")) | ||||
|             Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2")) | ||||
|         } | ||||
|  | ||||
|     interface InternalType with | ||||
|         member this.Mem1 (arg_0_0, arg_0_1) = this.Mem1 (arg_0_0, arg_0_1) | ||||
|         member this.Mem2 (arg_0_0) = this.Mem2 (arg_0_0) | ||||
|         member this.Mem2 arg_0_0 = this.Mem2 (arg_0_0) | ||||
| namespace SomeNamespace | ||||
|  | ||||
| open System | ||||
| open WoofWare.Myriad.Plugins | ||||
|  | ||||
| /// Mock record type for an interface | ||||
| type private PrivateTypeMock = | ||||
|     { | ||||
| @@ -51,32 +87,62 @@ type private PrivateTypeMock = | ||||
|         Mem2 : string -> int | ||||
|     } | ||||
|  | ||||
|     /// An implementation where every method throws. | ||||
|     static member Empty : PrivateTypeMock = | ||||
|         { | ||||
|             Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) | ||||
|             Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) | ||||
|             Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1")) | ||||
|             Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2")) | ||||
|         } | ||||
|  | ||||
|     interface PrivateType with | ||||
|         member this.Mem1 (arg_0_0, arg_0_1) = this.Mem1 (arg_0_0, arg_0_1) | ||||
|         member this.Mem2 (arg_0_0) = this.Mem2 (arg_0_0) | ||||
|         member this.Mem2 arg_0_0 = this.Mem2 (arg_0_0) | ||||
| namespace SomeNamespace | ||||
|  | ||||
| open System | ||||
| open WoofWare.Myriad.Plugins | ||||
|  | ||||
| /// Mock record type for an interface | ||||
| 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 | ||||
| type internal VeryPublicTypeMock<'a, 'b> = | ||||
|     { | ||||
|         Mem1 : 'a -> 'b | ||||
|     } | ||||
|  | ||||
|     /// An implementation where every method throws. | ||||
|     static member Empty () : VeryPublicTypeMock<'a, 'b> = | ||||
|         { | ||||
|             Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) | ||||
|             Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1")) | ||||
|         } | ||||
|  | ||||
|     interface VeryPublicType<'a, 'b> with | ||||
|         member this.Mem1 (arg_0_0) = this.Mem1 (arg_0_0) | ||||
|         member this.Mem1 arg_0_0 = this.Mem1 (arg_0_0) | ||||
| namespace SomeNamespace | ||||
|  | ||||
| open System | ||||
| open WoofWare.Myriad.Plugins | ||||
|  | ||||
| /// Mock record type for an interface | ||||
| type internal CurriedMock<'a> = | ||||
|     { | ||||
| @@ -88,20 +154,21 @@ type internal CurriedMock<'a> = | ||||
|         Mem6 : int * string -> 'a * int -> string | ||||
|     } | ||||
|  | ||||
|     /// An implementation where every method throws. | ||||
|     static member Empty () : CurriedMock<'a> = | ||||
|         { | ||||
|             Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) | ||||
|             Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) | ||||
|             Mem3 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) | ||||
|             Mem4 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) | ||||
|             Mem5 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) | ||||
|             Mem6 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) | ||||
|             Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: 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) = this.Mem1 (arg_0_0) (arg_1_0) | ||||
|         member this.Mem2 (arg_0_0, arg_0_1) (arg_1_0) = this.Mem2 (arg_0_0, arg_0_1) (arg_1_0) | ||||
|         member this.Mem3 ((arg_0_0, arg_0_1)) (arg_1_0) = this.Mem3 (arg_0_0, arg_0_1) (arg_1_0) | ||||
|         member this.Mem1 arg_0_0 arg_1_0 = this.Mem1 (arg_0_0) (arg_1_0) | ||||
|         member this.Mem2 (arg_0_0, arg_0_1) arg_1_0 = this.Mem2 (arg_0_0, arg_0_1) (arg_1_0) | ||||
|         member this.Mem3 ((arg_0_0, arg_0_1)) arg_1_0 = this.Mem3 (arg_0_0, arg_0_1) (arg_1_0) | ||||
|  | ||||
|         member this.Mem4 ((arg_0_0, arg_0_1)) ((arg_1_0, arg_1_1)) = | ||||
|             this.Mem4 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1) | ||||
| @@ -111,3 +178,31 @@ type internal CurriedMock<'a> = | ||||
|  | ||||
|         member this.Mem6 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1) = | ||||
|             this.Mem6 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1) | ||||
| namespace SomeNamespace | ||||
|  | ||||
| open System | ||||
| open WoofWare.Myriad.Plugins | ||||
|  | ||||
| /// Mock record type for an interface | ||||
| type internal TypeWithInterfaceMock = | ||||
|     { | ||||
|         /// Implementation of IDisposable.Dispose | ||||
|         Dispose : unit -> unit | ||||
|         Mem1 : string option -> string[] Async | ||||
|         Mem2 : unit -> string[] Async | ||||
|     } | ||||
|  | ||||
|     /// An implementation where every method throws. | ||||
|     static member Empty : TypeWithInterfaceMock = | ||||
|         { | ||||
|             Dispose = (fun () -> ()) | ||||
|             Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: 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 () | ||||
|   | ||||
							
								
								
									
										200
									
								
								ConsumePlugin/GeneratedMockNoAttributes.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										200
									
								
								ConsumePlugin/GeneratedMockNoAttributes.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,200 @@ | ||||
| //------------------------------------------------------------------------------ | ||||
| //        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
											
										
									
								
							| @@ -21,69 +21,69 @@ module InnerTypeWithBothJsonSerializeExtension = | ||||
|             let node = System.Text.Json.Nodes.JsonObject () | ||||
|  | ||||
|             do | ||||
|                 node.Add (("it's-a-me"), System.Text.Json.Nodes.JsonValue.Create<string> input.Thing) | ||||
|                 node.Add (("it's-a-me"), (input.Thing |> System.Text.Json.Nodes.JsonValue.Create<Guid>)) | ||||
|  | ||||
|                 node.Add ( | ||||
|                     "map", | ||||
|                     (fun field -> | ||||
|                         let ret = System.Text.Json.Nodes.JsonObject () | ||||
|                     (input.Map | ||||
|                      |> (fun field -> | ||||
|                          let ret = System.Text.Json.Nodes.JsonObject () | ||||
|  | ||||
|                         for (KeyValue (key, value)) in field do | ||||
|                             ret.Add (key.ToString (), System.Text.Json.Nodes.JsonValue.Create<Uri> value) | ||||
|                          for (KeyValue (key, value)) in field do | ||||
|                              ret.Add (key.ToString (), System.Text.Json.Nodes.JsonValue.Create<Uri> value) | ||||
|  | ||||
|                         ret | ||||
|                     ) | ||||
|                         input.Map | ||||
|                          ret | ||||
|                      )) | ||||
|                 ) | ||||
|  | ||||
|                 node.Add ( | ||||
|                     "readOnlyDict", | ||||
|                     (fun field -> | ||||
|                         let ret = System.Text.Json.Nodes.JsonObject () | ||||
|                     (input.ReadOnlyDict | ||||
|                      |> (fun field -> | ||||
|                          let ret = System.Text.Json.Nodes.JsonObject () | ||||
|  | ||||
|                         for (KeyValue (key, value)) in field do | ||||
|                             ret.Add ( | ||||
|                                 key.ToString (), | ||||
|                                 (fun field -> | ||||
|                                     let arr = System.Text.Json.Nodes.JsonArray () | ||||
|                          for (KeyValue (key, value)) in field do | ||||
|                              ret.Add ( | ||||
|                                  key.ToString (), | ||||
|                                  (fun field -> | ||||
|                                      let arr = System.Text.Json.Nodes.JsonArray () | ||||
|  | ||||
|                                     for mem in field do | ||||
|                                         arr.Add (System.Text.Json.Nodes.JsonValue.Create<char> mem) | ||||
|                                      for mem in field do | ||||
|                                          arr.Add (System.Text.Json.Nodes.JsonValue.Create<char> mem) | ||||
|  | ||||
|                                     arr | ||||
|                                 ) | ||||
|                                     value | ||||
|                             ) | ||||
|                                      arr | ||||
|                                  ) | ||||
|                                      value | ||||
|                              ) | ||||
|  | ||||
|                         ret | ||||
|                     ) | ||||
|                         input.ReadOnlyDict | ||||
|                          ret | ||||
|                      )) | ||||
|                 ) | ||||
|  | ||||
|                 node.Add ( | ||||
|                     "dict", | ||||
|                     (fun field -> | ||||
|                         let ret = System.Text.Json.Nodes.JsonObject () | ||||
|                     (input.Dict | ||||
|                      |> (fun field -> | ||||
|                          let ret = System.Text.Json.Nodes.JsonObject () | ||||
|  | ||||
|                         for (KeyValue (key, value)) in field do | ||||
|                             ret.Add (key.ToString (), System.Text.Json.Nodes.JsonValue.Create<bool> value) | ||||
|                          for (KeyValue (key, value)) in field do | ||||
|                              ret.Add (key.ToString (), System.Text.Json.Nodes.JsonValue.Create<bool> value) | ||||
|  | ||||
|                         ret | ||||
|                     ) | ||||
|                         input.Dict | ||||
|                          ret | ||||
|                      )) | ||||
|                 ) | ||||
|  | ||||
|                 node.Add ( | ||||
|                     "concreteDict", | ||||
|                     (fun field -> | ||||
|                         let ret = System.Text.Json.Nodes.JsonObject () | ||||
|                     (input.ConcreteDict | ||||
|                      |> (fun field -> | ||||
|                          let ret = System.Text.Json.Nodes.JsonObject () | ||||
|  | ||||
|                         for (KeyValue (key, value)) in field do | ||||
|                             ret.Add (key.ToString (), InnerTypeWithBoth.toJsonNode value) | ||||
|                          for (KeyValue (key, value)) in field do | ||||
|                              ret.Add (key.ToString (), InnerTypeWithBoth.toJsonNode value) | ||||
|  | ||||
|                         ret | ||||
|                     ) | ||||
|                         input.ConcreteDict | ||||
|                          ret | ||||
|                      )) | ||||
|                 ) | ||||
|  | ||||
|             node :> _ | ||||
| @@ -93,6 +93,24 @@ open System | ||||
| open System.Collections.Generic | ||||
| open System.Text.Json.Serialization | ||||
|  | ||||
| /// Module containing JSON serializing extension members for the SomeEnum type | ||||
| [<AutoOpen>] | ||||
| module SomeEnumJsonSerializeExtension = | ||||
|     /// Extension methods for JSON parsing | ||||
|     type SomeEnum with | ||||
|  | ||||
|         /// Serialize to a JSON node | ||||
|         static member toJsonNode (input : SomeEnum) : System.Text.Json.Nodes.JsonNode = | ||||
|             match input with | ||||
|             | SomeEnum.Blah -> System.Text.Json.Nodes.JsonValue.Create 1 | ||||
|             | SomeEnum.Thing -> System.Text.Json.Nodes.JsonValue.Create 0 | ||||
|             | v -> failwith (sprintf "Unrecognised value for enum: %O" v) | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| open System | ||||
| open System.Collections.Generic | ||||
| open System.Text.Json.Serialization | ||||
|  | ||||
| /// Module containing JSON serializing extension members for the JsonRecordTypeWithBoth type | ||||
| [<AutoOpen>] | ||||
| module JsonRecordTypeWithBothJsonSerializeExtension = | ||||
| @@ -104,50 +122,230 @@ module JsonRecordTypeWithBothJsonSerializeExtension = | ||||
|             let node = System.Text.Json.Nodes.JsonObject () | ||||
|  | ||||
|             do | ||||
|                 node.Add ("a", System.Text.Json.Nodes.JsonValue.Create<int> input.A) | ||||
|                 node.Add ("b", System.Text.Json.Nodes.JsonValue.Create<string> input.B) | ||||
|                 node.Add ("a", (input.A |> System.Text.Json.Nodes.JsonValue.Create<int>)) | ||||
|                 node.Add ("b", (input.B |> System.Text.Json.Nodes.JsonValue.Create<string>)) | ||||
|  | ||||
|                 node.Add ( | ||||
|                     "c", | ||||
|                     (fun field -> | ||||
|                         let arr = System.Text.Json.Nodes.JsonArray () | ||||
|                     (input.C | ||||
|                      |> (fun field -> | ||||
|                          let arr = System.Text.Json.Nodes.JsonArray () | ||||
|  | ||||
|                         for mem in field do | ||||
|                             arr.Add (System.Text.Json.Nodes.JsonValue.Create<int> mem) | ||||
|                          for mem in field do | ||||
|                              arr.Add (System.Text.Json.Nodes.JsonValue.Create<int> mem) | ||||
|  | ||||
|                         arr | ||||
|                     ) | ||||
|                         input.C | ||||
|                          arr | ||||
|                      )) | ||||
|                 ) | ||||
|  | ||||
|                 node.Add ("d", InnerTypeWithBoth.toJsonNode input.D) | ||||
|                 node.Add ("d", (input.D |> InnerTypeWithBoth.toJsonNode)) | ||||
|  | ||||
|                 node.Add ( | ||||
|                     "e", | ||||
|                     (fun field -> | ||||
|                         let arr = System.Text.Json.Nodes.JsonArray () | ||||
|                     (input.E | ||||
|                      |> (fun field -> | ||||
|                          let arr = System.Text.Json.Nodes.JsonArray () | ||||
|  | ||||
|                         for mem in field do | ||||
|                             arr.Add (System.Text.Json.Nodes.JsonValue.Create<string> mem) | ||||
|                          for mem in field do | ||||
|                              arr.Add (System.Text.Json.Nodes.JsonValue.Create<string> mem) | ||||
|  | ||||
|                         arr | ||||
|                     ) | ||||
|                         input.E | ||||
|                          arr | ||||
|                      )) | ||||
|                 ) | ||||
|  | ||||
|                 node.Add ( | ||||
|                     "f", | ||||
|                     (fun field -> | ||||
|                         let arr = System.Text.Json.Nodes.JsonArray () | ||||
|                     "arr", | ||||
|                     (input.Arr | ||||
|                      |> (fun field -> | ||||
|                          let arr = System.Text.Json.Nodes.JsonArray () | ||||
|  | ||||
|                         for mem in field do | ||||
|                             arr.Add (System.Text.Json.Nodes.JsonValue.Create<int> mem) | ||||
|                          for mem in field do | ||||
|                              arr.Add (System.Text.Json.Nodes.JsonValue.Create<int> mem) | ||||
|  | ||||
|                         arr | ||||
|                     ) | ||||
|                         input.F | ||||
|                          arr | ||||
|                      )) | ||||
|                 ) | ||||
|  | ||||
|                 node.Add ("byte", (input.Byte |> System.Text.Json.Nodes.JsonValue.Create<byte<measure>>)) | ||||
|                 node.Add ("sbyte", (input.Sbyte |> System.Text.Json.Nodes.JsonValue.Create<sbyte<measure>>)) | ||||
|                 node.Add ("i", (input.I |> System.Text.Json.Nodes.JsonValue.Create<int<measure>>)) | ||||
|                 node.Add ("i32", (input.I32 |> System.Text.Json.Nodes.JsonValue.Create<int32<measure>>)) | ||||
|                 node.Add ("i64", (input.I64 |> System.Text.Json.Nodes.JsonValue.Create<int64<measure>>)) | ||||
|                 node.Add ("u", (input.U |> System.Text.Json.Nodes.JsonValue.Create<uint<measure>>)) | ||||
|                 node.Add ("u32", (input.U32 |> System.Text.Json.Nodes.JsonValue.Create<uint32<measure>>)) | ||||
|                 node.Add ("u64", (input.U64 |> System.Text.Json.Nodes.JsonValue.Create<uint64<measure>>)) | ||||
|                 node.Add ("f", (input.F |> System.Text.Json.Nodes.JsonValue.Create<float<measure>>)) | ||||
|                 node.Add ("f32", (input.F32 |> System.Text.Json.Nodes.JsonValue.Create<float32<measure>>)) | ||||
|                 node.Add ("single", (input.Single |> System.Text.Json.Nodes.JsonValue.Create<single<measure>>)) | ||||
|  | ||||
|                 node.Add ( | ||||
|                     "intMeasureOption", | ||||
|                     (input.IntMeasureOption | ||||
|                      |> (fun field -> | ||||
|                          match field with | ||||
|                          | None -> null :> System.Text.Json.Nodes.JsonNode | ||||
|                          | Some field -> | ||||
|                              (System.Text.Json.Nodes.JsonValue.Create<int<measure>> field) | ||||
|                              :> System.Text.Json.Nodes.JsonNode | ||||
|                      )) | ||||
|                 ) | ||||
|  | ||||
|                 node.Add ( | ||||
|                     "intMeasureNullable", | ||||
|                     (input.IntMeasureNullable | ||||
|                      |> (fun field -> | ||||
|                          if field.HasValue then | ||||
|                              System.Text.Json.Nodes.JsonValue.Create<int<measure>> field.Value | ||||
|                              :> System.Text.Json.Nodes.JsonNode | ||||
|                          else | ||||
|                              null :> System.Text.Json.Nodes.JsonNode | ||||
|                      )) | ||||
|                 ) | ||||
|  | ||||
|                 node.Add ("enum", (input.Enum |> SomeEnum.toJsonNode)) | ||||
|  | ||||
|                 node.Add ( | ||||
|                     "timestamp", | ||||
|                     (input.Timestamp | ||||
|                      |> (fun field -> field.ToString "o" |> System.Text.Json.Nodes.JsonValue.Create<string>)) | ||||
|                 ) | ||||
|  | ||||
|                 node.Add ("unit", (input.Unit |> (fun value -> System.Text.Json.Nodes.JsonObject ()))) | ||||
|  | ||||
|             node :> _ | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| open System | ||||
| open System.Collections.Generic | ||||
| open System.Text.Json.Serialization | ||||
|  | ||||
| /// Module containing JSON serializing extension members for the FirstDu type | ||||
| [<AutoOpen>] | ||||
| module FirstDuJsonSerializeExtension = | ||||
|     /// Extension methods for JSON parsing | ||||
|     type FirstDu with | ||||
|  | ||||
|         /// Serialize to a JSON node | ||||
|         static member toJsonNode (input : FirstDu) : System.Text.Json.Nodes.JsonNode = | ||||
|             let node = System.Text.Json.Nodes.JsonObject () | ||||
|  | ||||
|             match input with | ||||
|             | FirstDu.EmptyCase -> node.Add ("type", System.Text.Json.Nodes.JsonValue.Create "emptyCase") | ||||
|             | FirstDu.Case1 arg0 -> | ||||
|                 node.Add ("type", System.Text.Json.Nodes.JsonValue.Create "case1") | ||||
|                 let dataNode = System.Text.Json.Nodes.JsonObject () | ||||
|                 dataNode.Add ("data", System.Text.Json.Nodes.JsonValue.Create<string> arg0) | ||||
|                 node.Add ("data", dataNode) | ||||
|             | FirstDu.Case2 (arg0, arg1) -> | ||||
|                 node.Add ("type", System.Text.Json.Nodes.JsonValue.Create "case2") | ||||
|                 let dataNode = System.Text.Json.Nodes.JsonObject () | ||||
|                 dataNode.Add ("record", JsonRecordTypeWithBoth.toJsonNode arg0) | ||||
|                 dataNode.Add ("i", System.Text.Json.Nodes.JsonValue.Create<int> arg1) | ||||
|                 node.Add ("data", dataNode) | ||||
|  | ||||
|             node :> _ | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| open System | ||||
| open System.Collections.Generic | ||||
| open System.Text.Json.Serialization | ||||
|  | ||||
| /// Module containing JSON serializing extension members for the HeaderAndValue type | ||||
| [<AutoOpen>] | ||||
| module HeaderAndValueJsonSerializeExtension = | ||||
|     /// Extension methods for JSON parsing | ||||
|     type HeaderAndValue with | ||||
|  | ||||
|         /// Serialize to a JSON node | ||||
|         static member toJsonNode (input : HeaderAndValue) : System.Text.Json.Nodes.JsonNode = | ||||
|             let node = System.Text.Json.Nodes.JsonObject () | ||||
|  | ||||
|             do | ||||
|                 node.Add ("header", (input.Header |> System.Text.Json.Nodes.JsonValue.Create<string>)) | ||||
|                 node.Add ("value", (input.Value |> System.Text.Json.Nodes.JsonValue.Create<string>)) | ||||
|  | ||||
|             node :> _ | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| open System | ||||
| open System.Collections.Generic | ||||
| open System.Text.Json.Serialization | ||||
|  | ||||
| /// Module containing JSON serializing extension members for the Foo type | ||||
| [<AutoOpen>] | ||||
| module FooJsonSerializeExtension = | ||||
|     /// Extension methods for JSON parsing | ||||
|     type Foo with | ||||
|  | ||||
|         /// Serialize to a JSON node | ||||
|         static member toJsonNode (input : Foo) : System.Text.Json.Nodes.JsonNode = | ||||
|             let node = System.Text.Json.Nodes.JsonObject () | ||||
|  | ||||
|             do | ||||
|                 node.Add ( | ||||
|                     "message", | ||||
|                     (input.Message | ||||
|                      |> (fun field -> | ||||
|                          match field with | ||||
|                          | None -> null :> System.Text.Json.Nodes.JsonNode | ||||
|                          | Some field -> HeaderAndValue.toJsonNode field | ||||
|                      )) | ||||
|                 ) | ||||
|  | ||||
|             node :> _ | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| open System | ||||
| open System.Collections.Generic | ||||
| open System.Text.Json.Serialization | ||||
|  | ||||
| /// Module containing JSON serializing extension members for the CollectRemaining type | ||||
| [<AutoOpen>] | ||||
| module CollectRemainingJsonSerializeExtension = | ||||
|     /// Extension methods for JSON parsing | ||||
|     type CollectRemaining with | ||||
|  | ||||
|         /// Serialize to a JSON node | ||||
|         static member toJsonNode (input : CollectRemaining) : System.Text.Json.Nodes.JsonNode = | ||||
|             let node = System.Text.Json.Nodes.JsonObject () | ||||
|  | ||||
|             do | ||||
|                 node.Add ( | ||||
|                     "message", | ||||
|                     (input.Message | ||||
|                      |> (fun field -> | ||||
|                          match field with | ||||
|                          | None -> null :> System.Text.Json.Nodes.JsonNode | ||||
|                          | Some field -> HeaderAndValue.toJsonNode field | ||||
|                      )) | ||||
|                 ) | ||||
|  | ||||
|                 for KeyValue (key, value) in input.Rest do | ||||
|                     node.Add (key, id value) | ||||
|  | ||||
|             node :> _ | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| open System | ||||
| open System.Collections.Generic | ||||
| open System.Text.Json.Serialization | ||||
|  | ||||
| /// Module containing JSON serializing extension members for the OuterCollectRemaining type | ||||
| [<AutoOpen>] | ||||
| module OuterCollectRemainingJsonSerializeExtension = | ||||
|     /// Extension methods for JSON parsing | ||||
|     type OuterCollectRemaining with | ||||
|  | ||||
|         /// Serialize to a JSON node | ||||
|         static member toJsonNode (input : OuterCollectRemaining) : System.Text.Json.Nodes.JsonNode = | ||||
|             let node = System.Text.Json.Nodes.JsonObject () | ||||
|  | ||||
|             do | ||||
|                 for KeyValue (key, value) in input.Others do | ||||
|                     node.Add (key, System.Text.Json.Nodes.JsonValue.Create<int> value) | ||||
|  | ||||
|                 node.Add ("remaining", (input.Remaining |> CollectRemaining.toJsonNode)) | ||||
|  | ||||
|             node :> _ | ||||
|  | ||||
| namespace ConsumePlugin | ||||
| @@ -160,7 +358,7 @@ module InnerTypeWithBothJsonParseExtension = | ||||
|  | ||||
|         /// Parse from a JSON node. | ||||
|         static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : InnerTypeWithBoth = | ||||
|             let ConcreteDict = | ||||
|             let arg_4 = | ||||
|                 (match node.["concreteDict"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
| @@ -178,7 +376,7 @@ module InnerTypeWithBothJsonParseExtension = | ||||
|                 |> Seq.map System.Collections.Generic.KeyValuePair | ||||
|                 |> System.Collections.Generic.Dictionary | ||||
|  | ||||
|             let Dict = | ||||
|             let arg_3 = | ||||
|                 (match node.["dict"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
| @@ -190,12 +388,12 @@ module InnerTypeWithBothJsonParseExtension = | ||||
|                     .AsObject () | ||||
|                 |> Seq.map (fun kvp -> | ||||
|                     let key = (kvp.Key) |> System.Uri | ||||
|                     let value = (kvp.Value).AsValue().GetValue<bool> () | ||||
|                     let value = (kvp.Value).AsValue().GetValue<System.Boolean> () | ||||
|                     key, value | ||||
|                 ) | ||||
|                 |> dict | ||||
|  | ||||
|             let ReadOnlyDict = | ||||
|             let arg_2 = | ||||
|                 (match node.["readOnlyDict"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
| @@ -210,14 +408,14 @@ module InnerTypeWithBothJsonParseExtension = | ||||
|  | ||||
|                     let value = | ||||
|                         (kvp.Value).AsArray () | ||||
|                         |> Seq.map (fun elt -> elt.AsValue().GetValue<char> ()) | ||||
|                         |> Seq.map (fun elt -> elt.AsValue().GetValue<System.Char> ()) | ||||
|                         |> List.ofSeq | ||||
|  | ||||
|                     key, value | ||||
|                 ) | ||||
|                 |> readOnlyDict | ||||
|  | ||||
|             let Map = | ||||
|             let arg_1 = | ||||
|                 (match node.["map"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
| @@ -234,7 +432,7 @@ module InnerTypeWithBothJsonParseExtension = | ||||
|                 ) | ||||
|                 |> Map.ofSeq | ||||
|  | ||||
|             let Thing = | ||||
|             let arg_0 = | ||||
|                 (match node.[("it's-a-me")] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
| @@ -245,16 +443,35 @@ module InnerTypeWithBothJsonParseExtension = | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<string> () | ||||
|                 |> System.Guid.Parse | ||||
|  | ||||
|             { | ||||
|                 Thing = Thing | ||||
|                 Map = Map | ||||
|                 ReadOnlyDict = ReadOnlyDict | ||||
|                 Dict = Dict | ||||
|                 ConcreteDict = ConcreteDict | ||||
|                 Thing = arg_0 | ||||
|                 Map = arg_1 | ||||
|                 ReadOnlyDict = arg_2 | ||||
|                 Dict = arg_3 | ||||
|                 ConcreteDict = arg_4 | ||||
|             } | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| /// Module containing JSON parsing extension members for the SomeEnum type | ||||
| [<AutoOpen>] | ||||
| module SomeEnumJsonParseExtension = | ||||
|     /// Extension methods for JSON parsing | ||||
|     type SomeEnum with | ||||
|  | ||||
|         /// Parse from a JSON node. | ||||
|         static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : SomeEnum = | ||||
|             match node.GetValueKind () with | ||||
|             | System.Text.Json.JsonValueKind.Number -> node.AsValue().GetValue<int> () |> enum<SomeEnum> | ||||
|             | System.Text.Json.JsonValueKind.String -> | ||||
|                 match node.AsValue().GetValue<string>().ToLowerInvariant () with | ||||
|                 | "blah" -> SomeEnum.Blah | ||||
|                 | "thing" -> SomeEnum.Thing | ||||
|                 | v -> failwith ("Unrecognised value for enum: %i" + v) | ||||
|             | _ -> failwith ("Unrecognised kind for enum of type: " + "SomeEnum") | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| /// Module containing JSON parsing extension members for the JsonRecordTypeWithBoth type | ||||
| [<AutoOpen>] | ||||
| module JsonRecordTypeWithBothJsonParseExtension = | ||||
| @@ -263,7 +480,76 @@ module JsonRecordTypeWithBothJsonParseExtension = | ||||
|  | ||||
|         /// Parse from a JSON node. | ||||
|         static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordTypeWithBoth = | ||||
|             let F = | ||||
|             let arg_21 = () | ||||
|  | ||||
|             let arg_20 = | ||||
|                 (match node.["timestamp"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("timestamp") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<string> () | ||||
|                 |> System.DateTimeOffset.Parse | ||||
|  | ||||
|             let arg_19 = | ||||
|                 SomeEnum.jsonParse ( | ||||
|                     match node.["enum"] with | ||||
|                     | null -> | ||||
|                         raise ( | ||||
|                             System.Collections.Generic.KeyNotFoundException ( | ||||
|                                 sprintf "Required key '%s' not found on JSON object" ("enum") | ||||
|                             ) | ||||
|                         ) | ||||
|                     | v -> v | ||||
|                 ) | ||||
|  | ||||
|             let arg_18 = | ||||
|                 match node.["intMeasureNullable"] with | ||||
|                 | null -> System.Nullable () | ||||
|                 | v -> | ||||
|                     v.AsValue().GetValue<System.Int32> () | ||||
|                     |> LanguagePrimitives.Int32WithMeasure | ||||
|                     |> System.Nullable | ||||
|  | ||||
|             let arg_17 = | ||||
|                 match node.["intMeasureOption"] with | ||||
|                 | null -> None | ||||
|                 | v -> | ||||
|                     v.AsValue().GetValue<System.Int32> () | ||||
|                     |> LanguagePrimitives.Int32WithMeasure | ||||
|                     |> Some | ||||
|  | ||||
|             let arg_16 = | ||||
|                 (match node.["single"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("single") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.Single> () | ||||
|                 |> LanguagePrimitives.Float32WithMeasure | ||||
|  | ||||
|             let arg_15 = | ||||
|                 (match node.["f32"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("f32") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.Single> () | ||||
|                 |> LanguagePrimitives.Float32WithMeasure | ||||
|  | ||||
|             let arg_14 = | ||||
|                 (match node.["f"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
| @@ -271,12 +557,129 @@ module JsonRecordTypeWithBothJsonParseExtension = | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("f") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.Double> () | ||||
|                 |> LanguagePrimitives.FloatWithMeasure | ||||
|  | ||||
|             let arg_13 = | ||||
|                 (match node.["u64"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("u64") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.UInt64> () | ||||
|                 |> LanguagePrimitives.UInt64WithMeasure | ||||
|  | ||||
|             let arg_12 = | ||||
|                 (match node.["u32"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("u32") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.UInt32> () | ||||
|                 |> LanguagePrimitives.UInt32WithMeasure | ||||
|  | ||||
|             let arg_11 = | ||||
|                 (match node.["u"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("u") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.UInt32> () | ||||
|                 |> LanguagePrimitives.UInt32WithMeasure | ||||
|  | ||||
|             let arg_10 = | ||||
|                 (match node.["i64"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("i64") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.Int64> () | ||||
|                 |> LanguagePrimitives.Int64WithMeasure | ||||
|  | ||||
|             let arg_9 = | ||||
|                 (match node.["i32"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("i32") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.Int32> () | ||||
|                 |> LanguagePrimitives.Int32WithMeasure | ||||
|  | ||||
|             let arg_8 = | ||||
|                 (match node.["i"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("i") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.Int32> () | ||||
|                 |> LanguagePrimitives.Int32WithMeasure | ||||
|  | ||||
|             let arg_7 = | ||||
|                 (match node.["sbyte"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("sbyte") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.SByte> () | ||||
|                 |> LanguagePrimitives.SByteWithMeasure | ||||
|  | ||||
|             let arg_6 = | ||||
|                 (match node.["byte"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("byte") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.Byte> () | ||||
|                 |> LanguagePrimitives.ByteWithMeasure | ||||
|  | ||||
|             let arg_5 = | ||||
|                 (match node.["arr"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("arr") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsArray () | ||||
|                 |> Seq.map (fun elt -> elt.AsValue().GetValue<int> ()) | ||||
|                 |> Seq.map (fun elt -> elt.AsValue().GetValue<System.Int32> ()) | ||||
|                 |> Array.ofSeq | ||||
|  | ||||
|             let E = | ||||
|             let arg_4 = | ||||
|                 (match node.["e"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
| @@ -286,10 +689,10 @@ module JsonRecordTypeWithBothJsonParseExtension = | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsArray () | ||||
|                 |> Seq.map (fun elt -> elt.AsValue().GetValue<string> ()) | ||||
|                 |> Seq.map (fun elt -> elt.AsValue().GetValue<System.String> ()) | ||||
|                 |> Array.ofSeq | ||||
|  | ||||
|             let D = | ||||
|             let arg_3 = | ||||
|                 InnerTypeWithBoth.jsonParse ( | ||||
|                     match node.["d"] with | ||||
|                     | null -> | ||||
| @@ -301,7 +704,7 @@ module JsonRecordTypeWithBothJsonParseExtension = | ||||
|                     | v -> v | ||||
|                 ) | ||||
|  | ||||
|             let C = | ||||
|             let arg_2 = | ||||
|                 (match node.["c"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
| @@ -311,10 +714,10 @@ module JsonRecordTypeWithBothJsonParseExtension = | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsArray () | ||||
|                 |> Seq.map (fun elt -> elt.AsValue().GetValue<int> ()) | ||||
|                 |> Seq.map (fun elt -> elt.AsValue().GetValue<System.Int32> ()) | ||||
|                 |> List.ofSeq | ||||
|  | ||||
|             let B = | ||||
|             let arg_1 = | ||||
|                 (match node.["b"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
| @@ -324,9 +727,9 @@ module JsonRecordTypeWithBothJsonParseExtension = | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<string> () | ||||
|                     .GetValue<System.String> () | ||||
|  | ||||
|             let A = | ||||
|             let arg_0 = | ||||
|                 (match node.["a"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
| @@ -336,13 +739,245 @@ module JsonRecordTypeWithBothJsonParseExtension = | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<int> () | ||||
|                     .GetValue<System.Int32> () | ||||
|  | ||||
|             { | ||||
|                 A = A | ||||
|                 B = B | ||||
|                 C = C | ||||
|                 D = D | ||||
|                 E = E | ||||
|                 F = F | ||||
|                 A = arg_0 | ||||
|                 B = arg_1 | ||||
|                 C = arg_2 | ||||
|                 D = arg_3 | ||||
|                 E = arg_4 | ||||
|                 Arr = arg_5 | ||||
|                 Byte = arg_6 | ||||
|                 Sbyte = arg_7 | ||||
|                 I = arg_8 | ||||
|                 I32 = arg_9 | ||||
|                 I64 = arg_10 | ||||
|                 U = arg_11 | ||||
|                 U32 = arg_12 | ||||
|                 U64 = arg_13 | ||||
|                 F = arg_14 | ||||
|                 F32 = arg_15 | ||||
|                 Single = arg_16 | ||||
|                 IntMeasureOption = arg_17 | ||||
|                 IntMeasureNullable = arg_18 | ||||
|                 Enum = arg_19 | ||||
|                 Timestamp = arg_20 | ||||
|                 Unit = arg_21 | ||||
|             } | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| /// Module containing JSON parsing extension members for the FirstDu type | ||||
| [<AutoOpen>] | ||||
| module FirstDuJsonParseExtension = | ||||
|     /// Extension methods for JSON parsing | ||||
|     type FirstDu with | ||||
|  | ||||
|         /// Parse from a JSON node. | ||||
|         static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : FirstDu = | ||||
|             let ty = | ||||
|                 (match node.["type"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("type") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                 |> (fun v -> v.GetValue<string> ()) | ||||
|  | ||||
|             match ty with | ||||
|             | "emptyCase" -> FirstDu.EmptyCase | ||||
|             | "case1" -> | ||||
|                 let node = | ||||
|                     (match node.["data"] with | ||||
|                      | null -> | ||||
|                          raise ( | ||||
|                              System.Collections.Generic.KeyNotFoundException ( | ||||
|                                  sprintf "Required key '%s' not found on JSON object" ("data") | ||||
|                              ) | ||||
|                          ) | ||||
|                      | v -> v) | ||||
|  | ||||
|                 FirstDu.Case1 ( | ||||
|                     (match node.["data"] with | ||||
|                      | null -> | ||||
|                          raise ( | ||||
|                              System.Collections.Generic.KeyNotFoundException ( | ||||
|                                  sprintf "Required key '%s' not found on JSON object" ("data") | ||||
|                              ) | ||||
|                          ) | ||||
|                      | v -> v) | ||||
|                         .AsValue() | ||||
|                         .GetValue<System.String> () | ||||
|                 ) | ||||
|             | "case2" -> | ||||
|                 let node = | ||||
|                     (match node.["data"] with | ||||
|                      | null -> | ||||
|                          raise ( | ||||
|                              System.Collections.Generic.KeyNotFoundException ( | ||||
|                                  sprintf "Required key '%s' not found on JSON object" ("data") | ||||
|                              ) | ||||
|                          ) | ||||
|                      | v -> v) | ||||
|  | ||||
|                 FirstDu.Case2 ( | ||||
|                     JsonRecordTypeWithBoth.jsonParse ( | ||||
|                         match node.["record"] with | ||||
|                         | null -> | ||||
|                             raise ( | ||||
|                                 System.Collections.Generic.KeyNotFoundException ( | ||||
|                                     sprintf "Required key '%s' not found on JSON object" ("record") | ||||
|                                 ) | ||||
|                             ) | ||||
|                         | v -> v | ||||
|                     ), | ||||
|                     (match node.["i"] with | ||||
|                      | null -> | ||||
|                          raise ( | ||||
|                              System.Collections.Generic.KeyNotFoundException ( | ||||
|                                  sprintf "Required key '%s' not found on JSON object" ("i") | ||||
|                              ) | ||||
|                          ) | ||||
|                      | v -> v) | ||||
|                         .AsValue() | ||||
|                         .GetValue<System.Int32> () | ||||
|                 ) | ||||
|             | v -> failwith ("Unrecognised 'type' field value: " + v) | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| /// Module containing JSON parsing extension members for the HeaderAndValue type | ||||
| [<AutoOpen>] | ||||
| module HeaderAndValueJsonParseExtension = | ||||
|     /// Extension methods for JSON parsing | ||||
|     type HeaderAndValue with | ||||
|  | ||||
|         /// Parse from a JSON node. | ||||
|         static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : HeaderAndValue = | ||||
|             let arg_1 = | ||||
|                 (match node.["value"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("value") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.String> () | ||||
|  | ||||
|             let arg_0 = | ||||
|                 (match node.["header"] with | ||||
|                  | null -> | ||||
|                      raise ( | ||||
|                          System.Collections.Generic.KeyNotFoundException ( | ||||
|                              sprintf "Required key '%s' not found on JSON object" ("header") | ||||
|                          ) | ||||
|                      ) | ||||
|                  | v -> v) | ||||
|                     .AsValue() | ||||
|                     .GetValue<System.String> () | ||||
|  | ||||
|             { | ||||
|                 Header = arg_0 | ||||
|                 Value = arg_1 | ||||
|             } | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| /// Module containing JSON parsing extension members for the Foo type | ||||
| [<AutoOpen>] | ||||
| module FooJsonParseExtension = | ||||
|     /// Extension methods for JSON parsing | ||||
|     type Foo with | ||||
|  | ||||
|         /// Parse from a JSON node. | ||||
|         static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : Foo = | ||||
|             let arg_0 = | ||||
|                 match node.["message"] with | ||||
|                 | null -> None | ||||
|                 | v -> HeaderAndValue.jsonParse v |> Some | ||||
|  | ||||
|             { | ||||
|                 Message = arg_0 | ||||
|             } | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| /// Module containing JSON parsing extension members for the CollectRemaining type | ||||
| [<AutoOpen>] | ||||
| module CollectRemainingJsonParseExtension = | ||||
|     /// Extension methods for JSON parsing | ||||
|     type CollectRemaining with | ||||
|  | ||||
|         /// Parse from a JSON node. | ||||
|         static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : CollectRemaining = | ||||
|             let arg_1 = | ||||
|                 let result = | ||||
|                     System.Collections.Generic.Dictionary<string, System.Text.Json.Nodes.JsonNode> () | ||||
|  | ||||
|                 let node = node.AsObject () | ||||
|  | ||||
|                 for KeyValue (key, value) in node do | ||||
|                     if key = "message" then () else result.Add (key, node.[key]) | ||||
|  | ||||
|                 result | ||||
|  | ||||
|             let arg_0 = | ||||
|                 match node.["message"] with | ||||
|                 | null -> None | ||||
|                 | v -> HeaderAndValue.jsonParse v |> Some | ||||
|  | ||||
|             { | ||||
|                 Message = arg_0 | ||||
|                 Rest = arg_1 | ||||
|             } | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| /// Module containing JSON parsing extension members for the OuterCollectRemaining type | ||||
| [<AutoOpen>] | ||||
| module OuterCollectRemainingJsonParseExtension = | ||||
|     /// Extension methods for JSON parsing | ||||
|     type OuterCollectRemaining with | ||||
|  | ||||
|         /// Parse from a JSON node. | ||||
|         static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : OuterCollectRemaining = | ||||
|             let arg_1 = | ||||
|                 CollectRemaining.jsonParse ( | ||||
|                     match node.["remaining"] with | ||||
|                     | null -> | ||||
|                         raise ( | ||||
|                             System.Collections.Generic.KeyNotFoundException ( | ||||
|                                 sprintf "Required key '%s' not found on JSON object" ("remaining") | ||||
|                             ) | ||||
|                         ) | ||||
|                     | v -> v | ||||
|                 ) | ||||
|  | ||||
|             let arg_0 = | ||||
|                 let result = System.Collections.Generic.Dictionary<string, int> () | ||||
|                 let node = node.AsObject () | ||||
|  | ||||
|                 for KeyValue (key, value) in node do | ||||
|                     if key = "remaining" then | ||||
|                         () | ||||
|                     else | ||||
|                         result.Add ( | ||||
|                             key, | ||||
|                             (match node.[key] with | ||||
|                              | null -> | ||||
|                                  raise ( | ||||
|                                      System.Collections.Generic.KeyNotFoundException ( | ||||
|                                          sprintf "Required key '%s' not found on JSON object" (key) | ||||
|                                      ) | ||||
|                                  ) | ||||
|                              | v -> v) | ||||
|                                 .AsValue() | ||||
|                                 .GetValue<System.Int32> () | ||||
|                         ) | ||||
|  | ||||
|                 result | ||||
|  | ||||
|             { | ||||
|                 Others = arg_0 | ||||
|                 Remaining = arg_1 | ||||
|             } | ||||
|   | ||||
							
								
								
									
										6432
									
								
								ConsumePlugin/GeneratedSwaggerGitea.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										6432
									
								
								ConsumePlugin/GeneratedSwaggerGitea.fs
									
									
									
									
									
										Normal file
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							| @@ -8,12 +8,11 @@ | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| /// Module containing JSON parsing methods for the JwtVaultAuthResponse type | ||||
| [<RequireQualifiedAccess>] | ||||
| [<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>] | ||||
| [<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>] | ||||
| module JwtVaultAuthResponse = | ||||
|     /// Parse from a JSON node. | ||||
|     let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultAuthResponse = | ||||
|         let NumUses = | ||||
|         let arg_10 = | ||||
|             (match node.["num_uses"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -23,9 +22,9 @@ module JwtVaultAuthResponse = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsValue() | ||||
|                 .GetValue<int> () | ||||
|                 .GetValue<System.Int32> () | ||||
|  | ||||
|         let Orphan = | ||||
|         let arg_9 = | ||||
|             (match node.["orphan"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -35,9 +34,9 @@ module JwtVaultAuthResponse = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsValue() | ||||
|                 .GetValue<bool> () | ||||
|                 .GetValue<System.Boolean> () | ||||
|  | ||||
|         let EntityId = | ||||
|         let arg_8 = | ||||
|             (match node.["entity_id"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -47,9 +46,9 @@ module JwtVaultAuthResponse = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsValue() | ||||
|                 .GetValue<string> () | ||||
|                 .GetValue<System.String> () | ||||
|  | ||||
|         let TokenType = | ||||
|         let arg_7 = | ||||
|             (match node.["token_type"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -59,9 +58,9 @@ module JwtVaultAuthResponse = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsValue() | ||||
|                 .GetValue<string> () | ||||
|                 .GetValue<System.String> () | ||||
|  | ||||
|         let Renewable = | ||||
|         let arg_6 = | ||||
|             (match node.["renewable"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -71,9 +70,9 @@ module JwtVaultAuthResponse = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsValue() | ||||
|                 .GetValue<bool> () | ||||
|                 .GetValue<System.Boolean> () | ||||
|  | ||||
|         let LeaseDuration = | ||||
|         let arg_5 = | ||||
|             (match node.["lease_duration"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -83,9 +82,9 @@ module JwtVaultAuthResponse = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsValue() | ||||
|                 .GetValue<int> () | ||||
|                 .GetValue<System.Int32> () | ||||
|  | ||||
|         let IdentityPolicies = | ||||
|         let arg_4 = | ||||
|             (match node.["identity_policies"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -95,10 +94,10 @@ module JwtVaultAuthResponse = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsArray () | ||||
|             |> Seq.map (fun elt -> elt.AsValue().GetValue<string> ()) | ||||
|             |> Seq.map (fun elt -> elt.AsValue().GetValue<System.String> ()) | ||||
|             |> List.ofSeq | ||||
|  | ||||
|         let TokenPolicies = | ||||
|         let arg_3 = | ||||
|             (match node.["token_policies"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -108,10 +107,10 @@ module JwtVaultAuthResponse = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsArray () | ||||
|             |> Seq.map (fun elt -> elt.AsValue().GetValue<string> ()) | ||||
|             |> Seq.map (fun elt -> elt.AsValue().GetValue<System.String> ()) | ||||
|             |> List.ofSeq | ||||
|  | ||||
|         let Policies = | ||||
|         let arg_2 = | ||||
|             (match node.["policies"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -121,10 +120,10 @@ module JwtVaultAuthResponse = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsArray () | ||||
|             |> Seq.map (fun elt -> elt.AsValue().GetValue<string> ()) | ||||
|             |> Seq.map (fun elt -> elt.AsValue().GetValue<System.String> ()) | ||||
|             |> List.ofSeq | ||||
|  | ||||
|         let Accessor = | ||||
|         let arg_1 = | ||||
|             (match node.["accessor"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -134,9 +133,9 @@ module JwtVaultAuthResponse = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsValue() | ||||
|                 .GetValue<string> () | ||||
|                 .GetValue<System.String> () | ||||
|  | ||||
|         let ClientToken = | ||||
|         let arg_0 = | ||||
|             (match node.["client_token"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -146,30 +145,29 @@ module JwtVaultAuthResponse = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsValue() | ||||
|                 .GetValue<string> () | ||||
|                 .GetValue<System.String> () | ||||
|  | ||||
|         { | ||||
|             ClientToken = ClientToken | ||||
|             Accessor = Accessor | ||||
|             Policies = Policies | ||||
|             TokenPolicies = TokenPolicies | ||||
|             IdentityPolicies = IdentityPolicies | ||||
|             LeaseDuration = LeaseDuration | ||||
|             Renewable = Renewable | ||||
|             TokenType = TokenType | ||||
|             EntityId = EntityId | ||||
|             Orphan = Orphan | ||||
|             NumUses = NumUses | ||||
|             ClientToken = arg_0 | ||||
|             Accessor = arg_1 | ||||
|             Policies = arg_2 | ||||
|             TokenPolicies = arg_3 | ||||
|             IdentityPolicies = arg_4 | ||||
|             LeaseDuration = arg_5 | ||||
|             Renewable = arg_6 | ||||
|             TokenType = arg_7 | ||||
|             EntityId = arg_8 | ||||
|             Orphan = arg_9 | ||||
|             NumUses = arg_10 | ||||
|         } | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| /// Module containing JSON parsing methods for the JwtVaultResponse type | ||||
| [<RequireQualifiedAccess>] | ||||
| [<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>] | ||||
| [<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>] | ||||
| module JwtVaultResponse = | ||||
|     /// Parse from a JSON node. | ||||
|     let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultResponse = | ||||
|         let Auth = | ||||
|         let arg_4 = | ||||
|             JwtVaultAuthResponse.jsonParse ( | ||||
|                 match node.["auth"] with | ||||
|                 | null -> | ||||
| @@ -181,7 +179,7 @@ module JwtVaultResponse = | ||||
|                 | v -> v | ||||
|             ) | ||||
|  | ||||
|         let LeaseDuration = | ||||
|         let arg_3 = | ||||
|             (match node.["lease_duration"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -191,9 +189,9 @@ module JwtVaultResponse = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsValue() | ||||
|                 .GetValue<int> () | ||||
|                 .GetValue<System.Int32> () | ||||
|  | ||||
|         let Renewable = | ||||
|         let arg_2 = | ||||
|             (match node.["renewable"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -203,9 +201,9 @@ module JwtVaultResponse = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsValue() | ||||
|                 .GetValue<bool> () | ||||
|                 .GetValue<System.Boolean> () | ||||
|  | ||||
|         let LeaseId = | ||||
|         let arg_1 = | ||||
|             (match node.["lease_id"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -215,9 +213,9 @@ module JwtVaultResponse = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsValue() | ||||
|                 .GetValue<string> () | ||||
|                 .GetValue<System.String> () | ||||
|  | ||||
|         let RequestId = | ||||
|         let arg_0 = | ||||
|             (match node.["request_id"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -227,24 +225,23 @@ module JwtVaultResponse = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsValue() | ||||
|                 .GetValue<string> () | ||||
|                 .GetValue<System.String> () | ||||
|  | ||||
|         { | ||||
|             RequestId = RequestId | ||||
|             LeaseId = LeaseId | ||||
|             Renewable = Renewable | ||||
|             LeaseDuration = LeaseDuration | ||||
|             Auth = Auth | ||||
|             RequestId = arg_0 | ||||
|             LeaseId = arg_1 | ||||
|             Renewable = arg_2 | ||||
|             LeaseDuration = arg_3 | ||||
|             Auth = arg_4 | ||||
|         } | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| /// Module containing JSON parsing methods for the JwtSecretResponse type | ||||
| [<RequireQualifiedAccess>] | ||||
| [<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>] | ||||
| [<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>] | ||||
| module JwtSecretResponse = | ||||
|     /// Parse from a JSON node. | ||||
|     let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtSecretResponse = | ||||
|         let Data8 = | ||||
|         let arg_11 = | ||||
|             (match node.["data8"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -262,7 +259,7 @@ module JwtSecretResponse = | ||||
|             |> Seq.map System.Collections.Generic.KeyValuePair | ||||
|             |> System.Collections.Generic.Dictionary | ||||
|  | ||||
|         let Data7 = | ||||
|         let arg_10 = | ||||
|             (match node.["data7"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -274,12 +271,12 @@ module JwtSecretResponse = | ||||
|                 .AsObject () | ||||
|             |> Seq.map (fun kvp -> | ||||
|                 let key = (kvp.Key) | ||||
|                 let value = (kvp.Value).AsValue().GetValue<int> () | ||||
|                 let value = (kvp.Value).AsValue().GetValue<System.Int32> () | ||||
|                 key, value | ||||
|             ) | ||||
|             |> Map.ofSeq | ||||
|  | ||||
|         let Data6 = | ||||
|         let arg_9 = | ||||
|             (match node.["data6"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -291,12 +288,12 @@ module JwtSecretResponse = | ||||
|                 .AsObject () | ||||
|             |> Seq.map (fun kvp -> | ||||
|                 let key = (kvp.Key) |> System.Uri | ||||
|                 let value = (kvp.Value).AsValue().GetValue<string> () | ||||
|                 let value = (kvp.Value).AsValue().GetValue<System.String> () | ||||
|                 key, value | ||||
|             ) | ||||
|             |> dict | ||||
|  | ||||
|         let Data5 = | ||||
|         let arg_8 = | ||||
|             (match node.["data5"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -308,12 +305,12 @@ module JwtSecretResponse = | ||||
|                 .AsObject () | ||||
|             |> Seq.map (fun kvp -> | ||||
|                 let key = (kvp.Key) |> System.Uri | ||||
|                 let value = (kvp.Value).AsValue().GetValue<string> () | ||||
|                 let value = (kvp.Value).AsValue().GetValue<System.String> () | ||||
|                 key, value | ||||
|             ) | ||||
|             |> readOnlyDict | ||||
|  | ||||
|         let Data4 = | ||||
|         let arg_7 = | ||||
|             (match node.["data4"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -325,12 +322,12 @@ module JwtSecretResponse = | ||||
|                 .AsObject () | ||||
|             |> Seq.map (fun kvp -> | ||||
|                 let key = (kvp.Key) | ||||
|                 let value = (kvp.Value).AsValue().GetValue<string> () | ||||
|                 let value = (kvp.Value).AsValue().GetValue<System.String> () | ||||
|                 key, value | ||||
|             ) | ||||
|             |> Map.ofSeq | ||||
|  | ||||
|         let Data3 = | ||||
|         let arg_6 = | ||||
|             (match node.["data3"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -342,13 +339,13 @@ module JwtSecretResponse = | ||||
|                 .AsObject () | ||||
|             |> Seq.map (fun kvp -> | ||||
|                 let key = (kvp.Key) | ||||
|                 let value = (kvp.Value).AsValue().GetValue<string> () | ||||
|                 let value = (kvp.Value).AsValue().GetValue<System.String> () | ||||
|                 key, value | ||||
|             ) | ||||
|             |> Seq.map System.Collections.Generic.KeyValuePair | ||||
|             |> System.Collections.Generic.Dictionary | ||||
|  | ||||
|         let Data2 = | ||||
|         let arg_5 = | ||||
|             (match node.["data2"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -360,12 +357,12 @@ module JwtSecretResponse = | ||||
|                 .AsObject () | ||||
|             |> Seq.map (fun kvp -> | ||||
|                 let key = (kvp.Key) | ||||
|                 let value = (kvp.Value).AsValue().GetValue<string> () | ||||
|                 let value = (kvp.Value).AsValue().GetValue<System.String> () | ||||
|                 key, value | ||||
|             ) | ||||
|             |> dict | ||||
|  | ||||
|         let Data = | ||||
|         let arg_4 = | ||||
|             (match node.["data"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -377,12 +374,12 @@ module JwtSecretResponse = | ||||
|                 .AsObject () | ||||
|             |> Seq.map (fun kvp -> | ||||
|                 let key = (kvp.Key) | ||||
|                 let value = (kvp.Value).AsValue().GetValue<string> () | ||||
|                 let value = (kvp.Value).AsValue().GetValue<System.String> () | ||||
|                 key, value | ||||
|             ) | ||||
|             |> readOnlyDict | ||||
|  | ||||
|         let LeaseDuration = | ||||
|         let arg_3 = | ||||
|             (match node.["lease_duration"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -392,9 +389,9 @@ module JwtSecretResponse = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsValue() | ||||
|                 .GetValue<int> () | ||||
|                 .GetValue<System.Int32> () | ||||
|  | ||||
|         let Renewable = | ||||
|         let arg_2 = | ||||
|             (match node.["renewable"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -404,9 +401,9 @@ module JwtSecretResponse = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsValue() | ||||
|                 .GetValue<bool> () | ||||
|                 .GetValue<System.Boolean> () | ||||
|  | ||||
|         let LeaseId = | ||||
|         let arg_1 = | ||||
|             (match node.["lease_id"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -416,9 +413,9 @@ module JwtSecretResponse = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsValue() | ||||
|                 .GetValue<string> () | ||||
|                 .GetValue<System.String> () | ||||
|  | ||||
|         let RequestId = | ||||
|         let arg_0 = | ||||
|             (match node.["request_id"] with | ||||
|              | null -> | ||||
|                  raise ( | ||||
| @@ -428,21 +425,21 @@ module JwtSecretResponse = | ||||
|                  ) | ||||
|              | v -> v) | ||||
|                 .AsValue() | ||||
|                 .GetValue<string> () | ||||
|                 .GetValue<System.String> () | ||||
|  | ||||
|         { | ||||
|             RequestId = RequestId | ||||
|             LeaseId = LeaseId | ||||
|             Renewable = Renewable | ||||
|             LeaseDuration = LeaseDuration | ||||
|             Data = Data | ||||
|             Data2 = Data2 | ||||
|             Data3 = Data3 | ||||
|             Data4 = Data4 | ||||
|             Data5 = Data5 | ||||
|             Data6 = Data6 | ||||
|             Data7 = Data7 | ||||
|             Data8 = Data8 | ||||
|             RequestId = arg_0 | ||||
|             LeaseId = arg_1 | ||||
|             Renewable = arg_2 | ||||
|             LeaseDuration = arg_3 | ||||
|             Data = arg_4 | ||||
|             Data2 = arg_5 | ||||
|             Data3 = arg_6 | ||||
|             Data4 = arg_7 | ||||
|             Data5 = arg_8 | ||||
|             Data6 = arg_9 | ||||
|             Data7 = arg_10 | ||||
|             Data8 = arg_11 | ||||
|         } | ||||
|  | ||||
| namespace ConsumePlugin | ||||
| @@ -455,19 +452,13 @@ open System.Threading.Tasks | ||||
| open RestEase | ||||
|  | ||||
| /// Module for constructing a REST client. | ||||
| [<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>] | ||||
| [<RequireQualifiedAccess>] | ||||
| [<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>] | ||||
| module VaultClient = | ||||
|     /// Create a REST client. | ||||
|     let make (client : System.Net.Http.HttpClient) : IVaultClient = | ||||
|         { new IVaultClient with | ||||
|             member _.GetSecret | ||||
|                 ( | ||||
|                     jwt : JwtVaultResponse, | ||||
|                     path : string, | ||||
|                     mountPoint : string, | ||||
|                     ct : CancellationToken option | ||||
|                 ) | ||||
|                 (jwt : JwtVaultResponse, path : string, mountPoint : string, ct : CancellationToken option) | ||||
|                 = | ||||
|                 async { | ||||
|                     let! ct = Async.CancellationToken | ||||
| @@ -485,11 +476,8 @@ module VaultClient = | ||||
|                              | v -> v), | ||||
|                             System.Uri ( | ||||
|                                 "v1/{mountPoint}/{path}" | ||||
|                                     .Replace("{path}", path.ToString () |> System.Web.HttpUtility.UrlEncode) | ||||
|                                     .Replace ( | ||||
|                                         "{mountPoint}", | ||||
|                                         mountPoint.ToString () |> System.Web.HttpUtility.UrlEncode | ||||
|                                     ), | ||||
|                                     .Replace("{path}", path.ToString () |> System.Uri.EscapeDataString) | ||||
|                                     .Replace ("{mountPoint}", mountPoint.ToString () |> System.Uri.EscapeDataString), | ||||
|                                 System.UriKind.Relative | ||||
|                             ) | ||||
|                         ) | ||||
| @@ -548,3 +536,194 @@ module VaultClient = | ||||
|                 } | ||||
|                 |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) | ||||
|         } | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| open System | ||||
| open System.Collections.Generic | ||||
| open System.Text.Json.Serialization | ||||
| open System.Threading | ||||
| open System.Threading.Tasks | ||||
| open RestEase | ||||
|  | ||||
| /// Module for constructing a REST client. | ||||
| [<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>] | ||||
| module VaultClientNonExtensionMethod = | ||||
|     /// Create a REST client. | ||||
|     let make (client : System.Net.Http.HttpClient) : IVaultClientNonExtensionMethod = | ||||
|         { new IVaultClientNonExtensionMethod with | ||||
|             member _.GetSecret | ||||
|                 (jwt : JwtVaultResponse, path : string, mountPoint : string, ct : CancellationToken option) | ||||
|                 = | ||||
|                 async { | ||||
|                     let! ct = Async.CancellationToken | ||||
|  | ||||
|                     let uri = | ||||
|                         System.Uri ( | ||||
|                             (match client.BaseAddress with | ||||
|                              | null -> | ||||
|                                  raise ( | ||||
|                                      System.ArgumentNullException ( | ||||
|                                          nameof (client.BaseAddress), | ||||
|                                          "No base address was supplied on the type, and no BaseAddress was on the HttpClient." | ||||
|                                      ) | ||||
|                                  ) | ||||
|                              | v -> v), | ||||
|                             System.Uri ( | ||||
|                                 "v1/{mountPoint}/{path}" | ||||
|                                     .Replace("{path}", path.ToString () |> System.Uri.EscapeDataString) | ||||
|                                     .Replace ("{mountPoint}", mountPoint.ToString () |> System.Uri.EscapeDataString), | ||||
|                                 System.UriKind.Relative | ||||
|                             ) | ||||
|                         ) | ||||
|  | ||||
|                     let httpMessage = | ||||
|                         new System.Net.Http.HttpRequestMessage ( | ||||
|                             Method = System.Net.Http.HttpMethod.Get, | ||||
|                             RequestUri = uri | ||||
|                         ) | ||||
|  | ||||
|                     let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask | ||||
|                     let response = response.EnsureSuccessStatusCode () | ||||
|                     let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask | ||||
|  | ||||
|                     let! jsonNode = | ||||
|                         System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct) | ||||
|                         |> Async.AwaitTask | ||||
|  | ||||
|                     return JwtSecretResponse.jsonParse jsonNode | ||||
|                 } | ||||
|                 |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) | ||||
|  | ||||
|             member _.GetJwt (role : string, jwt : string, ct : CancellationToken option) = | ||||
|                 async { | ||||
|                     let! ct = Async.CancellationToken | ||||
|  | ||||
|                     let uri = | ||||
|                         System.Uri ( | ||||
|                             (match client.BaseAddress with | ||||
|                              | null -> | ||||
|                                  raise ( | ||||
|                                      System.ArgumentNullException ( | ||||
|                                          nameof (client.BaseAddress), | ||||
|                                          "No base address was supplied on the type, and no BaseAddress was on the HttpClient." | ||||
|                                      ) | ||||
|                                  ) | ||||
|                              | v -> v), | ||||
|                             System.Uri ("v1/auth/jwt/login", System.UriKind.Relative) | ||||
|                         ) | ||||
|  | ||||
|                     let httpMessage = | ||||
|                         new System.Net.Http.HttpRequestMessage ( | ||||
|                             Method = System.Net.Http.HttpMethod.Get, | ||||
|                             RequestUri = uri | ||||
|                         ) | ||||
|  | ||||
|                     let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask | ||||
|                     let response = response.EnsureSuccessStatusCode () | ||||
|                     let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask | ||||
|  | ||||
|                     let! jsonNode = | ||||
|                         System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct) | ||||
|                         |> Async.AwaitTask | ||||
|  | ||||
|                     return JwtVaultResponse.jsonParse jsonNode | ||||
|                 } | ||||
|                 |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) | ||||
|         } | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| open System | ||||
| open System.Collections.Generic | ||||
| open System.Text.Json.Serialization | ||||
| open System.Threading | ||||
| open System.Threading.Tasks | ||||
| open RestEase | ||||
|  | ||||
| /// Extension methods for constructing a REST client. | ||||
| [<AutoOpen>] | ||||
| module VaultClientExtensionMethodHttpClientExtension = | ||||
|     /// Extension methods for HTTP clients | ||||
|     type VaultClientExtensionMethod with | ||||
|  | ||||
|         /// Create a REST client. | ||||
|         static member make (client : System.Net.Http.HttpClient) : IVaultClientExtensionMethod = | ||||
|             { new IVaultClientExtensionMethod with | ||||
|                 member _.GetSecret | ||||
|                     (jwt : JwtVaultResponse, path : string, mountPoint : string, ct : CancellationToken option) | ||||
|                     = | ||||
|                     async { | ||||
|                         let! ct = Async.CancellationToken | ||||
|  | ||||
|                         let uri = | ||||
|                             System.Uri ( | ||||
|                                 (match client.BaseAddress with | ||||
|                                  | null -> | ||||
|                                      raise ( | ||||
|                                          System.ArgumentNullException ( | ||||
|                                              nameof (client.BaseAddress), | ||||
|                                              "No base address was supplied on the type, and no BaseAddress was on the HttpClient." | ||||
|                                          ) | ||||
|                                      ) | ||||
|                                  | v -> v), | ||||
|                                 System.Uri ( | ||||
|                                     "v1/{mountPoint}/{path}" | ||||
|                                         .Replace("{path}", path.ToString () |> System.Uri.EscapeDataString) | ||||
|                                         .Replace ("{mountPoint}", mountPoint.ToString () |> System.Uri.EscapeDataString), | ||||
|                                     System.UriKind.Relative | ||||
|                                 ) | ||||
|                             ) | ||||
|  | ||||
|                         let httpMessage = | ||||
|                             new System.Net.Http.HttpRequestMessage ( | ||||
|                                 Method = System.Net.Http.HttpMethod.Get, | ||||
|                                 RequestUri = uri | ||||
|                             ) | ||||
|  | ||||
|                         let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask | ||||
|                         let response = response.EnsureSuccessStatusCode () | ||||
|                         let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask | ||||
|  | ||||
|                         let! jsonNode = | ||||
|                             System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct) | ||||
|                             |> Async.AwaitTask | ||||
|  | ||||
|                         return JwtSecretResponse.jsonParse jsonNode | ||||
|                     } | ||||
|                     |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) | ||||
|  | ||||
|                 member _.GetJwt (role : string, jwt : string, ct : CancellationToken option) = | ||||
|                     async { | ||||
|                         let! ct = Async.CancellationToken | ||||
|  | ||||
|                         let uri = | ||||
|                             System.Uri ( | ||||
|                                 (match client.BaseAddress with | ||||
|                                  | null -> | ||||
|                                      raise ( | ||||
|                                          System.ArgumentNullException ( | ||||
|                                              nameof (client.BaseAddress), | ||||
|                                              "No base address was supplied on the type, and no BaseAddress was on the HttpClient." | ||||
|                                          ) | ||||
|                                      ) | ||||
|                                  | v -> v), | ||||
|                                 System.Uri ("v1/auth/jwt/login", System.UriKind.Relative) | ||||
|                             ) | ||||
|  | ||||
|                         let httpMessage = | ||||
|                             new System.Net.Http.HttpRequestMessage ( | ||||
|                                 Method = System.Net.Http.HttpMethod.Get, | ||||
|                                 RequestUri = uri | ||||
|                             ) | ||||
|  | ||||
|                         let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask | ||||
|                         let response = response.EnsureSuccessStatusCode () | ||||
|                         let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask | ||||
|  | ||||
|                         let! jsonNode = | ||||
|                             System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct) | ||||
|                             |> Async.AwaitTask | ||||
|  | ||||
|                         return JwtVaultResponse.jsonParse jsonNode | ||||
|                     } | ||||
|                     |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) | ||||
|             } | ||||
|   | ||||
| @@ -29,13 +29,52 @@ type JsonRecordType = | ||||
|         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>] | ||||
| type ToGetExtensionMethod = | ||||
|     { | ||||
|         Tinker : string | ||||
|         Tailor : int | ||||
|         Soldier : System.Uri | ||||
|         Sailor : float | ||||
|         Alpha : string | ||||
|         Bravo : System.Uri | ||||
|         Charlie : float | ||||
|         Delta : float32 | ||||
|         Echo : single | ||||
|         Foxtrot : double | ||||
|         Golf : int64 | ||||
|         Hotel : uint64 | ||||
|         India : int | ||||
|         Juliette : uint | ||||
|         Kilo : int32 | ||||
|         Lima : uint32 | ||||
|         Mike : int16 | ||||
|         November : uint16 | ||||
|         Oscar : int8 | ||||
|         Papa : uint8 | ||||
|         Quebec : byte | ||||
|         Tango : sbyte | ||||
|         Uniform : decimal | ||||
|         Victor : char | ||||
|         Whiskey : bigint | ||||
|     } | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
|   | ||||
							
								
								
									
										19
									
								
								ConsumePlugin/List.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										19
									
								
								ConsumePlugin/List.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,19 @@ | ||||
| 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> | ||||
							
								
								
									
										118
									
								
								ConsumePlugin/ListCata.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										118
									
								
								ConsumePlugin/ListCata.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,118 @@ | ||||
| //------------------------------------------------------------------------------ | ||||
| //        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 | ||||
| @@ -1,5 +1,6 @@ | ||||
| namespace SomeNamespace | ||||
|  | ||||
| open System | ||||
| open WoofWare.Myriad.Plugins | ||||
|  | ||||
| [<GenerateMock>] | ||||
| @@ -8,6 +9,12 @@ type IPublicType = | ||||
|     abstract Mem2 : string -> int | ||||
|     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>] | ||||
| type internal InternalType = | ||||
|     abstract Mem1 : string * int -> unit | ||||
| @@ -18,6 +25,11 @@ type private PrivateType = | ||||
|     abstract Mem1 : string * int -> unit | ||||
|     abstract Mem2 : string -> int | ||||
|  | ||||
| [<GenerateMock false>] | ||||
| type private PrivateTypeInternalFalse = | ||||
|     abstract Mem1 : string * int -> unit | ||||
|     abstract Mem2 : string -> int | ||||
|  | ||||
| [<GenerateMock>] | ||||
| type VeryPublicType<'a, 'b> = | ||||
|     abstract Mem1 : 'a -> 'b | ||||
| @@ -30,3 +42,9 @@ type Curried<'a> = | ||||
|     abstract Mem4 : (int * string) -> ('a * int) -> string | ||||
|     abstract Mem5 : x : int * string -> ('a * int) -> string | ||||
|     abstract Mem6 : int * string -> y : 'a * int -> string | ||||
|  | ||||
| [<GenerateMock>] | ||||
| type TypeWithInterface = | ||||
|     inherit IDisposable | ||||
|     abstract Mem1 : string option -> string[] Async | ||||
|     abstract Mem2 : unit -> string[] Async | ||||
|   | ||||
							
								
								
									
										41
									
								
								ConsumePlugin/MockExampleNoAttributes.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										41
									
								
								ConsumePlugin/MockExampleNoAttributes.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,41 @@ | ||||
| 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 | ||||
| @@ -19,13 +19,16 @@ type GymAccessOptions = | ||||
|         QrCodeAccess : bool | ||||
|     } | ||||
|  | ||||
| [<Measure>] | ||||
| type measure | ||||
|  | ||||
| [<WoofWare.Myriad.Plugins.JsonParse>] | ||||
| type GymLocation = | ||||
|     { | ||||
|         [<JsonNumberHandling(JsonNumberHandling.AllowReadingFromString)>] | ||||
|         Longitude : float | ||||
|         [<JsonNumberHandling(JsonNumberHandling.AllowReadingFromString)>] | ||||
|         Latitude : float | ||||
|         Latitude : float<measure> | ||||
|     } | ||||
|  | ||||
| [<WoofWare.Myriad.Plugins.JsonParse>] | ||||
|   | ||||
| @@ -1,9 +1,5 @@ | ||||
| namespace ConsumePlugin | ||||
|  | ||||
| type ParseState = | ||||
|     | AwaitingKey | ||||
|     | AwaitingValue of string | ||||
|  | ||||
| /// My whatnot | ||||
| [<WoofWare.Myriad.Plugins.RemoveOptions>] | ||||
| type RecordType = | ||||
|   | ||||
| @@ -11,17 +11,20 @@ open RestEase | ||||
| [<WoofWare.Myriad.Plugins.HttpClient>] | ||||
| [<BaseAddress "https://whatnot.com">] | ||||
| type IPureGymApi = | ||||
|     [<Get "v1/gyms/">] | ||||
|     [<Get("v1/gyms/")>] | ||||
|     abstract GetGyms : ?ct : CancellationToken -> Task<Gym list> | ||||
|  | ||||
|     [<Get "v1/gyms/{gym_id}/attendance">] | ||||
|     abstract GetGymAttendance : [<Path "gym_id">] gymId : int * ?ct : CancellationToken -> Task<GymAttendance> | ||||
|  | ||||
|     [<Get "v1/gyms/{gym_id}/attendance">] | ||||
|     abstract GetGymAttendance' : [<Path("gym_id")>] gymId : int * ?ct : CancellationToken -> Task<GymAttendance> | ||||
|  | ||||
|     [<RestEase.GetAttribute "v1/member">] | ||||
|     abstract GetMember : ?ct : CancellationToken -> Member Task | ||||
|  | ||||
|     [<RestEase.Get "v1/gyms/{gym_id}">] | ||||
|     abstract GetGym : [<Path "gym_id">] gymId : int * ?ct : CancellationToken -> Task<Gym> | ||||
|     [<RestEase.Get "v1/gyms/{gym}">] | ||||
|     abstract GetGym : [<Path>] gym : int * ?ct : CancellationToken -> Task<Gym> | ||||
|  | ||||
|     [<GetAttribute "v1/member/activity">] | ||||
|     abstract GetMemberActivity : ?ct : CancellationToken -> Task<MemberActivityDto> | ||||
| @@ -29,11 +32,19 @@ type IPureGymApi = | ||||
|     [<Get "some/url">] | ||||
|     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 | ||||
|     [<Get "/v2/gymSessions/member">] | ||||
|     abstract GetSessions : | ||||
|         [<Query>] fromDate : DateOnly * [<Query>] toDate : DateOnly * ?ct : CancellationToken -> Task<Sessions> | ||||
|  | ||||
|     [<Get "/v2/gymSessions/member?foo=1">] | ||||
|     abstract GetSessionsWithQuery : | ||||
|         [<Query>] fromDate : DateOnly * [<Query>] toDate : DateOnly * ?ct : CancellationToken -> Task<Sessions> | ||||
|  | ||||
|     // An example from RestEase's own docs | ||||
|     [<Post "users/new">] | ||||
|     abstract CreateUserString : [<Body>] user : string * ?ct : CancellationToken -> Task<string> | ||||
| @@ -53,6 +64,12 @@ type IPureGymApi = | ||||
|     [<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">] | ||||
|     abstract CreateUserHttpContent : | ||||
|         [<Body>] user : System.Net.Http.HttpContent * ?ct : CancellationToken -> Task<string> | ||||
| @@ -105,17 +122,84 @@ type internal IApiWithoutBaseAddress = | ||||
|     [<Get "endpoint/{param}">] | ||||
|     abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string> | ||||
|  | ||||
| // TODO: implement BasePath support | ||||
|  | ||||
| [<WoofWare.Myriad.Plugins.HttpClient>] | ||||
| [<BasePath "foo">] | ||||
| type IApiWithBasePath = | ||||
|     [<Get "endpoint/{param}">] | ||||
|     abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string> | ||||
|     // 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">] | ||||
| [<BaseAddress "https://whatnot.com/thing">] | ||||
| [<BasePath "foo">] | ||||
| type IApiWithBasePathAndAddress = | ||||
|     [<Get "endpoint/{param}">] | ||||
|     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> | ||||
|   | ||||
| @@ -9,13 +9,22 @@ open System.Text.Json.Serialization | ||||
| type InnerTypeWithBoth = | ||||
|     { | ||||
|         [<JsonPropertyName("it's-a-me")>] | ||||
|         Thing : string | ||||
|         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 = | ||||
| @@ -25,5 +34,61 @@ type JsonRecordTypeWithBoth = | ||||
|         C : int list | ||||
|         D : InnerTypeWithBoth | ||||
|         E : string array | ||||
|         F : int[] | ||||
|         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 | ||||
|     } | ||||
|   | ||||
| @@ -76,3 +76,33 @@ type IVaultClient = | ||||
|  | ||||
|     [<Get "v1/auth/jwt/login">] | ||||
|     abstract GetJwt : role : string * jwt : string * ?ct : CancellationToken -> Task<JwtVaultResponse> | ||||
|  | ||||
| [<WoofWare.Myriad.Plugins.HttpClient false>] | ||||
| type IVaultClientNonExtensionMethod = | ||||
|     [<Get "v1/{mountPoint}/{path}">] | ||||
|     abstract GetSecret : | ||||
|         jwt : JwtVaultResponse * | ||||
|         [<Path "path">] path : string * | ||||
|         [<Path "mountPoint">] mountPoint : string * | ||||
|         ?ct : CancellationToken -> | ||||
|             Task<JwtSecretResponse> | ||||
|  | ||||
|     [<Get "v1/auth/jwt/login">] | ||||
|     abstract GetJwt : role : string * jwt : string * ?ct : CancellationToken -> Task<JwtVaultResponse> | ||||
|  | ||||
| [<WoofWare.Myriad.Plugins.HttpClient(true)>] | ||||
| type IVaultClientExtensionMethod = | ||||
|     [<Get "v1/{mountPoint}/{path}">] | ||||
|     abstract GetSecret : | ||||
|         jwt : JwtVaultResponse * | ||||
|         [<Path "path">] path : string * | ||||
|         [<Path "mountPoint">] mountPoint : string * | ||||
|         ?ct : CancellationToken -> | ||||
|             Task<JwtSecretResponse> | ||||
|  | ||||
|     [<Get "v1/auth/jwt/login">] | ||||
|     abstract GetJwt : role : string * jwt : string * ?ct : CancellationToken -> Task<JwtVaultResponse> | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| type VaultClientExtensionMethod = | ||||
|     static member thisClashes = 99 | ||||
|   | ||||
							
								
								
									
										21054
									
								
								ConsumePlugin/swagger-gitea.json
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										21054
									
								
								ConsumePlugin/swagger-gitea.json
									
									
									
									
									
										Normal file
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							| @@ -10,19 +10,10 @@ | ||||
|     <WarnOn>FS3388,FS3559</WarnOn> | ||||
|   </PropertyGroup> | ||||
|   <ItemGroup> | ||||
|     <PackageReference Include="Nerdbank.GitVersioning" Version="3.6.133" PrivateAssets="all"/> | ||||
|     <PackageReference Include="Microsoft.SourceLink.GitHub" Version="8.0.0" PrivateAssets="All"/> | ||||
|     <PackageReference Include="Nerdbank.GitVersioning" Version="3.6.143" PrivateAssets="all"/> | ||||
|     <SourceLinkGitHubHost Include="github.com" ContentUrl="https://raw.githubusercontent.com"/> | ||||
|   </ItemGroup> | ||||
|   <!-- | ||||
|     SourceLink doesn't support F# deterministic builds out of the box, | ||||
|     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> | ||||
|   <PropertyGroup Condition="'$(GITHUB_ACTION)' != ''"> | ||||
|     <ContinuousIntegrationBuild>true</ContinuousIntegrationBuild> | ||||
|   </PropertyGroup> | ||||
| </Project> | ||||
|   | ||||
							
								
								
									
										97
									
								
								WoofWare.Myriad.Plugins.Attributes/ArgParserAttributes.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										97
									
								
								WoofWare.Myriad.Plugins.Attributes/ArgParserAttributes.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,97 @@ | ||||
| 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. | ||||
| 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 () | ||||
							
								
								
									
										81
									
								
								WoofWare.Myriad.Plugins.Attributes/Attributes.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										81
									
								
								WoofWare.Myriad.Plugins.Attributes/Attributes.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,81 @@ | ||||
| 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. | ||||
| 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 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 () | ||||
							
								
								
									
										84
									
								
								WoofWare.Myriad.Plugins.Attributes/RestEase.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										84
									
								
								WoofWare.Myriad.Plugins.Attributes/RestEase.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,84 @@ | ||||
| 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 () | ||||
							
								
								
									
										81
									
								
								WoofWare.Myriad.Plugins.Attributes/SurfaceBaseline.txt
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										81
									
								
								WoofWare.Myriad.Plugins.Attributes/SurfaceBaseline.txt
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,81 @@ | ||||
| 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.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 | ||||
							
								
								
									
										24
									
								
								WoofWare.Myriad.Plugins.Attributes/Test/TestSurface.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										24
									
								
								WoofWare.Myriad.Plugins.Attributes/Test/TestSurface.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,24 @@ | ||||
| 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 | ||||
| @@ -0,0 +1,30 @@ | ||||
| <Project Sdk="Microsoft.NET.Sdk"> | ||||
|  | ||||
|     <PropertyGroup> | ||||
|       <TargetFramework>net8.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="4.1.5" /> | ||||
|         <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.11.1"/> | ||||
|         <PackageReference Include="NUnit" Version="4.2.2"/> | ||||
|         <PackageReference Include="NUnit3TestAdapter" Version="4.6.0"/> | ||||
|     </ItemGroup> | ||||
|  | ||||
|     <ItemGroup> | ||||
|       <ProjectReference Include="..\WoofWare.Myriad.Plugins.Attributes.fsproj" /> | ||||
|     </ItemGroup> | ||||
|  | ||||
| </Project> | ||||
| @@ -0,0 +1,40 @@ | ||||
| <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> | ||||
							
								
								
									
										15
									
								
								WoofWare.Myriad.Plugins.Attributes/version.json
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										15
									
								
								WoofWare.Myriad.Plugins.Attributes/version.json
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,15 @@ | ||||
| { | ||||
|   "version": "3.6", | ||||
|   "publicReleaseRefSpec": [ | ||||
|     "^refs/heads/main$" | ||||
|   ], | ||||
|   "pathFilters": [ | ||||
|     ":/README.md", | ||||
|     ":/LICENSE", | ||||
|     ":/WoofWare.Myriad.Plugins/logo.png", | ||||
|     ":/Directory.Build.props", | ||||
|     ":/global.json", | ||||
|     "./", | ||||
|     ":^Test" | ||||
|   ] | ||||
| } | ||||
| @@ -58,7 +58,7 @@ module PureGymDtos = | ||||
|         [ | ||||
|             """{"latitude": 1.0, "longitude": 3.0}""", | ||||
|             { | ||||
|                 GymLocation.Latitude = 1.0 | ||||
|                 GymLocation.Latitude = 1.0<measure> | ||||
|                 Longitude = 3.0 | ||||
|             } | ||||
|         ] | ||||
| @@ -96,7 +96,7 @@ module PureGymDtos = | ||||
|                 Location = | ||||
|                     { | ||||
|                         Longitude = -0.110252 | ||||
|                         Latitude = 51.480401 | ||||
|                         Latitude = 51.480401<measure> | ||||
|                     } | ||||
|                 TimeZone = "Europe/London" | ||||
|                 ReopenDate = "2021-04-12T00:00:00+01 Europe/London" | ||||
|   | ||||
							
								
								
									
										706
									
								
								WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										706
									
								
								WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,706 @@ | ||||
| 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> | ||||
|             "" | ||||
|  | ||||
|         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> | ||||
|             "" | ||||
|  | ||||
|         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> | ||||
|             "" | ||||
|  | ||||
|         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> | ||||
|             "" | ||||
|  | ||||
|         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> | ||||
|             "" | ||||
|  | ||||
|         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" | ||||
|             "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> | ||||
|             "" | ||||
|  | ||||
|         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" | ||||
|             "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> | ||||
|             "" | ||||
|  | ||||
|         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> | ||||
|             "" | ||||
|  | ||||
|         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" | ||||
|             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" | ||||
|             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""" | ||||
| @@ -0,0 +1,47 @@ | ||||
| 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 | ||||
| @@ -0,0 +1,37 @@ | ||||
| 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. | ||||
							
								
								
									
										99
									
								
								WoofWare.Myriad.Plugins.Test/TestCataGenerator/TestGift.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										99
									
								
								WoofWare.Myriad.Plugins.Test/TestCataGenerator/TestGift.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,99 @@ | ||||
| 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 | ||||
							
								
								
									
										77
									
								
								WoofWare.Myriad.Plugins.Test/TestCataGenerator/TestMyList.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										77
									
								
								WoofWare.Myriad.Plugins.Test/TestCataGenerator/TestMyList.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,77 @@ | ||||
| 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 | ||||
| @@ -0,0 +1,25 @@ | ||||
| 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 | ||||
| @@ -9,18 +9,18 @@ open FsUnitTyped | ||||
|  | ||||
| [<TestFixture>] | ||||
| 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>] | ||||
|     let ``Base address is respected`` () = | ||||
|         let proc (message : HttpRequestMessage) : HttpResponseMessage Async = | ||||
|             async { | ||||
|                 message.Method |> shouldEqual HttpMethod.Get | ||||
|                 let content = new StringContent (message.RequestUri.ToString ()) | ||||
|                 let resp = new HttpResponseMessage (HttpStatusCode.OK) | ||||
|                 resp.Content <- content | ||||
|                 return resp | ||||
|             } | ||||
|  | ||||
|         use client = HttpClientMock.makeNoUri proc | ||||
|         use client = HttpClientMock.makeNoUri replyWithUrl | ||||
|         let api = PureGymApi.make client | ||||
|  | ||||
|         let observedUri = api.GetPathParam("param").Result | ||||
| @@ -28,38 +28,28 @@ module TestBasePath = | ||||
|  | ||||
|     [<Test>] | ||||
|     let ``Without a base address attr but with BaseAddress on client, request goes through`` () = | ||||
|         let proc (message : HttpRequestMessage) : HttpResponseMessage Async = | ||||
|             async { | ||||
|                 message.Method |> shouldEqual HttpMethod.Get | ||||
|                 let content = new StringContent (message.RequestUri.ToString ()) | ||||
|                 let resp = new HttpResponseMessage (HttpStatusCode.OK) | ||||
|                 resp.Content <- content | ||||
|                 return resp | ||||
|             } | ||||
|  | ||||
|         use client = HttpClientMock.make (System.Uri "https://baseaddress.com") proc | ||||
|         use client = HttpClientMock.make (Uri "https://baseaddress.com") replyWithUrl | ||||
|         let api = ApiWithoutBaseAddress.make client | ||||
|  | ||||
|         let observedUri = api.GetPathParam("param").Result | ||||
|         observedUri |> shouldEqual "https://baseaddress.com/endpoint/param" | ||||
|  | ||||
|     [<Test>] | ||||
|     let ``Without a base address attr or BaseAddress on client, request throws`` () = | ||||
|         let proc (message : HttpRequestMessage) : HttpResponseMessage Async = | ||||
|             async { | ||||
|                 message.Method |> shouldEqual HttpMethod.Get | ||||
|                 let content = new StringContent (message.RequestUri.ToString ()) | ||||
|                 let resp = new HttpResponseMessage (HttpStatusCode.OK) | ||||
|                 resp.Content <- content | ||||
|                 return resp | ||||
|             } | ||||
|     let ``Base address on client takes precedence`` () = | ||||
|         use client = HttpClientMock.make (Uri "https://baseaddress.com") replyWithUrl | ||||
|         let api = PureGymApi.make client | ||||
|  | ||||
|         use client = HttpClientMock.makeNoUri proc | ||||
|         let observedUri = api.GetPathParam("param").Result | ||||
|         observedUri |> shouldEqual "https://baseaddress.com/endpoint/param" | ||||
|  | ||||
|     [<Test>] | ||||
|     let ``Without a base address attr or BaseAddress on client, request throws`` () = | ||||
|         use client = HttpClientMock.makeNoUri replyWithUrl | ||||
|         let api = ApiWithoutBaseAddress.make client | ||||
|  | ||||
|         let observedExc = | ||||
|             async { | ||||
|                 let! result = api.GetPathParam ("param") |> Async.AwaitTask |> Async.Catch | ||||
|                 let! result = api.GetPathParam "param" |> Async.AwaitTask |> Async.Catch | ||||
|  | ||||
|                 match result with | ||||
|                 | Choice1Of2 _ -> return failwith "test failure" | ||||
| @@ -78,3 +68,103 @@ module TestBasePath = | ||||
|         observedExc.Message | ||||
|         |> shouldEqual | ||||
|             "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" | ||||
|   | ||||
| @@ -148,3 +148,41 @@ module TestBodyParam = | ||||
|         |> 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\"" | ||||
|   | ||||
| @@ -33,4 +33,4 @@ module TestPathParam = | ||||
|         let api = PureGymApi.make client | ||||
|  | ||||
|         api.GetPathParam("hello/world?(hi)").Result | ||||
|         |> shouldEqual "hello%2fworld%3f(hi)" | ||||
|         |> shouldEqual "hello%2Fworld%3F%28hi%29" | ||||
|   | ||||
| @@ -89,6 +89,7 @@ module TestPureGymRestApi = | ||||
|         let api = PureGymApi.make client | ||||
|  | ||||
|         api.GetGymAttendance(requestedGym).Result |> shouldEqual expected | ||||
|         api.GetGymAttendance'(requestedGym).Result |> shouldEqual expected | ||||
|  | ||||
|     let memberCases = | ||||
|         PureGymDtos.memberCases |> List.allPairs baseUris |> List.map TestCaseData | ||||
| @@ -209,10 +210,7 @@ module TestPureGymRestApi = | ||||
|  | ||||
|     [<TestCaseSource(nameof sessionsCases)>] | ||||
|     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 = | ||||
|             async { | ||||
| @@ -237,6 +235,33 @@ module TestPureGymRestApi = | ||||
|  | ||||
|         api.GetSessions(startDate, endDate).Result |> shouldEqual expected | ||||
|  | ||||
|     [<TestCaseSource(nameof sessionsCases)>] | ||||
|     let ``Test GetSessionsWithQuery`` | ||||
|         (baseUri : Uri, (startDate : DateOnly, (endDate : DateOnly, (json : string, expected : Sessions)))) | ||||
|         = | ||||
|         let proc (message : HttpRequestMessage) : HttpResponseMessage Async = | ||||
|             async { | ||||
|                 message.Method |> shouldEqual HttpMethod.Get | ||||
|  | ||||
|                 // This one is specified as being absolute, in its attribute on the IPureGymApi type | ||||
|                 let expectedUri = | ||||
|                     let fromDate = dateOnlyToString startDate | ||||
|                     let toDate = dateOnlyToString endDate | ||||
|                     $"https://example.com/v2/gymSessions/member?foo=1&fromDate=%s{fromDate}&toDate=%s{toDate}" | ||||
|  | ||||
|                 message.RequestUri.ToString () |> shouldEqual expectedUri | ||||
|  | ||||
|                 let content = new StringContent (json) | ||||
|                 let resp = new HttpResponseMessage (HttpStatusCode.OK) | ||||
|                 resp.Content <- content | ||||
|                 return resp | ||||
|             } | ||||
|  | ||||
|         use client = HttpClientMock.make baseUri proc | ||||
|         let api = PureGymApi.make client | ||||
|  | ||||
|         api.GetSessionsWithQuery(startDate, endDate).Result |> shouldEqual expected | ||||
|  | ||||
|     [<Test>] | ||||
|     let ``URI example`` () = | ||||
|         let proc (message : HttpRequestMessage) : HttpResponseMessage Async = | ||||
| @@ -260,3 +285,37 @@ module TestPureGymRestApi = | ||||
|         uri.ToString () |> shouldEqual "https://patrick@en.wikipedia.org/wiki/foo" | ||||
|         uri.UserInfo |> shouldEqual "patrick" | ||||
|         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 | ||||
|   | ||||
| @@ -0,0 +1,126 @@ | ||||
| namespace WoofWare.Myriad.Plugins.Test | ||||
|  | ||||
| open System | ||||
| open System.Net | ||||
| open System.Net.Http | ||||
| open System.Threading | ||||
| open NUnit.Framework | ||||
| open FsUnitTyped | ||||
| open PureGym | ||||
|  | ||||
| [<TestFixture>] | ||||
| module TestVariableHeader = | ||||
|  | ||||
|     [<Test>] | ||||
|     let ``Headers are set`` () : unit = | ||||
|         let proc (message : HttpRequestMessage) : HttpResponseMessage Async = | ||||
|             async { | ||||
|                 message.Method |> shouldEqual HttpMethod.Get | ||||
|  | ||||
|                 message.RequestUri.ToString () | ||||
|                 |> shouldEqual "https://example.com/endpoint/param" | ||||
|  | ||||
|                 let headers = | ||||
|                     [ | ||||
|                         for h in message.Headers do | ||||
|                             yield $"%s{h.Key}: %s{Seq.exactlyOne h.Value}" | ||||
|                     ] | ||||
|                     |> String.concat "\n" | ||||
|  | ||||
|                 let content = new StringContent (headers) | ||||
|                 let resp = new HttpResponseMessage (HttpStatusCode.OK) | ||||
|                 resp.Content <- content | ||||
|                 return resp | ||||
|             } | ||||
|  | ||||
|         use client = HttpClientMock.make (Uri "https://example.com") proc | ||||
|  | ||||
|         let someHeaderCount = ref 10 | ||||
|  | ||||
|         let someHeader () = | ||||
|             (Interlocked.Increment someHeaderCount : int).ToString () | ||||
|  | ||||
|         let someOtherHeaderCount = ref -100 | ||||
|  | ||||
|         let someOtherHeader () = | ||||
|             Interlocked.Increment someOtherHeaderCount | ||||
|  | ||||
|         let api = ApiWithHeaders.make someHeader someOtherHeader client | ||||
|  | ||||
|         someHeaderCount.Value |> shouldEqual 10 | ||||
|         someOtherHeaderCount.Value |> shouldEqual -100 | ||||
|  | ||||
|         api.GetPathParam("param").Result.Split "\n" | ||||
|         |> Array.sort | ||||
|         |> shouldEqual | ||||
|             [| | ||||
|                 "Authorization: -99" | ||||
|                 "Header-Name: Header-Value" | ||||
|                 "Something-Else: val" | ||||
|                 "X-Foo: 11" | ||||
|             |] | ||||
|  | ||||
|         someHeaderCount.Value |> shouldEqual 11 | ||||
|         someOtherHeaderCount.Value |> shouldEqual -99 | ||||
|  | ||||
|     [<Test>] | ||||
|     let ``Headers get re-evaluated every time`` () : unit = | ||||
|         let proc (message : HttpRequestMessage) : HttpResponseMessage Async = | ||||
|             async { | ||||
|                 message.Method |> shouldEqual HttpMethod.Get | ||||
|  | ||||
|                 message.RequestUri.ToString () | ||||
|                 |> shouldEqual "https://example.com/endpoint/param" | ||||
|  | ||||
|                 let headers = | ||||
|                     [ | ||||
|                         for h in message.Headers do | ||||
|                             yield $"%s{h.Key}: %s{Seq.exactlyOne h.Value}" | ||||
|                     ] | ||||
|                     |> String.concat "\n" | ||||
|  | ||||
|                 let content = new StringContent (headers) | ||||
|                 let resp = new HttpResponseMessage (HttpStatusCode.OK) | ||||
|                 resp.Content <- content | ||||
|                 return resp | ||||
|             } | ||||
|  | ||||
|         use client = HttpClientMock.make (Uri "https://example.com") proc | ||||
|  | ||||
|         let someHeaderCount = ref 10 | ||||
|  | ||||
|         let someHeader () = | ||||
|             (Interlocked.Increment someHeaderCount : int).ToString () | ||||
|  | ||||
|         let someOtherHeaderCount = ref -100 | ||||
|  | ||||
|         let someOtherHeader () = | ||||
|             Interlocked.Increment someOtherHeaderCount | ||||
|  | ||||
|         let api = ApiWithHeaders.make someHeader someOtherHeader client | ||||
|  | ||||
|         someHeaderCount.Value |> shouldEqual 10 | ||||
|         someOtherHeaderCount.Value |> shouldEqual -100 | ||||
|  | ||||
|         api.GetPathParam("param").Result.Split "\n" | ||||
|         |> Array.sort | ||||
|         |> shouldEqual | ||||
|             [| | ||||
|                 "Authorization: -99" | ||||
|                 "Header-Name: Header-Value" | ||||
|                 "Something-Else: val" | ||||
|                 "X-Foo: 11" | ||||
|             |] | ||||
|  | ||||
|         api.GetPathParam("param").Result.Split "\n" | ||||
|         |> Array.sort | ||||
|         |> shouldEqual | ||||
|             [| | ||||
|                 "Authorization: -98" | ||||
|                 "Header-Name: Header-Value" | ||||
|                 "Something-Else: val" | ||||
|                 "X-Foo: 12" | ||||
|             |] | ||||
|  | ||||
|         someHeaderCount.Value |> shouldEqual 12 | ||||
|         someOtherHeaderCount.Value |> shouldEqual -98 | ||||
| @@ -87,8 +87,10 @@ module TestVaultClient = | ||||
|     } | ||||
| }""" | ||||
|  | ||||
|     [<Test>] | ||||
|     let ``URI example`` () = | ||||
|     [<TestCase 1>] | ||||
|     [<TestCase 2>] | ||||
|     [<TestCase 3>] | ||||
|     let ``URI example`` (vaultClientId : int) = | ||||
|         let proc (message : HttpRequestMessage) : HttpResponseMessage Async = | ||||
|             async { | ||||
|                 message.Method |> shouldEqual HttpMethod.Get | ||||
| @@ -112,10 +114,25 @@ module TestVaultClient = | ||||
|             } | ||||
|  | ||||
|         use client = HttpClientMock.make (Uri "https://my-vault.com") proc | ||||
|         let api = VaultClient.make client | ||||
|  | ||||
|         let vaultResponse = api.GetJwt("role", "jwt").Result | ||||
|         let value = api.GetSecret(vaultResponse, "path", "mount").Result | ||||
|         let value = | ||||
|             match vaultClientId with | ||||
|             | 1 -> | ||||
|                 let api = VaultClient.make client | ||||
|                 let vaultResponse = api.GetJwt("role", "jwt").Result | ||||
|                 let value = api.GetSecret(vaultResponse, "path", "mount").Result | ||||
|                 value | ||||
|             | 2 -> | ||||
|                 let api = VaultClientNonExtensionMethod.make client | ||||
|                 let vaultResponse = api.GetJwt("role", "jwt").Result | ||||
|                 let value = api.GetSecret(vaultResponse, "path", "mount").Result | ||||
|                 value | ||||
|             | 3 -> | ||||
|                 let api = VaultClientExtensionMethod.make client | ||||
|                 let vaultResponse = api.GetJwt("role", "jwt").Result | ||||
|                 let value = api.GetSecret(vaultResponse, "path", "mount").Result | ||||
|                 value | ||||
|             | _ -> failwith $"Unrecognised ID: %i{vaultClientId}" | ||||
|  | ||||
|         value.Data | ||||
|         |> Seq.toList | ||||
| @@ -168,3 +185,5 @@ module TestVaultClient = | ||||
|                 "key8_1", "https://example.com/data8/1" | ||||
|                 "key8_2", "https://example.com/data8/2" | ||||
|             ] | ||||
|  | ||||
|     let _canSeePastExtensionMethod = VaultClientExtensionMethod.thisClashes | ||||
|   | ||||
| @@ -1,6 +1,7 @@ | ||||
| namespace WoofWare.Myriad.Plugins.Test | ||||
|  | ||||
| open System | ||||
| open System.Numerics | ||||
| open System.Text.Json.Nodes | ||||
| open ConsumePlugin | ||||
| open NUnit.Framework | ||||
| @@ -12,15 +13,62 @@ module TestExtensionMethod = | ||||
|     [<Test>] | ||||
|     let ``Parse via extension method`` () = | ||||
|         let json = | ||||
|             """{"tinker": "job", "tailor": 3, "soldier": "https://example.com", "sailor": 3.1}""" | ||||
|             """{ | ||||
|     "alpha": "hello!", | ||||
|     "bravo": "https://example.com", | ||||
|     "charlie": 0.3341, | ||||
|     "delta": 110033.4, | ||||
|     "echo": -0.000993, | ||||
|     "foxtrot": -999999999999, | ||||
|     "golf": -123456789101112, | ||||
|     "hotel": 18446744073709551615, | ||||
|     "india": 99884, | ||||
|     "juliette": 12223334, | ||||
|     "kilo": -2147483642, | ||||
|     "lima": 4294967293, | ||||
|     "mike": -32767, | ||||
|     "november": 65533, | ||||
|     "oscar": -125, | ||||
|     "papa": 253, | ||||
|     "quebec": 254, | ||||
|     "tango": -3, | ||||
|     "uniform": 1004443.300988393349583009, | ||||
|     "victor": "x", | ||||
|     "whiskey": 123456123456123456123456123456123456123456 | ||||
| }""" | ||||
|             |> JsonNode.Parse | ||||
|  | ||||
|         let expected = | ||||
|             { | ||||
|                 Tinker = "job" | ||||
|                 Tailor = 3 | ||||
|                 Soldier = Uri "https://example.com" | ||||
|                 Sailor = 3.1 | ||||
|                 Alpha = "hello!" | ||||
|                 Bravo = Uri "https://example.com" | ||||
|                 Charlie = 0.3341 | ||||
|                 Delta = 110033.4f | ||||
|                 Echo = -0.000993f | ||||
|                 Foxtrot = -999999999999.0 | ||||
|                 Golf = -123456789101112L | ||||
|                 Hotel = 18446744073709551615UL | ||||
|                 India = 99884 | ||||
|                 Juliette = 12223334u | ||||
|                 Kilo = -2147483642 | ||||
|                 Lima = 4294967293u | ||||
|                 Mike = -32767s | ||||
|                 November = 65533us | ||||
|                 Oscar = -125y | ||||
|                 Papa = 253uy | ||||
|                 Quebec = 254uy | ||||
|                 Tango = -3y | ||||
|                 Uniform = 1004443.300988393349583009m | ||||
|                 Victor = 'x' | ||||
|                 Whiskey = | ||||
|                     let mutable i = BigInteger 0 | ||||
|  | ||||
|                     for _ = 0 to 6 do | ||||
|                         i <- i * BigInteger 1000000 + BigInteger 123456 | ||||
|  | ||||
|                     i | ||||
|             } | ||||
|  | ||||
|         ToGetExtensionMethod.jsonParse json |> shouldEqual expected | ||||
|         let actual = ToGetExtensionMethod.jsonParse json | ||||
|  | ||||
|         actual |> shouldEqual expected | ||||
|   | ||||
| @@ -7,6 +7,8 @@ open FsUnitTyped | ||||
|  | ||||
| [<TestFixture>] | ||||
| module TestJsonParse = | ||||
|     let _canSeePastExtensionMethod = ToGetExtensionMethod.thisModuleWouldClash | ||||
|  | ||||
|     [<Test>] | ||||
|     let ``Single example`` () = | ||||
|         let s = | ||||
| @@ -47,3 +49,15 @@ module TestJsonParse = | ||||
|  | ||||
|         let actual = s |> JsonNode.Parse |> InnerType.jsonParse | ||||
|         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 | ||||
|   | ||||
| @@ -3,6 +3,8 @@ namespace WoofWare.Myriad.Plugins.Test | ||||
| open System | ||||
| open System.Collections.Generic | ||||
| open System.Text.Json.Nodes | ||||
| open FsCheck.Random | ||||
| open Microsoft.FSharp.Reflection | ||||
| open NUnit.Framework | ||||
| open FsCheck | ||||
| open FsUnitTyped | ||||
| @@ -19,7 +21,7 @@ module TestJsonSerde = | ||||
|  | ||||
|     let rec innerGen (count : int) : Gen<InnerTypeWithBoth> = | ||||
|         gen { | ||||
|             let! s = Arb.generate<NonNull<string>> | ||||
|             let! guid = Arb.generate<Guid> | ||||
|             let! mapKeys = Gen.listOf Arb.generate<NonNull<string>> | ||||
|             let mapKeys = mapKeys |> List.map _.Get |> List.distinct | ||||
|             let! mapValues = Gen.listOfLength mapKeys.Length uriGen | ||||
| @@ -59,7 +61,7 @@ module TestJsonSerde = | ||||
|  | ||||
|             return | ||||
|                 { | ||||
|                     Thing = s.Get | ||||
|                     Thing = guid | ||||
|                     Map = map | ||||
|                     ReadOnlyDict = readOnlyDict | ||||
|                     Dict = dict | ||||
| @@ -75,7 +77,22 @@ module TestJsonSerde = | ||||
|             let! depth = Gen.choose (0, 2) | ||||
|             let! d = innerGen depth | ||||
|             let! e = Gen.arrayOf Arb.generate<NonNull<string>> | ||||
|             let! f = Gen.arrayOf Arb.generate<int> | ||||
|             let! arr = Gen.arrayOf Arb.generate<int> | ||||
|             let! byte = Arb.generate | ||||
|             let! sbyte = Arb.generate | ||||
|             let! i = Arb.generate | ||||
|             let! i32 = Arb.generate | ||||
|             let! i64 = Arb.generate | ||||
|             let! u = Arb.generate | ||||
|             let! u32 = Arb.generate | ||||
|             let! u64 = Arb.generate | ||||
|             let! f = Arb.generate |> Gen.filter (fun s -> Double.IsFinite (s / 1.0<measure>)) | ||||
|             let! f32 = Arb.generate |> Gen.filter (fun s -> Single.IsFinite (s / 1.0f<measure>)) | ||||
|             let! single = Arb.generate |> Gen.filter (fun s -> Single.IsFinite (s / 1.0f<measure>)) | ||||
|             let! intMeasureOption = Arb.generate | ||||
|             let! intMeasureNullable = Arb.generate | ||||
|             let! someEnum = Gen.choose (0, 1) | ||||
|             let! timestamp = Arb.generate | ||||
|  | ||||
|             return | ||||
|                 { | ||||
| @@ -84,7 +101,23 @@ module TestJsonSerde = | ||||
|                     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 = () | ||||
|                 } | ||||
|         } | ||||
|  | ||||
| @@ -101,3 +134,341 @@ module TestJsonSerde = | ||||
|             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 = Arb.generate<NonNull<string>> | ||||
|                 return FirstDu.Case1 s.Get | ||||
|             | 2 -> | ||||
|                 let! i = Arb.generate<int> | ||||
|                 let! record = outerGen | ||||
|                 return FirstDu.Case2 (record, i) | ||||
|             | _ -> return failwith $"unexpected: %i{case}" | ||||
|         } | ||||
|  | ||||
|     [<Test>] | ||||
|     let ``Discriminated union works`` () = | ||||
|         let property (du : FirstDu) : unit = | ||||
|             du | ||||
|             |> FirstDu.toJsonNode | ||||
|             |> fun s -> s.ToJsonString () | ||||
|             |> JsonNode.Parse | ||||
|             |> FirstDu.jsonParse | ||||
|             |> shouldEqual du | ||||
|  | ||||
|         property |> Prop.forAll (Arb.fromGen duGen) |> Check.QuickThrowOnFailure | ||||
|  | ||||
|     [<Test>] | ||||
|     let ``DU generator covers all cases`` () = | ||||
|         let rand = Random () | ||||
|         let cases = FSharpType.GetUnionCases typeof<FirstDu> | ||||
|         let counts = Array.zeroCreate<int> cases.Length | ||||
|  | ||||
|         let decompose = FSharpValue.PreComputeUnionTagReader typeof<FirstDu> | ||||
|  | ||||
|         let mutable i = 0 | ||||
|  | ||||
|         while i < 10_000 && Array.exists (fun i -> i = 0) counts do | ||||
|             let du = Gen.eval 10 (StdGen.StdGen (rand.Next (), rand.Next ())) duGen | ||||
|             let tag = decompose du | ||||
|             counts.[tag] <- counts.[tag] + 1 | ||||
|             i <- i + 1 | ||||
|  | ||||
|         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 | ||||
|   | ||||
| @@ -0,0 +1,36 @@ | ||||
| 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" | ||||
| @@ -6,13 +6,14 @@ open ApiSurface | ||||
|  | ||||
| [<TestFixture>] | ||||
| module TestSurface = | ||||
|     let assembly = typeof<RemoveOptionsAttribute>.Assembly | ||||
|     let assembly = typeof<RemoveOptionsGenerator>.Assembly | ||||
|  | ||||
|     [<Test>] | ||||
|     let ``Ensure API surface has not been modified`` () = ApiSurface.assertIdentical assembly | ||||
|  | ||||
|     [<Test>] | ||||
|     let ``Check version against remote`` () = | ||||
|     // https://github.com/nunit/nunit3-vs-adapter/issues/876 | ||||
|     let CheckVersionAgainstRemote () = | ||||
|         MonotonicVersion.validate assembly "WoofWare.Myriad.Plugins" | ||||
|  | ||||
|     [<Test ; Explicit>] | ||||
|   | ||||
							
								
								
									
										84
									
								
								WoofWare.Myriad.Plugins.Test/TestSwagger/TestSwaggerParse.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										84
									
								
								WoofWare.Myriad.Plugins.Test/TestSwagger/TestSwaggerParse.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,84 @@ | ||||
| namespace WoofWare.Myriad.Plugins.Test | ||||
|  | ||||
| open System.Text.Json.Nodes | ||||
| open NUnit.Framework | ||||
| open FsUnitTyped | ||||
| open WoofWare.Myriad.Plugins | ||||
|  | ||||
| [<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 | ||||
|             } | ||||
| @@ -4,6 +4,11 @@ | ||||
|     <TargetFramework>net8.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> | ||||
| @@ -19,20 +24,29 @@ | ||||
|     <Compile Include="TestHttpClient\TestBasePath.fs" /> | ||||
|     <Compile Include="TestHttpClient\TestBodyParam.fs" /> | ||||
|     <Compile Include="TestHttpClient\TestVaultClient.fs" /> | ||||
|     <Compile Include="TestHttpClient\TestVariableHeader.fs" /> | ||||
|     <Compile Include="TestMockGenerator\TestMockGenerator.fs" /> | ||||
|     <Compile Include="TestMockGenerator\TestMockGeneratorNoAttr.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="TestRemoveOptions.fs"/> | ||||
|     <Compile Include="TestSurface.fs"/> | ||||
|     <None Include="../.github/workflows/dotnet.yaml" /> | ||||
|   </ItemGroup> | ||||
|  | ||||
|   <ItemGroup> | ||||
|     <PackageReference Include="ApiSurface" Version="4.0.25"/> | ||||
|     <PackageReference Include="ApiSurface" Version="4.1.5"/> | ||||
|     <PackageReference Include="FsCheck" Version="2.16.6"/> | ||||
|     <PackageReference Include="FsUnit" Version="6.0.0"/> | ||||
|     <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.8.0"/> | ||||
|     <PackageReference Include="NUnit" Version="4.0.1"/> | ||||
|     <PackageReference Include="NUnit3TestAdapter" Version="4.5.0"/> | ||||
|     <PackageReference Include="NUnit.Analyzers" Version="3.10.0"/> | ||||
|     <PackageReference Include="coverlet.collector" Version="6.0.0"/> | ||||
|     <PackageReference Include="FsUnit" Version="6.0.1"/> | ||||
|     <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.11.1"/> | ||||
|     <PackageReference Include="NUnit" Version="4.2.2"/> | ||||
|     <PackageReference Include="NUnit3TestAdapter" Version="4.6.0"/> | ||||
|   </ItemGroup> | ||||
|  | ||||
|   <ItemGroup> | ||||
| @@ -40,8 +54,4 @@ | ||||
|     <ProjectReference Include="..\ConsumePlugin\ConsumePlugin.fsproj"/> | ||||
|   </ItemGroup> | ||||
|  | ||||
|   <ItemGroup> | ||||
|     <Compile Include="TestJsonSerialize\TestJsonSerde.fs" /> | ||||
|   </ItemGroup> | ||||
|  | ||||
| </Project> | ||||
|   | ||||
							
								
								
									
										1820
									
								
								WoofWare.Myriad.Plugins/ArgParserGenerator.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										1820
									
								
								WoofWare.Myriad.Plugins/ArgParserGenerator.fs
									
									
									
									
									
										Normal file
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							| @@ -1,10 +1,8 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open Fantomas.FCS.Syntax | ||||
| open Fantomas.FCS.SyntaxTrivia | ||||
| open Fantomas.FCS.Text.Range | ||||
| open Fantomas.FCS.Xml | ||||
| open Myriad.Core.AstExtensions | ||||
|  | ||||
| type internal ParameterInfo = | ||||
|     { | ||||
| @@ -33,11 +31,30 @@ type internal MemberInfo = | ||||
|         IsMutable : bool | ||||
|     } | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| type internal PropertyAccessors = | ||||
|     | Get | ||||
|     | Set | ||||
|     | GetSet | ||||
|  | ||||
| type internal PropertyInfo = | ||||
|     { | ||||
|         Type : SynType | ||||
|         Accessibility : SynAccess option | ||||
|         Attributes : SynAttribute list | ||||
|         XmlDoc : PreXmlDoc option | ||||
|         Accessors : PropertyAccessors | ||||
|         IsInline : bool | ||||
|         Identifier : Ident | ||||
|     } | ||||
|  | ||||
| type internal InterfaceType = | ||||
|     { | ||||
|         Attributes : SynAttribute list | ||||
|         Name : LongIdent | ||||
|         Inherits : SynType list | ||||
|         Members : MemberInfo list | ||||
|         Properties : PropertyInfo list | ||||
|         Generics : SynTyparDecls option | ||||
|         Accessibility : SynAccess option | ||||
|     } | ||||
| @@ -45,99 +62,165 @@ type internal InterfaceType = | ||||
| type internal RecordType = | ||||
|     { | ||||
|         Name : Ident | ||||
|         Fields : SynField seq | ||||
|         Fields : SynField list | ||||
|         /// Any additional members which are not record fields. | ||||
|         Members : SynMemberDefns option | ||||
|         XmlDoc : PreXmlDoc option | ||||
|         Generics : SynTyparDecls option | ||||
|         Accessibility : SynAccess option | ||||
|         TypeAccessibility : SynAccess option | ||||
|         ImplAccessibility : SynAccess option | ||||
|         Attributes : SynAttribute list | ||||
|     } | ||||
|  | ||||
|     /// Parse from the AST. | ||||
|     static member OfRecord | ||||
|         (sci : SynComponentInfo) | ||||
|         (smd : SynMemberDefns) | ||||
|         (access : SynAccess option) | ||||
|         (recordFields : SynField list) | ||||
|         : RecordType | ||||
|         = | ||||
|         match sci with | ||||
|         | SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, implAccess, _) -> | ||||
|             { | ||||
|                 Name = List.last longId | ||||
|                 Fields = recordFields | ||||
|                 Members = if smd.IsEmpty then None else Some smd | ||||
|                 XmlDoc = if doc.IsEmpty then None else Some doc | ||||
|                 Generics = typars | ||||
|                 ImplAccessibility = implAccess | ||||
|                 TypeAccessibility = access | ||||
|                 Attributes = attrs |> List.collect (fun l -> l.Attributes) | ||||
|             } | ||||
|  | ||||
| /// Methods for manipulating UnionCase. | ||||
| [<RequireQualifiedAccess>] | ||||
| module UnionCase = | ||||
|     /// Construct our structured `UnionCase` from an FCS `SynUnionCase`: extract everything | ||||
|     /// we care about from the AST representation. | ||||
|     let ofSynUnionCase (case : SynUnionCase) : UnionCase<Ident option> = | ||||
|         match case with | ||||
|         | SynUnionCase.SynUnionCase (attributes, ident, caseType, xmlDoc, access, _, _) -> | ||||
|  | ||||
|         let ident = | ||||
|             match ident with | ||||
|             | SynIdent.SynIdent (ident, _) -> ident | ||||
|  | ||||
|         let fields = | ||||
|             match caseType with | ||||
|             | SynUnionCaseKind.Fields cases -> cases | ||||
|             | SynUnionCaseKind.FullType _ -> failwith "unexpected FullType union" | ||||
|  | ||||
|         { | ||||
|             Name = ident | ||||
|             XmlDoc = if xmlDoc.IsEmpty then None else Some xmlDoc | ||||
|             Access = access | ||||
|             Attributes = attributes |> List.collect (fun t -> t.Attributes) | ||||
|             Fields = fields |> List.map SynField.extract | ||||
|         } | ||||
|  | ||||
|     /// Functorial `map`. | ||||
|     let mapIdentFields<'a, 'b> (f : 'a -> 'b) (unionCase : UnionCase<'a>) : UnionCase<'b> = | ||||
|         { | ||||
|             Attributes = unionCase.Attributes | ||||
|             Name = unionCase.Name | ||||
|             Access = unionCase.Access | ||||
|             XmlDoc = unionCase.XmlDoc | ||||
|             Fields = unionCase.Fields |> List.map (SynField.mapIdent f) | ||||
|         } | ||||
|  | ||||
| /// Everything you need to know about a discriminated union definition. | ||||
| type internal UnionType = | ||||
|     { | ||||
|         /// The name of the DU: for example, `type Foo = | Blah` has this being `Foo`. | ||||
|         Name : Ident | ||||
|         /// Any additional members which are not union cases. | ||||
|         Members : SynMemberDefns option | ||||
|         /// Any docstring associated with the DU itself (not its cases). | ||||
|         XmlDoc : PreXmlDoc option | ||||
|         /// Generic type parameters this DU takes: `type Foo<'a> = | ...`. | ||||
|         Generics : SynTyparDecls option | ||||
|         /// Attributes of the DU (not its cases): `[<Attr>] type Foo = | ...` | ||||
|         Attributes : SynAttribute list | ||||
|         /// Accessibility modifier of the DU: `type private Foo = ...` | ||||
|         TypeAccessibility : SynAccess option | ||||
|         /// Accessibility modifier of the DU's implementation: `type Foo = private | ...` | ||||
|         ImplAccessibility : SynAccess option | ||||
|         /// The actual DU cases themselves. | ||||
|         Cases : UnionCase<Ident option> list | ||||
|     } | ||||
|  | ||||
|     static member OfUnion | ||||
|         (sci : SynComponentInfo) | ||||
|         (smd : SynMemberDefns) | ||||
|         (access : SynAccess option) | ||||
|         (cases : SynUnionCase list) | ||||
|         : UnionType | ||||
|         = | ||||
|         match sci with | ||||
|         | SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, implAccess, _) -> | ||||
|             { | ||||
|                 Name = List.last longId | ||||
|                 Members = if smd.IsEmpty then None else Some smd | ||||
|                 XmlDoc = if doc.IsEmpty then None else Some doc | ||||
|                 Generics = typars | ||||
|                 Attributes = attrs |> List.collect (fun l -> l.Attributes) | ||||
|                 TypeAccessibility = access | ||||
|                 ImplAccessibility = implAccess | ||||
|                 Cases = cases |> List.map UnionCase.ofSynUnionCase | ||||
|             } | ||||
|  | ||||
| /// Anything that is part of an ADT. | ||||
| /// A record is a product of stuff; this type represents one of those stuffs. | ||||
| type internal AdtNode = | ||||
|     { | ||||
|         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`); | ||||
| /// similarly a record is a product. | ||||
| /// This type represents a product in that sense. | ||||
| type internal AdtProduct = | ||||
|     { | ||||
|         Name : SynIdent | ||||
|         Fields : AdtNode 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. | ||||
|         Generics : SynTyparDecl list | ||||
|     } | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal AstHelper = | ||||
|  | ||||
|     let instantiateRecord (fields : (RecordFieldName * SynExpr option) list) : SynExpr = | ||||
|     let isEnum (SynTypeDefn.SynTypeDefn (_, repr, _, _, _, _)) : bool = | ||||
|         match repr with | ||||
|         | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Enum _, _) -> true | ||||
|         | _ -> false | ||||
|  | ||||
|     let instantiateRecord (fields : (SynLongIdent * SynExpr) list) : SynExpr = | ||||
|         let fields = | ||||
|             fields | ||||
|             |> List.map (fun (rfn, synExpr) -> SynExprRecordField (rfn, Some range0, synExpr, None)) | ||||
|             |> List.map (fun (rfn, synExpr) -> SynExprRecordField ((rfn, true), Some range0, Some synExpr, None)) | ||||
|  | ||||
|         SynExpr.Record (None, None, fields, range0) | ||||
|  | ||||
|     let defineRecordType (record : RecordType) : SynTypeDefn = | ||||
|         let repr = | ||||
|             SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (None, Seq.toList record.Fields, range0), range0) | ||||
|  | ||||
|         let name = | ||||
|             SynComponentInfo.Create ( | ||||
|                 [ record.Name ], | ||||
|                 ?xmldoc = record.XmlDoc, | ||||
|                 ?parameters = record.Generics, | ||||
|                 access = record.Accessibility | ||||
|             ) | ||||
|             SynComponentInfo.create record.Name | ||||
|             |> SynComponentInfo.setAccessibility record.TypeAccessibility | ||||
|             |> match record.XmlDoc with | ||||
|                | None -> id | ||||
|                | Some doc -> SynComponentInfo.withDocString doc | ||||
|             |> SynComponentInfo.setGenerics record.Generics | ||||
|  | ||||
|         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 isResponseIdent (ident : SynLongIdent) : bool = | ||||
|         match ident.LongIdent |> List.map _.idText with | ||||
|         | [ "Response" ] | ||||
|         | [ "RestEase" ; "Response" ] -> 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 | ||||
|         SynTypeDefnRepr.recordWithAccess record.ImplAccessibility (Seq.toList record.Fields) | ||||
|         |> SynTypeDefn.create name | ||||
|         |> SynTypeDefn.withMemberDefns (defaultArg record.Members SynMemberDefns.Empty) | ||||
|  | ||||
|     let rec private extractOpensFromDecl (moduleDecls : SynModuleDecl list) : SynOpenDeclTarget list = | ||||
|         moduleDecls | ||||
| @@ -159,12 +242,12 @@ module internal AstHelper = | ||||
|         | SynType.Paren (inner, _) -> | ||||
|             let result, _ = convertSigParam inner | ||||
|             result, true | ||||
|         | SynType.LongIdent ident -> | ||||
|         | SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) -> | ||||
|             { | ||||
|                 Attributes = [] | ||||
|                 IsOptional = false | ||||
|                 Id = None | ||||
|                 Type = SynType.CreateLongIdent ident | ||||
|                 Type = SynType.createLongIdent ident | ||||
|             }, | ||||
|             false | ||||
|         | SynType.SignatureParameter (attrs, opt, id, usedType, _) -> | ||||
| @@ -182,7 +265,7 @@ module internal AstHelper = | ||||
|                 Attributes = [] | ||||
|                 IsOptional = false | ||||
|                 Id = None | ||||
|                 Type = SynType.Var (typar, range0) | ||||
|                 Type = SynType.var typar | ||||
|             }, | ||||
|             false | ||||
|         | _ -> failwithf "expected SignatureParameter, got: %+A" ty | ||||
| @@ -211,10 +294,6 @@ module internal AstHelper = | ||||
|             } | ||||
|         | _ -> failwithf "Didn't have alternating type-and-star in interface member definition: %+A" tupleType | ||||
|  | ||||
|     let toFun (inputs : SynType list) (ret : SynType) : SynType = | ||||
|         (ret, List.rev inputs) | ||||
|         ||> List.fold (fun ty input -> SynType.CreateFun (input, ty)) | ||||
|  | ||||
|     /// Returns the args (where these are tuple types if curried) in order, and the return type. | ||||
|     let rec getType (ty : SynType) : (SynType * bool) list * SynType = | ||||
|         match ty with | ||||
| @@ -227,9 +306,122 @@ module internal AstHelper = | ||||
|                 | SynType.Paren (argType, _) -> getType argType, true | ||||
|                 | _ -> getType argType, false | ||||
|  | ||||
|             ((toFun (List.map fst inputArgs) inputRet), hasParen) :: args, ret | ||||
|             ((SynType.toFun (List.map fst inputArgs) inputRet), hasParen) :: args, ret | ||||
|         | _ -> [], 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 ...` | ||||
|     let parseInterface (interfaceType : SynTypeDefn) : InterfaceType = | ||||
|         let (SynTypeDefn (SynComponentInfo (attrs, typars, _, interfaceName, _, _, accessibility, _), | ||||
| @@ -242,271 +434,98 @@ module internal AstHelper = | ||||
|  | ||||
|         let attrs = attrs |> List.collect (fun s -> s.Attributes) | ||||
|  | ||||
|         let members = | ||||
|         let members, inherits = | ||||
|             match synTypeDefnRepr with | ||||
|             | SynTypeDefnRepr.ObjectModel (_kind, members, _) -> | ||||
|                 members | ||||
|                 |> List.map (fun defn -> | ||||
|                     match defn with | ||||
|                     | SynMemberDefn.AbstractSlot (slotSig, flags, _, _) -> | ||||
|                         match flags.MemberKind with | ||||
|                         | SynMemberKind.Member -> () | ||||
|                         | kind -> failwithf "Unrecognised member kind: %+A" kind | ||||
|  | ||||
|                         if not flags.IsInstance then | ||||
|                             failwith "member was not an instance member" | ||||
|  | ||||
|                         match slotSig with | ||||
|                         | SynValSig (attrs, | ||||
|                                      SynIdent.SynIdent (ident, _), | ||||
|                                      _typeParams, | ||||
|                                      synType, | ||||
|                                      arity, | ||||
|                                      isInline, | ||||
|                                      isMutable, | ||||
|                                      xmlDoc, | ||||
|                                      accessibility, | ||||
|                                      synExpr, | ||||
|                                      _, | ||||
|                                      _) -> | ||||
|  | ||||
|                             match synExpr with | ||||
|                             | Some _ -> failwith "literal members are not supported" | ||||
|                             | None -> () | ||||
|  | ||||
|                             let attrs = attrs |> List.collect (fun attr -> attr.Attributes) | ||||
|  | ||||
|                             let args, ret = getType synType | ||||
|  | ||||
|                             let args = | ||||
|                                 args | ||||
|                                 |> List.map (fun (args, hasParen) -> | ||||
|                                     match args with | ||||
|                                     | SynType.Tuple (false, path, _) -> extractTupledTypes path | ||||
|                                     | SynType.SignatureParameter _ -> | ||||
|                                         let arg, hasParen = convertSigParam args | ||||
|  | ||||
|                                         { | ||||
|                                             HasParen = hasParen | ||||
|                                             Args = [ arg ] | ||||
|                                         } | ||||
|                                     | SynType.LongIdent (SynLongIdent (ident, _, _)) -> | ||||
|                                         { | ||||
|                                             HasParen = false | ||||
|                                             Args = | ||||
|                                                 { | ||||
|                                                     Attributes = [] | ||||
|                                                     IsOptional = false | ||||
|                                                     Id = None | ||||
|                                                     Type = | ||||
|                                                         SynType.CreateLongIdent ( | ||||
|                                                             SynLongIdent.CreateFromLongIdent ident | ||||
|                                                         ) | ||||
|                                                 } | ||||
|                                                 |> List.singleton | ||||
|                                         } | ||||
|                                     | SynType.Var (typar, _) -> | ||||
|                                         { | ||||
|                                             HasParen = false | ||||
|                                             Args = | ||||
|                                                 { | ||||
|                                                     Attributes = [] | ||||
|                                                     IsOptional = false | ||||
|                                                     Id = None | ||||
|                                                     Type = SynType.Var (typar, range0) | ||||
|                                                 } | ||||
|                                                 |> List.singleton | ||||
|                                         } | ||||
|                                     | _ -> failwith $"Unrecognised args in interface method declaration: %+A{args}" | ||||
|                                     |> fun ty -> | ||||
|                                         { ty with | ||||
|                                             HasParen = ty.HasParen || hasParen | ||||
|                                         } | ||||
|                                 ) | ||||
|  | ||||
|                             { | ||||
|                                 ReturnType = ret | ||||
|                                 Args = args | ||||
|                                 Identifier = ident | ||||
|                                 Attributes = attrs | ||||
|                                 XmlDoc = Some xmlDoc | ||||
|                                 Accessibility = accessibility | ||||
|                                 IsInline = isInline | ||||
|                                 IsMutable = isMutable | ||||
|                             } | ||||
|                     | SynMemberDefn.AbstractSlot (slotSig, flags, _, _) -> Choice1Of2 (parseMember slotSig flags) | ||||
|                     | SynMemberDefn.Inherit (baseType, _asIdent, _) -> Choice2Of2 baseType | ||||
|                     | _ -> failwith $"Unrecognised member definition: %+A{defn}" | ||||
|                 ) | ||||
|             | _ -> failwith $"Unrecognised SynTypeDefnRepr for an interface type: %+A{synTypeDefnRepr}" | ||||
|             |> List.partitionChoice | ||||
|  | ||||
|         let members, properties = members |> List.partitionChoice | ||||
|  | ||||
|         { | ||||
|             Members = members | ||||
|             Properties = properties | ||||
|             Name = interfaceName | ||||
|             Inherits = inherits | ||||
|             Attributes = attrs | ||||
|             Generics = typars | ||||
|             Accessibility = accessibility | ||||
|         } | ||||
|  | ||||
|     let getUnionCases | ||||
|         (SynTypeDefn.SynTypeDefn (info, repr, _, _, _, _)) | ||||
|         : AdtProduct list * SynTyparDecl list * SynAccess option | ||||
|         = | ||||
|         let typars, access = | ||||
|             match info with | ||||
|             | SynComponentInfo (_, typars, _, _, _, _, access, _) -> typars, access | ||||
|  | ||||
| [<AutoOpen>] | ||||
| module internal SynTypePatterns = | ||||
|     let (|OptionType|_|) (fieldType : SynType) = | ||||
|         match fieldType with | ||||
|         | SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when AstHelper.isOptionIdent ident -> | ||||
|             Some innerType | ||||
|         | _ -> None | ||||
|         let typars = | ||||
|             match typars with | ||||
|             | None -> [] | ||||
|             | Some (SynTyparDecls.PrefixList (decls, _)) -> decls | ||||
|             | Some (SynTyparDecls.SinglePrefix (l, _)) -> [ l ] | ||||
|             | Some (SynTyparDecls.PostfixList (decls, constraints, _)) -> | ||||
|                 if not constraints.IsEmpty then | ||||
|                     failwith "Constrained type parameters not currently supported" | ||||
|  | ||||
|     let (|ListType|_|) (fieldType : SynType) = | ||||
|         match fieldType with | ||||
|         | SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when AstHelper.isListIdent ident -> | ||||
|             Some innerType | ||||
|         | _ -> None | ||||
|                 decls | ||||
|  | ||||
|     let (|ArrayType|_|) (fieldType : SynType) = | ||||
|         match fieldType with | ||||
|         | SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when AstHelper.isArrayIdent ident -> | ||||
|             Some innerType | ||||
|         | SynType.Array (1, innerType, _) -> Some innerType | ||||
|         | _ -> None | ||||
|         match repr with | ||||
|         | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (_, cases, _), _) -> | ||||
|             let cases = | ||||
|                 cases | ||||
|                 |> List.map (fun (SynUnionCase.SynUnionCase (_, ident, kind, _, _, _, _)) -> | ||||
|                     match kind with | ||||
|                     | 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 | ||||
|                         } | ||||
|                 ) | ||||
|  | ||||
|     let (|RestEaseResponseType|_|) (fieldType : SynType) = | ||||
|         match fieldType with | ||||
|         | SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when AstHelper.isResponseIdent ident -> | ||||
|             Some innerType | ||||
|         | _ -> None | ||||
|             cases, typars, access | ||||
|         | _ -> failwithf "Failed to get union cases for type that was: %+A" repr | ||||
|  | ||||
|     let (|DictionaryType|_|) (fieldType : SynType) = | ||||
|         match fieldType with | ||||
|         | SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when AstHelper.isDictionaryIdent ident -> | ||||
|             Some (key, value) | ||||
|         | _ -> None | ||||
|     let getRecordFields (SynTypeDefn.SynTypeDefn (typeInfo, repr, _, _, _, _)) : AdtNode list = | ||||
|         let (SynComponentInfo.SynComponentInfo (typeParams = typars)) = typeInfo | ||||
|  | ||||
|     let (|IDictionaryType|_|) (fieldType : SynType) = | ||||
|         match fieldType with | ||||
|         | SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when AstHelper.isIDictionaryIdent ident -> | ||||
|             Some (key, value) | ||||
|         | _ -> None | ||||
|         let typars = | ||||
|             match typars with | ||||
|             | None -> [] | ||||
|             | Some (SynTyparDecls.PrefixList (decls, _)) -> decls | ||||
|             | Some (SynTyparDecls.SinglePrefix (l, _)) -> [ l ] | ||||
|             | Some (SynTyparDecls.PostfixList (decls, constraints, _)) -> | ||||
|                 if not constraints.IsEmpty then | ||||
|                     failwith "Constrained type parameters not currently supported" | ||||
|  | ||||
|     let (|IReadOnlyDictionaryType|_|) (fieldType : SynType) = | ||||
|         match fieldType with | ||||
|         | SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when | ||||
|             AstHelper.isReadOnlyDictionaryIdent ident | ||||
|             -> | ||||
|             Some (key, value) | ||||
|         | _ -> None | ||||
|                 decls | ||||
|  | ||||
|     let (|MapType|_|) (fieldType : SynType) = | ||||
|         match fieldType with | ||||
|         | SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when AstHelper.isMapIdent ident -> | ||||
|             Some (key, value) | ||||
|         | _ -> None | ||||
|  | ||||
|     /// Returns the string name of the type. | ||||
|     let (|PrimitiveType|_|) (fieldType : SynType) = | ||||
|         match fieldType with | ||||
|         | SynType.LongIdent ident -> | ||||
|             match ident.LongIdent with | ||||
|             | [ i ] -> | ||||
|                 [ "string" ; "float" ; "int" ; "bool" ; "char" ] | ||||
|                 |> 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 | ||||
|         match repr with | ||||
|         | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_, fields, _), _) -> | ||||
|             fields | ||||
|             |> List.map (fun (SynField.SynField (_, _, ident, ty, _, _, _, _, _)) -> | ||||
|                 { | ||||
|                     Name = ident | ||||
|                     Type = ty | ||||
|                     GenericsOfParent = typars | ||||
|                 } | ||||
|             ) | ||||
|         | _ -> failwithf "Failed to get record elements for type that was: %+A" repr | ||||
|   | ||||
							
								
								
									
										1240
									
								
								WoofWare.Myriad.Plugins/CataGenerator.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										1240
									
								
								WoofWare.Myriad.Plugins/CataGenerator.fs
									
									
									
									
									
										Normal file
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							| @@ -2,186 +2,133 @@ namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open System | ||||
| open Fantomas.FCS.Syntax | ||||
| open Fantomas.FCS.SyntaxTrivia | ||||
| open Fantomas.FCS.Xml | ||||
| open Myriad.Core | ||||
|  | ||||
| /// Attribute indicating an interface type for which the "Generate Mock" Myriad | ||||
| /// generator should apply during build. | ||||
| /// This generator creates a record which implements the interface, | ||||
| /// but where each method is represented as a record field, so you can use | ||||
| /// record update syntax to easily specify partially-implemented mock objects. | ||||
| type GenerateMockAttribute () = | ||||
|     inherit Attribute () | ||||
| type internal GenerateMockOutputSpec = | ||||
|     { | ||||
|         IsInternal : bool | ||||
|     } | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal InterfaceMockGenerator = | ||||
|     open Fantomas.FCS.Text.Range | ||||
|     open Myriad.Core.Ast | ||||
|  | ||||
|     let private getName (SynField (_, _, id, _, _, _, _, _, _)) = | ||||
|         match id with | ||||
|         | None -> failwith "Expected record field to have a name, but it was somehow anonymous" | ||||
|         | Some id -> id | ||||
|  | ||||
|     [<RequireQualifiedAccess>] | ||||
|     type private KnownInheritance = | IDisposable | ||||
|  | ||||
|     let createType | ||||
|         (spec : GenerateMockOutputSpec) | ||||
|         (name : string) | ||||
|         (interfaceType : InterfaceType) | ||||
|         (xmlDoc : PreXmlDoc) | ||||
|         (fields : SynField list) | ||||
|         : SynModuleDecl | ||||
|         = | ||||
|         let synValData = | ||||
|             { | ||||
|                 SynMemberFlags.IsInstance = false | ||||
|                 SynMemberFlags.IsDispatchSlot = false | ||||
|                 SynMemberFlags.IsOverrideOrExplicitImpl = false | ||||
|                 SynMemberFlags.IsFinal = false | ||||
|                 SynMemberFlags.GetterOrSetterIsCompilerGenerated = false | ||||
|                 SynMemberFlags.MemberKind = SynMemberKind.Member | ||||
|             } | ||||
|  | ||||
|         let failwithFun = | ||||
|             SynExpr.createLambda | ||||
|                 "x" | ||||
|                 (SynExpr.CreateApp ( | ||||
|                     SynExpr.CreateIdentString "raise", | ||||
|                     SynExpr.CreateParen ( | ||||
|                         SynExpr.CreateApp ( | ||||
|                             SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "NotImplementedException" ]), | ||||
|                             SynExpr.CreateConstString "Unimplemented mock function" | ||||
|                         ) | ||||
|                     ) | ||||
|                 )) | ||||
|  | ||||
|         let constructorIdent = | ||||
|             let generics = | ||||
|                 interfaceType.Generics | ||||
|                 |> Option.map (fun generics -> SynValTyparDecls (Some generics, false)) | ||||
|  | ||||
|             SynPat.LongIdent ( | ||||
|                 SynLongIdent.CreateString "Empty", | ||||
|                 None, | ||||
|                 None, // no generics on the "Empty", only on the return type | ||||
|                 SynArgPats.Pats ( | ||||
|                     if generics.IsNone then | ||||
|                         [] | ||||
|                     else | ||||
|                         [ SynPat.CreateParen (SynPat.CreateConst SynConst.Unit) ] | ||||
|                 ), | ||||
|                 None, | ||||
|                 range0 | ||||
|         let inherits = | ||||
|             interfaceType.Inherits | ||||
|             |> Seq.map (fun ty -> | ||||
|                 match ty with | ||||
|                 | SynType.LongIdent (SynLongIdent.SynLongIdent (name, _, _)) -> | ||||
|                     match name |> List.map _.idText with | ||||
|                     | [] -> failwith "Unexpected empty identifier in inheritance declaration" | ||||
|                     | [ "IDisposable" ] | ||||
|                     | [ "System" ; "IDisposable" ] -> KnownInheritance.IDisposable | ||||
|                     | _ -> failwithf "Unrecognised inheritance identifier: %+A" name | ||||
|                 | x -> failwithf "Unrecognised type in inheritance: %+A" x | ||||
|             ) | ||||
|             |> Set.ofSeq | ||||
|  | ||||
|         let failwithFun (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 = | ||||
|             match interfaceType.Generics with | ||||
|             | None -> SynType.CreateLongIdent name | ||||
|             | None -> SynType.createLongIdent' [ name ] | ||||
|             | Some generics -> | ||||
|                 let generics = | ||||
|                     generics.TyparDecls | ||||
|                     |> List.map (fun (SynTyparDecl (_, typar)) -> SynType.Var (typar, range0)) | ||||
|  | ||||
|                 SynType.App ( | ||||
|                     SynType.CreateLongIdent name, | ||||
|                     Some range0, | ||||
|                     generics, | ||||
|                     List.replicate (generics.Length - 1) range0, | ||||
|                     Some range0, | ||||
|                     false, | ||||
|                     range0 | ||||
|                 ) | ||||
|             |> SynBindingReturnInfo.Create | ||||
|             let generics = | ||||
|                 generics.TyparDecls | ||||
|                 |> List.map (fun (SynTyparDecl (_, typar)) -> SynType.var typar) | ||||
|  | ||||
|             SynType.app name generics | ||||
|  | ||||
|         let constructorFields = | ||||
|             let extras = | ||||
|                 if inherits.Contains KnownInheritance.IDisposable then | ||||
|                     let unitFun = SynExpr.createThunk (SynExpr.CreateConst ()) | ||||
|  | ||||
|                     [ SynLongIdent.createS "Dispose", unitFun ] | ||||
|                 else | ||||
|                     [] | ||||
|  | ||||
|             let nonExtras = | ||||
|                 fields | ||||
|                 |> List.map (fun field -> SynLongIdent.createI (getName field), failwithFun field) | ||||
|  | ||||
|             extras @ nonExtras | ||||
|  | ||||
|         let constructor = | ||||
|             SynMemberDefn.Member ( | ||||
|                 SynBinding.SynBinding ( | ||||
|                     None, | ||||
|                     SynBindingKind.Normal, | ||||
|                     false, | ||||
|                     false, | ||||
|                     [], | ||||
|                     PreXmlDoc.Empty, | ||||
|                     SynValData.SynValData (Some synValData, SynValInfo.Empty, None), | ||||
|                     constructorIdent, | ||||
|                     Some constructorReturnType, | ||||
|                     AstHelper.instantiateRecord ( | ||||
|                         fields | ||||
|                         |> List.map (fun field -> | ||||
|                             ((SynLongIdent.CreateFromLongIdent [ getName field ], true), Some failwithFun) | ||||
|                         ) | ||||
|                     ), | ||||
|                     range0, | ||||
|                     DebugPointAtBinding.Yes range0, | ||||
|                     { SynExpr.synBindingTriviaZero true with | ||||
|                         LeadingKeyword = SynLeadingKeyword.StaticMember (range0, range0) | ||||
|             SynBinding.basic | ||||
|                 [ Ident.create "Empty" ] | ||||
|                 (if interfaceType.Generics.IsNone then | ||||
|                      [] | ||||
|                  else | ||||
|                      [ SynPat.unit ]) | ||||
|                 (AstHelper.instantiateRecord constructorFields) | ||||
|             |> SynBinding.withXmlDoc (PreXmlDoc.create "An implementation where every method throws.") | ||||
|             |> SynBinding.withReturnAnnotation constructorReturnType | ||||
|             |> SynMemberDefn.staticMember | ||||
|  | ||||
|         let fields = | ||||
|             let extras = | ||||
|                 if inherits.Contains KnownInheritance.IDisposable then | ||||
|                     { | ||||
|                         Attrs = [] | ||||
|                         Ident = Some (Ident.create "Dispose") | ||||
|                         Type = SynType.funFromDomain SynType.unit SynType.unit | ||||
|                     } | ||||
|                 ), | ||||
|                 range0 | ||||
|             ) | ||||
|                     |> SynField.make | ||||
|                     |> SynField.withDocString (PreXmlDoc.create "Implementation of IDisposable.Dispose") | ||||
|                     |> List.singleton | ||||
|                 else | ||||
|                     [] | ||||
|  | ||||
|             extras @ fields | ||||
|  | ||||
|         let interfaceMembers = | ||||
|             let members = | ||||
|                 interfaceType.Members | ||||
|                 |> List.map (fun memberInfo -> | ||||
|  | ||||
|                     let synValData = | ||||
|                         SynValData.SynValData ( | ||||
|                             Some | ||||
|                                 { | ||||
|                                     IsInstance = true | ||||
|                                     IsDispatchSlot = false | ||||
|                                     IsOverrideOrExplicitImpl = true | ||||
|                                     IsFinal = false | ||||
|                                     GetterOrSetterIsCompilerGenerated = false | ||||
|                                     MemberKind = SynMemberKind.Member | ||||
|                                 }, | ||||
|                             valInfo = | ||||
|                                 SynValInfo.SynValInfo ( | ||||
|                                     curriedArgInfos = | ||||
|                                         [ | ||||
|                                             yield | ||||
|                                                 [ | ||||
|                                                     SynArgInfo.SynArgInfo ( | ||||
|                                                         attributes = [], | ||||
|                                                         optional = false, | ||||
|                                                         ident = None | ||||
|                                                     ) | ||||
|                                                 ] | ||||
|                                             yield! | ||||
|                                                 memberInfo.Args | ||||
|                                                 |> List.mapi (fun i arg -> | ||||
|                                                     arg.Args | ||||
|                                                     |> List.mapi (fun j arg -> | ||||
|                                                         SynArgInfo.CreateIdString $"arg_%i{i}_%i{j}" | ||||
|                                                     ) | ||||
|                                                 ) | ||||
|                                         ], | ||||
|                                     returnInfo = | ||||
|                                         SynArgInfo.SynArgInfo (attributes = [], optional = false, ident = None) | ||||
|                                 ), | ||||
|                             thisIdOpt = None | ||||
|                         ) | ||||
|  | ||||
|                     let headArgs = | ||||
|                         memberInfo.Args | ||||
|                         |> List.mapi (fun i tupledArgs -> | ||||
|                             let args = | ||||
|                                 tupledArgs.Args | ||||
|                                 |> List.mapi (fun j _ -> SynPat.CreateNamed (Ident.Create $"arg_%i{i}_%i{j}")) | ||||
|                                 |> List.mapi (fun j ty -> | ||||
|                                     match ty.Type with | ||||
|                                     | UnitType -> SynPat.unit | ||||
|                                     | _ -> SynPat.named $"arg_%i{i}_%i{j}" | ||||
|                                 ) | ||||
|  | ||||
|                             SynPat.Tuple (false, args, List.replicate (args.Length - 1) range0, range0) | ||||
|                             |> SynPat.CreateParen | ||||
|                             |> fun i -> if tupledArgs.HasParen then SynPat.Paren (i, range0) else i | ||||
|                         ) | ||||
|  | ||||
|                     let headPat = | ||||
|                         SynPat.LongIdent ( | ||||
|                             SynLongIdent.CreateFromLongIdent [ Ident.Create "this" ; memberInfo.Identifier ], | ||||
|                             None, | ||||
|                             None, | ||||
|                             SynArgPats.Pats headArgs, | ||||
|                             None, | ||||
|                             range0 | ||||
|                             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 = | ||||
| @@ -189,8 +136,12 @@ module internal InterfaceMockGenerator = | ||||
|                             memberInfo.Args | ||||
|                             |> List.mapi (fun i args -> | ||||
|                                 args.Args | ||||
|                                 |> List.mapi (fun j args -> SynExpr.CreateIdentString $"arg_%i{i}_%i{j}") | ||||
|                                 |> SynExpr.CreateParenedTuple | ||||
|                                 |> List.mapi (fun j arg -> | ||||
|                                     match arg.Type with | ||||
|                                     | UnitType -> SynExpr.CreateConst () | ||||
|                                     | _ -> SynExpr.createIdent $"arg_%i{i}_%i{j}" | ||||
|                                 ) | ||||
|                                 |> SynExpr.tuple | ||||
|                             ) | ||||
|  | ||||
|                         match tuples |> List.rev with | ||||
| @@ -198,42 +149,17 @@ module internal InterfaceMockGenerator = | ||||
|                         | last :: rest -> | ||||
|  | ||||
|                         (last, rest) | ||||
|                         ||> List.fold (fun trail next -> SynExpr.CreateApp (next, trail)) | ||||
|                         |> fun args -> | ||||
|                             SynExpr.CreateApp ( | ||||
|                                 SynExpr.CreateLongIdent ( | ||||
|                                     SynLongIdent.CreateFromLongIdent [ Ident.Create "this" ; memberInfo.Identifier ] | ||||
|                                 ), | ||||
|                                 args | ||||
|                             ) | ||||
|                         ||> List.fold SynExpr.applyTo | ||||
|                         |> SynExpr.applyFunction ( | ||||
|                             SynExpr.createLongIdent' [ Ident.create "this" ; memberInfo.Identifier ] | ||||
|                         ) | ||||
|  | ||||
|                     SynMemberDefn.Member ( | ||||
|                         SynBinding.SynBinding ( | ||||
|                             None, | ||||
|                             SynBindingKind.Normal, | ||||
|                             false, | ||||
|                             false, | ||||
|                             [], | ||||
|                             PreXmlDoc.Empty, | ||||
|                             synValData, | ||||
|                             headPat, | ||||
|                             None, | ||||
|                             body, | ||||
|                             range0, | ||||
|                             DebugPointAtBinding.Yes range0, | ||||
|                             { | ||||
|                                 LeadingKeyword = SynLeadingKeyword.Member range0 | ||||
|                                 InlineKeyword = None | ||||
|                                 EqualsRange = Some range0 | ||||
|                             } | ||||
|                         ), | ||||
|                         range0 | ||||
|                     ) | ||||
|                     SynBinding.basic [ Ident.create "this" ; memberInfo.Identifier ] headArgs body | ||||
|                     |> SynMemberDefn.memberImplementation | ||||
|                 ) | ||||
|  | ||||
|             let interfaceName = | ||||
|                 let baseName = | ||||
|                     SynType.CreateLongIdent (SynLongIdent.CreateFromLongIdent interfaceType.Name) | ||||
|                 let baseName = SynType.createLongIdent interfaceType.Name | ||||
|  | ||||
|                 match interfaceType.Generics with | ||||
|                 | None -> baseName | ||||
| @@ -243,36 +169,52 @@ module internal InterfaceMockGenerator = | ||||
|                         | SynTyparDecls.PostfixList (decls, _, _) -> decls | ||||
|                         | SynTyparDecls.PrefixList (decls, _) -> decls | ||||
|                         | SynTyparDecls.SinglePrefix (decl, _) -> [ decl ] | ||||
|                         |> List.map (fun (SynTyparDecl (_, typar)) -> SynType.Var (typar, range0)) | ||||
|                         |> List.map (fun (SynTyparDecl (_, typar)) -> SynType.var typar) | ||||
|  | ||||
|                     SynType.App ( | ||||
|                         baseName, | ||||
|                         Some range0, | ||||
|                         generics, | ||||
|                         List.replicate (generics.Length - 1) range0, | ||||
|                         Some range0, | ||||
|                         false, | ||||
|                         range0 | ||||
|                     ) | ||||
|                     SynType.app' baseName generics | ||||
|  | ||||
|             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 | ||||
|             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 [ mem ], | ||||
|                         range0 | ||||
|                     ) | ||||
|             ) | ||||
|             |> Seq.toList | ||||
|  | ||||
|         let record = | ||||
|             { | ||||
|                 Name = Ident.Create name | ||||
|                 Name = Ident.create name | ||||
|                 Fields = fields | ||||
|                 Members = Some [ constructor ; interfaceMembers ] | ||||
|                 Members = Some ([ constructor ; interfaceMembers ] @ extraInterfaces) | ||||
|                 XmlDoc = Some xmlDoc | ||||
|                 Generics = interfaceType.Generics | ||||
|                 Accessibility = Some access | ||||
|                 TypeAccessibility = Some access | ||||
|                 ImplAccessibility = None | ||||
|                 Attributes = [] | ||||
|             } | ||||
|  | ||||
|         let typeDecl = AstHelper.defineRecordType record | ||||
| @@ -281,55 +223,56 @@ module internal InterfaceMockGenerator = | ||||
|  | ||||
|     let private buildType (x : ParameterInfo) : SynType = | ||||
|         if x.IsOptional then | ||||
|             SynType.App (SynType.CreateLongIdent "option", Some range0, [ x.Type ], [], Some range0, false, range0) | ||||
|             SynType.app "option" [ x.Type ] | ||||
|         else | ||||
|             x.Type | ||||
|  | ||||
|     let private constructMemberSinglePlace (tuple : TupledArg) : SynType = | ||||
|         match tuple.Args |> List.rev |> List.map buildType with | ||||
|         | [] -> failwith "no-arg functions not supported yet" | ||||
|         | [ x ] -> x | ||||
|         | last :: rest -> | ||||
|             ([ SynTupleTypeSegment.Type last ], rest) | ||||
|             ||> List.fold (fun ty nextArg -> SynTupleTypeSegment.Type nextArg :: SynTupleTypeSegment.Star range0 :: ty) | ||||
|             |> fun segs -> SynType.Tuple (false, segs, range0) | ||||
|         |> fun ty -> if tuple.HasParen then SynType.Paren (ty, range0) else ty | ||||
|         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 constructMember (mem : MemberInfo) : SynField = | ||||
|         let inputType = mem.Args |> List.map constructMemberSinglePlace | ||||
|  | ||||
|         let funcType = AstHelper.toFun inputType mem.ReturnType | ||||
|         let funcType = SynType.toFun inputType mem.ReturnType | ||||
|  | ||||
|         SynField.SynField ( | ||||
|             [], | ||||
|             false, | ||||
|             Some mem.Identifier, | ||||
|             funcType, | ||||
|             false, | ||||
|             mem.XmlDoc |> Option.defaultValue PreXmlDoc.Empty, | ||||
|             None, | ||||
|             range0, | ||||
|             SynFieldTrivia.Zero | ||||
|         ) | ||||
|         { | ||||
|             Type = funcType | ||||
|             Attrs = [] | ||||
|             Ident = Some mem.Identifier | ||||
|         } | ||||
|         |> SynField.make | ||||
|         |> SynField.withDocString (mem.XmlDoc |> Option.defaultValue PreXmlDoc.Empty) | ||||
|  | ||||
|     let createRecord (namespaceId : LongIdent) (interfaceType : SynTypeDefn) : SynModuleOrNamespace = | ||||
|     let createRecord | ||||
|         (namespaceId : LongIdent) | ||||
|         (opens : SynOpenDeclTarget list) | ||||
|         (interfaceType : SynTypeDefn, spec : GenerateMockOutputSpec) | ||||
|         : SynModuleOrNamespace | ||||
|         = | ||||
|         let interfaceType = AstHelper.parseInterface interfaceType | ||||
|         let fields = interfaceType.Members |> List.map constructMember | ||||
|         let docString = PreXmlDoc.Create " Mock record type for an interface" | ||||
|         let docString = PreXmlDoc.create "Mock record type for an interface" | ||||
|  | ||||
|         let name = | ||||
|             List.last interfaceType.Name | ||||
|             |> fun s -> s.idText | ||||
|             |> _.idText | ||||
|             |> fun s -> | ||||
|                 if s.StartsWith 'I' && s.Length > 1 && Char.IsUpper s.[1] then | ||||
|                     s.[1..] | ||||
|                     s.Substring 1 | ||||
|                 else | ||||
|                     s | ||||
|             |> fun s -> s + "Mock" | ||||
|  | ||||
|         let typeDecl = createType name interfaceType docString fields | ||||
|         let typeDecl = createType spec name interfaceType docString fields | ||||
|  | ||||
|         SynModuleOrNamespace.CreateNamespace (namespaceId, decls = [ typeDecl ]) | ||||
|         [ yield! opens |> List.map SynModuleDecl.openAny ; 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. | ||||
| @@ -340,6 +283,10 @@ type InterfaceMockGenerator () = | ||||
|         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 | ||||
|  | ||||
| @@ -348,15 +295,57 @@ type InterfaceMockGenerator () = | ||||
|             let namespaceAndInterfaces = | ||||
|                 types | ||||
|                 |> List.choose (fun (ns, types) -> | ||||
|                     match types |> List.filter Ast.hasAttribute<GenerateMockAttribute> with | ||||
|                     | [] -> None | ||||
|                     | types -> Some (ns, types) | ||||
|                     types | ||||
|                     |> List.choose (fun typeDef -> | ||||
|                         match Ast.getAttribute<GenerateMockAttribute> 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.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 modules = | ||||
|                 namespaceAndInterfaces | ||||
|                 |> List.collect (fun (ns, records) -> records |> List.map (InterfaceMockGenerator.createRecord ns)) | ||||
|                 |> List.collect (fun (ns, records) -> | ||||
|                     records |> List.map (InterfaceMockGenerator.createRecord ns opens) | ||||
|                 ) | ||||
|  | ||||
|             Output.Ast modules | ||||
|   | ||||
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							| @@ -3,26 +3,6 @@ namespace WoofWare.Myriad.Plugins | ||||
| open System | ||||
| open System.Text | ||||
| open Fantomas.FCS.Syntax | ||||
| open Fantomas.FCS.SyntaxTrivia | ||||
| open Fantomas.FCS.Xml | ||||
| open Myriad.Core | ||||
|  | ||||
| /// 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 () | ||||
|  | ||||
|     /// If changing this, *adjust the documentation strings* | ||||
|     static member internal DefaultIsExtensionMethod = false | ||||
|  | ||||
|     /// Shorthand for the "isExtensionMethod = false" constructor; see documentation there for details. | ||||
|     new () = JsonSerializeAttribute JsonSerializeAttribute.DefaultIsExtensionMethod | ||||
|  | ||||
| type internal JsonSerializeOutputSpec = | ||||
|     { | ||||
| @@ -32,174 +12,147 @@ type internal JsonSerializeOutputSpec = | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal JsonSerializeGenerator = | ||||
|     open Fantomas.FCS.Text.Range | ||||
|     open Myriad.Core.Ast | ||||
|  | ||||
|  | ||||
|     // The absolutely galaxy-brained implementation of JsonValue has `JsonValue.Parse "null"` | ||||
|     // identically equal to null. We have to work around this later, but we might as well just | ||||
|     // be efficient here and whip up the null directly. | ||||
|     let private jsonNull () = | ||||
|         SynExpr.createNull () | ||||
|         |> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]) | ||||
|  | ||||
|     /// 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)`. | ||||
|     let rec serializeNode (fieldType : SynType) : SynExpr = | ||||
|     /// Returns also a bool which is true if the resulting SynExpr represents something of type JsonNode. | ||||
|     let rec serializeNode (fieldType : SynType) : SynExpr * bool = | ||||
|         // TODO: serialization format for DateTime etc | ||||
|         match fieldType with | ||||
|         | DateOnly | ||||
|         | DateTime | ||||
|         | NumberType _ | ||||
|         | Measure _ | ||||
|         | PrimitiveType _ | ||||
|         | Guid | ||||
|         | Uri -> | ||||
|             // JsonValue.Create<{type}> | ||||
|             SynExpr.TypeApp ( | ||||
|                 SynExpr.CreateLongIdent ( | ||||
|                     SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonValue" ; "Create" ] | ||||
|                 ), | ||||
|                 range0, | ||||
|                 [ fieldType ], | ||||
|                 [], | ||||
|                 Some range0, | ||||
|                 range0, | ||||
|                 range0 | ||||
|             ) | ||||
|             // JsonValue.Create<type> | ||||
|             SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonValue" ; "Create" ] | ||||
|             |> SynExpr.typeApp [ fieldType ] | ||||
|             |> 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 | ||||
|         | NullableType ty -> | ||||
|             // fun field -> if field.HasValue then {serializeNode ty} field.Value else JsonValue.Create null | ||||
|             let inner, innerIsJsonNode = serializeNode ty | ||||
|  | ||||
|             SynExpr.applyFunction inner (SynExpr.createLongIdent [ "field" ; "Value" ]) | ||||
|             |> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]) | ||||
|             |> SynExpr.ifThenElse (SynExpr.createLongIdent [ "field" ; "HasValue" ]) (jsonNull ()) | ||||
|             |> SynExpr.createLambda "field" | ||||
|             |> fun e -> e, innerIsJsonNode | ||||
|         | OptionType ty -> | ||||
|             // fun field -> match field with | None -> JsonValue.Create null | Some v -> {serializeNode ty} field | ||||
|             SynExpr.CreateMatch ( | ||||
|                 SynExpr.CreateIdentString "field", | ||||
|                 [ | ||||
|                     SynMatchClause.Create ( | ||||
|                         SynPat.CreateLongIdent (SynLongIdent.CreateString "None", []), | ||||
|                         None, | ||||
|                         SynExpr.CreateApp ( | ||||
|                             SynExpr.CreateLongIdent ( | ||||
|                                 SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonValue" ; "Create" ] | ||||
|                             ), | ||||
|                             SynExpr.CreateNull | ||||
|                         ) | ||||
|                     ) | ||||
|             let noneClause = jsonNull () |> SynMatchClause.create (SynPat.named "None") | ||||
|  | ||||
|                     SynMatchClause.Create ( | ||||
|                         SynPat.CreateLongIdent ( | ||||
|                             SynLongIdent.CreateString "Some", | ||||
|                             [ SynPat.CreateNamed (Ident.Create "field") ] | ||||
|                         ), | ||||
|                         None, | ||||
|                         SynExpr.CreateApp (serializeNode ty, SynExpr.CreateIdentString "field") | ||||
|                     ) | ||||
|                 ] | ||||
|             ) | ||||
|             let someClause = | ||||
|                 let inner, innerIsJsonNode = serializeNode ty | ||||
|                 let target = SynExpr.applyFunction inner (SynExpr.createIdent "field") | ||||
|  | ||||
|                 if innerIsJsonNode then | ||||
|                     target | ||||
|                 else | ||||
|                     target | ||||
|                     |> SynExpr.paren | ||||
|                     |> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]) | ||||
|                 |> SynMatchClause.create (SynPat.nameWithArgs "Some" [ SynPat.named "field" ]) | ||||
|  | ||||
|             [ noneClause ; someClause ] | ||||
|             |> SynExpr.createMatch (SynExpr.createIdent "field") | ||||
|             |> SynExpr.createLambda "field" | ||||
|             |> fun e -> e, true | ||||
|         | ArrayType ty | ||||
|         | ListType ty -> | ||||
|             // fun field -> | ||||
|             //     let arr = JsonArray () | ||||
|             //     for mem in field do arr.Add ({serializeNode} mem) | ||||
|             //     arr | ||||
|             SynExpr.LetOrUse ( | ||||
|                 false, | ||||
|                 false, | ||||
|             [ | ||||
|                 SynExpr.ForEach ( | ||||
|                     DebugPointAtFor.Yes range0, | ||||
|                     DebugPointAtInOrTo.Yes range0, | ||||
|                     SeqExprOnly.SeqExprOnly false, | ||||
|                     true, | ||||
|                     SynPat.named "mem", | ||||
|                     SynExpr.createIdent "field", | ||||
|                     SynExpr.applyFunction | ||||
|                         (SynExpr.createLongIdent [ "arr" ; "Add" ]) | ||||
|                         (SynExpr.paren (SynExpr.applyFunction (fst (serializeNode ty)) (SynExpr.createIdent "mem"))), | ||||
|                     range0 | ||||
|                 ) | ||||
|                 SynExpr.createIdent "arr" | ||||
|             ] | ||||
|             |> SynExpr.sequential | ||||
|             |> SynExpr.createLet | ||||
|                 [ | ||||
|                     SynBinding.Let ( | ||||
|                         pattern = SynPat.CreateNamed (Ident.Create "arr"), | ||||
|                         expr = | ||||
|                             SynExpr.CreateApp ( | ||||
|                                 SynExpr.CreateLongIdent ( | ||||
|                                     SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonArray" ] | ||||
|                                 ), | ||||
|                                 SynExpr.CreateConst SynConst.Unit | ||||
|                             ) | ||||
|                     ) | ||||
|                 ], | ||||
|                 SynExpr.CreateSequential | ||||
|                     [ | ||||
|                         SynExpr.ForEach ( | ||||
|                             DebugPointAtFor.Yes range0, | ||||
|                             DebugPointAtInOrTo.Yes range0, | ||||
|                             SeqExprOnly.SeqExprOnly false, | ||||
|                             true, | ||||
|                             SynPat.CreateNamed (Ident.Create "mem"), | ||||
|                             SynExpr.CreateIdent (Ident.Create "field"), | ||||
|                             SynExpr.CreateApp ( | ||||
|                                 SynExpr.CreateLongIdent (SynLongIdent.Create [ "arr" ; "Add" ]), | ||||
|                                 SynExpr.CreateParen ( | ||||
|                                     SynExpr.CreateApp (serializeNode ty, SynExpr.CreateIdentString "mem") | ||||
|                                 ) | ||||
|                             ), | ||||
|                             range0 | ||||
|                         ) | ||||
|                         SynExpr.CreateIdentString "arr" | ||||
|                     ], | ||||
|                 range0, | ||||
|                 { | ||||
|                     InKeyword = None | ||||
|                 } | ||||
|             ) | ||||
|                     SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonArray" ] | ||||
|                     |> SynExpr.applyTo (SynExpr.CreateConst ()) | ||||
|                     |> SynBinding.basic [ Ident.create "arr" ] [] | ||||
|                 ] | ||||
|             |> SynExpr.createLambda "field" | ||||
|         | IDictionaryType (keyType, valueType) | ||||
|         | DictionaryType (keyType, valueType) | ||||
|         | IReadOnlyDictionaryType (keyType, valueType) | ||||
|         | MapType (keyType, valueType) -> | ||||
|             |> 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 | ||||
|             SynExpr.LetOrUse ( | ||||
|                 false, | ||||
|                 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.createLongIdent [ "key" ; "ToString" ] | ||||
|                                 |> SynExpr.applyTo (SynExpr.CreateConst ()) | ||||
|                                 SynExpr.applyFunction (fst (serializeNode valueType)) (SynExpr.createIdent "value") | ||||
|                             ]), | ||||
|                     range0 | ||||
|                 ) | ||||
|                 SynExpr.createIdent "ret" | ||||
|             ] | ||||
|             |> SynExpr.sequential | ||||
|             |> SynExpr.createLet | ||||
|                 [ | ||||
|                     SynBinding.Let ( | ||||
|                         pattern = SynPat.CreateNamed (Ident.Create "ret"), | ||||
|                         expr = | ||||
|                             SynExpr.CreateApp ( | ||||
|                                 SynExpr.CreateLongIdent ( | ||||
|                                     SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ] | ||||
|                                 ), | ||||
|                                 SynExpr.CreateConst SynConst.Unit | ||||
|                             ) | ||||
|                     ) | ||||
|                 ], | ||||
|                 SynExpr.CreateSequential | ||||
|                     [ | ||||
|                         SynExpr.ForEach ( | ||||
|                             DebugPointAtFor.Yes range0, | ||||
|                             DebugPointAtInOrTo.Yes range0, | ||||
|                             SeqExprOnly.SeqExprOnly false, | ||||
|                             true, | ||||
|                             SynPat.CreateParen ( | ||||
|                                 SynPat.CreateLongIdent ( | ||||
|                                     SynLongIdent.CreateString "KeyValue", | ||||
|                                     [ | ||||
|                                         SynPat.CreateParen ( | ||||
|                                             SynPat.Tuple ( | ||||
|                                                 false, | ||||
|                                                 [ | ||||
|                                                     SynPat.CreateNamed (Ident.Create "key") | ||||
|                                                     SynPat.CreateNamed (Ident.Create "value") | ||||
|                                                 ], | ||||
|                                                 [ range0 ], | ||||
|                                                 range0 | ||||
|                                             ) | ||||
|                                         ) | ||||
|                                     ] | ||||
|                                 ) | ||||
|                             ), | ||||
|                             SynExpr.CreateIdent (Ident.Create "field"), | ||||
|                             SynExpr.CreateApp ( | ||||
|                                 SynExpr.CreateLongIdent (SynLongIdent.Create [ "ret" ; "Add" ]), | ||||
|                                 SynExpr.CreateParenedTuple | ||||
|                                     [ | ||||
|                                         SynExpr.CreateApp ( | ||||
|                                             SynExpr.CreateLongIdent (SynLongIdent.Create [ "key" ; "ToString" ]), | ||||
|                                             SynExpr.CreateConst SynConst.Unit | ||||
|                                         ) | ||||
|                                         SynExpr.CreateApp (serializeNode valueType, SynExpr.CreateIdentString "value") | ||||
|                                     ] | ||||
|                             ), | ||||
|                             range0 | ||||
|                         ) | ||||
|                         SynExpr.CreateIdentString "ret" | ||||
|                     ], | ||||
|                 range0, | ||||
|                 { | ||||
|                     InKeyword = None | ||||
|                 } | ||||
|             ) | ||||
|                     SynExpr.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 | ||||
|         | Unit -> | ||||
|             SynExpr.createLambda | ||||
|                 "value" | ||||
|                 (SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ] | ||||
|                  |> SynExpr.applyTo (SynExpr.CreateConst ())), | ||||
|             false | ||||
|         | _ -> | ||||
|             // {type}.toJsonNode | ||||
|             let typeName = | ||||
| @@ -207,213 +160,281 @@ module internal JsonSerializeGenerator = | ||||
|                 | SynType.LongIdent ident -> ident.LongIdent | ||||
|                 | _ -> failwith $"Unrecognised type: %+A{fieldType}" | ||||
|  | ||||
|             SynExpr.CreateLongIdent (SynLongIdent.CreateFromLongIdent (typeName @ [ Ident.Create "toJsonNode" ])) | ||||
|             SynExpr.createLongIdent' (typeName @ [ Ident.create "toJsonNode" ]), true | ||||
|  | ||||
|     /// propertyName is probably a string literal, but it could be a [<Literal>] variable | ||||
|     /// `node.Add ({propertyName}, {toJsonNode})` | ||||
|     let createSerializeRhs (propertyName : SynExpr) (fieldId : Ident) (fieldType : SynType) : SynExpr = | ||||
|         let func = SynExpr.CreateLongIdent (SynLongIdent.Create [ "node" ; "Add" ]) | ||||
|     let createSerializeRhsRecord (propertyName : SynExpr) (fieldId : Ident) (fieldType : SynType) : SynExpr = | ||||
|         [ | ||||
|             propertyName | ||||
|             SynExpr.pipeThroughFunction | ||||
|                 (fst (serializeNode fieldType)) | ||||
|                 (SynExpr.createLongIdent' [ Ident.create "input" ; fieldId ]) | ||||
|             |> SynExpr.paren | ||||
|         ] | ||||
|         |> SynExpr.tuple | ||||
|         |> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ]) | ||||
|  | ||||
|         let args = | ||||
|             SynExpr.CreateParenedTuple | ||||
|                 [ | ||||
|                     propertyName | ||||
|                     SynExpr.CreateApp ( | ||||
|                         serializeNode fieldType, | ||||
|                         SynExpr.CreateLongIdent (SynLongIdent.CreateFromLongIdent [ Ident.Create "input" ; fieldId ]) | ||||
|                     ) | ||||
|                 ] | ||||
|     let getPropertyName (fieldId : Ident) (attrs : SynAttribute list) : SynExpr = | ||||
|         let propertyNameAttr = | ||||
|             attrs | ||||
|             |> List.tryFind (fun attr -> | ||||
|                 (SynLongIdent.toString attr.TypeName) | ||||
|                     .EndsWith ("JsonPropertyName", StringComparison.Ordinal) | ||||
|             ) | ||||
|  | ||||
|         SynExpr.CreateApp (func, args) | ||||
|         match propertyNameAttr with | ||||
|         | None -> | ||||
|             let sb = StringBuilder fieldId.idText.Length | ||||
|             sb.Append (Char.ToLowerInvariant fieldId.idText.[0]) |> ignore | ||||
|  | ||||
|     let createMaker (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (fields : SynField list) = | ||||
|         let xmlDoc = PreXmlDoc.Create " Serialize to a JSON node" | ||||
|             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 = | ||||
|             SynBindingReturnInfo.Create ( | ||||
|                 SynType.LongIdent (SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]) | ||||
|             ) | ||||
|             SynLongIdent.createS' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ] | ||||
|             |> SynType.LongIdent | ||||
|  | ||||
|         let inputArg = Ident.Create "input" | ||||
|         let functionName = Ident.Create "toJsonNode" | ||||
|  | ||||
|         let inputVal = | ||||
|             let memberFlags = | ||||
|                 if spec.ExtensionMethods then | ||||
|                     { | ||||
|                         SynMemberFlags.IsInstance = false | ||||
|                         SynMemberFlags.IsDispatchSlot = false | ||||
|                         SynMemberFlags.IsOverrideOrExplicitImpl = false | ||||
|                         SynMemberFlags.IsFinal = false | ||||
|                         SynMemberFlags.GetterOrSetterIsCompilerGenerated = false | ||||
|                         SynMemberFlags.MemberKind = SynMemberKind.Member | ||||
|                     } | ||||
|                     |> Some | ||||
|                 else | ||||
|                     None | ||||
|  | ||||
|             let thisIdOpt = if spec.ExtensionMethods then None else Some inputArg | ||||
|  | ||||
|             SynValData.SynValData ( | ||||
|                 memberFlags, | ||||
|                 SynValInfo.SynValInfo ([ [ SynArgInfo.CreateId functionName ] ], SynArgInfo.Empty), | ||||
|                 thisIdOpt | ||||
|             ) | ||||
|         let functionName = Ident.create "toJsonNode" | ||||
|  | ||||
|         let assignments = | ||||
|             fields | ||||
|             |> List.map (fun (SynField (attrs, _, id, fieldType, _, _, _, _, _)) -> | ||||
|                 let id = | ||||
|                     match id with | ||||
|                     | None -> failwith "didn't get an ID on field" | ||||
|                     | Some id -> id | ||||
|  | ||||
|                 let attrs = attrs |> List.collect (fun l -> l.Attributes) | ||||
|  | ||||
|                 let propertyNameAttr = | ||||
|                     attrs | ||||
|                     |> List.tryFind (fun attr -> | ||||
|                         attr.TypeName.AsString.EndsWith ("JsonPropertyName", StringComparison.Ordinal) | ||||
|                     ) | ||||
|  | ||||
|                 let propertyName = | ||||
|                     match propertyNameAttr with | ||||
|                     | None -> | ||||
|                         let sb = StringBuilder id.idText.Length | ||||
|                         sb.Append (Char.ToLowerInvariant id.idText.[0]) |> ignore | ||||
|  | ||||
|                         if id.idText.Length > 1 then | ||||
|                             sb.Append id.idText.[1..] |> ignore | ||||
|  | ||||
|                         sb.ToString () |> SynConst.CreateString |> SynExpr.CreateConst | ||||
|                     | Some name -> name.ArgExpr | ||||
|  | ||||
|                 let pattern = | ||||
|                     SynPat.LongIdent ( | ||||
|                         SynLongIdent.CreateFromLongIdent [ id ], | ||||
|                         None, | ||||
|                         None, | ||||
|                         SynArgPats.Empty, | ||||
|                         None, | ||||
|                         range0 | ||||
|                     ) | ||||
|  | ||||
|                 createSerializeRhs propertyName id fieldType | ||||
|             ) | ||||
|  | ||||
|         let finalConstruction = | ||||
|             fields | ||||
|             |> List.map (fun (SynField (_, _, id, _, _, _, _, _, _)) -> | ||||
|                 let id = | ||||
|                     match id with | ||||
|                     | None -> failwith "Expected record field to have an identifying name" | ||||
|                     | Some id -> id | ||||
|  | ||||
|                 (SynLongIdent.CreateFromLongIdent [ id ], true), | ||||
|                 Some (SynExpr.CreateLongIdent (SynLongIdent.CreateFromLongIdent [ id ])) | ||||
|             ) | ||||
|             |> AstHelper.instantiateRecord | ||||
|  | ||||
|         let assignments = assignments |> SynExpr.CreateSequential | ||||
|  | ||||
|         let assignments = | ||||
|             SynExpr.LetOrUse ( | ||||
|                 false, | ||||
|                 false, | ||||
|             [ | ||||
|                 populateNode | ||||
|                 SynExpr.Upcast (SynExpr.createIdent "node", SynType.Anon range0, range0) | ||||
|             ] | ||||
|             |> SynExpr.sequential | ||||
|             |> SynExpr.createLet | ||||
|                 [ | ||||
|                     SynBinding.Let ( | ||||
|                         pattern = SynPat.CreateNamed (Ident.Create "node"), | ||||
|                         expr = | ||||
|                             SynExpr.CreateApp ( | ||||
|                                 SynExpr.CreateLongIdent ( | ||||
|                                     SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ] | ||||
|                                 ), | ||||
|                                 SynExpr.CreateConst SynConst.Unit | ||||
|                             ) | ||||
|                     ) | ||||
|                 ], | ||||
|                 SynExpr.CreateSequential | ||||
|                     [ | ||||
|                         SynExpr.Do (assignments, range0) | ||||
|                         SynExpr.Upcast (SynExpr.CreateIdentString "node", SynType.Anon range0, range0) | ||||
|                     ], | ||||
|                 range0, | ||||
|                 { | ||||
|                     InKeyword = None | ||||
|                 } | ||||
|             ) | ||||
|                     SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ] | ||||
|                     |> SynExpr.applyTo (SynExpr.CreateConst ()) | ||||
|                     |> SynBinding.basic [ Ident.create "node" ] [] | ||||
|                 ] | ||||
|  | ||||
|         let pattern = | ||||
|             SynPat.LongIdent ( | ||||
|                 SynLongIdent.CreateFromLongIdent [ functionName ], | ||||
|                 None, | ||||
|                 None, | ||||
|                 SynArgPats.Pats | ||||
|                     [ | ||||
|                         SynPat.CreateTyped ( | ||||
|                             SynPat.CreateNamed inputArg, | ||||
|                             SynType.LongIdent (SynLongIdent.CreateFromLongIdent typeName) | ||||
|                         ) | ||||
|                         |> SynPat.CreateParen | ||||
|                     ], | ||||
|                 None, | ||||
|                 range0 | ||||
|             ) | ||||
|             SynPat.namedI inputArgName | ||||
|             |> SynPat.annotateType (SynType.LongIdent (SynLongIdent.create typeName)) | ||||
|  | ||||
|         if spec.ExtensionMethods then | ||||
|             let binding = | ||||
|                 SynBinding.SynBinding ( | ||||
|                     None, | ||||
|                     SynBindingKind.Normal, | ||||
|                     false, | ||||
|                     false, | ||||
|                     [], | ||||
|                     xmlDoc, | ||||
|                     inputVal, | ||||
|                     pattern, | ||||
|                     Some returnInfo, | ||||
|                     assignments, | ||||
|                     range0, | ||||
|                     DebugPointAtBinding.NoneAtInvisible, | ||||
|                     { | ||||
|                         LeadingKeyword = SynLeadingKeyword.StaticMember (range0, range0) | ||||
|                         InlineKeyword = None | ||||
|                         EqualsRange = Some range0 | ||||
|                     } | ||||
|                 ) | ||||
|             let componentInfo = | ||||
|                 SynComponentInfo.createLong typeName | ||||
|                 |> SynComponentInfo.withDocString (PreXmlDoc.create "Extension methods for JSON parsing") | ||||
|  | ||||
|             let mem = SynMemberDefn.Member (binding, range0) | ||||
|             let memberDef = | ||||
|                 assignments | ||||
|                 |> SynBinding.basic [ functionName ] [ pattern ] | ||||
|                 |> SynBinding.withXmlDoc xmlDoc | ||||
|                 |> SynBinding.withReturnAnnotation returnInfo | ||||
|                 |> SynMemberDefn.staticMember | ||||
|  | ||||
|             let containingType = | ||||
|                 SynTypeDefn.SynTypeDefn ( | ||||
|                     SynComponentInfo.Create (typeName, xmldoc = PreXmlDoc.Create " Extension methods for JSON parsing"), | ||||
|                     SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Augmentation range0, [], range0), | ||||
|                     [ mem ], | ||||
|                     None, | ||||
|                     range0, | ||||
|                     { | ||||
|                         LeadingKeyword = SynTypeDefnLeadingKeyword.Type range0 | ||||
|                         EqualsRange = None | ||||
|                         WithKeyword = None | ||||
|                     } | ||||
|                 ) | ||||
|                 SynTypeDefnRepr.augmentation () | ||||
|                 |> SynTypeDefn.create componentInfo | ||||
|                 |> SynTypeDefn.withMemberDefns [ memberDef ] | ||||
|  | ||||
|             SynModuleDecl.Types ([ containingType ], range0) | ||||
|         else | ||||
|             let binding = | ||||
|                 SynBinding.Let ( | ||||
|                     isInline = false, | ||||
|                     isMutable = false, | ||||
|                     xmldoc = xmlDoc, | ||||
|                     returnInfo = returnInfo, | ||||
|                     expr = assignments, | ||||
|                     valData = inputVal, | ||||
|                     pattern = pattern | ||||
|             assignments | ||||
|             |> SynBinding.basic [ 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 = fst (serializeNode 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 | ||||
|                 ) | ||||
|  | ||||
|             SynModuleDecl.CreateLet [ binding ] | ||||
|             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 createRecordModule | ||||
|             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 = | ||||
|                         SynExpr.applyFunction (fst (serializeNode 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) | ||||
| @@ -422,60 +443,72 @@ module internal JsonSerializeGenerator = | ||||
|         let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) = | ||||
|             typeDefn | ||||
|  | ||||
|         let (SynComponentInfo (_attributes, _typeParams, _constraints, recordId, _, _preferPostfix, _access, _)) = | ||||
|         let (SynComponentInfo (_attributes, _typeParams, _constraints, ident, _, _preferPostfix, access, _)) = | ||||
|             synComponentInfo | ||||
|  | ||||
|         match synTypeDefnRepr with | ||||
|         | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, recordFields, _recordRange), _) -> | ||||
|         let attributes = | ||||
|             if spec.ExtensionMethods then | ||||
|                 [ SynAttribute.autoOpen ] | ||||
|             else | ||||
|                 [ SynAttribute.requireQualifiedAccess ; SynAttribute.compilationRepresentation ] | ||||
|  | ||||
|             let decls = [ createMaker spec recordId recordFields ] | ||||
|         let xmlDoc = | ||||
|             let fullyQualified = ident |> Seq.map (fun i -> i.idText) |> String.concat "." | ||||
|  | ||||
|             let attributes = | ||||
|             let description = | ||||
|                 if spec.ExtensionMethods then | ||||
|                     [ SynAttributeList.Create SynAttribute.autoOpen ] | ||||
|                     "extension members" | ||||
|                 else | ||||
|                     [ | ||||
|                         SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ()) | ||||
|                         SynAttributeList.Create SynAttribute.compilationRepresentation | ||||
|                     ] | ||||
|                     "methods" | ||||
|  | ||||
|             let xmlDoc = | ||||
|                 let fullyQualified = recordId |> Seq.map (fun i -> i.idText) |> String.concat "." | ||||
|             $"Module containing JSON serializing %s{description} for the %s{fullyQualified} type" | ||||
|             |> PreXmlDoc.create | ||||
|  | ||||
|                 let description = | ||||
|                     if spec.ExtensionMethods then | ||||
|                         "extension members" | ||||
|                     else | ||||
|                         "methods" | ||||
|         let moduleName = | ||||
|             if spec.ExtensionMethods then | ||||
|                 match ident with | ||||
|                 | [] -> failwith "unexpectedly got an empty identifier for type name" | ||||
|                 | ident -> | ||||
|                     let expanded = | ||||
|                         List.last ident | ||||
|                         |> fun i -> i.idText | ||||
|                         |> fun s -> s + "JsonSerializeExtension" | ||||
|                         |> Ident.create | ||||
|  | ||||
|                 $" Module containing JSON serializing %s{description} for the %s{fullyQualified} type" | ||||
|                 |> PreXmlDoc.Create | ||||
|                     List.take (List.length ident - 1) ident @ [ expanded ] | ||||
|             else | ||||
|                 ident | ||||
|  | ||||
|             let moduleName = | ||||
|                 if spec.ExtensionMethods then | ||||
|                     match recordId with | ||||
|                     | [] -> failwith "unexpectedly got an empty identifier for record name" | ||||
|                     | recordId -> | ||||
|                         let expanded = | ||||
|                             List.last recordId | ||||
|                             |> fun i -> i.idText | ||||
|                             |> fun s -> s + "JsonSerializeExtension" | ||||
|                             |> Ident.Create | ||||
|         let info = | ||||
|             SynComponentInfo.createLong moduleName | ||||
|             |> SynComponentInfo.addAttributes attributes | ||||
|             |> SynComponentInfo.setAccessibility access | ||||
|             |> SynComponentInfo.withDocString xmlDoc | ||||
|  | ||||
|                         List.take (List.length recordId - 1) recordId @ [ expanded ] | ||||
|                 else | ||||
|                     recordId | ||||
|         let decls = | ||||
|             match synTypeDefnRepr with | ||||
|             | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, recordFields, _range), _) -> | ||||
|                 recordModule spec ident recordFields | ||||
|                 |> 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 | ||||
|  | ||||
|             let info = | ||||
|                 SynComponentInfo.Create (moduleName, attributes = attributes, xmldoc = xmlDoc) | ||||
|         [ | ||||
|             yield! opens |> List.map SynModuleDecl.openAny | ||||
|             yield decls |> List.singleton |> SynModuleDecl.nestedModule info | ||||
|         ] | ||||
|         |> SynModuleOrNamespace.createNamespace namespaceId | ||||
|  | ||||
|             let mdl = SynModuleDecl.CreateNestedModule (info, decls) | ||||
|  | ||||
|             SynModuleOrNamespace.CreateNamespace ( | ||||
|                 namespaceId, | ||||
|                 decls = (opens |> List.map SynModuleDecl.CreateOpen) @ [ mdl ] | ||||
|             ) | ||||
|         | _ -> failwithf "Not a record type" | ||||
| open Myriad.Core | ||||
|  | ||||
| /// Myriad generator that provides a method (possibly an extension method) for a record type, | ||||
| /// containing a JSON serialization function. | ||||
| @@ -486,18 +519,54 @@ type JsonSerializeGenerator () = | ||||
|         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 records = Ast.extractRecords ast | ||||
|             let relevantTypes = | ||||
|                 Ast.extractTypeDefn ast | ||||
|                 |> List.map (fun (name, defns) -> | ||||
|                     defns | ||||
|                     |> List.choose (fun defn -> | ||||
|                         if Ast.isRecord defn then Some defn | ||||
|                         elif Ast.isDu defn then Some defn | ||||
|                         elif AstHelper.isEnum defn then Some defn | ||||
|                         else None | ||||
|                     ) | ||||
|                     |> fun defns -> name, defns | ||||
|                 ) | ||||
|  | ||||
|             let namespaceAndRecords = | ||||
|                 records | ||||
|             let namespaceAndTypes = | ||||
|                 relevantTypes | ||||
|                 |> List.choose (fun (ns, types) -> | ||||
|                     types | ||||
|                     |> List.choose (fun typeDef -> | ||||
|                         match Ast.getAttribute<JsonSerializeAttribute> typeDef with | ||||
|                         | None -> None | ||||
|                         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 | ||||
| @@ -522,13 +591,10 @@ type JsonSerializeGenerator () = | ||||
|             let opens = AstHelper.extractOpens ast | ||||
|  | ||||
|             let modules = | ||||
|                 namespaceAndRecords | ||||
|                 |> List.collect (fun (ns, records) -> | ||||
|                     records | ||||
|                     |> List.map (fun (record, spec) -> | ||||
|                         let recordModule = JsonSerializeGenerator.createRecordModule ns opens spec record | ||||
|                         recordModule | ||||
|                     ) | ||||
|                 namespaceAndTypes | ||||
|                 |> List.collect (fun (ns, types) -> | ||||
|                     types | ||||
|                     |> List.map (fun (ty, spec) -> JsonSerializeGenerator.createModule ns opens spec ty) | ||||
|                 ) | ||||
|  | ||||
|             Output.Ast modules | ||||
|   | ||||
							
								
								
									
										23
									
								
								WoofWare.Myriad.Plugins/List.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										23
									
								
								WoofWare.Myriad.Plugins/List.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,23 @@ | ||||
| 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 | ||||
							
								
								
									
										24
									
								
								WoofWare.Myriad.Plugins/Measure.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										24
									
								
								WoofWare.Myriad.Plugins/Measure.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,24 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open Fantomas.FCS.Syntax | ||||
|  | ||||
| [<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 | ||||
							
								
								
									
										64
									
								
								WoofWare.Myriad.Plugins/MyriadParamParser.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										64
									
								
								WoofWare.Myriad.Plugins/MyriadParamParser.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,64 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open System.Collections.Generic | ||||
|  | ||||
| type internal DesiredGenerator = | ||||
|     | InterfaceMock of isInternal : bool option | ||||
|     | JsonParse of extensionMethod : bool option | ||||
|     | JsonSerialize of extensionMethod : bool option | ||||
|     | HttpClient of extensionMethod : bool option | ||||
|  | ||||
|     static member Parse (s : string) = | ||||
|         match s with | ||||
|         | "GenerateMock" -> DesiredGenerator.InterfaceMock None | ||||
|         | "GenerateMock(true)" -> DesiredGenerator.InterfaceMock (Some true) | ||||
|         | "GenerateMock(false)" -> DesiredGenerator.InterfaceMock (Some false) | ||||
|         | "JsonParse" -> DesiredGenerator.JsonParse None | ||||
|         | "JsonParse(true)" -> DesiredGenerator.JsonParse (Some true) | ||||
|         | "JsonParse(false)" -> DesiredGenerator.JsonParse (Some false) | ||||
|         | "JsonSerialize" -> DesiredGenerator.JsonSerialize None | ||||
|         | "JsonSerialize(true)" -> DesiredGenerator.JsonSerialize (Some true) | ||||
|         | "JsonSerialize(false)" -> DesiredGenerator.JsonSerialize (Some false) | ||||
|         | "HttpClient" -> DesiredGenerator.HttpClient None | ||||
|         | "HttpClient(true)" -> DesiredGenerator.HttpClient (Some true) | ||||
|         | "HttpClient(false)" -> DesiredGenerator.HttpClient (Some false) | ||||
|         | _ -> failwith $"Failed to parse as a generator specification: %s{s}" | ||||
|  | ||||
| [<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 | ||||
							
								
								
									
										32
									
								
								WoofWare.Myriad.Plugins/Primitives.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										32
									
								
								WoofWare.Myriad.Plugins/Primitives.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,32 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open Fantomas.FCS.Syntax | ||||
| open Fantomas.FCS.Text.Range | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal Primitives = | ||||
|     /// Given e.g. "byte", returns "System.Byte". | ||||
|     let qualifyType (typeName : string) : LongIdent option = | ||||
|         match typeName with | ||||
|         | "float32" | ||||
|         | "single" -> [ "System" ; "Single" ] |> Some | ||||
|         | "float" | ||||
|         | "double" -> [ "System" ; "Double" ] |> Some | ||||
|         | "byte" | ||||
|         | "uint8" -> [ "System" ; "Byte" ] |> Some | ||||
|         | "sbyte" | ||||
|         | "int8" -> [ "System" ; "SByte" ] |> Some | ||||
|         | "int16" -> [ "System" ; "Int16" ] |> Some | ||||
|         | "int" | ||||
|         | "int32" -> [ "System" ; "Int32" ] |> Some | ||||
|         | "int64" -> [ "System" ; "Int64" ] |> Some | ||||
|         | "uint16" -> [ "System" ; "UInt16" ] |> Some | ||||
|         | "uint" | ||||
|         | "uint32" -> [ "System" ; "UInt32" ] |> Some | ||||
|         | "uint64" -> [ "System" ; "UInt64" ] |> Some | ||||
|         | "char" -> [ "System" ; "Char" ] |> Some | ||||
|         | "decimal" -> [ "System" ; "Decimal" ] |> Some | ||||
|         | "string" -> [ "System" ; "String" ] |> Some | ||||
|         | "bool" -> [ "System" ; "Boolean" ] |> Some | ||||
|         | _ -> None | ||||
|         |> Option.map (List.map (fun i -> (Ident (i, range0)))) | ||||
| @@ -1,21 +1,11 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open System | ||||
| open Fantomas.FCS.Syntax | ||||
| open Fantomas.FCS.SyntaxTrivia | ||||
| open Fantomas.FCS.Xml | ||||
| open Myriad.Core | ||||
|  | ||||
| /// Attribute indicating a record type to which the "Remove Options" Myriad | ||||
| /// generator should apply during build. | ||||
| /// The purpose of this generator is to strip the `option` modifier from types. | ||||
| type RemoveOptionsAttribute () = | ||||
|     inherit Attribute () | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal RemoveOptionsGenerator = | ||||
|     open Fantomas.FCS.Text.Range | ||||
|     open Myriad.Core.Ast | ||||
|  | ||||
|     let private removeOption (s : SynField) : SynField = | ||||
|         let (SynField.SynField (synAttributeLists, | ||||
| @@ -46,15 +36,15 @@ module internal RemoveOptionsGenerator = | ||||
|             trivia | ||||
|         ) | ||||
|  | ||||
|     // TODO: this option seems a bit odd | ||||
|     let createType | ||||
|         (xmlDoc : PreXmlDoc option) | ||||
|         (accessibility : SynAccess option) | ||||
|         (generics : SynTyparDecls option) | ||||
|         (fields : SynField list) | ||||
|         : SynModuleDecl | ||||
|         = | ||||
|         let fields : SynField list = fields |> List.map removeOption | ||||
|         let name = Ident.Create "Short" | ||||
|         let name = Ident.create "Short" | ||||
|  | ||||
|         let record = | ||||
|             { | ||||
| @@ -63,138 +53,85 @@ module internal RemoveOptionsGenerator = | ||||
|                 Members = None | ||||
|                 XmlDoc = xmlDoc | ||||
|                 Generics = generics | ||||
|                 Accessibility = accessibility | ||||
|                 TypeAccessibility = accessibility | ||||
|                 ImplAccessibility = None | ||||
|                 Attributes = [] | ||||
|             } | ||||
|  | ||||
|         let typeDecl = AstHelper.defineRecordType record | ||||
|  | ||||
|         SynModuleDecl.Types ([ typeDecl ], range0) | ||||
|  | ||||
|     let createMaker (withOptionsType : LongIdent) (withoutOptionsType : LongIdent) (fields : SynField list) = | ||||
|         let xmlDoc = PreXmlDoc.Create " Remove the optional members of the input." | ||||
|     let createMaker (withOptionsType : LongIdent) (withoutOptionsType : Ident) (fields : SynFieldData<Ident> list) = | ||||
|         let xmlDoc = PreXmlDoc.create "Remove the optional members of the input." | ||||
|  | ||||
|         let returnInfo = | ||||
|             SynBindingReturnInfo.Create (SynType.LongIdent (SynLongIdent.CreateFromLongIdent withOptionsType)) | ||||
|  | ||||
|         let inputArg = Ident.Create "input" | ||||
|         let functionName = Ident.Create "shorten" | ||||
|  | ||||
|         let inputVal = | ||||
|             SynValData.SynValData ( | ||||
|                 None, | ||||
|                 SynValInfo.SynValInfo ([ [ SynArgInfo.CreateId functionName ] ], SynArgInfo.Empty), | ||||
|                 Some inputArg | ||||
|             ) | ||||
|         let inputArg = Ident.create "input" | ||||
|         let functionName = Ident.create "shorten" | ||||
|  | ||||
|         let body = | ||||
|             fields | ||||
|             |> List.map (fun (SynField (_, _, id, fieldType, _, _, _, _, _)) -> | ||||
|                 let id = | ||||
|                     match id with | ||||
|                     | None -> failwith "Expected record field to have an identifying name" | ||||
|                     | Some id -> id | ||||
|  | ||||
|             |> List.map (fun fieldData -> | ||||
|                 let accessor = | ||||
|                     SynExpr.LongIdent (false, SynLongIdent ([ inputArg ; id ], [ range0 ], []), None, range0) | ||||
|                     SynExpr.LongIdent ( | ||||
|                         false, | ||||
|                         SynLongIdent ([ inputArg ; fieldData.Ident ], [ range0 ], []), | ||||
|                         None, | ||||
|                         range0 | ||||
|                     ) | ||||
|  | ||||
|                 let body = | ||||
|                     match fieldType with | ||||
|                     match fieldData.Type with | ||||
|                     | OptionType _ -> | ||||
|                         SynExpr.CreateApp ( | ||||
|                             SynExpr.CreateAppInfix ( | ||||
|                                 SynExpr.LongIdent ( | ||||
|                                     false, | ||||
|                                     SynLongIdent.SynLongIdent ( | ||||
|                                         [ Ident.Create "op_PipeRight" ], | ||||
|                                         [], | ||||
|                                         [ Some (IdentTrivia.OriginalNotation "|>") ] | ||||
|                                     ), | ||||
|                                     None, | ||||
|                                     range0 | ||||
|                                 ), | ||||
|                                 accessor | ||||
|                             ), | ||||
|                             SynExpr.CreateApp ( | ||||
|                                 SynExpr.CreateLongIdent (SynLongIdent.CreateString "Option.defaultWith"), | ||||
|                                 SynExpr.CreateLongIdent ( | ||||
|                                     SynLongIdent.CreateFromLongIdent ( | ||||
|                                         withoutOptionsType @ [ Ident.Create (sprintf "Default%s" id.idText) ] | ||||
|                                     ) | ||||
|                                 ) | ||||
|                             ) | ||||
|                         accessor | ||||
|                         |> SynExpr.pipeThroughFunction ( | ||||
|                             SynExpr.applyFunction | ||||
|                                 (SynExpr.createLongIdent [ "Option" ; "defaultWith" ]) | ||||
|                                 (SynExpr.createLongIdent' ( | ||||
|                                     [ withoutOptionsType ] | ||||
|                                     @ [ Ident.create (sprintf "Default%s" fieldData.Ident.idText) ] | ||||
|                                 )) | ||||
|                         ) | ||||
|                     | _ -> accessor | ||||
|  | ||||
|                 (SynLongIdent.CreateFromLongIdent [ id ], true), Some body | ||||
|                 SynLongIdent.createI fieldData.Ident, body | ||||
|             ) | ||||
|             |> AstHelper.instantiateRecord | ||||
|  | ||||
|         let pattern = | ||||
|             SynPat.LongIdent ( | ||||
|                 SynLongIdent.CreateFromLongIdent [ functionName ], | ||||
|                 None, | ||||
|                 None, | ||||
|                 SynArgPats.Pats | ||||
|                     [ | ||||
|                         SynPat.CreateTyped ( | ||||
|                             SynPat.CreateNamed inputArg, | ||||
|                             SynType.LongIdent (SynLongIdent.CreateFromLongIdent withoutOptionsType) | ||||
|                         ) | ||||
|                         |> SynPat.CreateParen | ||||
|                     ], | ||||
|                 None, | ||||
|                 range0 | ||||
|             ) | ||||
|         SynBinding.basic | ||||
|             [ functionName ] | ||||
|             [ | ||||
|                 SynPat.named inputArg.idText | ||||
|                 |> SynPat.annotateType (SynType.LongIdent (SynLongIdent.createI withoutOptionsType)) | ||||
|             ] | ||||
|             body | ||||
|         |> SynBinding.withXmlDoc xmlDoc | ||||
|         |> SynBinding.withReturnAnnotation (SynType.LongIdent (SynLongIdent.create withOptionsType)) | ||||
|         |> SynModuleDecl.createLet | ||||
|  | ||||
|         let binding = | ||||
|             SynBinding.Let ( | ||||
|                 isInline = false, | ||||
|                 isMutable = false, | ||||
|                 xmldoc = xmlDoc, | ||||
|                 returnInfo = returnInfo, | ||||
|                 expr = body, | ||||
|                 valData = inputVal, | ||||
|                 pattern = pattern | ||||
|             ) | ||||
|     let createRecordModule (namespaceId : LongIdent) (typeDefn : RecordType) = | ||||
|         let fieldData = typeDefn.Fields |> List.map SynField.extractWithIdent | ||||
|  | ||||
|         SynModuleDecl.CreateLet [ binding ] | ||||
|         let decls = | ||||
|             [ | ||||
|                 createType typeDefn.XmlDoc typeDefn.TypeAccessibility typeDefn.Generics typeDefn.Fields | ||||
|                 createMaker [ Ident.create "Short" ] typeDefn.Name fieldData | ||||
|             ] | ||||
|  | ||||
|     let createRecordModule (namespaceId : LongIdent) (typeDefn : SynTypeDefn) = | ||||
|         let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) = | ||||
|             typeDefn | ||||
|         let xmlDoc = | ||||
|             sprintf "Module containing an option-truncated version of the %s type" typeDefn.Name.idText | ||||
|             |> PreXmlDoc.create | ||||
|  | ||||
|         let (SynComponentInfo (_attributes, typeParams, _constraints, recordId, doc, _preferPostfix, _access, _)) = | ||||
|             synComponentInfo | ||||
|         let info = | ||||
|             SynComponentInfo.create typeDefn.Name | ||||
|             |> SynComponentInfo.withDocString xmlDoc | ||||
|             |> SynComponentInfo.addAttributes [ SynAttribute.compilationRepresentation ] | ||||
|             |> SynComponentInfo.addAttributes [ SynAttribute.requireQualifiedAccess ] | ||||
|  | ||||
|         match synTypeDefnRepr with | ||||
|         | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (accessibility, recordFields, _recordRange), _) -> | ||||
|         SynModuleDecl.nestedModule info decls | ||||
|         |> List.singleton | ||||
|         |> SynModuleOrNamespace.createNamespace namespaceId | ||||
|  | ||||
|             let decls = | ||||
|                 [ | ||||
|                     createType (Some doc) accessibility typeParams recordFields | ||||
|                     createMaker [ Ident.Create "Short" ] recordId recordFields | ||||
|                 ] | ||||
|  | ||||
|             let attributes = | ||||
|                 [ | ||||
|                     SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ()) | ||||
|                     SynAttributeList.Create SynAttribute.compilationRepresentation | ||||
|                 ] | ||||
|  | ||||
|             let xmlDoc = | ||||
|                 recordId | ||||
|                 |> Seq.map (fun i -> i.idText) | ||||
|                 |> String.concat "." | ||||
|                 |> sprintf " Module containing an option-truncated version of the %s type" | ||||
|                 |> PreXmlDoc.Create | ||||
|  | ||||
|             let info = | ||||
|                 SynComponentInfo.Create (recordId, attributes = attributes, xmldoc = xmlDoc) | ||||
|  | ||||
|             let mdl = SynModuleDecl.CreateNestedModule (info, decls) | ||||
|  | ||||
|             SynModuleOrNamespace.CreateNamespace (namespaceId, decls = [ mdl ]) | ||||
|         | _ -> failwithf "Not a record type" | ||||
| open Myriad.Core | ||||
|  | ||||
| /// Myriad generator that stamps out a record with option types stripped | ||||
| /// from the fields at the top level. | ||||
| @@ -213,9 +150,29 @@ type RemoveOptionsGenerator () = | ||||
|             let namespaceAndRecords = | ||||
|                 records | ||||
|                 |> List.choose (fun (ns, types) -> | ||||
|                     match types |> List.filter Ast.hasAttribute<RemoveOptionsAttribute> with | ||||
|                     match | ||||
|                         types | ||||
|                         |> List.filter (SynTypeDefn.hasAttribute typeof<RemoveOptionsAttribute>.Name) | ||||
|                     with | ||||
|                     | [] -> None | ||||
|                     | types -> Some (ns, types) | ||||
|                     | types -> | ||||
|                         let types = | ||||
|                             types | ||||
|                             |> List.map (fun ty -> | ||||
|                                 match ty with | ||||
|                                 | SynTypeDefn.SynTypeDefn (sci, | ||||
|                                                            SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (access, | ||||
|                                                                                                                  fields, | ||||
|                                                                                                                  _), | ||||
|                                                                                    _), | ||||
|                                                            smd, | ||||
|                                                            smdo, | ||||
|                                                            _, | ||||
|                                                            _) -> RecordType.OfRecord sci smd access fields | ||||
|                                 | _ -> failwith "unexpectedly not a record" | ||||
|                             ) | ||||
|  | ||||
|                         Some (ns, types) | ||||
|                 ) | ||||
|  | ||||
|             let modules = | ||||
|   | ||||
| @@ -1,22 +1,318 @@ | ||||
| WoofWare.Myriad.Plugins.GenerateMockAttribute inherit System.Attribute | ||||
| WoofWare.Myriad.Plugins.GenerateMockAttribute..ctor [constructor]: unit | ||||
| WoofWare.Myriad.Plugins.HttpClientAttribute inherit System.Attribute | ||||
| WoofWare.Myriad.Plugins.HttpClientAttribute..ctor [constructor]: unit | ||||
| WoofWare.Myriad.Plugins.AdditionalProperties inherit obj, implements WoofWare.Myriad.Plugins.AdditionalProperties System.IEquatable, System.Collections.IStructuralEquatable - union type with 2 cases | ||||
| WoofWare.Myriad.Plugins.AdditionalProperties+Constrained inherit WoofWare.Myriad.Plugins.AdditionalProperties | ||||
| WoofWare.Myriad.Plugins.AdditionalProperties+Constrained.get_Item [method]: unit -> WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.AdditionalProperties+Constrained.Item [property]: [read-only] WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.AdditionalProperties+Tags inherit obj | ||||
| WoofWare.Myriad.Plugins.AdditionalProperties+Tags.Constrained [static field]: int = 1 | ||||
| WoofWare.Myriad.Plugins.AdditionalProperties+Tags.Never [static field]: int = 0 | ||||
| WoofWare.Myriad.Plugins.AdditionalProperties.Equals [method]: (WoofWare.Myriad.Plugins.AdditionalProperties, System.Collections.IEqualityComparer) -> bool | ||||
| WoofWare.Myriad.Plugins.AdditionalProperties.get_IsConstrained [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.AdditionalProperties.get_IsNever [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.AdditionalProperties.get_Never [static method]: unit -> WoofWare.Myriad.Plugins.AdditionalProperties | ||||
| WoofWare.Myriad.Plugins.AdditionalProperties.get_Tag [method]: unit -> int | ||||
| WoofWare.Myriad.Plugins.AdditionalProperties.IsConstrained [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.AdditionalProperties.IsNever [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.AdditionalProperties.Never [static property]: [read-only] WoofWare.Myriad.Plugins.AdditionalProperties | ||||
| WoofWare.Myriad.Plugins.AdditionalProperties.NewConstrained [static method]: WoofWare.Myriad.Plugins.Definition -> WoofWare.Myriad.Plugins.AdditionalProperties | ||||
| WoofWare.Myriad.Plugins.AdditionalProperties.Tag [property]: [read-only] int | ||||
| WoofWare.Myriad.Plugins.ArgParserGenerator inherit obj, implements Myriad.Core.IMyriadGenerator | ||||
| WoofWare.Myriad.Plugins.ArgParserGenerator..ctor [constructor]: unit | ||||
| WoofWare.Myriad.Plugins.ArrayTypeDefinition inherit obj, implements WoofWare.Myriad.Plugins.ArrayTypeDefinition System.IEquatable, System.Collections.IStructuralEquatable | ||||
| WoofWare.Myriad.Plugins.ArrayTypeDefinition..ctor [constructor]: WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.ArrayTypeDefinition.Equals [method]: (WoofWare.Myriad.Plugins.ArrayTypeDefinition, System.Collections.IEqualityComparer) -> bool | ||||
| WoofWare.Myriad.Plugins.ArrayTypeDefinition.get_Items [method]: unit -> WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.ArrayTypeDefinition.Items [property]: [read-only] WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.ArrayTypeDefinition.Parse [static method]: System.Text.Json.Nodes.JsonNode -> WoofWare.Myriad.Plugins.ArrayTypeDefinition | ||||
| WoofWare.Myriad.Plugins.CreateCatamorphismGenerator inherit obj, implements Myriad.Core.IMyriadGenerator | ||||
| WoofWare.Myriad.Plugins.CreateCatamorphismGenerator..ctor [constructor]: unit | ||||
| WoofWare.Myriad.Plugins.Definition inherit obj, implements WoofWare.Myriad.Plugins.Definition System.IEquatable, System.Collections.IStructuralEquatable - union type with 8 cases | ||||
| WoofWare.Myriad.Plugins.Definition+Array inherit WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.Definition+Array.get_Item [method]: unit -> WoofWare.Myriad.Plugins.ArrayTypeDefinition | ||||
| WoofWare.Myriad.Plugins.Definition+Array.Item [property]: [read-only] WoofWare.Myriad.Plugins.ArrayTypeDefinition | ||||
| WoofWare.Myriad.Plugins.Definition+Handle inherit WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.Definition+Handle.get_Item [method]: unit -> string | ||||
| WoofWare.Myriad.Plugins.Definition+Handle.Item [property]: [read-only] string | ||||
| WoofWare.Myriad.Plugins.Definition+Integer inherit WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.Definition+Integer.format [property]: [read-only] string option | ||||
| WoofWare.Myriad.Plugins.Definition+Integer.get_format [method]: unit -> string option | ||||
| WoofWare.Myriad.Plugins.Definition+Object inherit WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.Definition+Object.get_Item [method]: unit -> WoofWare.Myriad.Plugins.ObjectTypeDefinition | ||||
| WoofWare.Myriad.Plugins.Definition+Object.Item [property]: [read-only] WoofWare.Myriad.Plugins.ObjectTypeDefinition | ||||
| WoofWare.Myriad.Plugins.Definition+Tags inherit obj | ||||
| WoofWare.Myriad.Plugins.Definition+Tags.Array [static field]: int = 2 | ||||
| WoofWare.Myriad.Plugins.Definition+Tags.Boolean [static field]: int = 4 | ||||
| WoofWare.Myriad.Plugins.Definition+Tags.File [static field]: int = 7 | ||||
| WoofWare.Myriad.Plugins.Definition+Tags.Handle [static field]: int = 0 | ||||
| WoofWare.Myriad.Plugins.Definition+Tags.Integer [static field]: int = 6 | ||||
| WoofWare.Myriad.Plugins.Definition+Tags.Object [static field]: int = 1 | ||||
| WoofWare.Myriad.Plugins.Definition+Tags.String [static field]: int = 3 | ||||
| WoofWare.Myriad.Plugins.Definition+Tags.Unspecified [static field]: int = 5 | ||||
| WoofWare.Myriad.Plugins.Definition.Boolean [static property]: [read-only] WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.Definition.Equals [method]: (WoofWare.Myriad.Plugins.Definition, System.Collections.IEqualityComparer) -> bool | ||||
| WoofWare.Myriad.Plugins.Definition.File [static property]: [read-only] WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.Definition.get_Boolean [static method]: unit -> WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.Definition.get_File [static method]: unit -> WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.Definition.get_IsArray [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.Definition.get_IsBoolean [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.Definition.get_IsFile [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.Definition.get_IsHandle [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.Definition.get_IsInteger [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.Definition.get_IsObject [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.Definition.get_IsString [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.Definition.get_IsUnspecified [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.Definition.get_String [static method]: unit -> WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.Definition.get_Tag [method]: unit -> int | ||||
| WoofWare.Myriad.Plugins.Definition.get_Unspecified [static method]: unit -> WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.Definition.IsArray [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.Definition.IsBoolean [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.Definition.IsFile [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.Definition.IsHandle [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.Definition.IsInteger [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.Definition.IsObject [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.Definition.IsString [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.Definition.IsUnspecified [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.Definition.NewArray [static method]: WoofWare.Myriad.Plugins.ArrayTypeDefinition -> WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.Definition.NewHandle [static method]: string -> WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.Definition.NewInteger [static method]: string option -> WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.Definition.NewObject [static method]: WoofWare.Myriad.Plugins.ObjectTypeDefinition -> WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.Definition.Parse [static method]: System.Text.Json.Nodes.JsonObject -> WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.Definition.String [static property]: [read-only] WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.Definition.Tag [property]: [read-only] int | ||||
| WoofWare.Myriad.Plugins.Definition.Unspecified [static property]: [read-only] WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.HttpClientGenerator inherit obj, implements Myriad.Core.IMyriadGenerator | ||||
| WoofWare.Myriad.Plugins.HttpClientGenerator..ctor [constructor]: unit | ||||
| WoofWare.Myriad.Plugins.HttpMethod inherit obj, implements WoofWare.Myriad.Plugins.HttpMethod System.IEquatable, System.Collections.IStructuralEquatable, WoofWare.Myriad.Plugins.HttpMethod System.IComparable, System.IComparable, System.Collections.IStructuralComparable - union type with 8 cases | ||||
| WoofWare.Myriad.Plugins.HttpMethod+Tags inherit obj | ||||
| WoofWare.Myriad.Plugins.HttpMethod+Tags.Delete [static field]: int = 2 | ||||
| WoofWare.Myriad.Plugins.HttpMethod+Tags.Get [static field]: int = 0 | ||||
| WoofWare.Myriad.Plugins.HttpMethod+Tags.Head [static field]: int = 5 | ||||
| WoofWare.Myriad.Plugins.HttpMethod+Tags.Options [static field]: int = 4 | ||||
| WoofWare.Myriad.Plugins.HttpMethod+Tags.Patch [static field]: int = 3 | ||||
| WoofWare.Myriad.Plugins.HttpMethod+Tags.Post [static field]: int = 1 | ||||
| WoofWare.Myriad.Plugins.HttpMethod+Tags.Put [static field]: int = 6 | ||||
| WoofWare.Myriad.Plugins.HttpMethod+Tags.Trace [static field]: int = 7 | ||||
| WoofWare.Myriad.Plugins.HttpMethod.Delete [static property]: [read-only] WoofWare.Myriad.Plugins.HttpMethod | ||||
| WoofWare.Myriad.Plugins.HttpMethod.Equals [method]: (WoofWare.Myriad.Plugins.HttpMethod, System.Collections.IEqualityComparer) -> bool | ||||
| WoofWare.Myriad.Plugins.HttpMethod.Get [static property]: [read-only] WoofWare.Myriad.Plugins.HttpMethod | ||||
| WoofWare.Myriad.Plugins.HttpMethod.get_Delete [static method]: unit -> WoofWare.Myriad.Plugins.HttpMethod | ||||
| WoofWare.Myriad.Plugins.HttpMethod.get_Get [static method]: unit -> WoofWare.Myriad.Plugins.HttpMethod | ||||
| WoofWare.Myriad.Plugins.HttpMethod.get_Head [static method]: unit -> WoofWare.Myriad.Plugins.HttpMethod | ||||
| WoofWare.Myriad.Plugins.HttpMethod.get_IsDelete [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.HttpMethod.get_IsGet [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.HttpMethod.get_IsHead [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.HttpMethod.get_IsOptions [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.HttpMethod.get_IsPatch [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.HttpMethod.get_IsPost [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.HttpMethod.get_IsPut [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.HttpMethod.get_IsTrace [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.HttpMethod.get_Options [static method]: unit -> WoofWare.Myriad.Plugins.HttpMethod | ||||
| WoofWare.Myriad.Plugins.HttpMethod.get_Patch [static method]: unit -> WoofWare.Myriad.Plugins.HttpMethod | ||||
| WoofWare.Myriad.Plugins.HttpMethod.get_Post [static method]: unit -> WoofWare.Myriad.Plugins.HttpMethod | ||||
| WoofWare.Myriad.Plugins.HttpMethod.get_Put [static method]: unit -> WoofWare.Myriad.Plugins.HttpMethod | ||||
| WoofWare.Myriad.Plugins.HttpMethod.get_Tag [method]: unit -> int | ||||
| WoofWare.Myriad.Plugins.HttpMethod.get_Trace [static method]: unit -> WoofWare.Myriad.Plugins.HttpMethod | ||||
| WoofWare.Myriad.Plugins.HttpMethod.Head [static property]: [read-only] WoofWare.Myriad.Plugins.HttpMethod | ||||
| WoofWare.Myriad.Plugins.HttpMethod.IsDelete [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.HttpMethod.IsGet [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.HttpMethod.IsHead [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.HttpMethod.IsOptions [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.HttpMethod.IsPatch [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.HttpMethod.IsPost [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.HttpMethod.IsPut [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.HttpMethod.IsTrace [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.HttpMethod.Options [static property]: [read-only] WoofWare.Myriad.Plugins.HttpMethod | ||||
| WoofWare.Myriad.Plugins.HttpMethod.Parse [static method]: string -> WoofWare.Myriad.Plugins.HttpMethod | ||||
| WoofWare.Myriad.Plugins.HttpMethod.Patch [static property]: [read-only] WoofWare.Myriad.Plugins.HttpMethod | ||||
| WoofWare.Myriad.Plugins.HttpMethod.Post [static property]: [read-only] WoofWare.Myriad.Plugins.HttpMethod | ||||
| WoofWare.Myriad.Plugins.HttpMethod.Put [static property]: [read-only] WoofWare.Myriad.Plugins.HttpMethod | ||||
| WoofWare.Myriad.Plugins.HttpMethod.Tag [property]: [read-only] int | ||||
| WoofWare.Myriad.Plugins.HttpMethod.ToDotNet [method]: unit -> System.Net.Http.HttpMethod | ||||
| WoofWare.Myriad.Plugins.HttpMethod.Trace [static property]: [read-only] WoofWare.Myriad.Plugins.HttpMethod | ||||
| WoofWare.Myriad.Plugins.InterfaceMockGenerator inherit obj, implements Myriad.Core.IMyriadGenerator | ||||
| WoofWare.Myriad.Plugins.InterfaceMockGenerator..ctor [constructor]: unit | ||||
| WoofWare.Myriad.Plugins.JsonParseAttribute inherit System.Attribute | ||||
| WoofWare.Myriad.Plugins.JsonParseAttribute..ctor [constructor]: bool | ||||
| WoofWare.Myriad.Plugins.JsonParseAttribute..ctor [constructor]: unit | ||||
| WoofWare.Myriad.Plugins.JsonParseGenerator inherit obj, implements Myriad.Core.IMyriadGenerator | ||||
| WoofWare.Myriad.Plugins.JsonParseGenerator..ctor [constructor]: unit | ||||
| WoofWare.Myriad.Plugins.JsonSerializeAttribute inherit System.Attribute | ||||
| WoofWare.Myriad.Plugins.JsonSerializeAttribute..ctor [constructor]: bool | ||||
| WoofWare.Myriad.Plugins.JsonSerializeAttribute..ctor [constructor]: unit | ||||
| WoofWare.Myriad.Plugins.JsonSerializeGenerator inherit obj, implements Myriad.Core.IMyriadGenerator | ||||
| WoofWare.Myriad.Plugins.JsonSerializeGenerator..ctor [constructor]: unit | ||||
| WoofWare.Myriad.Plugins.RemoveOptionsAttribute inherit System.Attribute | ||||
| WoofWare.Myriad.Plugins.RemoveOptionsAttribute..ctor [constructor]: unit | ||||
| WoofWare.Myriad.Plugins.MimeType inherit obj, implements WoofWare.Myriad.Plugins.MimeType System.IEquatable, System.Collections.IStructuralEquatable, WoofWare.Myriad.Plugins.MimeType System.IComparable, System.IComparable, System.Collections.IStructuralComparable - union type with 1 cases | ||||
| WoofWare.Myriad.Plugins.MimeType.Equals [method]: (WoofWare.Myriad.Plugins.MimeType, System.Collections.IEqualityComparer) -> bool | ||||
| WoofWare.Myriad.Plugins.MimeType.get_Item [method]: unit -> string | ||||
| WoofWare.Myriad.Plugins.MimeType.get_Tag [method]: unit -> int | ||||
| WoofWare.Myriad.Plugins.MimeType.Item [property]: [read-only] string | ||||
| WoofWare.Myriad.Plugins.MimeType.NewMimeType [static method]: string -> WoofWare.Myriad.Plugins.MimeType | ||||
| WoofWare.Myriad.Plugins.MimeType.Tag [property]: [read-only] int | ||||
| WoofWare.Myriad.Plugins.ObjectTypeDefinition inherit obj, implements WoofWare.Myriad.Plugins.ObjectTypeDefinition System.IEquatable, System.Collections.IStructuralEquatable | ||||
| WoofWare.Myriad.Plugins.ObjectTypeDefinition..ctor [constructor]: (string option, Map<string, WoofWare.Myriad.Plugins.Definition> option, Map<string, System.Text.Json.Nodes.JsonNode>, string list option, WoofWare.Myriad.Plugins.AdditionalProperties option, System.Text.Json.Nodes.JsonObject option) | ||||
| WoofWare.Myriad.Plugins.ObjectTypeDefinition.AdditionalProperties [property]: [read-only] WoofWare.Myriad.Plugins.AdditionalProperties option | ||||
| WoofWare.Myriad.Plugins.ObjectTypeDefinition.Description [property]: [read-only] string option | ||||
| WoofWare.Myriad.Plugins.ObjectTypeDefinition.Equals [method]: (WoofWare.Myriad.Plugins.ObjectTypeDefinition, System.Collections.IEqualityComparer) -> bool | ||||
| WoofWare.Myriad.Plugins.ObjectTypeDefinition.Example [property]: [read-only] System.Text.Json.Nodes.JsonObject option | ||||
| WoofWare.Myriad.Plugins.ObjectTypeDefinition.Extras [property]: [read-only] Map<string, System.Text.Json.Nodes.JsonNode> | ||||
| WoofWare.Myriad.Plugins.ObjectTypeDefinition.get_AdditionalProperties [method]: unit -> WoofWare.Myriad.Plugins.AdditionalProperties option | ||||
| WoofWare.Myriad.Plugins.ObjectTypeDefinition.get_Description [method]: unit -> string option | ||||
| WoofWare.Myriad.Plugins.ObjectTypeDefinition.get_Example [method]: unit -> System.Text.Json.Nodes.JsonObject option | ||||
| WoofWare.Myriad.Plugins.ObjectTypeDefinition.get_Extras [method]: unit -> Map<string, System.Text.Json.Nodes.JsonNode> | ||||
| WoofWare.Myriad.Plugins.ObjectTypeDefinition.get_Properties [method]: unit -> Map<string, WoofWare.Myriad.Plugins.Definition> option | ||||
| WoofWare.Myriad.Plugins.ObjectTypeDefinition.get_Required [method]: unit -> string list option | ||||
| WoofWare.Myriad.Plugins.ObjectTypeDefinition.Parse [static method]: System.Text.Json.Nodes.JsonObject -> WoofWare.Myriad.Plugins.ObjectTypeDefinition | ||||
| WoofWare.Myriad.Plugins.ObjectTypeDefinition.Properties [property]: [read-only] Map<string, WoofWare.Myriad.Plugins.Definition> option | ||||
| WoofWare.Myriad.Plugins.ObjectTypeDefinition.Required [property]: [read-only] string list option | ||||
| WoofWare.Myriad.Plugins.OperationId inherit obj, implements WoofWare.Myriad.Plugins.OperationId System.IEquatable, System.Collections.IStructuralEquatable, WoofWare.Myriad.Plugins.OperationId System.IComparable, System.IComparable, System.Collections.IStructuralComparable - union type with 1 cases | ||||
| WoofWare.Myriad.Plugins.OperationId.Equals [method]: (WoofWare.Myriad.Plugins.OperationId, System.Collections.IEqualityComparer) -> bool | ||||
| WoofWare.Myriad.Plugins.OperationId.get_Item [method]: unit -> string | ||||
| WoofWare.Myriad.Plugins.OperationId.get_Tag [method]: unit -> int | ||||
| WoofWare.Myriad.Plugins.OperationId.Item [property]: [read-only] string | ||||
| WoofWare.Myriad.Plugins.OperationId.NewOperationId [static method]: string -> WoofWare.Myriad.Plugins.OperationId | ||||
| WoofWare.Myriad.Plugins.OperationId.Tag [property]: [read-only] int | ||||
| WoofWare.Myriad.Plugins.ParameterIn inherit obj, implements WoofWare.Myriad.Plugins.ParameterIn System.IEquatable, System.Collections.IStructuralEquatable, WoofWare.Myriad.Plugins.ParameterIn System.IComparable, System.IComparable, System.Collections.IStructuralComparable - union type with 4 cases | ||||
| WoofWare.Myriad.Plugins.ParameterIn+Path inherit WoofWare.Myriad.Plugins.ParameterIn | ||||
| WoofWare.Myriad.Plugins.ParameterIn+Path.get_name [method]: unit -> string | ||||
| WoofWare.Myriad.Plugins.ParameterIn+Path.name [property]: [read-only] string | ||||
| WoofWare.Myriad.Plugins.ParameterIn+Query inherit WoofWare.Myriad.Plugins.ParameterIn | ||||
| WoofWare.Myriad.Plugins.ParameterIn+Query.get_name [method]: unit -> string | ||||
| WoofWare.Myriad.Plugins.ParameterIn+Query.name [property]: [read-only] string | ||||
| WoofWare.Myriad.Plugins.ParameterIn+Tags inherit obj | ||||
| WoofWare.Myriad.Plugins.ParameterIn+Tags.Body [static field]: int = 2 | ||||
| WoofWare.Myriad.Plugins.ParameterIn+Tags.Path [static field]: int = 0 | ||||
| WoofWare.Myriad.Plugins.ParameterIn+Tags.Query [static field]: int = 1 | ||||
| WoofWare.Myriad.Plugins.ParameterIn+Tags.Unrecognised [static field]: int = 3 | ||||
| WoofWare.Myriad.Plugins.ParameterIn+Unrecognised inherit WoofWare.Myriad.Plugins.ParameterIn | ||||
| WoofWare.Myriad.Plugins.ParameterIn+Unrecognised.get_name [method]: unit -> string | ||||
| WoofWare.Myriad.Plugins.ParameterIn+Unrecognised.get_op [method]: unit -> string | ||||
| WoofWare.Myriad.Plugins.ParameterIn+Unrecognised.name [property]: [read-only] string | ||||
| WoofWare.Myriad.Plugins.ParameterIn+Unrecognised.op [property]: [read-only] string | ||||
| WoofWare.Myriad.Plugins.ParameterIn.Body [static property]: [read-only] WoofWare.Myriad.Plugins.ParameterIn | ||||
| WoofWare.Myriad.Plugins.ParameterIn.Equals [method]: (WoofWare.Myriad.Plugins.ParameterIn, System.Collections.IEqualityComparer) -> bool | ||||
| WoofWare.Myriad.Plugins.ParameterIn.get_Body [static method]: unit -> WoofWare.Myriad.Plugins.ParameterIn | ||||
| WoofWare.Myriad.Plugins.ParameterIn.get_IsBody [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.ParameterIn.get_IsPath [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.ParameterIn.get_IsQuery [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.ParameterIn.get_IsUnrecognised [method]: unit -> bool | ||||
| WoofWare.Myriad.Plugins.ParameterIn.get_Tag [method]: unit -> int | ||||
| WoofWare.Myriad.Plugins.ParameterIn.IsBody [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.ParameterIn.IsPath [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.ParameterIn.IsQuery [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.ParameterIn.IsUnrecognised [property]: [read-only] bool | ||||
| WoofWare.Myriad.Plugins.ParameterIn.NewPath [static method]: string -> WoofWare.Myriad.Plugins.ParameterIn | ||||
| WoofWare.Myriad.Plugins.ParameterIn.NewQuery [static method]: string -> WoofWare.Myriad.Plugins.ParameterIn | ||||
| WoofWare.Myriad.Plugins.ParameterIn.NewUnrecognised [static method]: (string, string) -> WoofWare.Myriad.Plugins.ParameterIn | ||||
| WoofWare.Myriad.Plugins.ParameterIn.Tag [property]: [read-only] int | ||||
| WoofWare.Myriad.Plugins.RemoveOptionsGenerator inherit obj, implements Myriad.Core.IMyriadGenerator | ||||
| WoofWare.Myriad.Plugins.RemoveOptionsGenerator..ctor [constructor]: unit | ||||
| WoofWare.Myriad.Plugins.RemoveOptionsGenerator..ctor [constructor]: unit | ||||
| WoofWare.Myriad.Plugins.Response inherit obj, implements WoofWare.Myriad.Plugins.Response System.IEquatable, System.Collections.IStructuralEquatable | ||||
| WoofWare.Myriad.Plugins.Response..ctor [constructor]: (string, WoofWare.Myriad.Plugins.Definition) | ||||
| WoofWare.Myriad.Plugins.Response.Description [property]: [read-only] string | ||||
| WoofWare.Myriad.Plugins.Response.Equals [method]: (WoofWare.Myriad.Plugins.Response, System.Collections.IEqualityComparer) -> bool | ||||
| WoofWare.Myriad.Plugins.Response.get_Description [method]: unit -> string | ||||
| WoofWare.Myriad.Plugins.Response.get_Schema [method]: unit -> WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.Response.Parse [static method]: System.Text.Json.Nodes.JsonObject -> WoofWare.Myriad.Plugins.Response | ||||
| WoofWare.Myriad.Plugins.Response.Schema [property]: [read-only] WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.Scheme inherit obj, implements WoofWare.Myriad.Plugins.Scheme System.IEquatable, System.Collections.IStructuralEquatable, WoofWare.Myriad.Plugins.Scheme System.IComparable, System.IComparable, System.Collections.IStructuralComparable - union type with 1 cases | ||||
| WoofWare.Myriad.Plugins.Scheme.Equals [method]: (WoofWare.Myriad.Plugins.Scheme, System.Collections.IEqualityComparer) -> bool | ||||
| WoofWare.Myriad.Plugins.Scheme.get_Item [method]: unit -> string | ||||
| WoofWare.Myriad.Plugins.Scheme.get_Tag [method]: unit -> int | ||||
| WoofWare.Myriad.Plugins.Scheme.Item [property]: [read-only] string | ||||
| WoofWare.Myriad.Plugins.Scheme.NewScheme [static method]: string -> WoofWare.Myriad.Plugins.Scheme | ||||
| WoofWare.Myriad.Plugins.Scheme.Tag [property]: [read-only] int | ||||
| WoofWare.Myriad.Plugins.Swagger inherit obj, implements WoofWare.Myriad.Plugins.Swagger System.IEquatable, System.Collections.IStructuralEquatable | ||||
| WoofWare.Myriad.Plugins.Swagger..ctor [constructor]: (WoofWare.Myriad.Plugins.MimeType list, WoofWare.Myriad.Plugins.MimeType list, WoofWare.Myriad.Plugins.Scheme list, System.Version, WoofWare.Myriad.Plugins.SwaggerInfo, string, Map<string, Map<WoofWare.Myriad.Plugins.HttpMethod, WoofWare.Myriad.Plugins.SwaggerEndpoint>>, Map<string, WoofWare.Myriad.Plugins.Definition>, Map<string, WoofWare.Myriad.Plugins.Response>) | ||||
| WoofWare.Myriad.Plugins.Swagger.BasePath [property]: [read-only] string | ||||
| WoofWare.Myriad.Plugins.Swagger.Consumes [property]: [read-only] WoofWare.Myriad.Plugins.MimeType list | ||||
| WoofWare.Myriad.Plugins.Swagger.Definitions [property]: [read-only] Map<string, WoofWare.Myriad.Plugins.Definition> | ||||
| WoofWare.Myriad.Plugins.Swagger.Equals [method]: (WoofWare.Myriad.Plugins.Swagger, System.Collections.IEqualityComparer) -> bool | ||||
| WoofWare.Myriad.Plugins.Swagger.get_BasePath [method]: unit -> string | ||||
| WoofWare.Myriad.Plugins.Swagger.get_Consumes [method]: unit -> WoofWare.Myriad.Plugins.MimeType list | ||||
| WoofWare.Myriad.Plugins.Swagger.get_Definitions [method]: unit -> Map<string, WoofWare.Myriad.Plugins.Definition> | ||||
| WoofWare.Myriad.Plugins.Swagger.get_Info [method]: unit -> WoofWare.Myriad.Plugins.SwaggerInfo | ||||
| WoofWare.Myriad.Plugins.Swagger.get_Paths [method]: unit -> Map<string, Map<WoofWare.Myriad.Plugins.HttpMethod, WoofWare.Myriad.Plugins.SwaggerEndpoint>> | ||||
| WoofWare.Myriad.Plugins.Swagger.get_Produces [method]: unit -> WoofWare.Myriad.Plugins.MimeType list | ||||
| WoofWare.Myriad.Plugins.Swagger.get_Responses [method]: unit -> Map<string, WoofWare.Myriad.Plugins.Response> | ||||
| WoofWare.Myriad.Plugins.Swagger.get_Schemes [method]: unit -> WoofWare.Myriad.Plugins.Scheme list | ||||
| WoofWare.Myriad.Plugins.Swagger.get_Swagger [method]: unit -> System.Version | ||||
| WoofWare.Myriad.Plugins.Swagger.Info [property]: [read-only] WoofWare.Myriad.Plugins.SwaggerInfo | ||||
| WoofWare.Myriad.Plugins.Swagger.Paths [property]: [read-only] Map<string, Map<WoofWare.Myriad.Plugins.HttpMethod, WoofWare.Myriad.Plugins.SwaggerEndpoint>> | ||||
| WoofWare.Myriad.Plugins.Swagger.Produces [property]: [read-only] WoofWare.Myriad.Plugins.MimeType list | ||||
| WoofWare.Myriad.Plugins.Swagger.Responses [property]: [read-only] Map<string, WoofWare.Myriad.Plugins.Response> | ||||
| WoofWare.Myriad.Plugins.Swagger.Schemes [property]: [read-only] WoofWare.Myriad.Plugins.Scheme list | ||||
| WoofWare.Myriad.Plugins.Swagger.Swagger [property]: [read-only] System.Version | ||||
| WoofWare.Myriad.Plugins.SwaggerClientGenerator inherit obj, implements Myriad.Core.IMyriadGenerator | ||||
| WoofWare.Myriad.Plugins.SwaggerClientGenerator..ctor [constructor]: unit | ||||
| WoofWare.Myriad.Plugins.SwaggerEndpoint inherit obj, implements WoofWare.Myriad.Plugins.SwaggerEndpoint System.IEquatable, System.Collections.IStructuralEquatable | ||||
| WoofWare.Myriad.Plugins.SwaggerEndpoint..ctor [constructor]: (WoofWare.Myriad.Plugins.MimeType list option, WoofWare.Myriad.Plugins.MimeType list option, string list, string, WoofWare.Myriad.Plugins.OperationId, WoofWare.Myriad.Plugins.SwaggerParameter list option, Map<int, WoofWare.Myriad.Plugins.Definition>) | ||||
| WoofWare.Myriad.Plugins.SwaggerEndpoint.Consumes [property]: [read-only] WoofWare.Myriad.Plugins.MimeType list option | ||||
| WoofWare.Myriad.Plugins.SwaggerEndpoint.Equals [method]: (WoofWare.Myriad.Plugins.SwaggerEndpoint, System.Collections.IEqualityComparer) -> bool | ||||
| WoofWare.Myriad.Plugins.SwaggerEndpoint.get_Consumes [method]: unit -> WoofWare.Myriad.Plugins.MimeType list option | ||||
| WoofWare.Myriad.Plugins.SwaggerEndpoint.get_OperationId [method]: unit -> WoofWare.Myriad.Plugins.OperationId | ||||
| WoofWare.Myriad.Plugins.SwaggerEndpoint.get_Parameters [method]: unit -> WoofWare.Myriad.Plugins.SwaggerParameter list option | ||||
| WoofWare.Myriad.Plugins.SwaggerEndpoint.get_Produces [method]: unit -> WoofWare.Myriad.Plugins.MimeType list option | ||||
| WoofWare.Myriad.Plugins.SwaggerEndpoint.get_Responses [method]: unit -> Map<int, WoofWare.Myriad.Plugins.Definition> | ||||
| WoofWare.Myriad.Plugins.SwaggerEndpoint.get_Summary [method]: unit -> string | ||||
| WoofWare.Myriad.Plugins.SwaggerEndpoint.get_Tags [method]: unit -> string list | ||||
| WoofWare.Myriad.Plugins.SwaggerEndpoint.OperationId [property]: [read-only] WoofWare.Myriad.Plugins.OperationId | ||||
| WoofWare.Myriad.Plugins.SwaggerEndpoint.Parameters [property]: [read-only] WoofWare.Myriad.Plugins.SwaggerParameter list option | ||||
| WoofWare.Myriad.Plugins.SwaggerEndpoint.Parse [static method]: System.Text.Json.Nodes.JsonObject -> WoofWare.Myriad.Plugins.SwaggerEndpoint | ||||
| WoofWare.Myriad.Plugins.SwaggerEndpoint.Produces [property]: [read-only] WoofWare.Myriad.Plugins.MimeType list option | ||||
| WoofWare.Myriad.Plugins.SwaggerEndpoint.Responses [property]: [read-only] Map<int, WoofWare.Myriad.Plugins.Definition> | ||||
| WoofWare.Myriad.Plugins.SwaggerEndpoint.Summary [property]: [read-only] string | ||||
| WoofWare.Myriad.Plugins.SwaggerEndpoint.Tags [property]: [read-only] string list | ||||
| WoofWare.Myriad.Plugins.SwaggerInfo inherit obj, implements WoofWare.Myriad.Plugins.SwaggerInfo System.IEquatable, System.Collections.IStructuralEquatable | ||||
| WoofWare.Myriad.Plugins.SwaggerInfo..ctor [constructor]: (string, string, WoofWare.Myriad.Plugins.SwaggerLicense, System.Version) | ||||
| WoofWare.Myriad.Plugins.SwaggerInfo.Description [property]: [read-only] string | ||||
| WoofWare.Myriad.Plugins.SwaggerInfo.Equals [method]: (WoofWare.Myriad.Plugins.SwaggerInfo, System.Collections.IEqualityComparer) -> bool | ||||
| WoofWare.Myriad.Plugins.SwaggerInfo.get_Description [method]: unit -> string | ||||
| WoofWare.Myriad.Plugins.SwaggerInfo.get_License [method]: unit -> WoofWare.Myriad.Plugins.SwaggerLicense | ||||
| WoofWare.Myriad.Plugins.SwaggerInfo.get_Title [method]: unit -> string | ||||
| WoofWare.Myriad.Plugins.SwaggerInfo.get_Version [method]: unit -> System.Version | ||||
| WoofWare.Myriad.Plugins.SwaggerInfo.License [property]: [read-only] WoofWare.Myriad.Plugins.SwaggerLicense | ||||
| WoofWare.Myriad.Plugins.SwaggerInfo.Parse [static method]: System.Text.Json.Nodes.JsonObject -> WoofWare.Myriad.Plugins.SwaggerInfo | ||||
| WoofWare.Myriad.Plugins.SwaggerInfo.Title [property]: [read-only] string | ||||
| WoofWare.Myriad.Plugins.SwaggerInfo.Version [property]: [read-only] System.Version | ||||
| WoofWare.Myriad.Plugins.SwaggerLicense inherit obj, implements WoofWare.Myriad.Plugins.SwaggerLicense System.IEquatable, System.Collections.IStructuralEquatable | ||||
| WoofWare.Myriad.Plugins.SwaggerLicense..ctor [constructor]: (string, System.Uri option, string option) | ||||
| WoofWare.Myriad.Plugins.SwaggerLicense.Equals [method]: (WoofWare.Myriad.Plugins.SwaggerLicense, System.Collections.IEqualityComparer) -> bool | ||||
| WoofWare.Myriad.Plugins.SwaggerLicense.get_Identifier [method]: unit -> string option | ||||
| WoofWare.Myriad.Plugins.SwaggerLicense.get_Name [method]: unit -> string | ||||
| WoofWare.Myriad.Plugins.SwaggerLicense.get_Url [method]: unit -> System.Uri option | ||||
| WoofWare.Myriad.Plugins.SwaggerLicense.Identifier [property]: [read-only] string option | ||||
| WoofWare.Myriad.Plugins.SwaggerLicense.Name [property]: [read-only] string | ||||
| WoofWare.Myriad.Plugins.SwaggerLicense.Parse [static method]: System.Text.Json.Nodes.JsonObject -> WoofWare.Myriad.Plugins.SwaggerLicense | ||||
| WoofWare.Myriad.Plugins.SwaggerLicense.Url [property]: [read-only] System.Uri option | ||||
| WoofWare.Myriad.Plugins.SwaggerModule inherit obj | ||||
| WoofWare.Myriad.Plugins.SwaggerModule.parse [static method]: string -> WoofWare.Myriad.Plugins.Swagger | ||||
| WoofWare.Myriad.Plugins.SwaggerParameter inherit obj, implements WoofWare.Myriad.Plugins.SwaggerParameter System.IEquatable, System.Collections.IStructuralEquatable | ||||
| WoofWare.Myriad.Plugins.SwaggerParameter..ctor [constructor]: (WoofWare.Myriad.Plugins.Definition, string option, WoofWare.Myriad.Plugins.ParameterIn, string, bool option) | ||||
| WoofWare.Myriad.Plugins.SwaggerParameter.Description [property]: [read-only] string option | ||||
| WoofWare.Myriad.Plugins.SwaggerParameter.Equals [method]: (WoofWare.Myriad.Plugins.SwaggerParameter, System.Collections.IEqualityComparer) -> bool | ||||
| WoofWare.Myriad.Plugins.SwaggerParameter.get_Description [method]: unit -> string option | ||||
| WoofWare.Myriad.Plugins.SwaggerParameter.get_In [method]: unit -> WoofWare.Myriad.Plugins.ParameterIn | ||||
| WoofWare.Myriad.Plugins.SwaggerParameter.get_Name [method]: unit -> string | ||||
| WoofWare.Myriad.Plugins.SwaggerParameter.get_Required [method]: unit -> bool option | ||||
| WoofWare.Myriad.Plugins.SwaggerParameter.get_Type [method]: unit -> WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.SwaggerParameter.In [property]: [read-only] WoofWare.Myriad.Plugins.ParameterIn | ||||
| WoofWare.Myriad.Plugins.SwaggerParameter.Name [property]: [read-only] string | ||||
| WoofWare.Myriad.Plugins.SwaggerParameter.Parse [static method]: System.Text.Json.Nodes.JsonObject -> WoofWare.Myriad.Plugins.SwaggerParameter | ||||
| WoofWare.Myriad.Plugins.SwaggerParameter.Required [property]: [read-only] bool option | ||||
| WoofWare.Myriad.Plugins.SwaggerParameter.Type [property]: [read-only] WoofWare.Myriad.Plugins.Definition | ||||
| WoofWare.Myriad.Plugins.SynFieldData`1 inherit obj | ||||
| WoofWare.Myriad.Plugins.SynFieldData`1..ctor [constructor]: (Fantomas.FCS.Syntax.SynAttribute list, 'Ident, Fantomas.FCS.Syntax.SynType) | ||||
| WoofWare.Myriad.Plugins.SynFieldData`1.Attrs [property]: [read-only] Fantomas.FCS.Syntax.SynAttribute list | ||||
| WoofWare.Myriad.Plugins.SynFieldData`1.get_Attrs [method]: unit -> Fantomas.FCS.Syntax.SynAttribute list | ||||
| WoofWare.Myriad.Plugins.SynFieldData`1.get_Ident [method]: unit -> 'Ident | ||||
| WoofWare.Myriad.Plugins.SynFieldData`1.get_Type [method]: unit -> Fantomas.FCS.Syntax.SynType | ||||
| WoofWare.Myriad.Plugins.SynFieldData`1.Ident [property]: [read-only] 'Ident | ||||
| WoofWare.Myriad.Plugins.SynFieldData`1.Type [property]: [read-only] Fantomas.FCS.Syntax.SynType | ||||
| WoofWare.Myriad.Plugins.UnionCase inherit obj | ||||
| WoofWare.Myriad.Plugins.UnionCase.mapIdentFields [static method]: ('a -> 'b) -> 'a WoofWare.Myriad.Plugins.UnionCase -> 'b WoofWare.Myriad.Plugins.UnionCase | ||||
| WoofWare.Myriad.Plugins.UnionCase.ofSynUnionCase [static method]: Fantomas.FCS.Syntax.SynUnionCase -> Fantomas.FCS.Syntax.Ident option WoofWare.Myriad.Plugins.UnionCase | ||||
| WoofWare.Myriad.Plugins.UnionCase`1 inherit obj | ||||
| WoofWare.Myriad.Plugins.UnionCase`1..ctor [constructor]: (Fantomas.FCS.Syntax.Ident, Fantomas.FCS.Xml.PreXmlDoc option, Fantomas.FCS.Syntax.SynAccess option, Fantomas.FCS.Syntax.SynAttribute list, 'ident WoofWare.Myriad.Plugins.SynFieldData list) | ||||
| WoofWare.Myriad.Plugins.UnionCase`1.Access [property]: [read-only] Fantomas.FCS.Syntax.SynAccess option | ||||
| WoofWare.Myriad.Plugins.UnionCase`1.Attributes [property]: [read-only] Fantomas.FCS.Syntax.SynAttribute list | ||||
| WoofWare.Myriad.Plugins.UnionCase`1.Fields [property]: [read-only] 'ident WoofWare.Myriad.Plugins.SynFieldData list | ||||
| WoofWare.Myriad.Plugins.UnionCase`1.get_Access [method]: unit -> Fantomas.FCS.Syntax.SynAccess option | ||||
| WoofWare.Myriad.Plugins.UnionCase`1.get_Attributes [method]: unit -> Fantomas.FCS.Syntax.SynAttribute list | ||||
| WoofWare.Myriad.Plugins.UnionCase`1.get_Fields [method]: unit -> 'ident WoofWare.Myriad.Plugins.SynFieldData list | ||||
| WoofWare.Myriad.Plugins.UnionCase`1.get_Name [method]: unit -> Fantomas.FCS.Syntax.Ident | ||||
| WoofWare.Myriad.Plugins.UnionCase`1.get_XmlDoc [method]: unit -> Fantomas.FCS.Xml.PreXmlDoc option | ||||
| WoofWare.Myriad.Plugins.UnionCase`1.Name [property]: [read-only] Fantomas.FCS.Syntax.Ident | ||||
| WoofWare.Myriad.Plugins.UnionCase`1.XmlDoc [property]: [read-only] Fantomas.FCS.Xml.PreXmlDoc option | ||||
							
								
								
									
										576
									
								
								WoofWare.Myriad.Plugins/Swagger.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										576
									
								
								WoofWare.Myriad.Plugins/Swagger.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,576 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open System | ||||
| 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 | ||||
|  | ||||
| /// A MIME type, like "application/json" | ||||
| type MimeType = | ||||
|     /// A MIME type, like "application/json" | ||||
|     | MimeType of string | ||||
|  | ||||
| /// A URL scheme, like "https" | ||||
| type Scheme = | ||||
|     /// A URL scheme, like "https" | ||||
|     | Scheme of string | ||||
|  | ||||
| /// "Licence information for the exposed API", whatever that means. | ||||
| type SwaggerLicense = | ||||
|     { | ||||
|         /// "The license name used for the API", whatever that means. | ||||
|         Name : string | ||||
|         /// Link to the license used. Mutually exclusive with `Identifier`. | ||||
|         Url : Uri option | ||||
|         /// SPDX license identifier. Mutually exclusive with `Url`. | ||||
|         Identifier : string option | ||||
|     } | ||||
|  | ||||
|     /// Render a JsonObject into the strongly-typed version, performing sanity | ||||
|     /// checks and throwing on input that can't be parsed. | ||||
|     static member Parse (node : JsonObject) : SwaggerLicense = | ||||
|         let name = asString node "name" | ||||
|         let url = asOpt<string> node "url" |> Option.map Uri | ||||
|         let identifier = asOpt<string> node "identifier" | ||||
|  | ||||
|         match url, identifier with | ||||
|         | Some _, Some _ -> failwith "Invalid license spec: cannot supply both URL and identifier" | ||||
|         | _, _ -> () | ||||
|  | ||||
|         { | ||||
|             Name = name | ||||
|             Url = url | ||||
|             Identifier = identifier | ||||
|         } | ||||
|  | ||||
| /// Overall information about the API described by this Swagger spec. | ||||
| type SwaggerInfo = | ||||
|     { | ||||
|         /// Human-readable description of what this Swagger API is for. | ||||
|         /// Supports GitHub-flavoured markdown, apparently. | ||||
|         Description : string | ||||
|         /// Human-readable title of the service to which this is an API. | ||||
|         Title : string | ||||
|         /// The license applying to this schema. It's very unclear what this means. | ||||
|         /// The spec just says: | ||||
|         /// "Licence information for the exposed API" | ||||
|         License : SwaggerLicense | ||||
|         /// The version of this API (not the version of Swagger or the file defining the API!). | ||||
|         /// Strictly speaking this can be anything, but I am assuming it's roughly | ||||
|         /// SemVer. | ||||
|         Version : Version | ||||
|     } | ||||
|  | ||||
|     /// Render a JsonObject into the strongly-typed version, performing sanity | ||||
|     /// checks and throwing on input that can't be parsed. | ||||
|     static member Parse (node : JsonObject) : SwaggerInfo = | ||||
|         let description = asString node "description" | ||||
|         let title = asString node "title" | ||||
|         let version = asString node "version" |> Version.Parse | ||||
|         let license = asObj node "license" |> SwaggerLicense.Parse | ||||
|  | ||||
|         { | ||||
|             Description = description | ||||
|             Title = title | ||||
|             License = license | ||||
|             Version = version | ||||
|         } | ||||
|  | ||||
| /// An "optional unique string used to describe an operation". | ||||
| /// If present, these are assumed to be unique among all operations described | ||||
| /// in the API. | ||||
| type OperationId = | ||||
|     /// An "optional unique string used to describe an operation". | ||||
|     /// If present, these are assumed to be unique among all operations described | ||||
|     /// in the API. | ||||
|     | OperationId of string | ||||
|  | ||||
|     /// Round-trip string representation. | ||||
|     override this.ToString () = | ||||
|         match this with | ||||
|         | OperationId.OperationId s -> s | ||||
|  | ||||
| /// Constraints on the `additionalProperties` (in the JSON schema sense). | ||||
| /// "Additional properties" are properties of a JSON object which were not | ||||
| /// listed in the schema. | ||||
| type AdditionalProperties = | ||||
|     /// No additional properties are allowed: all properties must have been | ||||
|     /// mentioned in the schema. | ||||
|     | Never | ||||
|     /// Additional properties are permitted, but if they exist, they must | ||||
|     /// match this schema definition. | ||||
|     | Constrained of Definition | ||||
|  | ||||
| /// The Swagger schema lets you define types. An ObjectTypeDefinition | ||||
| /// is specifically the information about types defined as `"type": "object"`. | ||||
| and ObjectTypeDefinition = | ||||
|     { | ||||
|         /// Human-readable description of the purpose of this type. | ||||
|         Description : string option | ||||
|         /// Fields which any object must have to satisfy this type. | ||||
|         Properties : Map<string, Definition> option | ||||
|         /// Extra properties in the type description. In Gitea, these are | ||||
|         /// (for example) "x-go-package":"code.gitea.io/gitea/modules/structs". | ||||
|         Extras : Map<string, JsonNode> | ||||
|         /// List of fields which are required; all other fields are optional. | ||||
|         Required : string list option | ||||
|         /// Constraints, if any, placed on fields which are not mentioned in | ||||
|         /// the schema. If absent, there are no constraints. | ||||
|         AdditionalProperties : AdditionalProperties option | ||||
|         /// Example of an object which satisfies this schema. | ||||
|         Example : JsonObject option | ||||
|     } | ||||
|  | ||||
|     /// Render a JsonObject into the strongly-typed version, performing sanity | ||||
|     /// checks and throwing on input that can't be parsed. | ||||
|     static member Parse (node : JsonObject) : ObjectTypeDefinition = | ||||
|         let description = | ||||
|             match asOpt<string> node "description", asOpt<string> node "title" with | ||||
|             | None, None -> None | ||||
|             | Some v, None | ||||
|             | None, Some v -> Some v | ||||
|             | Some v1, Some v2 -> failwith "both description and title were given" | ||||
|  | ||||
|         let additionalProperties = | ||||
|             match node.["additionalProperties"] with | ||||
|             | null -> None | ||||
|             | :? JsonValue as p -> | ||||
|                 if not (p.GetValue<bool> ()) then | ||||
|                     Some AdditionalProperties.Never | ||||
|                 else | ||||
|                     failwith $"additionalProperties should be 'false' or an object, but was: %s{p.ToJsonString ()}" | ||||
|             | p -> | ||||
|                 let p = p.AsObject () | ||||
|                 Definition.Parse p |> AdditionalProperties.Constrained |> Some | ||||
|  | ||||
|         let properties = | ||||
|             match node.["properties"] with | ||||
|             | null -> None | ||||
|             | p -> | ||||
|                 p.AsObject () | ||||
|                 |> Seq.map (fun (KeyValue (key, value)) -> | ||||
|                     let value = value.AsObject () | ||||
|                     key, Definition.Parse value | ||||
|                 ) | ||||
|                 |> Map.ofSeq | ||||
|                 |> Some | ||||
|  | ||||
|         let example = asObjOpt node "example" | ||||
|  | ||||
|         let required = asArrOpt'<string> node "required" | ||||
|  | ||||
|         let extras = | ||||
|             node.AsObject () | ||||
|             |> Seq.choose (fun (KeyValue (key, value)) -> | ||||
|                 match key with | ||||
|                 | "type" | ||||
|                 | "description" | ||||
|                 | "title" | ||||
|                 | "additionalProperties" | ||||
|                 | "example" | ||||
|                 | "required" | ||||
|                 | "properties" -> None | ||||
|                 | _ -> Some (key, value) | ||||
|             ) | ||||
|             |> Map.ofSeq | ||||
|  | ||||
|         { | ||||
|             Description = description | ||||
|             Properties = properties | ||||
|             AdditionalProperties = additionalProperties | ||||
|             Required = required | ||||
|             Extras = extras | ||||
|             Example = example | ||||
|         } | ||||
|  | ||||
| /// The Swagger schema lets you define types. An ArrayTypeDefinition | ||||
| /// is specifically the information about types defined as `"type": "array"`. | ||||
| and ArrayTypeDefinition = | ||||
|     { | ||||
|         /// The type is `'a array`; this field describes `'a`. | ||||
|         Items : Definition | ||||
|     } | ||||
|  | ||||
|     /// Render a JsonNode into the strongly-typed version, performing sanity | ||||
|     /// checks and throwing on input that can't be parsed. | ||||
|     static member Parse (n : JsonNode) : ArrayTypeDefinition = | ||||
|         let items = asObj n "items" |> Definition.Parse | ||||
|  | ||||
|         { | ||||
|             Items = items | ||||
|         } | ||||
|  | ||||
| /// Any definition of a type in the Swagger document. This is basically any | ||||
| /// information associated with the `"type": "blah"` field. | ||||
| and Definition = | ||||
|     /// For example, if `"$ref": "#/responses/Blah", then this is "#/responses/Blah". | ||||
|     | Handle of string | ||||
|     /// A type definition with "type": "object". | ||||
|     | Object of ObjectTypeDefinition | ||||
|     /// A type definition with "type": "array". | ||||
|     | Array of ArrayTypeDefinition | ||||
|     /// A type definition with "type": "string". | ||||
|     | String | ||||
|     /// A type definition with "type": "boolean". | ||||
|     | Boolean | ||||
|     /// A response without a body has no "schema" specified. | ||||
|     | Unspecified | ||||
|     /// A type definition with "type": "integer". | ||||
|     /// The format is an optional hint which could be e.g. "int64" or "int32". | ||||
|     /// https://swagger.io/docs/specification/data-models/data-types/#numbers | ||||
|     | Integer of format : string option | ||||
|     /// Not a JSON schema type, but a Swagger 2.0 type. | ||||
|     | File | ||||
|  | ||||
|     /// Render a JsonObject into this strongly-typed specification. | ||||
|     static member Parse (n : JsonObject) : Definition = | ||||
|         match n.["$ref"] |> Option.ofObj with | ||||
|         | Some ref -> Definition.Handle (ref.GetValue<string> ()) | ||||
|         | None -> | ||||
|  | ||||
|         let ty = asOpt<string> n "type" | ||||
|  | ||||
|         match ty with | ||||
|         | None -> Definition.Unspecified | ||||
|         | Some "object" -> ObjectTypeDefinition.Parse n |> Definition.Object | ||||
|         | Some "array" -> ArrayTypeDefinition.Parse n |> Definition.Array | ||||
|         | Some "string" -> Definition.String | ||||
|         | Some "boolean" -> Definition.Boolean | ||||
|         | Some "file" -> Definition.File | ||||
|         | Some "integer" -> | ||||
|             let format = asOpt<string> n "format" | ||||
|             Definition.Integer format | ||||
|         | Some ty -> failwith $"Unrecognised type: %s{ty}" | ||||
|  | ||||
| /// REST APIs allow their parameters to be passed in various ways. This describes | ||||
| /// how one single parameter is passed. | ||||
| type ParameterIn = | ||||
|     /// The parameter is interpolated into the path, e.g. "/foo/{blah}". | ||||
|     /// The "name" is what we replace in the path: e.g. "/foo/{person}" would | ||||
|     /// have a name of "person". | ||||
|     | Path of name : string | ||||
|     /// The parameter is appended to the URL's query params, e.g. "?<name>=blah" | ||||
|     | Query of name : string | ||||
|     /// The parameter is passed in the body of the HTTP request. | ||||
|     | Body | ||||
|     /// Some spec that WoofWare.Myriad doesn't support. | ||||
|     | Unrecognised of op : string * name : string | ||||
|  | ||||
| /// Description of a single input parameter to an endpoint. | ||||
| type SwaggerParameter = | ||||
|     { | ||||
|         /// The type schema to which this parameter must conform. | ||||
|         Type : Definition | ||||
|         /// Optional human-readable description of this parameter. | ||||
|         Description : string option | ||||
|         /// How this parameter is passed. | ||||
|         In : ParameterIn | ||||
|         /// Name of this parameter. For most `In` values, this name is the | ||||
|         /// name of the parameter as supplied to the API at runtime, and in WoofWare's | ||||
|         /// strongly-typed domain types this information is also contained in the `In` field. | ||||
|         /// For `Body` parameters, this is purely for dev-time information. | ||||
|         Name : string | ||||
|         /// Whether this parameter is required for validation to succeed. | ||||
|         /// I think this defaults to "no". | ||||
|         Required : bool option | ||||
|     } | ||||
|  | ||||
|     /// Render a JsonObject into this strongly-typed specification. | ||||
|     static member Parse (node : JsonObject) : SwaggerParameter = | ||||
|         let ty = | ||||
|             match asObjOpt node "schema" with | ||||
|             | None -> Definition.Parse node | ||||
|             | Some node -> Definition.Parse node | ||||
|  | ||||
|         let description = asOpt<string> node "description" | ||||
|         let name = asString node "name" | ||||
|  | ||||
|         let paramIn = | ||||
|             match asString node "in" with | ||||
|             | "path" -> ParameterIn.Path name | ||||
|             | "query" -> ParameterIn.Query name | ||||
|             | "body" -> ParameterIn.Body | ||||
|             | f -> ParameterIn.Unrecognised (f, name) | ||||
|  | ||||
|         let required = asOpt<bool> node "required" | ||||
|  | ||||
|         { | ||||
|             Type = ty | ||||
|             Description = description | ||||
|             In = paramIn | ||||
|             Name = name | ||||
|             Required = required | ||||
|         } | ||||
|  | ||||
| /// An "endpoint" is basically a single HTTP verb, applied to some path. | ||||
| type SwaggerEndpoint = | ||||
|     { | ||||
|         /// The MIME types we should send our request body in. | ||||
|         /// This overrides (does not extend) any global definitions on the spec itself. | ||||
|         Consumes : MimeType list option | ||||
|         /// The MIME types we should expect to receive in response to this request. | ||||
|         /// This overrides (does not extend) any global definitions on the spec itself. | ||||
|         Produces : MimeType list option | ||||
|         /// Arbitrary list of [tags](https://swagger.io/docs/specification/2-0/grouping-operations-with-tags/). | ||||
|         Tags : string list | ||||
|         /// Human-readable description of the endpoint. | ||||
|         Summary : string | ||||
|         /// Arbitrary identifier of this endpoint; this must be unique across *all* endpoints | ||||
|         /// in this entire spec. | ||||
|         OperationId : OperationId | ||||
|         /// Parameters that must be supplied at HTTP-request-time to the endpoint. | ||||
|         /// (Each parameter knows how it needs to be supplied: e.g. if it's a query parameter or | ||||
|         /// if it's interpolated into the path.) | ||||
|         Parameters : SwaggerParameter list option | ||||
|         /// Map of HTTP response code to the type that we expect to receive in the body if we | ||||
|         /// get that response code back. | ||||
|         Responses : Map<int, Definition> | ||||
|     } | ||||
|  | ||||
|     /// Render a JsonObject into this strongly-typed specification. | ||||
|     static member Parse (r : JsonObject) : SwaggerEndpoint = | ||||
|         let produces = asArrOpt'<string> r "produces" |> Option.map (List.map MimeType) | ||||
|         let consumes = asArrOpt'<string> r "consumes" |> Option.map (List.map MimeType) | ||||
|         let tags = asArr'<string> r "tags" | ||||
|         let summary = asString r "summary" | ||||
|         let operationId = asString r "operationId" |> OperationId | ||||
|  | ||||
|         let responses = | ||||
|             asObj r "responses" | ||||
|             |> Seq.map (fun (KeyValue (key, value)) -> | ||||
|                 let value = value.AsObject () | ||||
|                 Int32.Parse key, Definition.Parse value | ||||
|             ) | ||||
|             |> Map.ofSeq | ||||
|  | ||||
|         let parameters = | ||||
|             asArrOpt r "parameters" | ||||
|             |> Option.map (fun pars -> | ||||
|                 pars | ||||
|                 |> Seq.map (fun par -> par.AsObject () |> SwaggerParameter.Parse) | ||||
|                 |> Seq.toList | ||||
|             ) | ||||
|  | ||||
|         { | ||||
|             Produces = produces | ||||
|             Consumes = consumes | ||||
|             Tags = tags | ||||
|             Summary = summary | ||||
|             OperationId = operationId | ||||
|             Parameters = parameters | ||||
|             Responses = responses | ||||
|         } | ||||
|  | ||||
| /// Specifies the form a response to an endpoint will take if it's complying with this spec. | ||||
| type Response = | ||||
|     { | ||||
|         /// Human-readable description. | ||||
|         Description : string | ||||
|         /// Specification of the type to which responses will conform under this spec. | ||||
|         Schema : Definition | ||||
|     } | ||||
|  | ||||
|     /// Render a JsonObject into this strongly-typed specification. | ||||
|     static member Parse (r : JsonObject) : Response = | ||||
|         let desc = asString r "description" | ||||
|  | ||||
|         let schema = | ||||
|             match asObjOpt r "schema" with | ||||
|             | None -> Definition.Unspecified | ||||
|             | Some s -> Definition.Parse s | ||||
|  | ||||
|         { | ||||
|             Description = desc | ||||
|             Schema = schema | ||||
|         } | ||||
|  | ||||
| /// 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 -> "Post" | ||||
|         | 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}" | ||||
|  | ||||
| /// A Swagger API specification. | ||||
| type Swagger = | ||||
|     { | ||||
|         /// Global collection of MIME types which any endpoint expects to consume its inputs in. | ||||
|         /// This may be overridden on any individual endpoint by that endpoint. | ||||
|         Consumes : MimeType list | ||||
|         /// Global collection of MIME types which any endpoint will produce. | ||||
|         /// This may be overridden on any individual endpoint by that endpoint. | ||||
|         Produces : MimeType list | ||||
|         /// HTTP or HTTPS, for example. Indicates which scheme to access the API on. | ||||
|         Schemes : Scheme list | ||||
|         /// The version of OpenAPI this specification is written against. | ||||
|         /// (As of this writing, we only support 2.0.) | ||||
|         Swagger : Version | ||||
|         /// General information about this API. | ||||
|         Info : SwaggerInfo | ||||
|         /// Path under the URI host, which should be prefixed (with trailing slash if necessary) | ||||
|         /// to all requests. | ||||
|         BasePath : string | ||||
|         /// Map from relative path to "what is served at that path". | ||||
|         Paths : Map<string, Map<HttpMethod, SwaggerEndpoint>> | ||||
|         /// Types defined in the schema. Requests may use these definitions just like in any other JSON schema. | ||||
|         /// Key is a domain type name, e.g. "APIError". | ||||
|         Definitions : Map<string, Definition> | ||||
|         /// Types of each response. | ||||
|         /// Key is a domain type name, e.g. "AccessToken". | ||||
|         Responses : Map<string, Response> | ||||
|     } | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module Swagger = | ||||
|     /// Parse a JSON-schema-based specification of a Swagger 2.0 API and | ||||
|     /// build the strongly-typed version. Throws on invalid inputs. | ||||
|     let parse (s : string) : Swagger = | ||||
|         let node = JsonNode.Parse s | ||||
|         let consumes = asArr'<string> node "consumes" |> List.map MimeType | ||||
|         let produces = asArr'<string> node "produces" |> List.map MimeType | ||||
|         let schemes = asArr'<string> node "schemes" |> List.map Scheme | ||||
|         let swagger = asString node "swagger" |> Version.Parse | ||||
|         let info = asObj node "info" |> SwaggerInfo.Parse | ||||
|         let basePath = asString node "basePath" | ||||
|  | ||||
|         let definitions = | ||||
|             asObj node "definitions" | ||||
|             |> Seq.map (fun (KeyValue (key, value)) -> | ||||
|                 let value = value.AsObject () | ||||
|                 key, Definition.Parse value | ||||
|             ) | ||||
|             |> Map.ofSeq | ||||
|  | ||||
|         let paths = | ||||
|             asObj node "paths" | ||||
|             |> Seq.map (fun (KeyValue (key, value)) -> | ||||
|                 let contents = | ||||
|                     value.AsObject () | ||||
|                     |> Seq.map (fun (KeyValue (endpoint, contents)) -> | ||||
|                         let contents = contents.AsObject () | ||||
|                         HttpMethod.Parse endpoint, SwaggerEndpoint.Parse contents | ||||
|                     ) | ||||
|                     |> Map.ofSeq | ||||
|  | ||||
|                 key, contents | ||||
|             ) | ||||
|             |> Map.ofSeq | ||||
|  | ||||
|         let responses = | ||||
|             asObj node "responses" | ||||
|             |> Seq.map (fun (KeyValue (key, value)) -> | ||||
|                 let value = value.AsObject () | ||||
|                 key, Response.Parse value | ||||
|             ) | ||||
|             |> Map.ofSeq | ||||
|  | ||||
|         { | ||||
|             Consumes = consumes | ||||
|             Produces = produces | ||||
|             Schemes = schemes | ||||
|             Swagger = swagger | ||||
|             Info = info | ||||
|             BasePath = basePath | ||||
|             Paths = paths | ||||
|             Definitions = definitions | ||||
|             Responses = responses | ||||
|         } | ||||
							
								
								
									
										724
									
								
								WoofWare.Myriad.Plugins/SwaggerClientGenerator.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										724
									
								
								WoofWare.Myriad.Plugins/SwaggerClientGenerator.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,724 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open System.Collections.Generic | ||||
| open System.IO | ||||
| open System.Threading | ||||
| open Fantomas.FCS.Syntax | ||||
| open Fantomas.FCS.Xml | ||||
| open Fantomas.FCS.Text.Range | ||||
|  | ||||
| type internal SwaggerClientConfig = | ||||
|     { | ||||
|         /// Additionally create a mock with `InterfaceMockGenerator`, with the given boolean arg. | ||||
|         /// (`None` means "no mock".) | ||||
|         CreateMock : bool option | ||||
|         ClassName : string | ||||
|     } | ||||
|  | ||||
| type internal Produces = | ||||
|     // TODO: this will cope with decoding JSON, plain text, etc | ||||
|     | Produces of string | ||||
|  | ||||
| type internal Endpoint = | ||||
|     { | ||||
|         DocString : PreXmlDoc | ||||
|         Produces : Produces | ||||
|         ReturnType : Definition | ||||
|         Method : WoofWare.Myriad.Plugins.HttpMethod | ||||
|         Operation : OperationId | ||||
|         Parameters : SwaggerParameter list | ||||
|         Endpoint : string | ||||
|     } | ||||
|  | ||||
| type internal TypeEntry = | ||||
|     { | ||||
|         /// If we had to define a type for this, here it is. | ||||
|         FSharpDefinition : SynTypeDefn option | ||||
|         /// SynType you use in e.g. a type annotation to refer to this type in F# code. | ||||
|         Signature : SynType | ||||
|     } | ||||
|  | ||||
| type internal Types = | ||||
|     { | ||||
|         ByHandle : IReadOnlyDictionary<string, TypeEntry> | ||||
|         ByDefinition : IReadOnlyDictionary<Definition, TypeEntry> | ||||
|     } | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal SwaggerClientGenerator = | ||||
|     let outputFile = FileInfo "/tmp/output.txt" | ||||
|  | ||||
|     // do | ||||
|     //     use _ = File.Create outputFile.FullName | ||||
|     //     () | ||||
|  | ||||
|     let log (line : string) = | ||||
|         // use w = outputFile.AppendText () | ||||
|         // w.WriteLine line | ||||
|         () | ||||
|  | ||||
|     let renderType (types : Types) (defn : Definition) : SynType option = | ||||
|         match types.ByDefinition.TryGetValue defn with | ||||
|         | true, v -> Some v.Signature | ||||
|         | false, _ -> | ||||
|  | ||||
|         match defn with | ||||
|         | Definition.Handle h -> | ||||
|             match types.ByHandle.TryGetValue h with | ||||
|             | false, _ -> None | ||||
|             | true, v -> Some v.Signature | ||||
|         | Definition.Object _ -> failwith "should not hit" | ||||
|         | Definition.Array _ -> failwith "should not hit" | ||||
|         | Definition.Unspecified -> failwith "should not hit" | ||||
|         | Definition.String -> SynType.string |> Some | ||||
|         | Definition.Boolean -> SynType.bool |> Some | ||||
|         | Definition.Integer _ -> SynType.int |> Some | ||||
|         | Definition.File -> SynType.createLongIdent' [ "System" ; "IO" ; "Stream" ] |> Some | ||||
|  | ||||
|     /// Returns None if we lacked the information required to do this. | ||||
|     /// bigCache is a map of e.g. {"securityDefinition": {Defn : F# type}}. | ||||
|     let rec defnToType | ||||
|         (anonymousTypeCount : int ref) | ||||
|         (handlesMap : Dictionary<string, TypeEntry>) | ||||
|         (bigCache : Dictionary<string, Dictionary<Definition, TypeEntry>>) | ||||
|         (thisKey : string) | ||||
|         (typeName : string option) | ||||
|         (d : Definition) | ||||
|         : TypeEntry option | ||||
|         = | ||||
|         let cache = | ||||
|             match bigCache.TryGetValue thisKey with | ||||
|             | false, _ -> | ||||
|                 let d = Dictionary () | ||||
|                 bigCache.Add (thisKey, d) | ||||
|                 d | ||||
|             | true, d -> d | ||||
|  | ||||
|         let handleKey = | ||||
|             match typeName with | ||||
|             | None -> None | ||||
|             | Some typeName -> $"#/%s{thisKey}/%s{typeName}" |> Some | ||||
|  | ||||
|         match handleKey with | ||||
|         | Some hk when handlesMap.ContainsKey hk -> | ||||
|             let result = handlesMap.[hk] | ||||
|             cache.[d] <- result | ||||
|             Some result | ||||
|  | ||||
|         | _ -> | ||||
|  | ||||
|         match cache.TryGetValue d with | ||||
|         | true, v -> | ||||
|             match handleKey with | ||||
|             | None -> () | ||||
|             | Some key -> handlesMap.Add (key, v) | ||||
|  | ||||
|             Some v | ||||
|         | false, _ -> | ||||
|  | ||||
|         let result = | ||||
|             match d with | ||||
|             | Definition.Object obj -> | ||||
|                 let requiredFields = obj.Required |> Option.defaultValue [] |> Set.ofList | ||||
|  | ||||
|                 let namedProperties = | ||||
|                     obj.Properties | ||||
|                     |> Option.map Seq.cast | ||||
|                     |> Option.defaultValue Seq.empty | ||||
|                     |> Seq.map (fun (KeyValue (fieldName, defn)) -> | ||||
|                         // TODO this is a horrible hack and is incomplete, e.g. if we contain an array of ourself | ||||
|                         // Special case for when this is a reference to this very type | ||||
|                         let isOurself = | ||||
|                             match defn with | ||||
|                             | Definition.Handle h -> | ||||
|                                 match h.Split '/' with | ||||
|                                 | [| "#" ; location ; ty |] when location = thisKey && Some ty = typeName -> | ||||
|                                     SynType.named ty |> Some | ||||
|                                 | _ -> None | ||||
|                             | _ -> None | ||||
|  | ||||
|                         let jsonPropertyName = | ||||
|                             SynExpr.CreateConst (fieldName : string) | ||||
|                             |> SynAttribute.create ( | ||||
|                                 SynLongIdent.createS' | ||||
|                                     [ "System" ; "Text" ; "Json" ; "Serialization" ; "JsonPropertyName" ] | ||||
|                             ) | ||||
|  | ||||
|                         match isOurself with | ||||
|                         | Some alreadyDone -> | ||||
|                             let ty = | ||||
|                                 if Set.contains fieldName requiredFields then | ||||
|                                     alreadyDone | ||||
|                                 else | ||||
|                                     SynType.option alreadyDone | ||||
|  | ||||
|                             { | ||||
|                                 Attrs = [ jsonPropertyName ] | ||||
|                                 Type = ty | ||||
|                                 Ident = Some (Ident.createSanitisedTypeName fieldName) | ||||
|                             } | ||||
|                             |> SynField.make | ||||
|                             |> Some | ||||
|                         | None -> | ||||
|  | ||||
|                         let defn' = defnToType anonymousTypeCount handlesMap bigCache thisKey None defn | ||||
|  | ||||
|                         match defn' with | ||||
|                         | None -> None | ||||
|                         | Some defn' -> | ||||
|                             let ty = | ||||
|                                 if Set.contains fieldName requiredFields then | ||||
|                                     defn'.Signature | ||||
|                                 else | ||||
|                                     defn'.Signature |> SynType.option | ||||
|  | ||||
|                             { | ||||
|                                 Attrs = [ jsonPropertyName ] | ||||
|                                 Ident = Ident.createSanitisedTypeName fieldName |> Some | ||||
|                                 Type = ty | ||||
|                             } | ||||
|                             |> SynField.make | ||||
|                             |> Some | ||||
|                     ) | ||||
|                     |> Seq.toList | ||||
|  | ||||
|                 let additionalProperties = | ||||
|                     match obj.AdditionalProperties with | ||||
|                     | None -> | ||||
|                         { | ||||
|                             Attrs = | ||||
|                                 [ | ||||
|                                     SynAttribute.create | ||||
|                                         (SynLongIdent.createS' | ||||
|                                             [ "System" ; "Text" ; "Json" ; "Serialization" ; "JsonExtensionData" ]) | ||||
|                                         (SynExpr.CreateConst ()) | ||||
|                                 ] | ||||
|                             Ident = Ident.create "AdditionalProperties" |> Some | ||||
|                             Type = | ||||
|                                 SynType.app' | ||||
|                                     (SynType.createLongIdent' [ "System" ; "Collections" ; "Generic" ; "Dictionary" ]) | ||||
|                                     [ | ||||
|                                         SynType.string | ||||
|                                         SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ] | ||||
|                                     ] | ||||
|                         } | ||||
|                         |> SynField.make | ||||
|                         |> List.singleton | ||||
|                         |> Some | ||||
|                     | Some AdditionalProperties.Never -> Some [] | ||||
|                     | Some (AdditionalProperties.Constrained defn) -> | ||||
|                         let defn' = defnToType anonymousTypeCount handlesMap bigCache thisKey None defn | ||||
|  | ||||
|                         match defn' with | ||||
|                         | None -> None | ||||
|                         | Some defn' -> | ||||
|                             { | ||||
|                                 Attrs = | ||||
|                                     [ | ||||
|                                         SynAttribute.create | ||||
|                                             (SynLongIdent.createS' | ||||
|                                                 [ "System" ; "Text" ; "Json" ; "Serialization" ; "JsonExtensionData" ]) | ||||
|                                             (SynExpr.CreateConst ()) | ||||
|                                     ] | ||||
|                                 Ident = Ident.create "AdditionalProperties" |> Some | ||||
|                                 Type = | ||||
|                                     SynType.app' | ||||
|                                         (SynType.createLongIdent' | ||||
|                                             [ "System" ; "Collections" ; "Generic" ; "Dictionary" ]) | ||||
|                                         [ SynType.string ; defn'.Signature ] | ||||
|                             } | ||||
|                             |> SynField.make | ||||
|                             |> List.singleton | ||||
|                             |> Some | ||||
|  | ||||
|                 match additionalProperties with | ||||
|                 | None -> None | ||||
|                 | Some additionalProperties -> | ||||
|  | ||||
|                 match List.allSome namedProperties with | ||||
|                 | None -> None | ||||
|                 | Some namedProperties -> | ||||
|  | ||||
|                 let fSharpTypeName = | ||||
|                     match typeName with | ||||
|                     | None -> $"Type%i{Interlocked.Increment anonymousTypeCount}" | ||||
|                     | Some typeName -> typeName | ||||
|  | ||||
|                 let properties = additionalProperties @ namedProperties | ||||
|  | ||||
|                 let properties = | ||||
|                     if properties.IsEmpty then | ||||
|                         // sigh, they didn't give us any properties at all; let's make one up | ||||
|                         { | ||||
|                             Attrs = [] | ||||
|                             Ident = Some (Ident.create "_SchemaUnspecified") | ||||
|                             Type = SynType.obj | ||||
|                         } | ||||
|                         |> SynField.make | ||||
|                         |> List.singleton | ||||
|                     else | ||||
|                         properties | ||||
|  | ||||
|                 let defn = | ||||
|                     let sci = | ||||
|                         SynComponentInfo.create (Ident.createSanitisedTypeName fSharpTypeName) | ||||
|                         |> SynComponentInfo.addAttributes | ||||
|                             [ | ||||
|                                 SynAttribute.create (SynLongIdent.createS' [ "JsonParse" ]) (SynExpr.CreateConst true) | ||||
|                                 SynAttribute.create | ||||
|                                     (SynLongIdent.createS' [ "JsonSerialize" ]) | ||||
|                                     (SynExpr.CreateConst true) | ||||
|                             ] | ||||
|                         |> fun sci -> | ||||
|                             match obj.Description with | ||||
|                             | None -> sci | ||||
|                             | Some doc -> sci |> SynComponentInfo.withDocString (PreXmlDoc.create doc) | ||||
|  | ||||
|                     properties |> SynTypeDefnRepr.record |> SynTypeDefn.create sci | ||||
|  | ||||
|                 let defn = | ||||
|                     { | ||||
|                         Signature = SynType.named fSharpTypeName | ||||
|                         FSharpDefinition = Some defn | ||||
|                     } | ||||
|  | ||||
|                 defn |> Some | ||||
|  | ||||
|             | Definition.Array elt -> | ||||
|                 let child = defnToType anonymousTypeCount handlesMap bigCache thisKey None elt.Items | ||||
|  | ||||
|                 match child with | ||||
|                 | None -> None | ||||
|                 | Some child -> | ||||
|                     let defn = | ||||
|                         { | ||||
|                             Signature = SynType.list child.Signature | ||||
|                             FSharpDefinition = None | ||||
|                         } | ||||
|  | ||||
|                     Some defn | ||||
|             | Definition.String -> | ||||
|                 { | ||||
|                     Signature = SynType.string | ||||
|                     FSharpDefinition = None | ||||
|                 } | ||||
|                 |> Some | ||||
|             | Definition.Boolean -> | ||||
|                 { | ||||
|                     Signature = SynType.bool | ||||
|                     FSharpDefinition = None | ||||
|                 } | ||||
|                 |> Some | ||||
|             | Definition.Unspecified -> | ||||
|                 { | ||||
|                     Signature = SynType.unit | ||||
|                     FSharpDefinition = None | ||||
|                 } | ||||
|                 |> Some | ||||
|             | Definition.Integer _ -> | ||||
|                 { | ||||
|                     Signature = SynType.createLongIdent' [ "int" ] | ||||
|                     FSharpDefinition = None | ||||
|                 } | ||||
|                 |> Some | ||||
|             | Definition.File -> | ||||
|                 { | ||||
|                     Signature = SynType.createLongIdent' [ "System" ; "IO" ; "Stream" ] | ||||
|                     FSharpDefinition = None | ||||
|                 } | ||||
|                 |> Some | ||||
|             | Definition.Handle s -> | ||||
|                 let split = s.Split '/' |> List.ofArray | ||||
|  | ||||
|                 match split with | ||||
|                 | [ "#" ; _location ; _handle ] -> | ||||
|                     match handlesMap.TryGetValue s with | ||||
|                     | false, _ -> None | ||||
|                     | true, computed -> | ||||
|                         let defn = | ||||
|                             { | ||||
|                                 FSharpDefinition = None | ||||
|                                 Signature = computed.Signature | ||||
|                             } | ||||
|  | ||||
|                         defn |> Some | ||||
|                 | _ -> failwith $"we don't know how to deal with object handle %s{s}" | ||||
|  | ||||
|         match result with | ||||
|         | None -> None | ||||
|         | Some result -> | ||||
|  | ||||
|         match handleKey with | ||||
|         | None -> () | ||||
|         | Some handleKey -> handlesMap.Add (handleKey, result) | ||||
|  | ||||
|         cache.Add (d, result) | ||||
|         Some result | ||||
|  | ||||
|     let instantiateRequiredTypes (types : Types) : SynModuleDecl = | ||||
|         types.ByDefinition | ||||
|         |> Seq.choose (fun (KeyValue (_defn, typeEntry)) -> typeEntry.FSharpDefinition) | ||||
|         |> Seq.toList | ||||
|         |> SynModuleDecl.createTypes | ||||
|  | ||||
|     type private IsIn = | ||||
|         | Path of str : string | ||||
|         | Query of str : string | ||||
|         | Body | ||||
|  | ||||
|     let computeType | ||||
|         (options : SwaggerClientConfig) | ||||
|         (basePath : string) | ||||
|         (types : Types) | ||||
|         (clientDocString : PreXmlDoc) | ||||
|         (endpoints : Endpoint list) | ||||
|         : SynModuleDecl list | ||||
|         = | ||||
|         endpoints | ||||
|         |> List.choose (fun ep -> | ||||
|             let name = (Ident.createSanitisedTypeName (ep.Operation.ToString ())).idText | ||||
|  | ||||
|             match renderType types ep.ReturnType with | ||||
|             | None -> | ||||
|                 log $"Skipping %O{ep.Operation}: Couldn't render return type: %O{ep.ReturnType}" | ||||
|                 None | ||||
|             | Some returnType -> | ||||
|  | ||||
|             let pars = | ||||
|                 ep.Parameters | ||||
|                 |> List.map (fun par -> | ||||
|                     let inParam = | ||||
|                         match par.In with | ||||
|                         | ParameterIn.Unrecognised (f, name) -> | ||||
|                             log | ||||
|                                 $"Skipping %O{ep.Operation} at %s{ep.Endpoint}: unrecognised In parameter %s{f} with name %s{name}" | ||||
|  | ||||
|                             None | ||||
|                         | ParameterIn.Body -> Some IsIn.Body | ||||
|                         | ParameterIn.Query name -> Some (IsIn.Query name) | ||||
|                         | ParameterIn.Path name -> Some (IsIn.Path name) | ||||
|  | ||||
|                     match inParam with | ||||
|                     | None -> None | ||||
|                     | Some inParam -> | ||||
|  | ||||
|                     match renderType types par.Type with | ||||
|                     | None -> | ||||
|                         // Couldn't render the return type | ||||
|                         // failwith "Did not have a type here" | ||||
|                         log $"Skipping %O{ep.Operation}: Couldn't render parameter: %O{par.Type}" | ||||
|                         None | ||||
|                     | Some v -> Some (Ident.createSanitisedParamName par.Name, inParam, v) | ||||
|                 ) | ||||
|                 |> List.allSome | ||||
|  | ||||
|             match pars with | ||||
|             | None -> None | ||||
|             | Some pars -> | ||||
|  | ||||
|             let arity = | ||||
|                 SynValInfo.SynValInfo ( | ||||
|                     [ | ||||
|                         ep.Parameters | ||||
|                         |> List.map (fun par -> | ||||
|                             let name = par.Name |> Ident.create |> Some | ||||
|                             SynArgInfo.SynArgInfo ([], false, name) | ||||
|                         ) | ||||
|                         |> fun l -> l @ [ SynArgInfo.SynArgInfo ([], true, Some (Ident.create "ct")) ] | ||||
|                     ], | ||||
|                     SynArgInfo.SynArgInfo ([], false, None) | ||||
|                 ) | ||||
|  | ||||
|             let domain = | ||||
|                 let ctParam = | ||||
|                     SynType.signatureParamOfType | ||||
|                         [] | ||||
|                         (SynType.createLongIdent' [ "System" ; "Threading" ; "CancellationToken" ]) | ||||
|                         true | ||||
|                         (Some (Ident.create "ct")) | ||||
|  | ||||
|                 let argParams = | ||||
|                     pars | ||||
|                     |> List.map (fun (ident, isIn, t) -> | ||||
|                         let attr : SynAttribute list = | ||||
|                             match isIn with | ||||
|                             | IsIn.Path name -> | ||||
|                                 SynAttribute.create | ||||
|                                     (SynLongIdent.createS' [ "RestEase" ; "Path" ]) | ||||
|                                     (SynExpr.CreateConst name) | ||||
|                                 |> List.singleton | ||||
|                             | IsIn.Query name -> | ||||
|                                 SynAttribute.create | ||||
|                                     (SynLongIdent.createS' [ "RestEase" ; "Query" ]) | ||||
|                                     (SynExpr.CreateConst name) | ||||
|                                 |> List.singleton | ||||
|                             | IsIn.Body -> | ||||
|                                 SynAttribute.create | ||||
|                                     (SynLongIdent.createS' [ "RestEase" ; "Body" ]) | ||||
|                                     (SynExpr.CreateConst ()) | ||||
|                                 |> List.singleton | ||||
|  | ||||
|                         SynType.signatureParamOfType attr t false (Some ident) | ||||
|                     ) | ||||
|  | ||||
|                 SynType.tupleNoParen (argParams @ [ ctParam ]) |> Option.get | ||||
|  | ||||
|             let attrs = | ||||
|                 [ | ||||
|                     SynAttribute.create | ||||
|                         (SynLongIdent.createS' [ "RestEase" ; ep.Method.ToString () ]) | ||||
|                         // Gitea, at least, starts with a `/`, which `Uri` then takes to indicate an absolute path. | ||||
|                         (SynExpr.CreateConst (ep.Endpoint.TrimStart '/')) | ||||
|  | ||||
|                     match ep.Produces with | ||||
|                     | Produces.Produces contentType -> | ||||
|                         SynAttribute.create | ||||
|                             (SynLongIdent.createS' [ "RestEase" ; "Header" ]) | ||||
|                             // Gitea, at least, starts with a `/`, which `Uri` then takes to indicate an absolute path. | ||||
|                             (SynExpr.tuple [ SynExpr.CreateConst "Content-Type" ; SynExpr.CreateConst contentType ]) | ||||
|                 ] | ||||
|  | ||||
|             returnType | ||||
|             |> SynType.task | ||||
|             |> SynType.toFun [ domain ] | ||||
|             |> SynMemberDefn.abstractMember attrs (SynIdent.createS name) None arity ep.DocString | ||||
|             |> Some | ||||
|         ) | ||||
|         |> SynTypeDefnRepr.interfaceType | ||||
|         |> SynTypeDefn.create ( | ||||
|             let attrs = | ||||
|                 [ | ||||
|                     yield SynAttribute.create (SynLongIdent.createS' [ "HttpClient" ]) (SynExpr.CreateConst false) | ||||
|                     yield | ||||
|                         SynAttribute.create | ||||
|                             (SynLongIdent.createS' [ "RestEase" ; "BasePath" ]) | ||||
|                             (SynExpr.CreateConst basePath) | ||||
|                     match options.CreateMock with | ||||
|                     | None -> () | ||||
|                     | Some createMockValue -> | ||||
|                         yield | ||||
|                             SynAttribute.create | ||||
|                                 (SynLongIdent.createS' [ "GenerateMock" ]) | ||||
|                                 (SynExpr.CreateConst createMockValue) | ||||
|                 ] | ||||
|  | ||||
|             SynComponentInfo.create (Ident.create ("I" + options.ClassName)) | ||||
|             |> SynComponentInfo.withDocString clientDocString | ||||
|             |> SynComponentInfo.addAttributes attrs | ||||
|         ) | ||||
|         |> List.singleton | ||||
|         |> SynModuleDecl.createTypes | ||||
|         |> List.singleton | ||||
|  | ||||
| open Myriad.Core | ||||
|  | ||||
| /// Myriad generator that stamps out an interface and class to access a Swagger-specified API. | ||||
| [<MyriadGenerator("swagger-client")>] | ||||
| type SwaggerClientGenerator () = | ||||
|  | ||||
|     interface IMyriadGenerator with | ||||
|         member _.ValidInputExtensions = [ ".json" ] | ||||
|  | ||||
|         member _.Generate (context : GeneratorContext) = | ||||
|             let contents = File.ReadAllText context.InputFilename |> Swagger.parse | ||||
|  | ||||
|             let scheme = | ||||
|                 let preferred = Scheme "https" | ||||
|  | ||||
|                 if List.isEmpty contents.Schemes then | ||||
|                     failwith "no schemes specified in API spec!" | ||||
|  | ||||
|                 if List.contains preferred contents.Schemes then | ||||
|                     preferred | ||||
|                 else | ||||
|                     List.head contents.Schemes | ||||
|  | ||||
|             let clientDocstring = contents.Info.Description |> PreXmlDoc.create | ||||
|  | ||||
|             let basePath = contents.BasePath | ||||
|  | ||||
|             let typeDefs = | ||||
|                 let bigCache = Dictionary<_, Dictionary<_, _>> () | ||||
|  | ||||
|                 let countAll () = | ||||
|                     (0, bigCache) ||> Seq.fold (fun count (KeyValue (_, v)) -> count + v.Count) | ||||
|  | ||||
|                 let byHandle = Dictionary () | ||||
|                 let anonymousTypeCount = ref 0 | ||||
|  | ||||
|                 let rec go (contents : ((string * Definition) * string) list) = | ||||
|                     let lastRound = countAll () | ||||
|  | ||||
|                     contents | ||||
|                     |> List.filter (fun ((name, defn), defnClass) -> | ||||
|                         let doIt = | ||||
|                             SwaggerClientGenerator.defnToType | ||||
|                                 anonymousTypeCount | ||||
|                                 byHandle | ||||
|                                 bigCache | ||||
|                                 defnClass | ||||
|                                 (Some name) | ||||
|                                 defn | ||||
|  | ||||
|                         match doIt with | ||||
|                         | None -> true | ||||
|                         | Some _ -> false | ||||
|                     ) | ||||
|                     |> fun remaining -> | ||||
|                         if not remaining.IsEmpty then | ||||
|                             let currentCount = countAll () | ||||
|  | ||||
|                             if currentCount = lastRound then | ||||
|                                 for (name, remaining), kind in remaining do | ||||
|                                     SwaggerClientGenerator.log $"Remaining: %s{name} (%s{kind})" | ||||
|  | ||||
|                                 SwaggerClientGenerator.log "--------" | ||||
|  | ||||
|                                 for KeyValue (handle, defn) in byHandle do | ||||
|                                     SwaggerClientGenerator.log $"Known: %s{handle} %O{defn}" | ||||
|  | ||||
|                                 // TODO: ohh noooooo the Gitea spec is genuinely circular, | ||||
|                                 // it's impossible to construct a Repository type | ||||
|                                 // we're going to have to somehow detect this case and break the cycle | ||||
|                                 // by artificially making a property optional | ||||
|                                 // :sob: Gitea why are you like this | ||||
|                                 // failwith "Made no further progress rendering types" | ||||
|                                 () | ||||
|                             else | ||||
|                                 go remaining | ||||
|  | ||||
|                 seq { | ||||
|                     for defnClass in [ "definitions" ; "responses" ] do | ||||
|                         match defnClass with | ||||
|                         | "definitions" -> | ||||
|                             for KeyValue (k, v) in contents.Definitions do | ||||
|                                 yield (k, v), defnClass | ||||
|                         | "responses" -> | ||||
|                             for KeyValue (k, v) in contents.Responses do | ||||
|                                 yield (k, v.Schema), defnClass | ||||
|                         | _ -> failwith "oh no" | ||||
|                 } | ||||
|                 |> Seq.toList | ||||
|                 |> go | ||||
|  | ||||
|                 let result = Dictionary () | ||||
|  | ||||
|                 for KeyValue (_container, types) in bigCache do | ||||
|                     for KeyValue (defn, rendered) in types do | ||||
|                         result.TryAdd (defn, rendered) |> ignore<bool> | ||||
|  | ||||
|                 { | ||||
|                     ByHandle = byHandle | ||||
|                     ByDefinition = result :> IReadOnlyDictionary<_, _> | ||||
|                 } | ||||
|  | ||||
|             let summary = | ||||
|                 contents.Paths | ||||
|                 |> Seq.collect (fun (KeyValue (path, endpoints)) -> | ||||
|                     endpoints | ||||
|                     |> Seq.choose (fun (KeyValue (method, endpoint)) -> | ||||
|                         let docstring = endpoint.Summary |> PreXmlDoc.create | ||||
|  | ||||
|                         let produces = | ||||
|                             match endpoint.Produces with | ||||
|                             | None -> Produces "json" | ||||
|                             | Some [] -> failwith $"API specified empty Produces: %s{path} (%O{method})" | ||||
|                             | Some [ MimeType "application/json" ] -> Produces "json" | ||||
|                             | Some [ MimeType (StartsWith "text/" t) ] -> Produces t | ||||
|                             | Some [ MimeType s ] -> | ||||
|                                 failwithf | ||||
|                                     $"we don't support non-JSON Produces right now, got: %s{s} (%s{path} %O{method})" | ||||
|                             | Some (_ :: _) -> | ||||
|                                 failwith $"we don't support multiple Produces right now, at %s{path} (%O{method})" | ||||
|  | ||||
|                         let returnType = | ||||
|                             endpoint.Responses | ||||
|                             |> Seq.choose (fun (KeyValue (response, defn)) -> | ||||
|                                 if 200 <= response && response < 300 then | ||||
|                                     Some defn | ||||
|                                 else | ||||
|                                     None | ||||
|                             ) | ||||
|                             |> Seq.toList | ||||
|  | ||||
|                         let returnType = | ||||
|                             match returnType with | ||||
|                             | [ t ] -> Some t | ||||
|                             | [] -> failwith $"got no successful response results, %s{path} %O{method}" | ||||
|                             | _ -> | ||||
|                                 SwaggerClientGenerator.log | ||||
|                                     $"Ignoring %s{path} %O{method} due to multiple success responses" | ||||
|                                 // can't be bothered to work out how to deal with multiple success | ||||
|                                 // results right now | ||||
|                                 None | ||||
|  | ||||
|                         match returnType with | ||||
|                         | None -> None | ||||
|                         | Some returnType -> | ||||
|  | ||||
|                         { | ||||
|                             Method = method | ||||
|                             Produces = produces | ||||
|                             DocString = docstring | ||||
|                             ReturnType = returnType | ||||
|                             Operation = endpoint.OperationId | ||||
|                             Parameters = endpoint.Parameters |> Option.defaultValue [] | ||||
|                             Endpoint = path | ||||
|                         } | ||||
|                         |> Some | ||||
|                     ) | ||||
|                     |> Seq.toList | ||||
|                 ) | ||||
|                 |> Seq.toList | ||||
|  | ||||
|             let config = | ||||
|                 let pars = MyriadParamParser.render context.AdditionalParameters | ||||
|  | ||||
|                 let pars = | ||||
|                     pars | ||||
|                     |> Map.toSeq | ||||
|                     |> Seq.map (fun (k, v) -> k.ToUpperInvariant (), v) | ||||
|                     |> Map.ofSeq | ||||
|  | ||||
|                 if pars.IsEmpty then | ||||
|                     failwith "No parameters given. You must supply the <ClassName /> parameter in <MyriadParams />." | ||||
|  | ||||
|                 let createMock = | ||||
|                     match Map.tryFind "GENERATEMOCKVISIBILITY" pars with | ||||
|                     | None -> None | ||||
|                     | Some v -> | ||||
|                         match v.ToLowerInvariant () with | ||||
|                         | "internal" -> Some true | ||||
|                         | "public" -> Some false | ||||
|                         | _ -> | ||||
|                             failwith | ||||
|                                 $"Expected GenerateMockVisibility parameter to be 'internal' or 'public', but was: '%s{v.ToLowerInvariant ()}'" | ||||
|  | ||||
|                 let className = | ||||
|                     match Map.tryFind "CLASSNAME" pars with | ||||
|                     | None -> failwith "You must supply the <ClassName /> parameter in <MyriadParams />." | ||||
|                     | Some v -> v | ||||
|  | ||||
|                 { | ||||
|                     CreateMock = createMock | ||||
|                     ClassName = className | ||||
|                 } | ||||
|  | ||||
|             let ty = | ||||
|                 SwaggerClientGenerator.computeType config basePath typeDefs clientDocstring summary | ||||
|  | ||||
|             [ | ||||
|                 yield | ||||
|                     SynModuleDecl.Open ( | ||||
|                         SynOpenDeclTarget.ModuleOrNamespace ( | ||||
|                             SynLongIdent.createS' [ "WoofWare" ; "Myriad" ; "Plugins" ], | ||||
|                             range0 | ||||
|                         ), | ||||
|                         range0 | ||||
|                     ) | ||||
|                 yield SwaggerClientGenerator.instantiateRequiredTypes typeDefs | ||||
|                 yield! ty | ||||
|             ] | ||||
|             |> SynModuleOrNamespace.createNamespace [ Ident.create config.ClassName ] | ||||
|             |> List.singleton | ||||
|             |> Output.Ast | ||||
| @@ -1,31 +0,0 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open Fantomas.FCS.Syntax | ||||
| open Fantomas.FCS.Text.Range | ||||
| open Myriad.Core | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal SynAttribute = | ||||
|     let internal compilationRepresentation : SynAttribute = | ||||
|         { | ||||
|             TypeName = SynLongIdent.CreateString "CompilationRepresentation" | ||||
|             ArgExpr = | ||||
|                 SynExpr.CreateLongIdent ( | ||||
|                     false, | ||||
|                     SynLongIdent.Create [ "CompilationRepresentationFlags" ; "ModuleSuffix" ], | ||||
|                     None | ||||
|                 ) | ||||
|                 |> SynExpr.CreateParen | ||||
|             Target = None | ||||
|             AppliesToGetterAndSetter = false | ||||
|             Range = range0 | ||||
|         } | ||||
|  | ||||
|     let internal autoOpen : SynAttribute = | ||||
|         { | ||||
|             TypeName = SynLongIdent.CreateString "AutoOpen" | ||||
|             ArgExpr = SynExpr.CreateConst SynConst.Unit | ||||
|             Target = None | ||||
|             AppliesToGetterAndSetter = false | ||||
|             Range = range0 | ||||
|         } | ||||
| @@ -1,275 +0,0 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open Fantomas.FCS.Syntax | ||||
| open Fantomas.FCS.SyntaxTrivia | ||||
| open Myriad.Core | ||||
| open Myriad.Core.Ast | ||||
| open Fantomas.FCS.Text.Range | ||||
|  | ||||
| type internal CompExprBinding = | ||||
|     | LetBang of varName : string * rhs : SynExpr | ||||
|     | Let of varName : string * rhs : SynExpr | ||||
|     | Use of varName : string * rhs : SynExpr | ||||
|     | Do of body : SynExpr | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal SynExpr = | ||||
|  | ||||
|     /// {expr} |> {func} | ||||
|     let pipeThroughFunction (func : SynExpr) (expr : SynExpr) : SynExpr = | ||||
|         SynExpr.CreateApp ( | ||||
|             SynExpr.CreateAppInfix ( | ||||
|                 SynExpr.CreateLongIdent ( | ||||
|                     SynLongIdent.SynLongIdent ( | ||||
|                         [ Ident.Create "op_PipeRight" ], | ||||
|                         [], | ||||
|                         [ Some (IdentTrivia.OriginalNotation "|>") ] | ||||
|                     ) | ||||
|                 ), | ||||
|                 expr | ||||
|             ), | ||||
|             func | ||||
|         ) | ||||
|  | ||||
|     /// if {cond} then {trueBranch} else {falseBranch} | ||||
|     /// Note that this function puts the trueBranch last, for pipelining convenience: | ||||
|     /// we assume that the `else` branch is more like an error case and is less interesting. | ||||
|     let ifThenElse (cond : SynExpr) (falseBranch : SynExpr) (trueBranch : SynExpr) : SynExpr = | ||||
|         SynExpr.IfThenElse ( | ||||
|             cond, | ||||
|             trueBranch, | ||||
|             Some falseBranch, | ||||
|             DebugPointAtBinding.Yes range0, | ||||
|             false, | ||||
|             range0, | ||||
|             { | ||||
|                 IfKeyword = range0 | ||||
|                 IsElif = false | ||||
|                 ThenKeyword = range0 | ||||
|                 ElseKeyword = Some range0 | ||||
|                 IfToThenRange = range0 | ||||
|             } | ||||
|         ) | ||||
|  | ||||
|     /// try {body} with | {exc} as exc -> {handler} | ||||
|     let pipeThroughTryWith (exc : SynPat) (handler : SynExpr) (body : SynExpr) : SynExpr = | ||||
|         let clause = | ||||
|             SynMatchClause.Create (SynPat.As (exc, SynPat.CreateNamed (Ident.Create "exc"), range0), None, handler) | ||||
|  | ||||
|         SynExpr.TryWith ( | ||||
|             body, | ||||
|             [ clause ], | ||||
|             range0, | ||||
|             DebugPointAtTry.Yes range0, | ||||
|             DebugPointAtWith.Yes range0, | ||||
|             { | ||||
|                 TryKeyword = range0 | ||||
|                 TryToWithRange = range0 | ||||
|                 WithKeyword = range0 | ||||
|                 WithToEndRange = range0 | ||||
|             } | ||||
|         ) | ||||
|  | ||||
|     /// {a} = {b} | ||||
|     let equals (a : SynExpr) (b : SynExpr) = | ||||
|         SynExpr.CreateApp ( | ||||
|             SynExpr.CreateAppInfix ( | ||||
|                 SynExpr.CreateLongIdent ( | ||||
|                     SynLongIdent.SynLongIdent ( | ||||
|                         Ident.CreateLong "op_Equality", | ||||
|                         [], | ||||
|                         [ Some (IdentTrivia.OriginalNotation "=") ] | ||||
|                     ) | ||||
|                 ), | ||||
|                 a | ||||
|             ), | ||||
|             b | ||||
|         ) | ||||
|  | ||||
|     /// {a} + {b} | ||||
|     let plus (a : SynExpr) (b : SynExpr) = | ||||
|         SynExpr.CreateApp ( | ||||
|             SynExpr.CreateAppInfix ( | ||||
|                 SynExpr.CreateLongIdent ( | ||||
|                     SynLongIdent.SynLongIdent ( | ||||
|                         Ident.CreateLong "op_Addition", | ||||
|                         [], | ||||
|                         [ Some (IdentTrivia.OriginalNotation "+") ] | ||||
|                     ) | ||||
|                 ), | ||||
|                 a | ||||
|             ), | ||||
|             b | ||||
|         ) | ||||
|  | ||||
|     let rec stripOptionalParen (expr : SynExpr) : SynExpr = | ||||
|         match expr with | ||||
|         | SynExpr.Paren (expr, _, _, _) -> stripOptionalParen expr | ||||
|         | expr -> expr | ||||
|  | ||||
|     /// Given e.g. "byte", returns "System.Byte". | ||||
|     let qualifyPrimitiveType (typeName : string) : LongIdent = | ||||
|         match typeName with | ||||
|         | "float32" -> [ "System" ; "Single" ] | ||||
|         | "float" -> [ "System" ; "Double" ] | ||||
|         | "byte" | ||||
|         | "uint8" -> [ "System" ; "Byte" ] | ||||
|         | "sbyte" -> [ "System" ; "SByte" ] | ||||
|         | "int16" -> [ "System" ; "Int16" ] | ||||
|         | "int" -> [ "System" ; "Int32" ] | ||||
|         | "int64" -> [ "System" ; "Int64" ] | ||||
|         | "uint16" -> [ "System" ; "UInt16" ] | ||||
|         | "uint" | ||||
|         | "uint32" -> [ "System" ; "UInt32" ] | ||||
|         | "uint64" -> [ "System" ; "UInt64" ] | ||||
|         | _ -> failwith $"Unable to identify a parsing function `string -> %s{typeName}`" | ||||
|         |> List.map Ident.Create | ||||
|  | ||||
|     /// {obj}.{meth} {arg} | ||||
|     let callMethodArg (meth : string) (arg : SynExpr) (obj : SynExpr) : SynExpr = | ||||
|         SynExpr.CreateApp ( | ||||
|             SynExpr.DotGet ( | ||||
|                 obj, | ||||
|                 range0, | ||||
|                 SynLongIdent.SynLongIdent (id = [ Ident.Create meth ], dotRanges = [], trivia = [ None ]), | ||||
|                 range0 | ||||
|             ), | ||||
|             arg | ||||
|         ) | ||||
|  | ||||
|     /// {obj}.{meth}() | ||||
|     let callMethod (meth : string) (obj : SynExpr) : SynExpr = | ||||
|         callMethodArg meth (SynExpr.CreateConst SynConst.Unit) obj | ||||
|  | ||||
|     /// {obj}.{meth}<ty>() | ||||
|     let callGenericMethod (meth : string) (ty : string) (obj : SynExpr) : SynExpr = | ||||
|         SynExpr.CreateApp ( | ||||
|             SynExpr.TypeApp ( | ||||
|                 SynExpr.DotGet (obj, range0, SynLongIdent.Create [ meth ], range0), | ||||
|                 range0, | ||||
|                 [ SynType.CreateLongIdent ty ], | ||||
|                 [], | ||||
|                 Some range0, | ||||
|                 range0, | ||||
|                 range0 | ||||
|             ), | ||||
|             SynExpr.CreateConst SynConst.Unit | ||||
|         ) | ||||
|  | ||||
|     let index (property : SynExpr) (obj : SynExpr) : SynExpr = | ||||
|         SynExpr.DotIndexedGet (obj, property, range0, range0) | ||||
|  | ||||
|     /// (fun {varName} -> {body}) | ||||
|     let createLambda (varName : string) (body : SynExpr) : SynExpr = | ||||
|         let parsedDataPat = [ SynPat.CreateNamed (Ident.Create varName) ] | ||||
|  | ||||
|         SynExpr.Lambda ( | ||||
|             false, | ||||
|             false, | ||||
|             SynSimplePats.Create [ SynSimplePat.CreateId (Ident.Create varName) ], | ||||
|             body, | ||||
|             Some (parsedDataPat, body), | ||||
|             range0, | ||||
|             { | ||||
|                 ArrowRange = Some range0 | ||||
|             } | ||||
|         ) | ||||
|         |> SynExpr.CreateParen | ||||
|  | ||||
|     let reraise : SynExpr = | ||||
|         SynExpr.CreateApp (SynExpr.CreateIdent (Ident.Create "reraise"), SynExpr.CreateConst SynConst.Unit) | ||||
|  | ||||
|     /// {body} |> fun a -> Async.StartAsTask (a, ?cancellationToken=ct) | ||||
|     let startAsTask (body : SynExpr) = | ||||
|         let lambda = | ||||
|             SynExpr.CreateApp ( | ||||
|                 SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "StartAsTask" ]), | ||||
|                 SynExpr.CreateParenedTuple | ||||
|                     [ | ||||
|                         SynExpr.CreateLongIdent (SynLongIdent.CreateString "a") | ||||
|                         equals | ||||
|                             (SynExpr.LongIdent (true, SynLongIdent.CreateString "cancellationToken", None, range0)) | ||||
|                             (SynExpr.CreateLongIdent (SynLongIdent.CreateString "ct")) | ||||
|                     ] | ||||
|             ) | ||||
|             |> createLambda "a" | ||||
|  | ||||
|         pipeThroughFunction lambda body | ||||
|  | ||||
|     /// {compExpr} { {lets} ; return {ret} } | ||||
|     let createCompExpr (compExpr : string) (retBody : SynExpr) (lets : CompExprBinding list) : SynExpr = | ||||
|         let retStatement = SynExpr.YieldOrReturn ((false, true), retBody, range0) | ||||
|  | ||||
|         let contents : SynExpr = | ||||
|             (retStatement, List.rev lets) | ||||
|             ||> List.fold (fun state binding -> | ||||
|                 match binding with | ||||
|                 | LetBang (lhs, rhs) -> | ||||
|                     SynExpr.LetOrUseBang ( | ||||
|                         DebugPointAtBinding.Yes range0, | ||||
|                         false, | ||||
|                         true, | ||||
|                         SynPat.CreateNamed (Ident.Create lhs), | ||||
|                         rhs, | ||||
|                         [], | ||||
|                         state, | ||||
|                         range0, | ||||
|                         { | ||||
|                             EqualsRange = Some range0 | ||||
|                         } | ||||
|                     ) | ||||
|                 | Let (lhs, rhs) -> | ||||
|                     SynExpr.LetOrUse ( | ||||
|                         false, | ||||
|                         false, | ||||
|                         [ SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create lhs), expr = rhs) ], | ||||
|                         state, | ||||
|                         range0, | ||||
|                         { | ||||
|                             SynExprLetOrUseTrivia.InKeyword = None | ||||
|                         } | ||||
|                     ) | ||||
|                 | Use (lhs, rhs) -> | ||||
|                     SynExpr.LetOrUse ( | ||||
|                         false, | ||||
|                         true, | ||||
|                         [ SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create lhs), expr = rhs) ], | ||||
|                         state, | ||||
|                         range0, | ||||
|                         { | ||||
|                             SynExprLetOrUseTrivia.InKeyword = None | ||||
|                         } | ||||
|                     ) | ||||
|                 | Do body -> SynExpr.CreateSequential [ SynExpr.Do (body, range0) ; state ] | ||||
|             ) | ||||
|  | ||||
|         SynExpr.CreateApp ( | ||||
|             SynExpr.CreateIdent (Ident.Create compExpr), | ||||
|             SynExpr.ComputationExpr (false, contents, range0) | ||||
|         ) | ||||
|  | ||||
|     /// {expr} |> Async.AwaitTask | ||||
|     let awaitTask (expr : SynExpr) : SynExpr = | ||||
|         expr | ||||
|         |> pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "AwaitTask" ])) | ||||
|  | ||||
|     /// {ident}.ToString () | ||||
|     /// with special casing for some types like DateTime | ||||
|     let toString (ty : SynType) (ident : SynExpr) = | ||||
|         match ty with | ||||
|         | DateOnly -> ident |> callMethodArg "ToString" (SynExpr.CreateConstString "yyyy-MM-dd") | ||||
|         | DateTime -> | ||||
|             ident | ||||
|             |> callMethodArg "ToString" (SynExpr.CreateConstString "yyyy-MM-ddTHH:mm:ss") | ||||
|         | _ -> callMethod "ToString" ident | ||||
|  | ||||
|     let synBindingTriviaZero (isMember : bool) = | ||||
|         { | ||||
|             SynBindingTrivia.EqualsRange = Some range0 | ||||
|             InlineKeyword = None | ||||
|             LeadingKeyword = | ||||
|                 if isMember then | ||||
|                     SynLeadingKeyword.Member range0 | ||||
|                 else | ||||
|                     SynLeadingKeyword.Let range0 | ||||
|         } | ||||
							
								
								
									
										49
									
								
								WoofWare.Myriad.Plugins/SynExpr/CompExpr.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										49
									
								
								WoofWare.Myriad.Plugins/SynExpr/CompExpr.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,49 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open Fantomas.FCS.Syntax | ||||
|  | ||||
| type internal CompExprBinding = | ||||
|     | LetBang of varName : string * rhs : SynExpr | ||||
|     | Let of varName : string * rhs : SynExpr | ||||
|     | Use of varName : string * rhs : SynExpr | ||||
|     | Do of body : SynExpr | ||||
|  | ||||
| (* | ||||
| Potential API! | ||||
| type internal CompExprBindings = | ||||
|     private | ||||
|         { | ||||
|             /// These are stored in reverse. | ||||
|             Bindings : CompExprBinding list | ||||
|             CompExprName : string | ||||
|         } | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal CompExprBindings = | ||||
|     let make (name : string) : CompExprBindings = | ||||
|         { | ||||
|             Bindings = [] | ||||
|             CompExprName = name | ||||
|         } | ||||
|  | ||||
|     let thenDo (body : SynExpr) (bindings : CompExprBindings) = | ||||
|         { bindings with | ||||
|             Bindings = (Do body :: bindings.Bindings) | ||||
|         } | ||||
|  | ||||
|     let thenLet (varName : string) (value : SynExpr) (bindings : CompExprBindings) = | ||||
|         { bindings with | ||||
|             Bindings = (Let (varName, value) :: bindings.Bindings) | ||||
|         } | ||||
|  | ||||
|     let thenLetBang (varName : string) (value : SynExpr) (bindings : CompExprBindings) = | ||||
|         { bindings with | ||||
|             Bindings = (LetBang (varName, value) :: bindings.Bindings) | ||||
|         } | ||||
|  | ||||
|  | ||||
|     let thenUse (varName : string) (value : SynExpr) (bindings : CompExprBindings) = | ||||
|         { bindings with | ||||
|             Bindings = (LetBang (varName, value) :: bindings.Bindings) | ||||
|         } | ||||
| *) | ||||
							
								
								
									
										65
									
								
								WoofWare.Myriad.Plugins/SynExpr/Ident.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										65
									
								
								WoofWare.Myriad.Plugins/SynExpr/Ident.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,65 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open System | ||||
| open System.Text | ||||
| open System.Text.RegularExpressions | ||||
| open Fantomas.FCS.Syntax | ||||
| open Fantomas.FCS.Text.Range | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal Ident = | ||||
|     let inline create (s : string) = Ident (s, range0) | ||||
|  | ||||
|     /// Fantomas bug, perhaps? "type" is not rendered as ``type``, although the ASTs are identical | ||||
|     /// apart from the ranges? | ||||
|     /// Awful hack: here is a function that does this sort of thing. | ||||
|     let createSanitisedParamName (s : string) = | ||||
|         match s with | ||||
|         | "type" -> create "type'" | ||||
|         | "private" -> create "private'" | ||||
|         | _ -> | ||||
|  | ||||
|         let result = StringBuilder () | ||||
|  | ||||
|         for i = 0 to s.Length - 1 do | ||||
|             if Char.IsLetter s.[i] then | ||||
|                 result.Append s.[i] |> ignore<StringBuilder> | ||||
|             elif Char.IsNumber s.[i] then | ||||
|                 if result.Length > 0 then | ||||
|                     result.Append s.[i] |> ignore<StringBuilder> | ||||
|             elif s.[i] = '_' || s.[i] = '-' then | ||||
|                 result.Append '_' |> ignore<StringBuilder> | ||||
|             else | ||||
|                 failwith $"could not convert to ident: %s{s}" | ||||
|  | ||||
|         create (result.ToString ()) | ||||
|  | ||||
|     let private alnum = Regex @"^[a-zA-Z][a-zA-Z0-9]*$" | ||||
|  | ||||
|     let createSanitisedTypeName (s : string) = | ||||
|         let result = StringBuilder () | ||||
|         let mutable capitalize = true | ||||
|  | ||||
|         for i = 0 to s.Length - 1 do | ||||
|             if Char.IsLetter s.[i] then | ||||
|                 if capitalize then | ||||
|                     result.Append (Char.ToUpperInvariant s.[i]) |> ignore<StringBuilder> | ||||
|                     capitalize <- false | ||||
|                 else | ||||
|                     result.Append s.[i] |> ignore<StringBuilder> | ||||
|             elif Char.IsNumber s.[i] then | ||||
|                 if result.Length > 0 then | ||||
|                     result.Append s.[i] |> ignore<StringBuilder> | ||||
|             elif s.[i] = '_' then | ||||
|                 capitalize <- true | ||||
|  | ||||
|         if result.Length = 0 then | ||||
|             failwith $"String %s{s} was not suitable as a type identifier" | ||||
|  | ||||
|         Ident (result.ToString (), range0) | ||||
|  | ||||
|     let lowerFirstLetter (x : Ident) : Ident = | ||||
|         let result = StringBuilder x.idText.Length | ||||
|         result.Append (Char.ToLowerInvariant x.idText.[0]) |> ignore | ||||
|         result.Append x.idText.[1..] |> ignore | ||||
|         create ((result : StringBuilder).ToString ()) | ||||
							
								
								
									
										17
									
								
								WoofWare.Myriad.Plugins/SynExpr/PreXmlDoc.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										17
									
								
								WoofWare.Myriad.Plugins/SynExpr/PreXmlDoc.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,17 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open Fantomas.FCS.Xml | ||||
| open Fantomas.FCS.Text.Range | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal PreXmlDoc = | ||||
|     let create (s : string) : PreXmlDoc = | ||||
|         let s = s.Split "\n" | ||||
|  | ||||
|         for i = 0 to s.Length - 1 do | ||||
|             s.[i] <- " " + s.[i] | ||||
|  | ||||
|         PreXmlDoc.Create (s, range0) | ||||
|  | ||||
|     let create' (s : string seq) : PreXmlDoc = | ||||
|         PreXmlDoc.Create (Array.ofSeq s, range0) | ||||
							
								
								
									
										7
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynArgInfo.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										7
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynArgInfo.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,7 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open Fantomas.FCS.Syntax | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal SynArgInfo = | ||||
|     let empty = SynArgInfo.SynArgInfo ([], false, None) | ||||
							
								
								
									
										30
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynArgPats.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										30
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynArgPats.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,30 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open Fantomas.FCS.Syntax | ||||
| open Fantomas.FCS.Text.Range | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal SynArgPats = | ||||
|     let createNamed (caseNames : string list) : SynArgPats = | ||||
|         match caseNames.Length with | ||||
|         | 0 -> SynArgPats.Pats [] | ||||
|         | 1 -> | ||||
|             SynPat.Named (SynIdent.createS caseNames.[0], false, None, range0) | ||||
|             |> List.singleton | ||||
|             |> SynArgPats.Pats | ||||
|         | len -> | ||||
|             caseNames | ||||
|             |> List.map (fun name -> SynPat.Named (SynIdent.createS name, false, None, range0)) | ||||
|             |> fun t -> SynPat.Tuple (false, t, List.replicate (len - 1) range0, range0) | ||||
|             |> fun t -> SynPat.Paren (t, range0) | ||||
|             |> List.singleton | ||||
|             |> SynArgPats.Pats | ||||
|  | ||||
|     let create (pats : SynPat list) : SynArgPats = | ||||
|         match pats.Length with | ||||
|         | 0 -> SynArgPats.Pats [] | ||||
|         | 1 -> [ pats.[0] ] |> SynArgPats.Pats | ||||
|         | len -> | ||||
|             SynPat.Paren (SynPat.Tuple (false, pats, List.replicate (len - 1) range0, range0), range0) | ||||
|             |> List.singleton | ||||
|             |> SynArgPats.Pats | ||||
							
								
								
									
										27
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynAttribute.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										27
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynAttribute.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,27 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open Fantomas.FCS.Syntax | ||||
| open Fantomas.FCS.Text.Range | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal SynAttribute = | ||||
|     let inline create (typeName : SynLongIdent) (arg : SynExpr) : SynAttribute = | ||||
|         { | ||||
|             TypeName = typeName | ||||
|             ArgExpr = arg | ||||
|             Target = None | ||||
|             AppliesToGetterAndSetter = false | ||||
|             Range = range0 | ||||
|         } | ||||
|  | ||||
|     let internal compilationRepresentation : SynAttribute = | ||||
|         [ "CompilationRepresentationFlags" ; "ModuleSuffix" ] | ||||
|         |> SynExpr.createLongIdent | ||||
|         |> SynExpr.paren | ||||
|         |> create (SynLongIdent.createS "CompilationRepresentation") | ||||
|  | ||||
|     let internal requireQualifiedAccess : SynAttribute = | ||||
|         create (SynLongIdent.createS "RequireQualifiedAccess") (SynExpr.CreateConst ()) | ||||
|  | ||||
|     let internal autoOpen : SynAttribute = | ||||
|         create (SynLongIdent.createS "AutoOpen") (SynExpr.CreateConst ()) | ||||
							
								
								
									
										15
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynAttributes.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										15
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynAttributes.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,15 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open Fantomas.FCS.Syntax | ||||
| open Fantomas.FCS.Text.Range | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal SynAttributes = | ||||
|     let ofAttrs (attrs : SynAttribute list) : SynAttributes = | ||||
|         attrs | ||||
|         |> List.map (fun a -> | ||||
|             { | ||||
|                 Attributes = [ a ] | ||||
|                 Range = range0 | ||||
|             } | ||||
|         ) | ||||
							
								
								
									
										233
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynBinding.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										233
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynBinding.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,233 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open Fantomas.FCS.Syntax | ||||
| open Fantomas.FCS.SyntaxTrivia | ||||
| open Fantomas.FCS.Xml | ||||
| open Fantomas.FCS.Text.Range | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal SynBinding = | ||||
|  | ||||
|     let rec private stripParen (pat : SynPat) = | ||||
|         match pat with | ||||
|         | SynPat.Paren (p, _) -> stripParen p | ||||
|         | _ -> pat | ||||
|  | ||||
|     let rec private getName (pat : SynPat) : Ident option = | ||||
|         match stripParen pat with | ||||
|         | SynPat.Named (SynIdent.SynIdent (name, _), _, _, _) -> Some name | ||||
|         | SynPat.Typed (pat, _, _) -> getName pat | ||||
|         | SynPat.LongIdent (SynLongIdent.SynLongIdent (longIdent, _, _), _, _, _, _, _) -> | ||||
|             match longIdent with | ||||
|             | [ x ] -> Some x | ||||
|             | _ -> failwithf "got long ident %O ; can only get the name of a long ident with one component" longIdent | ||||
|         | _ -> None | ||||
|  | ||||
|     let private getArgInfo (pat : SynPat) : SynArgInfo list = | ||||
|         // TODO: this only copes with one layer of tupling | ||||
|         match stripParen pat with | ||||
|         | SynPat.Tuple (_, pats, _, _) -> pats |> List.map (fun pat -> SynArgInfo.SynArgInfo ([], false, getName pat)) | ||||
|         | pat -> [ SynArgInfo.SynArgInfo (SynAttributes.Empty, false, getName pat) ] | ||||
|  | ||||
|     let triviaZero (isMember : bool) = | ||||
|         { | ||||
|             SynBindingTrivia.EqualsRange = Some range0 | ||||
|             InlineKeyword = None | ||||
|             LeadingKeyword = | ||||
|                 if isMember then | ||||
|                     SynLeadingKeyword.Member range0 | ||||
|                 else | ||||
|                     SynLeadingKeyword.Let range0 | ||||
|         } | ||||
|  | ||||
|     let basic (name : LongIdent) (args : SynPat list) (body : SynExpr) : SynBinding = | ||||
|         let valInfo : SynValInfo = | ||||
|             args | ||||
|             |> List.map getArgInfo | ||||
|             |> fun x -> SynValInfo.SynValInfo (x, SynArgInfo.SynArgInfo ([], false, None)) | ||||
|  | ||||
|         SynBinding.SynBinding ( | ||||
|             None, | ||||
|             SynBindingKind.Normal, | ||||
|             false, | ||||
|             false, | ||||
|             [], | ||||
|             PreXmlDoc.Empty, | ||||
|             SynValData.SynValData (None, valInfo, None), | ||||
|             SynPat.identWithArgs name (SynArgPats.Pats args), | ||||
|             None, | ||||
|             body, | ||||
|             range0, | ||||
|             DebugPointAtBinding.Yes range0, | ||||
|             triviaZero false | ||||
|         ) | ||||
|  | ||||
|     let withMutability (mut : bool) (binding : SynBinding) : SynBinding = | ||||
|         match binding with | ||||
|         | SynBinding (pat, kind, inl, _, attrs, xml, valData, headPat, returnInfo, expr, range, debugPoint, trivia) -> | ||||
|             SynBinding (pat, kind, inl, mut, attrs, xml, valData, headPat, returnInfo, expr, range, debugPoint, trivia) | ||||
|  | ||||
|     let withRecursion (isRec : bool) (binding : SynBinding) : SynBinding = | ||||
|         match binding with | ||||
|         | SynBinding (pat, kind, inl, mut, attrs, xml, valData, headPat, returnInfo, expr, range, debugPoint, trivia) -> | ||||
|             let trivia = | ||||
|                 { trivia with | ||||
|                     LeadingKeyword = | ||||
|                         match trivia.LeadingKeyword with | ||||
|                         | SynLeadingKeyword.Let _ -> | ||||
|                             if isRec then | ||||
|                                 SynLeadingKeyword.LetRec (range0, range0) | ||||
|                             else | ||||
|                                 trivia.LeadingKeyword | ||||
|                         | SynLeadingKeyword.LetRec _ -> | ||||
|                             if isRec then | ||||
|                                 trivia.LeadingKeyword | ||||
|                             else | ||||
|                                 trivia.LeadingKeyword | ||||
|                         | existing -> | ||||
|                             failwith | ||||
|                                 $"WoofWare.Myriad doesn't yet let you adjust the recursion modifier on a binding with modifier %O{existing}" | ||||
|                 } | ||||
|  | ||||
|             SynBinding (pat, kind, inl, mut, attrs, xml, valData, headPat, returnInfo, expr, range, debugPoint, trivia) | ||||
|  | ||||
|     let withAccessibility (acc : SynAccess option) (binding : SynBinding) : SynBinding = | ||||
|         match binding with | ||||
|         | SynBinding (_, kind, inl, mut, attrs, xml, valData, headPat, returnInfo, expr, range, debugPoint, trivia) -> | ||||
|             let headPat = | ||||
|                 match headPat with | ||||
|                 | SynPat.LongIdent (ident, extra, options, argPats, _, range) -> | ||||
|                     SynPat.LongIdent (ident, extra, options, argPats, acc, range) | ||||
|                 | _ -> failwithf "unrecognised head pattern: %O" headPat | ||||
|  | ||||
|             SynBinding (acc, kind, inl, mut, attrs, xml, valData, headPat, returnInfo, expr, range, debugPoint, trivia) | ||||
|  | ||||
|     let withXmlDoc (doc : PreXmlDoc) (binding : SynBinding) : SynBinding = | ||||
|         match binding with | ||||
|         | SynBinding (acc, kind, inl, mut, attrs, _, valData, headPat, returnInfo, expr, range, debugPoint, trivia) -> | ||||
|             SynBinding (acc, kind, inl, mut, attrs, doc, valData, headPat, returnInfo, expr, range, debugPoint, trivia) | ||||
|  | ||||
|     let withReturnAnnotation (ty : SynType) (binding : SynBinding) : SynBinding = | ||||
|         match binding with | ||||
|         | SynBinding (acc, kind, inl, mut, attrs, doc, valData, headPat, _, expr, range, debugPoint, trivia) -> | ||||
|             let retInfo = | ||||
|                 SynBindingReturnInfo.SynBindingReturnInfo ( | ||||
|                     ty, | ||||
|                     range0, | ||||
|                     [], | ||||
|                     { | ||||
|                         ColonRange = Some range0 | ||||
|                     } | ||||
|                 ) | ||||
|  | ||||
|             SynBinding ( | ||||
|                 acc, | ||||
|                 kind, | ||||
|                 inl, | ||||
|                 mut, | ||||
|                 attrs, | ||||
|                 doc, | ||||
|                 valData, | ||||
|                 headPat, | ||||
|                 Some retInfo, | ||||
|                 expr, | ||||
|                 range, | ||||
|                 debugPoint, | ||||
|                 trivia | ||||
|             ) | ||||
|  | ||||
|     let inline makeInline (binding : SynBinding) : SynBinding = | ||||
|         match binding with | ||||
|         | SynBinding (acc, kind, _, mut, attrs, doc, valData, headPat, ret, expr, range, debugPoint, trivia) -> | ||||
|             SynBinding ( | ||||
|                 acc, | ||||
|                 kind, | ||||
|                 true, | ||||
|                 mut, | ||||
|                 attrs, | ||||
|                 doc, | ||||
|                 valData, | ||||
|                 headPat, | ||||
|                 ret, | ||||
|                 expr, | ||||
|                 range, | ||||
|                 debugPoint, | ||||
|                 { trivia with | ||||
|                     InlineKeyword = Some range0 | ||||
|                 } | ||||
|             ) | ||||
|  | ||||
|     let inline makeNotInline (binding : SynBinding) : SynBinding = | ||||
|         match binding with | ||||
|         | SynBinding (acc, kind, _, mut, attrs, doc, valData, headPat, ret, expr, range, debugPoint, trivia) -> | ||||
|             SynBinding ( | ||||
|                 acc, | ||||
|                 kind, | ||||
|                 false, | ||||
|                 mut, | ||||
|                 attrs, | ||||
|                 doc, | ||||
|                 valData, | ||||
|                 headPat, | ||||
|                 ret, | ||||
|                 expr, | ||||
|                 range, | ||||
|                 debugPoint, | ||||
|                 { trivia with | ||||
|                     InlineKeyword = None | ||||
|                 } | ||||
|             ) | ||||
|  | ||||
|     let inline setInline (isInline : bool) (binding : SynBinding) : SynBinding = | ||||
|         if isInline then | ||||
|             makeInline binding | ||||
|         else | ||||
|             makeNotInline binding | ||||
|  | ||||
|     let makeStaticMember (binding : SynBinding) : SynBinding = | ||||
|         let memberFlags = | ||||
|             { | ||||
|                 SynMemberFlags.IsInstance = false | ||||
|                 SynMemberFlags.IsDispatchSlot = false | ||||
|                 SynMemberFlags.IsOverrideOrExplicitImpl = false | ||||
|                 SynMemberFlags.IsFinal = false | ||||
|                 SynMemberFlags.GetterOrSetterIsCompilerGenerated = false | ||||
|                 SynMemberFlags.MemberKind = SynMemberKind.Member | ||||
|             } | ||||
|  | ||||
|         match binding with | ||||
|         | SynBinding (acc, kind, inl, mut, attrs, doc, valData, headPat, ret, expr, range, debugPoint, trivia) -> | ||||
|             let valData = | ||||
|                 match valData with | ||||
|                 | SynValData.SynValData (_, valInfo, _) -> SynValData.SynValData (Some memberFlags, valInfo, None) | ||||
|  | ||||
|             let trivia = | ||||
|                 { trivia with | ||||
|                     LeadingKeyword = SynLeadingKeyword.StaticMember (range0, range0) | ||||
|                 } | ||||
|  | ||||
|             SynBinding (acc, kind, inl, mut, attrs, doc, valData, headPat, ret, expr, range, debugPoint, trivia) | ||||
|  | ||||
|     let makeInstanceMember (binding : SynBinding) : SynBinding = | ||||
|         let memberFlags = | ||||
|             { | ||||
|                 SynMemberFlags.IsInstance = true | ||||
|                 SynMemberFlags.IsDispatchSlot = false | ||||
|                 SynMemberFlags.IsOverrideOrExplicitImpl = true | ||||
|                 SynMemberFlags.IsFinal = false | ||||
|                 SynMemberFlags.GetterOrSetterIsCompilerGenerated = false | ||||
|                 SynMemberFlags.MemberKind = SynMemberKind.Member | ||||
|             } | ||||
|  | ||||
|         match binding with | ||||
|         | SynBinding (acc, kind, inl, mut, attrs, doc, valData, headPat, ret, expr, range, debugPoint, trivia) -> | ||||
|             let valData = | ||||
|                 match valData with | ||||
|                 | SynValData.SynValData (_, valInfo, _) -> SynValData.SynValData (Some memberFlags, valInfo, None) | ||||
|  | ||||
|             let trivia = | ||||
|                 { trivia with | ||||
|                     LeadingKeyword = SynLeadingKeyword.Member range0 | ||||
|                 } | ||||
|  | ||||
|             SynBinding (acc, kind, inl, mut, attrs, doc, valData, headPat, ret, expr, range, debugPoint, trivia) | ||||
							
								
								
									
										50
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynComponentInfo.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										50
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynComponentInfo.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,50 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open Fantomas.FCS.Syntax | ||||
| open Fantomas.FCS.Xml | ||||
| open Fantomas.FCS.Text.Range | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal SynComponentInfo = | ||||
|     let inline createLong (name : LongIdent) = | ||||
|         SynComponentInfo.SynComponentInfo ([], None, [], name, PreXmlDoc.Empty, false, None, range0) | ||||
|  | ||||
|     let inline create (name : Ident) = createLong [ name ] | ||||
|  | ||||
|     let inline withDocString (doc : PreXmlDoc) (i : SynComponentInfo) : SynComponentInfo = | ||||
|         match i with | ||||
|         | SynComponentInfo.SynComponentInfo (attrs, typars, constraints, name, _, postfix, access, range) -> | ||||
|             SynComponentInfo (attrs, typars, constraints, name, doc, postfix, access, range) | ||||
|  | ||||
|     let inline setGenerics (typars : SynTyparDecls option) (i : SynComponentInfo) : SynComponentInfo = | ||||
|         match i with | ||||
|         | SynComponentInfo.SynComponentInfo (attrs, _, constraints, name, doc, postfix, access, range) -> | ||||
|             SynComponentInfo (attrs, typars, constraints, name, doc, postfix, access, range) | ||||
|  | ||||
|     let inline withGenerics (typars : SynTyparDecl list) (i : SynComponentInfo) : SynComponentInfo = | ||||
|         let inner = | ||||
|             if typars.IsEmpty then | ||||
|                 None | ||||
|             else | ||||
|                 Some (SynTyparDecls.PostfixList (typars, [], range0)) | ||||
|  | ||||
|         setGenerics inner i | ||||
|  | ||||
|     let inline setAccessibility (acc : SynAccess option) (i : SynComponentInfo) : SynComponentInfo = | ||||
|         match i with | ||||
|         | SynComponentInfo.SynComponentInfo (attrs, typars, constraints, name, doc, postfix, _, range) -> | ||||
|             SynComponentInfo.SynComponentInfo (attrs, typars, constraints, name, doc, postfix, acc, range) | ||||
|  | ||||
|     let inline withAccessibility (acc : SynAccess) (i : SynComponentInfo) : SynComponentInfo = | ||||
|         setAccessibility (Some acc) i | ||||
|  | ||||
|     let inline addAttributes (attrs : SynAttribute list) (i : SynComponentInfo) : SynComponentInfo = | ||||
|         match i with | ||||
|         | SynComponentInfo.SynComponentInfo (oldAttrs, typars, constraints, name, doc, postfix, acc, range) -> | ||||
|             let attrs = | ||||
|                 { | ||||
|                     SynAttributeList.Attributes = attrs | ||||
|                     SynAttributeList.Range = range0 | ||||
|                 } | ||||
|  | ||||
|             SynComponentInfo.SynComponentInfo ((attrs :: oldAttrs), typars, constraints, name, doc, postfix, acc, range) | ||||
							
								
								
									
										10
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynConst.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										10
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynConst.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,10 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open Fantomas.FCS.Syntax | ||||
| open Fantomas.FCS.Text.Range | ||||
|  | ||||
| [<AutoOpen>] | ||||
| module internal SynConstExt = | ||||
|     type SynConst with | ||||
|         static member Create (s : string) : SynConst = | ||||
|             SynConst.String (s, SynStringKind.Regular, range0) | ||||
							
								
								
									
										365
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										365
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,365 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open Fantomas.FCS.Syntax | ||||
| open Fantomas.FCS.SyntaxTrivia | ||||
| open Fantomas.FCS.Text.Range | ||||
|  | ||||
| [<AutoOpen>] | ||||
| module internal SynExprExtensions = | ||||
|     type SynExpr with | ||||
|         static member CreateConst (s : string) : SynExpr = | ||||
|             SynExpr.Const (SynConst.Create s, range0) | ||||
|  | ||||
|         static member CreateConst () : SynExpr = SynExpr.Const (SynConst.Unit, range0) | ||||
|  | ||||
|         static member CreateConst (b : bool) : SynExpr = SynExpr.Const (SynConst.Bool b, range0) | ||||
|  | ||||
|         static member CreateConst (c : char) : SynExpr = | ||||
|             // apparent Myriad bug: `IndexOf '?'` gets formatted as `IndexOf ?` which is clearly wrong | ||||
|             SynExpr.App ( | ||||
|                 ExprAtomicFlag.NonAtomic, | ||||
|                 false, | ||||
|                 SynExpr.Ident (Ident.create "char"), | ||||
|                 SynExpr.CreateConst (int c), | ||||
|                 range0 | ||||
|             ) | ||||
|             |> fun e -> SynExpr.Paren (e, range0, Some range0, range0) | ||||
|  | ||||
|         static member CreateConst (i : int32) : SynExpr = | ||||
|             SynExpr.Const (SynConst.Int32 i, range0) | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal SynExpr = | ||||
|  | ||||
|     /// {f} {x} | ||||
|     let applyFunction (f : SynExpr) (x : SynExpr) : SynExpr = | ||||
|         SynExpr.App (ExprAtomicFlag.NonAtomic, false, f, x, range0) | ||||
|  | ||||
|     /// {f} {x} | ||||
|     let inline applyTo (x : SynExpr) (f : SynExpr) : SynExpr = applyFunction f x | ||||
|  | ||||
|     let inline private createAppInfix (f : SynExpr) (x : SynExpr) = | ||||
|         SynExpr.App (ExprAtomicFlag.NonAtomic, true, f, x, range0) | ||||
|  | ||||
|     let inline createLongIdent'' (ident : SynLongIdent) : SynExpr = | ||||
|         SynExpr.LongIdent (false, ident, None, range0) | ||||
|  | ||||
|     let inline createLongIdent' (ident : Ident list) : SynExpr = | ||||
|         createLongIdent'' (SynLongIdent.create ident) | ||||
|  | ||||
|     let inline createLongIdent (ident : string list) : SynExpr = | ||||
|         createLongIdent' (ident |> List.map Ident.create) | ||||
|  | ||||
|     /// {expr} |> {func} | ||||
|     let pipeThroughFunction (func : SynExpr) (expr : SynExpr) : SynExpr = | ||||
|         createAppInfix (createLongIdent'' SynLongIdent.pipe) expr |> applyTo func | ||||
|  | ||||
|     /// if {cond} then {trueBranch} else {falseBranch} | ||||
|     /// Note that this function puts the trueBranch last, for pipelining convenience: | ||||
|     /// we assume that the `else` branch is more like an error case and is less interesting. | ||||
|     let ifThenElse (cond : SynExpr) (falseBranch : SynExpr) (trueBranch : SynExpr) : SynExpr = | ||||
|         SynExpr.IfThenElse ( | ||||
|             cond, | ||||
|             trueBranch, | ||||
|             Some falseBranch, | ||||
|             DebugPointAtBinding.Yes range0, | ||||
|             false, | ||||
|             range0, | ||||
|             { | ||||
|                 IfKeyword = range0 | ||||
|                 IsElif = false | ||||
|                 ThenKeyword = range0 | ||||
|                 ElseKeyword = Some range0 | ||||
|                 IfToThenRange = range0 | ||||
|             } | ||||
|         ) | ||||
|  | ||||
|     /// try {body} with | {exc} as exc -> {handler} | ||||
|     let pipeThroughTryWith (exc : SynPat) (handler : SynExpr) (body : SynExpr) : SynExpr = | ||||
|         let clause = | ||||
|             SynMatchClause.create (SynPat.As (exc, SynPat.named "exc", range0)) handler | ||||
|  | ||||
|         SynExpr.TryWith ( | ||||
|             body, | ||||
|             [ clause ], | ||||
|             range0, | ||||
|             DebugPointAtTry.Yes range0, | ||||
|             DebugPointAtWith.Yes range0, | ||||
|             { | ||||
|                 TryKeyword = range0 | ||||
|                 TryToWithRange = range0 | ||||
|                 WithKeyword = range0 | ||||
|                 WithToEndRange = range0 | ||||
|             } | ||||
|         ) | ||||
|  | ||||
|     /// {a} = {b} | ||||
|     let equals (a : SynExpr) (b : SynExpr) = | ||||
|         createAppInfix (createLongIdent'' SynLongIdent.eq) a |> applyTo b | ||||
|  | ||||
|     /// {a} && {b} | ||||
|     let booleanAnd (a : SynExpr) (b : SynExpr) = | ||||
|         createAppInfix (createLongIdent'' SynLongIdent.booleanAnd) a |> applyTo b | ||||
|  | ||||
|     /// {a} || {b} | ||||
|     let booleanOr (a : SynExpr) (b : SynExpr) = | ||||
|         createAppInfix (createLongIdent'' SynLongIdent.booleanOr) a |> applyTo b | ||||
|  | ||||
|     /// {a} + {b} | ||||
|     let plus (a : SynExpr) (b : SynExpr) = | ||||
|         createAppInfix (createLongIdent'' SynLongIdent.plus) a |> applyTo b | ||||
|  | ||||
|     /// {a} * {b} | ||||
|     let times (a : SynExpr) (b : SynExpr) = | ||||
|         createAppInfix (createLongIdent'' SynLongIdent.times) a |> applyTo b | ||||
|  | ||||
|     let rec stripOptionalParen (expr : SynExpr) : SynExpr = | ||||
|         match expr with | ||||
|         | SynExpr.Paren (expr, _, _, _) -> stripOptionalParen expr | ||||
|         | expr -> expr | ||||
|  | ||||
|     let dotGet (field : string) (obj : SynExpr) : SynExpr = | ||||
|         SynExpr.DotGet ( | ||||
|             obj, | ||||
|             range0, | ||||
|             SynLongIdent.SynLongIdent (id = [ Ident.create field ], dotRanges = [], trivia = [ None ]), | ||||
|             range0 | ||||
|         ) | ||||
|  | ||||
|     /// {obj}.{meth} {arg} | ||||
|     let callMethodArg (meth : string) (arg : SynExpr) (obj : SynExpr) : SynExpr = dotGet meth obj |> applyTo arg | ||||
|  | ||||
|     /// {obj}.{meth}() | ||||
|     let callMethod (meth : string) (obj : SynExpr) : SynExpr = | ||||
|         callMethodArg meth (SynExpr.CreateConst ()) obj | ||||
|  | ||||
|     let typeApp (types : SynType list) (operand : SynExpr) = | ||||
|         SynExpr.TypeApp (operand, range0, types, List.replicate (types.Length - 1) range0, Some range0, range0, range0) | ||||
|  | ||||
|     /// {obj}.{meth}<types,...>() | ||||
|     let callGenericMethod (meth : SynLongIdent) (types : SynType list) (obj : SynExpr) : SynExpr = | ||||
|         SynExpr.DotGet (obj, range0, meth, range0) | ||||
|         |> typeApp types | ||||
|         |> applyTo (SynExpr.CreateConst ()) | ||||
|  | ||||
|     /// {obj}.{meth}<ty>() | ||||
|     let callGenericMethod' (meth : string) (ty : string) (obj : SynExpr) : SynExpr = | ||||
|         callGenericMethod (SynLongIdent.createS meth) [ SynType.createLongIdent' [ ty ] ] obj | ||||
|  | ||||
|     let inline index (property : SynExpr) (obj : SynExpr) : SynExpr = | ||||
|         SynExpr.DotIndexedGet (obj, property, range0, range0) | ||||
|  | ||||
|     let inline arrayIndexRange (start : SynExpr option) (endRange : SynExpr option) (arr : SynExpr) : SynExpr = | ||||
|         SynExpr.DotIndexedGet ( | ||||
|             arr, | ||||
|             (SynExpr.IndexRange (start, range0, endRange, range0, range0, range0)), | ||||
|             range0, | ||||
|             range0 | ||||
|         ) | ||||
|  | ||||
|     let inline paren (e : SynExpr) : SynExpr = | ||||
|         SynExpr.Paren (e, range0, Some range0, range0) | ||||
|  | ||||
|     /// (fun {varName} -> {body}) | ||||
|     let createLambda (varName : string) (body : SynExpr) : SynExpr = | ||||
|         let parsedDataPat = [ SynPat.named varName ] | ||||
|  | ||||
|         SynExpr.Lambda ( | ||||
|             false, | ||||
|             false, | ||||
|             SynSimplePats.create [ SynSimplePat.createId (Ident.create varName) ], | ||||
|             body, | ||||
|             Some (parsedDataPat, body), | ||||
|             range0, | ||||
|             { | ||||
|                 ArrowRange = Some range0 | ||||
|             } | ||||
|         ) | ||||
|         |> paren | ||||
|  | ||||
|     let createThunk (body : SynExpr) : SynExpr = | ||||
|         SynExpr.Lambda ( | ||||
|             false, | ||||
|             false, | ||||
|             SynSimplePats.create [], | ||||
|             body, | ||||
|             Some ([ SynPat.unit ], body), | ||||
|             range0, | ||||
|             { | ||||
|                 ArrowRange = Some range0 | ||||
|             } | ||||
|         ) | ||||
|         |> paren | ||||
|  | ||||
|     let inline createIdent (s : string) : SynExpr = SynExpr.Ident (Ident (s, range0)) | ||||
|  | ||||
|     let inline createIdent' (i : Ident) : SynExpr = SynExpr.Ident i | ||||
|  | ||||
|     let tupleNoParen (args : SynExpr list) : SynExpr = | ||||
|         SynExpr.Tuple (false, args, List.replicate (args.Length - 1) range0, range0) | ||||
|  | ||||
|     let inline tuple (args : SynExpr list) = args |> tupleNoParen |> paren | ||||
|  | ||||
|     /// {body} |> fun a -> Async.StartAsTask (a, ?cancellationToken=ct) | ||||
|     let startAsTask (ct : Ident) (body : SynExpr) = | ||||
|         let lambda = | ||||
|             [ | ||||
|                 createIdent "a" | ||||
|                 equals | ||||
|                     (SynExpr.LongIdent (true, SynLongIdent.createS "cancellationToken", None, range0)) | ||||
|                     (createIdent' ct) | ||||
|             ] | ||||
|             |> tuple | ||||
|             |> applyFunction (createLongIdent [ "Async" ; "StartAsTask" ]) | ||||
|             |> createLambda "a" | ||||
|  | ||||
|         pipeThroughFunction lambda body | ||||
|  | ||||
|     let inline createForEach (pat : SynPat) (enumExpr : SynExpr) (body : SynExpr) : SynExpr = | ||||
|         SynExpr.ForEach ( | ||||
|             DebugPointAtFor.No, | ||||
|             DebugPointAtInOrTo.No, | ||||
|             SeqExprOnly.SeqExprOnly false, | ||||
|             true, | ||||
|             pat, | ||||
|             enumExpr, | ||||
|             body, | ||||
|             range0 | ||||
|         ) | ||||
|  | ||||
|     let inline createLet (bindings : SynBinding list) (body : SynExpr) : SynExpr = | ||||
|         SynExpr.LetOrUse (false, false, bindings, body, range0, SynExprLetOrUseTrivia.empty) | ||||
|  | ||||
|     let inline createDo (body : SynExpr) : SynExpr = SynExpr.Do (body, range0) | ||||
|  | ||||
|     let inline createMatch (matchOn : SynExpr) (cases : SynMatchClause list) : SynExpr = | ||||
|         SynExpr.Match ( | ||||
|             DebugPointAtBinding.Yes range0, | ||||
|             matchOn, | ||||
|             cases, | ||||
|             range0, | ||||
|             { | ||||
|                 MatchKeyword = range0 | ||||
|                 WithKeyword = range0 | ||||
|             } | ||||
|         ) | ||||
|  | ||||
|     let typeAnnotate (ty : SynType) (expr : SynExpr) : SynExpr = SynExpr.Typed (expr, ty, range0) | ||||
|  | ||||
|     let inline createNew (ty : SynType) (args : SynExpr) : SynExpr = | ||||
|         SynExpr.New (false, ty, paren args, range0) | ||||
|  | ||||
|     let inline createWhile (cond : SynExpr) (body : SynExpr) : SynExpr = | ||||
|         SynExpr.While (DebugPointAtWhile.Yes range0, cond, body, range0) | ||||
|  | ||||
|     let inline createNull () : SynExpr = SynExpr.Null range0 | ||||
|  | ||||
|     let reraise : SynExpr = createIdent "reraise" |> applyTo (SynExpr.CreateConst ()) | ||||
|  | ||||
|     let sequential (exprs : SynExpr list) : SynExpr = | ||||
|         exprs | ||||
|         |> List.reduce (fun a b -> SynExpr.Sequential (DebugPointAtSequential.SuppressNeither, false, a, b, range0)) | ||||
|  | ||||
|     let listLiteral (elts : SynExpr list) : SynExpr = | ||||
|         SynExpr.ArrayOrListComputed (false, sequential elts, range0) | ||||
|  | ||||
|     let arrayLiteral (elts : SynExpr list) : SynExpr = | ||||
|         SynExpr.ArrayOrListComputed (true, sequential elts, range0) | ||||
|  | ||||
|     /// {compExpr} { {lets} ; return {ret} } | ||||
|     let createCompExpr (compExpr : string) (retBody : SynExpr) (lets : CompExprBinding list) : SynExpr = | ||||
|         let retStatement = SynExpr.YieldOrReturn ((false, true), retBody, range0) | ||||
|  | ||||
|         let contents : SynExpr = | ||||
|             (retStatement, List.rev lets) | ||||
|             ||> List.fold (fun state binding -> | ||||
|                 match binding with | ||||
|                 | LetBang (lhs, rhs) -> | ||||
|                     SynExpr.LetOrUseBang ( | ||||
|                         DebugPointAtBinding.Yes range0, | ||||
|                         false, | ||||
|                         true, | ||||
|                         SynPat.named lhs, | ||||
|                         rhs, | ||||
|                         [], | ||||
|                         state, | ||||
|                         range0, | ||||
|                         { | ||||
|                             EqualsRange = Some range0 | ||||
|                         } | ||||
|                     ) | ||||
|                 | Let (lhs, rhs) -> createLet [ SynBinding.basic [ Ident.create lhs ] [] rhs ] state | ||||
|                 | Use (lhs, rhs) -> | ||||
|                     SynExpr.LetOrUse ( | ||||
|                         false, | ||||
|                         true, | ||||
|                         [ SynBinding.basic [ Ident.create lhs ] [] rhs ], | ||||
|                         state, | ||||
|                         range0, | ||||
|                         { | ||||
|                             SynExprLetOrUseTrivia.InKeyword = None | ||||
|                         } | ||||
|                     ) | ||||
|                 | Do body -> sequential [ SynExpr.Do (body, range0) ; state ] | ||||
|             ) | ||||
|  | ||||
|         applyFunction (createIdent compExpr) (SynExpr.ComputationExpr (false, contents, range0)) | ||||
|  | ||||
|     /// {expr} |> Async.AwaitTask | ||||
|     let awaitTask (expr : SynExpr) : SynExpr = | ||||
|         expr |> pipeThroughFunction (createLongIdent [ "Async" ; "AwaitTask" ]) | ||||
|  | ||||
|     /// {ident}.ToString () | ||||
|     /// with special casing for some types like DateTime | ||||
|     let toString (ty : SynType) (ident : SynExpr) = | ||||
|         match ty with | ||||
|         | DateOnly -> ident |> callMethodArg "ToString" (SynExpr.CreateConst "yyyy-MM-dd") | ||||
|         | DateTime -> ident |> callMethodArg "ToString" (SynExpr.CreateConst "yyyy-MM-ddTHH:mm:ss") | ||||
|         | _ -> callMethod "ToString" ident | ||||
|  | ||||
|     let upcast' (ty : SynType) (e : SynExpr) = SynExpr.Upcast (e, ty, range0) | ||||
|  | ||||
|     /// {ident} - {rhs} | ||||
|     let minus (ident : SynLongIdent) (rhs : SynExpr) : SynExpr = | ||||
|         createAppInfix (createLongIdent'' SynLongIdent.sub) (createLongIdent'' ident) | ||||
|         |> applyTo rhs | ||||
|  | ||||
|     /// {ident} - {n} | ||||
|     let minusN (ident : SynLongIdent) (n : int) : SynExpr = minus ident (SynExpr.CreateConst n) | ||||
|  | ||||
|     /// {y} > {x} | ||||
|     let greaterThan (x : SynExpr) (y : SynExpr) : SynExpr = | ||||
|         createAppInfix (createLongIdent'' SynLongIdent.gt) y |> applyTo x | ||||
|  | ||||
|     /// {y} < {x} | ||||
|     let lessThan (x : SynExpr) (y : SynExpr) : SynExpr = | ||||
|         createAppInfix (createLongIdent'' SynLongIdent.lt) y |> applyTo x | ||||
|  | ||||
|     /// {y} >= {x} | ||||
|     let greaterThanOrEqual (x : SynExpr) (y : SynExpr) : SynExpr = | ||||
|         createAppInfix (createLongIdent'' SynLongIdent.geq) y |> applyTo x | ||||
|  | ||||
|     /// {y} <= {x} | ||||
|     let lessThanOrEqual (x : SynExpr) (y : SynExpr) : SynExpr = | ||||
|         createAppInfix (createLongIdent'' SynLongIdent.leq) y |> applyTo x | ||||
|  | ||||
|     /// {x} :: {y} | ||||
|     let listCons (x : SynExpr) (y : SynExpr) : SynExpr = | ||||
|         createAppInfix | ||||
|             (SynExpr.LongIdent ( | ||||
|                 false, | ||||
|                 SynLongIdent.SynLongIdent ( | ||||
|                     [ Ident.create "op_ColonColon" ], | ||||
|                     [], | ||||
|                     [ Some (IdentTrivia.OriginalNotation "::") ] | ||||
|                 ), | ||||
|                 None, | ||||
|                 range0 | ||||
|             )) | ||||
|             (tupleNoParen [ x ; y ]) | ||||
|         |> paren | ||||
|  | ||||
|     let assign (lhs : SynLongIdent) (rhs : SynExpr) : SynExpr = SynExpr.LongIdentSet (lhs, rhs, range0) | ||||
|  | ||||
|     let assignIndex (lhs : SynExpr) (index : SynExpr) (rhs : SynExpr) : SynExpr = | ||||
|         SynExpr.DotIndexedSet (lhs, index, rhs, range0, range0, range0) | ||||
							
								
								
									
										10
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynExprLetOrUseTrivia.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										10
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynExprLetOrUseTrivia.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,10 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open Fantomas.FCS.SyntaxTrivia | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal SynExprLetOrUseTrivia = | ||||
|     let empty : SynExprLetOrUseTrivia = | ||||
|         { | ||||
|             InKeyword = None | ||||
|         } | ||||
							
								
								
									
										76
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynField.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										76
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynField.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,76 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open Fantomas.FCS.Text.Range | ||||
| open Fantomas.FCS.Syntax | ||||
| open Fantomas.FCS.SyntaxTrivia | ||||
| open Fantomas.FCS.Xml | ||||
|  | ||||
| /// The data needed to reconstitute a single piece of data within a union field, or a single record field. | ||||
| /// This is generic on whether the field is identified. For example, in `type Foo = Blah of int`, the `int` | ||||
| /// field is not identified; whereas in `type Foo = Blah of baz : int`, it is identified. | ||||
| type SynFieldData<'Ident> = | ||||
|     { | ||||
|         /// Attributes on this field. I think you can only get these if this is a *record* field. | ||||
|         Attrs : SynAttribute list | ||||
|         /// The identifier of this field (see docstring for SynFieldData). | ||||
|         Ident : 'Ident | ||||
|         /// The type of the data contained in this field. For example, `type Foo = { Blah : int }` | ||||
|         /// has this being `int`. | ||||
|         Type : SynType | ||||
|     } | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal SynField = | ||||
|     /// Get the useful information out of a SynField. | ||||
|     let extract (SynField (attrs, _, id, fieldType, _, _, _, _, _)) : SynFieldData<Ident option> = | ||||
|         { | ||||
|             Attrs = attrs |> List.collect (fun l -> l.Attributes) | ||||
|             Ident = id | ||||
|             Type = fieldType | ||||
|         } | ||||
|  | ||||
|     let mapIdent<'a, 'b> (f : 'a -> 'b) (x : SynFieldData<'a>) : SynFieldData<'b> = | ||||
|         let ident = f x.Ident | ||||
|  | ||||
|         { | ||||
|             Attrs = x.Attrs | ||||
|             Ident = ident | ||||
|             Type = x.Type | ||||
|         } | ||||
|  | ||||
|     /// Throws if the field has no identifier. | ||||
|     let extractWithIdent (f : SynField) : SynFieldData<Ident> = | ||||
|         f | ||||
|         |> extract | ||||
|         |> mapIdent (fun ident -> | ||||
|             match ident with | ||||
|             | None -> failwith "expected field identifier to have a value, but it did not" | ||||
|             | Some i -> i | ||||
|         ) | ||||
|  | ||||
|     let make (data : SynFieldData<Ident option>) : SynField = | ||||
|         let attrs : SynAttributeList list = | ||||
|             data.Attrs | ||||
|             |> List.map (fun l -> | ||||
|                 { | ||||
|                     Attributes = [ l ] | ||||
|                     Range = range0 | ||||
|                 } | ||||
|             ) | ||||
|  | ||||
|         SynField.SynField ( | ||||
|             attrs, | ||||
|             false, | ||||
|             data.Ident, | ||||
|             data.Type, | ||||
|             false, | ||||
|             PreXmlDoc.Empty, | ||||
|             None, | ||||
|             range0, | ||||
|             SynFieldTrivia.Zero | ||||
|         ) | ||||
|  | ||||
|     let withDocString (doc : PreXmlDoc) (f : SynField) : SynField = | ||||
|         match f with | ||||
|         | SynField (attributes, isStatic, idOpt, fieldType, isMutable, _, accessibility, range, trivia) -> | ||||
|             SynField (attributes, isStatic, idOpt, fieldType, isMutable, doc, accessibility, range, trivia) | ||||
							
								
								
									
										10
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynIdent.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										10
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynIdent.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,10 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open Fantomas.FCS.Syntax | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal SynIdent = | ||||
|     let inline createI (i : Ident) : SynIdent = SynIdent.SynIdent (i, None) | ||||
|  | ||||
|     let inline createS (i : string) : SynIdent = | ||||
|         SynIdent.SynIdent (Ident.create i, None) | ||||
							
								
								
									
										140
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynLongIdent.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										140
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynLongIdent.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,140 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open Fantomas.FCS.SyntaxTrivia | ||||
| open Fantomas.FCS.Text.Range | ||||
| open Fantomas.FCS.Syntax | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal SynLongIdent = | ||||
|  | ||||
|     let geq = | ||||
|         SynLongIdent.SynLongIdent ( | ||||
|             [ Ident.create "op_GreaterThanOrEqual" ], | ||||
|             [], | ||||
|             [ Some (IdentTrivia.OriginalNotation ">=") ] | ||||
|         ) | ||||
|  | ||||
|     let leq = | ||||
|         SynLongIdent.SynLongIdent ( | ||||
|             [ Ident.create "op_LessThanOrEqual" ], | ||||
|             [], | ||||
|             [ Some (IdentTrivia.OriginalNotation "<=") ] | ||||
|         ) | ||||
|  | ||||
|     let gt = | ||||
|         SynLongIdent.SynLongIdent ([ Ident.create "op_GreaterThan" ], [], [ Some (IdentTrivia.OriginalNotation ">") ]) | ||||
|  | ||||
|     let lt = | ||||
|         SynLongIdent.SynLongIdent ([ Ident.create "op_LessThan" ], [], [ Some (IdentTrivia.OriginalNotation "<") ]) | ||||
|  | ||||
|     let sub = | ||||
|         SynLongIdent.SynLongIdent ([ Ident.create "op_Subtraction" ], [], [ Some (IdentTrivia.OriginalNotation "-") ]) | ||||
|  | ||||
|     let eq = | ||||
|         SynLongIdent.SynLongIdent ([ Ident.create "op_Equality" ], [], [ Some (IdentTrivia.OriginalNotation "=") ]) | ||||
|  | ||||
|     let booleanAnd = | ||||
|         SynLongIdent.SynLongIdent ([ Ident.create "op_BooleanAnd" ], [], [ Some (IdentTrivia.OriginalNotation "&&") ]) | ||||
|  | ||||
|     let booleanOr = | ||||
|         SynLongIdent.SynLongIdent ([ Ident.create "op_BooleanOr" ], [], [ Some (IdentTrivia.OriginalNotation "||") ]) | ||||
|  | ||||
|     let plus = | ||||
|         SynLongIdent.SynLongIdent ([ Ident.create "op_Addition" ], [], [ Some (IdentTrivia.OriginalNotation "+") ]) | ||||
|  | ||||
|     let times = | ||||
|         SynLongIdent.SynLongIdent ([ Ident.create "op_Multiply" ], [], [ Some (IdentTrivia.OriginalNotation "*") ]) | ||||
|  | ||||
|     let pipe = | ||||
|         SynLongIdent.SynLongIdent ([ Ident.create "op_PipeRight" ], [], [ Some (IdentTrivia.OriginalNotation "|>") ]) | ||||
|  | ||||
|     let toString (sli : SynLongIdent) : string = | ||||
|         sli.LongIdent |> List.map _.idText |> String.concat "." | ||||
|  | ||||
|     let create (ident : LongIdent) : SynLongIdent = | ||||
|         let commas = | ||||
|             match ident with | ||||
|             | [] -> [] | ||||
|             | _ :: commas -> commas |> List.map (fun _ -> range0) | ||||
|  | ||||
|         SynLongIdent.SynLongIdent (ident, commas, List.replicate ident.Length None) | ||||
|  | ||||
|     let inline createI (i : Ident) : SynLongIdent = create [ i ] | ||||
|  | ||||
|     let inline createS (s : string) : SynLongIdent = createI (Ident (s, range0)) | ||||
|  | ||||
|     let inline createS' (s : string list) : SynLongIdent = | ||||
|         create (s |> List.map (fun i -> Ident (i, range0))) | ||||
|  | ||||
|     let isUnit (ident : SynLongIdent) : bool = | ||||
|         match ident.LongIdent with | ||||
|         | [ i ] when System.String.Equals (i.idText, "unit", System.StringComparison.OrdinalIgnoreCase) -> true | ||||
|         | _ -> false | ||||
|  | ||||
|     let isList (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 isArray (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 isOption (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 isChoice (ident : SynLongIdent) : bool = | ||||
|         match ident.LongIdent with | ||||
|         | [ i ] when System.String.Equals (i.idText, "Choice", System.StringComparison.Ordinal) -> true | ||||
|         // TODO: consider Microsoft.FSharp.Choice or whatever it is | ||||
|         | _ -> false | ||||
|  | ||||
|     let isNullable (ident : SynLongIdent) : bool = | ||||
|         match ident.LongIdent |> List.map _.idText with | ||||
|         | [ "System" ; "Nullable" ] | ||||
|         | [ "Nullable" ] -> true | ||||
|         | _ -> false | ||||
|  | ||||
|     let isResponse (ident : SynLongIdent) : bool = | ||||
|         match ident.LongIdent |> List.map _.idText with | ||||
|         | [ "Response" ] | ||||
|         | [ "RestEase" ; "Response" ] -> true | ||||
|         | _ -> false | ||||
|  | ||||
|     let isMap (ident : SynLongIdent) : bool = | ||||
|         match ident.LongIdent |> List.map _.idText with | ||||
|         | [ "Map" ] -> true | ||||
|         | _ -> false | ||||
|  | ||||
|     let isReadOnlyDictionary (ident : SynLongIdent) : bool = | ||||
|         match ident.LongIdent |> List.map _.idText with | ||||
|         | [ "IReadOnlyDictionary" ] | ||||
|         | [ "Generic" ; "IReadOnlyDictionary" ] | ||||
|         | [ "Collections" ; "Generic" ; "IReadOnlyDictionary" ] | ||||
|         | [ "System" ; "Collections" ; "Generic" ; "IReadOnlyDictionary" ] -> true | ||||
|         | _ -> false | ||||
|  | ||||
|     let isDictionary (ident : SynLongIdent) : bool = | ||||
|         match ident.LongIdent |> List.map _.idText with | ||||
|         | [ "Dictionary" ] | ||||
|         | [ "Generic" ; "Dictionary" ] | ||||
|         | [ "Collections" ; "Generic" ; "Dictionary" ] | ||||
|         | [ "System" ; "Collections" ; "Generic" ; "Dictionary" ] -> true | ||||
|         | _ -> false | ||||
|  | ||||
|     let isIDictionary (ident : SynLongIdent) : bool = | ||||
|         match ident.LongIdent |> List.map _.idText with | ||||
|         | [ "IDictionary" ] | ||||
|         | [ "Generic" ; "IDictionary" ] | ||||
|         | [ "Collections" ; "Generic" ; "IDictionary" ] | ||||
|         | [ "System" ; "Collections" ; "Generic" ; "IDictionary" ] -> true | ||||
|         | _ -> false | ||||
							
								
								
									
										24
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynMatchClause.fs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										24
									
								
								WoofWare.Myriad.Plugins/SynExpr/SynMatchClause.fs
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,24 @@ | ||||
| namespace WoofWare.Myriad.Plugins | ||||
|  | ||||
| open Fantomas.FCS.Syntax | ||||
| open Fantomas.FCS.Text.Range | ||||
|  | ||||
| [<RequireQualifiedAccess>] | ||||
| module internal SynMatchClause = | ||||
|     let create (lhs : SynPat) (rhs : SynExpr) : SynMatchClause = | ||||
|         SynMatchClause.SynMatchClause ( | ||||
|             lhs, | ||||
|             None, | ||||
|             rhs, | ||||
|             range0, | ||||
|             DebugPointAtTarget.Yes, | ||||
|             { | ||||
|                 ArrowRange = Some range0 | ||||
|                 BarRange = Some range0 | ||||
|             } | ||||
|         ) | ||||
|  | ||||
|     let withWhere (where : SynExpr) (m : SynMatchClause) : SynMatchClause = | ||||
|         match m with | ||||
|         | SynMatchClause (synPat, _, resultExpr, range, debugPointAtTarget, synMatchClauseTrivia) -> | ||||
|             SynMatchClause (synPat, Some where, resultExpr, range, debugPointAtTarget, synMatchClauseTrivia) | ||||
Some files were not shown because too many files have changed in this diff Show More
		Reference in New Issue
	
	Block a user