mirror of
https://github.com/Smaug123/WoofWare.Myriad
synced 2025-12-15 21:35:39 +00:00
Compare commits
1 Commits
WoofWare.M
...
WoofWare.M
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
038b424906 |
@@ -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
|
||||
}
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 ()
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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'" ]
|
||||
[
|
||||
|
||||
Reference in New Issue
Block a user