Skip to content

Commit 9d2113e

Browse files
Smaug123claude
Smaug123
and
claude
committed
Group union alternatives in help text; test case-payload defaults
Help was flattening the parse tree, presenting e.g. --foo, --bar and --baz as one undifferentiated list with nothing to say that the grammar is `--foo` XOR (`--bar` AND `--baz`). Help is now a fold of the parse tree: each union renders as an "exactly one of the following sets of arguments:" header with its alternatives' arguments grouped beneath their case names, indenting two spaces per nesting level. Parsers with no union render byte-identically to before. Also exercise [<ArgumentDefaultFunction>] on a union case's payload record end to end: the generated call resolves against the payload record (fixed one level down the stack), the defaulted case is selectable by an empty command line, and the default does not influence case selection. Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
1 parent 76f74a7 commit 9d2113e

5 files changed

Lines changed: 419 additions & 49 deletions

File tree

‎ConsumePlugin/DuArgs.fs‎

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -43,3 +43,25 @@ type WithModeArgs =
4343
Verbose : bool
4444
Mode : Mode
4545
}
46+
47+
type DefaultedArgs =
48+
{
49+
[<ArgumentDefaultFunction>]
50+
Retries : Choice<int, int>
51+
}
52+
53+
/// The default-function convention resolves against the record which declares the field
54+
/// (this case's payload record), not against the [<ArgParser>]-tagged union.
55+
static member DefaultRetries () = 3
56+
57+
type PlainArgs =
58+
{
59+
Value : int
60+
}
61+
62+
/// A union case whose payload record carries a default function. The default makes the case
63+
/// satisfiable with no arguments, but must not influence which case is selected.
64+
[<ArgParser>]
65+
type DuWithDefaultArgs =
66+
| Defaulted of DefaultedArgs
67+
| Plain of PlainArgs

‎ConsumePlugin/GeneratedArgs.fs‎

Lines changed: 21 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -3122,11 +3122,14 @@ module ParentRecordChildDefaultArgParse =
31223122
}
31233123
]
31243124
Tree =
3125-
(ArgParserRuntime_BasicNoPositionals.ErasedTree.Product[ArgParserRuntime_BasicNoPositionals.ErasedTree.Leaf
3126-
0
3127-
3128-
ArgParserRuntime_BasicNoPositionals.ErasedTree.Leaf
3129-
1])
3125+
(ArgParserRuntime_BasicNoPositionals.ErasedTree.Product (
3126+
[
3127+
ArgParserRuntime_BasicNoPositionals.ErasedTree.Product (
3128+
[ ArgParserRuntime_BasicNoPositionals.ErasedTree.Leaf 0 ]
3129+
)
3130+
ArgParserRuntime_BasicNoPositionals.ErasedTree.Leaf 1
3131+
]
3132+
))
31303133
Positional = None
31313134
}
31323135

@@ -3204,26 +3207,22 @@ module ParentRecordChildDefaultArgParse =
32043207
parser_callbacks
32053208
args
32063209
with
3207-
| ArgParserRuntime_BasicNoPositionals.ParseOutcome.Success ->
3208-
let arg_0 =
3209-
match arg_0 with
3210-
| Some x -> x
3211-
| None ->
3212-
failwith
3213-
"WoofWare.Myriad internal error in generated parser: required argument missing after successful parse"
3214-
3215-
let arg_1 =
3216-
match arg_1 with
3217-
| Some x -> x
3218-
| None ->
3219-
failwith
3220-
"WoofWare.Myriad internal error in generated parser: required argument missing after successful parse"
3221-
3210+
| ArgParserRuntime_BasicNoPositionals.ParseOutcome.Success parser_selection ->
32223211
{
3223-
AndAnother = arg_1
3212+
AndAnother =
3213+
(match arg_1 with
3214+
| Some x -> x
3215+
| None ->
3216+
failwith
3217+
"WoofWare.Myriad internal error in generated parser: required argument missing after successful parse")
32243218
Child =
32253219
{
3226-
FromFunction = arg_0
3220+
FromFunction =
3221+
(match arg_0 with
3222+
| Some x -> x
3223+
| None ->
3224+
failwith
3225+
"WoofWare.Myriad internal error in generated parser: required argument missing after successful parse")
32273226
}
32283227
}
32293228
| ArgParserRuntime_BasicNoPositionals.ParseOutcome.HelpRequested ->

‎ConsumePlugin/GeneratedDuArgs.fs‎

Lines changed: 251 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -593,6 +593,13 @@ module private ArgParserRuntime_DuArgs =
593593
| NoForms of leafId : int
594594
/// A leaf accepts `--no-` negation but is not boolean-like.
595595
| NegationOnNonBool of leafId : int
596+
/// A form is the empty string: its token would be `--`, which the scanner always
597+
/// treats as the positional separator, so the argument could never be addressed.
598+
| EmptyForm of claimant : string
599+
/// A form contains an equals sign: the scanner splits a `--key=value` token at its
600+
/// *first* `=`, so such a form can never match. An argument required under such a form
601+
/// makes the schema (or a union case of it) permanently unsatisfiable.
602+
| FormContainsEquals of claimant : string * form : string
596603
/// Two distinct claimants respond to the same `--token` under the scanner's
597604
/// case-insensitive matching (so e.g. forms `foo` and `FOO` collide, as do a literal
598605
/// form `no-foo` and the negated variant of a negatable `foo`). The token is reported
@@ -616,6 +623,13 @@ module private ArgParserRuntime_DuArgs =
616623
| SchemaError.NoForms leafId -> sprintf "argument id %i has no names" leafId
617624
| SchemaError.NegationOnNonBool leafId ->
618625
sprintf "argument id %i accepts --no- negation but is not boolean-like" leafId
626+
| SchemaError.EmptyForm claimant ->
627+
sprintf "%s has an empty name: its token would be '--', which is the positional separator" claimant
628+
| SchemaError.FormContainsEquals (claimant, form) ->
629+
sprintf
630+
"%s has the name '%s', which contains '='; a --key=value token splits at its first '=', so this argument could never be addressed"
631+
claimant
632+
form
619633
| SchemaError.TokenCollision (token, claimants) ->
620634
sprintf
621635
"the token '%s' is claimed by: %s (argument names are matched case-insensitively)"
@@ -718,13 +732,60 @@ module private ArgParserRuntime_DuArgs =
718732
@ [ "--help", "the built-in help flag" ]
719733

720734
let collisions =
721-
claims
722-
|> List.groupBy (fun (token, _) -> token.ToUpperInvariant ())
723-
|> List.choose (fun (_, group) ->
724-
match group with
725-
| []
726-
| [ _ ] -> None
727-
| (token, _) :: _ -> Some (SchemaError.TokenCollision (token, group |> List.map snd))
735+
let indexOf =
736+
System.Collections.Generic.Dictionary<string, int> (StringComparer.OrdinalIgnoreCase)
737+
738+
let buckets = ResizeArray<ResizeArray<string * string>> ()
739+
740+
for token, claimant in claims do
741+
match indexOf.TryGetValue token with
742+
| true, index -> buckets.[index].Add ((token, claimant))
743+
| false, _ ->
744+
indexOf.[token] <- buckets.Count
745+
let bucket = ResizeArray ()
746+
bucket.Add ((token, claimant))
747+
buckets.Add bucket
748+
749+
buckets
750+
|> Seq.choose (fun bucket ->
751+
if bucket.Count < 2 then
752+
None
753+
else
754+
let token, _ = bucket.[0]
755+
Some (SchemaError.TokenCollision (token, bucket |> Seq.map snd |> List.ofSeq))
756+
)
757+
|> List.ofSeq
758+
759+
let unaddressable =
760+
(schema.Leaves
761+
|> List.collect (fun leaf ->
762+
let claimant = sprintf "argument id %i" leaf.Id
763+
764+
leaf.Forms
765+
|> List.collect (fun form ->
766+
if form = "" then
767+
[ SchemaError.EmptyForm claimant ]
768+
elif form.Contains "=" then
769+
[ SchemaError.FormContainsEquals (claimant, form) ]
770+
else
771+
[]
772+
)
773+
))
774+
@ (
775+
match schema.Positional with
776+
| None -> []
777+
| Some positional ->
778+
let claimant = "the positional-args sink"
779+
780+
positional.Forms
781+
|> List.collect (fun form ->
782+
if form = "" then
783+
[ SchemaError.EmptyForm claimant ]
784+
elif form.Contains "=" then
785+
[ SchemaError.FormContainsEquals (claimant, form) ]
786+
else
787+
[]
788+
)
728789
)
729790

730791
duplicateLeafIds
@@ -734,6 +795,7 @@ module private ArgParserRuntime_DuArgs =
734795
@ duplicateSumIds
735796
@ noForms
736797
@ negationOnNonBool
798+
@ unaddressable
737799
@ collisions
738800

739801
/// Check the invariants which the scanning and selection semantics rely on.
@@ -964,9 +1026,12 @@ module DuArgs =
9641026
let parse' (getEnvironmentVariable : string -> string option) (args : string list) : DuArgs =
9651027
let helpText () =
9661028
[
967-
(sprintf "%s int32%s%s" (sprintf "--%s" "foo") "" (sprintf " : %s" ("The foo argument")))
968-
(sprintf "%s int32%s%s" (sprintf "--%s" "bar") "" "")
969-
(sprintf "%s int32%s%s" (sprintf "--%s" "baz") "" "")
1029+
"exactly one of the following sets of arguments:"
1030+
"FooCase:"
1031+
(sprintf " %s int32%s%s" (sprintf "--%s" "foo") "" (sprintf " : %s" ("The foo argument")))
1032+
"BarCase:"
1033+
(sprintf " %s int32%s%s" (sprintf "--%s" "bar") "" "")
1034+
(sprintf " %s int32%s%s" (sprintf "--%s" "baz") "" "")
9701035
]
9711036
|> String.concat "\n"
9721037

@@ -1163,8 +1228,11 @@ module WithModeArgs =
11631228
let helpText () =
11641229
[
11651230
(sprintf "%s bool%s%s" (sprintf "--%s" "verbose") "" "")
1166-
(sprintf "%s bool%s%s" (sprintf "--%s" "quiet") " (optional)" "")
1167-
(sprintf "%s int32%s%s" (sprintf "--%s" "level") "" "")
1231+
"exactly one of the following sets of arguments:"
1232+
"Auto:"
1233+
(sprintf " %s bool%s%s" (sprintf "--%s" "quiet") " (optional)" "")
1234+
"Manual:"
1235+
(sprintf " %s int32%s%s" (sprintf "--%s" "level") "" "")
11681236
]
11691237
|> String.concat "\n"
11701238

@@ -1356,3 +1424,174 @@ module WithModeArgs =
13561424

13571425
let parse (args : string list) : WithModeArgs =
13581426
parse' (System.Environment.GetEnvironmentVariable >> Option.ofObj) args
1427+
namespace ConsumePlugin
1428+
1429+
open WoofWare.Myriad.Plugins
1430+
1431+
/// Methods to parse arguments for the type DuWithDefaultArgs
1432+
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
1433+
module DuWithDefaultArgs =
1434+
let parse' (getEnvironmentVariable : string -> string option) (args : string list) : DuWithDefaultArgs =
1435+
let helpText () =
1436+
[
1437+
"exactly one of the following sets of arguments:"
1438+
"Defaulted:"
1439+
1440+
(sprintf
1441+
" %s int32%s%s"
1442+
(sprintf "--%s" "retries")
1443+
(DefaultedArgs.DefaultRetries ()
1444+
|> (fun x -> x.ToString ())
1445+
|> sprintf " (default value: %s)")
1446+
"")
1447+
1448+
"Plain:"
1449+
(sprintf " %s int32%s%s" (sprintf "--%s" "value") "" "")
1450+
]
1451+
|> String.concat "\n"
1452+
1453+
let parser_LeftoverArgs : string ResizeArray = ResizeArray ()
1454+
let mutable arg_1 : Choice<int, int> option = None
1455+
let mutable arg_2 : int option = None
1456+
1457+
let parser_schema : ArgParserRuntime_DuArgs.ErasedSchema =
1458+
{
1459+
Leaves =
1460+
[
1461+
{
1462+
Id = 0
1463+
Forms = [ "retries" ]
1464+
AcceptsNegation = false
1465+
Arity = ArgParserRuntime_DuArgs.ErasedArity.One
1466+
Repeatable = false
1467+
Requirement = ArgParserRuntime_DuArgs.ErasedRequirement.HasDefault
1468+
TypeDescription = ""
1469+
Help = None
1470+
}
1471+
{
1472+
Id = 1
1473+
Forms = [ "value" ]
1474+
AcceptsNegation = false
1475+
Arity = ArgParserRuntime_DuArgs.ErasedArity.One
1476+
Repeatable = false
1477+
Requirement = ArgParserRuntime_DuArgs.ErasedRequirement.Required
1478+
TypeDescription = ""
1479+
Help = None
1480+
}
1481+
]
1482+
Tree =
1483+
(ArgParserRuntime_DuArgs.ErasedTree.Sum (
1484+
(0,
1485+
[
1486+
("Defaulted",
1487+
ArgParserRuntime_DuArgs.ErasedTree.Product ([ ArgParserRuntime_DuArgs.ErasedTree.Leaf 0 ]))
1488+
("Plain",
1489+
ArgParserRuntime_DuArgs.ErasedTree.Product ([ ArgParserRuntime_DuArgs.ErasedTree.Leaf 1 ]))
1490+
])
1491+
))
1492+
Positional = None
1493+
}
1494+
1495+
let parser_storeOccurrence (occurrence : ArgParserRuntime_DuArgs.ErasedOccurrence) : string option =
1496+
match occurrence.LeafId with
1497+
| 0 ->
1498+
match arg_1 with
1499+
| Some _ -> None
1500+
| None ->
1501+
match occurrence.Value with
1502+
| Some value ->
1503+
try
1504+
arg_1 <- Some (Choice1Of2 (value |> (fun x -> System.Int32.Parse x)))
1505+
None
1506+
with _ as exc ->
1507+
(sprintf "%s (at arg %s)" exc.Message occurrence.Source) |> Some
1508+
| None ->
1509+
failwith
1510+
"WoofWare.Myriad internal error in generated parser: arity-one occurrence with no value"
1511+
| 1 ->
1512+
match arg_2 with
1513+
| Some _ -> None
1514+
| None ->
1515+
match occurrence.Value with
1516+
| Some value ->
1517+
try
1518+
arg_2 <- Some (value |> (fun x -> System.Int32.Parse x))
1519+
None
1520+
with _ as exc ->
1521+
(sprintf "%s (at arg %s)" exc.Message occurrence.Source) |> Some
1522+
| None ->
1523+
failwith
1524+
"WoofWare.Myriad internal error in generated parser: arity-one occurrence with no value"
1525+
| _ -> failwith "WoofWare.Myriad internal error in generated parser: unknown argument id"
1526+
1527+
let parser_storePositional (value : string) (afterSeparator : bool) : string option = None
1528+
1529+
let parser_renderStored (leafId : int) : string =
1530+
match leafId with
1531+
| 0 ->
1532+
match arg_1 with
1533+
| Some (Choice1Of2 x) -> x.ToString ()
1534+
| Some (Choice2Of2 x) -> x.ToString ()
1535+
| None -> "<no value>"
1536+
| 1 ->
1537+
match arg_2 with
1538+
| Some x -> x.ToString ()
1539+
| None -> "<no value>"
1540+
| _ -> "<no value>"
1541+
1542+
let parser_applyDefault (leafId : int) : string option =
1543+
match leafId with
1544+
| 0 ->
1545+
arg_1 <- Some (Choice2Of2 (DefaultedArgs.DefaultRetries ()))
1546+
None
1547+
| _ -> failwith "WoofWare.Myriad internal error in generated parser: unknown defaulted argument id"
1548+
1549+
let parser_callbacks : ArgParserRuntime_DuArgs.TypedCallbacks =
1550+
{
1551+
StoreOccurrence = parser_storeOccurrence
1552+
StorePositional = parser_storePositional
1553+
HelpText = helpText
1554+
RenderStored = parser_renderStored
1555+
ApplyDefault = parser_applyDefault
1556+
}
1557+
1558+
match
1559+
ArgParserRuntime_DuArgs.runParse
1560+
(ArgParserRuntime_DuArgs.WellFormedSchema.checkOrFail parser_schema)
1561+
parser_callbacks
1562+
args
1563+
with
1564+
| ArgParserRuntime_DuArgs.ParseOutcome.Success parser_selection ->
1565+
match Map.tryFind 0 parser_selection.Choices with
1566+
| Some 0 ->
1567+
DuWithDefaultArgs.Defaulted (
1568+
{
1569+
Retries =
1570+
(match arg_1 with
1571+
| Some x -> x
1572+
| None ->
1573+
failwith
1574+
"WoofWare.Myriad internal error in generated parser: required argument missing after successful parse")
1575+
}
1576+
)
1577+
| Some 1 ->
1578+
DuWithDefaultArgs.Plain (
1579+
{
1580+
Value =
1581+
(match arg_2 with
1582+
| Some x -> x
1583+
| None ->
1584+
failwith
1585+
"WoofWare.Myriad internal error in generated parser: required argument missing after successful parse")
1586+
}
1587+
)
1588+
| _ ->
1589+
failwith
1590+
"WoofWare.Myriad internal error in generated parser: no case selected despite a successful parse"
1591+
| ArgParserRuntime_DuArgs.ParseOutcome.HelpRequested -> helpText () |> failwithf "Help text requested.\n%s"
1592+
| ArgParserRuntime_DuArgs.ParseOutcome.Fatal message -> failwith message
1593+
| ArgParserRuntime_DuArgs.ParseOutcome.Errors errors ->
1594+
errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s"
1595+
1596+
let parse (args : string list) : DuWithDefaultArgs =
1597+
parse' (System.Environment.GetEnvironmentVariable >> Option.ofObj) args

0 commit comments

Comments
 (0)