Compare commits

..

1 Commits

Author SHA1 Message Date
Patrick Stevens
038b424906 Add type-level help text support to ArgParser generator (#457)
The ArgumentHelpText attribute can now be applied to the record type itself
to display help text at the top of the --help output, before field descriptions.
This enables better documentation of command-line argument parsers.

Features:
- Type-level help text appears before argument list
- Multiline help text is supported
- Backward compatible with existing code
- Help text appears in both --help and error messages

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

Co-authored-by: Claude <noreply@anthropic.com>
2025-11-21 06:32:55 +00:00
5 changed files with 583 additions and 13 deletions

View File

@@ -235,3 +235,27 @@ type FlagsIntoPositionalArgs' =
[<PositionalArgs false>]
DontGrabEverything : string list
}
[<ArgParser>]
[<ArgumentHelpText "Parse command-line arguments for a basic configuration. This help text appears before the argument list.">]
type WithTypeHelp =
{
[<ArgumentHelpText "The configuration file path">]
ConfigFile : string
[<ArgumentHelpText "Enable verbose output">]
Verbose : bool
Port : int
}
[<ArgParser>]
[<ArgumentHelpText "This is a multiline help text example.
It spans multiple lines to test that multiline strings work correctly.
You can use this to provide detailed documentation for your argument parser.">]
type WithMultilineTypeHelp =
{
[<ArgumentHelpText "Input file to process">]
InputFile : string
[<ArgumentHelpText "Output directory">]
OutputDir : string
Force : bool
}

View File

@@ -4346,3 +4346,438 @@ module FlagsIntoPositionalArgs'ArgParse =
static member parse (args : string list) : FlagsIntoPositionalArgs' =
FlagsIntoPositionalArgs'.parse' (System.Environment.GetEnvironmentVariable >> Option.ofObj) args
namespace ConsumePlugin
open System
open System.IO
open WoofWare.Myriad.Plugins
/// Methods to parse arguments for the type WithTypeHelp
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module WithTypeHelp =
type private ParseState_WithTypeHelp =
/// Ready to consume a key or positional arg
| AwaitingKey
/// Waiting to receive a value for the key we've already consumed
| AwaitingValue of key : string
let parse' (getEnvironmentVariable : string -> string option) (args : string list) : WithTypeHelp =
let ArgParser_errors = ResizeArray ()
let helpText () =
[
"Parse command-line arguments for a basic configuration. This help text appears before the argument list."
""
(sprintf
"%s string%s%s"
(sprintf "--%s" "config-file")
""
(sprintf " : %s" ("The configuration file path")))
(sprintf "%s bool%s%s" (sprintf "--%s" "verbose") "" (sprintf " : %s" ("Enable verbose output")))
(sprintf "%s int32%s%s" (sprintf "--%s" "port") "" "")
]
|> String.concat "\n"
let parser_LeftoverArgs : string ResizeArray = ResizeArray ()
let mutable arg_0 : string option = None
let mutable arg_1 : bool option = None
let mutable arg_2 : int option = None
/// Processes the key-value pair, returning Error if no key was matched.
/// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(<the message>).
/// This can nevertheless be a successful parse, e.g. when the key may have arity 0.
let processKeyValue (key : string) (value : string) : Result<unit, string option> =
if System.String.Equals (key, sprintf "--%s" "port", System.StringComparison.OrdinalIgnoreCase) then
match arg_2 with
| Some x ->
sprintf
"Argument '%s' was supplied multiple times: %s and %s"
(sprintf "--%s" "port")
(x.ToString ())
(value.ToString ())
|> ArgParser_errors.Add
Ok ()
| None ->
try
arg_2 <- value |> (fun x -> System.Int32.Parse x) |> Some
Ok ()
with _ as exc ->
exc.Message |> Some |> Error
else if System.String.Equals (key, sprintf "--%s" "verbose", System.StringComparison.OrdinalIgnoreCase) then
match arg_1 with
| Some x ->
sprintf
"Argument '%s' was supplied multiple times: %s and %s"
(sprintf "--%s" "verbose")
(x.ToString ())
(value.ToString ())
|> ArgParser_errors.Add
Ok ()
| None ->
try
arg_1 <- value |> (fun x -> System.Boolean.Parse x) |> Some
Ok ()
with _ as exc ->
exc.Message |> Some |> Error
else if
System.String.Equals (key, sprintf "--%s" "config-file", System.StringComparison.OrdinalIgnoreCase)
then
match arg_0 with
| Some x ->
sprintf
"Argument '%s' was supplied multiple times: %s and %s"
(sprintf "--%s" "config-file")
(x.ToString ())
(value.ToString ())
|> ArgParser_errors.Add
Ok ()
| None ->
try
arg_0 <- value |> (fun x -> x) |> Some
Ok ()
with _ as exc ->
exc.Message |> Some |> Error
else
Error None
/// Returns false if we didn't set a value.
let setFlagValue (key : string) : bool =
if System.String.Equals (key, sprintf "--%s" "verbose", System.StringComparison.OrdinalIgnoreCase) then
match arg_1 with
| Some x ->
sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "verbose")
|> ArgParser_errors.Add
true
| None ->
arg_1 <- true |> Some
true
else
false
let rec go (state : ParseState_WithTypeHelp) (args : string list) =
match args with
| [] ->
match state with
| ParseState_WithTypeHelp.AwaitingKey -> ()
| ParseState_WithTypeHelp.AwaitingValue key ->
if setFlagValue key then
()
else
sprintf
"Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args."
key
|> ArgParser_errors.Add
| "--" :: rest -> parser_LeftoverArgs.AddRange (rest |> Seq.map (fun x -> x))
| arg :: args ->
match state with
| ParseState_WithTypeHelp.AwaitingKey ->
if arg.StartsWith ("--", System.StringComparison.Ordinal) then
if arg = "--help" then
helpText () |> failwithf "Help text requested.\n%s"
else
let equals = arg.IndexOf (char 61)
if equals < 0 then
args |> go (ParseState_WithTypeHelp.AwaitingValue arg)
else
let key = arg.[0 .. equals - 1]
let value = arg.[equals + 1 ..]
match processKeyValue key value with
| Ok () -> go ParseState_WithTypeHelp.AwaitingKey args
| Error x ->
match x with
| None ->
failwithf "Unable to process argument %s as key %s and value %s" arg key value
| Some msg ->
sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add
go ParseState_WithTypeHelp.AwaitingKey args
else
arg |> (fun x -> x) |> parser_LeftoverArgs.Add
go ParseState_WithTypeHelp.AwaitingKey args
| ParseState_WithTypeHelp.AwaitingValue key ->
match processKeyValue key arg with
| Ok () -> go ParseState_WithTypeHelp.AwaitingKey args
| Error exc ->
if setFlagValue key then
go ParseState_WithTypeHelp.AwaitingKey (arg :: args)
else
match exc with
| None ->
failwithf "Unable to process supplied arg %s. Help text follows.\n%s" key (helpText ())
| Some msg -> msg |> ArgParser_errors.Add
go ParseState_WithTypeHelp.AwaitingKey args
let parser_LeftoverArgs =
if 0 = parser_LeftoverArgs.Count then
()
else
parser_LeftoverArgs
|> String.concat " "
|> sprintf "There were leftover args: %s"
|> ArgParser_errors.Add
Unchecked.defaultof<_>
let arg_0 =
match arg_0 with
| None ->
sprintf "Required argument '%s' received no value" (sprintf "--%s" "config-file")
|> ArgParser_errors.Add
Unchecked.defaultof<_>
| Some x -> x
let arg_1 =
match arg_1 with
| None ->
sprintf "Required argument '%s' received no value" (sprintf "--%s" "verbose")
|> ArgParser_errors.Add
Unchecked.defaultof<_>
| Some x -> x
let arg_2 =
match arg_2 with
| None ->
sprintf "Required argument '%s' received no value" (sprintf "--%s" "port")
|> ArgParser_errors.Add
Unchecked.defaultof<_>
| Some x -> x
if 0 = ArgParser_errors.Count then
{
ConfigFile = arg_0
Port = arg_2
Verbose = arg_1
}
else
ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s"
let parse (args : string list) : WithTypeHelp =
parse' (System.Environment.GetEnvironmentVariable >> Option.ofObj) args
namespace ConsumePlugin
open System
open System.IO
open WoofWare.Myriad.Plugins
/// Methods to parse arguments for the type WithMultilineTypeHelp
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module WithMultilineTypeHelp =
type private ParseState_WithMultilineTypeHelp =
/// Ready to consume a key or positional arg
| AwaitingKey
/// Waiting to receive a value for the key we've already consumed
| AwaitingValue of key : string
let parse' (getEnvironmentVariable : string -> string option) (args : string list) : WithMultilineTypeHelp =
let ArgParser_errors = ResizeArray ()
let helpText () =
[
"This is a multiline help text example.
It spans multiple lines to test that multiline strings work correctly.
You can use this to provide detailed documentation for your argument parser."
""
(sprintf "%s string%s%s" (sprintf "--%s" "input-file") "" (sprintf " : %s" ("Input file to process")))
(sprintf "%s string%s%s" (sprintf "--%s" "output-dir") "" (sprintf " : %s" ("Output directory")))
(sprintf "%s bool%s%s" (sprintf "--%s" "force") "" "")
]
|> String.concat "\n"
let parser_LeftoverArgs : string ResizeArray = ResizeArray ()
let mutable arg_0 : string option = None
let mutable arg_1 : string option = None
let mutable arg_2 : bool option = None
/// Processes the key-value pair, returning Error if no key was matched.
/// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(<the message>).
/// This can nevertheless be a successful parse, e.g. when the key may have arity 0.
let processKeyValue (key : string) (value : string) : Result<unit, string option> =
if System.String.Equals (key, sprintf "--%s" "force", System.StringComparison.OrdinalIgnoreCase) then
match arg_2 with
| Some x ->
sprintf
"Argument '%s' was supplied multiple times: %s and %s"
(sprintf "--%s" "force")
(x.ToString ())
(value.ToString ())
|> ArgParser_errors.Add
Ok ()
| None ->
try
arg_2 <- value |> (fun x -> System.Boolean.Parse x) |> Some
Ok ()
with _ as exc ->
exc.Message |> Some |> Error
else if
System.String.Equals (key, sprintf "--%s" "output-dir", System.StringComparison.OrdinalIgnoreCase)
then
match arg_1 with
| Some x ->
sprintf
"Argument '%s' was supplied multiple times: %s and %s"
(sprintf "--%s" "output-dir")
(x.ToString ())
(value.ToString ())
|> ArgParser_errors.Add
Ok ()
| None ->
try
arg_1 <- value |> (fun x -> x) |> Some
Ok ()
with _ as exc ->
exc.Message |> Some |> Error
else if
System.String.Equals (key, sprintf "--%s" "input-file", System.StringComparison.OrdinalIgnoreCase)
then
match arg_0 with
| Some x ->
sprintf
"Argument '%s' was supplied multiple times: %s and %s"
(sprintf "--%s" "input-file")
(x.ToString ())
(value.ToString ())
|> ArgParser_errors.Add
Ok ()
| None ->
try
arg_0 <- value |> (fun x -> x) |> Some
Ok ()
with _ as exc ->
exc.Message |> Some |> Error
else
Error None
/// Returns false if we didn't set a value.
let setFlagValue (key : string) : bool =
if System.String.Equals (key, sprintf "--%s" "force", System.StringComparison.OrdinalIgnoreCase) then
match arg_2 with
| Some x ->
sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "force")
|> ArgParser_errors.Add
true
| None ->
arg_2 <- true |> Some
true
else
false
let rec go (state : ParseState_WithMultilineTypeHelp) (args : string list) =
match args with
| [] ->
match state with
| ParseState_WithMultilineTypeHelp.AwaitingKey -> ()
| ParseState_WithMultilineTypeHelp.AwaitingValue key ->
if setFlagValue key then
()
else
sprintf
"Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args."
key
|> ArgParser_errors.Add
| "--" :: rest -> parser_LeftoverArgs.AddRange (rest |> Seq.map (fun x -> x))
| arg :: args ->
match state with
| ParseState_WithMultilineTypeHelp.AwaitingKey ->
if arg.StartsWith ("--", System.StringComparison.Ordinal) then
if arg = "--help" then
helpText () |> failwithf "Help text requested.\n%s"
else
let equals = arg.IndexOf (char 61)
if equals < 0 then
args |> go (ParseState_WithMultilineTypeHelp.AwaitingValue arg)
else
let key = arg.[0 .. equals - 1]
let value = arg.[equals + 1 ..]
match processKeyValue key value with
| Ok () -> go ParseState_WithMultilineTypeHelp.AwaitingKey args
| Error x ->
match x with
| None ->
failwithf "Unable to process argument %s as key %s and value %s" arg key value
| Some msg ->
sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add
go ParseState_WithMultilineTypeHelp.AwaitingKey args
else
arg |> (fun x -> x) |> parser_LeftoverArgs.Add
go ParseState_WithMultilineTypeHelp.AwaitingKey args
| ParseState_WithMultilineTypeHelp.AwaitingValue key ->
match processKeyValue key arg with
| Ok () -> go ParseState_WithMultilineTypeHelp.AwaitingKey args
| Error exc ->
if setFlagValue key then
go ParseState_WithMultilineTypeHelp.AwaitingKey (arg :: args)
else
match exc with
| None ->
failwithf "Unable to process supplied arg %s. Help text follows.\n%s" key (helpText ())
| Some msg -> msg |> ArgParser_errors.Add
go ParseState_WithMultilineTypeHelp.AwaitingKey args
let parser_LeftoverArgs =
if 0 = parser_LeftoverArgs.Count then
()
else
parser_LeftoverArgs
|> String.concat " "
|> sprintf "There were leftover args: %s"
|> ArgParser_errors.Add
Unchecked.defaultof<_>
let arg_0 =
match arg_0 with
| None ->
sprintf "Required argument '%s' received no value" (sprintf "--%s" "input-file")
|> ArgParser_errors.Add
Unchecked.defaultof<_>
| Some x -> x
let arg_1 =
match arg_1 with
| None ->
sprintf "Required argument '%s' received no value" (sprintf "--%s" "output-dir")
|> ArgParser_errors.Add
Unchecked.defaultof<_>
| Some x -> x
let arg_2 =
match arg_2 with
| None ->
sprintf "Required argument '%s' received no value" (sprintf "--%s" "force")
|> ArgParser_errors.Add
Unchecked.defaultof<_>
| Some x -> x
if 0 = ArgParser_errors.Count then
{
Force = arg_2
InputFile = arg_0
OutputDir = arg_1
}
else
ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s"
let parse (args : string list) : WithMultilineTypeHelp =
parse' (System.Environment.GetEnvironmentVariable >> Option.ofObj) args

View File

@@ -62,8 +62,10 @@ type ArgumentDefaultFunctionAttribute () =
type ArgumentDefaultEnvironmentVariableAttribute (envVar : string) =
inherit Attribute ()
/// Attribute indicating that this field shall have the given help text, when `--help` is invoked
/// Attribute indicating that this field or type shall have the given help text, when `--help` is invoked
/// or when a parse error causes us to print help text.
/// When applied to a record type, the help text appears at the top of the help output, before the field descriptions.
/// When applied to a field, the help text appears next to that field's description.
type ArgumentHelpTextAttribute (helpText : string) =
inherit Attribute ()

View File

@@ -444,7 +444,7 @@ Required argument '--exact' received no value"""
]
|> List.map TestCaseData
[<TestCaseSource(nameof (boolCases))>]
[<TestCaseSource(nameof boolCases)>]
let ``Bool env vars can be populated`` (envValue : string, boolValue : bool) =
let getEnvVar (s : string) =
s |> shouldEqual "CONSUMEPLUGIN_THINGS"
@@ -704,3 +704,87 @@ Required argument '--exact' received no value"""
// Again, we don't try to detect that the user has missed out the desired argument to `--a`.
exc.Message
|> shouldEqual """Unable to process argument --c=hi as key --c and value hi"""
[<Test>]
let ``Type-level help text appears in help output`` () =
let getEnvVar (_ : string) = None
let exc =
Assert.Throws<exn> (fun () -> WithTypeHelp.parse' getEnvVar [ "--help" ] |> ignore<WithTypeHelp>)
exc.Message
|> shouldContainText
"Parse command-line arguments for a basic configuration. This help text appears before the argument list."
exc.Message
|> shouldContainText "--config-file string : The configuration file path"
exc.Message |> shouldContainText "--verbose bool : Enable verbose output"
exc.Message |> shouldContainText "--port int32"
[<Test>]
let ``Type-level help text appears before field help`` () =
let getEnvVar (_ : string) = None
let exc =
Assert.Throws<exn> (fun () -> WithTypeHelp.parse' getEnvVar [ "--help" ] |> ignore<WithTypeHelp>)
// Verify that the type help appears before the field help
let typeHelpIndex =
exc.Message.IndexOf "Parse command-line arguments for a basic configuration"
let fieldHelpIndex = exc.Message.IndexOf "--config-file"
typeHelpIndex |> shouldBeSmallerThan fieldHelpIndex
[<Test>]
let ``Multiline type-level help text works`` () =
let getEnvVar (_ : string) = None
let exc =
Assert.Throws<exn> (fun () ->
WithMultilineTypeHelp.parse' getEnvVar [ "--help" ]
|> ignore<WithMultilineTypeHelp>
)
exc.Message |> shouldContainText "This is a multiline help text example."
exc.Message
|> shouldContainText "It spans multiple lines to test that multiline strings work correctly."
exc.Message
|> shouldContainText "You can use this to provide detailed documentation for your argument parser."
exc.Message |> shouldContainText "--input-file string : Input file to process"
exc.Message |> shouldContainText "--output-dir string : Output directory"
exc.Message |> shouldContainText "--force bool"
[<Test>]
let ``Type-level help text appears in error messages`` () =
let getEnvVar (_ : string) = None
let exc =
Assert.Throws<exn> (fun () ->
WithTypeHelp.parse' getEnvVar [ "--unknown-arg" ; "value" ]
|> ignore<WithTypeHelp>
)
// Verify that the type help appears in error messages too
exc.Message
|> shouldContainText
"Parse command-line arguments for a basic configuration. This help text appears before the argument list."
exc.Message |> shouldContainText "--config-file"
[<Test>]
let ``Types without type-level help still work`` () =
let getEnvVar (_ : string) = None
let exc =
Assert.Throws<exn> (fun () -> Basic.parse' getEnvVar [ "--help" ] |> ignore<Basic>)
// Should not contain any type-level help, just the field help
exc.Message |> shouldContainText "--foo int32 : This is a foo!"
exc.Message |> shouldContainText "--bar string"
// Make sure there's no extra blank line at the beginning
exc.Message.StartsWith '\n' |> shouldEqual false

View File

@@ -769,6 +769,7 @@ module internal ArgParserGenerator =
/// let helpText : string = ...
let private helpText
(typeHelp : SynExpr option)
(typeName : Ident)
(positional : ParseFunctionPositional option)
(args : ParseFunctionNonPositional list)
@@ -850,12 +851,24 @@ module internal ArgParserGenerator =
|> SynExpr.applyTo helpText
|> SynExpr.paren
let fieldHelp =
args
|> List.map (toPrintable describeNonPositional)
|> fun l ->
match positional with
| None -> l
| Some pos -> l @ [ toPrintable describePositional pos ]
let allHelp =
match typeHelp with
| Some helpExpr ->
// Prepend type help, followed by blank line, then field help
[ helpExpr ; SynExpr.CreateConst "" ] @ fieldHelp
| None ->
// No type help, just field help
fieldHelp
allHelp
|> SynExpr.listLiteral
|> SynExpr.pipeThroughFunction (
SynExpr.applyFunction (SynExpr.createLongIdent [ "String" ; "concat" ]) (SynExpr.CreateConst @"\n")
@@ -1560,6 +1573,7 @@ module internal ArgParserGenerator =
/// Takes a single argument, `args : string list`, and returns something of the type indicated by `recordType`.
let createRecordParse
(typeHelpText : SynExpr option)
(parseState : Ident)
(flagDus : FlagDu list)
(ambientRecords : RecordType list)
@@ -1626,7 +1640,7 @@ module internal ArgParserGenerator =
|> SynExpr.applyTo (SynExpr.CreateConst ())
|> SynBinding.basic [ argParseErrors ] []
let helpText = helpText recordType.Name pos nonPos
let helpText = helpText typeHelpText recordType.Name pos nonPos
let bindings = errorCollection :: helpText :: bindings
@@ -1923,14 +1937,25 @@ module internal ArgParserGenerator =
| _ -> None
)
let taggedType =
let taggedType, typeHelpText =
match taggedType with
| SynTypeDefn.SynTypeDefn (sci,
| SynTypeDefn.SynTypeDefn (SynComponentInfo.SynComponentInfo (attributes = attrs) as sci,
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (access, fields, _), _),
smd,
_,
_,
_) -> RecordType.OfRecord sci smd access fields
_) ->
let typeHelp =
attrs
|> SynAttributes.toAttrs
|> List.tryPick (fun a ->
match (List.last a.TypeName.LongIdent).idText with
| "ArgumentHelpTextAttribute"
| "ArgumentHelpText" -> Some a.ArgExpr
| _ -> None
)
RecordType.OfRecord sci smd access fields, typeHelp
| _ -> failwith "[<ArgParser>] currently only supports being placed on records."
let modAttrs, modName =
@@ -1988,7 +2013,7 @@ module internal ArgParserGenerator =
|> SynPat.annotateType (SynType.appPostfix "list" SynType.string)
let parsePrime =
createRecordParse parseStateIdent flagDus allRecordTypes taggedType
createRecordParse typeHelpText parseStateIdent flagDus allRecordTypes taggedType
|> SynBinding.basic
[ Ident.create "parse'" ]
[