Compare commits

...

8 Commits

Author SHA1 Message Date
Patrick Stevens
81b7e5361d Another grand refactor (#150) 2024-05-30 20:34:53 +01:00
Patrick Stevens
94b88a4143 Reduce duplication (#149) 2024-05-30 14:28:56 +01:00
Patrick Stevens
ed3ffecb52 Fix and test GitHub release script (#148) 2024-05-30 12:32:40 +00:00
Patrick Stevens
c696dcf31f Fix curl failing logic (#147) 2024-05-30 11:35:30 +00:00
Patrick Stevens
d5bb2726d3 Tighten the tagging logic (#146) 2024-05-30 11:28:43 +00:00
Patrick Stevens
f17290d0f1 Check generation of files is accurate (#145) 2024-05-30 12:10:49 +01:00
Patrick Stevens
35cd94cba1 Add JSON serialisation of DUs (#144) 2024-05-30 12:00:55 +01:00
Patrick Stevens
1b3eb03380 NerdBank.GitVersioning heights (#143) 2024-05-29 00:44:16 +01:00
30 changed files with 1735 additions and 1807 deletions

View File

@@ -1,3 +1,4 @@
# yaml-language-server: $schema=https://raw.githubusercontent.com/SchemaStore/schemastore/master/src/schemas/json/github-workflow.json
name: .NET name: .NET
on: on:
@@ -86,6 +87,27 @@ jobs:
- name: Run Fantomas - name: Run Fantomas
run: nix run .#fantomas -- --check . run: nix run .#fantomas -- --check .
check-accurate-generations:
runs-on: ubuntu-latest
steps:
- name: Checkout
uses: actions/checkout@v4
with:
fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
- name: Install Nix
uses: cachix/install-nix-action@V27
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
- name: Whitespace change
run: "echo ' ' >> ConsumePlugin/List.fs"
- name: Generate code
run: nix develop --command dotnet build
- name: Run Fantomas
run: nix run .#fantomas -- .
- name: Verify there is no diff
run: git diff --name-only --no-color --exit-code
check-nix-format: check-nix-format:
runs-on: ubuntu-latest runs-on: ubuntu-latest
steps: steps:
@@ -174,8 +196,27 @@ jobs:
# Verify that there is exactly one nupkg in the artifact that would be NuGet published # 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 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: all-required-checks-complete:
needs: [check-dotnet-format, check-nix-format, build, build-nix, linkcheck, flake-check, analyzers, nuget-pack, expected-pack] needs: [check-dotnet-format, check-nix-format, check-accurate-generations, build, build-nix, linkcheck, flake-check, analyzers, nuget-pack, expected-pack, github-release-plugin-dry-run]
runs-on: ubuntu-latest runs-on: ubuntu-latest
steps: steps:
- run: echo "All required checks complete." - run: echo "All required checks complete."

View File

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

View File

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

View File

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

View File

@@ -13,7 +13,7 @@ namespace ConsumePlugin
module InnerType = module InnerType =
/// Parse from a JSON node. /// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : InnerType = let jsonParse (node : System.Text.Json.Nodes.JsonNode) : InnerType =
let Thing = let arg_0 =
(match node.[(Literals.something)] with (match node.[(Literals.something)] with
| null -> | null ->
raise ( raise (
@@ -26,7 +26,7 @@ module InnerType =
.GetValue<string> () .GetValue<string> ()
{ {
Thing = Thing Thing = arg_0
} }
namespace ConsumePlugin namespace ConsumePlugin
@@ -36,7 +36,7 @@ namespace ConsumePlugin
module JsonRecordType = module JsonRecordType =
/// Parse from a JSON node. /// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordType = let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordType =
let F = let arg_5 =
(match node.["f"] with (match node.["f"] with
| null -> | null ->
raise ( raise (
@@ -49,7 +49,7 @@ module JsonRecordType =
|> Seq.map (fun elt -> elt.AsValue().GetValue<int> ()) |> Seq.map (fun elt -> elt.AsValue().GetValue<int> ())
|> Array.ofSeq |> Array.ofSeq
let E = let arg_4 =
(match node.["e"] with (match node.["e"] with
| null -> | null ->
raise ( raise (
@@ -62,7 +62,7 @@ module JsonRecordType =
|> Seq.map (fun elt -> elt.AsValue().GetValue<string> ()) |> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
|> Array.ofSeq |> Array.ofSeq
let D = let arg_3 =
InnerType.jsonParse ( InnerType.jsonParse (
match node.["d"] with match node.["d"] with
| null -> | null ->
@@ -74,7 +74,7 @@ module JsonRecordType =
| v -> v | v -> v
) )
let C = let arg_2 =
(match node.["hi"] with (match node.["hi"] with
| null -> | null ->
raise ( raise (
@@ -87,7 +87,7 @@ module JsonRecordType =
|> Seq.map (fun elt -> elt.AsValue().GetValue<int> ()) |> Seq.map (fun elt -> elt.AsValue().GetValue<int> ())
|> List.ofSeq |> List.ofSeq
let B = let arg_1 =
(match node.["another-thing"] with (match node.["another-thing"] with
| null -> | null ->
raise ( raise (
@@ -99,7 +99,7 @@ module JsonRecordType =
.AsValue() .AsValue()
.GetValue<string> () .GetValue<string> ()
let A = let arg_0 =
(match node.["a"] with (match node.["a"] with
| null -> | null ->
raise ( raise (
@@ -112,12 +112,12 @@ module JsonRecordType =
.GetValue<int> () .GetValue<int> ()
{ {
A = A A = arg_0
B = B B = arg_1
C = C C = arg_2
D = D D = arg_3
E = E E = arg_4
F = F F = arg_5
} }
namespace ConsumePlugin namespace ConsumePlugin
@@ -129,9 +129,9 @@ module ToGetExtensionMethodJsonParseExtension =
/// Parse from a JSON node. /// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : ToGetExtensionMethod = static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : ToGetExtensionMethod =
let Whiskey = System.Numerics.BigInteger.Parse (node.["whiskey"].ToJsonString ()) let arg_20 = System.Numerics.BigInteger.Parse (node.["whiskey"].ToJsonString ())
let Victor = let arg_19 =
(match node.["victor"] with (match node.["victor"] with
| null -> | null ->
raise ( raise (
@@ -143,7 +143,7 @@ module ToGetExtensionMethodJsonParseExtension =
.AsValue() .AsValue()
.GetValue<System.Char> () .GetValue<System.Char> ()
let Uniform = let arg_18 =
(match node.["uniform"] with (match node.["uniform"] with
| null -> | null ->
raise ( raise (
@@ -155,7 +155,7 @@ module ToGetExtensionMethodJsonParseExtension =
.AsValue() .AsValue()
.GetValue<System.Decimal> () .GetValue<System.Decimal> ()
let Tango = let arg_17 =
(match node.["tango"] with (match node.["tango"] with
| null -> | null ->
raise ( raise (
@@ -167,7 +167,7 @@ module ToGetExtensionMethodJsonParseExtension =
.AsValue() .AsValue()
.GetValue<System.SByte> () .GetValue<System.SByte> ()
let Quebec = let arg_16 =
(match node.["quebec"] with (match node.["quebec"] with
| null -> | null ->
raise ( raise (
@@ -179,7 +179,7 @@ module ToGetExtensionMethodJsonParseExtension =
.AsValue() .AsValue()
.GetValue<System.Byte> () .GetValue<System.Byte> ()
let Papa = let arg_15 =
(match node.["papa"] with (match node.["papa"] with
| null -> | null ->
raise ( raise (
@@ -191,7 +191,7 @@ module ToGetExtensionMethodJsonParseExtension =
.AsValue() .AsValue()
.GetValue<System.Byte> () .GetValue<System.Byte> ()
let Oscar = let arg_14 =
(match node.["oscar"] with (match node.["oscar"] with
| null -> | null ->
raise ( raise (
@@ -203,7 +203,7 @@ module ToGetExtensionMethodJsonParseExtension =
.AsValue() .AsValue()
.GetValue<System.SByte> () .GetValue<System.SByte> ()
let November = let arg_13 =
(match node.["november"] with (match node.["november"] with
| null -> | null ->
raise ( raise (
@@ -215,7 +215,7 @@ module ToGetExtensionMethodJsonParseExtension =
.AsValue() .AsValue()
.GetValue<System.UInt16> () .GetValue<System.UInt16> ()
let Mike = let arg_12 =
(match node.["mike"] with (match node.["mike"] with
| null -> | null ->
raise ( raise (
@@ -227,7 +227,7 @@ module ToGetExtensionMethodJsonParseExtension =
.AsValue() .AsValue()
.GetValue<System.Int16> () .GetValue<System.Int16> ()
let Lima = let arg_11 =
(match node.["lima"] with (match node.["lima"] with
| null -> | null ->
raise ( raise (
@@ -239,7 +239,7 @@ module ToGetExtensionMethodJsonParseExtension =
.AsValue() .AsValue()
.GetValue<System.UInt32> () .GetValue<System.UInt32> ()
let Kilo = let arg_10 =
(match node.["kilo"] with (match node.["kilo"] with
| null -> | null ->
raise ( raise (
@@ -251,7 +251,7 @@ module ToGetExtensionMethodJsonParseExtension =
.AsValue() .AsValue()
.GetValue<System.Int32> () .GetValue<System.Int32> ()
let Juliette = let arg_9 =
(match node.["juliette"] with (match node.["juliette"] with
| null -> | null ->
raise ( raise (
@@ -263,7 +263,7 @@ module ToGetExtensionMethodJsonParseExtension =
.AsValue() .AsValue()
.GetValue<System.UInt32> () .GetValue<System.UInt32> ()
let India = let arg_8 =
(match node.["india"] with (match node.["india"] with
| null -> | null ->
raise ( raise (
@@ -275,7 +275,7 @@ module ToGetExtensionMethodJsonParseExtension =
.AsValue() .AsValue()
.GetValue<int> () .GetValue<int> ()
let Hotel = let arg_7 =
(match node.["hotel"] with (match node.["hotel"] with
| null -> | null ->
raise ( raise (
@@ -287,7 +287,7 @@ module ToGetExtensionMethodJsonParseExtension =
.AsValue() .AsValue()
.GetValue<System.UInt64> () .GetValue<System.UInt64> ()
let Golf = let arg_6 =
(match node.["golf"] with (match node.["golf"] with
| null -> | null ->
raise ( raise (
@@ -299,7 +299,7 @@ module ToGetExtensionMethodJsonParseExtension =
.AsValue() .AsValue()
.GetValue<System.Int64> () .GetValue<System.Int64> ()
let Foxtrot = let arg_5 =
(match node.["foxtrot"] with (match node.["foxtrot"] with
| null -> | null ->
raise ( raise (
@@ -311,7 +311,7 @@ module ToGetExtensionMethodJsonParseExtension =
.AsValue() .AsValue()
.GetValue<System.Double> () .GetValue<System.Double> ()
let Echo = let arg_4 =
(match node.["echo"] with (match node.["echo"] with
| null -> | null ->
raise ( raise (
@@ -323,7 +323,7 @@ module ToGetExtensionMethodJsonParseExtension =
.AsValue() .AsValue()
.GetValue<System.Single> () .GetValue<System.Single> ()
let Delta = let arg_3 =
(match node.["delta"] with (match node.["delta"] with
| null -> | null ->
raise ( raise (
@@ -335,7 +335,7 @@ module ToGetExtensionMethodJsonParseExtension =
.AsValue() .AsValue()
.GetValue<System.Single> () .GetValue<System.Single> ()
let Charlie = let arg_2 =
(match node.["charlie"] with (match node.["charlie"] with
| null -> | null ->
raise ( raise (
@@ -347,7 +347,7 @@ module ToGetExtensionMethodJsonParseExtension =
.AsValue() .AsValue()
.GetValue<float> () .GetValue<float> ()
let Bravo = let arg_1 =
(match node.["bravo"] with (match node.["bravo"] with
| null -> | null ->
raise ( raise (
@@ -360,7 +360,7 @@ module ToGetExtensionMethodJsonParseExtension =
.GetValue<string> () .GetValue<string> ()
|> System.Uri |> System.Uri
let Alpha = let arg_0 =
(match node.["alpha"] with (match node.["alpha"] with
| null -> | null ->
raise ( raise (
@@ -373,25 +373,25 @@ module ToGetExtensionMethodJsonParseExtension =
.GetValue<string> () .GetValue<string> ()
{ {
Alpha = Alpha Alpha = arg_0
Bravo = Bravo Bravo = arg_1
Charlie = Charlie Charlie = arg_2
Delta = Delta Delta = arg_3
Echo = Echo Echo = arg_4
Foxtrot = Foxtrot Foxtrot = arg_5
Golf = Golf Golf = arg_6
Hotel = Hotel Hotel = arg_7
India = India India = arg_8
Juliette = Juliette Juliette = arg_9
Kilo = Kilo Kilo = arg_10
Lima = Lima Lima = arg_11
Mike = Mike Mike = arg_12
November = November November = arg_13
Oscar = Oscar Oscar = arg_14
Papa = Papa Papa = arg_15
Quebec = Quebec Quebec = arg_16
Tango = Tango Tango = arg_17
Uniform = Uniform Uniform = arg_18
Victor = Victor Victor = arg_19
Whiskey = Whiskey Whiskey = arg_20
} }

View File

@@ -19,9 +19,9 @@ type internal PublicTypeMock =
/// An implementation where every method throws. /// An implementation where every method throws.
static member Empty : PublicTypeMock = static member Empty : PublicTypeMock =
{ {
Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem3 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem3 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
} }
interface IPublicType with interface IPublicType with
@@ -44,9 +44,9 @@ type public PublicTypeInternalFalseMock =
/// An implementation where every method throws. /// An implementation where every method throws.
static member Empty : PublicTypeInternalFalseMock = static member Empty : PublicTypeInternalFalseMock =
{ {
Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem3 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem3 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
} }
interface IPublicTypeInternalFalse with interface IPublicTypeInternalFalse with
@@ -68,8 +68,8 @@ type internal InternalTypeMock =
/// An implementation where every method throws. /// An implementation where every method throws.
static member Empty : InternalTypeMock = static member Empty : InternalTypeMock =
{ {
Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
} }
interface InternalType with interface InternalType with
@@ -90,8 +90,8 @@ type private PrivateTypeMock =
/// An implementation where every method throws. /// An implementation where every method throws.
static member Empty : PrivateTypeMock = static member Empty : PrivateTypeMock =
{ {
Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
} }
interface PrivateType with interface PrivateType with
@@ -112,8 +112,8 @@ type private PrivateTypeInternalFalseMock =
/// An implementation where every method throws. /// An implementation where every method throws.
static member Empty : PrivateTypeInternalFalseMock = static member Empty : PrivateTypeInternalFalseMock =
{ {
Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
} }
interface PrivateTypeInternalFalse with interface PrivateTypeInternalFalse with
@@ -133,7 +133,7 @@ type internal VeryPublicTypeMock<'a, 'b> =
/// An implementation where every method throws. /// An implementation where every method throws.
static member Empty () : VeryPublicTypeMock<'a, 'b> = static member Empty () : VeryPublicTypeMock<'a, 'b> =
{ {
Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
} }
interface VeryPublicType<'a, 'b> with interface VeryPublicType<'a, 'b> with
@@ -157,12 +157,12 @@ type internal CurriedMock<'a> =
/// An implementation where every method throws. /// An implementation where every method throws.
static member Empty () : CurriedMock<'a> = static member Empty () : CurriedMock<'a> =
{ {
Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem3 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem3 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem4 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem4 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem5 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem5 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem6 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem6 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
} }
interface Curried<'a> with interface Curried<'a> with
@@ -196,8 +196,8 @@ type internal TypeWithInterfaceMock =
static member Empty : TypeWithInterfaceMock = static member Empty : TypeWithInterfaceMock =
{ {
Dispose = (fun _ -> ()) Dispose = (fun _ -> ())
Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function"))
} }
interface TypeWithInterface with interface TypeWithInterface with

View File

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

View File

@@ -149,6 +149,37 @@ module JsonRecordTypeWithBothJsonSerializeExtension =
) )
node :> _ 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 namespace ConsumePlugin
@@ -160,7 +191,7 @@ module InnerTypeWithBothJsonParseExtension =
/// Parse from a JSON node. /// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : InnerTypeWithBoth = static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : InnerTypeWithBoth =
let ConcreteDict = let arg_4 =
(match node.["concreteDict"] with (match node.["concreteDict"] with
| null -> | null ->
raise ( raise (
@@ -178,7 +209,7 @@ module InnerTypeWithBothJsonParseExtension =
|> Seq.map System.Collections.Generic.KeyValuePair |> Seq.map System.Collections.Generic.KeyValuePair
|> System.Collections.Generic.Dictionary |> System.Collections.Generic.Dictionary
let Dict = let arg_3 =
(match node.["dict"] with (match node.["dict"] with
| null -> | null ->
raise ( raise (
@@ -195,7 +226,7 @@ module InnerTypeWithBothJsonParseExtension =
) )
|> dict |> dict
let ReadOnlyDict = let arg_2 =
(match node.["readOnlyDict"] with (match node.["readOnlyDict"] with
| null -> | null ->
raise ( raise (
@@ -217,7 +248,7 @@ module InnerTypeWithBothJsonParseExtension =
) )
|> readOnlyDict |> readOnlyDict
let Map = let arg_1 =
(match node.["map"] with (match node.["map"] with
| null -> | null ->
raise ( raise (
@@ -234,7 +265,7 @@ module InnerTypeWithBothJsonParseExtension =
) )
|> Map.ofSeq |> Map.ofSeq
let Thing = let arg_0 =
(match node.[("it's-a-me")] with (match node.[("it's-a-me")] with
| null -> | null ->
raise ( raise (
@@ -248,11 +279,11 @@ module InnerTypeWithBothJsonParseExtension =
|> System.Guid.Parse |> System.Guid.Parse
{ {
Thing = Thing Thing = arg_0
Map = Map Map = arg_1
ReadOnlyDict = ReadOnlyDict ReadOnlyDict = arg_2
Dict = Dict Dict = arg_3
ConcreteDict = ConcreteDict ConcreteDict = arg_4
} }
namespace ConsumePlugin namespace ConsumePlugin
@@ -264,7 +295,7 @@ module JsonRecordTypeWithBothJsonParseExtension =
/// Parse from a JSON node. /// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordTypeWithBoth = static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordTypeWithBoth =
let F = let arg_5 =
(match node.["f"] with (match node.["f"] with
| null -> | null ->
raise ( raise (
@@ -277,7 +308,7 @@ module JsonRecordTypeWithBothJsonParseExtension =
|> Seq.map (fun elt -> elt.AsValue().GetValue<int> ()) |> Seq.map (fun elt -> elt.AsValue().GetValue<int> ())
|> Array.ofSeq |> Array.ofSeq
let E = let arg_4 =
(match node.["e"] with (match node.["e"] with
| null -> | null ->
raise ( raise (
@@ -290,7 +321,7 @@ module JsonRecordTypeWithBothJsonParseExtension =
|> Seq.map (fun elt -> elt.AsValue().GetValue<string> ()) |> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
|> Array.ofSeq |> Array.ofSeq
let D = let arg_3 =
InnerTypeWithBoth.jsonParse ( InnerTypeWithBoth.jsonParse (
match node.["d"] with match node.["d"] with
| null -> | null ->
@@ -302,7 +333,7 @@ module JsonRecordTypeWithBothJsonParseExtension =
| v -> v | v -> v
) )
let C = let arg_2 =
(match node.["c"] with (match node.["c"] with
| null -> | null ->
raise ( raise (
@@ -315,7 +346,7 @@ module JsonRecordTypeWithBothJsonParseExtension =
|> Seq.map (fun elt -> elt.AsValue().GetValue<int> ()) |> Seq.map (fun elt -> elt.AsValue().GetValue<int> ())
|> List.ofSeq |> List.ofSeq
let B = let arg_1 =
(match node.["b"] with (match node.["b"] with
| null -> | null ->
raise ( raise (
@@ -327,7 +358,7 @@ module JsonRecordTypeWithBothJsonParseExtension =
.AsValue() .AsValue()
.GetValue<string> () .GetValue<string> ()
let A = let arg_0 =
(match node.["a"] with (match node.["a"] with
| null -> | null ->
raise ( raise (
@@ -340,10 +371,10 @@ module JsonRecordTypeWithBothJsonParseExtension =
.GetValue<int> () .GetValue<int> ()
{ {
A = A A = arg_0
B = B B = arg_1
C = C C = arg_2
D = D D = arg_3
E = E E = arg_4
F = F F = arg_5
} }

View File

@@ -13,7 +13,7 @@ namespace ConsumePlugin
module JwtVaultAuthResponse = module JwtVaultAuthResponse =
/// Parse from a JSON node. /// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultAuthResponse = let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultAuthResponse =
let NumUses = let arg_10 =
(match node.["num_uses"] with (match node.["num_uses"] with
| null -> | null ->
raise ( raise (
@@ -25,7 +25,7 @@ module JwtVaultAuthResponse =
.AsValue() .AsValue()
.GetValue<int> () .GetValue<int> ()
let Orphan = let arg_9 =
(match node.["orphan"] with (match node.["orphan"] with
| null -> | null ->
raise ( raise (
@@ -37,7 +37,7 @@ module JwtVaultAuthResponse =
.AsValue() .AsValue()
.GetValue<bool> () .GetValue<bool> ()
let EntityId = let arg_8 =
(match node.["entity_id"] with (match node.["entity_id"] with
| null -> | null ->
raise ( raise (
@@ -49,7 +49,7 @@ module JwtVaultAuthResponse =
.AsValue() .AsValue()
.GetValue<string> () .GetValue<string> ()
let TokenType = let arg_7 =
(match node.["token_type"] with (match node.["token_type"] with
| null -> | null ->
raise ( raise (
@@ -61,7 +61,7 @@ module JwtVaultAuthResponse =
.AsValue() .AsValue()
.GetValue<string> () .GetValue<string> ()
let Renewable = let arg_6 =
(match node.["renewable"] with (match node.["renewable"] with
| null -> | null ->
raise ( raise (
@@ -73,7 +73,7 @@ module JwtVaultAuthResponse =
.AsValue() .AsValue()
.GetValue<bool> () .GetValue<bool> ()
let LeaseDuration = let arg_5 =
(match node.["lease_duration"] with (match node.["lease_duration"] with
| null -> | null ->
raise ( raise (
@@ -85,7 +85,7 @@ module JwtVaultAuthResponse =
.AsValue() .AsValue()
.GetValue<int> () .GetValue<int> ()
let IdentityPolicies = let arg_4 =
(match node.["identity_policies"] with (match node.["identity_policies"] with
| null -> | null ->
raise ( raise (
@@ -98,7 +98,7 @@ module JwtVaultAuthResponse =
|> Seq.map (fun elt -> elt.AsValue().GetValue<string> ()) |> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
|> List.ofSeq |> List.ofSeq
let TokenPolicies = let arg_3 =
(match node.["token_policies"] with (match node.["token_policies"] with
| null -> | null ->
raise ( raise (
@@ -111,7 +111,7 @@ module JwtVaultAuthResponse =
|> Seq.map (fun elt -> elt.AsValue().GetValue<string> ()) |> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
|> List.ofSeq |> List.ofSeq
let Policies = let arg_2 =
(match node.["policies"] with (match node.["policies"] with
| null -> | null ->
raise ( raise (
@@ -124,7 +124,7 @@ module JwtVaultAuthResponse =
|> Seq.map (fun elt -> elt.AsValue().GetValue<string> ()) |> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
|> List.ofSeq |> List.ofSeq
let Accessor = let arg_1 =
(match node.["accessor"] with (match node.["accessor"] with
| null -> | null ->
raise ( raise (
@@ -136,7 +136,7 @@ module JwtVaultAuthResponse =
.AsValue() .AsValue()
.GetValue<string> () .GetValue<string> ()
let ClientToken = let arg_0 =
(match node.["client_token"] with (match node.["client_token"] with
| null -> | null ->
raise ( raise (
@@ -149,17 +149,17 @@ module JwtVaultAuthResponse =
.GetValue<string> () .GetValue<string> ()
{ {
ClientToken = ClientToken ClientToken = arg_0
Accessor = Accessor Accessor = arg_1
Policies = Policies Policies = arg_2
TokenPolicies = TokenPolicies TokenPolicies = arg_3
IdentityPolicies = IdentityPolicies IdentityPolicies = arg_4
LeaseDuration = LeaseDuration LeaseDuration = arg_5
Renewable = Renewable Renewable = arg_6
TokenType = TokenType TokenType = arg_7
EntityId = EntityId EntityId = arg_8
Orphan = Orphan Orphan = arg_9
NumUses = NumUses NumUses = arg_10
} }
namespace ConsumePlugin namespace ConsumePlugin
@@ -169,7 +169,7 @@ namespace ConsumePlugin
module JwtVaultResponse = module JwtVaultResponse =
/// Parse from a JSON node. /// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultResponse = let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultResponse =
let Auth = let arg_4 =
JwtVaultAuthResponse.jsonParse ( JwtVaultAuthResponse.jsonParse (
match node.["auth"] with match node.["auth"] with
| null -> | null ->
@@ -181,7 +181,7 @@ module JwtVaultResponse =
| v -> v | v -> v
) )
let LeaseDuration = let arg_3 =
(match node.["lease_duration"] with (match node.["lease_duration"] with
| null -> | null ->
raise ( raise (
@@ -193,7 +193,7 @@ module JwtVaultResponse =
.AsValue() .AsValue()
.GetValue<int> () .GetValue<int> ()
let Renewable = let arg_2 =
(match node.["renewable"] with (match node.["renewable"] with
| null -> | null ->
raise ( raise (
@@ -205,7 +205,7 @@ module JwtVaultResponse =
.AsValue() .AsValue()
.GetValue<bool> () .GetValue<bool> ()
let LeaseId = let arg_1 =
(match node.["lease_id"] with (match node.["lease_id"] with
| null -> | null ->
raise ( raise (
@@ -217,7 +217,7 @@ module JwtVaultResponse =
.AsValue() .AsValue()
.GetValue<string> () .GetValue<string> ()
let RequestId = let arg_0 =
(match node.["request_id"] with (match node.["request_id"] with
| null -> | null ->
raise ( raise (
@@ -230,11 +230,11 @@ module JwtVaultResponse =
.GetValue<string> () .GetValue<string> ()
{ {
RequestId = RequestId RequestId = arg_0
LeaseId = LeaseId LeaseId = arg_1
Renewable = Renewable Renewable = arg_2
LeaseDuration = LeaseDuration LeaseDuration = arg_3
Auth = Auth Auth = arg_4
} }
namespace ConsumePlugin namespace ConsumePlugin
@@ -244,7 +244,7 @@ namespace ConsumePlugin
module JwtSecretResponse = module JwtSecretResponse =
/// Parse from a JSON node. /// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtSecretResponse = let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtSecretResponse =
let Data8 = let arg_11 =
(match node.["data8"] with (match node.["data8"] with
| null -> | null ->
raise ( raise (
@@ -262,7 +262,7 @@ module JwtSecretResponse =
|> Seq.map System.Collections.Generic.KeyValuePair |> Seq.map System.Collections.Generic.KeyValuePair
|> System.Collections.Generic.Dictionary |> System.Collections.Generic.Dictionary
let Data7 = let arg_10 =
(match node.["data7"] with (match node.["data7"] with
| null -> | null ->
raise ( raise (
@@ -279,7 +279,7 @@ module JwtSecretResponse =
) )
|> Map.ofSeq |> Map.ofSeq
let Data6 = let arg_9 =
(match node.["data6"] with (match node.["data6"] with
| null -> | null ->
raise ( raise (
@@ -296,7 +296,7 @@ module JwtSecretResponse =
) )
|> dict |> dict
let Data5 = let arg_8 =
(match node.["data5"] with (match node.["data5"] with
| null -> | null ->
raise ( raise (
@@ -313,7 +313,7 @@ module JwtSecretResponse =
) )
|> readOnlyDict |> readOnlyDict
let Data4 = let arg_7 =
(match node.["data4"] with (match node.["data4"] with
| null -> | null ->
raise ( raise (
@@ -330,7 +330,7 @@ module JwtSecretResponse =
) )
|> Map.ofSeq |> Map.ofSeq
let Data3 = let arg_6 =
(match node.["data3"] with (match node.["data3"] with
| null -> | null ->
raise ( raise (
@@ -348,7 +348,7 @@ module JwtSecretResponse =
|> Seq.map System.Collections.Generic.KeyValuePair |> Seq.map System.Collections.Generic.KeyValuePair
|> System.Collections.Generic.Dictionary |> System.Collections.Generic.Dictionary
let Data2 = let arg_5 =
(match node.["data2"] with (match node.["data2"] with
| null -> | null ->
raise ( raise (
@@ -365,7 +365,7 @@ module JwtSecretResponse =
) )
|> dict |> dict
let Data = let arg_4 =
(match node.["data"] with (match node.["data"] with
| null -> | null ->
raise ( raise (
@@ -382,7 +382,7 @@ module JwtSecretResponse =
) )
|> readOnlyDict |> readOnlyDict
let LeaseDuration = let arg_3 =
(match node.["lease_duration"] with (match node.["lease_duration"] with
| null -> | null ->
raise ( raise (
@@ -394,7 +394,7 @@ module JwtSecretResponse =
.AsValue() .AsValue()
.GetValue<int> () .GetValue<int> ()
let Renewable = let arg_2 =
(match node.["renewable"] with (match node.["renewable"] with
| null -> | null ->
raise ( raise (
@@ -406,7 +406,7 @@ module JwtSecretResponse =
.AsValue() .AsValue()
.GetValue<bool> () .GetValue<bool> ()
let LeaseId = let arg_1 =
(match node.["lease_id"] with (match node.["lease_id"] with
| null -> | null ->
raise ( raise (
@@ -418,7 +418,7 @@ module JwtSecretResponse =
.AsValue() .AsValue()
.GetValue<string> () .GetValue<string> ()
let RequestId = let arg_0 =
(match node.["request_id"] with (match node.["request_id"] with
| null -> | null ->
raise ( raise (
@@ -431,18 +431,18 @@ module JwtSecretResponse =
.GetValue<string> () .GetValue<string> ()
{ {
RequestId = RequestId RequestId = arg_0
LeaseId = LeaseId LeaseId = arg_1
Renewable = Renewable Renewable = arg_2
LeaseDuration = LeaseDuration LeaseDuration = arg_3
Data = Data Data = arg_4
Data2 = Data2 Data2 = arg_5
Data3 = Data3 Data3 = arg_6
Data4 = Data4 Data4 = arg_7
Data5 = Data5 Data5 = arg_8
Data6 = Data6 Data6 = arg_9
Data7 = Data7 Data7 = arg_10
Data8 = Data8 Data8 = arg_11
} }
namespace ConsumePlugin namespace ConsumePlugin

View File

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

View File

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

View File

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

View File

@@ -3,5 +3,13 @@
"publicReleaseRefSpec": [ "publicReleaseRefSpec": [
"^refs/heads/main$" "^refs/heads/main$"
], ],
"pathFilters": null "pathFilters": [
} ":/README.md",
":/LICENSE",
":/WoofWare.Myriad.Plugins/logo.png",
":/Directory.Build.props",
":/global.json",
"./",
"^./Test"
]
}

View File

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

View File

@@ -274,9 +274,7 @@ module internal HttpClientGenerator =
SynExpr.CreateConstString ("{" + substituteId + "}") SynExpr.CreateConstString ("{" + substituteId + "}")
SynExpr.callMethod "ToString" (SynExpr.CreateIdent varName) SynExpr.callMethod "ToString" (SynExpr.CreateIdent varName)
|> SynExpr.pipeThroughFunction ( |> SynExpr.pipeThroughFunction (
SynExpr.CreateLongIdent ( SynExpr.createLongIdent [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ]
SynLongIdent.Create [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ]
)
) )
]) ])
| _ -> template | _ -> template
@@ -316,12 +314,9 @@ module internal HttpClientGenerator =
let urlSeparator = let urlSeparator =
// apparent Myriad bug: `IndexOf '?'` gets formatted as `IndexOf ?` which is clearly wrong // apparent Myriad bug: `IndexOf '?'` gets formatted as `IndexOf ?` which is clearly wrong
let questionMark = let questionMark =
SynExpr.CreateParen ( SynExpr.CreateConst (SynConst.Int32 63)
SynExpr.CreateApp ( |> SynExpr.applyFunction (SynExpr.CreateIdentString "char")
SynExpr.CreateIdentString "char", |> SynExpr.CreateParen
SynExpr.CreateConst (SynConst.Int32 63)
)
)
let containsQuestion = let containsQuestion =
info.UrlTemplate info.UrlTemplate
@@ -354,9 +349,7 @@ module internal HttpClientGenerator =
SynExpr.toString paramValue.Type (SynExpr.CreateIdent paramValueId) SynExpr.toString paramValue.Type (SynExpr.CreateIdent paramValueId)
|> SynExpr.CreateParen |> SynExpr.CreateParen
|> SynExpr.pipeThroughFunction ( |> SynExpr.pipeThroughFunction (
SynExpr.CreateLongIdent ( SynExpr.createLongIdent [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ]
SynLongIdent.Create [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ]
)
) )
|> SynExpr.CreateParen |> SynExpr.CreateParen
|> SynExpr.plus (SynExpr.plus uri (SynExpr.CreateConstString ("&" + paramKey + "="))) |> SynExpr.plus (SynExpr.plus uri (SynExpr.CreateConstString ("&" + paramKey + "=")))
@@ -365,48 +358,31 @@ module internal HttpClientGenerator =
|> SynExpr.CreateParen |> SynExpr.CreateParen
let requestUri = let requestUri =
let uriIdent = SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Uri" ]) let uriIdent = SynExpr.createLongIdent [ "System" ; "Uri" ]
let baseAddress = SynExpr.createLongIdent [ "client" ; "BaseAddress" ]
let baseAddress = let baseAddress =
SynExpr.CreateLongIdent (SynLongIdent.Create [ "client" ; "BaseAddress" ]) [
SynMatchClause.Create (
let baseAddress = SynPat.CreateNull,
SynExpr.CreateMatch ( None,
baseAddress, match info.BaseAddress with
[ | None ->
SynMatchClause.Create ( [
SynPat.CreateNull, SynExpr.CreateApp (SynExpr.CreateIdentString "nameof", SynExpr.CreateParen baseAddress)
None, SynExpr.CreateConstString
match info.BaseAddress with "No base address was supplied on the type, and no BaseAddress was on the HttpClient."
| None -> ]
SynExpr.CreateApp ( |> SynExpr.CreateParenedTuple
SynExpr.CreateIdentString "raise", |> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "ArgumentNullException" ])
SynExpr.CreateParen ( |> SynExpr.CreateParen
SynExpr.CreateApp ( |> SynExpr.applyFunction (SynExpr.CreateIdentString "raise")
SynExpr.CreateLongIdent ( | Some expr -> SynExpr.CreateApp (uriIdent, expr)
SynLongIdent.Create [ "System" ; "ArgumentNullException" ] )
), SynMatchClause.Create (SynPat.CreateNamed (Ident.Create "v"), None, SynExpr.CreateIdentString "v")
SynExpr.CreateParenedTuple ]
[ |> SynExpr.createMatch baseAddress
SynExpr.CreateApp (
SynExpr.CreateIdentString "nameof",
SynExpr.CreateParen baseAddress
)
SynExpr.CreateConstString
"No base address was supplied on the type, and no BaseAddress was on the HttpClient."
]
)
)
)
| Some expr -> SynExpr.CreateApp (uriIdent, expr)
)
SynMatchClause.Create (
SynPat.CreateNamed (Ident.Create "v"),
None,
SynExpr.CreateIdentString "v"
)
]
)
|> SynExpr.CreateParen |> SynExpr.CreateParen
SynExpr.App ( SynExpr.App (
@@ -421,7 +397,7 @@ module internal HttpClientGenerator =
SynExpr.CreateParenedTuple SynExpr.CreateParenedTuple
[ [
requestUriTrailer requestUriTrailer
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "UriKind" ; "Relative" ]) SynExpr.createLongIdent [ "System" ; "UriKind" ; "Relative" ]
] ]
) )
], ],
@@ -461,10 +437,8 @@ module internal HttpClientGenerator =
[ [
SynExpr.equals SynExpr.equals
(SynExpr.CreateIdentString "Method") (SynExpr.CreateIdentString "Method")
(SynExpr.CreateLongIdent ( (SynExpr.createLongIdent
SynLongIdent.Create [ "System" ; "Net" ; "Http" ; "HttpMethod" ; httpMethodString info.HttpMethod ])
[ "System" ; "Net" ; "Http" ; "HttpMethod" ; httpMethodString info.HttpMethod ]
))
SynExpr.equals (SynExpr.CreateIdentString "RequestUri") (SynExpr.CreateIdentString "uri") SynExpr.equals (SynExpr.CreateIdentString "RequestUri") (SynExpr.CreateIdentString "uri")
] ]
|> SynExpr.CreateParenedTuple |> SynExpr.CreateParenedTuple
@@ -599,9 +573,7 @@ module internal HttpClientGenerator =
"responseString", "responseString",
SynExpr.awaitTask ( SynExpr.awaitTask (
SynExpr.CreateApp ( SynExpr.CreateApp (
SynExpr.CreateLongIdent ( SynExpr.createLongIdent [ "response" ; "Content" ; "ReadAsStringAsync" ],
SynLongIdent.Create [ "response" ; "Content" ; "ReadAsStringAsync" ]
),
SynExpr.CreateIdentString "ct" SynExpr.CreateIdentString "ct"
) )
) )
@@ -612,9 +584,7 @@ module internal HttpClientGenerator =
"responseStream", "responseStream",
SynExpr.awaitTask ( SynExpr.awaitTask (
SynExpr.CreateApp ( SynExpr.CreateApp (
SynExpr.CreateLongIdent ( SynExpr.createLongIdent [ "response" ; "Content" ; "ReadAsStreamAsync" ],
SynLongIdent.Create [ "response" ; "Content" ; "ReadAsStreamAsync" ]
),
SynExpr.CreateIdentString "ct" SynExpr.CreateIdentString "ct"
) )
) )
@@ -625,9 +595,7 @@ module internal HttpClientGenerator =
"jsonNode", "jsonNode",
SynExpr.awaitTask ( SynExpr.awaitTask (
SynExpr.CreateApp ( SynExpr.CreateApp (
SynExpr.CreateLongIdent ( SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ; "ParseAsync" ],
SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ; "ParseAsync" ]
),
SynExpr.CreateParenedTuple SynExpr.CreateParenedTuple
[ [
SynExpr.CreateIdentString "responseStream" SynExpr.CreateIdentString "responseStream"
@@ -644,15 +612,13 @@ module internal HttpClientGenerator =
|> List.map (fun (headerName, callToGetValue) -> |> List.map (fun (headerName, callToGetValue) ->
Do ( Do (
SynExpr.CreateApp ( SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "httpMessage" ; "Headers" ; "Add" ]), SynExpr.createLongIdent [ "httpMessage" ; "Headers" ; "Add" ],
SynExpr.CreateParenedTuple SynExpr.CreateParenedTuple
[ [
headerName headerName
SynExpr.CreateApp ( SynExpr.CreateApp (
SynExpr.CreateLongIdent ( SynExpr.createLongIdent'
SynLongIdent.CreateFromLongIdent [ Ident.Create "this" ; callToGetValue ; Ident.Create "ToString" ],
[ Ident.Create "this" ; callToGetValue ; Ident.Create "ToString" ]
),
SynExpr.CreateConst SynConst.Unit SynExpr.CreateConst SynConst.Unit
) )
] ]
@@ -665,14 +631,14 @@ module internal HttpClientGenerator =
|> List.map (fun (headerName, headerValue) -> |> List.map (fun (headerName, headerValue) ->
Do ( Do (
SynExpr.CreateApp ( SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "httpMessage" ; "Headers" ; "Add" ]), SynExpr.createLongIdent [ "httpMessage" ; "Headers" ; "Add" ],
SynExpr.CreateParenedTuple [ headerName ; headerValue ] SynExpr.CreateParenedTuple [ headerName ; headerValue ]
) )
) )
) )
[ [
yield LetBang ("ct", SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "CancellationToken" ])) yield LetBang ("ct", SynExpr.createLongIdent [ "Async" ; "CancellationToken" ])
yield Let ("uri", requestUri) yield Let ("uri", requestUri)
yield yield
Use ( Use (
@@ -697,7 +663,7 @@ module internal HttpClientGenerator =
"response", "response",
SynExpr.awaitTask ( SynExpr.awaitTask (
SynExpr.CreateApp ( SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "client" ; "SendAsync" ]), SynExpr.createLongIdent [ "client" ; "SendAsync" ],
SynExpr.CreateParenedTuple SynExpr.CreateParenedTuple
[ SynExpr.CreateIdentString "httpMessage" ; SynExpr.CreateIdentString "ct" ] [ SynExpr.CreateIdentString "httpMessage" ; SynExpr.CreateIdentString "ct" ]
) )
@@ -708,7 +674,7 @@ module internal HttpClientGenerator =
Let ( Let (
"response", "response",
SynExpr.CreateApp ( SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "response" ; "EnsureSuccessStatusCode" ]), SynExpr.createLongIdent [ "response" ; "EnsureSuccessStatusCode" ],
SynExpr.CreateConst SynConst.Unit SynExpr.CreateConst SynConst.Unit
) )
) )
@@ -727,24 +693,23 @@ module internal HttpClientGenerator =
|> SynExpr.createCompExpr "async" returnExpr |> SynExpr.createCompExpr "async" returnExpr
|> SynExpr.startAsTask (SynLongIdent.CreateFromLongIdent [ cancellationTokenArg ]) |> SynExpr.startAsTask (SynLongIdent.CreateFromLongIdent [ cancellationTokenArg ])
SynMemberDefn.Member ( SynBinding.SynBinding (
SynBinding.SynBinding ( None,
info.Accessibility, SynBindingKind.Normal,
SynBindingKind.Normal, false,
false, false,
false, [],
[], PreXmlDoc.Empty,
PreXmlDoc.Empty, valData,
valData, headPat,
headPat, None,
None, implementation,
implementation, range0,
range0, DebugPointAtBinding.Yes range0,
DebugPointAtBinding.Yes range0, SynBinding.triviaZero true
SynExpr.synBindingTriviaZero true
),
range0
) )
|> SynBinding.withAccessibility info.Accessibility
|> fun b -> SynMemberDefn.Member (b, range0)
let getHttpAttributes (attrs : SynAttribute list) : HttpAttribute list = let getHttpAttributes (attrs : SynAttribute list) : HttpAttribute list =
attrs attrs
@@ -945,9 +910,7 @@ module internal HttpClientGenerator =
), ),
Some (SynBindingReturnInfo.Create pi.Type), Some (SynBindingReturnInfo.Create pi.Type),
SynExpr.CreateApp ( SynExpr.CreateApp (
SynExpr.CreateLongIdent ( SynExpr.createLongIdent' [ Ident.lowerFirstLetter pi.Identifier ],
SynLongIdent.CreateFromLongIdent [ Ident.lowerFirstLetter pi.Identifier ]
),
SynExpr.CreateConst SynConst.Unit SynExpr.CreateConst SynConst.Unit
), ),
range0, range0,
@@ -1031,43 +994,30 @@ module internal HttpClientGenerator =
None None
) )
let pattern = let pattern = SynLongIdent.CreateString "make"
SynPat.CreateLongIdent (SynLongIdent.CreateString "make", headerArgs @ [ clientCreationArg ])
let returnInfo = let returnInfo =
SynBindingReturnInfo.Create (SynType.LongIdent (SynLongIdent.CreateFromLongIdent interfaceType.Name)) SynType.LongIdent (SynLongIdent.CreateFromLongIdent interfaceType.Name)
let nameWithoutLeadingI = let nameWithoutLeadingI =
List.last interfaceType.Name List.last interfaceType.Name
|> _.idText |> _.idText
|> fun s -> |> fun s ->
if s.StartsWith 'I' then if s.StartsWith 'I' then
s.[1..] s.Substring 1
else else
failwith $"Expected interface type to start with 'I', but was: %s{s}" failwith $"Expected interface type to start with 'I', but was: %s{s}"
let createFunc = let createFunc =
if spec.ExtensionMethods then if spec.ExtensionMethods then
let binding = let binding =
SynBinding.SynBinding ( SynBinding.basic
None, (SynLongIdent.CreateString "make")
SynBindingKind.Normal, (headerArgs @ [ clientCreationArg ])
false, interfaceImpl
false, |> SynBinding.withXmlDoc xmlDoc
[], |> SynBinding.makeStaticMember
xmlDoc, |> SynBinding.withReturnAnnotation returnInfo
valData,
pattern,
Some returnInfo,
interfaceImpl,
range0,
DebugPointAtBinding.NoneAtInvisible,
{
LeadingKeyword = SynLeadingKeyword.StaticMember (range0, range0)
InlineKeyword = None
EqualsRange = Some range0
}
)
let mem = SynMemberDefn.Member (binding, range0) let mem = SynMemberDefn.Member (binding, range0)
@@ -1091,21 +1041,9 @@ module internal HttpClientGenerator =
SynModuleDecl.Types ([ containingType ], range0) SynModuleDecl.Types ([ containingType ], range0)
else else
SynBinding.SynBinding ( SynBinding.basic (SynLongIdent.CreateString "make") (headerArgs @ [ clientCreationArg ]) interfaceImpl
None, |> SynBinding.withXmlDoc xmlDoc
SynBindingKind.Normal, |> SynBinding.withReturnAnnotation returnInfo
false,
false,
[],
xmlDoc,
valData,
pattern,
Some returnInfo,
interfaceImpl,
range0,
DebugPointAtBinding.NoneAtLet,
SynExpr.synBindingTriviaZero false
)
|> List.singleton |> List.singleton
|> SynModuleDecl.CreateLet |> SynModuleDecl.CreateLet

View File

@@ -46,66 +46,31 @@ module internal InterfaceMockGenerator =
) )
|> Set.ofSeq |> Set.ofSeq
let synValData =
{
SynMemberFlags.IsInstance = false
SynMemberFlags.IsDispatchSlot = false
SynMemberFlags.IsOverrideOrExplicitImpl = false
SynMemberFlags.IsFinal = false
SynMemberFlags.GetterOrSetterIsCompilerGenerated = false
SynMemberFlags.MemberKind = SynMemberKind.Member
}
let failwithFun = let failwithFun =
SynExpr.createLambda SynExpr.createLongIdent [ "System" ; "NotImplementedException" ]
"x" |> SynExpr.applyTo (SynExpr.CreateConstString "Unimplemented mock function")
(SynExpr.CreateApp ( |> SynExpr.CreateParen
SynExpr.CreateIdentString "raise", |> SynExpr.applyFunction (SynExpr.CreateIdentString "raise")
SynExpr.CreateParen ( |> SynExpr.createLambda "_"
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "NotImplementedException" ]),
SynExpr.CreateConstString "Unimplemented mock function"
)
)
))
let constructorIdent =
let generics =
interfaceType.Generics
|> Option.map (fun generics -> SynValTyparDecls (Some generics, false))
SynPat.LongIdent (
SynLongIdent.CreateString "Empty",
None,
None, // no generics on the "Empty", only on the return type
SynArgPats.Pats (
if generics.IsNone then
[]
else
[ SynPat.CreateParen (SynPat.CreateConst SynConst.Unit) ]
),
None,
range0
)
let constructorReturnType = let constructorReturnType =
match interfaceType.Generics with match interfaceType.Generics with
| None -> SynType.CreateLongIdent name | None -> SynType.CreateLongIdent name
| Some generics -> | Some generics ->
let generics =
generics.TyparDecls
|> List.map (fun (SynTyparDecl (_, typar)) -> SynType.Var (typar, range0))
SynType.App ( let generics =
SynType.CreateLongIdent name, generics.TyparDecls
Some range0, |> List.map (fun (SynTyparDecl (_, typar)) -> SynType.Var (typar, range0))
generics,
List.replicate (generics.Length - 1) range0, SynType.App (
Some range0, SynType.CreateLongIdent name,
false, Some range0,
range0 generics,
) List.replicate (generics.Length - 1) range0,
|> SynBindingReturnInfo.Create Some range0,
false,
range0
)
let constructorFields = let constructorFields =
let extras = let extras =
@@ -125,26 +90,17 @@ module internal InterfaceMockGenerator =
extras @ nonExtras extras @ nonExtras
let constructor = let constructor =
SynMemberDefn.Member ( SynBinding.basic
SynBinding.SynBinding ( (SynLongIdent.CreateString "Empty")
None, (if interfaceType.Generics.IsNone then
SynBindingKind.Normal, []
false, else
false, [ SynPat.CreateConst SynConst.Unit ])
[], (AstHelper.instantiateRecord constructorFields)
PreXmlDoc.Create " An implementation where every method throws.", |> SynBinding.makeStaticMember
SynValData.SynValData (Some synValData, SynValInfo.Empty, None), |> SynBinding.withXmlDoc (PreXmlDoc.Create " An implementation where every method throws.")
constructorIdent, |> SynBinding.withReturnAnnotation constructorReturnType
Some constructorReturnType, |> fun m -> SynMemberDefn.Member (m, range0)
AstHelper.instantiateRecord constructorFields,
range0,
DebugPointAtBinding.Yes range0,
{ SynExpr.synBindingTriviaZero true with
LeadingKeyword = SynLeadingKeyword.StaticMember (range0, range0)
}
),
range0
)
let fields = let fields =
let extras = let extras =
@@ -255,13 +211,9 @@ module internal InterfaceMockGenerator =
(last, rest) (last, rest)
||> List.fold (fun trail next -> SynExpr.CreateApp (next, trail)) ||> List.fold (fun trail next -> SynExpr.CreateApp (next, trail))
|> fun args -> |> SynExpr.applyFunction (
SynExpr.CreateApp ( SynExpr.createLongIdent' [ Ident.Create "this" ; memberInfo.Identifier ]
SynExpr.CreateLongIdent ( )
SynLongIdent.CreateFromLongIdent [ Ident.Create "this" ; memberInfo.Identifier ]
),
args
)
SynMemberDefn.Member ( SynMemberDefn.Member (
SynBinding.SynBinding ( SynBinding.SynBinding (
@@ -327,78 +279,13 @@ module internal InterfaceMockGenerator =
|> Seq.map (fun inheritance -> |> Seq.map (fun inheritance ->
match inheritance with match inheritance with
| KnownInheritance.IDisposable -> | KnownInheritance.IDisposable ->
let valData =
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
)
]
],
returnInfo =
SynArgInfo.SynArgInfo (attributes = [], optional = false, ident = None)
),
thisIdOpt = None
)
let headArgs = [ SynPat.Const (SynConst.Unit, range0) ]
let headPat =
SynPat.LongIdent (
SynLongIdent.CreateFromLongIdent [ Ident.Create "this" ; Ident.Create "Dispose" ],
None,
None,
SynArgPats.Pats headArgs,
None,
range0
)
let binding = let binding =
SynBinding.SynBinding ( SynBinding.basic
None, (SynLongIdent.CreateFromLongIdent [ Ident.Create "this" ; Ident.Create "Dispose" ])
SynBindingKind.Normal, [ SynPat.CreateConst SynConst.Unit ]
false, (SynExpr.CreateApp (SynExpr.createLongIdent [ "this" ; "Dispose" ], SynExpr.CreateUnit))
false, |> SynBinding.withReturnAnnotation (SynType.Unit ())
[], |> SynBinding.makeInstanceMember
PreXmlDoc.Empty,
valData,
headPat,
Some (
SynBindingReturnInfo.SynBindingReturnInfo (
SynType.Unit (),
range0,
[],
SynBindingReturnInfoTrivia.Zero
)
),
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "this" ; "Dispose" ]),
SynExpr.CreateUnit
),
range0,
DebugPointAtBinding.Yes range0,
{
LeadingKeyword = SynLeadingKeyword.Member range0
InlineKeyword = None
EqualsRange = Some range0
}
)
let mem = SynMemberDefn.Member (binding, range0) let mem = SynMemberDefn.Member (binding, range0)
@@ -473,7 +360,7 @@ module internal InterfaceMockGenerator =
|> _.idText |> _.idText
|> fun s -> |> fun s ->
if s.StartsWith 'I' && s.Length > 1 && Char.IsUpper s.[1] then if s.StartsWith 'I' && s.Length > 1 && Char.IsUpper s.[1] then
s.[1..] s.Substring 1
else else
s s
|> fun s -> s + "Mock" |> fun s -> s + "Mock"

View File

@@ -31,24 +31,20 @@ module internal JsonParseGenerator =
let assertNotNull (propertyName : SynExpr) (indexed : SynExpr) = let assertNotNull (propertyName : SynExpr) (indexed : SynExpr) =
let raiseExpr = let raiseExpr =
SynExpr.CreateApp ( SynExpr.CreateApp (
SynExpr.CreateIdentString "raise", SynExpr.CreateApp (
SynExpr.CreateParen ( SynExpr.CreateIdentString "sprintf",
SynExpr.CreateApp ( SynExpr.CreateConstString "Required key '%s' not found on JSON object"
SynExpr.CreateLongIdent ( ),
SynLongIdent.Create [ "System" ; "Collections" ; "Generic" ; "KeyNotFoundException" ] SynExpr.CreateParen propertyName
), )
SynExpr.CreateParen ( |> SynExpr.CreateParen
SynExpr.CreateApp ( |> SynExpr.applyFunction (
SynExpr.CreateApp ( SynExpr.CreateLongIdent (
SynExpr.CreateIdentString "sprintf", SynLongIdent.Create [ "System" ; "Collections" ; "Generic" ; "KeyNotFoundException" ]
SynExpr.CreateConstString "Required key '%s' not found on JSON object"
),
SynExpr.CreateParen propertyName
)
)
)
) )
) )
|> SynExpr.CreateParen
|> SynExpr.applyFunction (SynExpr.CreateIdentString "raise")
SynExpr.CreateMatch ( SynExpr.CreateMatch (
indexed, indexed,
@@ -139,37 +135,19 @@ module internal JsonParseGenerator =
/// fun kvp -> let key = {key(kvp)} in let value = {value(kvp)} in (key, value)) /// fun kvp -> let key = {key(kvp)} in let value = {value(kvp)} in (key, value))
/// The inputs will be fed with appropriate SynExprs to apply them to the `kvp.Key` and `kvp.Value` args. /// The inputs will be fed with appropriate SynExprs to apply them to the `kvp.Key` and `kvp.Value` args.
let dictionaryMapper (key : SynExpr -> SynExpr) (value : SynExpr -> SynExpr) : SynExpr = let dictionaryMapper (key : SynExpr -> SynExpr) (value : SynExpr -> SynExpr) : SynExpr =
let keyArg = let keyArg = SynExpr.createLongIdent [ "kvp" ; "Key" ] |> SynExpr.CreateParen
SynExpr.CreateLongIdent (SynLongIdent.Create [ "kvp" ; "Key" ])
|> SynExpr.CreateParen
let valueArg = let valueArg = SynExpr.createLongIdent [ "kvp" ; "Value" ] |> SynExpr.CreateParen
SynExpr.CreateLongIdent (SynLongIdent.Create [ "kvp" ; "Value" ])
|> SynExpr.CreateParen
SynExpr.LetOrUse ( SynExpr.CreateTuple [ SynExpr.CreateIdentString "key" ; SynExpr.CreateIdentString "value" ]
false, |> SynExpr.createLet
false, [
SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create "value"), expr = value valueArg)
]
|> SynExpr.createLet
[ [
SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create "key"), expr = key keyArg) SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create "key"), expr = key keyArg)
], ]
SynExpr.LetOrUse (
false,
false,
[
SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create "value"), expr = value valueArg)
],
SynExpr.CreateTuple [ SynExpr.CreateIdentString "key" ; SynExpr.CreateIdentString "value" ],
range0,
{
InKeyword = None
}
),
range0,
{
InKeyword = None
}
)
|> SynExpr.createLambda "kvp" |> SynExpr.createLambda "kvp"
/// A conforming JSON object has only strings as keys. But it would be reasonable to allow the user /// A conforming JSON object has only strings as keys. But it would be reasonable to allow the user
@@ -199,25 +177,19 @@ module internal JsonParseGenerator =
| DateOnly -> | DateOnly ->
node node
|> asValueGetValue propertyName "string" |> asValueGetValue propertyName "string"
|> SynExpr.pipeThroughFunction ( |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "DateOnly" ; "Parse" ])
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "DateOnly" ; "Parse" ])
)
| Uri -> | Uri ->
node node
|> asValueGetValue propertyName "string" |> asValueGetValue propertyName "string"
|> SynExpr.pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Uri" ])) |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "Uri" ])
| Guid -> | Guid ->
node node
|> asValueGetValue propertyName "string" |> asValueGetValue propertyName "string"
|> SynExpr.pipeThroughFunction ( |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "Guid" ; "Parse" ])
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Guid" ; "Parse" ])
)
| DateTime -> | DateTime ->
node node
|> asValueGetValue propertyName "string" |> asValueGetValue propertyName "string"
|> SynExpr.pipeThroughFunction ( |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "DateTime" ; "Parse" ])
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "DateTime" ; "Parse" ])
)
| NumberType typeName -> | NumberType typeName ->
let basic = asValueGetValue propertyName typeName node let basic = asValueGetValue propertyName typeName node
@@ -237,9 +209,7 @@ module internal JsonParseGenerator =
let handler = let handler =
asValueGetValue propertyName "string" node asValueGetValue propertyName "string" node
|> SynExpr.pipeThroughFunction ( |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' (parseFunction typeName))
SynExpr.CreateLongIdent (SynLongIdent.CreateFromLongIdent (parseFunction typeName))
)
|> SynExpr.ifThenElse |> SynExpr.ifThenElse
(SynExpr.equals (SynExpr.equals
option option
@@ -325,10 +295,10 @@ module internal JsonParseGenerator =
) )
|> SynExpr.pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "Map" ; "ofSeq" ])) |> SynExpr.pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "Map" ; "ofSeq" ]))
| BigInt -> | BigInt ->
SynExpr.CreateApp ( node
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Numerics" ; "BigInteger" ; "Parse" ]), |> SynExpr.callMethod "ToJsonString"
SynExpr.CreateParen (node |> SynExpr.callMethod "ToJsonString") |> SynExpr.CreateParen
) |> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Numerics" ; "BigInteger" ; "Parse" ])
| _ -> | _ ->
// Let's just hope that we've also got our own type annotation! // Let's just hope that we've also got our own type annotation!
let typeName = let typeName =
@@ -357,183 +327,30 @@ module internal JsonParseGenerator =
| [ _ ; "JsonNumberHandling" ; "Serialization" ; "Json" ; "Text" ; "System" ] -> true | [ _ ; "JsonNumberHandling" ; "Serialization" ; "Json" ; "Text" ; "System" ] -> true
| _ -> false | _ -> false
let createMaker (spec : JsonParseOutputSpec) (typeName : LongIdent) (fields : SynField list) = /// `populateNode` will be inserted before we return the `node` variable.
///
/// That is, we give you access to a `JsonNode` called `node`,
/// and you must return a `typeName`.
let scaffolding (spec : JsonParseOutputSpec) (typeName : LongIdent) (functionBody : SynExpr) : SynModuleDecl =
let xmlDoc = PreXmlDoc.Create " Parse from a JSON node." let xmlDoc = PreXmlDoc.Create " Parse from a JSON node."
let returnInfo = let returnInfo = SynType.LongIdent (SynLongIdent.CreateFromLongIdent typeName)
SynBindingReturnInfo.Create (SynType.LongIdent (SynLongIdent.CreateFromLongIdent typeName))
let inputArg = Ident.Create "node" let inputArg = Ident.Create "node"
let functionName = Ident.Create "jsonParse" let functionName = Ident.Create "jsonParse"
let inputVal = let arg =
let memberFlags = SynPat.CreateNamed inputArg
if spec.ExtensionMethods then |> SynPat.annotateType (
{ SynType.LongIdent (SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
SynMemberFlags.IsInstance = false
SynMemberFlags.IsDispatchSlot = false
SynMemberFlags.IsOverrideOrExplicitImpl = false
SynMemberFlags.IsFinal = false
SynMemberFlags.GetterOrSetterIsCompilerGenerated = false
SynMemberFlags.MemberKind = SynMemberKind.Member
}
|> Some
else
None
let thisIdOpt = if spec.ExtensionMethods then None else Some inputArg
SynValData.SynValData (
memberFlags,
SynValInfo.SynValInfo ([ [ SynArgInfo.CreateId functionName ] ], SynArgInfo.Empty),
thisIdOpt
)
let assignments =
fields
|> List.map (fun (SynField (attrs, _, id, fieldType, _, _, _, _, _)) ->
let id =
match id with
| None -> failwith "didn't get an ID on field"
| Some id -> id
let attrs = attrs |> List.collect (fun l -> l.Attributes)
let propertyNameAttr =
attrs
|> List.tryFind (fun attr ->
attr.TypeName.AsString.EndsWith ("JsonPropertyName", StringComparison.Ordinal)
)
let options =
(JsonParseOption.None, attrs)
||> List.fold (fun options attr ->
if attr.TypeName.AsString.EndsWith ("JsonNumberHandling", StringComparison.Ordinal) then
let qualifiedEnumValue =
match SynExpr.stripOptionalParen attr.ArgExpr with
| SynExpr.LongIdent (_, SynLongIdent (ident, _, _), _, _) when
isJsonNumberHandling ident
->
// Make sure it's fully qualified
SynExpr.CreateLongIdent (
SynLongIdent.Create
[
"System"
"Text"
"Json"
"Serialization"
"JsonNumberHandling"
"AllowReadingFromString"
]
)
| _ -> attr.ArgExpr
{
JsonNumberHandlingArg = Some qualifiedEnumValue
}
else
options
)
let propertyName =
match propertyNameAttr with
| None ->
let sb = StringBuilder id.idText.Length
sb.Append (Char.ToLowerInvariant id.idText.[0]) |> ignore
if id.idText.Length > 1 then
sb.Append id.idText.[1..] |> ignore
sb.ToString () |> SynConst.CreateString |> SynExpr.CreateConst
| Some name -> name.ArgExpr
let pattern =
SynPat.LongIdent (
SynLongIdent.CreateFromLongIdent [ id ],
None,
None,
SynArgPats.Empty,
None,
range0
)
SynBinding.Let (
isInline = false,
isMutable = false,
expr = createParseRhs options propertyName fieldType,
valData = inputVal,
pattern = pattern
)
)
let finalConstruction =
fields
|> List.map (fun (SynField (_, _, id, _, _, _, _, _, _)) ->
let id =
match id with
| None -> failwith "Expected record field to have an identifying name"
| Some id -> id
(SynLongIdent.CreateFromLongIdent [ id ], true),
Some (SynExpr.CreateLongIdent (SynLongIdent.CreateFromLongIdent [ id ]))
)
|> AstHelper.instantiateRecord
let assignments =
(finalConstruction, assignments)
||> List.fold (fun final assignment ->
SynExpr.LetOrUse (
false,
false,
[ assignment ],
final,
range0,
{
InKeyword = None
}
)
)
let pattern =
SynPat.LongIdent (
SynLongIdent.CreateFromLongIdent [ functionName ],
None,
None,
SynArgPats.Pats
[
SynPat.CreateTyped (
SynPat.CreateNamed inputArg,
SynType.LongIdent (
SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
)
)
|> SynPat.CreateParen
],
None,
range0
) )
if spec.ExtensionMethods then if spec.ExtensionMethods then
let binding = let binding =
SynBinding.SynBinding ( SynBinding.basic (SynLongIdent.CreateFromLongIdent [ functionName ]) [ arg ] functionBody
None, |> SynBinding.makeStaticMember
SynBindingKind.Normal, |> SynBinding.withXmlDoc xmlDoc
false, |> SynBinding.withReturnAnnotation returnInfo
false,
[],
xmlDoc,
inputVal,
pattern,
Some returnInfo,
assignments,
range0,
DebugPointAtBinding.NoneAtInvisible,
{
LeadingKeyword = SynLeadingKeyword.StaticMember (range0, range0)
InlineKeyword = None
EqualsRange = Some range0
}
)
let mem = SynMemberDefn.Member (binding, range0) let mem = SynMemberDefn.Member (binding, range0)
@@ -553,74 +370,156 @@ module internal JsonParseGenerator =
SynModuleDecl.Types ([ containingType ], range0) SynModuleDecl.Types ([ containingType ], range0)
else else
let binding = SynBinding.basic (SynLongIdent.CreateFromLongIdent [ functionName ]) [ arg ] functionBody
SynBinding.Let ( |> SynBinding.withXmlDoc xmlDoc
isInline = false, |> SynBinding.withReturnAnnotation returnInfo
isMutable = false, |> List.singleton
xmldoc = xmlDoc, |> SynModuleDecl.CreateLet
returnInfo = returnInfo,
expr = assignments,
valData = inputVal,
pattern = pattern
)
SynModuleDecl.CreateLet [ binding ] let createMaker (spec : JsonParseOutputSpec) (typeName : LongIdent) (fields : SynFieldData<Ident> list) =
let assignments =
fields
|> List.mapi (fun i fieldData ->
let propertyNameAttr =
fieldData.Attrs
|> List.tryFind (fun attr ->
attr.TypeName.AsString.EndsWith ("JsonPropertyName", StringComparison.Ordinal)
)
let createRecordModule (namespaceId : LongIdent) (spec : JsonParseOutputSpec) (typeDefn : SynTypeDefn) = let options =
(JsonParseOption.None, fieldData.Attrs)
||> List.fold (fun options attr ->
if attr.TypeName.AsString.EndsWith ("JsonNumberHandling", StringComparison.Ordinal) then
let qualifiedEnumValue =
match SynExpr.stripOptionalParen attr.ArgExpr with
| SynExpr.LongIdent (_, SynLongIdent (ident, _, _), _, _) when
isJsonNumberHandling ident
->
// Make sure it's fully qualified
SynExpr.createLongIdent
[
"System"
"Text"
"Json"
"Serialization"
"JsonNumberHandling"
"AllowReadingFromString"
]
| _ -> attr.ArgExpr
{
JsonNumberHandlingArg = Some qualifiedEnumValue
}
else
options
)
let propertyName =
match propertyNameAttr with
| None ->
let sb = StringBuilder fieldData.Ident.idText.Length
sb.Append (Char.ToLowerInvariant fieldData.Ident.idText.[0]) |> ignore
if fieldData.Ident.idText.Length > 1 then
sb.Append fieldData.Ident.idText.[1..] |> ignore
sb.ToString () |> SynConst.CreateString |> SynExpr.CreateConst
| Some name -> name.ArgExpr
createParseRhs options propertyName fieldData.Type
|> SynBinding.basic (SynLongIdent.CreateString $"arg_%i{i}") []
)
let finalConstruction =
fields
|> List.mapi (fun i fieldData ->
(SynLongIdent.CreateFromLongIdent [ fieldData.Ident ], true),
Some (SynExpr.CreateLongIdent (SynLongIdent.CreateString $"arg_%i{i}"))
)
|> AstHelper.instantiateRecord
let assignments =
(finalConstruction, assignments)
||> List.fold (fun final assignment -> SynExpr.createLet [ assignment ] final)
assignments |> scaffolding spec typeName
(*
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : FirstDu =
let ty =
match node.["type"] with
| null -> raise (System.Collections.Generic.KeyNotFoundException ())
| v -> v.GetValue<string> ()
match ty with
| "emptyCase" -> FirstDu.EmptyCase
| "case1" ->
FirstDu.Case1
| "case2" -> FirstDu.Case2
| _ -> failwithf "Unrecognised case name: %s" ty
*)
let createModule (namespaceId : LongIdent) (spec : JsonParseOutputSpec) (typeDefn : SynTypeDefn) =
let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) = let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) =
typeDefn typeDefn
let (SynComponentInfo (_attributes, _typeParams, _constraints, recordId, _, _preferPostfix, _access, _)) = let (SynComponentInfo (_attributes, _typeParams, _constraints, ident, _, _preferPostfix, _access, _)) =
synComponentInfo synComponentInfo
match synTypeDefnRepr with let attributes =
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, recordFields, _recordRange), _) -> if spec.ExtensionMethods then
[ SynAttributeList.Create SynAttribute.autoOpen ]
else
[
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
SynAttributeList.Create SynAttribute.compilationRepresentation
]
let decls = [ createMaker spec recordId recordFields ] let xmlDoc =
let fullyQualified = ident |> Seq.map (fun i -> i.idText) |> String.concat "."
let attributes = let description =
if spec.ExtensionMethods then if spec.ExtensionMethods then
[ SynAttributeList.Create SynAttribute.autoOpen ] "extension members"
else else
[ "methods"
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
SynAttributeList.Create SynAttribute.compilationRepresentation
]
let xmlDoc = $" Module containing JSON parsing %s{description} for the %s{fullyQualified} type"
let fullyQualified = recordId |> Seq.map (fun i -> i.idText) |> String.concat "." |> PreXmlDoc.Create
let description = let moduleName =
if spec.ExtensionMethods then if spec.ExtensionMethods then
"extension members" match ident with
else | [] -> failwith "unexpectedly got an empty identifier for record name"
"methods" | ident ->
let expanded =
List.last ident
|> fun i -> i.idText
|> fun s -> s + "JsonParseExtension"
|> Ident.Create
$" Module containing JSON parsing %s{description} for the %s{fullyQualified} type" List.take (List.length ident - 1) ident @ [ expanded ]
|> PreXmlDoc.Create else
ident
let moduleName = let info =
if spec.ExtensionMethods then SynComponentInfo.Create (moduleName, attributes = attributes, xmldoc = xmlDoc)
match recordId with
| [] -> failwith "unexpectedly got an empty identifier for record name"
| recordId ->
let expanded =
List.last recordId
|> fun i -> i.idText
|> fun s -> s + "JsonParseExtension"
|> Ident.Create
List.take (List.length recordId - 1) recordId @ [ expanded ] let decls =
else match synTypeDefnRepr with
recordId | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, fields, _range), _) ->
let fields = fields |> List.map SynField.extractWithIdent
[ createMaker spec ident fields ]
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (_accessibility, cases, _range), _) ->
let cases = cases |> List.map SynUnionCase.extract
// [ createMaker spec ident cases ]
failwith "Unions are not yet supported"
| _ -> failwithf "Not a record or union type"
let info = let mdl = SynModuleDecl.CreateNestedModule (info, decls)
SynComponentInfo.Create (moduleName, attributes = attributes, xmldoc = xmlDoc)
let mdl = SynModuleDecl.CreateNestedModule (info, decls) SynModuleOrNamespace.CreateNamespace (namespaceId, decls = [ mdl ])
SynModuleOrNamespace.CreateNamespace (namespaceId, decls = [ mdl ])
| _ -> failwithf "Not a record type"
/// Myriad generator that provides a method (possibly an extension method) for a record type, /// Myriad generator that provides a method (possibly an extension method) for a record type,
/// containing a JSON parse function. /// containing a JSON parse function.
@@ -634,10 +533,20 @@ type JsonParseGenerator () =
let ast, _ = let ast, _ =
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
let records = Ast.extractRecords ast let recordsAndUnions =
Ast.extractTypeDefn ast
|> List.map (fun (name, defns) ->
defns
|> List.choose (fun defn ->
if Ast.isRecord defn then Some defn
elif Ast.isDu defn then Some defn
else None
)
|> fun defns -> name, defns
)
let namespaceAndRecords = let namespaceAndTypes =
records recordsAndUnions
|> List.choose (fun (ns, types) -> |> List.choose (fun (ns, types) ->
types types
|> List.choose (fun typeDef -> |> List.choose (fun typeDef ->
@@ -665,13 +574,9 @@ type JsonParseGenerator () =
) )
let modules = let modules =
namespaceAndRecords namespaceAndTypes
|> List.collect (fun (ns, records) -> |> List.collect (fun (ns, types) ->
records types |> List.map (fun (ty, spec) -> JsonParseGenerator.createModule ns spec ty)
|> List.map (fun (record, spec) ->
let recordModule = JsonParseGenerator.createRecordModule ns spec record
recordModule
)
) )
Output.Ast modules Output.Ast modules

View File

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

View File

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

View File

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

View File

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

View File

@@ -15,21 +15,25 @@ type internal CompExprBinding =
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module internal SynExpr = module internal SynExpr =
/// {f} {x}
let applyFunction (f : SynExpr) (x : SynExpr) : SynExpr = SynExpr.CreateApp (f, x)
/// {f} {x}
let applyTo (x : SynExpr) (f : SynExpr) : SynExpr = SynExpr.CreateApp (f, x)
/// {expr} |> {func} /// {expr} |> {func}
let pipeThroughFunction (func : SynExpr) (expr : SynExpr) : SynExpr = let pipeThroughFunction (func : SynExpr) (expr : SynExpr) : SynExpr =
SynExpr.CreateApp ( SynExpr.CreateAppInfix (
SynExpr.CreateAppInfix ( SynExpr.CreateLongIdent (
SynExpr.CreateLongIdent ( SynLongIdent.SynLongIdent (
SynLongIdent.SynLongIdent ( [ Ident.Create "op_PipeRight" ],
[ Ident.Create "op_PipeRight" ], [],
[], [ Some (IdentTrivia.OriginalNotation "|>") ]
[ Some (IdentTrivia.OriginalNotation "|>") ] )
)
),
expr
), ),
func expr
) )
|> applyTo func
/// if {cond} then {trueBranch} else {falseBranch} /// if {cond} then {trueBranch} else {falseBranch}
/// Note that this function puts the trueBranch last, for pipelining convenience: /// Note that this function puts the trueBranch last, for pipelining convenience:
@@ -72,35 +76,31 @@ module internal SynExpr =
/// {a} = {b} /// {a} = {b}
let equals (a : SynExpr) (b : SynExpr) = let equals (a : SynExpr) (b : SynExpr) =
SynExpr.CreateApp ( SynExpr.CreateAppInfix (
SynExpr.CreateAppInfix ( SynExpr.CreateLongIdent (
SynExpr.CreateLongIdent ( SynLongIdent.SynLongIdent (
SynLongIdent.SynLongIdent ( Ident.CreateLong "op_Equality",
Ident.CreateLong "op_Equality", [],
[], [ Some (IdentTrivia.OriginalNotation "=") ]
[ Some (IdentTrivia.OriginalNotation "=") ] )
)
),
a
), ),
b a
) )
|> applyTo b
/// {a} + {b} /// {a} + {b}
let plus (a : SynExpr) (b : SynExpr) = let plus (a : SynExpr) (b : SynExpr) =
SynExpr.CreateApp ( SynExpr.CreateAppInfix (
SynExpr.CreateAppInfix ( SynExpr.CreateLongIdent (
SynExpr.CreateLongIdent ( SynLongIdent.SynLongIdent (
SynLongIdent.SynLongIdent ( Ident.CreateLong "op_Addition",
Ident.CreateLong "op_Addition", [],
[], [ Some (IdentTrivia.OriginalNotation "+") ]
[ Some (IdentTrivia.OriginalNotation "+") ] )
)
),
a
), ),
b a
) )
|> applyTo b
let rec stripOptionalParen (expr : SynExpr) : SynExpr = let rec stripOptionalParen (expr : SynExpr) : SynExpr =
match expr with match expr with
@@ -109,48 +109,42 @@ module internal SynExpr =
/// {obj}.{meth} {arg} /// {obj}.{meth} {arg}
let callMethodArg (meth : string) (arg : SynExpr) (obj : SynExpr) : SynExpr = let callMethodArg (meth : string) (arg : SynExpr) (obj : SynExpr) : SynExpr =
SynExpr.CreateApp ( SynExpr.DotGet (
SynExpr.DotGet ( obj,
obj, range0,
range0, SynLongIdent.SynLongIdent (id = [ Ident.Create meth ], dotRanges = [], trivia = [ None ]),
SynLongIdent.SynLongIdent (id = [ Ident.Create meth ], dotRanges = [], trivia = [ None ]), range0
range0
),
arg
) )
|> applyTo arg
/// {obj}.{meth}() /// {obj}.{meth}()
let callMethod (meth : string) (obj : SynExpr) : SynExpr = let callMethod (meth : string) (obj : SynExpr) : SynExpr =
callMethodArg meth (SynExpr.CreateConst SynConst.Unit) obj callMethodArg meth (SynExpr.CreateConst SynConst.Unit) obj
let callGenericMethod (meth : string) (ty : LongIdent) (obj : SynExpr) : SynExpr = let callGenericMethod (meth : string) (ty : LongIdent) (obj : SynExpr) : SynExpr =
SynExpr.CreateApp ( SynExpr.TypeApp (
SynExpr.TypeApp ( SynExpr.DotGet (obj, range0, SynLongIdent.Create [ meth ], range0),
SynExpr.DotGet (obj, range0, SynLongIdent.Create [ meth ], range0), range0,
range0, [ SynType.LongIdent (SynLongIdent.CreateFromLongIdent ty) ],
[ SynType.LongIdent (SynLongIdent.CreateFromLongIdent ty) ], [],
[], Some range0,
Some range0, range0,
range0, range0
range0
),
SynExpr.CreateConst SynConst.Unit
) )
|> applyTo (SynExpr.CreateConst SynConst.Unit)
/// {obj}.{meth}<ty>() /// {obj}.{meth}<ty>()
let callGenericMethod' (meth : string) (ty : string) (obj : SynExpr) : SynExpr = let callGenericMethod' (meth : string) (ty : string) (obj : SynExpr) : SynExpr =
SynExpr.CreateApp ( SynExpr.TypeApp (
SynExpr.TypeApp ( SynExpr.DotGet (obj, range0, SynLongIdent.Create [ meth ], range0),
SynExpr.DotGet (obj, range0, SynLongIdent.Create [ meth ], range0), range0,
range0, [ SynType.CreateLongIdent ty ],
[ SynType.CreateLongIdent ty ], [],
[], Some range0,
Some range0, range0,
range0, range0
range0
),
SynExpr.CreateConst SynConst.Unit
) )
|> applyTo (SynExpr.CreateConst SynConst.Unit)
let index (property : SynExpr) (obj : SynExpr) : SynExpr = let index (property : SynExpr) (obj : SynExpr) : SynExpr =
SynExpr.DotIndexedGet (obj, property, range0, range0) SynExpr.DotIndexedGet (obj, property, range0, range0)
@@ -173,25 +167,37 @@ module internal SynExpr =
|> SynExpr.CreateParen |> SynExpr.CreateParen
let reraise : SynExpr = let reraise : SynExpr =
SynExpr.CreateApp (SynExpr.CreateIdent (Ident.Create "reraise"), SynExpr.CreateConst SynConst.Unit) SynExpr.CreateIdent (Ident.Create "reraise")
|> applyTo (SynExpr.CreateConst SynConst.Unit)
/// {body} |> fun a -> Async.StartAsTask (a, ?cancellationToken=ct) /// {body} |> fun a -> Async.StartAsTask (a, ?cancellationToken=ct)
let startAsTask (ct : SynLongIdent) (body : SynExpr) = let startAsTask (ct : SynLongIdent) (body : SynExpr) =
let lambda = let lambda =
SynExpr.CreateApp ( [
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "StartAsTask" ]), SynExpr.CreateLongIdent (SynLongIdent.CreateString "a")
SynExpr.CreateParenedTuple equals
[ (SynExpr.LongIdent (true, SynLongIdent.CreateString "cancellationToken", None, range0))
SynExpr.CreateLongIdent (SynLongIdent.CreateString "a") (SynExpr.CreateLongIdent ct)
equals ]
(SynExpr.LongIdent (true, SynLongIdent.CreateString "cancellationToken", None, range0)) |> SynExpr.CreateParenedTuple
(SynExpr.CreateLongIdent ct) |> applyFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "StartAsTask" ]))
]
)
|> createLambda "a" |> createLambda "a"
pipeThroughFunction lambda body pipeThroughFunction lambda body
let createLongIdent (ident : string list) : SynExpr =
SynExpr.CreateLongIdent (SynLongIdent.Create ident)
let createLongIdent' (ident : Ident list) : SynExpr =
SynExpr.CreateLongIdent (SynLongIdent.CreateFromLongIdent ident)
let createLet (bindings : SynBinding list) (body : SynExpr) : SynExpr =
SynExpr.LetOrUse (false, false, bindings, body, range0, SynExprLetOrUseTrivia.empty)
let createMatch (matchOn : SynExpr) (cases : SynMatchClause list) : SynExpr = SynExpr.CreateMatch (matchOn, cases)
let typeAnnotate (ty : SynType) (expr : SynExpr) : SynExpr = SynExpr.CreateTyped (expr, ty)
/// {compExpr} { {lets} ; return {ret} } /// {compExpr} { {lets} ; return {ret} }
let createCompExpr (compExpr : string) (retBody : SynExpr) (lets : CompExprBinding list) : SynExpr = let createCompExpr (compExpr : string) (retBody : SynExpr) (lets : CompExprBinding list) : SynExpr =
let retStatement = SynExpr.YieldOrReturn ((false, true), retBody, range0) let retStatement = SynExpr.YieldOrReturn ((false, true), retBody, range0)
@@ -215,16 +221,7 @@ module internal SynExpr =
} }
) )
| Let (lhs, rhs) -> | Let (lhs, rhs) ->
SynExpr.LetOrUse ( createLet [ SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create lhs), expr = rhs) ] state
false,
false,
[ SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create lhs), expr = rhs) ],
state,
range0,
{
SynExprLetOrUseTrivia.InKeyword = None
}
)
| Use (lhs, rhs) -> | Use (lhs, rhs) ->
SynExpr.LetOrUse ( SynExpr.LetOrUse (
false, false,
@@ -261,17 +258,6 @@ module internal SynExpr =
let upcast' (ty : SynType) (e : SynExpr) = SynExpr.Upcast (e, ty, range0) let upcast' (ty : SynType) (e : SynExpr) = SynExpr.Upcast (e, ty, range0)
let synBindingTriviaZero (isMember : bool) =
{
SynBindingTrivia.EqualsRange = Some range0
InlineKeyword = None
LeadingKeyword =
if isMember then
SynLeadingKeyword.Member range0
else
SynLeadingKeyword.Let range0
}
/// {ident} - {rhs} /// {ident} - {rhs}
let minus (ident : SynLongIdent) (rhs : SynExpr) : SynExpr = let minus (ident : SynLongIdent) (rhs : SynExpr) : SynExpr =
SynExpr.CreateApp ( SynExpr.CreateApp (
@@ -310,16 +296,14 @@ module internal SynExpr =
/// {y} >= {x} /// {y} >= {x}
let greaterThanOrEqual (x : SynExpr) (y : SynExpr) : SynExpr = let greaterThanOrEqual (x : SynExpr) (y : SynExpr) : SynExpr =
SynExpr.CreateApp ( SynExpr.CreateAppInfix (
SynExpr.CreateAppInfix ( SynExpr.CreateLongIdent (
SynExpr.CreateLongIdent ( SynLongIdent.SynLongIdent (
SynLongIdent.SynLongIdent ( [ Ident.Create "op_GreaterThanOrEqual" ],
[ Ident.Create "op_GreaterThanOrEqual" ], [],
[], [ Some (IdentTrivia.OriginalNotation ">=") ]
[ Some (IdentTrivia.OriginalNotation ">=") ] )
)
),
y
), ),
x y
) )
|> applyTo x

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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