Compare commits

...

16 Commits

Author SHA1 Message Date
Patrick Stevens
913959a740 Make arg parser more AOT-friendly (#253) 2024-09-10 22:16:43 +01:00
dependabot[bot]
93ffc065cd Bump Microsoft.NET.Test.Sdk from 17.11.0 to 17.11.1 (#248)
* Bump Microsoft.NET.Test.Sdk from 17.11.0 to 17.11.1

Bumps [Microsoft.NET.Test.Sdk](https://github.com/microsoft/vstest) from 17.11.0 to 17.11.1.
- [Release notes](https://github.com/microsoft/vstest/releases)
- [Changelog](https://github.com/microsoft/vstest/blob/main/docs/releases.md)
- [Commits](https://github.com/microsoft/vstest/compare/v17.11.0...v17.11.1)

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

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

* Bump fantomas from 6.3.11 to 6.3.12

Bumps [fantomas](https://github.com/fsprojects/fantomas) from 6.3.11 to 6.3.12.
- [Release notes](https://github.com/fsprojects/fantomas/releases)
- [Changelog](https://github.com/fsprojects/fantomas/blob/main/CHANGELOG.md)
- [Commits](https://github.com/fsprojects/fantomas/compare/v6.3.11...v6.3.12)

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

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

* Deps

---------

Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
Co-authored-by: Smaug123 <3138005+Smaug123@users.noreply.github.com>
2024-09-09 19:33:39 +00:00
dependabot[bot]
d14efba7e7 Bump actions/attest-build-provenance from 1.4.2 to 1.4.3 (#247) 2024-09-09 12:42:12 +01:00
patrick-conscriptus[bot]
f5cf0b79dd Automated commit (#246)
Co-authored-by: patrick-conscriptus[bot] <175414948+patrick-conscriptus[bot]@users.noreply.github.com>
2024-09-08 01:20:34 +00:00
Patrick Stevens
029e3746bb Fix record/union impl accessibility (#245) 2024-09-07 08:49:28 +00:00
Patrick Stevens
8ae749c529 Add ArgumentLongForm (#244) 2024-09-05 21:26:52 +01:00
Patrick Stevens
e4cbab3209 Implement [<ArgumentFlag>] for two-case DUs (#242) 2024-09-04 21:48:36 +00:00
Patrick Stevens
bdce82fb7a Handle env vars with value 0 and 1 for bools (#241) 2024-09-04 21:06:22 +01:00
Patrick Stevens
8f9f933971 Handle URI in arg parser (#240) 2024-09-04 20:20:51 +01:00
Patrick Stevens
3a55ba1242 Allow positional args to be Choice<'a, 'a> to indicate whether they came before any positional marker (#238) 2024-09-04 20:09:40 +01:00
Patrick Stevens
047b2eda99 Throw on duplicated args (#237) 2024-09-04 08:39:19 +01:00
Patrick Stevens
2220f88053 Compose records in arg parser (#234) 2024-09-03 23:04:23 +00:00
dependabot[bot]
86b938c81e Bump Nerdbank.GitVersioning from 3.6.141 to 3.6.143 (#231) 2024-09-02 20:05:18 +01:00
patrick-conscriptus[bot]
1832a57bdf Automated commit (#230)
Co-authored-by: patrick-conscriptus[bot] <175414948+patrick-conscriptus[bot]@users.noreply.github.com>
2024-09-01 01:25:31 +00:00
Patrick Stevens
38f4821fa4 Switch to centrally managed actions (#229) 2024-08-28 16:51:36 +00:00
dependabot[bot]
70aaf8c408 Bump actions/attest-build-provenance from 1.4.1 to 1.4.2 (#221)
* Bump actions/attest-build-provenance from 1.4.1 to 1.4.2

Bumps [actions/attest-build-provenance](https://github.com/actions/attest-build-provenance) from 1.4.1 to 1.4.2.
- [Release notes](https://github.com/actions/attest-build-provenance/releases)
- [Changelog](https://github.com/actions/attest-build-provenance/blob/main/RELEASE.md)
- [Commits](310b0a4a3b...6149ea5740)

---
updated-dependencies:
- dependency-name: actions/attest-build-provenance
  dependency-type: direct:production
  update-type: version-update:semver-patch
...

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

* Bump Microsoft.NET.Test.Sdk from 17.10.0 to 17.11.0

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

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

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

* Bump ApiSurface from 4.0.44 to 4.1.2

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

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

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

* Bump NUnit from 4.1.0 to 4.2.1

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

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

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

* Bump fsharp-analyzers from 0.26.1 to 0.27.0

Bumps [fsharp-analyzers](https://github.com/ionide/FSharp.Analyzers.SDK) from 0.26.1 to 0.27.0.
- [Release notes](https://github.com/ionide/FSharp.Analyzers.SDK/releases)
- [Changelog](https://github.com/ionide/FSharp.Analyzers.SDK/blob/main/CHANGELOG.md)
- [Commits](https://github.com/ionide/FSharp.Analyzers.SDK/compare/v0.26.1...v0.27.0)

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

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

* Bump fantomas from 6.3.10 to 6.3.11

Bumps [fantomas](https://github.com/fsprojects/fantomas) from 6.3.10 to 6.3.11.
- [Release notes](https://github.com/fsprojects/fantomas/releases)
- [Changelog](https://github.com/fsprojects/fantomas/blob/main/CHANGELOG.md)
- [Commits](https://github.com/fsprojects/fantomas/compare/v6.3.10...v6.3.11)

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

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

* Deps

* Bump analyzers too

---------

Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
Co-authored-by: Smaug123 <3138005+Smaug123@users.noreply.github.com>
2024-08-26 11:07:27 +00:00
33 changed files with 4032 additions and 876 deletions

View File

@@ -3,13 +3,13 @@
"isRoot": true,
"tools": {
"fantomas": {
"version": "6.3.10",
"version": "6.3.12",
"commands": [
"fantomas"
]
},
"fsharp-analyzers": {
"version": "0.26.1",
"version": "0.27.0",
"commands": [
"fsharp-analyzers"
]

1
.fantomasignore Normal file
View File

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

View File

@@ -222,7 +222,7 @@ jobs:
if: ${{ always() }}
runs-on: ubuntu-latest
steps:
- uses: Smaug123/all-required-checks-complete-action@d0ef051668d922e3591cc7c97156702946437f8d
- uses: G-Research/common-actions/check-required-lite@2b7dc49cb14f3344fbe6019c14a31165e258c059
with:
needs-context: ${{ toJSON(needs) }}
@@ -241,7 +241,7 @@ jobs:
name: nuget-package-attribute
path: packed
- name: Attest Build Provenance
uses: actions/attest-build-provenance@310b0a4a3b0b78ef57ecda988ee04b132db73ef8 # v1.4.1
uses: actions/attest-build-provenance@1c608d11d69870c2092266b3f9a6f3abbf17002c # v1.4.3
with:
subject-path: "packed/*.nupkg"
@@ -260,7 +260,7 @@ jobs:
name: nuget-package-plugin
path: packed
- name: Attest Build Provenance
uses: actions/attest-build-provenance@310b0a4a3b0b78ef57ecda988ee04b132db73ef8 # v1.4.1
uses: actions/attest-build-provenance@1c608d11d69870c2092266b3f9a6f3abbf17002c # v1.4.3
with:
subject-path: "packed/*.nupkg"
@@ -290,7 +290,7 @@ jobs:
run: nix develop --command bash -c 'echo "dotnet=$(which dotnet)" >> $GITHUB_OUTPUT'
- name: Publish to NuGet
id: publish-success
uses: Smaug123/publish-nuget-action@76df889166633c2dc613560c092882aabe260df0
uses: G-Research/common-actions/publish-nuget@2b7dc49cb14f3344fbe6019c14a31165e258c059
with:
package-name: WoofWare.Myriad.Plugins.Attributes
nuget-key: ${{ secrets.NUGET_API_KEY }}
@@ -323,7 +323,7 @@ jobs:
run: nix develop --command bash -c 'echo "dotnet=$(which dotnet)" >> $GITHUB_OUTPUT'
- name: Publish to NuGet
id: publish-success
uses: Smaug123/publish-nuget-action@76df889166633c2dc613560c092882aabe260df0
uses: G-Research/common-actions/publish-nuget@2b7dc49cb14f3344fbe6019c14a31165e258c059
with:
package-name: WoofWare.Myriad.Plugins
nuget-key: ${{ secrets.NUGET_API_KEY }}

1
.gitignore vendored
View File

@@ -11,3 +11,4 @@ result
analysis.sarif
.direnv/
.venv/
.vs/

View File

@@ -1,5 +1,9 @@
Notable changes are recorded here.
# WoofWare.Myriad.Plugins 2.2.1, WoofWare.Myriad.Plugins.Attributes 3.2.1
New generator: `ArgParser`, a basic reflection-free argument parser.
# WoofWare.Myriad.Plugins 2.1.45, WoofWare.Myriad.Plugins.Attributes 3.1.7
The NuGet packages are now attested to through [GitHub Attestations](https://github.blog/2024-05-02-introducing-artifact-attestations-now-in-public-beta/).

View File

@@ -93,3 +93,105 @@ type DatesAndTimes =
[<InvariantCulture ; ParseExact @"hh\:mm\:ss">]
InvariantExact : TimeSpan
}
type ChildRecord =
{
Thing1 : int
Thing2 : string
}
[<ArgParser true>]
type ParentRecord =
{
Child : ChildRecord
AndAnother : bool
}
type ChildRecordWithPositional =
{
Thing1 : int
[<PositionalArgs>]
Thing2 : Uri list
}
[<ArgParser true>]
type ParentRecordChildPos =
{
Child : ChildRecordWithPositional
AndAnother : bool
}
[<ArgParser true>]
type ParentRecordSelfPos =
{
Child : ChildRecord
[<PositionalArgs>]
AndAnother : bool list
}
[<ArgParser true>]
type ChoicePositionals =
{
[<PositionalArgs>]
Args : Choice<string, string> list
}
[<ArgParser true>]
type ContainsBoolEnvVar =
{
[<ArgumentDefaultEnvironmentVariable "CONSUMEPLUGIN_THINGS">]
BoolVar : Choice<bool, bool>
}
[<RequireQualifiedAccess>]
module Consts =
[<Literal>]
let FALSE = false
[<Literal>]
let TRUE = true
type DryRunMode =
| [<ArgumentFlag(Consts.FALSE)>] Wet
| [<ArgumentFlag true>] Dry
[<ArgParser true>]
type WithFlagDu =
{
DryRun : DryRunMode
}
[<ArgParser true>]
type ContainsFlagEnvVar =
{
// This phrasing is odd, but it's for a test. Nobody's really going to have `--dry-run`
// controlled by an env var!
[<ArgumentDefaultEnvironmentVariable "CONSUMEPLUGIN_THINGS">]
DryRun : Choice<DryRunMode, DryRunMode>
}
[<ArgParser true>]
type ContainsFlagDefaultValue =
{
[<ArgumentDefaultFunction>]
DryRun : Choice<DryRunMode, DryRunMode>
}
static member DefaultDryRun () = DryRunMode.Wet
[<ArgParser true>]
type ManyLongForms =
{
[<ArgumentLongForm "do-something-else">]
[<ArgumentLongForm "anotherarg">]
DoTheThing : string
[<ArgumentLongForm "turn-it-on">]
[<ArgumentLongForm "dont-turn-it-off">]
SomeFlag : bool
}
[<RequireQualifiedAccess>]
type private IrrelevantDu =
| Foo
| Bar

File diff suppressed because it is too large Load Diff

View File

@@ -10,7 +10,7 @@
<WarnOn>FS3388,FS3559</WarnOn>
</PropertyGroup>
<ItemGroup>
<PackageReference Include="Nerdbank.GitVersioning" Version="3.6.141" PrivateAssets="all"/>
<PackageReference Include="Nerdbank.GitVersioning" Version="3.6.143" PrivateAssets="all"/>
<SourceLinkGitHubHost Include="github.com" ContentUrl="https://raw.githubusercontent.com"/>
</ItemGroup>
<PropertyGroup Condition="'$(GITHUB_ACTION)' != ''">

View File

@@ -61,3 +61,24 @@ type ParseExactAttribute (format : string) =
/// `TimeSpan.ParseExact (s, @"hh\:mm\:ss", CultureInfo.InvariantCulture).
type InvariantCultureAttribute () =
inherit Attribute ()
/// Attribute placed on a field of a two-case no-data discriminated union, indicating that this is "basically a bool".
/// For example: `type DryRun = | [<ArgumentFlag true>] Dry | [<ArgumentFlag false>] Wet`
/// A record with `{ DryRun : DryRun }` will then be parsed like `{ DryRun : bool }` (so the user supplies `--dry-run`),
/// but that you get this strongly-typed value directly in the code (so you `match args.DryRun with | DryRun.Dry ...`).
///
/// You must put this attribute on both cases of the discriminated union, with opposite values in each case.
type ArgumentFlagAttribute (flagValue : bool) =
inherit Attribute ()
/// Attribute placed on a field of a record to specify a different long form from the default. If you place this
/// attribute, you won't get the default: ArgFoo would normally be expressed as `--arg-foo`, but if you instead
/// say `[<ArgumentLongForm "thingy-blah">]` or `[<ArgumentLongForm "thingy">]`, you instead use `--thingy-blah`
/// or `--thingy` respectively.
///
/// You can place this argument multiple times.
///
/// Omit the initial `--` that you expect the user to type.
[<AttributeUsage(AttributeTargets.Field, AllowMultiple = true)>]
type ArgumentLongForm (s : string) =
inherit Attribute ()

View File

@@ -7,8 +7,12 @@ WoofWare.Myriad.Plugins.ArgumentDefaultEnvironmentVariableAttribute inherit Syst
WoofWare.Myriad.Plugins.ArgumentDefaultEnvironmentVariableAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.ArgumentDefaultFunctionAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.ArgumentDefaultFunctionAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.ArgumentFlagAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.ArgumentFlagAttribute..ctor [constructor]: bool
WoofWare.Myriad.Plugins.ArgumentHelpTextAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.ArgumentHelpTextAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.ArgumentLongForm inherit System.Attribute
WoofWare.Myriad.Plugins.ArgumentLongForm..ctor [constructor]: string
WoofWare.Myriad.Plugins.CreateCatamorphismAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.CreateCatamorphismAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.GenerateMockAttribute inherit System.Attribute

View File

@@ -1,10 +1,15 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net8.0</TargetFramework>
<TargetFramework>net8.0</TargetFramework>
<IsPackable>false</IsPackable>
<IsTestProject>true</IsTestProject>
<IsPackable>false</IsPackable>
<IsTestProject>true</IsTestProject>
<!--
Known high severity vulnerability
I have not yet seen a single instance where I care about this warning
-->
<NoWarn>$(NoWarn),NU1903</NoWarn>
</PropertyGroup>
<ItemGroup>
@@ -12,9 +17,9 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="ApiSurface" Version="4.0.44" />
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.10.0"/>
<PackageReference Include="NUnit" Version="4.1.0"/>
<PackageReference Include="ApiSurface" Version="4.1.5" />
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.11.1"/>
<PackageReference Include="NUnit" Version="4.2.2"/>
<PackageReference Include="NUnit3TestAdapter" Version="4.6.0"/>
</ItemGroup>

View File

@@ -1,5 +1,5 @@
{
"version": "3.2",
"version": "3.4",
"publicReleaseRefSpec": [
"^refs/heads/main$"
],
@@ -12,4 +12,4 @@
"./",
":^Test"
]
}
}

View File

@@ -341,3 +341,280 @@ Input string was not in a correct format. (at arg --exact=11:34)
Required argument '--exact' received no value"""
count.Value |> shouldEqual 0
[<Test>]
let ``Can consume stacked record without positionals`` () =
let getEnvVar (_ : string) = failwith "should not call"
let parsed =
ParentRecord.parse' getEnvVar [ "--and-another=true" ; "--thing1=9" ; "--thing2=a thing!" ]
parsed
|> shouldEqual
{
Child =
{
Thing1 = 9
Thing2 = "a thing!"
}
AndAnother = true
}
[<Test>]
let ``Can consume stacked record, child has positionals`` () =
let getEnvVar (_ : string) = failwith "should not call"
let parsed =
ParentRecordChildPos.parse'
getEnvVar
[
"--and-another=true"
"--thing1=9"
"--thing2=https://example.com"
"--thing2=http://example.com"
]
parsed.AndAnother |> shouldEqual true
parsed.Child.Thing1 |> shouldEqual 9
parsed.Child.Thing2
|> List.map (fun (x : Uri) -> x.ToString ())
|> shouldEqual [ "https://example.com/" ; "http://example.com/" ]
[<Test>]
let ``Can consume stacked record, child has no positionals, parent has positionals`` () =
let getEnvVar (_ : string) = failwith "should not call"
let parsed =
ParentRecordSelfPos.parse'
getEnvVar
[
"--and-another=true"
"--and-another=false"
"--and-another=true"
"--thing1=9"
"--thing2=some"
]
parsed
|> shouldEqual
{
Child =
{
Thing1 = 9
Thing2 = "some"
}
AndAnother = [ true ; false ; true ]
}
[<Test>]
let ``Help text for stacked records`` () =
let getEnvVar (_ : string) = failwith "should not call"
let exc =
Assert.Throws<exn> (fun () ->
ParentRecordSelfPos.parse' getEnvVar [ "--help" ] |> ignore<ParentRecordSelfPos>
)
exc.Message
|> shouldEqual
"""Help text requested.
--thing1 int32
--thing2 string
--and-another bool (positional args) (can be repeated)"""
[<Test>]
let ``Positionals are tagged with Choice`` () =
let getEnvVar (_ : string) = failwith "should not call"
ChoicePositionals.parse' getEnvVar [ "a" ; "b" ; "--" ; "--c" ; "--help" ]
|> shouldEqual
{
Args = [ Choice1Of2 "a" ; Choice1Of2 "b" ; Choice2Of2 "--c" ; Choice2Of2 "--help" ]
}
let boolCases =
[
"1", true
"0", false
"true", true
"false", false
"TRUE", true
"FALSE", false
]
|> List.map TestCaseData
[<TestCaseSource(nameof (boolCases))>]
let ``Bool env vars can be populated`` (envValue : string, boolValue : bool) =
let getEnvVar (s : string) =
s |> shouldEqual "CONSUMEPLUGIN_THINGS"
envValue
ContainsBoolEnvVar.parse' getEnvVar []
|> shouldEqual
{
BoolVar = Choice2Of2 boolValue
}
[<Test>]
let ``Bools can be treated with arity 0`` () =
let getEnvVar (_ : string) = failwith "do not call"
ContainsBoolEnvVar.parse' getEnvVar [ "--bool-var" ]
|> shouldEqual
{
BoolVar = Choice1Of2 true
}
[<TestCaseSource(nameof boolCases)>]
let ``Flag DUs can be parsed from env var`` (envValue : string, boolValue : bool) =
let getEnvVar (s : string) =
s |> shouldEqual "CONSUMEPLUGIN_THINGS"
envValue
let boolValue = if boolValue then DryRunMode.Dry else DryRunMode.Wet
ContainsFlagEnvVar.parse' getEnvVar []
|> shouldEqual
{
DryRun = Choice2Of2 boolValue
}
let dryRunData =
[
[ "--dry-run" ], DryRunMode.Dry
[ "--dry-run" ; "true" ], DryRunMode.Dry
[ "--dry-run=true" ], DryRunMode.Dry
[ "--dry-run" ; "True" ], DryRunMode.Dry
[ "--dry-run=True" ], DryRunMode.Dry
[ "--dry-run" ; "false" ], DryRunMode.Wet
[ "--dry-run=false" ], DryRunMode.Wet
[ "--dry-run" ; "False" ], DryRunMode.Wet
[ "--dry-run=False" ], DryRunMode.Wet
]
|> List.map TestCaseData
[<TestCaseSource(nameof dryRunData)>]
let ``Flag DUs can be parsed`` (args : string list, expected : DryRunMode) =
let getEnvVar (_ : string) = failwith "do not call"
ContainsFlagEnvVar.parse' getEnvVar args
|> shouldEqual
{
DryRun = Choice1Of2 expected
}
[<TestCaseSource(nameof dryRunData)>]
let ``Flag DUs can be parsed, ArgumentDefaultFunction`` (args : string list, expected : DryRunMode) =
let getEnvVar (_ : string) = failwith "do not call"
ContainsFlagDefaultValue.parse' getEnvVar args
|> shouldEqual
{
DryRun = Choice1Of2 expected
}
[<Test>]
let ``Flag DUs can be given a default value`` () =
let getEnvVar (_ : string) = failwith "do not call"
ContainsFlagDefaultValue.parse' getEnvVar []
|> shouldEqual
{
DryRun = Choice2Of2 DryRunMode.Wet
}
[<Test>]
let ``Help text for flag DU`` () =
let getEnvVar (_ : string) = failwith "do not call"
let exc =
Assert.Throws<exn> (fun () ->
ContainsFlagDefaultValue.parse' getEnvVar [ "--help" ]
|> ignore<ContainsFlagDefaultValue>
)
exc.Message
|> shouldEqual
"""Help text requested.
--dry-run bool (default value: false)"""
[<Test>]
let ``Help text for flag DU, non default`` () =
let getEnvVar (_ : string) = failwith "do not call"
let exc =
Assert.Throws<exn> (fun () -> WithFlagDu.parse' getEnvVar [ "--help" ] |> ignore<WithFlagDu>)
exc.Message
|> shouldEqual
"""Help text requested.
--dry-run bool"""
let longFormCases =
let doTheThing =
[
[ "--do-something-else=foo" ]
[ "--anotherarg=foo" ]
[ "--do-something-else" ; "foo" ]
[ "--anotherarg" ; "foo" ]
]
let someFlag =
[
[ "--turn-it-on" ], true
[ "--dont-turn-it-off" ], true
[ "--turn-it-on=true" ], true
[ "--dont-turn-it-off=true" ], true
[ "--turn-it-on=false" ], false
[ "--dont-turn-it-off=false" ], false
[ "--turn-it-on" ; "true" ], true
[ "--dont-turn-it-off" ; "true" ], true
[ "--turn-it-on" ; "false" ], false
[ "--dont-turn-it-off" ; "false" ], false
]
List.allPairs doTheThing someFlag
|> List.map (fun (doTheThing, (someFlag, someFlagResult)) ->
let args = doTheThing @ someFlag
let expected =
{
DoTheThing = "foo"
SomeFlag = someFlagResult
}
args, expected
)
|> List.map TestCaseData
[<TestCaseSource(nameof longFormCases)>]
let ``Long-form args`` (args : string list, expected : ManyLongForms) =
let getEnvVar (_ : string) = failwith "do not call"
ManyLongForms.parse' getEnvVar args |> shouldEqual expected
[<Test>]
let ``Long-form args can't be referred to by their original name`` () =
let getEnvVar (_ : string) = failwith "do not call"
let exc =
Assert.Throws<exn> (fun () ->
ManyLongForms.parse' getEnvVar [ "--do-the-thing=foo" ] |> ignore<ManyLongForms>
)
exc.Message
|> shouldEqual """Unable to process argument --do-the-thing=foo as key --do-the-thing and value foo"""
[<Test>]
let ``Long-form args help text`` () =
let getEnvVar (_ : string) = failwith "do not call"
let exc =
Assert.Throws<exn> (fun () -> ManyLongForms.parse' getEnvVar [ "--help" ] |> ignore<ManyLongForms>)
exc.Message
|> shouldEqual
"""Help text requested.
--do-something-else / --anotherarg string
--turn-it-on / --dont-turn-it-off bool"""

View File

@@ -4,6 +4,11 @@
<TargetFramework>net8.0</TargetFramework>
<IsPackable>false</IsPackable>
<IsTestProject>true</IsTestProject>
<!--
Known high severity vulnerability
I have not yet seen a single instance where I care about this warning
-->
<NoWarn>$(NoWarn),NU1903</NoWarn>
</PropertyGroup>
<ItemGroup>
@@ -34,11 +39,11 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="ApiSurface" Version="4.0.44"/>
<PackageReference Include="ApiSurface" Version="4.1.5"/>
<PackageReference Include="FsCheck" Version="2.16.6"/>
<PackageReference Include="FsUnit" Version="6.0.0"/>
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.10.0"/>
<PackageReference Include="NUnit" Version="4.1.0"/>
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.11.1"/>
<PackageReference Include="NUnit" Version="4.2.2"/>
<PackageReference Include="NUnit3TestAdapter" Version="4.6.0"/>
</ItemGroup>

File diff suppressed because it is too large Load Diff

View File

@@ -67,41 +67,109 @@ type internal RecordType =
Members : SynMemberDefns option
XmlDoc : PreXmlDoc option
Generics : SynTyparDecls option
Accessibility : SynAccess option
TypeAccessibility : SynAccess option
ImplAccessibility : SynAccess option
Attributes : SynAttribute list
}
/// Parse from the AST.
static member OfRecord (record : SynTypeDefn) : RecordType =
let sci, sdr, smd, smdo =
match record with
| SynTypeDefn.SynTypeDefn (sci, sdr, smd, smdo, _, _) -> sci, sdr, smd, smdo
let synAccessOption, recordFields =
match sdr with
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (sa, fields, _), _) -> sa, fields
| _ -> failwith $"expected a record; got: %+A{record}"
static member OfRecord
(sci : SynComponentInfo)
(smd : SynMemberDefns)
(access : SynAccess option)
(recordFields : SynField list)
: RecordType
=
match sci with
| SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, access, _) ->
if access <> synAccessOption then
failwith
$"TODO what's happened, two different accessibility modifiers: %O{access} and %O{synAccessOption}"
match smdo with
| Some v -> failwith $"TODO what's happened, got a synMemberDefn of %O{v}"
| None -> ()
| SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, implAccess, _) ->
{
Name = List.last longId
Fields = recordFields
Members = if smd.IsEmpty then None else Some smd
XmlDoc = if doc.IsEmpty then None else Some doc
Generics = typars
Accessibility = synAccessOption
ImplAccessibility = implAccess
TypeAccessibility = access
Attributes = attrs |> List.collect (fun l -> l.Attributes)
}
/// Methods for manipulating UnionCase.
[<RequireQualifiedAccess>]
module UnionCase =
/// Construct our structured `UnionCase` from an FCS `SynUnionCase`: extract everything
/// we care about from the AST representation.
let ofSynUnionCase (case : SynUnionCase) : UnionCase<Ident option> =
match case with
| SynUnionCase.SynUnionCase (attributes, ident, caseType, xmlDoc, access, _, _) ->
let ident =
match ident with
| SynIdent.SynIdent (ident, _) -> ident
let fields =
match caseType with
| SynUnionCaseKind.Fields cases -> cases
| SynUnionCaseKind.FullType _ -> failwith "unexpected FullType union"
{
Name = ident
XmlDoc = if xmlDoc.IsEmpty then None else Some xmlDoc
Access = access
Attributes = attributes |> List.collect (fun t -> t.Attributes)
Fields = fields |> List.map SynField.extract
}
/// Functorial `map`.
let mapIdentFields<'a, 'b> (f : 'a -> 'b) (unionCase : UnionCase<'a>) : UnionCase<'b> =
{
Attributes = unionCase.Attributes
Name = unionCase.Name
Access = unionCase.Access
XmlDoc = unionCase.XmlDoc
Fields = unionCase.Fields |> List.map (SynField.mapIdent f)
}
/// Everything you need to know about a discriminated union definition.
type internal UnionType =
{
/// The name of the DU: for example, `type Foo = | Blah` has this being `Foo`.
Name : Ident
/// Any additional members which are not union cases.
Members : SynMemberDefns option
/// Any docstring associated with the DU itself (not its cases).
XmlDoc : PreXmlDoc option
/// Generic type parameters this DU takes: `type Foo<'a> = | ...`.
Generics : SynTyparDecls option
/// Attributes of the DU (not its cases): `[<Attr>] type Foo = | ...`
Attributes : SynAttribute list
/// Accessibility modifier of the DU: `type private Foo = ...`
TypeAccessibility : SynAccess option
/// Accessibility modifier of the DU's implementation: `type Foo = private | ...`
ImplAccessibility : SynAccess option
/// The actual DU cases themselves.
Cases : UnionCase<Ident option> list
}
static member OfUnion
(sci : SynComponentInfo)
(smd : SynMemberDefns)
(access : SynAccess option)
(cases : SynUnionCase list)
: UnionType
=
match sci with
| SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, implAccess, _) ->
{
Name = List.last longId
Members = if smd.IsEmpty then None else Some smd
XmlDoc = if doc.IsEmpty then None else Some doc
Generics = typars
Attributes = attrs |> List.collect (fun l -> l.Attributes)
TypeAccessibility = access
ImplAccessibility = implAccess
Cases = cases |> List.map UnionCase.ofSynUnionCase
}
/// Anything that is part of an ADT.
/// A record is a product of stuff; this type represents one of those stuffs.
type internal AdtNode =
@@ -144,13 +212,13 @@ module internal AstHelper =
let defineRecordType (record : RecordType) : SynTypeDefn =
let name =
SynComponentInfo.create record.Name
|> SynComponentInfo.setAccessibility record.Accessibility
|> SynComponentInfo.setAccessibility record.TypeAccessibility
|> match record.XmlDoc with
| None -> id
| Some doc -> SynComponentInfo.withDocString doc
|> SynComponentInfo.setGenerics record.Generics
SynTypeDefnRepr.record (Seq.toList record.Fields)
SynTypeDefnRepr.recordWithAccess record.ImplAccessibility (Seq.toList record.Fields)
|> SynTypeDefn.create name
|> SynTypeDefn.withMemberDefns (defaultArg record.Members SynMemberDefns.Empty)

View File

@@ -212,7 +212,8 @@ module internal InterfaceMockGenerator =
Members = Some ([ constructor ; interfaceMembers ] @ extraInterfaces)
XmlDoc = Some xmlDoc
Generics = interfaceType.Generics
Accessibility = Some access
TypeAccessibility = Some access
ImplAccessibility = None
Attributes = []
}

View File

@@ -416,11 +416,11 @@ module internal JsonParseGenerator =
let createUnionMaker (spec : JsonParseOutputSpec) (typeName : LongIdent) (fields : UnionCase<Ident> list) =
fields
|> List.map (fun case ->
let propertyName = JsonSerializeGenerator.getPropertyName case.Ident case.Attrs
let propertyName = JsonSerializeGenerator.getPropertyName case.Name case.Attributes
let body =
if case.Fields.IsEmpty then
SynExpr.createLongIdent' (typeName @ [ case.Ident ])
SynExpr.createLongIdent' (typeName @ [ case.Name ])
else
case.Fields
|> List.map (fun field ->
@@ -429,7 +429,7 @@ module internal JsonParseGenerator =
createParseRhs options propertyName field.Type
)
|> SynExpr.tuple
|> SynExpr.applyFunction (SynExpr.createLongIdent' (typeName @ [ case.Ident ]))
|> SynExpr.applyFunction (SynExpr.createLongIdent' (typeName @ [ case.Name ]))
|> SynExpr.createLet
[
SynExpr.index (SynExpr.CreateConst "data") (SynExpr.createIdent "node")
@@ -600,7 +600,7 @@ module internal JsonParseGenerator =
| Some i -> i
cases
|> List.map SynUnionCase.extract
|> List.map UnionCase.ofSynUnionCase
|> List.map (UnionCase.mapIdentFields optionGet)
|> createUnionMaker spec ident
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Enum (cases, _range), _) ->

View File

@@ -263,11 +263,11 @@ module internal JsonSerializeGenerator =
let unionModule (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (cases : SynUnionCase list) =
let inputArg = Ident.create "input"
let fields = cases |> List.map SynUnionCase.extract
let fields = cases |> List.map UnionCase.ofSynUnionCase
fields
|> List.map (fun unionCase ->
let propertyName = getPropertyName unionCase.Ident unionCase.Attrs
let propertyName = getPropertyName unionCase.Name unionCase.Attributes
let caseNames = unionCase.Fields |> List.mapi (fun i _ -> $"arg%i{i}")
@@ -275,7 +275,7 @@ module internal JsonSerializeGenerator =
let pattern =
SynPat.LongIdent (
SynLongIdent.create (typeName @ [ unionCase.Ident ]),
SynLongIdent.create (typeName @ [ unionCase.Name ]),
None,
None,
argPats,

View File

@@ -36,7 +36,6 @@ module internal RemoveOptionsGenerator =
trivia
)
// TODO: this option seems a bit odd
let createType
(xmlDoc : PreXmlDoc option)
(accessibility : SynAccess option)
@@ -54,7 +53,8 @@ module internal RemoveOptionsGenerator =
Members = None
XmlDoc = xmlDoc
Generics = generics
Accessibility = accessibility
TypeAccessibility = accessibility
ImplAccessibility = None
Attributes = []
}
@@ -62,7 +62,7 @@ module internal RemoveOptionsGenerator =
SynModuleDecl.Types ([ typeDecl ], range0)
let createMaker (withOptionsType : LongIdent) (withoutOptionsType : LongIdent) (fields : SynFieldData<Ident> list) =
let createMaker (withOptionsType : LongIdent) (withoutOptionsType : Ident) (fields : SynFieldData<Ident> list) =
let xmlDoc = PreXmlDoc.create "Remove the optional members of the input."
let inputArg = Ident.create "input"
@@ -87,7 +87,7 @@ module internal RemoveOptionsGenerator =
SynExpr.applyFunction
(SynExpr.createLongIdent [ "Option" ; "defaultWith" ])
(SynExpr.createLongIdent' (
withoutOptionsType
[ withoutOptionsType ]
@ [ Ident.create (sprintf "Default%s" fieldData.Ident.idText) ]
))
)
@@ -101,47 +101,35 @@ module internal RemoveOptionsGenerator =
[ functionName ]
[
SynPat.named inputArg.idText
|> SynPat.annotateType (SynType.LongIdent (SynLongIdent.create withoutOptionsType))
|> SynPat.annotateType (SynType.LongIdent (SynLongIdent.createI withoutOptionsType))
]
body
|> SynBinding.withXmlDoc xmlDoc
|> SynBinding.withReturnAnnotation (SynType.LongIdent (SynLongIdent.create withOptionsType))
|> SynModuleDecl.createLet
let createRecordModule (namespaceId : LongIdent) (typeDefn : SynTypeDefn) =
let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) =
typeDefn
let createRecordModule (namespaceId : LongIdent) (typeDefn : RecordType) =
let fieldData = typeDefn.Fields |> List.map SynField.extractWithIdent
let (SynComponentInfo (_attributes, typeParams, _constraints, recordId, doc, _preferPostfix, _access, _)) =
synComponentInfo
let decls =
[
createType typeDefn.XmlDoc typeDefn.TypeAccessibility typeDefn.Generics typeDefn.Fields
createMaker [ Ident.create "Short" ] typeDefn.Name fieldData
]
match synTypeDefnRepr with
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (accessibility, fields, _range), _) ->
let fieldData = fields |> List.map SynField.extractWithIdent
let xmlDoc =
sprintf "Module containing an option-truncated version of the %s type" typeDefn.Name.idText
|> PreXmlDoc.create
let decls =
[
createType (Some doc) accessibility typeParams fields
createMaker [ Ident.create "Short" ] recordId fieldData
]
let info =
SynComponentInfo.create typeDefn.Name
|> SynComponentInfo.withDocString xmlDoc
|> SynComponentInfo.addAttributes [ SynAttribute.compilationRepresentation ]
|> SynComponentInfo.addAttributes [ SynAttribute.requireQualifiedAccess ]
let xmlDoc =
recordId
|> Seq.map (fun i -> i.idText)
|> String.concat "."
|> sprintf "Module containing an option-truncated version of the %s type"
|> PreXmlDoc.create
let info =
SynComponentInfo.createLong recordId
|> SynComponentInfo.withDocString xmlDoc
|> SynComponentInfo.addAttributes [ SynAttribute.compilationRepresentation ]
|> SynComponentInfo.addAttributes [ SynAttribute.requireQualifiedAccess ]
SynModuleDecl.nestedModule info decls
|> List.singleton
|> SynModuleOrNamespace.createNamespace namespaceId
| _ -> failwithf "Not a record type"
SynModuleDecl.nestedModule info decls
|> List.singleton
|> SynModuleOrNamespace.createNamespace namespaceId
open Myriad.Core
@@ -164,7 +152,24 @@ type RemoveOptionsGenerator () =
|> List.choose (fun (ns, types) ->
match types |> List.filter Ast.hasAttribute<RemoveOptionsAttribute> with
| [] -> None
| types -> Some (ns, types)
| types ->
let types =
types
|> List.map (fun ty ->
match ty with
| SynTypeDefn.SynTypeDefn (sci,
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (access,
fields,
_),
_),
smd,
smdo,
_,
_) -> RecordType.OfRecord sci smd access fields
| _ -> failwith "unexpectedly not a record"
)
Some (ns, types)
)
let modules =

View File

@@ -11,4 +11,27 @@ WoofWare.Myriad.Plugins.JsonParseGenerator..ctor [constructor]: unit
WoofWare.Myriad.Plugins.JsonSerializeGenerator inherit obj, implements Myriad.Core.IMyriadGenerator
WoofWare.Myriad.Plugins.JsonSerializeGenerator..ctor [constructor]: unit
WoofWare.Myriad.Plugins.RemoveOptionsGenerator inherit obj, implements Myriad.Core.IMyriadGenerator
WoofWare.Myriad.Plugins.RemoveOptionsGenerator..ctor [constructor]: unit
WoofWare.Myriad.Plugins.RemoveOptionsGenerator..ctor [constructor]: unit
WoofWare.Myriad.Plugins.SynFieldData`1 inherit obj
WoofWare.Myriad.Plugins.SynFieldData`1..ctor [constructor]: (Fantomas.FCS.Syntax.SynAttribute list, 'Ident, Fantomas.FCS.Syntax.SynType)
WoofWare.Myriad.Plugins.SynFieldData`1.Attrs [property]: [read-only] Fantomas.FCS.Syntax.SynAttribute list
WoofWare.Myriad.Plugins.SynFieldData`1.get_Attrs [method]: unit -> Fantomas.FCS.Syntax.SynAttribute list
WoofWare.Myriad.Plugins.SynFieldData`1.get_Ident [method]: unit -> 'Ident
WoofWare.Myriad.Plugins.SynFieldData`1.get_Type [method]: unit -> Fantomas.FCS.Syntax.SynType
WoofWare.Myriad.Plugins.SynFieldData`1.Ident [property]: [read-only] 'Ident
WoofWare.Myriad.Plugins.SynFieldData`1.Type [property]: [read-only] Fantomas.FCS.Syntax.SynType
WoofWare.Myriad.Plugins.UnionCase inherit obj
WoofWare.Myriad.Plugins.UnionCase.mapIdentFields [static method]: ('a -> 'b) -> 'a WoofWare.Myriad.Plugins.UnionCase -> 'b WoofWare.Myriad.Plugins.UnionCase
WoofWare.Myriad.Plugins.UnionCase.ofSynUnionCase [static method]: Fantomas.FCS.Syntax.SynUnionCase -> Fantomas.FCS.Syntax.Ident option WoofWare.Myriad.Plugins.UnionCase
WoofWare.Myriad.Plugins.UnionCase`1 inherit obj
WoofWare.Myriad.Plugins.UnionCase`1..ctor [constructor]: (Fantomas.FCS.Syntax.Ident, Fantomas.FCS.Xml.PreXmlDoc option, Fantomas.FCS.Syntax.SynAccess option, Fantomas.FCS.Syntax.SynAttribute list, 'ident WoofWare.Myriad.Plugins.SynFieldData list)
WoofWare.Myriad.Plugins.UnionCase`1.Access [property]: [read-only] Fantomas.FCS.Syntax.SynAccess option
WoofWare.Myriad.Plugins.UnionCase`1.Attributes [property]: [read-only] Fantomas.FCS.Syntax.SynAttribute list
WoofWare.Myriad.Plugins.UnionCase`1.Fields [property]: [read-only] 'ident WoofWare.Myriad.Plugins.SynFieldData list
WoofWare.Myriad.Plugins.UnionCase`1.get_Access [method]: unit -> Fantomas.FCS.Syntax.SynAccess option
WoofWare.Myriad.Plugins.UnionCase`1.get_Attributes [method]: unit -> Fantomas.FCS.Syntax.SynAttribute list
WoofWare.Myriad.Plugins.UnionCase`1.get_Fields [method]: unit -> 'ident WoofWare.Myriad.Plugins.SynFieldData list
WoofWare.Myriad.Plugins.UnionCase`1.get_Name [method]: unit -> Fantomas.FCS.Syntax.Ident
WoofWare.Myriad.Plugins.UnionCase`1.get_XmlDoc [method]: unit -> Fantomas.FCS.Xml.PreXmlDoc option
WoofWare.Myriad.Plugins.UnionCase`1.Name [property]: [read-only] Fantomas.FCS.Syntax.Ident
WoofWare.Myriad.Plugins.UnionCase`1.XmlDoc [property]: [read-only] Fantomas.FCS.Xml.PreXmlDoc option

View File

@@ -5,10 +5,17 @@ open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Xml
type internal SynFieldData<'Ident> =
/// The data needed to reconstitute a single piece of data within a union field, or a single record field.
/// This is generic on whether the field is identified. For example, in `type Foo = Blah of int`, the `int`
/// field is not identified; whereas in `type Foo = Blah of baz : int`, it is identified.
type SynFieldData<'Ident> =
{
/// Attributes on this field. I think you can only get these if this is a *record* field.
Attrs : SynAttribute list
/// The identifier of this field (see docstring for SynFieldData).
Ident : 'Ident
/// The type of the data contained in this field. For example, `type Foo = { Blah : int }`
/// has this being `int`.
Type : SynType
}

View File

@@ -363,6 +363,7 @@ module internal SynType =
| DateTimeOffset -> "DateTimeOffset"
| DateOnly -> "DateOnly"
| TimeSpan -> "TimeSpan"
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) -> ident |> List.map _.idText |> String.concat "."
| ty -> failwithf "could not compute human-readable string for type: %O" ty
/// Guess whether the types are equal. We err on the side of saying "no, they're different".
@@ -454,4 +455,11 @@ module internal SynType =
match ty2 with
| DateOnly -> true
| _ -> false
| _ -> false
| _ ->
match ty1, ty2 with
| SynType.LongIdent (SynLongIdent (ident1, _, _)), SynType.LongIdent (SynLongIdent (ident2, _, _)) ->
let ident1 = ident1 |> List.map _.idText
let ident2 = ident2 |> List.map _.idText
ident1 = ident2
| _, _ -> false

View File

@@ -13,8 +13,12 @@ module internal SynTypeDefnRepr =
let inline augmentation () : SynTypeDefnRepr =
SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Augmentation range0, [], range0)
let inline union (cases : SynUnionCase list) : SynTypeDefnRepr =
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (None, cases, range0), range0)
let inline unionWithAccess (implAccess : SynAccess option) (cases : SynUnionCase list) : SynTypeDefnRepr =
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (implAccess, cases, range0), range0)
let inline record (fields : SynField list) : SynTypeDefnRepr =
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (None, fields, range0), range0)
let inline union (cases : SynUnionCase list) : SynTypeDefnRepr = unionWithAccess None cases
let inline recordWithAccess (implAccess : SynAccess option) (fields : SynField list) : SynTypeDefnRepr =
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (implAccess, fields, range0), range0)
let inline record (fields : SynField list) : SynTypeDefnRepr = recordWithAccess None fields

View File

@@ -5,44 +5,24 @@ open Fantomas.FCS.Text.Range
open Fantomas.FCS.Xml
open Fantomas.FCS.SyntaxTrivia
type internal UnionCase<'Ident> =
/// Represents everything you need to know about a union case.
/// This is generic on whether each field of this case must be named.
type UnionCase<'ident> =
{
Fields : SynFieldData<'Ident> list
Attrs : SynAttribute list
Ident : Ident
/// The name of the case: e.g. `| Foo of blah` has this being `Foo`.
Name : Ident
/// Any docstring associated with this case.
XmlDoc : PreXmlDoc option
/// Any accessibility modifier: e.g. `type Foo = private | Blah`.
Access : SynAccess option
/// Attributes on the case: for example, `| [<Attr>] Foo of blah`.
Attributes : SynAttribute list
/// The data contained within the case: for example, `[blah]` in `| Foo of blah`.
Fields : SynFieldData<'ident> list
}
[<RequireQualifiedAccess>]
module internal UnionCase =
let mapIdentFields<'a, 'b> (f : 'a -> 'b) (unionCase : UnionCase<'a>) : UnionCase<'b> =
{
Fields = unionCase.Fields |> List.map (SynField.mapIdent f)
Attrs = unionCase.Attrs
Ident = unionCase.Ident
}
[<RequireQualifiedAccess>]
module internal SynUnionCase =
let extract (SynUnionCase (attrs, id, caseType, _, _, _, _)) : UnionCase<Ident option> =
match caseType with
| SynUnionCaseKind.FullType _ -> failwith "WoofWare.Myriad does not support FullType union cases."
| SynUnionCaseKind.Fields fields ->
let fields = fields |> List.map SynField.extract
let id =
match id with
| SynIdent.SynIdent (ident, _) -> ident
// As far as I can tell, there's no way to get any attributes here? :shrug:
let attrs = attrs |> List.collect (fun l -> l.Attributes)
{
Fields = fields
Attrs = attrs
Ident = id
}
let create (case : UnionCase<Ident>) : SynUnionCase =
let fields =
case.Fields
@@ -63,11 +43,11 @@ module internal SynUnionCase =
)
SynUnionCase.SynUnionCase (
SynAttributes.ofAttrs case.Attrs,
SynIdent.SynIdent (case.Ident, None),
SynAttributes.ofAttrs case.Attributes,
SynIdent.SynIdent (case.Name, None),
SynUnionCaseKind.Fields fields,
PreXmlDoc.Empty,
None,
case.XmlDoc |> Option.defaultValue PreXmlDoc.Empty,
case.Access,
range0,
{
BarRange = Some range0

View File

@@ -0,0 +1,18 @@
namespace WoofWare.Myriad.Plugins
// Extracted from https://github.com/G-Research/TypeEquality
// which is Apache-2.0 licenced. See `TeqLicence.txt`.
// We inline this code because Myriad doesn't seem to reliably load package references in the generator.
// I have reformatted a little, and stripped out all the code I don't use.
type internal Teq<'a, 'b> = private | Teq of ('a -> 'b) * ('b -> 'a)
[<RequireQualifiedAccess>]
module internal Teq =
let refl<'a> : Teq<'a, 'a> = Teq (id, id)
let cast (Teq (f, _)) a = f a
[<RequireQualifiedAccess>]
module Cong =
let believeMe<'a, 'b, 'a2, 'b2> (_ : Teq<'a, 'b>) : Teq<'a2, 'b2> = unbox <| (refl : Teq<'a2, 'a2>)

View File

@@ -0,0 +1,201 @@
Apache License
Version 2.0, January 2004
http://www.apache.org/licenses/
TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
1. Definitions.
"License" shall mean the terms and conditions for use, reproduction,
and distribution as defined by Sections 1 through 9 of this document.
"Licensor" shall mean the copyright owner or entity authorized by
the copyright owner that is granting the License.
"Legal Entity" shall mean the union of the acting entity and all
other entities that control, are controlled by, or are under common
control with that entity. For the purposes of this definition,
"control" means (i) the power, direct or indirect, to cause the
direction or management of such entity, whether by contract or
otherwise, or (ii) ownership of fifty percent (50%) or more of the
outstanding shares, or (iii) beneficial ownership of such entity.
"You" (or "Your") shall mean an individual or Legal Entity
exercising permissions granted by this License.
"Source" form shall mean the preferred form for making modifications,
including but not limited to software source code, documentation
source, and configuration files.
"Object" form shall mean any form resulting from mechanical
transformation or translation of a Source form, including but
not limited to compiled object code, generated documentation,
and conversions to other media types.
"Work" shall mean the work of authorship, whether in Source or
Object form, made available under the License, as indicated by a
copyright notice that is included in or attached to the work
(an example is provided in the Appendix below).
"Derivative Works" shall mean any work, whether in Source or Object
form, that is based on (or derived from) the Work and for which the
editorial revisions, annotations, elaborations, or other modifications
represent, as a whole, an original work of authorship. For the purposes
of this License, Derivative Works shall not include works that remain
separable from, or merely link (or bind by name) to the interfaces of,
the Work and Derivative Works thereof.
"Contribution" shall mean any work of authorship, including
the original version of the Work and any modifications or additions
to that Work or Derivative Works thereof, that is intentionally
submitted to Licensor for inclusion in the Work by the copyright owner
or by an individual or Legal Entity authorized to submit on behalf of
the copyright owner. For the purposes of this definition, "submitted"
means any form of electronic, verbal, or written communication sent
to the Licensor or its representatives, including but not limited to
communication on electronic mailing lists, source code control systems,
and issue tracking systems that are managed by, or on behalf of, the
Licensor for the purpose of discussing and improving the Work, but
excluding communication that is conspicuously marked or otherwise
designated in writing by the copyright owner as "Not a Contribution."
"Contributor" shall mean Licensor and any individual or Legal Entity
on behalf of whom a Contribution has been received by Licensor and
subsequently incorporated within the Work.
2. Grant of Copyright License. Subject to the terms and conditions of
this License, each Contributor hereby grants to You a perpetual,
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
copyright license to reproduce, prepare Derivative Works of,
publicly display, publicly perform, sublicense, and distribute the
Work and such Derivative Works in Source or Object form.
3. Grant of Patent License. Subject to the terms and conditions of
this License, each Contributor hereby grants to You a perpetual,
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
(except as stated in this section) patent license to make, have made,
use, offer to sell, sell, import, and otherwise transfer the Work,
where such license applies only to those patent claims licensable
by such Contributor that are necessarily infringed by their
Contribution(s) alone or by combination of their Contribution(s)
with the Work to which such Contribution(s) was submitted. If You
institute patent litigation against any entity (including a
cross-claim or counterclaim in a lawsuit) alleging that the Work
or a Contribution incorporated within the Work constitutes direct
or contributory patent infringement, then any patent licenses
granted to You under this License for that Work shall terminate
as of the date such litigation is filed.
4. Redistribution. You may reproduce and distribute copies of the
Work or Derivative Works thereof in any medium, with or without
modifications, and in Source or Object form, provided that You
meet the following conditions:
(a) You must give any other recipients of the Work or
Derivative Works a copy of this License; and
(b) You must cause any modified files to carry prominent notices
stating that You changed the files; and
(c) You must retain, in the Source form of any Derivative Works
that You distribute, all copyright, patent, trademark, and
attribution notices from the Source form of the Work,
excluding those notices that do not pertain to any part of
the Derivative Works; and
(d) If the Work includes a "NOTICE" text file as part of its
distribution, then any Derivative Works that You distribute must
include a readable copy of the attribution notices contained
within such NOTICE file, excluding those notices that do not
pertain to any part of the Derivative Works, in at least one
of the following places: within a NOTICE text file distributed
as part of the Derivative Works; within the Source form or
documentation, if provided along with the Derivative Works; or,
within a display generated by the Derivative Works, if and
wherever such third-party notices normally appear. The contents
of the NOTICE file are for informational purposes only and
do not modify the License. You may add Your own attribution
notices within Derivative Works that You distribute, alongside
or as an addendum to the NOTICE text from the Work, provided
that such additional attribution notices cannot be construed
as modifying the License.
You may add Your own copyright statement to Your modifications and
may provide additional or different license terms and conditions
for use, reproduction, or distribution of Your modifications, or
for any such Derivative Works as a whole, provided Your use,
reproduction, and distribution of the Work otherwise complies with
the conditions stated in this License.
5. Submission of Contributions. Unless You explicitly state otherwise,
any Contribution intentionally submitted for inclusion in the Work
by You to the Licensor shall be under the terms and conditions of
this License, without any additional terms or conditions.
Notwithstanding the above, nothing herein shall supersede or modify
the terms of any separate license agreement you may have executed
with Licensor regarding such Contributions.
6. Trademarks. This License does not grant permission to use the trade
names, trademarks, service marks, or product names of the Licensor,
except as required for reasonable and customary use in describing the
origin of the Work and reproducing the content of the NOTICE file.
7. Disclaimer of Warranty. Unless required by applicable law or
agreed to in writing, Licensor provides the Work (and each
Contributor provides its Contributions) on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
implied, including, without limitation, any warranties or conditions
of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
PARTICULAR PURPOSE. You are solely responsible for determining the
appropriateness of using or redistributing the Work and assume any
risks associated with Your exercise of permissions under this License.
8. Limitation of Liability. In no event and under no legal theory,
whether in tort (including negligence), contract, or otherwise,
unless required by applicable law (such as deliberate and grossly
negligent acts) or agreed to in writing, shall any Contributor be
liable to You for damages, including any direct, indirect, special,
incidental, or consequential damages of any character arising as a
result of this License or out of the use or inability to use the
Work (including but not limited to damages for loss of goodwill,
work stoppage, computer failure or malfunction, or any and all
other commercial damages or losses), even if such Contributor
has been advised of the possibility of such damages.
9. Accepting Warranty or Additional Liability. While redistributing
the Work or Derivative Works thereof, You may choose to offer,
and charge a fee for, acceptance of support, warranty, indemnity,
or other liability obligations and/or rights consistent with this
License. However, in accepting such obligations, You may act only
on Your own behalf and on Your sole responsibility, not on behalf
of any other Contributor, and only if You agree to indemnify,
defend, and hold each Contributor harmless for any liability
incurred by, or claims asserted against, such Contributor by reason
of your accepting any such warranty or additional liability.
END OF TERMS AND CONDITIONS
APPENDIX: How to apply the Apache License to your work.
To apply the Apache License to your work, attach the following
boilerplate notice, with the fields enclosed by brackets "[]"
replaced with your own identifying information. (Don't include
the brackets!) The text should be enclosed in the appropriate
comment syntax for the file format. We also recommend that a
file or class name and description of purpose be included on the
same "printed page" as the copyright notice for easier
identification within third-party archives.
Copyright [yyyy] [name of copyright owner]
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.

View File

@@ -25,6 +25,7 @@
<ItemGroup>
<Compile Include="List.fs"/>
<Compile Include="Teq.fs" />
<Compile Include="Primitives.fs" />
<Compile Include="SynExpr\SynAttributes.fs" />
<Compile Include="SynExpr\PreXmlDoc.fs" />
@@ -56,6 +57,7 @@
<Compile Include="HttpClientGenerator.fs"/>
<Compile Include="CataGenerator.fs" />
<Compile Include="ArgParserGenerator.fs" />
<None Include="TeqLicence.txt" />
<EmbeddedResource Include="version.json"/>
<EmbeddedResource Include="SurfaceBaseline.txt"/>
<None Include="..\README.md">

View File

@@ -1,5 +1,5 @@
{
"version": "2.2",
"version": "2.3",
"publicReleaseRefSpec": [
"^refs/heads/main$"
],

View File

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

6
flake.lock generated
View File

@@ -20,11 +20,11 @@
},
"nixpkgs": {
"locked": {
"lastModified": 1724395761,
"narHash": "sha256-zRkDV/nbrnp3Y8oCADf5ETl1sDrdmAW6/bBVJ8EbIdQ=",
"lastModified": 1725534445,
"narHash": "sha256-Yd0FK9SkWy+ZPuNqUgmVPXokxDgMJoGuNpMEtkfcf84=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "ae815cee91b417be55d43781eb4b73ae1ecc396c",
"rev": "9bb1e7571aadf31ddb4af77fc64b2d59580f9a39",
"type": "github"
},
"original": {

View File

@@ -1,6 +1,6 @@
{
"sdk": {
"version": "8.0.100",
"rollForward": "latestFeature"
"rollForward": "latestMajor"
}
}

View File

@@ -3,13 +3,13 @@
{fetchNuGet}: [
(fetchNuGet {
pname = "ApiSurface";
version = "4.0.44";
hash = "sha256-1su3UcdsyG9OoPwiMqo07rUMKhkVKlohRK4fA8mbxvI=";
version = "4.1.5";
hash = "sha256-Kbt18XLk1gvZfzGca885HaXZB119APay85KzI546PYM=";
})
(fetchNuGet {
pname = "fantomas";
version = "6.3.10";
hash = "sha256-2m4YevDp9CRm/Ci2hguDXd6DUMElRg3hNAne9LHntWM=";
version = "6.3.12";
hash = "sha256-LFZn2cO72FlsmLI0vTLz52Bn4XBeGILTOr8rz/EuXeg=";
})
(fetchNuGet {
pname = "Fantomas.Core";
@@ -28,8 +28,8 @@
})
(fetchNuGet {
pname = "fsharp-analyzers";
version = "0.26.1";
hash = "sha256-UqSK8PoXRJMZWKphMmWpl5klVn82EM1VczNZ1AOZ6Sw=";
version = "0.27.0";
hash = "sha256-QhLi2veTY1wZlQKJLTyVPgx/ImkaZugQNjSN5VJCNEA=";
})
(fetchNuGet {
pname = "FSharp.Core";
@@ -43,8 +43,8 @@
})
(fetchNuGet {
pname = "FSharp.Core";
version = "8.0.301";
hash = "sha256-LyP+zHxXFNksSQ/ExQ9CGkQYGvld8W6JNmxMg6lTRCs=";
version = "8.0.400";
hash = "sha256-wlrcAjjvI5YtnHR7kFH8uRUA4GomJYmqr41K5LYjCGs=";
})
(fetchNuGet {
pname = "FsUnit";
@@ -53,83 +53,83 @@
})
(fetchNuGet {
pname = "Microsoft.AspNetCore.App.Ref";
version = "6.0.32";
hash = "sha256-1mQTxwruzhm20YdlZefrYuy7xrBs17pH4Vo0K3Tl7Fc=";
version = "6.0.33";
hash = "sha256-GcPiO+iI0JsHYlqURAmzWjOnDX2jDCUY4jYaIwr8ojs=";
})
(fetchNuGet {
pname = "Microsoft.AspNetCore.App.Runtime.linux-arm64";
version = "6.0.32";
hash = "sha256-cIe0F+7rgwYSmh0VuFuQsUI9iEW5hn2KCD2H8Cs/k2g=";
version = "6.0.33";
hash = "sha256-g5zbB1DnCSKuCOWtF09GEqGn1uJLdlTN6kqdnSCzRjQ=";
})
(fetchNuGet {
pname = "Microsoft.AspNetCore.App.Runtime.linux-x64";
version = "6.0.32";
hash = "sha256-TkYv7h9NBr3I+FIaXeLU4MawJtgT2RWhs35ewGRDKx8=";
version = "6.0.33";
hash = "sha256-ToaiqVy5qonomAVBg5PO1GgrPKL4Cc1BZTJ0z/2LquA=";
})
(fetchNuGet {
pname = "Microsoft.AspNetCore.App.Runtime.osx-arm64";
version = "6.0.32";
hash = "sha256-RaC37ZQcJn7ykXJrtV7ibxh0GcalRyPKncxlqOLou+I=";
version = "6.0.33";
hash = "sha256-OY/vdqAzZ99I4lEZbOOQw12TE0AIb5pXxKTvDxO2M2Q=";
})
(fetchNuGet {
pname = "Microsoft.AspNetCore.App.Runtime.osx-x64";
version = "6.0.32";
hash = "sha256-vh/e46xM/HbhbBvL5eP5/DCHwCP2Bg7WoMS28nBXWV0=";
version = "6.0.33";
hash = "sha256-53MAV3RO1kXzy5IpdZDZIOhoUzFqWHn7+A3aWwdTONQ=";
})
(fetchNuGet {
pname = "Microsoft.CodeCoverage";
version = "17.10.0";
hash = "sha256-yQFwqVChRtIRpbtkJr92JH2i+O7xn91NGbYgnKs8G2g=";
version = "17.11.1";
hash = "sha256-1dLlK3NGh88PuFYZiYpT+izA96etxhU3BSgixDgdtGA=";
})
(fetchNuGet {
pname = "Microsoft.NET.Test.Sdk";
version = "17.10.0";
hash = "sha256-rkHIqB2mquNXF89XBTFpUL2z5msjTBsOcyjSBCh36I0=";
version = "17.11.1";
hash = "sha256-0JUEucQ2lzaPgkrjm/NFLBTbqU1dfhvhN3Tl3moE6mI=";
})
(fetchNuGet {
pname = "Microsoft.NETCore.App.Host.linux-arm64";
version = "6.0.32";
hash = "sha256-yDOkSHEGuGG6u+rB5u+IC3rc2tQwvbjdqmgHcl7Gkn4=";
version = "6.0.33";
hash = "sha256-rwWOpf2Pdg84c8bKIUcMYuDTI0kXUELL/nl9psSmX+E=";
})
(fetchNuGet {
pname = "Microsoft.NETCore.App.Host.linux-x64";
version = "6.0.32";
hash = "sha256-2aDGkn0QqXXHUUSAwtQQbjKl5I6S0fcQWPciqPnOiM4=";
version = "6.0.33";
hash = "sha256-5iYNZATXOePDsLA9lI80o1Gjxw4E+B4bJbwdYJJHcZY=";
})
(fetchNuGet {
pname = "Microsoft.NETCore.App.Host.osx-arm64";
version = "6.0.32";
hash = "sha256-n6hks4j88TRelq1O6SCeUH5GmxoSm5BWXGwnpnYJibI=";
version = "6.0.33";
hash = "sha256-k3LenomOlacyzq4FlBY/TwV7+ClbK4U0A/O9r0pZHT4=";
})
(fetchNuGet {
pname = "Microsoft.NETCore.App.Host.osx-x64";
version = "6.0.32";
hash = "sha256-nBBq4RYAgimBYOn/bN6JTFvJFYaqYXMHae2pmCzRaS8=";
version = "6.0.33";
hash = "sha256-tu72AwDH1+oAIXjOJcNbeyKm1s4pncYp0avbMSBrcJQ=";
})
(fetchNuGet {
pname = "Microsoft.NETCore.App.Ref";
version = "6.0.32";
hash = "sha256-Fm3RUZNcro434rIu3c7unGviGeGBjXj2dGnr2mmrM2g=";
version = "6.0.33";
hash = "sha256-BiGUcXo1FQTlZdR6ndhUQ8lrYG3KaGXNXRVF+Fc3L28=";
})
(fetchNuGet {
pname = "Microsoft.NETCore.App.Runtime.linux-arm64";
version = "6.0.32";
hash = "sha256-kdj8ia/2du2oKGg4MJdO2XytpT3gQ9UOiHVCyfiX2V8=";
version = "6.0.33";
hash = "sha256-obRKiJEVpZ5E3TE7q2oHaYwFYhI23rMiHwp+8ORkwXY=";
})
(fetchNuGet {
pname = "Microsoft.NETCore.App.Runtime.linux-x64";
version = "6.0.32";
hash = "sha256-/Hti30Ba12NDJQcG8pFTg6REVUDIrxZ/hRtEZNDlgxE=";
version = "6.0.33";
hash = "sha256-2xdhvnKsFc8utDWN09zeXzZ5op+WUqkoWLuzdtQAkrA=";
})
(fetchNuGet {
pname = "Microsoft.NETCore.App.Runtime.osx-arm64";
version = "6.0.32";
hash = "sha256-A8MFGOMXFROH1QGUE7xzq5b5EskDyIQCQt7SLfGdSbU=";
version = "6.0.33";
hash = "sha256-9KHubWicibZOcixiByzuBKPnJM2u5DSQC9jR3MAR1bI=";
})
(fetchNuGet {
pname = "Microsoft.NETCore.App.Runtime.osx-x64";
version = "6.0.32";
hash = "sha256-y5YB62WlMrK10bR/+nNpI8luVRlD9W9ZG3GsX7AXzUM=";
version = "6.0.33";
hash = "sha256-smh6SiTtCAuFglqWrXiGGsoIDP9dhGuIKdYjmw+xCyY=";
})
(fetchNuGet {
pname = "Microsoft.NETCore.Platforms";
@@ -153,13 +153,13 @@
})
(fetchNuGet {
pname = "Microsoft.TestPlatform.ObjectModel";
version = "17.10.0";
hash = "sha256-3YjVGK2zEObksBGYg8b/CqoJgLQ1jUv4GCWNjDhLRh4=";
version = "17.11.1";
hash = "sha256-5vX+vCzFY3S7xfMVIv8OlMMFtdedW9UIJzc0WEc+vm4=";
})
(fetchNuGet {
pname = "Microsoft.TestPlatform.TestHost";
version = "17.10.0";
hash = "sha256-+yzP3FY6WoOosSpYnB7duZLhOPUZMQYy8zJ1d3Q4hK4=";
version = "17.11.1";
hash = "sha256-wSkY0H1fQAq0H3LcKT4u7Y5RzhAAPa6yueVN84g8HxU=";
})
(fetchNuGet {
pname = "Myriad.Core";
@@ -173,8 +173,8 @@
})
(fetchNuGet {
pname = "Nerdbank.GitVersioning";
version = "3.6.141";
hash = "sha256-i1pBJ12vlPmde6qSQK4PG2QLSpjaUCoY+odTi24R5XI=";
version = "3.6.143";
hash = "sha256-OhOtMzP+2obDIR+npR7SsoXo0KrmcsL+VCE8Z3t5gzQ=";
})
(fetchNuGet {
pname = "NETStandard.Library";
@@ -193,38 +193,38 @@
})
(fetchNuGet {
pname = "NuGet.Common";
version = "6.10.1";
hash = "sha256-2gZe1zwSaZsr0nipaMBJixLEVOvR7vp75kwecSSYyfw=";
version = "6.11.0";
hash = "sha256-eb7G07RyZv4AQT6ItRqdBuUf9e9BXcQygsy5RNEXfNE=";
})
(fetchNuGet {
pname = "NuGet.Configuration";
version = "6.10.1";
hash = "sha256-RmjvlbtJssxuWEiOcVJLtUVT0nPn7IUPb878NmJbwmM=";
version = "6.11.0";
hash = "sha256-2SNZkX64SB15glzQx3k+vI7btr8Yqg4CayaaaK1B0AQ=";
})
(fetchNuGet {
pname = "NuGet.Frameworks";
version = "6.10.1";
hash = "sha256-AdfpuVDDy9zYAGgcMZoTf/fkFCJJVrxRFhsv6AI4Dd0=";
version = "6.11.0";
hash = "sha256-8DC7V2IlCjiMDQ9yWbl7QQHia6OpBrbWh5rL0qa0Opw=";
})
(fetchNuGet {
pname = "NuGet.Packaging";
version = "6.10.1";
hash = "sha256-ogsVjOao+LKUOMhGir1flDuMPjOeR2OpkNGHtr/riH4=";
version = "6.11.0";
hash = "sha256-LVLvxcB6SMdayxAsrc5bCuLLt25fqPr6KfYcYoWWIQk=";
})
(fetchNuGet {
pname = "NuGet.Protocol";
version = "6.10.1";
hash = "sha256-UeS/10z1EqswbeB0c7QgBIVOp0VGlN5ZDQqTY2/AhX8=";
version = "6.11.0";
hash = "sha256-3vdB/8IiJ2LMHhFXLWOzf0H59Ow/zcoq6W4uCHbihCQ=";
})
(fetchNuGet {
pname = "NuGet.Versioning";
version = "6.10.1";
hash = "sha256-jOh27AORk0TIhVePDVAgVhh6FuUo2v3oh/Xapcw7UVI=";
version = "6.11.0";
hash = "sha256-03edgWvbqUtbzpBBTIxTwsSRoj1T2muGVL+vTuIHXag=";
})
(fetchNuGet {
pname = "NUnit";
version = "4.1.0";
hash = "sha256-srzj0lf2ReKw41TnigZwf8rqKKNzGRRVrgN3hR/vRjo=";
version = "4.2.2";
hash = "sha256-+0OS67ITalmG9arYCgQF/+YbmPRnB3pIIykew0kvoCc=";
})
(fetchNuGet {
pname = "NUnit3TestAdapter";