Skip to content

Commit 0153210

Browse files
Smaug123claude
Smaug123
and
claude
committed
ArgParser: read ArgumentHelpText from nested records and unions
The type-level help lookup ran only against the [<ArgParser>]-tagged root, so an [<ArgumentHelpText>] on a nested argument record or union was silently ignored -- despite the attribute documenting itself as applying to a record type generally. RecordType.Attributes and UnionType.Attributes were already to hand at the nesting site; nothing was reading them. The nested type's help now heads the group its arguments form, wherever that type is embedded. A field's own [<ArgumentHelpText>] overrides it: the field is the more specific placement, and one type may be embedded at several sites for different purposes. Both the root lookup and the field lookup now go through one helpTextAttribute helper, rather than three copies of the same tryPick. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
1 parent 96986ed commit 0153210

9 files changed

Lines changed: 665 additions & 20 deletions

File tree

‎CHANGELOG.md‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,13 @@
11
Notable changes are recorded here.
22

3+
# WoofWare.Myriad.Plugins 10.7.2
4+
5+
`ArgParserGenerator` now reads `[<ArgumentHelpText>]` from a nested argument record or union of alternative argument sets, and not only from the `[<ArgParser>]`-tagged root.
6+
The nested type's help heads the group of arguments that type contributes, wherever it is embedded; previously it was silently ignored, despite the attribute documenting itself as applying to a record type generally.
7+
8+
An `[<ArgumentHelpText>]` on the *field* overrides the one on the type it refers to.
9+
The field is the more specific placement, and one type may be embedded at several sites for different purposes, so that is the one which can say what a particular occurrence is for.
10+
311
# WoofWare.Myriad.Plugins 10.7.1
412

513
`ArgParserGenerator` help text now groups the arguments contributed by a field whose type is another argument record, or a union of alternative argument sets, under a header line naming that field.

‎ConsumePlugin/Args.fs‎

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -158,6 +158,26 @@ type ParentRecordWithGroupHelp =
158158
AndAnother : bool
159159
}
160160

161+
/// A nested type may describe itself, for the benefit of every site which embeds it.
162+
[<ArgumentHelpText "How to talk to the database">]
163+
type DescribedChild =
164+
{
165+
Host : string
166+
Port : int
167+
}
168+
169+
/// `Primary` takes the type's own description; `Secondary` overrides it, because the field is the
170+
/// more specific placement and one type may be embedded for different purposes.
171+
[<ArgParser true>]
172+
type ParentRecordWithTypeHelp =
173+
{
174+
[<ArgumentPrefix "primary">]
175+
Primary : DescribedChild
176+
[<ArgumentPrefix "secondary">]
177+
[<ArgumentHelpText "Where to fail over to">]
178+
Secondary : DescribedChild
179+
}
180+
161181
[<ArgParser true>]
162182
type ChoicePositionals =
163183
{

‎ConsumePlugin/DuArgs.fs‎

Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -76,6 +76,34 @@ type WithModeHelpArgs =
7676
Mode : Mode
7777
}
7878

79+
/// A union of alternative argument sets may describe itself, for the benefit of every field which
80+
/// embeds it.
81+
[<ArgumentHelpText "Which transport to use">]
82+
type Transport =
83+
| Tcp of TcpArgs
84+
| Unix of UnixArgs
85+
86+
and TcpArgs =
87+
{
88+
TcpPort : int
89+
}
90+
91+
and UnixArgs =
92+
{
93+
SocketPath : string
94+
}
95+
96+
/// `Fallback` takes the union's own description; `Preferred` overrides it from the field.
97+
[<ArgParser>]
98+
type WithTransportArgs =
99+
{
100+
[<ArgumentPrefix "preferred">]
101+
[<ArgumentHelpText "Try this one first">]
102+
Preferred : Transport
103+
[<ArgumentPrefix "fallback">]
104+
Fallback : Transport
105+
}
106+
79107
/// A union beside a positional sink (default, i.e. Reject-mode): named arguments select the
80108
/// union case, and every bare token is routed to the sink whichever case wins. An unrecognised
81109
/// `--key`-shaped token remains fatal. The sink converts, so selection must not depend on the

‎ConsumePlugin/GeneratedArgs.fs‎

Lines changed: 247 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4239,6 +4239,253 @@ open System
42394239
open System.IO
42404240
open WoofWare.Myriad.Plugins
42414241

4242+
/// Methods to parse arguments for the type ParentRecordWithTypeHelp
4243+
[<AutoOpen>]
4244+
module ParentRecordWithTypeHelpArgParse =
4245+
/// Extension methods for argument parsing
4246+
type ParentRecordWithTypeHelp with
4247+
4248+
static member parse'
4249+
(getEnvironmentVariable : string -> string option)
4250+
(args : string list)
4251+
: ParentRecordWithTypeHelp
4252+
=
4253+
let helpText () =
4254+
[
4255+
(sprintf "%s: %s" "Primary" ("How to talk to the database"))
4256+
(sprintf " %s %s%s%s" (sprintf "--%s" "primary-host") "string" "" "")
4257+
(sprintf " %s %s%s%s" (sprintf "--%s" "primary-port") "int32" "" "")
4258+
(sprintf "%s: %s" "Secondary" ("Where to fail over to"))
4259+
(sprintf " %s %s%s%s" (sprintf "--%s" "secondary-host") "string" "" "")
4260+
(sprintf " %s %s%s%s" (sprintf "--%s" "secondary-port") "int32" "" "")
4261+
]
4262+
|> String.concat "\n"
4263+
4264+
let parser_LeftoverArgs : string ResizeArray = ResizeArray ()
4265+
let mutable arg_0 : string option = None
4266+
let mutable arg_1 : int option = None
4267+
let mutable arg_2 : string option = None
4268+
let mutable arg_3 : int option = None
4269+
4270+
let parser_schema : ArgParserRuntime_BasicNoPositionals.ErasedSchema =
4271+
{
4272+
Leaves =
4273+
[
4274+
{
4275+
Id = 0
4276+
Forms = [ "primary-host" ]
4277+
AcceptsNegation = false
4278+
Arity = ArgParserRuntime_BasicNoPositionals.ErasedArity.One
4279+
Repeatable = false
4280+
Requirement = ArgParserRuntime_BasicNoPositionals.ErasedRequirement.Required
4281+
TypeDescription = ""
4282+
Help = None
4283+
}
4284+
4285+
{
4286+
Id = 1
4287+
Forms = [ "primary-port" ]
4288+
AcceptsNegation = false
4289+
Arity = ArgParserRuntime_BasicNoPositionals.ErasedArity.One
4290+
Repeatable = false
4291+
Requirement = ArgParserRuntime_BasicNoPositionals.ErasedRequirement.Required
4292+
TypeDescription = ""
4293+
Help = None
4294+
}
4295+
4296+
{
4297+
Id = 2
4298+
Forms = [ "secondary-host" ]
4299+
AcceptsNegation = false
4300+
Arity = ArgParserRuntime_BasicNoPositionals.ErasedArity.One
4301+
Repeatable = false
4302+
Requirement = ArgParserRuntime_BasicNoPositionals.ErasedRequirement.Required
4303+
TypeDescription = ""
4304+
Help = None
4305+
}
4306+
{
4307+
Id = 3
4308+
Forms = [ "secondary-port" ]
4309+
AcceptsNegation = false
4310+
Arity = ArgParserRuntime_BasicNoPositionals.ErasedArity.One
4311+
Repeatable = false
4312+
Requirement = ArgParserRuntime_BasicNoPositionals.ErasedRequirement.Required
4313+
TypeDescription = ""
4314+
Help = None
4315+
}
4316+
]
4317+
Tree =
4318+
(ArgParserRuntime_BasicNoPositionals.ErasedTree.Product (
4319+
[
4320+
ArgParserRuntime_BasicNoPositionals.ErasedTree.Product (
4321+
[
4322+
ArgParserRuntime_BasicNoPositionals.ErasedTree.Leaf 0
4323+
ArgParserRuntime_BasicNoPositionals.ErasedTree.Leaf 1
4324+
]
4325+
)
4326+
ArgParserRuntime_BasicNoPositionals.ErasedTree.Product (
4327+
[
4328+
ArgParserRuntime_BasicNoPositionals.ErasedTree.Leaf 2
4329+
ArgParserRuntime_BasicNoPositionals.ErasedTree.Leaf 3
4330+
]
4331+
)
4332+
]
4333+
))
4334+
Positionals = List.empty
4335+
}
4336+
4337+
let parser_storeOccurrence
4338+
(occurrence : ArgParserRuntime_BasicNoPositionals.ErasedOccurrence)
4339+
: string option
4340+
=
4341+
match occurrence.LeafId with
4342+
| 0 ->
4343+
match arg_0 with
4344+
| Some _ -> None
4345+
| None ->
4346+
match occurrence.Value with
4347+
| Some value ->
4348+
try
4349+
arg_0 <- Some (value |> (fun x -> x))
4350+
None
4351+
with _ as exc ->
4352+
(sprintf "%s (at arg %s)" exc.Message occurrence.Source) |> Some
4353+
| None ->
4354+
failwith
4355+
"WoofWare.Myriad internal error in generated parser: arity-one occurrence with no value"
4356+
| 1 ->
4357+
match arg_1 with
4358+
| Some _ -> None
4359+
| None ->
4360+
match occurrence.Value with
4361+
| Some value ->
4362+
try
4363+
arg_1 <- Some (value |> (fun x -> System.Int32.Parse x))
4364+
None
4365+
with _ as exc ->
4366+
(sprintf "%s (at arg %s)" exc.Message occurrence.Source) |> Some
4367+
| None ->
4368+
failwith
4369+
"WoofWare.Myriad internal error in generated parser: arity-one occurrence with no value"
4370+
| 2 ->
4371+
match arg_2 with
4372+
| Some _ -> None
4373+
| None ->
4374+
match occurrence.Value with
4375+
| Some value ->
4376+
try
4377+
arg_2 <- Some (value |> (fun x -> x))
4378+
None
4379+
with _ as exc ->
4380+
(sprintf "%s (at arg %s)" exc.Message occurrence.Source) |> Some
4381+
| None ->
4382+
failwith
4383+
"WoofWare.Myriad internal error in generated parser: arity-one occurrence with no value"
4384+
| 3 ->
4385+
match arg_3 with
4386+
| Some _ -> None
4387+
| None ->
4388+
match occurrence.Value with
4389+
| Some value ->
4390+
try
4391+
arg_3 <- Some (value |> (fun x -> System.Int32.Parse x))
4392+
None
4393+
with _ as exc ->
4394+
(sprintf "%s (at arg %s)" exc.Message occurrence.Source) |> Some
4395+
| None ->
4396+
failwith
4397+
"WoofWare.Myriad internal error in generated parser: arity-one occurrence with no value"
4398+
| _ -> failwith "WoofWare.Myriad internal error in generated parser: unknown argument id"
4399+
4400+
let parser_storePositional (positionalId : int) (value : string) (afterSeparator : bool) : string option =
4401+
failwith "WoofWare.Myriad internal error in generated parser: no positional sink exists"
4402+
4403+
let parser_renderStored (leafId : int) : string =
4404+
match leafId with
4405+
| 0 ->
4406+
match arg_0 with
4407+
| Some x -> x.ToString ()
4408+
| None -> "<no value>"
4409+
| 1 ->
4410+
match arg_1 with
4411+
| Some x -> x.ToString ()
4412+
| None -> "<no value>"
4413+
| 2 ->
4414+
match arg_2 with
4415+
| Some x -> x.ToString ()
4416+
| None -> "<no value>"
4417+
| 3 ->
4418+
match arg_3 with
4419+
| Some x -> x.ToString ()
4420+
| None -> "<no value>"
4421+
| _ -> "<no value>"
4422+
4423+
let parser_applyDefault (leafId : int) : string option =
4424+
match leafId with
4425+
| _ -> failwith "WoofWare.Myriad internal error in generated parser: unknown defaulted argument id"
4426+
4427+
let parser_callbacks : ArgParserRuntime_BasicNoPositionals.TypedCallbacks =
4428+
{
4429+
StoreOccurrence = parser_storeOccurrence
4430+
StorePositional = parser_storePositional
4431+
HelpText = helpText
4432+
RenderStored = parser_renderStored
4433+
ApplyDefault = parser_applyDefault
4434+
}
4435+
4436+
match
4437+
ArgParserRuntime_BasicNoPositionals.runParse
4438+
(ArgParserRuntime_BasicNoPositionals.WellFormedSchema.checkOrFail parser_schema)
4439+
parser_callbacks
4440+
args
4441+
with
4442+
| ArgParserRuntime_BasicNoPositionals.ParseOutcome.Success parser_selection ->
4443+
{
4444+
Primary =
4445+
{
4446+
Host =
4447+
(match arg_0 with
4448+
| Some x -> x
4449+
| None ->
4450+
failwith
4451+
"WoofWare.Myriad internal error in generated parser: required argument missing after successful parse")
4452+
Port =
4453+
(match arg_1 with
4454+
| Some x -> x
4455+
| None ->
4456+
failwith
4457+
"WoofWare.Myriad internal error in generated parser: required argument missing after successful parse")
4458+
}
4459+
Secondary =
4460+
{
4461+
Host =
4462+
(match arg_2 with
4463+
| Some x -> x
4464+
| None ->
4465+
failwith
4466+
"WoofWare.Myriad internal error in generated parser: required argument missing after successful parse")
4467+
Port =
4468+
(match arg_3 with
4469+
| Some x -> x
4470+
| None ->
4471+
failwith
4472+
"WoofWare.Myriad internal error in generated parser: required argument missing after successful parse")
4473+
}
4474+
}
4475+
| ArgParserRuntime_BasicNoPositionals.ParseOutcome.HelpRequested ->
4476+
helpText () |> failwithf "Help text requested.\n%s"
4477+
| ArgParserRuntime_BasicNoPositionals.ParseOutcome.Fatal message -> failwith message
4478+
| ArgParserRuntime_BasicNoPositionals.ParseOutcome.Errors errors ->
4479+
errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s"
4480+
4481+
static member parse (args : string list) : ParentRecordWithTypeHelp =
4482+
ParentRecordWithTypeHelp.parse' (System.Environment.GetEnvironmentVariable >> Option.ofObj) args
4483+
namespace ConsumePlugin
4484+
4485+
open System
4486+
open System.IO
4487+
open WoofWare.Myriad.Plugins
4488+
42424489
/// Methods to parse arguments for the type ChoicePositionals
42434490
[<AutoOpen>]
42444491
module ChoicePositionalsArgParse =

0 commit comments

Comments
 (0)