From 5748ac3d5b2a8315b1adb168015eb0bf7ed0ae32 Mon Sep 17 00:00:00 2001 From: Patrick Stevens <3138005+Smaug123@users.noreply.github.com> Date: Wed, 11 Sep 2024 20:00:04 +0100 Subject: [PATCH] Allow consuming *all* args as positionals, not just ones which look like `--foo` (#255) --- ConsumePlugin/Args.fs | 16 + ConsumePlugin/GeneratedArgs.fs | 542 +++++++++++++++--- .../ArgParserAttributes.fs | 15 +- .../SurfaceBaseline.txt | 3 + .../version.json | 2 +- .../TestArgParser/TestArgParser.fs | 45 ++ WoofWare.Myriad.Plugins/ArgParserGenerator.fs | 110 ++-- WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs | 5 + .../SynExpr/SynLongIdent.fs | 3 + 9 files changed, 620 insertions(+), 121 deletions(-) diff --git a/ConsumePlugin/Args.fs b/ConsumePlugin/Args.fs index 033b28c..754612d 100644 --- a/ConsumePlugin/Args.fs +++ b/ConsumePlugin/Args.fs @@ -195,3 +195,19 @@ type ManyLongForms = type private IrrelevantDu = | Foo | Bar + +[] +type FlagsIntoPositionalArgs = + { + A : string + [] + GrabEverything : string list + } + +[] +type FlagsIntoPositionalArgs' = + { + A : string + [] + DontGrabEverything : string list + } diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index 10c7d73..2a020e8 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -148,11 +148,13 @@ module BasicNoPositionals = match processKeyValue key value with | Ok () -> go ParseState_BasicNoPositionals.AwaitingKey args - | Error None -> - failwithf "Unable to process argument %s as key %s and value %s" arg key value - | Error (Some msg) -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_BasicNoPositionals.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_BasicNoPositionals.AwaitingKey args else arg |> (fun x -> x) |> parser_LeftoverArgs.Add go ParseState_BasicNoPositionals.AwaitingKey args @@ -365,11 +367,13 @@ module Basic = match processKeyValue key value with | Ok () -> go ParseState_Basic.AwaitingKey args - | Error None -> - failwithf "Unable to process argument %s as key %s and value %s" arg key value - | Error (Some msg) -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_Basic.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_Basic.AwaitingKey args else arg |> (fun x -> x) |> arg_3.Add go ParseState_Basic.AwaitingKey args @@ -566,11 +570,13 @@ module BasicWithIntPositionals = match processKeyValue key value with | Ok () -> go ParseState_BasicWithIntPositionals.AwaitingKey args - | Error None -> - failwithf "Unable to process argument %s as key %s and value %s" arg key value - | Error (Some msg) -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_BasicWithIntPositionals.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_BasicWithIntPositionals.AwaitingKey args else arg |> (fun x -> System.Int32.Parse x) |> arg_3.Add go ParseState_BasicWithIntPositionals.AwaitingKey args @@ -945,11 +951,13 @@ module LoadsOfTypes = match processKeyValue key value with | Ok () -> go ParseState_LoadsOfTypes.AwaitingKey args - | Error None -> - failwithf "Unable to process argument %s as key %s and value %s" arg key value - | Error (Some msg) -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_LoadsOfTypes.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_LoadsOfTypes.AwaitingKey args else arg |> (fun x -> System.Int32.Parse x) |> arg_7.Add go ParseState_LoadsOfTypes.AwaitingKey args @@ -1371,11 +1379,13 @@ module LoadsOfTypesNoPositionals = match processKeyValue key value with | Ok () -> go ParseState_LoadsOfTypesNoPositionals.AwaitingKey args - | Error None -> - failwithf "Unable to process argument %s as key %s and value %s" arg key value - | Error (Some msg) -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_LoadsOfTypesNoPositionals.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_LoadsOfTypesNoPositionals.AwaitingKey args else arg |> (fun x -> x) |> parser_LeftoverArgs.Add go ParseState_LoadsOfTypesNoPositionals.AwaitingKey args @@ -1688,11 +1698,17 @@ module DatesAndTimesArgParse = match processKeyValue key value with | Ok () -> go ParseState_DatesAndTimes.AwaitingKey args - | Error None -> - failwithf "Unable to process argument %s as key %s and value %s" arg key value - | Error (Some msg) -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_DatesAndTimes.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_DatesAndTimes.AwaitingKey args else arg |> (fun x -> x) |> parser_LeftoverArgs.Add go ParseState_DatesAndTimes.AwaitingKey args @@ -1918,11 +1934,17 @@ module ParentRecordArgParse = match processKeyValue key value with | Ok () -> go ParseState_ParentRecord.AwaitingKey args - | Error None -> - failwithf "Unable to process argument %s as key %s and value %s" arg key value - | Error (Some msg) -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ParentRecord.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_ParentRecord.AwaitingKey args else arg |> (fun x -> x) |> parser_LeftoverArgs.Add go ParseState_ParentRecord.AwaitingKey args @@ -2124,11 +2146,17 @@ module ParentRecordChildPosArgParse = match processKeyValue key value with | Ok () -> go ParseState_ParentRecordChildPos.AwaitingKey args - | Error None -> - failwithf "Unable to process argument %s as key %s and value %s" arg key value - | Error (Some msg) -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ParentRecordChildPos.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_ParentRecordChildPos.AwaitingKey args else arg |> (fun x -> System.Uri x) |> arg_1.Add go ParseState_ParentRecordChildPos.AwaitingKey args @@ -2297,11 +2325,17 @@ module ParentRecordSelfPosArgParse = match processKeyValue key value with | Ok () -> go ParseState_ParentRecordSelfPos.AwaitingKey args - | Error None -> - failwithf "Unable to process argument %s as key %s and value %s" arg key value - | Error (Some msg) -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ParentRecordSelfPos.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_ParentRecordSelfPos.AwaitingKey args else arg |> (fun x -> System.Boolean.Parse x) |> arg_2.Add go ParseState_ParentRecordSelfPos.AwaitingKey args @@ -2428,11 +2462,17 @@ module ChoicePositionalsArgParse = match processKeyValue key value with | Ok () -> go ParseState_ChoicePositionals.AwaitingKey args - | Error None -> - failwithf "Unable to process argument %s as key %s and value %s" arg key value - | Error (Some msg) -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ChoicePositionals.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_ChoicePositionals.AwaitingKey args else arg |> (fun x -> x) |> Choice1Of2 |> arg_0.Add go ParseState_ChoicePositionals.AwaitingKey args @@ -2567,11 +2607,17 @@ module ContainsBoolEnvVarArgParse = match processKeyValue key value with | Ok () -> go ParseState_ContainsBoolEnvVar.AwaitingKey args - | Error None -> - failwithf "Unable to process argument %s as key %s and value %s" arg key value - | Error (Some msg) -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ContainsBoolEnvVar.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_ContainsBoolEnvVar.AwaitingKey args else arg |> (fun x -> x) |> parser_LeftoverArgs.Add go ParseState_ContainsBoolEnvVar.AwaitingKey args @@ -2747,11 +2793,17 @@ module WithFlagDuArgParse = match processKeyValue key value with | Ok () -> go ParseState_WithFlagDu.AwaitingKey args - | Error None -> - failwithf "Unable to process argument %s as key %s and value %s" arg key value - | Error (Some msg) -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_WithFlagDu.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_WithFlagDu.AwaitingKey args else arg |> (fun x -> x) |> parser_LeftoverArgs.Add go ParseState_WithFlagDu.AwaitingKey args @@ -2920,11 +2972,17 @@ module ContainsFlagEnvVarArgParse = match processKeyValue key value with | Ok () -> go ParseState_ContainsFlagEnvVar.AwaitingKey args - | Error None -> - failwithf "Unable to process argument %s as key %s and value %s" arg key value - | Error (Some msg) -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ContainsFlagEnvVar.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_ContainsFlagEnvVar.AwaitingKey args else arg |> (fun x -> x) |> parser_LeftoverArgs.Add go ParseState_ContainsFlagEnvVar.AwaitingKey args @@ -3126,11 +3184,17 @@ module ContainsFlagDefaultValueArgParse = match processKeyValue key value with | Ok () -> go ParseState_ContainsFlagDefaultValue.AwaitingKey args - | Error None -> - failwithf "Unable to process argument %s as key %s and value %s" arg key value - | Error (Some msg) -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ContainsFlagDefaultValue.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_ContainsFlagDefaultValue.AwaitingKey args else arg |> (fun x -> x) |> parser_LeftoverArgs.Add go ParseState_ContainsFlagDefaultValue.AwaitingKey args @@ -3367,11 +3431,17 @@ module ManyLongFormsArgParse = match processKeyValue key value with | Ok () -> go ParseState_ManyLongForms.AwaitingKey args - | Error None -> - failwithf "Unable to process argument %s as key %s and value %s" arg key value - | Error (Some msg) -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ManyLongForms.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_ManyLongForms.AwaitingKey args else arg |> (fun x -> x) |> parser_LeftoverArgs.Add go ParseState_ManyLongForms.AwaitingKey args @@ -3435,3 +3505,325 @@ module ManyLongFormsArgParse = static member parse (args : string list) : ManyLongForms = ManyLongForms.parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type FlagsIntoPositionalArgs +[] +module FlagsIntoPositionalArgsArgParse = + type private ParseState_FlagsIntoPositionalArgs = + /// 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 + + /// Extension methods for argument parsing + type FlagsIntoPositionalArgs with + + static member parse' + (getEnvironmentVariable : string -> string) + (args : string list) + : FlagsIntoPositionalArgs + = + let ArgParser_errors = ResizeArray () + + let helpText () = + [ + (sprintf "%s string%s%s" (sprintf "--%s" "a") "" "") + (sprintf + "%s string%s%s" + (sprintf "--%s" "grab-everything") + " (positional args) (can be repeated)" + "") + ] + |> String.concat "\n" + + let arg_1 : string ResizeArray = ResizeArray () + let mutable arg_0 : string 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(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + let processKeyValue (key : string) (value : string) : Result = + if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then + match arg_0 with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "a") + (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 if + System.String.Equals ( + key, + sprintf "--%s" "grab-everything", + System.StringComparison.OrdinalIgnoreCase + ) + then + value |> (fun x -> x) |> arg_1.Add + () |> Ok + else + Error None + + /// Returns false if we didn't set a value. + let setFlagValue (key : string) : bool = false + + let rec go (state : ParseState_FlagsIntoPositionalArgs) (args : string list) = + match args with + | [] -> + match state with + | ParseState_FlagsIntoPositionalArgs.AwaitingKey -> () + | ParseState_FlagsIntoPositionalArgs.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 -> arg_1.AddRange (rest |> Seq.map (fun x -> x)) + | arg :: args -> + match state with + | ParseState_FlagsIntoPositionalArgs.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_FlagsIntoPositionalArgs.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match processKeyValue key value with + | Ok () -> go ParseState_FlagsIntoPositionalArgs.AwaitingKey args + | Error x -> + if true then + arg |> (fun x -> x) |> arg_1.Add + go ParseState_FlagsIntoPositionalArgs.AwaitingKey args + else + 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_FlagsIntoPositionalArgs.AwaitingKey args + else + arg |> (fun x -> x) |> arg_1.Add + go ParseState_FlagsIntoPositionalArgs.AwaitingKey args + | ParseState_FlagsIntoPositionalArgs.AwaitingValue key -> + match processKeyValue key arg with + | Ok () -> go ParseState_FlagsIntoPositionalArgs.AwaitingKey args + | Error exc -> + if setFlagValue key then + go ParseState_FlagsIntoPositionalArgs.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_FlagsIntoPositionalArgs.AwaitingKey args + let arg_1 = arg_1 |> Seq.toList + + let arg_0 = + match arg_0 with + | None -> + sprintf "Required argument '%s' received no value" (sprintf "--%s" "a") + |> ArgParser_errors.Add + + Unchecked.defaultof<_> + | Some x -> x + + if 0 = ArgParser_errors.Count then + { + A = arg_0 + GrabEverything = arg_1 + } + else + ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + + static member parse (args : string list) : FlagsIntoPositionalArgs = + FlagsIntoPositionalArgs.parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type FlagsIntoPositionalArgs' +[] +module FlagsIntoPositionalArgs'ArgParse = + type private ParseState_FlagsIntoPositionalArgs' = + /// 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 + + /// Extension methods for argument parsing + type FlagsIntoPositionalArgs' with + + static member parse' + (getEnvironmentVariable : string -> string) + (args : string list) + : FlagsIntoPositionalArgs' + = + let ArgParser_errors = ResizeArray () + + let helpText () = + [ + (sprintf "%s string%s%s" (sprintf "--%s" "a") "" "") + (sprintf + "%s string%s%s" + (sprintf "--%s" "dont-grab-everything") + " (positional args) (can be repeated)" + "") + ] + |> String.concat "\n" + + let arg_1 : string ResizeArray = ResizeArray () + let mutable arg_0 : string 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(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + let processKeyValue (key : string) (value : string) : Result = + if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then + match arg_0 with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "a") + (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 if + System.String.Equals ( + key, + sprintf "--%s" "dont-grab-everything", + System.StringComparison.OrdinalIgnoreCase + ) + then + value |> (fun x -> x) |> arg_1.Add + () |> Ok + else + Error None + + /// Returns false if we didn't set a value. + let setFlagValue (key : string) : bool = false + + let rec go (state : ParseState_FlagsIntoPositionalArgs') (args : string list) = + match args with + | [] -> + match state with + | ParseState_FlagsIntoPositionalArgs'.AwaitingKey -> () + | ParseState_FlagsIntoPositionalArgs'.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 -> arg_1.AddRange (rest |> Seq.map (fun x -> x)) + | arg :: args -> + match state with + | ParseState_FlagsIntoPositionalArgs'.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_FlagsIntoPositionalArgs'.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match processKeyValue key value with + | Ok () -> go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args + | Error x -> + if false then + arg |> (fun x -> x) |> arg_1.Add + go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args + else + 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_FlagsIntoPositionalArgs'.AwaitingKey args + else + arg |> (fun x -> x) |> arg_1.Add + go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args + | ParseState_FlagsIntoPositionalArgs'.AwaitingValue key -> + match processKeyValue key arg with + | Ok () -> go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args + | Error exc -> + if setFlagValue key then + go ParseState_FlagsIntoPositionalArgs'.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_FlagsIntoPositionalArgs'.AwaitingKey args + let arg_1 = arg_1 |> Seq.toList + + let arg_0 = + match arg_0 with + | None -> + sprintf "Required argument '%s' received no value" (sprintf "--%s" "a") + |> ArgParser_errors.Add + + Unchecked.defaultof<_> + | Some x -> x + + if 0 = ArgParser_errors.Count then + { + A = arg_0 + DontGrabEverything = arg_1 + } + else + ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + + static member parse (args : string list) : FlagsIntoPositionalArgs' = + FlagsIntoPositionalArgs'.parse' System.Environment.GetEnvironmentVariable args diff --git a/WoofWare.Myriad.Plugins.Attributes/ArgParserAttributes.fs b/WoofWare.Myriad.Plugins.Attributes/ArgParserAttributes.fs index 87a94a1..f9b34c2 100644 --- a/WoofWare.Myriad.Plugins.Attributes/ArgParserAttributes.fs +++ b/WoofWare.Myriad.Plugins.Attributes/ArgParserAttributes.fs @@ -19,9 +19,22 @@ type ArgParserAttribute (isExtensionMethod : bool) = /// Attribute indicating that this field shall accumulate all unmatched args, /// as well as any that appear after a bare `--`. -type PositionalArgsAttribute () = +/// +/// Set `includeFlagLike = true` to include args that begin `--` in the +/// positional args. +/// (By default, `includeFlagLike = false` and we throw when encountering +/// an argument which looks like a flag but which we don't recognise.) +/// We will still interpret `--help` as requesting help, unless it comes after +/// a standalone `--` separator. +type PositionalArgsAttribute (includeFlagLike : bool) = inherit Attribute () + /// The default value of `isExtensionMethod`, the optional argument to the ArgParserAttribute constructor. + static member DefaultIncludeFlagLike = false + + /// Shorthand for the "includeFlagLike = false" constructor; see documentation there for details. + new () = PositionalArgsAttribute PositionalArgsAttribute.DefaultIncludeFlagLike + /// Attribute indicating that this field shall have a default value derived /// from calling an appropriately named static method on the type. /// diff --git a/WoofWare.Myriad.Plugins.Attributes/SurfaceBaseline.txt b/WoofWare.Myriad.Plugins.Attributes/SurfaceBaseline.txt index 7802547..cfe922b 100644 --- a/WoofWare.Myriad.Plugins.Attributes/SurfaceBaseline.txt +++ b/WoofWare.Myriad.Plugins.Attributes/SurfaceBaseline.txt @@ -40,7 +40,10 @@ WoofWare.Myriad.Plugins.JsonSerializeAttribute.get_DefaultIsExtensionMethod [sta WoofWare.Myriad.Plugins.ParseExactAttribute inherit System.Attribute WoofWare.Myriad.Plugins.ParseExactAttribute..ctor [constructor]: string WoofWare.Myriad.Plugins.PositionalArgsAttribute inherit System.Attribute +WoofWare.Myriad.Plugins.PositionalArgsAttribute..ctor [constructor]: bool WoofWare.Myriad.Plugins.PositionalArgsAttribute..ctor [constructor]: unit +WoofWare.Myriad.Plugins.PositionalArgsAttribute.DefaultIncludeFlagLike [static property]: [read-only] bool +WoofWare.Myriad.Plugins.PositionalArgsAttribute.get_DefaultIncludeFlagLike [static method]: unit -> bool WoofWare.Myriad.Plugins.RemoveOptionsAttribute inherit System.Attribute WoofWare.Myriad.Plugins.RemoveOptionsAttribute..ctor [constructor]: unit WoofWare.Myriad.Plugins.RestEase inherit obj diff --git a/WoofWare.Myriad.Plugins.Attributes/version.json b/WoofWare.Myriad.Plugins.Attributes/version.json index 3f331b4..fde2c04 100644 --- a/WoofWare.Myriad.Plugins.Attributes/version.json +++ b/WoofWare.Myriad.Plugins.Attributes/version.json @@ -1,5 +1,5 @@ { - "version": "3.4", + "version": "3.5", "publicReleaseRefSpec": [ "^refs/heads/main$" ], diff --git a/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs b/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs index 1a89abd..5c2a75a 100644 --- a/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs +++ b/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs @@ -618,3 +618,48 @@ Required argument '--exact' received no value""" """Help text requested. --do-something-else / --anotherarg string --turn-it-on / --dont-turn-it-off bool""" + + [] + let ``Can collect *all* non-help args into positional args with includeFlagLike`` () = + let getEnvVar (_ : string) = failwith "do not call" + + FlagsIntoPositionalArgs.parse' getEnvVar [ "--a" ; "foo" ; "--b=false" ; "--c=hi" ; "--" ; "--help" ] + |> shouldEqual + { + A = "foo" + GrabEverything = [ "--b=false" ; "--c=hi" ; "--help" ] + } + + // Users might consider this eccentric! + // But we're only a simple arg parser; we don't look around to see whether this is "almost" + // a valid parse. + FlagsIntoPositionalArgs.parse' getEnvVar [ "--a" ; "--b=false" ; "--c=hi" ; "--" ; "--help" ] + |> shouldEqual + { + A = "--b=false" + GrabEverything = [ "--c=hi" ; "--help" ] + } + + [] + let ``Can refuse to collect non-help args`` () = + let getEnvVar (_ : string) = failwith "do not call" + + let exc = + Assert.Throws (fun () -> + FlagsIntoPositionalArgs'.parse' getEnvVar [ "--a" ; "foo" ; "--b=false" ; "--c=hi" ; "--" ; "--help" ] + |> ignore + ) + + exc.Message + |> shouldEqual """Unable to process argument --b=false as key --b and value false""" + + let exc = + Assert.Throws (fun () -> + FlagsIntoPositionalArgs'.parse' getEnvVar [ "--a" ; "--b=false" ; "--c=hi" ; "--" ; "--help" ] + |> ignore + ) + + // Again perhaps eccentric! + // 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""" diff --git a/WoofWare.Myriad.Plugins/ArgParserGenerator.fs b/WoofWare.Myriad.Plugins/ArgParserGenerator.fs index 6535a73..f9d0711 100644 --- a/WoofWare.Myriad.Plugins/ArgParserGenerator.fs +++ b/WoofWare.Myriad.Plugins/ArgParserGenerator.fs @@ -85,8 +85,8 @@ type private ParseFunction<'acc> = [] type private ChoicePositional = - | Normal - | Choice + | Normal of includeFlagLike : SynExpr option + | Choice of includeFlagLike : SynExpr option type private ParseFunctionPositional = ParseFunction type private ParseFunctionNonPositional = ParseFunction> @@ -506,11 +506,14 @@ module internal ArgParserGenerator = let positionalArgAttr = attrs - |> List.tryFind (fun a -> + |> List.tryPick (fun a -> match (List.last a.TypeName.LongIdent).idText with | "PositionalArgsAttribute" - | "PositionalArgs" -> true - | _ -> false + | "PositionalArgs" -> + match a.ArgExpr with + | SynExpr.Const (SynConst.Unit, _) -> Some None + | a -> Some (Some a) + | _ -> None ) let parseExactModifier = @@ -580,7 +583,7 @@ module internal ArgParserGenerator = | None -> match positionalArgAttr with - | Some _ -> + | Some includeFlagLike -> let getChoice (spec : ArgumentDefaultSpec option) : unit = match spec with | Some _ -> @@ -607,7 +610,7 @@ module internal ArgParserGenerator = FieldName = ident Parser = parser TargetVariable = Ident.create $"arg_%i{counter}" - Accumulation = ChoicePositional.Choice + Accumulation = ChoicePositional.Choice includeFlagLike TargetType = parseTy ArgForm = longForms Help = helpText @@ -619,7 +622,7 @@ module internal ArgParserGenerator = FieldName = ident Parser = parser TargetVariable = Ident.create $"arg_%i{counter}" - Accumulation = ChoicePositional.Normal + Accumulation = ChoicePositional.Normal includeFlagLike TargetType = parseTy ArgForm = longForms Help = helpText @@ -855,8 +858,9 @@ module internal ArgParserGenerator = |> SynExpr.pipeThroughFunction pos.Parser |> fun p -> match pos.Accumulation with - | ChoicePositional.Choice -> p |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2") - | ChoicePositional.Normal -> p + | ChoicePositional.Choice _ -> + p |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2") + | ChoicePositional.Normal _ -> p |> SynExpr.pipeThroughFunction ( SynExpr.createLongIdent' [ pos.TargetVariable ; Ident.create "Add" ] ) @@ -1000,6 +1004,50 @@ module internal ArgParserGenerator = |> SynExpr.applyTo (SynExpr.createIdent "key") |> SynExpr.applyTo (SynExpr.createIdent "value") + let processAsPositional = + SynExpr.sequential + [ + SynExpr.createIdent "arg" + |> SynExpr.pipeThroughFunction leftoverArgParser + |> fun p -> + match leftoverArgAcc with + | ChoicePositional.Normal _ -> p + | ChoicePositional.Choice _ -> + p |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2") + |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' [ leftoverArgs ; Ident.create "Add" ]) + + recurseKey + ] + + let notMatched = + let posAttr = + match leftoverArgAcc with + | ChoicePositional.Choice a + | ChoicePositional.Normal a -> a + + let handleFailure = + [ + SynMatchClause.create (SynPat.named "None") fail + + SynMatchClause.create + (SynPat.nameWithArgs "Some" [ SynPat.named "msg" ]) + (SynExpr.sequential + [ + SynExpr.createIdent "sprintf" + |> SynExpr.applyTo (SynExpr.CreateConst "%s (at arg %s)") + |> SynExpr.applyTo (SynExpr.createIdent "msg") + |> SynExpr.applyTo (SynExpr.createIdent "arg") + |> SynExpr.pipeThroughFunction (SynExpr.dotGet "Add" (SynExpr.createIdent' errorAcc)) + + recurseKey + ]) + ] + |> SynExpr.createMatch (SynExpr.createIdent "x") + + match posAttr with + | None -> handleFailure + | Some posAttr -> SynExpr.ifThenElse posAttr handleFailure processAsPositional + let argStartsWithDashes = SynExpr.createIdent "arg" |> SynExpr.callMethodArg @@ -1013,19 +1061,7 @@ module internal ArgParserGenerator = let processKey = SynExpr.ifThenElse argStartsWithDashes - (SynExpr.sequential - [ - SynExpr.createIdent "arg" - |> SynExpr.pipeThroughFunction leftoverArgParser - |> fun p -> - match leftoverArgAcc with - | ChoicePositional.Normal -> p - | ChoicePositional.Choice -> - p |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2") - |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' [ leftoverArgs ; Ident.create "Add" ]) - - recurseKey - ]) + processAsPositional (SynExpr.ifThenElse (SynExpr.equals (SynExpr.createIdent "arg") (SynExpr.CreateConst "--help")) (SynExpr.createLet @@ -1061,23 +1097,9 @@ module internal ArgParserGenerator = [ SynMatchClause.create (SynPat.nameWithArgs "Ok" [ SynPat.unit ]) recurseKey - SynMatchClause.create (SynPat.nameWithArgs "Error" [ SynPat.named "None" ]) fail SynMatchClause.create - (SynPat.nameWithArgs - "Error" - [ SynPat.nameWithArgs "Some" [ SynPat.named "msg" ] |> SynPat.paren ]) - (SynExpr.sequential - [ - SynExpr.createIdent "sprintf" - |> SynExpr.applyTo (SynExpr.CreateConst "%s (at arg %s)") - |> SynExpr.applyTo (SynExpr.createIdent "msg") - |> SynExpr.applyTo (SynExpr.createIdent "arg") - |> SynExpr.pipeThroughFunction ( - SynExpr.dotGet "Add" (SynExpr.createIdent' errorAcc) - ) - - recurseKey - ]) + (SynPat.nameWithArgs "Error" [ SynPat.named "x" ]) + notMatched ])) (SynExpr.createIdent "args" |> SynExpr.pipeThroughFunction recurseValue))) (SynExpr.createIdent "helpText" @@ -1189,8 +1211,8 @@ module internal ArgParserGenerator = ) |> fun p -> match leftoverArgAcc with - | ChoicePositional.Normal -> p - | ChoicePositional.Choice -> + | ChoicePositional.Normal _ -> p + | ChoicePositional.Choice _ -> p |> SynExpr.pipeThroughFunction ( SynExpr.applyFunction @@ -1262,9 +1284,9 @@ module internal ArgParserGenerator = SynType.string | Some pf -> match pf.Accumulation with - | ChoicePositional.Choice -> + | ChoicePositional.Choice _ -> pf.TargetVariable, pf.Parser, SynType.app "Choice" [ pf.TargetType ; pf.TargetType ] - | ChoicePositional.Normal -> pf.TargetVariable, pf.Parser, pf.TargetType + | ChoicePositional.Normal _ -> pf.TargetVariable, pf.Parser, pf.TargetType let bindings = SynExpr.createIdent "ResizeArray" @@ -1492,7 +1514,7 @@ module internal ArgParserGenerator = let leftoverArgAcc = match pos with - | None -> ChoicePositional.Normal + | None -> ChoicePositional.Normal None | Some pos -> pos.Accumulation [ diff --git a/WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs b/WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs index 7a3bf3c..98bbd84 100644 --- a/WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs +++ b/WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs @@ -80,6 +80,11 @@ module internal SynExpr = let equals (a : SynExpr) (b : SynExpr) = SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.eq, a) |> applyTo b + /// {a} && {b} + let booleanAnd (a : SynExpr) (b : SynExpr) = + SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.booleanAnd, a) + |> applyTo b + /// {a} + {b} let plus (a : SynExpr) (b : SynExpr) = SynExpr.CreateAppInfix ( diff --git a/WoofWare.Myriad.Plugins/SynExpr/SynLongIdent.fs b/WoofWare.Myriad.Plugins/SynExpr/SynLongIdent.fs index 3c0bb8a..308af7d 100644 --- a/WoofWare.Myriad.Plugins/SynExpr/SynLongIdent.fs +++ b/WoofWare.Myriad.Plugins/SynExpr/SynLongIdent.fs @@ -33,6 +33,9 @@ module internal SynLongIdent = let eq = SynLongIdent.SynLongIdent ([ Ident.create "op_Equality" ], [], [ Some (IdentTrivia.OriginalNotation "=") ]) + let booleanAnd = + SynLongIdent.SynLongIdent ([ Ident.create "op_BooleanAnd" ], [], [ Some (IdentTrivia.OriginalNotation "&&") ]) + let pipe = SynLongIdent.SynLongIdent ([ Ident.create "op_PipeRight" ], [], [ Some (IdentTrivia.OriginalNotation "|>") ])