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>
This commit is contained in:
Patrick Stevens
2025-11-19 07:53:15 +00:00
committed by GitHub
parent 6dee454229
commit 67e051b6b3
12 changed files with 2028 additions and 110 deletions

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

@@ -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

@@ -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" />

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$"
],