Compare commits

..

11 Commits

Author SHA1 Message Date
Patrick Stevens
67e051b6b3 Add --no- prefix for bools (#455)
Implements support for --no- prefix negation on boolean and flag DU fields
when marked with [<ArgumentNegateWithPrefix>]. This allows both --flag and
--no-flag forms to be accepted, with --no- variants negating the value.

Changes:
- Extend ArgParserGenerator to generate --no- prefix handling
- Add conflict detection for overlapping --no- prefixed arguments
- Update help text to display both forms (e.g., --verbose / --no-verbose)
- Add test examples in ArgParserNegationTests.fs demonstrating:
  - Boolean field negation
  - Flag DU negation
  - Multiple ArgumentLongForm with negation
  - Combined features (defaults, help text)

🤖 Generated with [Claude Code](https://claude.com/claude-code)

Co-Authored-By: Claude <noreply@anthropic.com>
2025-11-19 07:53:15 +00:00
dependabot[bot]
6dee454229 Bump ApiSurface from 5.0.2 to 5.0.3 (#452)
* Bump ApiSurface from 5.0.2 to 5.0.3

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

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

* Bump fsharp-analyzers from 0.33.1 to 0.34.1

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

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

* Bump Microsoft.NET.Test.Sdk from 18.0.0 to 18.0.1

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

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

* Deps

* 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>
2025-11-17 22:29:40 +00:00
patrick-conscriptus[bot]
e1767f5ed0 Automated commit (#451)
Co-authored-by: patrick-conscriptus[bot] <175414948+patrick-conscriptus[bot]@users.noreply.github.com>
2025-11-16 01:43:42 +00:00
dependabot[bot]
f95437aa48 Bump FsCheck from 3.3.1 to 3.3.2 (#449)
* Bump FsCheck from 3.3.1 to 3.3.2

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

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

* Bump Nerdbank.GitVersioning from 3.8.118 to 3.9.50

---
updated-dependencies:
- dependency-name: Nerdbank.GitVersioning
  dependency-version: 3.9.50
  dependency-type: direct:production
  update-type: version-update:semver-minor
...

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>
2025-11-10 17:50:04 +00:00
patrick-conscriptus[bot]
e9edf9dabc Automated commit (#448)
Co-authored-by: patrick-conscriptus[bot] <175414948+patrick-conscriptus[bot]@users.noreply.github.com>
2025-11-09 01:33:34 +00:00
patrick-conscriptus[bot]
d873850acf Automated commit (#447)
Co-authored-by: patrick-conscriptus[bot] <175414948+patrick-conscriptus[bot]@users.noreply.github.com>
2025-11-02 01:41:54 +00:00
dependabot[bot]
bd4905a236 Bump actions/upload-artifact from 4 to 5 (#446)
Bumps [actions/upload-artifact](https://github.com/actions/upload-artifact) from 4 to 5.
- [Release notes](https://github.com/actions/upload-artifact/releases)
- [Commits](https://github.com/actions/upload-artifact/compare/v4...v5)

---
updated-dependencies:
- dependency-name: actions/upload-artifact
  dependency-version: '5'
  dependency-type: direct:production
  update-type: version-update:semver-major
...

Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
Co-authored-by: Patrick Stevens <3138005+Smaug123@users.noreply.github.com>
2025-10-30 07:43:57 +00:00
dependabot[bot]
62daa84b26 Bump actions/download-artifact from 5 to 6 (#445) 2025-10-27 11:11:53 +00:00
patrick-conscriptus[bot]
4d5830d147 Automated commit (#444)
Co-authored-by: patrick-conscriptus[bot] <175414948+patrick-conscriptus[bot]@users.noreply.github.com>
2025-10-26 01:32:39 +00:00
patrick-conscriptus[bot]
6c2280c300 Automated commit (#443)
Co-authored-by: patrick-conscriptus[bot] <175414948+patrick-conscriptus[bot]@users.noreply.github.com>
2025-10-24 19:57:59 +00:00
dependabot[bot]
ecbe425f66 Bump WoofWare.Expect from 0.8.3 to 0.8.4 (#442)
* Bump WoofWare.Expect from 0.8.3 to 0.8.4

---
updated-dependencies:
- dependency-name: WoofWare.Expect
  dependency-version: 0.8.4
  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>
2025-10-20 13:15:33 +00:00
19 changed files with 2070 additions and 152 deletions

View File

@@ -9,10 +9,10 @@
]
},
"fsharp-analyzers": {
"version": "0.33.1",
"version": "0.34.1",
"commands": [
"fsharp-analyzers"
]
}
}
}
}

View File

@@ -167,12 +167,12 @@ jobs:
- name: Pack
run: nix develop --command dotnet pack --configuration Release
- name: Upload NuGet artifact (plugin)
uses: actions/upload-artifact@v4
uses: actions/upload-artifact@v5
with:
name: nuget-package-plugin
path: WoofWare.Myriad.Plugins/bin/Release/WoofWare.Myriad.Plugins.*.nupkg
- name: Upload NuGet artifact (attributes)
uses: actions/upload-artifact@v4
uses: actions/upload-artifact@v5
with:
name: nuget-package-attribute
path: WoofWare.Myriad.Plugins.Attributes/bin/Release/WoofWare.Myriad.Plugins.Attributes.*.nupkg
@@ -182,7 +182,7 @@ jobs:
runs-on: ubuntu-latest
steps:
- name: Download NuGet artifact (plugin)
uses: actions/download-artifact@v5
uses: actions/download-artifact@v6
with:
name: nuget-package-plugin
path: packed-plugin
@@ -190,7 +190,7 @@ jobs:
# Verify that there is exactly one nupkg in the artifact that would be NuGet published
run: if [[ $(find packed-plugin -maxdepth 1 -name 'WoofWare.Myriad.Plugins.*.nupkg' -printf c | wc -c) -ne "1" ]]; then exit 1; fi
- name: Download NuGet artifact (attributes)
uses: actions/download-artifact@v5
uses: actions/download-artifact@v6
with:
name: nuget-package-attribute
path: packed-attribute
@@ -209,7 +209,7 @@ jobs:
steps:
- uses: actions/checkout@v5
- name: Download NuGet artifact
uses: actions/download-artifact@v5
uses: actions/download-artifact@v6
with:
name: ${{ matrix.artifact }}
- name: Compute package path
@@ -249,7 +249,7 @@ jobs:
contents: read
steps:
- name: Download NuGet artifact
uses: actions/download-artifact@v5
uses: actions/download-artifact@v6
with:
name: nuget-package-attribute
path: packed
@@ -268,7 +268,7 @@ jobs:
contents: read
steps:
- name: Download NuGet artifact
uses: actions/download-artifact@v5
uses: actions/download-artifact@v6
with:
name: nuget-package-plugin
path: packed
@@ -294,7 +294,7 @@ jobs:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
- name: Download NuGet artifact
uses: actions/download-artifact@v5
uses: actions/download-artifact@v6
with:
name: nuget-package-attribute
path: packed
@@ -332,7 +332,7 @@ jobs:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
- name: Download NuGet artifact
uses: actions/download-artifact@v5
uses: actions/download-artifact@v6
with:
name: nuget-package-plugin
path: packed
@@ -368,7 +368,7 @@ jobs:
steps:
- uses: actions/checkout@v5
- name: Download NuGet artifact
uses: actions/download-artifact@v5
uses: actions/download-artifact@v6
with:
name: ${{ matrix.artifact }}
- name: Compute package path

View File

@@ -1,5 +1,16 @@
Notable changes are recorded here.
# WoofWare.Myriad.Plugins 9.1.1, WoofWare.Myriad.Plugins.Attributes 3.8.1
Adds the `[<ArgumentNegateWithPrefix>]` attribute, which can be placed on a boolean or flag-valued field when using the `ArgParser` generator.
This causes the boolean to be specifiable with the `--no-` prefix to negate its value.
(For example, `Foo : bool` is normally specified as `--foo`; this new attribute lets the user additionally give `--no-foo` to get the same semantics as `--foo=false`.)
# WoofWare.Myriad.Plugins 9.0.1
Converts the `static member Empty` field on each generated mock (from `GeneratedMock`) into a function, so as to permit the `GeneratedCapturingMock` to have the same signature.
(`GeneratedCapturingMock` contains mutable state, so must be created afresh each time.)
# WoofWare.Myriad.Plugins 8.1.1
Adds `GenerateCapturingMock`, which is `GenerateMock` but additionally records the calls made to each function.

View File

@@ -0,0 +1,124 @@
namespace ConsumePlugin
open WoofWare.Myriad.Plugins
// This file contains test cases for conflict detection in the ArgParser generator.
// These are expected to FAIL at build time with appropriate error messages.
// Uncomment each section one at a time to test the specific conflict detection.
// ============================================================================
// Test 1: Field named NoFooBar conflicts with FooBar's --no- variant
// ============================================================================
// Expected error: Argument name conflict: '--no-foo-bar' collides with the --no- variant
// of field 'FooBar' (which has [<ArgumentNegateWithPrefix>])
(*
[<ArgParser>]
type ConflictingFieldNames =
{
[<ArgumentNegateWithPrefix>]
FooBar : bool
NoFooBar : bool
}
*)
// ============================================================================
// Test 2: ArgumentLongForm "no-foo" conflicts with Foo's --no- variant
// ============================================================================
// Expected error: Argument name conflict: '--no-foo' collides with the --no- variant
// of field 'Foo' (which has [<ArgumentNegateWithPrefix>])
(*
[<ArgParser>]
type ConflictingLongForm =
{
[<ArgumentNegateWithPrefix>]
Foo : bool
[<ArgumentLongForm "no-foo">]
Bar : bool
}
*)
// ============================================================================
// Test 3: Multiple ArgumentLongForm, one conflicts
// ============================================================================
// Expected error: Argument name conflict: '--no-verbose' collides with...
(*
[<ArgParser>]
type ConflictingMultipleLongForms =
{
[<ArgumentLongForm "verbose">]
[<ArgumentLongForm "v">]
[<ArgumentNegateWithPrefix>]
VerboseMode : bool
[<ArgumentLongForm "no-verbose">]
Quiet : bool
}
*)
// ============================================================================
// Test 4: ArgumentNegateWithPrefix on non-boolean field
// ============================================================================
// Expected error: [<ArgumentNegateWithPrefix>] can only be applied to boolean
// or flag DU fields, but was applied to field NotABool of type string
(*
[<ArgParser>]
type InvalidAttributeOnNonBool =
{
[<ArgumentNegateWithPrefix>]
NotABool : string
}
*)
// ============================================================================
// Test 5: ArgumentNegateWithPrefix on non-flag int field
// ============================================================================
// Expected error: [<ArgumentNegateWithPrefix>] can only be applied to boolean
// or flag DU fields
(*
[<ArgParser>]
type InvalidAttributeOnInt =
{
[<ArgumentNegateWithPrefix>]
NotAFlag : int
}
*)
// ============================================================================
// Test 6: Complex conflict with custom names
// ============================================================================
// This tests a more complex scenario where a custom ArgumentLongForm creates
// a conflict with a different field's negated form
(*
[<ArgParser>]
type ComplexConflict =
{
[<ArgumentLongForm "enable">]
[<ArgumentNegateWithPrefix>]
FeatureA : bool
[<ArgumentLongForm "no-enable">]
DisableAll : bool
}
*)
// ============================================================================
// Test 7: Valid usage - no conflicts (this SHOULD compile)
// ============================================================================
[<ArgParser>]
type NoConflict =
{
[<ArgumentNegateWithPrefix>]
EnableFeature : bool
[<ArgumentNegateWithPrefix>]
VerboseMode : bool
NormalField : string
}

View File

@@ -0,0 +1,48 @@
namespace ConsumePlugin
open WoofWare.Myriad.Plugins
// Test types for ArgumentNegateWithPrefix functionality
type TestDryRunMode =
| [<ArgumentFlag false>] Wet
| [<ArgumentFlag true>] Dry
[<ArgParser true>]
type BoolNegation =
{
[<ArgumentNegateWithPrefix>]
EnableFeature : bool
}
[<ArgParser true>]
type FlagNegation =
{
[<ArgumentNegateWithPrefix>]
DryRun : TestDryRunMode
}
[<ArgParser true>]
type MultipleFormsNegation =
{
[<ArgumentLongForm "verbose">]
[<ArgumentLongForm "v">]
[<ArgumentNegateWithPrefix>]
VerboseMode : bool
}
[<ArgParser true>]
type CombinedFeatures =
{
[<ArgumentNegateWithPrefix>]
[<ArgumentDefaultFunction>]
Verbose : Choice<bool, bool>
[<ArgumentNegateWithPrefix>]
[<ArgumentHelpText "Enable debug mode">]
Debug : bool
NormalBool : bool
}
static member DefaultVerbose () = false

View File

@@ -89,6 +89,17 @@
<Compile Include="GeneratedArgs.fs">
<MyriadFile>Args.fs</MyriadFile>
</Compile>
<Compile Include="ArgParserNegationTests.fs" />
<Compile Include="GeneratedArgParserNegationTests.fs">
<MyriadFile>ArgParserNegationTests.fs</MyriadFile>
</Compile>
<!-- Not compiled, because by design they *don't* compile. That makes them very hard to test in an automated way! -->
<None Include="ArgParserConflictTests.fs" />
<!-- To run the conflict tests:
<Compile Include="GeneratedArgParserConflictTests.fs">
<MyriadFile>ArgParserConflictTests.fs</MyriadFile>
</Compile>
-->
<None Include="swagger-gitea.json" />
<Compile Include="GeneratedSwaggerGitea.fs">
<MyriadFile>swagger-gitea.json</MyriadFile>

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.8.118" PrivateAssets="all" />
<PackageReference Include="Nerdbank.GitVersioning" Version="3.9.50" PrivateAssets="all" />
<SourceLinkGitHubHost Include="github.com" ContentUrl="https://raw.githubusercontent.com" />
</ItemGroup>
<PropertyGroup Condition="'$(GITHUB_ACTION)' != ''">

View File

@@ -100,3 +100,24 @@ type ArgumentFlagAttribute (flagValue : bool) =
[<AttributeUsage(AttributeTargets.Field, AllowMultiple = true)>]
type ArgumentLongForm (s : string) =
inherit Attribute ()
/// Attribute indicating that this boolean or flag field should accept `--no-` prefix for negation.
/// When this attribute is present on a boolean or flag DU field, the generated parser will accept
/// both --field-name and --no-field-name as argument forms.
///
/// For boolean fields:
/// --field-name (or --field-name=true) sets the value to true
/// --no-field-name (or --no-field-name=true) sets the value to false
/// --field-name=false sets the value to false
/// --no-field-name=false sets the value to true
///
/// For flag DU fields with [<ArgumentFlag>]:
/// --field-name (or --field-name=true) sets to the case marked with [<ArgumentFlag true>]
/// --no-field-name (or --no-field-name=true) sets to the case marked with [<ArgumentFlag false>]
/// --field-name=false sets to the [<ArgumentFlag false>] case
/// --no-field-name=false sets to the [<ArgumentFlag true>] case
///
/// This attribute can only be applied to bool fields or flag DU fields (two-case DUs with [<ArgumentFlag>]).
[<AttributeUsage(AttributeTargets.Field, AllowMultiple = false)>]
type ArgumentNegateWithPrefixAttribute () =
inherit Attribute ()

View File

@@ -13,6 +13,8 @@ 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.ArgumentNegateWithPrefixAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.ArgumentNegateWithPrefixAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.CreateCatamorphismAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.CreateCatamorphismAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.GenerateCapturingMockAttribute inherit System.Attribute

View File

@@ -17,8 +17,8 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="ApiSurface" Version="5.0.2" />
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="18.0.0"/>
<PackageReference Include="ApiSurface" Version="5.0.3" />
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="18.0.1"/>
<PackageReference Include="NUnit" Version="4.3.2"/>
<PackageReference Include="NUnit3TestAdapter" Version="5.2.0"/>
</ItemGroup>

View File

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

View File

@@ -0,0 +1,372 @@
namespace WoofWare.Myriad.Plugins.Test
open System.Threading
open NUnit.Framework
open FsUnitTyped
open ConsumePlugin
[<TestFixture>]
module TestArgParserNegation =
[<Test>]
let ``Boolean field with ArgumentNegateWithPrefix: --foo sets to true`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--enable-feature" ]
result.EnableFeature |> shouldEqual true
[<Test>]
let ``Boolean field with ArgumentNegateWithPrefix: --foo=true sets to true`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--enable-feature=true" ]
result.EnableFeature |> shouldEqual true
[<Test>]
let ``Boolean field with ArgumentNegateWithPrefix: --foo true sets to true`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--enable-feature" ; "true" ]
result.EnableFeature |> shouldEqual true
[<Test>]
let ``Boolean field with ArgumentNegateWithPrefix: --foo=false sets to false`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--enable-feature=false" ]
result.EnableFeature |> shouldEqual false
[<Test>]
let ``Boolean field with ArgumentNegateWithPrefix: --foo false sets to false`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--enable-feature" ; "false" ]
result.EnableFeature |> shouldEqual false
[<Test>]
let ``Boolean field with ArgumentNegateWithPrefix: --no-foo sets to false`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--no-enable-feature" ]
result.EnableFeature |> shouldEqual false
[<Test>]
let ``Boolean field with ArgumentNegateWithPrefix: --no-foo=true sets to false`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--no-enable-feature=true" ]
result.EnableFeature |> shouldEqual false
[<Test>]
let ``Boolean field with ArgumentNegateWithPrefix: --no-foo true sets to false`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--no-enable-feature" ; "true" ]
result.EnableFeature |> shouldEqual false
[<Test>]
let ``Boolean field with ArgumentNegateWithPrefix: --no-foo=false sets to true`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--no-enable-feature=false" ]
result.EnableFeature |> shouldEqual true
[<Test>]
let ``Boolean field with ArgumentNegateWithPrefix: --no-foo false sets to true`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--no-enable-feature" ; "false" ]
result.EnableFeature |> shouldEqual true
[<Test>]
let ``Flag DU with ArgumentNegateWithPrefix: --dry-run sets to Dry`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--dry-run" ]
result.DryRun |> shouldEqual TestDryRunMode.Dry
[<Test>]
let ``Flag DU with ArgumentNegateWithPrefix: --dry-run=true sets to Dry`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--dry-run=true" ]
result.DryRun |> shouldEqual TestDryRunMode.Dry
[<Test>]
let ``Flag DU with ArgumentNegateWithPrefix: --dry-run true sets to Dry`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--dry-run" ; "true" ]
result.DryRun |> shouldEqual TestDryRunMode.Dry
[<Test>]
let ``Flag DU with ArgumentNegateWithPrefix: --dry-run=false sets to Wet`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--dry-run=false" ]
result.DryRun |> shouldEqual TestDryRunMode.Wet
[<Test>]
let ``Flag DU with ArgumentNegateWithPrefix: --dry-run false sets to Wet`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--dry-run" ; "false" ]
result.DryRun |> shouldEqual TestDryRunMode.Wet
[<Test>]
let ``Flag DU with ArgumentNegateWithPrefix: --no-dry-run sets to Wet`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--no-dry-run" ]
result.DryRun |> shouldEqual TestDryRunMode.Wet
[<Test>]
let ``Flag DU with ArgumentNegateWithPrefix: --no-dry-run=true sets to Wet`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--no-dry-run=true" ]
result.DryRun |> shouldEqual TestDryRunMode.Wet
[<Test>]
let ``Flag DU with ArgumentNegateWithPrefix: --no-dry-run true sets to Wet`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--no-dry-run" ; "true" ]
result.DryRun |> shouldEqual TestDryRunMode.Wet
[<Test>]
let ``Flag DU with ArgumentNegateWithPrefix: --no-dry-run=false sets to Dry`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--no-dry-run=false" ]
result.DryRun |> shouldEqual TestDryRunMode.Dry
[<Test>]
let ``Flag DU with ArgumentNegateWithPrefix: --no-dry-run false sets to Dry`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--no-dry-run" ; "false" ]
result.DryRun |> shouldEqual TestDryRunMode.Dry
[<Test>]
let ``ArgumentNegateWithPrefix works with multiple ArgumentLongForm: --verbose`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = MultipleFormsNegation.parse' getEnvVar [ "--verbose" ]
result.VerboseMode |> shouldEqual true
[<Test>]
let ``ArgumentNegateWithPrefix works with multiple ArgumentLongForm: --v`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = MultipleFormsNegation.parse' getEnvVar [ "--v" ]
result.VerboseMode |> shouldEqual true
[<Test>]
let ``ArgumentNegateWithPrefix works with multiple ArgumentLongForm: --no-verbose`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = MultipleFormsNegation.parse' getEnvVar [ "--no-verbose" ]
result.VerboseMode |> shouldEqual false
[<Test>]
let ``ArgumentNegateWithPrefix works with multiple ArgumentLongForm: --no-v`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = MultipleFormsNegation.parse' getEnvVar [ "--no-v" ]
result.VerboseMode |> shouldEqual false
[<Test>]
let ``ArgumentNegateWithPrefix works with multiple ArgumentLongForm: --verbose=false`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = MultipleFormsNegation.parse' getEnvVar [ "--verbose=false" ]
result.VerboseMode |> shouldEqual false
[<Test>]
let ``ArgumentNegateWithPrefix works with multiple ArgumentLongForm: --no-v=false`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = MultipleFormsNegation.parse' getEnvVar [ "--no-v=false" ]
result.VerboseMode |> shouldEqual true
[<Test>]
let ``Help text shows both standard and negated forms for boolean`` () =
let getEnvVar (_ : string) = failwith "do not call"
let exc =
Assert.Throws<exn> (fun () -> BoolNegation.parse' getEnvVar [ "--help" ] |> ignore<BoolNegation>)
exc.Message
|> shouldEqual
"""Help text requested.
--enable-feature / --no-enable-feature bool"""
[<Test>]
let ``Help text shows both standard and negated forms for flag DU`` () =
let getEnvVar (_ : string) = failwith "do not call"
let exc =
Assert.Throws<exn> (fun () -> FlagNegation.parse' getEnvVar [ "--help" ] |> ignore<FlagNegation>)
exc.Message
|> shouldEqual
"""Help text requested.
--dry-run / --no-dry-run bool"""
[<Test>]
let ``Help text with multiple long forms shows all variants`` () =
let getEnvVar (_ : string) = failwith "do not call"
let exc =
Assert.Throws<exn> (fun () ->
MultipleFormsNegation.parse' getEnvVar [ "--help" ]
|> ignore<MultipleFormsNegation>
)
exc.Message
|> shouldEqual
"""Help text requested.
--verbose / --v / --no-verbose / --no-v bool"""
[<Test>]
let ``Multiple occurrences error: --foo and --no-foo both supplied`` () =
let getEnvVar (_ : string) = failwith "should not call"
let exc =
Assert.Throws<exn> (fun () ->
BoolNegation.parse' getEnvVar [ "--enable-feature" ; "--no-enable-feature" ]
|> ignore<BoolNegation>
)
// Should report as duplicate argument
exc.Message |> shouldContainText "supplied multiple times"
[<Test>]
let ``Multiple occurrences error: --no-foo and --foo both supplied`` () =
let getEnvVar (_ : string) = failwith "should not call"
let exc =
Assert.Throws<exn> (fun () ->
BoolNegation.parse' getEnvVar [ "--no-enable-feature" ; "--enable-feature" ]
|> ignore<BoolNegation>
)
// Should report as duplicate argument
exc.Message |> shouldContainText "supplied multiple times"
[<Test>]
let ``Multiple occurrences error: --foo=true and --no-foo=false both supplied`` () =
let getEnvVar (_ : string) = failwith "should not call"
let exc =
Assert.Throws<exn> (fun () ->
BoolNegation.parse' getEnvVar [ "--enable-feature=true" ; "--no-enable-feature=false" ]
|> ignore<BoolNegation>
)
// Should report as duplicate argument
exc.Message |> shouldContainText "supplied multiple times"
[<Test>]
let ``CombinedFeatures: verbose with default value works with negation`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = CombinedFeatures.parse' getEnvVar [ "--debug" ; "--normal-bool" ]
result.Verbose |> shouldEqual (Choice2Of2 false)
result.Debug |> shouldEqual true
result.NormalBool |> shouldEqual true
[<Test>]
let ``CombinedFeatures: can override default with --verbose`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result =
CombinedFeatures.parse' getEnvVar [ "--verbose" ; "--debug" ; "--normal-bool" ]
result.Verbose |> shouldEqual (Choice1Of2 true)
result.Debug |> shouldEqual true
result.NormalBool |> shouldEqual true
[<Test>]
let ``CombinedFeatures: can override default with --no-verbose`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result =
CombinedFeatures.parse' getEnvVar [ "--no-verbose" ; "--debug" ; "--normal-bool" ]
result.Verbose |> shouldEqual (Choice1Of2 false)
result.Debug |> shouldEqual true
result.NormalBool |> shouldEqual true
[<Test>]
let ``CombinedFeatures: --no-debug sets debug to false`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = CombinedFeatures.parse' getEnvVar [ "--no-debug" ; "--normal-bool" ]
result.Debug |> shouldEqual false
[<Test>]
let ``CombinedFeatures: help text shows negation for fields with attribute`` () =
let getEnvVar (_ : string) = failwith "do not call"
let exc =
Assert.Throws<exn> (fun () -> CombinedFeatures.parse' getEnvVar [ "--help" ] |> ignore<CombinedFeatures>)
// Verbose and Debug should have --no- forms, NormalBool should not
exc.Message |> shouldContainText "--verbose / --no-verbose"
exc.Message |> shouldContainText "--debug / --no-debug"
exc.Message |> shouldContainText "--normal-bool bool"
exc.Message |> shouldNotContainText "--no-normal-bool"
[<Test>]
let ``Case insensitivity: --NO-ENABLE-FEATURE works`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--NO-ENABLE-FEATURE" ]
result.EnableFeature |> shouldEqual false
[<Test>]
let ``Case insensitivity: --No-Enable-Feature works`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--No-Enable-Feature" ]
result.EnableFeature |> shouldEqual false
[<Test>]
let ``Case insensitivity: --NO-DRY-RUN works`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--NO-DRY-RUN" ]
result.DryRun |> shouldEqual TestDryRunMode.Wet

View File

@@ -38,6 +38,7 @@
<Compile Include="TestCataGenerator\TestMyList.fs" />
<Compile Include="TestCataGenerator\TestMyList2.fs" />
<Compile Include="TestArgParser\TestArgParser.fs" />
<Compile Include="TestArgParser\TestArgParserNegation.fs" />
<Compile Include="TestSwagger\TestSwaggerParse.fs" />
<Compile Include="TestSwagger\TestOpenApi3Parse.fs" />
<EmbeddedResource Include="TestSwagger\api-with-examples.json" />
@@ -55,13 +56,13 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="ApiSurface" Version="5.0.2" />
<PackageReference Include="FsCheck" Version="3.3.1" />
<PackageReference Include="ApiSurface" Version="5.0.3" />
<PackageReference Include="FsCheck" Version="3.3.2" />
<PackageReference Include="FsUnit" Version="7.1.1" />
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="18.0.0" />
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="18.0.1" />
<PackageReference Include="NUnit" Version="4.3.2" />
<PackageReference Include="NUnit3TestAdapter" Version="5.2.0" />
<PackageReference Include="WoofWare.Expect" Version="0.8.3" />
<PackageReference Include="WoofWare.Expect" Version="0.8.4" />
</ItemGroup>
<ItemGroup>

View File

@@ -72,16 +72,38 @@ type private ParseFunction<'acc> =
/// and choices and so on.
TargetType : SynType
Accumulation : 'acc
/// If true, this boolean/flag field accepts --no- prefix for negation (has [<ArgumentNegateWithPrefix>])
AcceptsNegation : bool
}
/// A SynExpr of type `string` which we can display to the user at generated-program runtime to display all
/// the ways they can refer to this arg.
member arg.HumanReadableArgForm : SynExpr =
let formatString = List.replicate arg.ArgForm.Length "--%s" |> String.concat " / "
if arg.AcceptsNegation then
// Include both standard and --no- variants
// E.g., "--foo / --bar / --no-foo / --no-bar"
let standardFormatString =
List.replicate arg.ArgForm.Length "--%s" |> String.concat " / "
(SynExpr.applyFunction (SynExpr.createIdent "sprintf") (SynExpr.CreateConst formatString), arg.ArgForm)
||> List.fold SynExpr.applyFunction
|> SynExpr.paren
let negatedFormatString =
List.replicate arg.ArgForm.Length "--no-%s" |> String.concat " / "
let combinedFormatString = standardFormatString + " / " + negatedFormatString
// Apply all arg forms twice (once for standard, once for negated)
let allArgForms = arg.ArgForm @ arg.ArgForm
(SynExpr.applyFunction (SynExpr.createIdent "sprintf") (SynExpr.CreateConst combinedFormatString),
allArgForms)
||> List.fold SynExpr.applyFunction
|> SynExpr.paren
else
// Standard behavior: just --foo / --bar
let formatString = List.replicate arg.ArgForm.Length "--%s" |> String.concat " / "
(SynExpr.applyFunction (SynExpr.createIdent "sprintf") (SynExpr.CreateConst formatString), arg.ArgForm)
||> List.fold SynExpr.applyFunction
|> SynExpr.paren
[<RequireQualifiedAccess>]
type private ChoicePositional =
@@ -222,8 +244,8 @@ module private ParseTree =
nonPos @ nonPos2, Some pos
|> fun (nonPos, pos) ->
let duplicateArgs =
// This is best-effort. We can't necessarily detect all SynExprs here, but usually it'll be strings.
// Extract all arg form strings for validation
let allArgForms =
Option.toList (pos |> Option.map _.ArgForm) @ (nonPos |> List.map _.ArgForm)
|> Seq.concat
|> Seq.choose (fun expr ->
@@ -232,14 +254,57 @@ module private ParseTree =
| _ -> None
)
|> List.ofSeq
// Check for direct duplicates
let duplicateArgs =
allArgForms
|> List.groupBy id
|> List.choose (fun (key, v) -> if v.Length > 1 then Some key else None)
match duplicateArgs with
| [] -> nonPos, pos
| dups ->
| dups when not dups.IsEmpty ->
let dups = dups |> String.concat " "
failwith $"Duplicate args detected! %s{dups}"
| _ ->
// Check for --no- prefix conflicts
// Build a map of arg names that have AcceptsNegation=true
let negatedForms =
nonPos
|> List.filter _.AcceptsNegation
|> List.collect (fun pf ->
pf.ArgForm
|> List.choose (fun expr ->
match expr |> SynExpr.stripOptionalParen with
| SynExpr.Const (SynConst.String (s, _, _), _) -> Some (pf.FieldName.idText, s)
| _ -> None
)
)
|> List.map (fun (fieldName, argForm) -> $"no-%s{argForm}", fieldName)
|> Map.ofList
// Check if any existing arg form conflicts with a --no- variant
let conflicts =
allArgForms
|> List.choose (fun argForm ->
match negatedForms.TryFind argForm with
| Some fieldWithNegation -> Some (argForm, fieldWithNegation)
| None -> None
)
match conflicts with
| [] -> ()
| conflicts ->
let conflictMessages =
conflicts
|> List.map (fun (argForm, fieldWithNegation) ->
$"Argument name conflict: '--%s{argForm}' collides with the --no- variant of field '%s{fieldWithNegation}' (which has [<ArgumentNegateWithPrefix>])"
)
|> String.concat "\n"
failwith $"Conflicting argument names detected:\n%s{conflictMessages}"
nonPos, pos
/// Build the return value.
let rec instantiate<'a> (tree : ParseTree<'a>) : SynExpr =
@@ -615,6 +680,7 @@ module internal ArgParserGenerator =
ArgForm = longForms
Help = helpText
BoolCases = isBoolLike
AcceptsNegation = false
}
|> fun t -> ParseTree.PositionalLeaf (t, Teq.refl)
| Accumulation.List Accumulation.Required ->
@@ -627,6 +693,7 @@ module internal ArgParserGenerator =
ArgForm = longForms
Help = helpText
BoolCases = isBoolLike
AcceptsNegation = false
}
|> fun t -> ParseTree.PositionalLeaf (t, Teq.refl)
| Accumulation.Choice _
@@ -651,6 +718,27 @@ module internal ArgParserGenerator =
Some (Choice2Of2 ())
| parseTy -> identifyAsFlag flagDus parseTy |> Option.map Choice1Of2
let hasNegateAttr =
attrs
|> List.exists (fun attr ->
match attr.TypeName with
| SynLongIdent.SynLongIdent (ident, _, _) ->
match (List.last ident).idText with
| "ArgumentNegateWithPrefixAttribute"
| "ArgumentNegateWithPrefix" -> true
| _ -> false
)
let acceptsNegation =
if hasNegateAttr then
match isBoolLike with
| Some _ -> true
| None ->
failwith
$"[<ArgumentNegateWithPrefix>] can only be applied to boolean or flag DU fields, but was applied to field %s{ident.idText} of type %O{fieldType}"
else
false
{
FieldName = ident
Parser = parser
@@ -660,6 +748,7 @@ module internal ArgParserGenerator =
ArgForm = longForms
Help = helpText
BoolCases = isBoolLike
AcceptsNegation = acceptsNegation
}
|> fun t -> ParseTree.NonPositionalLeaf (t, Teq.refl)
|> ParseTreeCrate.make
@@ -773,6 +862,37 @@ module internal ArgParserGenerator =
)
|> SynBinding.basic [ Ident.create "helpText" ] [ SynPat.unit ]
/// Helper to create a negated parser for boolean/flag fields.
/// Returns a SynExpr that represents: string -> (negated bool or negated flag DU)
/// For booleans: `fun x -> not (Boolean.Parse x)`
/// For flag DUs: `fun x -> FlagDu.FromBoolean flagDu (not (Boolean.Parse x))`
let private createNegatedParser (arg : ParseFunction<'acc>) : SynExpr =
match arg.BoolCases with
| None -> failwith $"LOGIC ERROR: createNegatedParser called on non-boolean field %s{arg.FieldName.idText}"
| Some (Choice2Of2 ()) ->
// Boolean: parse and negate
// fun x -> not (System.Boolean.Parse x)
let parseExpr =
SynExpr.createIdent "x"
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Boolean" ; "Parse" ])
|> SynExpr.paren
parseExpr
|> SynExpr.applyFunction (SynExpr.createIdent "not")
|> SynExpr.createLambda "x"
| Some (Choice1Of2 flagDu) ->
// Flag DU: parse as bool, negate, then convert to flag DU
// fun x -> x |> System.Boolean.Parse |> not |> FlagDu.FromBoolean flagDu
let parseExpr =
SynExpr.createIdent "x"
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Boolean" ; "Parse" ])
|> SynExpr.paren
parseExpr
|> SynExpr.applyFunction (SynExpr.createIdent "not")
|> FlagDu.FromBoolean flagDu
|> SynExpr.createLambda "x"
/// `let processKeyValue (key : string) (value : string) : Result<unit, string option> = ...`
/// Returns a possible error.
/// A parse failure might not be fatal (e.g. maybe the input was optionally of arity 0, and we failed to do
@@ -786,109 +906,209 @@ module internal ArgParserGenerator =
let args =
args
|> List.map (fun arg ->
match arg.Accumulation with
| Accumulation.Required
| Accumulation.Choice _
| Accumulation.Optional ->
let multipleErrorMessage =
SynExpr.createIdent "sprintf"
|> SynExpr.applyTo (SynExpr.CreateConst "Argument '%s' was supplied multiple times: %s and %s")
|> SynExpr.applyTo arg.HumanReadableArgForm
|> SynExpr.applyTo (SynExpr.createIdent "x" |> SynExpr.callMethod "ToString" |> SynExpr.paren)
|> SynExpr.applyTo (
SynExpr.createIdent "value" |> SynExpr.callMethod "ToString" |> SynExpr.paren
)
let assignmentExpr =
match arg.Accumulation with
| Accumulation.Required
| Accumulation.Choice _
| Accumulation.Optional ->
let multipleErrorMessage =
SynExpr.createIdent "sprintf"
|> SynExpr.applyTo (
SynExpr.CreateConst "Argument '%s' was supplied multiple times: %s and %s"
)
|> SynExpr.applyTo arg.HumanReadableArgForm
|> SynExpr.applyTo (
SynExpr.createIdent "x" |> SynExpr.callMethod "ToString" |> SynExpr.paren
)
|> SynExpr.applyTo (
SynExpr.createIdent "value" |> SynExpr.callMethod "ToString" |> SynExpr.paren
)
let performAssignment =
let performAssignment =
[
SynExpr.createIdent "value"
|> SynExpr.pipeThroughFunction arg.Parser
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some")
|> SynExpr.assign (SynLongIdent.createI arg.TargetVariable)
SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ())
]
|> SynExpr.sequential
[
SynMatchClause.create
(SynPat.nameWithArgs "Some" [ SynPat.named "x" ])
(SynExpr.sequential
[
multipleErrorMessage
|> SynExpr.pipeThroughFunction (
SynExpr.dotGet "Add" (SynExpr.createIdent' argParseErrors)
)
SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ())
])
SynMatchClause.create
(SynPat.named "None")
(SynExpr.pipeThroughTryWith
SynPat.anon
(SynExpr.createLongIdent [ "exc" ; "Message" ]
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some")
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Error"))
performAssignment)
]
|> SynExpr.createMatch (SynExpr.createIdent' arg.TargetVariable)
| Accumulation.List (Accumulation.List _)
| Accumulation.List Accumulation.Optional
| Accumulation.List (Accumulation.Choice _) ->
failwith
"WoofWare.Myriad invariant violated: expected a list to contain only a Required accumulation. Non-positional lists cannot be optional or Choice, nor can they themselves contain lists."
| Accumulation.List Accumulation.Required ->
[
SynExpr.createIdent "value"
|> SynExpr.pipeThroughFunction arg.Parser
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some")
|> SynExpr.assign (SynLongIdent.createI arg.TargetVariable)
SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ())
|> SynExpr.pipeThroughFunction (
SynExpr.createLongIdent' [ arg.TargetVariable ; Ident.create "Add" ]
)
SynExpr.CreateConst () |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Ok")
]
|> SynExpr.sequential
[
SynMatchClause.create
(SynPat.nameWithArgs "Some" [ SynPat.named "x" ])
(SynExpr.sequential
[
multipleErrorMessage
|> SynExpr.pipeThroughFunction (
SynExpr.dotGet "Add" (SynExpr.createIdent' argParseErrors)
)
SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ())
])
SynMatchClause.create
(SynPat.named "None")
(SynExpr.pipeThroughTryWith
SynPat.anon
(SynExpr.createLongIdent [ "exc" ; "Message" ]
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some")
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Error"))
performAssignment)
]
|> SynExpr.createMatch (SynExpr.createIdent' arg.TargetVariable)
| Accumulation.List (Accumulation.List _)
| Accumulation.List Accumulation.Optional
| Accumulation.List (Accumulation.Choice _) ->
failwith
"WoofWare.Myriad invariant violated: expected a list to contain only a Required accumulation. Non-positional lists cannot be optional or Choice, nor can they themselves contain lists."
| Accumulation.List Accumulation.Required ->
[
SynExpr.createIdent "value"
|> SynExpr.pipeThroughFunction arg.Parser
|> SynExpr.pipeThroughFunction (
SynExpr.createLongIdent' [ arg.TargetVariable ; Ident.create "Add" ]
)
SynExpr.CreateConst () |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Ok")
]
|> SynExpr.sequential
|> fun expr -> arg.ArgForm, expr
// Return (argForms, assignmentExpr), argMetadata
(arg.ArgForm, assignmentExpr), Some arg
)
let posArg =
match pos with
| None -> []
| Some pos ->
[
SynExpr.createIdent "value"
|> SynExpr.pipeThroughFunction pos.Parser
|> fun p ->
match pos.Accumulation with
| ChoicePositional.Choice _ ->
p |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2")
| ChoicePositional.Normal _ -> p
|> SynExpr.pipeThroughFunction (
SynExpr.createLongIdent' [ pos.TargetVariable ; Ident.create "Add" ]
)
SynExpr.CreateConst () |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Ok")
]
|> SynExpr.sequential
|> fun expr -> pos.ArgForm, expr
|> List.singleton
let posExpr =
[
SynExpr.createIdent "value"
|> SynExpr.pipeThroughFunction pos.Parser
|> fun p ->
match pos.Accumulation with
| ChoicePositional.Choice _ ->
p |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2")
| ChoicePositional.Normal _ -> p
|> SynExpr.pipeThroughFunction (
SynExpr.createLongIdent' [ pos.TargetVariable ; Ident.create "Add" ]
)
SynExpr.CreateConst () |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Ok")
]
|> SynExpr.sequential
// Positional args don't support negation, so metadata is None
[ (pos.ArgForm, posExpr), None ]
(SynExpr.applyFunction (SynExpr.createIdent "Error") (SynExpr.createIdent "None"), posArg @ args)
||> List.fold (fun finalBranch (argForm, arg) ->
||> List.fold (fun finalBranch ((argForm, arg), argMetadata) ->
(finalBranch, argForm)
||> List.fold (fun finalBranch argForm ->
arg
|> SynExpr.ifThenElse
(SynExpr.applyFunction
(SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
(SynExpr.tuple
// Standard match: --argForm
let standardMatch =
arg
|> SynExpr.ifThenElse
(SynExpr.applyFunction
(SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
(SynExpr.tuple
[
SynExpr.createIdent "key"
SynExpr.applyFunction
(SynExpr.applyFunction
(SynExpr.createIdent "sprintf")
(SynExpr.CreateConst "--%s"))
argForm
SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
]))
finalBranch
// If this arg accepts negation, also match --no-argForm
match argMetadata with
| None -> standardMatch
| Some (parseFn : ParseFunctionNonPositional) when parseFn.AcceptsNegation ->
// Create negated assignment (same structure as `arg` but with negated parser)
let negatedParser = createNegatedParser parseFn
let negatedArg =
match parseFn.Accumulation with
| Accumulation.Required
| Accumulation.Choice _
| Accumulation.Optional ->
let multipleErrorMessage =
SynExpr.createIdent "sprintf"
|> SynExpr.applyTo (
SynExpr.CreateConst "Argument '%s' was supplied multiple times: %s and %s"
)
|> SynExpr.applyTo parseFn.HumanReadableArgForm
|> SynExpr.applyTo (
SynExpr.createIdent "x" |> SynExpr.callMethod "ToString" |> SynExpr.paren
)
|> SynExpr.applyTo (
SynExpr.createIdent "value" |> SynExpr.callMethod "ToString" |> SynExpr.paren
)
let performNegatedAssignment =
[
SynExpr.createIdent "value"
|> SynExpr.pipeThroughFunction negatedParser
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some")
|> SynExpr.assign (SynLongIdent.createI parseFn.TargetVariable)
SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ())
]
|> SynExpr.sequential
[
SynExpr.createIdent "key"
SynExpr.applyFunction
(SynExpr.applyFunction
(SynExpr.createIdent "sprintf")
(SynExpr.CreateConst "--%s"))
argForm
SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
]))
finalBranch
SynMatchClause.create
(SynPat.nameWithArgs "Some" [ SynPat.named "x" ])
(SynExpr.sequential
[
multipleErrorMessage
|> SynExpr.pipeThroughFunction (
SynExpr.dotGet "Add" (SynExpr.createIdent' argParseErrors)
)
SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ())
])
SynMatchClause.create
(SynPat.named "None")
(SynExpr.pipeThroughTryWith
SynPat.anon
(SynExpr.createLongIdent [ "exc" ; "Message" ]
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some")
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Error"))
performNegatedAssignment)
]
|> SynExpr.createMatch (SynExpr.createIdent' parseFn.TargetVariable)
| Accumulation.List Accumulation.Required ->
[
SynExpr.createIdent "value"
|> SynExpr.pipeThroughFunction negatedParser
|> SynExpr.pipeThroughFunction (
SynExpr.createLongIdent' [ parseFn.TargetVariable ; Ident.create "Add" ]
)
SynExpr.CreateConst () |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Ok")
]
|> SynExpr.sequential
| _ ->
failwith
"WoofWare.Myriad invariant violated: unexpected accumulation type for negated arg"
// Match --no-argForm
negatedArg
|> SynExpr.ifThenElse
(SynExpr.applyFunction
(SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
(SynExpr.tuple
[
SynExpr.createIdent "key"
SynExpr.applyFunction
(SynExpr.applyFunction
(SynExpr.createIdent "sprintf")
(SynExpr.CreateConst "--no-%s"))
argForm
SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
]))
standardMatch
| Some _ -> standardMatch
)
)
|> SynBinding.basic
@@ -909,6 +1129,34 @@ module internal ArgParserGenerator =
|> PreXmlDoc.create'
)
/// Try to extract a constant bool value from a SynExpr.
/// Returns Some true/false if the expr is a constant bool, None otherwise.
let private tryGetConstBool (expr : SynExpr) : bool option =
match expr |> SynExpr.stripOptionalParen with
| SynExpr.Const (SynConst.Bool v, _) -> Some v
| _ -> None
/// Helper to get the "false" case for a boolean/flag field.
/// For booleans: `false`
/// For flag DUs: the case marked with [<ArgumentFlag false>]
let private getFalseCase (flag : ParseFunction<'a>) : SynExpr =
match flag.BoolCases with
| None -> failwith $"LOGIC ERROR: getFalseCase called on non-boolean field %s{flag.FieldName.idText}"
| Some (Choice2Of2 ()) ->
// Boolean: return false
SynExpr.CreateConst false
| Some (Choice1Of2 flagDu) ->
// Flag DU: return the case associated with false
// Check which case has false as its arg
match tryGetConstBool flagDu.Case1Arg, tryGetConstBool flagDu.Case2Arg with
| Some false, _ -> SynExpr.createLongIdent' [ flagDu.Name ; flagDu.Case1Name ]
| _, Some false -> SynExpr.createLongIdent' [ flagDu.Name ; flagDu.Case2Name ]
| Some true, _ -> SynExpr.createLongIdent' [ flagDu.Name ; flagDu.Case2Name ]
| _, Some true -> SynExpr.createLongIdent' [ flagDu.Name ; flagDu.Case1Name ]
| None, None ->
// Can't determine at compile time, use FlagDu.FromBoolean with false
FlagDu.FromBoolean flagDu (SynExpr.CreateConst false)
/// `let setFlagValue (key : string) : bool = ...`
/// The second member of the `flags` list tuple is the constant "true" with which we will interpret the
/// arity-0 `--foo`. So in the case of a boolean-typed field, this is `true`; in the case of a Flag-typed field,
@@ -949,21 +1197,72 @@ module internal ArgParserGenerator =
(finalExpr, flag.ArgForm)
||> List.fold (fun finalExpr argForm ->
SynExpr.ifThenElse
(SynExpr.applyFunction
(SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
(SynExpr.tuple
[
SynExpr.createIdent "key"
SynExpr.applyFunction
(SynExpr.applyFunction
(SynExpr.createIdent "sprintf")
(SynExpr.CreateConst "--%s"))
argForm
SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
]))
finalExpr
matchFlag
// Standard match: --argForm sets to trueCase
let standardMatch =
SynExpr.ifThenElse
(SynExpr.applyFunction
(SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
(SynExpr.tuple
[
SynExpr.createIdent "key"
SynExpr.applyFunction
(SynExpr.applyFunction
(SynExpr.createIdent "sprintf")
(SynExpr.CreateConst "--%s"))
argForm
SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
]))
finalExpr
matchFlag
// If this flag accepts negation, also match --no-argForm sets to falseCase
if flag.AcceptsNegation then
let falseCase = getFalseCase flag
let matchNegatedFlag =
[
SynMatchClause.create
(SynPat.nameWithArgs "Some" [ SynPat.named "x" ])
// This is an error, but it's one we can gracefully report at the end.
(SynExpr.sequential
[
multipleErrorMessage
|> SynExpr.pipeThroughFunction (
SynExpr.dotGet "Add" (SynExpr.createIdent' argParseErrors)
)
SynExpr.CreateConst true
])
SynMatchClause.create
(SynPat.named "None")
([
SynExpr.assign
(SynLongIdent.createI flag.TargetVariable)
(SynExpr.pipeThroughFunction (SynExpr.createIdent "Some") falseCase)
SynExpr.CreateConst true
]
|> SynExpr.sequential)
]
|> SynExpr.createMatch (SynExpr.createIdent' flag.TargetVariable)
// Match --no-argForm
SynExpr.ifThenElse
(SynExpr.applyFunction
(SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
(SynExpr.tuple
[
SynExpr.createIdent "key"
SynExpr.applyFunction
(SynExpr.applyFunction
(SynExpr.createIdent "sprintf")
(SynExpr.CreateConst "--no-%s"))
argForm
SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
]))
standardMatch
matchNegatedFlag
else
standardMatch
)
)
|> SynBinding.basic [ Ident.create "setFlagValue" ] [ SynPat.annotateType SynType.string (SynPat.named "key") ]

View File

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

View File

@@ -10,8 +10,8 @@
</PropertyGroup>
<ItemGroup>
<PackageDownload Include="WoofWare.FSharpAnalyzers" Version="[0.2.1]" />
<PackageDownload Include="G-Research.FSharp.Analyzers" Version="[0.19.0]" />
<PackageDownload Include="WoofWare.FSharpAnalyzers" Version="[0.2.2]" />
<PackageDownload Include="G-Research.FSharp.Analyzers" Version="[0.20.0]" />
</ItemGroup>
</Project>

6
flake.lock generated
View File

@@ -20,11 +20,11 @@
},
"nixpkgs": {
"locked": {
"lastModified": 1760596604,
"narHash": "sha256-J/i5K6AAz/y5dBePHQOuzC7MbhyTOKsd/GLezSbEFiM=",
"lastModified": 1763191728,
"narHash": "sha256-esRhOS0APE6k40Hs/jjReXg+rx+J5LkWw7cuWFKlwYA=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "3cbe716e2346710d6e1f7c559363d14e11c32a43",
"rev": "1d4c88323ac36805d09657d13a5273aea1b34f0c",
"type": "github"
},
"original": {

View File

@@ -1,8 +1,8 @@
[
{
"pname": "ApiSurface",
"version": "5.0.2",
"hash": "sha256-zcq1H1ccQzsZQf4kolzoOBSbyz07skihgPAvQ9Jri+E="
"version": "5.0.3",
"hash": "sha256-uU5mqLL6zMt17oPYMzhB57ryYC6O6FzSjmdTFg7LvNo="
},
{
"pname": "fantomas",
@@ -26,13 +26,13 @@
},
{
"pname": "FsCheck",
"version": "3.3.1",
"hash": "sha256-k65ksdOSOGz+meRUUND+yuqJtm5ChaKuaxmRIdKzx2Y="
"version": "3.3.2",
"hash": "sha256-3ydyTGpqySynjbcWbmFVeCBnT3KDH3miPSJYJlyxrGs="
},
{
"pname": "fsharp-analyzers",
"version": "0.33.1",
"hash": "sha256-vYXvqnf3en487svFv3CmNl24SolwMYzu6zKKGXNxSu8="
"version": "0.34.1",
"hash": "sha256-Y6PzfVGob2EgX29ZhZIde5EhiZ28Y1+U2pJ6ybIsHV0="
},
{
"pname": "FSharp.Core",
@@ -91,13 +91,13 @@
},
{
"pname": "Microsoft.CodeCoverage",
"version": "18.0.0",
"hash": "sha256-1RNxheCYASMusDC48BXtaO3MhnInw15JVfjfLM1VMGA="
"version": "18.0.1",
"hash": "sha256-G6y5iyHZ3R2shlLCW/uTusio/UqcnWT79X+UAbxvDQY="
},
{
"pname": "Microsoft.NET.Test.Sdk",
"version": "18.0.0",
"hash": "sha256-9iW+9mvMeZgDXwSoR08bnvRNsN4jT8OVWcjq3lcE+cs="
"version": "18.0.1",
"hash": "sha256-0c3/rp9di0w7E5UmfRh6Prrm3Aeyi8NOj5bm2i6jAh0="
},
{
"pname": "Microsoft.NETCore.App.Host.linux-arm64",
@@ -201,13 +201,13 @@
},
{
"pname": "Microsoft.TestPlatform.ObjectModel",
"version": "18.0.0",
"hash": "sha256-O/ivHdoIO+q1n0byJ9OZO4quOqACOD3K3Qm00wfhuZk="
"version": "18.0.1",
"hash": "sha256-oJbS7SZ46RzyOQ+gCysW7qJRy7V8RlQVa5d8uajb91M="
},
{
"pname": "Microsoft.TestPlatform.TestHost",
"version": "18.0.0",
"hash": "sha256-qAIX2Rqxrnh1xaYRjCbkkvvMm407oyKihqyVjURX5wY="
"version": "18.0.1",
"hash": "sha256-OXYf5vg4piDr10ve0bZ2ZSb+nb3yOiHayJV3cu5sMV4="
},
{
"pname": "Myriad.Core",
@@ -221,8 +221,8 @@
},
{
"pname": "Nerdbank.GitVersioning",
"version": "3.8.118",
"hash": "sha256-Hmyy0ZKOmwN4zIhI4+MqoN8geZNc1sd033aZJ6APrO8="
"version": "3.9.50",
"hash": "sha256-BiBfXwr8ob2HTaFk2L5TwAgtvd/EPoqudSI9nhAjQPI="
},
{
"pname": "NETStandard.Library",
@@ -386,8 +386,8 @@
},
{
"pname": "WoofWare.Expect",
"version": "0.8.3",
"hash": "sha256-Fc4xpqXjD2hMnaR9kxYiXi/Kxhy6T1QA5Xe2XjTM/t8="
"version": "0.8.4",
"hash": "sha256-UI7f2nt4g4Gg1Ke/IChrA4fpVOYAChXpvR6zkKfkmzE="
},
{
"pname": "WoofWare.Whippet.Fantomas",