Compare commits

...

1 Commits

Author SHA1 Message Date
Patrick Stevens
49ecfbf5e5 Fix includeFlagLike when arg doesn't have an equals (#257) 2024-09-12 22:10:08 +00:00
3 changed files with 37 additions and 12 deletions

View File

@@ -3635,6 +3635,9 @@ module FlagsIntoPositionalArgsArgParse =
| Error exc -> | Error exc ->
if setFlagValue key then if setFlagValue key then
go ParseState_FlagsIntoPositionalArgs.AwaitingKey (arg :: args) go ParseState_FlagsIntoPositionalArgs.AwaitingKey (arg :: args)
else if true then
key |> arg_1.Add
go ParseState_FlagsIntoPositionalArgs.AwaitingKey (arg :: args)
else else
match exc with match exc with
| None -> | None ->
@@ -3796,6 +3799,9 @@ module FlagsIntoPositionalArgs'ArgParse =
| Error exc -> | Error exc ->
if setFlagValue key then if setFlagValue key then
go ParseState_FlagsIntoPositionalArgs'.AwaitingKey (arg :: args) go ParseState_FlagsIntoPositionalArgs'.AwaitingKey (arg :: args)
else if false then
key |> arg_1.Add
go ParseState_FlagsIntoPositionalArgs'.AwaitingKey (arg :: args)
else else
match exc with match exc with
| None -> | None ->

View File

@@ -623,30 +623,32 @@ Required argument '--exact' received no value"""
let ``Can collect *all* non-help args into positional args with includeFlagLike`` () = let ``Can collect *all* non-help args into positional args with includeFlagLike`` () =
let getEnvVar (_ : string) = failwith "do not call" let getEnvVar (_ : string) = failwith "do not call"
FlagsIntoPositionalArgs.parse' getEnvVar [ "--a" ; "foo" ; "--b=false" ; "--c=hi" ; "--" ; "--help" ] FlagsIntoPositionalArgs.parse' getEnvVar [ "--a" ; "foo" ; "--b=false" ; "--c" ; "hi" ; "--" ; "--help" ]
|> shouldEqual |> shouldEqual
{ {
A = "foo" A = "foo"
GrabEverything = [ "--b=false" ; "--c=hi" ; "--help" ] GrabEverything = [ "--b=false" ; "--c" ; "hi" ; "--help" ]
} }
// Users might consider this eccentric! // Users might consider this eccentric!
// But we're only a simple arg parser; we don't look around to see whether this is "almost" // But we're only a simple arg parser; we don't look around to see whether this is "almost"
// a valid parse. // a valid parse.
FlagsIntoPositionalArgs.parse' getEnvVar [ "--a" ; "--b=false" ; "--c=hi" ; "--" ; "--help" ] FlagsIntoPositionalArgs.parse' getEnvVar [ "--a" ; "--b=false" ; "--c" ; "hi" ; "--" ; "--help" ]
|> shouldEqual |> shouldEqual
{ {
A = "--b=false" A = "--b=false"
GrabEverything = [ "--c=hi" ; "--help" ] GrabEverything = [ "--c" ; "hi" ; "--help" ]
} }
[<Test>] [<Test>]
let ``Can refuse to collect non-help args`` () = let ``Can refuse to collect non-help args with PositionalArgs false`` () =
let getEnvVar (_ : string) = failwith "do not call" let getEnvVar (_ : string) = failwith "do not call"
let exc = let exc =
Assert.Throws<exn> (fun () -> Assert.Throws<exn> (fun () ->
FlagsIntoPositionalArgs'.parse' getEnvVar [ "--a" ; "foo" ; "--b=false" ; "--c=hi" ; "--" ; "--help" ] FlagsIntoPositionalArgs'.parse'
getEnvVar
[ "--a" ; "foo" ; "--b=false" ; "--c" ; "hi" ; "--" ; "--help" ]
|> ignore<FlagsIntoPositionalArgs'> |> ignore<FlagsIntoPositionalArgs'>
) )

View File

@@ -1019,12 +1019,12 @@ module internal ArgParserGenerator =
recurseKey recurseKey
] ]
let notMatched = let posAttr =
let posAttr = match leftoverArgAcc with
match leftoverArgAcc with | ChoicePositional.Choice a
| ChoicePositional.Choice a | ChoicePositional.Normal a -> a
| ChoicePositional.Normal a -> a
let notMatched =
let handleFailure = let handleFailure =
[ [
SynMatchClause.create (SynPat.named "None") fail SynMatchClause.create (SynPat.named "None") fail
@@ -1113,6 +1113,8 @@ module internal ArgParserGenerator =
let processValue = let processValue =
// During failure, we've received an optional exception message that happened when we tried to parse // During failure, we've received an optional exception message that happened when we tried to parse
// the value; it's in the variable `exc`. // the value; it's in the variable `exc`.
// `fail` is for the case where we're genuinely emitting an error.
// If we're in `PositionalArgs true` mode, though, we won't call `fail`.
let fail = let fail =
[ [
SynExpr.createIdent "failwithf" SynExpr.createIdent "failwithf"
@@ -1132,6 +1134,21 @@ module internal ArgParserGenerator =
] ]
|> SynExpr.createMatch (SynExpr.createIdent "exc") |> SynExpr.createMatch (SynExpr.createIdent "exc")
let onFailure =
match posAttr with
| None -> fail
| Some includeFlagLike ->
[
SynExpr.createIdent "key"
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' [ leftoverArgs ; Ident.create "Add" ])
SynExpr.createIdent "go"
|> SynExpr.applyTo (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ])
|> SynExpr.applyTo (SynExpr.listCons (SynExpr.createIdent "arg") (SynExpr.createIdent "args"))
]
|> SynExpr.sequential
|> SynExpr.ifThenElse includeFlagLike fail
[ [
SynMatchClause.create SynMatchClause.create
(SynPat.nameWithArgs "Ok" [ SynPat.unit ]) (SynPat.nameWithArgs "Ok" [ SynPat.unit ])
@@ -1144,7 +1161,7 @@ module internal ArgParserGenerator =
(SynPat.nameWithArgs "Error" [ SynPat.named "exc" ]) (SynPat.nameWithArgs "Error" [ SynPat.named "exc" ])
(SynExpr.ifThenElse (SynExpr.ifThenElse
(SynExpr.applyFunction (SynExpr.createIdent "setFlagValue") (SynExpr.createIdent "key")) (SynExpr.applyFunction (SynExpr.createIdent "setFlagValue") (SynExpr.createIdent "key"))
fail onFailure
(SynExpr.createIdent "go" (SynExpr.createIdent "go"
|> SynExpr.applyTo (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ]) |> SynExpr.applyTo (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ])
|> SynExpr.applyTo (SynExpr.listCons (SynExpr.createIdent "arg") (SynExpr.createIdent "args")))) |> SynExpr.applyTo (SynExpr.listCons (SynExpr.createIdent "arg") (SynExpr.createIdent "args"))))