diff --git a/ConsumePlugin/Args.fs b/ConsumePlugin/Args.fs index 2ef25290..13477cc7 100644 --- a/ConsumePlugin/Args.fs +++ b/ConsumePlugin/Args.fs @@ -235,3 +235,9 @@ type FlagsIntoPositionalArgs' = [] DontGrabEverything : string list } + +[] +type PassThru = + { + A : ParentRecordChildPos + } diff --git a/ConsumePlugin/ArgsWithUnions.fs b/ConsumePlugin/ArgsWithUnions.fs new file mode 100644 index 00000000..53974428 --- /dev/null +++ b/ConsumePlugin/ArgsWithUnions.fs @@ -0,0 +1,35 @@ +namespace ConsumePlugin.ArgsWithUnions + +open System +open System.IO +open WoofWare.Myriad.Plugins + +type BasicNoPositionals = + { + Foo : int + Bar : string + Baz : bool + Rest : int list + } + +type UsernamePasswordAuth = + { + Username : string + Password : string + } + +type TokenAuth = + { + Token : string + } + +type AuthOptions = + | UsernamePassword of UsernamePasswordAuth + | Token of TokenAuth + +[] +type DoTheThing = + { + Basics : BasicNoPositionals + Auth : AuthOptions + } diff --git a/ConsumePlugin/ConsumePlugin.fsproj b/ConsumePlugin/ConsumePlugin.fsproj index 7d053e93..06b55b60 100644 --- a/ConsumePlugin/ConsumePlugin.fsproj +++ b/ConsumePlugin/ConsumePlugin.fsproj @@ -12,6 +12,7 @@ + Args.fs + + + ArgsWithUnions.fs + + diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index 7a0752fd..8b60d112 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -8,701 +8,768 @@ -namespace ConsumePlugin +namespace ArgParserHelpers + +/// Helper types for arg parsing +module internal ArgParseHelpers_ConsumePlugin = + open System + open System.IO + open WoofWare.Myriad.Plugins + open ConsumePlugin + + /// A partially-parsed BasicNoPositionals. + type internal BasicNoPositionals_InProgress = + { + mutable Bar : string option + mutable Baz : bool option + mutable Foo : int option + mutable Rest : ResizeArray + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () -open System -open System.IO -open WoofWare.Myriad.Plugins + let arg0 : int = + match this.Foo with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "foo") + Unchecked.defaultof<_> -/// Methods to parse arguments for the type BasicNoPositionals -[] -module BasicNoPositionals = - type private ParseState_BasicNoPositionals = - /// 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 arg1 : string = + match this.Bar with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "bar") + Unchecked.defaultof<_> - let parse' (getEnvironmentVariable : string -> string) (args : string list) : BasicNoPositionals = - let ArgParser_errors = ResizeArray () - - let helpText () = - [ - (sprintf "%s int32%s%s" (sprintf "--%s" "foo") "" "") - (sprintf "%s string%s%s" (sprintf "--%s" "bar") "" "") - (sprintf "%s bool%s%s" (sprintf "--%s" "baz") "" "") - (sprintf "%s int32%s%s" (sprintf "--%s" "rest") " (can be repeated)" "") - ] - |> String.concat "\n" - - let parser_LeftoverArgs : string ResizeArray = ResizeArray () - let mutable arg_0 : int option = None - let mutable arg_1 : string option = None - let mutable arg_2 : bool option = None - let arg_3 : int ResizeArray = ResizeArray () + let arg2 : bool = + match this.Baz with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "baz") + Unchecked.defaultof<_> + + let arg3 : int list = this.Rest |> Seq.toList + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + Foo = arg0 + Bar = arg1 + Baz = arg2 + Rest = arg3 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : BasicNoPositionals_InProgress = + { + Bar = None + Baz = None + Foo = None + Rest = ResizeArray () + } /// 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 = + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = if System.String.Equals (key, sprintf "--%s" "rest", System.StringComparison.OrdinalIgnoreCase) then - value |> (fun x -> System.Int32.Parse x) |> arg_3.Add + value |> (fun x -> System.Int32.Parse x) |> (fun x -> x) |> this.Rest.Add () |> Ok - else if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then - match arg_2 with + else if System.String.Equals (key, sprintf "--%s" "foo", System.StringComparison.OrdinalIgnoreCase) then + match this.Foo with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "baz") + (sprintf "--%s" "foo") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_2 <- value |> (fun x -> System.Boolean.Parse x) |> Some + this.Foo <- value |> (fun x -> System.Int32.Parse x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error - else if System.String.Equals (key, sprintf "--%s" "bar", System.StringComparison.OrdinalIgnoreCase) then - match arg_1 with + else if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then + match this.Baz with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "bar") + (sprintf "--%s" "baz") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_1 <- value |> (fun x -> x) |> Some + this.Baz <- value |> (fun x -> System.Boolean.Parse x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error - else if System.String.Equals (key, sprintf "--%s" "foo", System.StringComparison.OrdinalIgnoreCase) then - match arg_0 with + else if System.String.Equals (key, sprintf "--%s" "bar", System.StringComparison.OrdinalIgnoreCase) then + match this.Bar with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "foo") + (sprintf "--%s" "bar") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_0 <- value |> (fun x -> System.Int32.Parse x) |> Some + this.Bar <- value |> (fun x -> x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error else Error None + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + /// Returns false if we didn't set a value. - let setFlagValue (key : string) : bool = + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then - match arg_2 with - | Some x -> + match this.Baz with + | Some _ -> sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "baz") - |> ArgParser_errors.Add + |> errors_.Add true | None -> - arg_2 <- true |> Some + this.Baz <- true |> Some true else false - let rec go (state : ParseState_BasicNoPositionals) (args : string list) = - match args with - | [] -> - match state with - | ParseState_BasicNoPositionals.AwaitingKey -> () - | ParseState_BasicNoPositionals.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_BasicNoPositionals.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_BasicNoPositionals.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] - - match processKeyValue key value with - | Ok () -> 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 - | ParseState_BasicNoPositionals.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_BasicNoPositionals.AwaitingKey args - | Error exc -> - if setFlagValue key then - go ParseState_BasicNoPositionals.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_BasicNoPositionals.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 + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" - Unchecked.defaultof<_> + /// A partially-parsed Basic. + type internal Basic_InProgress = + { + mutable Bar : string option + mutable Baz : bool option + mutable Foo : int option + mutable Rest : ResizeArray + } - let arg_0 = - match arg_0 with - | None -> - sprintf "Required argument '%s' received no value" (sprintf "--%s" "foo") - |> ArgParser_errors.Add + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () - Unchecked.defaultof<_> - | Some x -> x + let arg0 : int = + match this.Foo with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "foo") + Unchecked.defaultof<_> - let arg_1 = - match arg_1 with - | None -> - sprintf "Required argument '%s' received no value" (sprintf "--%s" "bar") - |> ArgParser_errors.Add + let arg1 : string = + match this.Bar with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "bar") + Unchecked.defaultof<_> - Unchecked.defaultof<_> - | Some x -> x + let arg2 : bool = + match this.Baz with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "baz") + Unchecked.defaultof<_> - let arg_2 = - match arg_2 with - | None -> - sprintf "Required argument '%s' received no value" (sprintf "--%s" "baz") - |> ArgParser_errors.Add + let arg3 : string list = + positionalConsumers.Add (sprintf "--%s" "rest") - Unchecked.defaultof<_> - | Some x -> x + positionals + |> Seq.map (fun x -> + match x with + | Choice1Of2 x -> + if not (false) && (fst x).StartsWith ("--", System.StringComparison.Ordinal) then + outOfPlacePositionals.Add (fst x) + x + else + x + | Choice2Of2 x -> x + ) + |> Seq.map (fun (str, argNum_) -> str |> (fun x -> x), argNum_) + |> (fun x -> Seq.append this.Rest x) + |> Seq.sortBy snd + |> Seq.map fst + |> Seq.toList + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () - let arg_3 = arg_3 |> Seq.toList + if errors.Count = 0 then + Ok ( + { + Foo = arg0 + Bar = arg1 + Baz = arg2 + Rest = arg3 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error - if 0 = ArgParser_errors.Count then + static member _Empty () : Basic_InProgress = { - Bar = arg_1 - Baz = arg_2 - Foo = arg_0 - Rest = arg_3 + Bar = None + Baz = None + Foo = None + Rest = ResizeArray () } - else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" - - let parse (args : string list) : BasicNoPositionals = - parse' System.Environment.GetEnvironmentVariable args -namespace ConsumePlugin - -open System -open System.IO -open WoofWare.Myriad.Plugins - -/// Methods to parse arguments for the type Basic -[] -module Basic = - type private ParseState_Basic = - /// 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) (args : string list) : Basic = - let ArgParser_errors = ResizeArray () - - let helpText () = - [ - (sprintf "%s int32%s%s" (sprintf "--%s" "foo") "" (sprintf " : %s" ("This is a foo!"))) - (sprintf "%s string%s%s" (sprintf "--%s" "bar") "" "") - (sprintf "%s bool%s%s" (sprintf "--%s" "baz") "" "") - (sprintf - "%s string%s%s" - (sprintf "--%s" "rest") - " (positional args) (can be repeated)" - (sprintf " : %s" ("Here's where the rest of the args go"))) - ] - |> String.concat "\n" - - let arg_3 : string ResizeArray = ResizeArray () - let mutable arg_0 : int 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(). /// 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" "baz", System.StringComparison.OrdinalIgnoreCase) then - match arg_2 with + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "rest", System.StringComparison.OrdinalIgnoreCase) then + value |> (fun x -> x) |> (fun x -> x, argNum_) |> this.Rest.Add + () |> Ok + else if System.String.Equals (key, sprintf "--%s" "foo", System.StringComparison.OrdinalIgnoreCase) then + match this.Foo with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "baz") + (sprintf "--%s" "foo") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_2 <- value |> (fun x -> System.Boolean.Parse x) |> Some + this.Foo <- value |> (fun x -> System.Int32.Parse x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error - else if System.String.Equals (key, sprintf "--%s" "bar", System.StringComparison.OrdinalIgnoreCase) then - match arg_1 with + else if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then + match this.Baz with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "bar") + (sprintf "--%s" "baz") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_1 <- value |> (fun x -> x) |> Some + this.Baz <- value |> (fun x -> System.Boolean.Parse x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error - else if System.String.Equals (key, sprintf "--%s" "foo", System.StringComparison.OrdinalIgnoreCase) then - match arg_0 with + else if System.String.Equals (key, sprintf "--%s" "bar", System.StringComparison.OrdinalIgnoreCase) then + match this.Bar with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "foo") + (sprintf "--%s" "bar") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_0 <- value |> (fun x -> System.Int32.Parse x) |> Some + this.Bar <- value |> (fun x -> x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error - else if System.String.Equals (key, sprintf "--%s" "rest", System.StringComparison.OrdinalIgnoreCase) then - value |> (fun x -> x) |> arg_3.Add - () |> Ok else Error None + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + /// Returns false if we didn't set a value. - let setFlagValue (key : string) : bool = + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then - match arg_2 with - | Some x -> + match this.Baz with + | Some _ -> sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "baz") - |> ArgParser_errors.Add + |> errors_.Add true | None -> - arg_2 <- true |> Some + this.Baz <- true |> Some true else false - let rec go (state : ParseState_Basic) (args : string list) = - match args with - | [] -> - match state with - | ParseState_Basic.AwaitingKey -> () - | ParseState_Basic.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_3.AddRange (rest |> Seq.map (fun x -> x)) - | arg :: args -> - match state with - | ParseState_Basic.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) + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" - if equals < 0 then - args |> go (ParseState_Basic.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] + /// A partially-parsed BasicWithIntPositionals. + type internal BasicWithIntPositionals_InProgress = + { + mutable Bar : string option + mutable Baz : bool option + mutable Foo : int option + mutable Rest : ResizeArray + } - match processKeyValue key value with - | Ok () -> 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 - | ParseState_Basic.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_Basic.AwaitingKey args - | Error exc -> - if setFlagValue key then - go ParseState_Basic.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_Basic.AwaitingKey args - let arg_3 = arg_3 |> Seq.toList - - let arg_0 = - match arg_0 with - | None -> - sprintf "Required argument '%s' received no value" (sprintf "--%s" "foo") - |> 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" "bar") - |> 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" "baz") - |> ArgParser_errors.Add - - Unchecked.defaultof<_> - | Some x -> x - - if 0 = ArgParser_errors.Count then - { - Bar = arg_1 - Baz = arg_2 - Foo = arg_0 - Rest = arg_3 - } - else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () - let parse (args : string list) : Basic = - parse' System.Environment.GetEnvironmentVariable args -namespace ConsumePlugin + let arg0 : int = + match this.Foo with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "foo") + Unchecked.defaultof<_> -open System -open System.IO -open WoofWare.Myriad.Plugins + let arg1 : string = + match this.Bar with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "bar") + Unchecked.defaultof<_> -/// Methods to parse arguments for the type BasicWithIntPositionals -[] -module BasicWithIntPositionals = - type private ParseState_BasicWithIntPositionals = - /// 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 arg2 : bool = + match this.Baz with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "baz") + Unchecked.defaultof<_> - let parse' (getEnvironmentVariable : string -> string) (args : string list) : BasicWithIntPositionals = - let ArgParser_errors = ResizeArray () - - let helpText () = - [ - (sprintf "%s int32%s%s" (sprintf "--%s" "foo") "" "") - (sprintf "%s string%s%s" (sprintf "--%s" "bar") "" "") - (sprintf "%s bool%s%s" (sprintf "--%s" "baz") "" "") - (sprintf "%s int32%s%s" (sprintf "--%s" "rest") " (positional args) (can be repeated)" "") - ] - |> String.concat "\n" - - let arg_3 : int ResizeArray = ResizeArray () - let mutable arg_0 : int option = None - let mutable arg_1 : string option = None - let mutable arg_2 : bool option = None + let arg3 : int list = + positionalConsumers.Add (sprintf "--%s" "rest") + + positionals + |> Seq.map (fun x -> + match x with + | Choice1Of2 x -> + if not (false) && (fst x).StartsWith ("--", System.StringComparison.Ordinal) then + outOfPlacePositionals.Add (fst x) + x + else + x + | Choice2Of2 x -> x + ) + |> Seq.map (fun (str, argNum_) -> str |> (fun x -> System.Int32.Parse x), argNum_) + |> (fun x -> Seq.append this.Rest x) + |> Seq.sortBy snd + |> Seq.map fst + |> Seq.toList + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + Foo = arg0 + Bar = arg1 + Baz = arg2 + Rest = arg3 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : BasicWithIntPositionals_InProgress = + { + Bar = None + Baz = None + Foo = None + Rest = ResizeArray () + } /// 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" "baz", System.StringComparison.OrdinalIgnoreCase) then - match arg_2 with + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "rest", System.StringComparison.OrdinalIgnoreCase) then + value + |> (fun x -> System.Int32.Parse x) + |> (fun x -> x, argNum_) + |> this.Rest.Add + + () |> Ok + else if System.String.Equals (key, sprintf "--%s" "foo", System.StringComparison.OrdinalIgnoreCase) then + match this.Foo with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "baz") + (sprintf "--%s" "foo") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_2 <- value |> (fun x -> System.Boolean.Parse x) |> Some + this.Foo <- value |> (fun x -> System.Int32.Parse x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error - else if System.String.Equals (key, sprintf "--%s" "bar", System.StringComparison.OrdinalIgnoreCase) then - match arg_1 with + else if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then + match this.Baz with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "bar") + (sprintf "--%s" "baz") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_1 <- value |> (fun x -> x) |> Some + this.Baz <- value |> (fun x -> System.Boolean.Parse x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error - else if System.String.Equals (key, sprintf "--%s" "foo", System.StringComparison.OrdinalIgnoreCase) then - match arg_0 with + else if System.String.Equals (key, sprintf "--%s" "bar", System.StringComparison.OrdinalIgnoreCase) then + match this.Bar with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "foo") + (sprintf "--%s" "bar") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_0 <- value |> (fun x -> System.Int32.Parse x) |> Some + this.Bar <- value |> (fun x -> x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error - else if System.String.Equals (key, sprintf "--%s" "rest", System.StringComparison.OrdinalIgnoreCase) then - value |> (fun x -> System.Int32.Parse x) |> arg_3.Add - () |> Ok else Error None + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + /// Returns false if we didn't set a value. - let setFlagValue (key : string) : bool = + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then - match arg_2 with - | Some x -> + match this.Baz with + | Some _ -> sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "baz") - |> ArgParser_errors.Add + |> errors_.Add true | None -> - arg_2 <- true |> Some + this.Baz <- true |> Some true else false - let rec go (state : ParseState_BasicWithIntPositionals) (args : string list) = - match args with - | [] -> - match state with - | ParseState_BasicWithIntPositionals.AwaitingKey -> () - | ParseState_BasicWithIntPositionals.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_3.AddRange (rest |> Seq.map (fun x -> System.Int32.Parse x)) - | arg :: args -> - match state with - | ParseState_BasicWithIntPositionals.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) + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed LoadsOfTypes. + type internal LoadsOfTypes_InProgress = + { + mutable AnotherOptionalThing : int option + mutable Bar : string option + mutable Baz : bool option + mutable Foo : int option + mutable OptionalThing : bool option + mutable OptionalThingWithNoDefault : int option + mutable Positionals : ResizeArray + mutable SomeDirectory : DirectoryInfo option + mutable SomeFile : FileInfo option + mutable SomeList : ResizeArray + mutable YetAnotherOptionalThing : string option + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () - if equals < 0 then - args |> go (ParseState_BasicWithIntPositionals.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] + let arg0 : int = + match this.Foo with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "foo") + Unchecked.defaultof<_> - match processKeyValue key value with - | Ok () -> 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 - | ParseState_BasicWithIntPositionals.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_BasicWithIntPositionals.AwaitingKey args - | Error exc -> - if setFlagValue key then - go ParseState_BasicWithIntPositionals.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_BasicWithIntPositionals.AwaitingKey args - let arg_3 = arg_3 |> Seq.toList - - let arg_0 = - match arg_0 with - | None -> - sprintf "Required argument '%s' received no value" (sprintf "--%s" "foo") - |> 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" "bar") - |> 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" "baz") - |> ArgParser_errors.Add - - Unchecked.defaultof<_> - | Some x -> x - - if 0 = ArgParser_errors.Count then - { - Bar = arg_1 - Baz = arg_2 - Foo = arg_0 - Rest = arg_3 - } - else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + let arg1 : string = + match this.Bar with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "bar") + Unchecked.defaultof<_> - let parse (args : string list) : BasicWithIntPositionals = - parse' System.Environment.GetEnvironmentVariable args -namespace ConsumePlugin + let arg2 : bool = + match this.Baz with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "baz") + Unchecked.defaultof<_> -open System -open System.IO -open WoofWare.Myriad.Plugins + let arg3 : FileInfo = + match this.SomeFile with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "some-file") + Unchecked.defaultof<_> -/// Methods to parse arguments for the type LoadsOfTypes -[] -module LoadsOfTypes = - type private ParseState_LoadsOfTypes = - /// 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 arg4 : DirectoryInfo = + match this.SomeDirectory with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "some-directory") - let parse' (getEnvironmentVariable : string -> string) (args : string list) : LoadsOfTypes = - let ArgParser_errors = ResizeArray () - - let helpText () = - [ - (sprintf "%s int32%s%s" (sprintf "--%s" "foo") "" "") - (sprintf "%s string%s%s" (sprintf "--%s" "bar") "" "") - (sprintf "%s bool%s%s" (sprintf "--%s" "baz") "" "") - (sprintf "%s FileInfo%s%s" (sprintf "--%s" "some-file") "" "") - (sprintf "%s DirectoryInfo%s%s" (sprintf "--%s" "some-directory") "" "") - (sprintf "%s DirectoryInfo%s%s" (sprintf "--%s" "some-list") " (can be repeated)" "") - (sprintf "%s int32%s%s" (sprintf "--%s" "optional-thing-with-no-default") " (optional)" "") - - (sprintf - "%s bool%s%s" - (sprintf "--%s" "optional-thing") - (LoadsOfTypes.DefaultOptionalThing () - |> (fun x -> x.ToString ()) - |> sprintf " (default value: %s)") - "") - - (sprintf - "%s int32%s%s" - (sprintf "--%s" "another-optional-thing") - (LoadsOfTypes.DefaultAnotherOptionalThing () - |> (fun x -> x.ToString ()) - |> sprintf " (default value: %s)") - "") - - (sprintf - "%s string%s%s" - (sprintf "--%s" "yet-another-optional-thing") - ("CONSUMEPLUGIN_THINGS" |> sprintf " (default value populated from env var %s)") - "") - (sprintf "%s int32%s%s" (sprintf "--%s" "positionals") " (positional args) (can be repeated)" "") - ] - |> String.concat "\n" - - let arg_7 : int ResizeArray = ResizeArray () - let mutable arg_0 : int option = None - let mutable arg_1 : string option = None - let mutable arg_2 : bool option = None - let mutable arg_3 : FileInfo option = None - let mutable arg_4 : DirectoryInfo option = None - let arg_5 : DirectoryInfo ResizeArray = ResizeArray () - let mutable arg_6 : int option = None - let mutable arg_8 : bool option = None - let mutable arg_9 : int option = None - let mutable arg_10 : string option = None + Unchecked.defaultof<_ > + + let arg5 : DirectoryInfo list = this.SomeList |> Seq.toList + let arg6 : int option = this.OptionalThingWithNoDefault + + let arg7 : int list = + positionalConsumers.Add (sprintf "--%s" "positionals") + + positionals + |> Seq.map (fun x -> + match x with + | Choice1Of2 x -> + if not (false) && (fst x).StartsWith ("--", System.StringComparison.Ordinal) then + outOfPlacePositionals.Add (fst x) + x + else + x + | Choice2Of2 x -> x + ) + |> Seq.map (fun (str, argNum_) -> str |> (fun x -> System.Int32.Parse x), argNum_) + |> (fun x -> Seq.append this.Positionals x) + |> Seq.sortBy snd + |> Seq.map fst + |> Seq.toList + + let arg8 : Choice = + match this.OptionalThing with + | Some result -> Choice1Of2 result + | None -> Choice2Of2 (LoadsOfTypes.DefaultOptionalThing ()) + + let arg9 : Choice = + match this.AnotherOptionalThing with + | Some result -> Choice1Of2 result + | None -> Choice2Of2 (LoadsOfTypes.DefaultAnotherOptionalThing ()) + + let arg10 : Choice = + match this.YetAnotherOptionalThing with + | Some result -> Choice1Of2 result + | None -> Choice2Of2 ("CONSUMEPLUGIN_THINGS" |> getEnvironmentVariable |> (fun x -> x)) + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + Foo = arg0 + Bar = arg1 + Baz = arg2 + SomeFile = arg3 + SomeDirectory = arg4 + SomeList = arg5 + OptionalThingWithNoDefault = arg6 + Positionals = arg7 + OptionalThing = arg8 + AnotherOptionalThing = arg9 + YetAnotherOptionalThing = arg10 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : LoadsOfTypes_InProgress = + { + AnotherOptionalThing = None + Bar = None + Baz = None + Foo = None + OptionalThing = None + OptionalThingWithNoDefault = None + Positionals = ResizeArray () + SomeDirectory = None + SomeFile = None + SomeList = ResizeArray () + YetAnotherOptionalThing = 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 = + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = if System.String.Equals ( key, @@ -710,64 +777,78 @@ module LoadsOfTypes = System.StringComparison.OrdinalIgnoreCase ) then - match arg_10 with + match this.YetAnotherOptionalThing with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" (sprintf "--%s" "yet-another-optional-thing") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_10 <- value |> (fun x -> x) |> Some + this.YetAnotherOptionalThing <- value |> (fun x -> x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error else if - System.String.Equals ( - key, - sprintf "--%s" "another-optional-thing", - System.StringComparison.OrdinalIgnoreCase - ) + System.String.Equals (key, sprintf "--%s" "some-list", System.StringComparison.OrdinalIgnoreCase) + then + value + |> (fun x -> System.IO.DirectoryInfo x) + |> (fun x -> x) + |> this.SomeList.Add + + () |> Ok + else if + System.String.Equals (key, sprintf "--%s" "some-file", System.StringComparison.OrdinalIgnoreCase) then - match arg_9 with + match this.SomeFile with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "another-optional-thing") + (sprintf "--%s" "some-file") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_9 <- value |> (fun x -> System.Int32.Parse x) |> Some + this.SomeFile <- value |> (fun x -> System.IO.FileInfo x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error else if - System.String.Equals (key, sprintf "--%s" "optional-thing", System.StringComparison.OrdinalIgnoreCase) + System.String.Equals (key, sprintf "--%s" "some-directory", System.StringComparison.OrdinalIgnoreCase) then - match arg_8 with + match this.SomeDirectory with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "optional-thing") + (sprintf "--%s" "some-directory") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_8 <- value |> (fun x -> System.Boolean.Parse x) |> Some + this.SomeDirectory <- value |> (fun x -> System.IO.DirectoryInfo x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error + else if + System.String.Equals (key, sprintf "--%s" "positionals", System.StringComparison.OrdinalIgnoreCase) + then + value + |> (fun x -> System.Int32.Parse x) + |> (fun x -> x, argNum_) + |> this.Positionals.Add + + () |> Ok else if System.String.Equals ( key, @@ -775,367 +856,304 @@ module LoadsOfTypes = System.StringComparison.OrdinalIgnoreCase ) then - match arg_6 with + match this.OptionalThingWithNoDefault with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" (sprintf "--%s" "optional-thing-with-no-default") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_6 <- value |> (fun x -> System.Int32.Parse x) |> Some + this.OptionalThingWithNoDefault <- value |> (fun x -> System.Int32.Parse x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error else if - System.String.Equals (key, sprintf "--%s" "some-list", System.StringComparison.OrdinalIgnoreCase) - then - value |> (fun x -> System.IO.DirectoryInfo x) |> arg_5.Add - () |> Ok - else if - System.String.Equals (key, sprintf "--%s" "some-directory", System.StringComparison.OrdinalIgnoreCase) + System.String.Equals (key, sprintf "--%s" "optional-thing", System.StringComparison.OrdinalIgnoreCase) then - match arg_4 with + match this.OptionalThing with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "some-directory") + (sprintf "--%s" "optional-thing") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_4 <- value |> (fun x -> System.IO.DirectoryInfo x) |> Some + this.OptionalThing <- value |> (fun x -> System.Boolean.Parse x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error - else if - System.String.Equals (key, sprintf "--%s" "some-file", System.StringComparison.OrdinalIgnoreCase) - then - match arg_3 with + else if System.String.Equals (key, sprintf "--%s" "foo", System.StringComparison.OrdinalIgnoreCase) then + match this.Foo with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "some-file") + (sprintf "--%s" "foo") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_3 <- value |> (fun x -> System.IO.FileInfo x) |> Some + this.Foo <- value |> (fun x -> System.Int32.Parse x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error else if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then - match arg_2 with + match this.Baz with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" (sprintf "--%s" "baz") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_2 <- value |> (fun x -> System.Boolean.Parse x) |> Some + this.Baz <- value |> (fun x -> System.Boolean.Parse x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error else if System.String.Equals (key, sprintf "--%s" "bar", System.StringComparison.OrdinalIgnoreCase) then - match arg_1 with + match this.Bar with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" (sprintf "--%s" "bar") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_1 <- value |> (fun x -> x) |> Some + this.Bar <- value |> (fun x -> x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error - else if System.String.Equals (key, sprintf "--%s" "foo", System.StringComparison.OrdinalIgnoreCase) then - match arg_0 with + else if + System.String.Equals ( + key, + sprintf "--%s" "another-optional-thing", + System.StringComparison.OrdinalIgnoreCase + ) + then + match this.AnotherOptionalThing with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "foo") + (sprintf "--%s" "another-optional-thing") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_0 <- value |> (fun x -> System.Int32.Parse x) |> Some + this.AnotherOptionalThing <- value |> (fun x -> System.Int32.Parse x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error - else if - System.String.Equals (key, sprintf "--%s" "positionals", System.StringComparison.OrdinalIgnoreCase) - then - value |> (fun x -> System.Int32.Parse x) |> arg_7.Add - () |> Ok else Error None + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + /// Returns false if we didn't set a value. - let setFlagValue (key : string) : bool = + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = if System.String.Equals (key, sprintf "--%s" "optional-thing", System.StringComparison.OrdinalIgnoreCase) then - match arg_8 with - | Some x -> + match this.OptionalThing with + | Some _ -> sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "optional-thing") - |> ArgParser_errors.Add + |> errors_.Add true | None -> - arg_8 <- true |> Some + this.OptionalThing <- true |> Some true else if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then - match arg_2 with - | Some x -> + match this.Baz with + | Some _ -> sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "baz") - |> ArgParser_errors.Add + |> errors_.Add true | None -> - arg_2 <- true |> Some + this.Baz <- true |> Some true else false - let rec go (state : ParseState_LoadsOfTypes) (args : string list) = - match args with - | [] -> - match state with - | ParseState_LoadsOfTypes.AwaitingKey -> () - | ParseState_LoadsOfTypes.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_7.AddRange (rest |> Seq.map (fun x -> System.Int32.Parse x)) - | arg :: args -> - match state with - | ParseState_LoadsOfTypes.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) + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed LoadsOfTypesNoPositionals. + type internal LoadsOfTypesNoPositionals_InProgress = + { + mutable AnotherOptionalThing : int option + mutable Bar : string option + mutable Baz : bool option + mutable Foo : int option + mutable OptionalThing : bool option + mutable OptionalThingWithNoDefault : int option + mutable SomeDirectory : DirectoryInfo option + mutable SomeFile : FileInfo option + mutable SomeList : ResizeArray + mutable YetAnotherOptionalThing : string option + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () - if equals < 0 then - args |> go (ParseState_LoadsOfTypes.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] + let arg0 : int = + match this.Foo with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "foo") + Unchecked.defaultof<_> - match processKeyValue key value with - | Ok () -> 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 - | ParseState_LoadsOfTypes.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_LoadsOfTypes.AwaitingKey args - | Error exc -> - if setFlagValue key then - go ParseState_LoadsOfTypes.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_LoadsOfTypes.AwaitingKey args - let arg_7 = arg_7 |> Seq.toList - - let arg_0 = - match arg_0 with - | None -> - sprintf "Required argument '%s' received no value" (sprintf "--%s" "foo") - |> 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" "bar") - |> 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" "baz") - |> ArgParser_errors.Add - - Unchecked.defaultof<_> - | Some x -> x - - let arg_3 = - match arg_3 with - | None -> - sprintf "Required argument '%s' received no value" (sprintf "--%s" "some-file") - |> ArgParser_errors.Add - - Unchecked.defaultof<_> - | Some x -> x - - let arg_4 = - match arg_4 with - | None -> - sprintf "Required argument '%s' received no value" (sprintf "--%s" "some-directory") - |> ArgParser_errors.Add - - Unchecked.defaultof<_> - | Some x -> x - - let arg_5 = arg_5 |> Seq.toList - let arg_6 = arg_6 - - let arg_8 = - match arg_8 with - | None -> LoadsOfTypes.DefaultOptionalThing () |> Choice2Of2 - | Some x -> Choice1Of2 x - - let arg_9 = - match arg_9 with - | None -> LoadsOfTypes.DefaultAnotherOptionalThing () |> Choice2Of2 - | Some x -> Choice1Of2 x - - let arg_10 = - match arg_10 with - | None -> - match "CONSUMEPLUGIN_THINGS" |> getEnvironmentVariable with - | null -> - sprintf - "No value was supplied for %s, nor was environment variable %s set" - (sprintf "--%s" "yet-another-optional-thing") - "CONSUMEPLUGIN_THINGS" - |> ArgParser_errors.Add + let arg1 : string = + match this.Bar with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "bar") + Unchecked.defaultof<_> + let arg2 : bool = + match this.Baz with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "baz") Unchecked.defaultof<_> - | x -> x |> (fun x -> x) - |> Choice2Of2 - | Some x -> Choice1Of2 x - if 0 = ArgParser_errors.Count then - { - AnotherOptionalThing = arg_9 - Bar = arg_1 - Baz = arg_2 - Foo = arg_0 - OptionalThing = arg_8 - OptionalThingWithNoDefault = arg_6 - Positionals = arg_7 - SomeDirectory = arg_4 - SomeFile = arg_3 - SomeList = arg_5 - YetAnotherOptionalThing = arg_10 - } - else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + let arg3 : FileInfo = + match this.SomeFile with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "some-file") + Unchecked.defaultof<_> - let parse (args : string list) : LoadsOfTypes = - parse' System.Environment.GetEnvironmentVariable args -namespace ConsumePlugin + let arg4 : DirectoryInfo = + match this.SomeDirectory with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "some-directory") -open System -open System.IO -open WoofWare.Myriad.Plugins + Unchecked.defaultof<_ > -/// Methods to parse arguments for the type LoadsOfTypesNoPositionals -[] -module LoadsOfTypesNoPositionals = - type private ParseState_LoadsOfTypesNoPositionals = - /// 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 arg5 : DirectoryInfo list = this.SomeList |> Seq.toList + let arg6 : int option = this.OptionalThingWithNoDefault - let parse' (getEnvironmentVariable : string -> string) (args : string list) : LoadsOfTypesNoPositionals = - let ArgParser_errors = ResizeArray () - - let helpText () = - [ - (sprintf "%s int32%s%s" (sprintf "--%s" "foo") "" "") - (sprintf "%s string%s%s" (sprintf "--%s" "bar") "" "") - (sprintf "%s bool%s%s" (sprintf "--%s" "baz") "" "") - (sprintf "%s FileInfo%s%s" (sprintf "--%s" "some-file") "" "") - (sprintf "%s DirectoryInfo%s%s" (sprintf "--%s" "some-directory") "" "") - (sprintf "%s DirectoryInfo%s%s" (sprintf "--%s" "some-list") " (can be repeated)" "") - (sprintf "%s int32%s%s" (sprintf "--%s" "optional-thing-with-no-default") " (optional)" "") - - (sprintf - "%s bool%s%s" - (sprintf "--%s" "optional-thing") - (LoadsOfTypesNoPositionals.DefaultOptionalThing () - |> (fun x -> x.ToString ()) - |> sprintf " (default value: %s)") - "") - - (sprintf - "%s int32%s%s" - (sprintf "--%s" "another-optional-thing") - (LoadsOfTypesNoPositionals.DefaultAnotherOptionalThing () - |> (fun x -> x.ToString ()) - |> sprintf " (default value: %s)") - "") - (sprintf - "%s string%s%s" - (sprintf "--%s" "yet-another-optional-thing") - ("CONSUMEPLUGIN_THINGS" |> sprintf " (default value populated from env var %s)") - "") - ] - |> String.concat "\n" - - let parser_LeftoverArgs : string ResizeArray = ResizeArray () - let mutable arg_0 : int option = None - let mutable arg_1 : string option = None - let mutable arg_2 : bool option = None - let mutable arg_3 : FileInfo option = None - let mutable arg_4 : DirectoryInfo option = None - let arg_5 : DirectoryInfo ResizeArray = ResizeArray () - let mutable arg_6 : int option = None - let mutable arg_7 : bool option = None - let mutable arg_8 : int option = None - let mutable arg_9 : string option = None + let arg7 : Choice = + match this.OptionalThing with + | Some result -> Choice1Of2 result + | None -> Choice2Of2 (LoadsOfTypesNoPositionals.DefaultOptionalThing ()) + + let arg8 : Choice = + match this.AnotherOptionalThing with + | Some result -> Choice1Of2 result + | None -> Choice2Of2 (LoadsOfTypesNoPositionals.DefaultAnotherOptionalThing ()) + + let arg9 : Choice = + match this.YetAnotherOptionalThing with + | Some result -> Choice1Of2 result + | None -> Choice2Of2 ("CONSUMEPLUGIN_THINGS" |> getEnvironmentVariable |> (fun x -> x)) + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + Foo = arg0 + Bar = arg1 + Baz = arg2 + SomeFile = arg3 + SomeDirectory = arg4 + SomeList = arg5 + OptionalThingWithNoDefault = arg6 + OptionalThing = arg7 + AnotherOptionalThing = arg8 + YetAnotherOptionalThing = arg9 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : LoadsOfTypesNoPositionals_InProgress = + { + AnotherOptionalThing = None + Bar = None + Baz = None + Foo = None + OptionalThing = None + OptionalThingWithNoDefault = None + SomeDirectory = None + SomeFile = None + SomeList = ResizeArray () + YetAnotherOptionalThing = 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 = + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = if System.String.Equals ( key, @@ -1143,61 +1161,66 @@ module LoadsOfTypesNoPositionals = System.StringComparison.OrdinalIgnoreCase ) then - match arg_9 with + match this.YetAnotherOptionalThing with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" (sprintf "--%s" "yet-another-optional-thing") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_9 <- value |> (fun x -> x) |> Some + this.YetAnotherOptionalThing <- value |> (fun x -> x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error else if - System.String.Equals ( - key, - sprintf "--%s" "another-optional-thing", - System.StringComparison.OrdinalIgnoreCase - ) + System.String.Equals (key, sprintf "--%s" "some-list", System.StringComparison.OrdinalIgnoreCase) + then + value + |> (fun x -> System.IO.DirectoryInfo x) + |> (fun x -> x) + |> this.SomeList.Add + + () |> Ok + else if + System.String.Equals (key, sprintf "--%s" "some-file", System.StringComparison.OrdinalIgnoreCase) then - match arg_8 with + match this.SomeFile with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "another-optional-thing") + (sprintf "--%s" "some-file") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_8 <- value |> (fun x -> System.Int32.Parse x) |> Some + this.SomeFile <- value |> (fun x -> System.IO.FileInfo x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error else if - System.String.Equals (key, sprintf "--%s" "optional-thing", System.StringComparison.OrdinalIgnoreCase) + System.String.Equals (key, sprintf "--%s" "some-directory", System.StringComparison.OrdinalIgnoreCase) then - match arg_7 with + match this.SomeDirectory with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "optional-thing") + (sprintf "--%s" "some-directory") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_7 <- value |> (fun x -> System.Boolean.Parse x) |> Some + this.SomeDirectory <- value |> (fun x -> System.IO.DirectoryInfo x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error @@ -1208,306 +1231,3256 @@ module LoadsOfTypesNoPositionals = System.StringComparison.OrdinalIgnoreCase ) then - match arg_6 with + match this.OptionalThingWithNoDefault with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" (sprintf "--%s" "optional-thing-with-no-default") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_6 <- value |> (fun x -> System.Int32.Parse x) |> Some + this.OptionalThingWithNoDefault <- value |> (fun x -> System.Int32.Parse x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error else if - System.String.Equals (key, sprintf "--%s" "some-list", System.StringComparison.OrdinalIgnoreCase) - then - value |> (fun x -> System.IO.DirectoryInfo x) |> arg_5.Add - () |> Ok - else if - System.String.Equals (key, sprintf "--%s" "some-directory", System.StringComparison.OrdinalIgnoreCase) + System.String.Equals (key, sprintf "--%s" "optional-thing", System.StringComparison.OrdinalIgnoreCase) then - match arg_4 with + match this.OptionalThing with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "some-directory") + (sprintf "--%s" "optional-thing") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add Ok () | None -> try - arg_4 <- value |> (fun x -> System.IO.DirectoryInfo x) |> Some + this.OptionalThing <- value |> (fun x -> System.Boolean.Parse x) |> Some Ok () with _ as exc -> exc.Message |> Some |> Error - else if - System.String.Equals (key, sprintf "--%s" "some-file", System.StringComparison.OrdinalIgnoreCase) - then - match arg_3 with + else if System.String.Equals (key, sprintf "--%s" "foo", System.StringComparison.OrdinalIgnoreCase) then + match this.Foo with | Some x -> sprintf "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "some-file") + (sprintf "--%s" "foo") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Foo <- value |> (fun x -> System.Int32.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then + match this.Baz with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "baz") (x.ToString ()) (value.ToString ()) - |> ArgParser_errors.Add + |> errors_.Add + + Ok () + | None -> + try + this.Baz <- value |> (fun x -> System.Boolean.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if System.String.Equals (key, sprintf "--%s" "bar", System.StringComparison.OrdinalIgnoreCase) then + match this.Bar with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "bar") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Bar <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if + System.String.Equals ( + key, + sprintf "--%s" "another-optional-thing", + System.StringComparison.OrdinalIgnoreCase + ) + then + match this.AnotherOptionalThing with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "another-optional-thing") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.AnotherOptionalThing <- value |> (fun x -> System.Int32.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = + if + System.String.Equals (key, sprintf "--%s" "optional-thing", System.StringComparison.OrdinalIgnoreCase) + then + match this.OptionalThing with + | Some _ -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "optional-thing") + |> errors_.Add + + true + | None -> + this.OptionalThing <- true |> Some + true + else if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then + match this.Baz with + | Some _ -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "baz") + |> errors_.Add + + true + | None -> + this.Baz <- true |> Some + true + else + false + + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed DatesAndTimes. + type internal DatesAndTimes_InProgress = + { + mutable Exact : TimeSpan option + mutable Invariant : TimeSpan option + mutable InvariantExact : TimeSpan option + mutable Plain : TimeSpan option + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : TimeSpan = + match this.Plain with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "plain") + Unchecked.defaultof<_> + + let arg1 : TimeSpan = + match this.Invariant with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "invariant") + Unchecked.defaultof<_> + + let arg2 : TimeSpan = + match this.Exact with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "exact") + Unchecked.defaultof<_> + + let arg3 : TimeSpan = + match this.InvariantExact with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "invariant-exact") + + Unchecked.defaultof<_ > + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + Plain = arg0 + Invariant = arg1 + Exact = arg2 + InvariantExact = arg3 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : DatesAndTimes_InProgress = + { + Exact = None + Invariant = None + InvariantExact = None + Plain = 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. + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "plain", System.StringComparison.OrdinalIgnoreCase) then + match this.Plain with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "plain") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Plain <- value |> (fun x -> System.TimeSpan.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if + System.String.Equals (key, sprintf "--%s" "invariant-exact", System.StringComparison.OrdinalIgnoreCase) + then + match this.InvariantExact with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "invariant-exact") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.InvariantExact <- + value + |> (fun x -> + System.TimeSpan.ParseExact ( + x, + @"hh\:mm\:ss", + System.Globalization.CultureInfo.InvariantCulture + ) + ) + |> Some + + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if + System.String.Equals (key, sprintf "--%s" "invariant", System.StringComparison.OrdinalIgnoreCase) + then + match this.Invariant with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "invariant") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Invariant <- + value + |> (fun x -> System.TimeSpan.Parse (x, System.Globalization.CultureInfo.InvariantCulture)) + |> Some + + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if System.String.Equals (key, sprintf "--%s" "exact", System.StringComparison.OrdinalIgnoreCase) then + match this.Exact with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "exact") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Exact <- + value + |> (fun x -> + System.TimeSpan.ParseExact ( + x, + @"hh\:mm\:ss", + System.Globalization.CultureInfo.CurrentCulture + ) + ) + |> Some + + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed ChildRecord. + type internal ChildRecord_InProgress = + { + mutable Thing1 : int option + mutable Thing2 : string option + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : int = + match this.Thing1 with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "thing1") + Unchecked.defaultof<_> + + let arg1 : string = + match this.Thing2 with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "thing2") + Unchecked.defaultof<_> + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + Thing1 = arg0 + Thing2 = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : ChildRecord_InProgress = + { + Thing1 = None + Thing2 = 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. + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "thing2", System.StringComparison.OrdinalIgnoreCase) then + match this.Thing2 with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "thing2") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Thing2 <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if System.String.Equals (key, sprintf "--%s" "thing1", System.StringComparison.OrdinalIgnoreCase) then + match this.Thing1 with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "thing1") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Thing1 <- value |> (fun x -> System.Int32.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed ParentRecord. + type internal ParentRecord_InProgress = + { + mutable AndAnother : bool option + mutable Child : ChildRecord_InProgress + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : ChildRecord = + match this.Child.Assemble_ getEnvironmentVariable positionals with + | Ok (result, consumedPositional) -> + match consumedPositional with + | None -> () + | Some positionalConsumer -> positionalConsumers.Add positionalConsumer + + result + | Error err -> + errors.AddRange err + Unchecked.defaultof<_> + + let arg1 : bool = + match this.AndAnother with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "and-another") + Unchecked.defaultof<_> + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + Child = arg0 + AndAnother = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : ParentRecord_InProgress = + { + AndAnother = None + Child = ChildRecord_InProgress._Empty () + } + + /// 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. + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "and-another", System.StringComparison.OrdinalIgnoreCase) then + match this.AndAnother with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "and-another") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.AndAnother <- value |> (fun x -> System.Boolean.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + + /// Passes the key-value pair to any child records, 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. + member this.ProcessKeyValueRecord_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + let errors : ResizeArray = ResizeArray () + + match this.Child.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> Ok () + | Error e -> Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> + match this.ProcessKeyValueRecord_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error errorFromRecord -> Error errorFromRecord + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = + if System.String.Equals (key, sprintf "--%s" "and-another", System.StringComparison.OrdinalIgnoreCase) then + match this.AndAnother with + | Some _ -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "and-another") + |> errors_.Add + + true + | None -> + this.AndAnother <- true |> Some + true + else + false + + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed ChildRecordWithPositional. + type internal ChildRecordWithPositional_InProgress = + { + mutable Thing1 : int option + mutable Thing2 : ResizeArray + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : int = + match this.Thing1 with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "thing1") + Unchecked.defaultof<_> + + let arg1 : Uri list = + positionalConsumers.Add (sprintf "--%s" "thing2") + + positionals + |> Seq.map (fun x -> + match x with + | Choice1Of2 x -> + if not (false) && (fst x).StartsWith ("--", System.StringComparison.Ordinal) then + outOfPlacePositionals.Add (fst x) + x + else + x + | Choice2Of2 x -> x + ) + |> Seq.map (fun (str, argNum_) -> str |> (fun x -> System.Uri x), argNum_) + |> (fun x -> Seq.append this.Thing2 x) + |> Seq.sortBy snd + |> Seq.map fst + |> Seq.toList + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + Thing1 = arg0 + Thing2 = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : ChildRecordWithPositional_InProgress = + { + Thing1 = None + Thing2 = ResizeArray () + } + + /// 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. + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "thing2", System.StringComparison.OrdinalIgnoreCase) then + value |> (fun x -> System.Uri x) |> (fun x -> x, argNum_) |> this.Thing2.Add + () |> Ok + else if System.String.Equals (key, sprintf "--%s" "thing1", System.StringComparison.OrdinalIgnoreCase) then + match this.Thing1 with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "thing1") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Thing1 <- value |> (fun x -> System.Int32.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed ParentRecordChildPos. + type internal ParentRecordChildPos_InProgress = + { + mutable AndAnother : bool option + mutable Child : ChildRecordWithPositional_InProgress + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : ChildRecordWithPositional = + match this.Child.Assemble_ getEnvironmentVariable positionals with + | Ok (result, consumedPositional) -> + match consumedPositional with + | None -> () + | Some positionalConsumer -> positionalConsumers.Add positionalConsumer + + result + | Error err -> + errors.AddRange err + Unchecked.defaultof<_> + + let arg1 : bool = + match this.AndAnother with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "and-another") + Unchecked.defaultof<_> + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + Child = arg0 + AndAnother = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : ParentRecordChildPos_InProgress = + { + AndAnother = None + Child = ChildRecordWithPositional_InProgress._Empty () + } + + /// 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. + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "and-another", System.StringComparison.OrdinalIgnoreCase) then + match this.AndAnother with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "and-another") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.AndAnother <- value |> (fun x -> System.Boolean.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + + /// Passes the key-value pair to any child records, 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. + member this.ProcessKeyValueRecord_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + let errors : ResizeArray = ResizeArray () + + match this.Child.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> Ok () + | Error e -> Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> + match this.ProcessKeyValueRecord_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error errorFromRecord -> Error errorFromRecord + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = + if System.String.Equals (key, sprintf "--%s" "and-another", System.StringComparison.OrdinalIgnoreCase) then + match this.AndAnother with + | Some _ -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "and-another") + |> errors_.Add + + true + | None -> + this.AndAnother <- true |> Some + true + else + false + + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed ParentRecordSelfPos. + type internal ParentRecordSelfPos_InProgress = + { + mutable AndAnother : ResizeArray + mutable Child : ChildRecord_InProgress + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : ChildRecord = + match this.Child.Assemble_ getEnvironmentVariable positionals with + | Ok (result, consumedPositional) -> + match consumedPositional with + | None -> () + | Some positionalConsumer -> positionalConsumers.Add positionalConsumer + + result + | Error err -> + errors.AddRange err + Unchecked.defaultof<_> + + let arg1 : bool list = + positionalConsumers.Add (sprintf "--%s" "and-another") + + positionals + |> Seq.map (fun x -> + match x with + | Choice1Of2 x -> + if not (false) && (fst x).StartsWith ("--", System.StringComparison.Ordinal) then + outOfPlacePositionals.Add (fst x) + x + else + x + | Choice2Of2 x -> x + ) + |> Seq.map (fun (str, argNum_) -> str |> (fun x -> System.Boolean.Parse x), argNum_) + |> (fun x -> Seq.append this.AndAnother x) + |> Seq.sortBy snd + |> Seq.map fst + |> Seq.toList + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + Child = arg0 + AndAnother = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : ParentRecordSelfPos_InProgress = + { + AndAnother = ResizeArray () + Child = ChildRecord_InProgress._Empty () + } + + /// 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. + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "and-another", System.StringComparison.OrdinalIgnoreCase) then + value + |> (fun x -> System.Boolean.Parse x) + |> (fun x -> x, argNum_) + |> this.AndAnother.Add + + () |> Ok + else + Error None + + /// Passes the key-value pair to any child records, 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. + member this.ProcessKeyValueRecord_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + let errors : ResizeArray = ResizeArray () + + match this.Child.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> Ok () + | Error e -> Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> + match this.ProcessKeyValueRecord_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error errorFromRecord -> Error errorFromRecord + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed ChoicePositionals. + type internal ChoicePositionals_InProgress = + { + mutable Args : ResizeArray + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : Choice list = + positionalConsumers.Add (sprintf "--%s" "args") + + positionals + |> List.map (fun x -> + match x with + | Choice1Of2 (x, argPos) -> (fun x -> x) x |> Choice1Of2 + | Choice2Of2 (x, argPos) -> (fun x -> x) x |> Choice2Of2 + ) + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + Args = arg0 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : ChoicePositionals_InProgress = + { + Args = ResizeArray () + } + + /// 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. + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "args", System.StringComparison.OrdinalIgnoreCase) then + value |> (fun x -> x) |> (fun x -> x, argNum_) |> this.Args.Add + () |> Ok + else + Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed ContainsBoolEnvVar. + type internal ContainsBoolEnvVar_InProgress = + { + mutable BoolVar : bool option + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : Choice = + match this.BoolVar with + | Some result -> Choice1Of2 result + | None -> + Choice2Of2 ( + "CONSUMEPLUGIN_THINGS" + |> getEnvironmentVariable + |> (fun x -> + if System.String.Equals (x, "1", System.StringComparison.OrdinalIgnoreCase) then + true + else if System.String.Equals (x, "0", System.StringComparison.OrdinalIgnoreCase) then + false + else + x |> (fun x -> System.Boolean.Parse x) + ) + ) + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + BoolVar = arg0 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : ContainsBoolEnvVar_InProgress = + { + BoolVar = 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. + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "bool-var", System.StringComparison.OrdinalIgnoreCase) then + match this.BoolVar with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "bool-var") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.BoolVar <- value |> (fun x -> System.Boolean.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = + if System.String.Equals (key, sprintf "--%s" "bool-var", System.StringComparison.OrdinalIgnoreCase) then + match this.BoolVar with + | Some _ -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "bool-var") + |> errors_.Add + + true + | None -> + this.BoolVar <- true |> Some + true + else + false + + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed WithFlagDu. + type internal WithFlagDu_InProgress = + { + mutable DryRun : DryRunMode option + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : DryRunMode = + match this.DryRun with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "dry-run") + Unchecked.defaultof<_> + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + DryRun = arg0 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : WithFlagDu_InProgress = + { + DryRun = 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. + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "dry-run", System.StringComparison.OrdinalIgnoreCase) then + match this.DryRun with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "dry-run") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.DryRun <- + value + |> (fun x -> + if System.Boolean.Parse x = Consts.FALSE then + DryRunMode.Wet + else + DryRunMode.Dry + ) + |> Some + + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = + if System.String.Equals (key, sprintf "--%s" "dry-run", System.StringComparison.OrdinalIgnoreCase) then + match this.DryRun with + | Some _ -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "dry-run") + |> errors_.Add + + true + | None -> + this.DryRun <- + if true = Consts.FALSE then + DryRunMode.Wet + else + DryRunMode.Dry + |> Some + + true + else + false + + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed ContainsFlagEnvVar. + type internal ContainsFlagEnvVar_InProgress = + { + mutable DryRun : DryRunMode option + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : Choice = + match this.DryRun with + | Some result -> Choice1Of2 result + | None -> + Choice2Of2 ( + "CONSUMEPLUGIN_THINGS" + |> getEnvironmentVariable + |> (fun x -> + if System.String.Equals (x, "1", System.StringComparison.OrdinalIgnoreCase) then + if true = Consts.FALSE then + DryRunMode.Wet + else + DryRunMode.Dry + else if System.String.Equals (x, "0", System.StringComparison.OrdinalIgnoreCase) then + if false = Consts.FALSE then + DryRunMode.Wet + else + DryRunMode.Dry + else + x + |> (fun x -> + if System.Boolean.Parse x = Consts.FALSE then + DryRunMode.Wet + else + DryRunMode.Dry + ) + ) + ) + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + DryRun = arg0 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : ContainsFlagEnvVar_InProgress = + { + DryRun = 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. + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "dry-run", System.StringComparison.OrdinalIgnoreCase) then + match this.DryRun with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "dry-run") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.DryRun <- + value + |> (fun x -> + if System.Boolean.Parse x = Consts.FALSE then + DryRunMode.Wet + else + DryRunMode.Dry + ) + |> Some + + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = + if System.String.Equals (key, sprintf "--%s" "dry-run", System.StringComparison.OrdinalIgnoreCase) then + match this.DryRun with + | Some _ -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "dry-run") + |> errors_.Add + + true + | None -> + this.DryRun <- + if true = Consts.FALSE then + DryRunMode.Wet + else + DryRunMode.Dry + |> Some + + true + else + false + + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed ContainsFlagDefaultValue. + type internal ContainsFlagDefaultValue_InProgress = + { + mutable DryRun : DryRunMode option + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : Choice = + match this.DryRun with + | Some result -> Choice1Of2 result + | None -> Choice2Of2 (ContainsFlagDefaultValue.DefaultDryRun ()) + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + DryRun = arg0 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : ContainsFlagDefaultValue_InProgress = + { + DryRun = 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. + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "dry-run", System.StringComparison.OrdinalIgnoreCase) then + match this.DryRun with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "dry-run") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.DryRun <- + value + |> (fun x -> + if System.Boolean.Parse x = Consts.FALSE then + DryRunMode.Wet + else + DryRunMode.Dry + ) + |> Some + + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = + if System.String.Equals (key, sprintf "--%s" "dry-run", System.StringComparison.OrdinalIgnoreCase) then + match this.DryRun with + | Some _ -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "dry-run") + |> errors_.Add + + true + | None -> + this.DryRun <- + if true = Consts.FALSE then + DryRunMode.Wet + else + DryRunMode.Dry + |> Some + + true + else + false + + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed ManyLongForms. + type internal ManyLongForms_InProgress = + { + mutable DoTheThing : string option + mutable SomeFlag : bool option + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : string = + match this.DoTheThing with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "do-something-else") + + Unchecked.defaultof<_ > + + let arg1 : bool = + match this.SomeFlag with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "turn-it-on") + Unchecked.defaultof<_> + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + DoTheThing = arg0 + SomeFlag = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : ManyLongForms_InProgress = + { + DoTheThing = None + SomeFlag = 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. + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if + System.String.Equals (key, sprintf "--%s" "dont-turn-it-off", System.StringComparison.OrdinalIgnoreCase) + then + match this.SomeFlag with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s / --%s" "turn-it-on" "dont-turn-it-off") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.SomeFlag <- value |> (fun x -> System.Boolean.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if + System.String.Equals (key, sprintf "--%s" "turn-it-on", System.StringComparison.OrdinalIgnoreCase) + then + match this.SomeFlag with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s / --%s" "turn-it-on" "dont-turn-it-off") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.SomeFlag <- value |> (fun x -> System.Boolean.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if + System.String.Equals (key, sprintf "--%s" "anotherarg", System.StringComparison.OrdinalIgnoreCase) + then + match this.DoTheThing with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s / --%s" "do-something-else" "anotherarg") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.DoTheThing <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if + System.String.Equals ( + key, + sprintf "--%s" "do-something-else", + System.StringComparison.OrdinalIgnoreCase + ) + then + match this.DoTheThing with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s / --%s" "do-something-else" "anotherarg") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.DoTheThing <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = + if + System.String.Equals (key, sprintf "--%s" "dont-turn-it-off", System.StringComparison.OrdinalIgnoreCase) + then + match this.SomeFlag with + | Some _ -> + sprintf + "Flag '%s' was supplied multiple times" + (sprintf "--%s / --%s" "turn-it-on" "dont-turn-it-off") + |> errors_.Add + + true + | None -> + this.SomeFlag <- true |> Some + true + else if + System.String.Equals (key, sprintf "--%s" "turn-it-on", System.StringComparison.OrdinalIgnoreCase) + then + match this.SomeFlag with + | Some _ -> + sprintf + "Flag '%s' was supplied multiple times" + (sprintf "--%s / --%s" "turn-it-on" "dont-turn-it-off") + |> errors_.Add + + true + | None -> + this.SomeFlag <- true |> Some + true + else + false + + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed FlagsIntoPositionalArgs. + type internal FlagsIntoPositionalArgs_InProgress = + { + mutable A : string option + mutable GrabEverything : ResizeArray + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : string = + match this.A with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "a") + Unchecked.defaultof<_> + + let arg1 : string list = + positionalConsumers.Add (sprintf "--%s" "grab-everything") + + positionals + |> Seq.map (fun x -> + match x with + | Choice1Of2 x -> + if not (true) && (fst x).StartsWith ("--", System.StringComparison.Ordinal) then + outOfPlacePositionals.Add (fst x) + x + else + x + | Choice2Of2 x -> x + ) + |> Seq.map (fun (str, argNum_) -> str |> (fun x -> x), argNum_) + |> (fun x -> Seq.append this.GrabEverything x) + |> Seq.sortBy snd + |> Seq.map fst + |> Seq.toList + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + A = arg0 + GrabEverything = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : FlagsIntoPositionalArgs_InProgress = + { + A = None + GrabEverything = ResizeArray () + } + + /// 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. + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if + System.String.Equals (key, sprintf "--%s" "grab-everything", System.StringComparison.OrdinalIgnoreCase) + then + value |> (fun x -> x) |> (fun x -> x, argNum_) |> this.GrabEverything.Add + () |> Ok + else if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then + match this.A with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "a") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.A <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed FlagsIntoPositionalArgsChoice. + type internal FlagsIntoPositionalArgsChoice_InProgress = + { + mutable A : string option + mutable GrabEverything : ResizeArray + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : string = + match this.A with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "a") + Unchecked.defaultof<_> + + let arg1 : Choice list = + positionalConsumers.Add (sprintf "--%s" "grab-everything") + + positionals + |> List.map (fun x -> + match x with + | Choice1Of2 (x, argPos) -> (fun x -> x) x |> Choice1Of2 + | Choice2Of2 (x, argPos) -> (fun x -> x) x |> Choice2Of2 + ) + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + A = arg0 + GrabEverything = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : FlagsIntoPositionalArgsChoice_InProgress = + { + A = None + GrabEverything = ResizeArray () + } + + /// 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. + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if + System.String.Equals (key, sprintf "--%s" "grab-everything", System.StringComparison.OrdinalIgnoreCase) + then + value |> (fun x -> x) |> (fun x -> x, argNum_) |> this.GrabEverything.Add + () |> Ok + else if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then + match this.A with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "a") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.A <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed FlagsIntoPositionalArgsInt. + type internal FlagsIntoPositionalArgsInt_InProgress = + { + mutable A : string option + mutable GrabEverything : ResizeArray + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : string = + match this.A with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "a") + Unchecked.defaultof<_> + + let arg1 : int list = + positionalConsumers.Add (sprintf "--%s" "grab-everything") + + positionals + |> Seq.map (fun x -> + match x with + | Choice1Of2 x -> + if not (true) && (fst x).StartsWith ("--", System.StringComparison.Ordinal) then + outOfPlacePositionals.Add (fst x) + x + else + x + | Choice2Of2 x -> x + ) + |> Seq.map (fun (str, argNum_) -> str |> (fun x -> System.Int32.Parse x), argNum_) + |> (fun x -> Seq.append this.GrabEverything x) + |> Seq.sortBy snd + |> Seq.map fst + |> Seq.toList + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + A = arg0 + GrabEverything = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : FlagsIntoPositionalArgsInt_InProgress = + { + A = None + GrabEverything = ResizeArray () + } + + /// 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. + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if + System.String.Equals (key, sprintf "--%s" "grab-everything", System.StringComparison.OrdinalIgnoreCase) + then + value + |> (fun x -> System.Int32.Parse x) + |> (fun x -> x, argNum_) + |> this.GrabEverything.Add + + () |> Ok + else if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then + match this.A with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "a") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.A <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed FlagsIntoPositionalArgsIntChoice. + type internal FlagsIntoPositionalArgsIntChoice_InProgress = + { + mutable A : string option + mutable GrabEverything : ResizeArray + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : string = + match this.A with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "a") + Unchecked.defaultof<_> + + let arg1 : Choice list = + positionalConsumers.Add (sprintf "--%s" "grab-everything") + + positionals + |> List.map (fun x -> + match x with + | Choice1Of2 (x, argPos) -> (fun x -> System.Int32.Parse x) x |> Choice1Of2 + | Choice2Of2 (x, argPos) -> (fun x -> System.Int32.Parse x) x |> Choice2Of2 + ) + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + A = arg0 + GrabEverything = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : FlagsIntoPositionalArgsIntChoice_InProgress = + { + A = None + GrabEverything = ResizeArray () + } + + /// 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. + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if + System.String.Equals (key, sprintf "--%s" "grab-everything", System.StringComparison.OrdinalIgnoreCase) + then + value + |> (fun x -> System.Int32.Parse x) + |> (fun x -> x, argNum_) + |> this.GrabEverything.Add + + () |> Ok + else if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then + match this.A with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "a") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.A <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed FlagsIntoPositionalArgs'. + type internal FlagsIntoPositionalArgs'_InProgress = + { + mutable A : string option + mutable DontGrabEverything : ResizeArray + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : string = + match this.A with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "a") + Unchecked.defaultof<_> + + let arg1 : string list = + positionalConsumers.Add (sprintf "--%s" "dont-grab-everything") + + positionals + |> Seq.map (fun x -> + match x with + | Choice1Of2 x -> + if not (false) && (fst x).StartsWith ("--", System.StringComparison.Ordinal) then + outOfPlacePositionals.Add (fst x) + x + else + x + | Choice2Of2 x -> x + ) + |> Seq.map (fun (str, argNum_) -> str |> (fun x -> x), argNum_) + |> (fun x -> Seq.append this.DontGrabEverything x) + |> Seq.sortBy snd + |> Seq.map fst + |> Seq.toList + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + A = arg0 + DontGrabEverything = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : FlagsIntoPositionalArgs'_InProgress = + { + A = None + DontGrabEverything = ResizeArray () + } + + /// 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. + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if + System.String.Equals ( + key, + sprintf "--%s" "dont-grab-everything", + System.StringComparison.OrdinalIgnoreCase + ) + then + value |> (fun x -> x) |> (fun x -> x, argNum_) |> this.DontGrabEverything.Add + () |> Ok + else if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then + match this.A with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "a") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.A <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed PassThru. + type internal PassThru_InProgress = + { + mutable A : ParentRecordChildPos_InProgress + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : ParentRecordChildPos = + match this.A.Assemble_ getEnvironmentVariable positionals with + | Ok (result, consumedPositional) -> + match consumedPositional with + | None -> () + | Some positionalConsumer -> positionalConsumers.Add positionalConsumer + + result + | Error err -> + errors.AddRange err + Unchecked.defaultof<_> + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + A = arg0 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : PassThru_InProgress = + { + A = ParentRecordChildPos_InProgress._Empty () + } + + /// Passes the key-value pair to any child records, 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. + member this.ProcessKeyValueRecord_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + let errors : ResizeArray = ResizeArray () + + match this.A.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> Ok () + | Error e -> Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueRecord_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error errorFromRecord -> Error errorFromRecord + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" +namespace ConsumePlugin + +open ArgParserHelpers +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type BasicNoPositionals +[] +module BasicNoPositionals = + type internal ParseState_BasicNoPositionals = + /// 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) (args : string list) : BasicNoPositionals = + let inProgress = + ArgParseHelpers_ConsumePlugin.BasicNoPositionals_InProgress._Empty () + + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (argNum_ : int) (state : ParseState_BasicNoPositionals) (args : string list) = + match args with + | [] -> + match state with + | ParseState_BasicNoPositionals.AwaitingKey -> () + | ParseState_BasicNoPositionals.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_BasicNoPositionals.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) + + if equals < 0 then + go (argNum_ + 1) (ParseState_BasicNoPositionals.AwaitingValue arg) args + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_BasicNoPositionals.AwaitingKey args + | Error x -> + match x with + | None -> + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_BasicNoPositionals.AwaitingKey args + | Some msg -> + sprintf "%s (at arg %s)" msg arg |> errors_.Add + go (argNum_ + 1) ParseState_BasicNoPositionals.AwaitingKey args + else + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_BasicNoPositionals.AwaitingKey args + | ParseState_BasicNoPositionals.AwaitingValue key -> + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_BasicNoPositionals.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go argNum_ ParseState_BasicNoPositionals.AwaitingKey (arg :: args) + else + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_BasicNoPositionals.AwaitingKey (arg :: args) + + go 0 ParseState_BasicNoPositionals.AwaitingKey args + + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith + else + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + let parse (args : string list) : BasicNoPositionals = + parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open ArgParserHelpers +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type Basic +[] +module Basic = + type internal ParseState_Basic = + /// 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) (args : string list) : Basic = + let inProgress = ArgParseHelpers_ConsumePlugin.Basic_InProgress._Empty () + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (argNum_ : int) (state : ParseState_Basic) (args : string list) = + match args with + | [] -> + match state with + | ParseState_Basic.AwaitingKey -> () + | ParseState_Basic.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_Basic.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) + + if equals < 0 then + go (argNum_ + 1) (ParseState_Basic.AwaitingValue arg) args + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_Basic.AwaitingKey args + | Error x -> + match x with + | None -> + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_Basic.AwaitingKey args + | Some msg -> + sprintf "%s (at arg %s)" msg arg |> errors_.Add + go (argNum_ + 1) ParseState_Basic.AwaitingKey args + else + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_Basic.AwaitingKey args + | ParseState_Basic.AwaitingValue key -> + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_Basic.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go argNum_ ParseState_Basic.AwaitingKey (arg :: args) + else + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_Basic.AwaitingKey (arg :: args) + + go 0 ParseState_Basic.AwaitingKey args + + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith + else + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + let parse (args : string list) : Basic = + parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open ArgParserHelpers +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type BasicWithIntPositionals +[] +module BasicWithIntPositionals = + type internal ParseState_BasicWithIntPositionals = + /// 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) (args : string list) : BasicWithIntPositionals = + let inProgress = + ArgParseHelpers_ConsumePlugin.BasicWithIntPositionals_InProgress._Empty () + + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (argNum_ : int) (state : ParseState_BasicWithIntPositionals) (args : string list) = + match args with + | [] -> + match state with + | ParseState_BasicWithIntPositionals.AwaitingKey -> () + | ParseState_BasicWithIntPositionals.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_BasicWithIntPositionals.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) + + if equals < 0 then + go (argNum_ + 1) (ParseState_BasicWithIntPositionals.AwaitingValue arg) args + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_BasicWithIntPositionals.AwaitingKey args + | Error x -> + match x with + | None -> + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_BasicWithIntPositionals.AwaitingKey args + | Some msg -> + sprintf "%s (at arg %s)" msg arg |> errors_.Add + go (argNum_ + 1) ParseState_BasicWithIntPositionals.AwaitingKey args + else + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_BasicWithIntPositionals.AwaitingKey args + | ParseState_BasicWithIntPositionals.AwaitingValue key -> + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_BasicWithIntPositionals.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go argNum_ ParseState_BasicWithIntPositionals.AwaitingKey (arg :: args) + else + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_BasicWithIntPositionals.AwaitingKey (arg :: args) + + go 0 ParseState_BasicWithIntPositionals.AwaitingKey args + + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith + else + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + let parse (args : string list) : BasicWithIntPositionals = + parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open ArgParserHelpers +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type LoadsOfTypes +[] +module LoadsOfTypes = + type internal ParseState_LoadsOfTypes = + /// 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) (args : string list) : LoadsOfTypes = + let inProgress = ArgParseHelpers_ConsumePlugin.LoadsOfTypes_InProgress._Empty () + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (argNum_ : int) (state : ParseState_LoadsOfTypes) (args : string list) = + match args with + | [] -> + match state with + | ParseState_LoadsOfTypes.AwaitingKey -> () + | ParseState_LoadsOfTypes.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_LoadsOfTypes.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) - Ok () - | None -> - try - arg_3 <- value |> (fun x -> System.IO.FileInfo x) |> Some - Ok () - with _ as exc -> - exc.Message |> Some |> Error - else if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then - match arg_2 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "baz") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add + if equals < 0 then + go (argNum_ + 1) (ParseState_LoadsOfTypes.AwaitingValue arg) args + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] - 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" "bar", System.StringComparison.OrdinalIgnoreCase) then - match arg_1 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "bar") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_LoadsOfTypes.AwaitingKey args + | Error x -> + match x with + | None -> + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_LoadsOfTypes.AwaitingKey args + | Some msg -> + sprintf "%s (at arg %s)" msg arg |> errors_.Add + go (argNum_ + 1) ParseState_LoadsOfTypes.AwaitingKey args + else + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_LoadsOfTypes.AwaitingKey args + | ParseState_LoadsOfTypes.AwaitingValue key -> + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_LoadsOfTypes.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go argNum_ ParseState_LoadsOfTypes.AwaitingKey (arg :: args) + else + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_LoadsOfTypes.AwaitingKey (arg :: args) - 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" "foo", System.StringComparison.OrdinalIgnoreCase) then - match arg_0 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "foo") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add + go 0 ParseState_LoadsOfTypes.AwaitingKey args - Ok () - | None -> - try - arg_0 <- value |> (fun x -> System.Int32.Parse x) |> Some - Ok () - with _ as exc -> - exc.Message |> Some |> Error + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else - Error None + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith - /// Returns false if we didn't set a value. - let setFlagValue (key : string) : bool = - if - System.String.Equals (key, sprintf "--%s" "optional-thing", System.StringComparison.OrdinalIgnoreCase) - then - match arg_7 with - | Some x -> - sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "optional-thing") - |> ArgParser_errors.Add + let parse (args : string list) : LoadsOfTypes = + parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin - true - | None -> - arg_7 <- true |> Some - true - else if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then - match arg_2 with - | Some x -> - sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "baz") - |> ArgParser_errors.Add +open ArgParserHelpers +open System +open System.IO +open WoofWare.Myriad.Plugins - true - | None -> - arg_2 <- true |> Some - true - else - false +/// Methods to parse arguments for the type LoadsOfTypesNoPositionals +[] +module LoadsOfTypesNoPositionals = + type internal ParseState_LoadsOfTypesNoPositionals = + /// 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) (args : string list) : LoadsOfTypesNoPositionals = + let inProgress = + ArgParseHelpers_ConsumePlugin.LoadsOfTypesNoPositionals_InProgress._Empty () - let rec go (state : ParseState_LoadsOfTypesNoPositionals) (args : string list) = + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (argNum_ : int) (state : ParseState_LoadsOfTypesNoPositionals) (args : string list) = match args with | [] -> match state with | ParseState_LoadsOfTypesNoPositionals.AwaitingKey -> () | ParseState_LoadsOfTypesNoPositionals.AwaitingValue key -> - if setFlagValue key then + if inProgress.SetFlagValue_ errors_ 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)) + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_LoadsOfTypesNoPositionals.AwaitingKey -> if arg.StartsWith ("--", System.StringComparison.Ordinal) then if arg = "--help" then - helpText () |> failwithf "Help text requested.\n%s" + "TODO" |> failwithf "Help text requested.\n%s" else let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_LoadsOfTypesNoPositionals.AwaitingValue arg) + go (argNum_ + 1) (ParseState_LoadsOfTypesNoPositionals.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match processKeyValue key value with - | Ok () -> go ParseState_LoadsOfTypesNoPositionals.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) 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 + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_LoadsOfTypesNoPositionals.AwaitingKey args | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_LoadsOfTypesNoPositionals.AwaitingKey args + sprintf "%s (at arg %s)" msg arg |> errors_.Add + go (argNum_ + 1) ParseState_LoadsOfTypesNoPositionals.AwaitingKey args else - arg |> (fun x -> x) |> parser_LeftoverArgs.Add - go ParseState_LoadsOfTypesNoPositionals.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_LoadsOfTypesNoPositionals.AwaitingKey args | ParseState_LoadsOfTypesNoPositionals.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_LoadsOfTypesNoPositionals.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_LoadsOfTypesNoPositionals.AwaitingKey args | Error exc -> - if setFlagValue key then - go ParseState_LoadsOfTypesNoPositionals.AwaitingKey (arg :: args) + if inProgress.SetFlagValue_ errors_ key then + go argNum_ ParseState_LoadsOfTypesNoPositionals.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_LoadsOfTypesNoPositionals.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" "foo") - |> 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" "bar") - |> 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" "baz") - |> ArgParser_errors.Add - - Unchecked.defaultof<_> - | Some x -> x - - let arg_3 = - match arg_3 with - | None -> - sprintf "Required argument '%s' received no value" (sprintf "--%s" "some-file") - |> ArgParser_errors.Add - - Unchecked.defaultof<_> - | Some x -> x - - let arg_4 = - match arg_4 with - | None -> - sprintf "Required argument '%s' received no value" (sprintf "--%s" "some-directory") - |> ArgParser_errors.Add - - Unchecked.defaultof<_> - | Some x -> x - - let arg_5 = arg_5 |> Seq.toList - let arg_6 = arg_6 - - let arg_7 = - match arg_7 with - | None -> LoadsOfTypesNoPositionals.DefaultOptionalThing () |> Choice2Of2 - | Some x -> Choice1Of2 x - - let arg_8 = - match arg_8 with - | None -> LoadsOfTypesNoPositionals.DefaultAnotherOptionalThing () |> Choice2Of2 - | Some x -> Choice1Of2 x - - let arg_9 = - match arg_9 with - | None -> - match "CONSUMEPLUGIN_THINGS" |> getEnvironmentVariable with - | null -> - sprintf - "No value was supplied for %s, nor was environment variable %s set" - (sprintf "--%s" "yet-another-optional-thing") - "CONSUMEPLUGIN_THINGS" - |> ArgParser_errors.Add + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_LoadsOfTypesNoPositionals.AwaitingKey (arg :: args) - Unchecked.defaultof<_> - | x -> x |> (fun x -> x) - |> Choice2Of2 - | Some x -> Choice1Of2 x + go 0 ParseState_LoadsOfTypesNoPositionals.AwaitingKey args - if 0 = ArgParser_errors.Count then - { - AnotherOptionalThing = arg_8 - Bar = arg_1 - Baz = arg_2 - Foo = arg_0 - OptionalThing = arg_7 - OptionalThingWithNoDefault = arg_6 - SomeDirectory = arg_4 - SomeFile = arg_3 - SomeList = arg_5 - YetAnotherOptionalThing = arg_9 - } + if 0 = errors_.Count then + () else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith + else + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith let parse (args : string list) : LoadsOfTypesNoPositionals = parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1515,7 +4488,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type DatesAndTimes [] module DatesAndTimesArgParse = - type private ParseState_DatesAndTimes = + type internal ParseState_DatesAndTimes = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -1525,271 +4498,98 @@ module DatesAndTimesArgParse = type DatesAndTimes with static member parse' (getEnvironmentVariable : string -> string) (args : string list) : DatesAndTimes = - let ArgParser_errors = ResizeArray () - - let helpText () = - [ - (sprintf "%s TimeSpan%s%s" (sprintf "--%s" "plain") "" "") - (sprintf "%s TimeSpan%s%s" (sprintf "--%s" "invariant") "" "") - - (sprintf - "%s TimeSpan%s%s" - (sprintf "--%s" "exact") - "" - (sprintf " : %s" (sprintf "%s [Parse format (.NET): %s]" "An exact time please" @"hh\:mm\:ss"))) - (sprintf - "%s TimeSpan%s%s" - (sprintf "--%s" "invariant-exact") - "" - (sprintf " : %s" (sprintf "[Parse format (.NET): %s]" @"hh\:mm\:ss"))) - ] - |> String.concat "\n" - - let parser_LeftoverArgs : string ResizeArray = ResizeArray () - let mutable arg_0 : TimeSpan option = None - let mutable arg_1 : TimeSpan option = None - let mutable arg_2 : TimeSpan option = None - let mutable arg_3 : TimeSpan 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" "invariant-exact", - System.StringComparison.OrdinalIgnoreCase - ) - then - match arg_3 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "invariant-exact") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add - - Ok () - | None -> - try - arg_3 <- - value - |> (fun x -> - System.TimeSpan.ParseExact ( - x, - @"hh\:mm\:ss", - System.Globalization.CultureInfo.InvariantCulture - ) - ) - |> Some - - Ok () - with _ as exc -> - exc.Message |> Some |> Error - else if - System.String.Equals (key, sprintf "--%s" "exact", System.StringComparison.OrdinalIgnoreCase) - then - match arg_2 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "exact") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add - - Ok () - | None -> - try - arg_2 <- - value - |> (fun x -> - System.TimeSpan.ParseExact ( - x, - @"hh\:mm\:ss", - System.Globalization.CultureInfo.CurrentCulture - ) - ) - |> Some - - Ok () - with _ as exc -> - exc.Message |> Some |> Error - else if - System.String.Equals (key, sprintf "--%s" "invariant", System.StringComparison.OrdinalIgnoreCase) - then - match arg_1 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "invariant") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add - - Ok () - | None -> - try - arg_1 <- - value - |> (fun x -> - System.TimeSpan.Parse (x, System.Globalization.CultureInfo.InvariantCulture) - ) - |> Some - - Ok () - with _ as exc -> - exc.Message |> Some |> Error - else if - System.String.Equals (key, sprintf "--%s" "plain", System.StringComparison.OrdinalIgnoreCase) - then - match arg_0 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "plain") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add + let inProgress = ArgParseHelpers_ConsumePlugin.DatesAndTimes_InProgress._Empty () + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () - Ok () - | None -> - try - arg_0 <- value |> (fun x -> System.TimeSpan.Parse 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 = false - - let rec go (state : ParseState_DatesAndTimes) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_DatesAndTimes) (args : string list) = match args with | [] -> match state with | ParseState_DatesAndTimes.AwaitingKey -> () | ParseState_DatesAndTimes.AwaitingValue key -> - if setFlagValue key then + if inProgress.SetFlagValue_ errors_ 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)) + |> errors_.Add + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_DatesAndTimes.AwaitingKey -> if arg.StartsWith ("--", System.StringComparison.Ordinal) then if arg = "--help" then - helpText () |> failwithf "Help text requested.\n%s" + "TODO" |> failwithf "Help text requested.\n%s" else let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_DatesAndTimes.AwaitingValue arg) + go (argNum_ + 1) (ParseState_DatesAndTimes.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match processKeyValue key value with - | Ok () -> go ParseState_DatesAndTimes.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) 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 + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_DatesAndTimes.AwaitingKey args | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_DatesAndTimes.AwaitingKey args + sprintf "%s (at arg %s)" msg arg |> errors_.Add + go (argNum_ + 1) ParseState_DatesAndTimes.AwaitingKey args else - arg |> (fun x -> x) |> parser_LeftoverArgs.Add - go ParseState_DatesAndTimes.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_DatesAndTimes.AwaitingKey args | ParseState_DatesAndTimes.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_DatesAndTimes.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_DatesAndTimes.AwaitingKey args | Error exc -> - if setFlagValue key then - go ParseState_DatesAndTimes.AwaitingKey (arg :: args) + if inProgress.SetFlagValue_ errors_ key then + go argNum_ ParseState_DatesAndTimes.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_DatesAndTimes.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" "plain") - |> 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" "invariant") - |> 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" "exact") - |> ArgParser_errors.Add - - Unchecked.defaultof<_> - | Some x -> x + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_DatesAndTimes.AwaitingKey (arg :: args) - let arg_3 = - match arg_3 with - | None -> - sprintf "Required argument '%s' received no value" (sprintf "--%s" "invariant-exact") - |> ArgParser_errors.Add + go 0 ParseState_DatesAndTimes.AwaitingKey args - Unchecked.defaultof<_> - | Some x -> x - - if 0 = ArgParser_errors.Count then - { - Exact = arg_2 - Invariant = arg_1 - InvariantExact = arg_3 - Plain = arg_0 - } + if 0 = errors_.Count then + () else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith + else + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : DatesAndTimes = DatesAndTimes.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1797,7 +4597,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type ParentRecord [] module ParentRecordArgParse = - type private ParseState_ParentRecord = + type internal ParseState_ParentRecord = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -1807,218 +4607,98 @@ module ParentRecordArgParse = type ParentRecord with static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ParentRecord = - let ArgParser_errors = ResizeArray () - - let helpText () = - [ - (sprintf "%s int32%s%s" (sprintf "--%s" "thing1") "" "") - (sprintf "%s string%s%s" (sprintf "--%s" "thing2") "" "") - (sprintf "%s bool%s%s" (sprintf "--%s" "and-another") "" "") - ] - |> String.concat "\n" - - let parser_LeftoverArgs : string ResizeArray = ResizeArray () - let mutable arg_0 : int 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(). - /// 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" "and-another", System.StringComparison.OrdinalIgnoreCase) - then - match arg_2 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "and-another") - (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" "thing2", System.StringComparison.OrdinalIgnoreCase) - then - match arg_1 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "thing2") - (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" "thing1", System.StringComparison.OrdinalIgnoreCase) - then - match arg_0 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "thing1") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add - - Ok () - | None -> - try - arg_0 <- value |> (fun x -> System.Int32.Parse 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" "and-another", System.StringComparison.OrdinalIgnoreCase) - then - match arg_2 with - | Some x -> - sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "and-another") - |> ArgParser_errors.Add - - true - | None -> - arg_2 <- true |> Some - true - else - false + let inProgress = ArgParseHelpers_ConsumePlugin.ParentRecord_InProgress._Empty () + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () - let rec go (state : ParseState_ParentRecord) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_ParentRecord) (args : string list) = match args with | [] -> match state with | ParseState_ParentRecord.AwaitingKey -> () | ParseState_ParentRecord.AwaitingValue key -> - if setFlagValue key then + if inProgress.SetFlagValue_ errors_ 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)) + |> errors_.Add + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_ParentRecord.AwaitingKey -> if arg.StartsWith ("--", System.StringComparison.Ordinal) then if arg = "--help" then - helpText () |> failwithf "Help text requested.\n%s" + "TODO" |> failwithf "Help text requested.\n%s" else let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_ParentRecord.AwaitingValue arg) + go (argNum_ + 1) (ParseState_ParentRecord.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match processKeyValue key value with - | Ok () -> go ParseState_ParentRecord.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) 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 + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_ParentRecord.AwaitingKey args | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ParentRecord.AwaitingKey args + sprintf "%s (at arg %s)" msg arg |> errors_.Add + go (argNum_ + 1) ParseState_ParentRecord.AwaitingKey args else - arg |> (fun x -> x) |> parser_LeftoverArgs.Add - go ParseState_ParentRecord.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ParentRecord.AwaitingKey args | ParseState_ParentRecord.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_ParentRecord.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_ParentRecord.AwaitingKey args | Error exc -> - if setFlagValue key then - go ParseState_ParentRecord.AwaitingKey (arg :: args) + if inProgress.SetFlagValue_ errors_ key then + go argNum_ ParseState_ParentRecord.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_ParentRecord.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" "thing1") - |> 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" "thing2") - |> 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" "and-another") - |> ArgParser_errors.Add + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ParentRecord.AwaitingKey (arg :: args) - Unchecked.defaultof<_> - | Some x -> x + go 0 ParseState_ParentRecord.AwaitingKey args - if 0 = ArgParser_errors.Count then - { - AndAnother = arg_2 - Child = - { - Thing1 = arg_0 - Thing2 = arg_1 - } - } + if 0 = errors_.Count then + () else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith + else + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : ParentRecord = ParentRecord.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -2026,7 +4706,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type ParentRecordChildPos [] module ParentRecordChildPosArgParse = - type private ParseState_ParentRecordChildPos = + type internal ParseState_ParentRecordChildPos = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -2036,182 +4716,100 @@ module ParentRecordChildPosArgParse = type ParentRecordChildPos with static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ParentRecordChildPos = - let ArgParser_errors = ResizeArray () - - let helpText () = - [ - (sprintf "%s bool%s%s" (sprintf "--%s" "and-another") "" "") - (sprintf "%s int32%s%s" (sprintf "--%s" "thing1") "" "") - (sprintf "%s URI%s%s" (sprintf "--%s" "thing2") " (positional args) (can be repeated)" "") - ] - |> String.concat "\n" - - let arg_1 : Uri ResizeArray = ResizeArray () - let mutable arg_2 : bool option = None - let mutable arg_0 : 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(). - /// 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" "thing1", System.StringComparison.OrdinalIgnoreCase) then - match arg_0 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "thing1") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add + let inProgress = + ArgParseHelpers_ConsumePlugin.ParentRecordChildPos_InProgress._Empty () - Ok () - | None -> - try - arg_0 <- value |> (fun x -> System.Int32.Parse x) |> Some - Ok () - with _ as exc -> - exc.Message |> Some |> Error - else if - System.String.Equals (key, sprintf "--%s" "and-another", System.StringComparison.OrdinalIgnoreCase) - then - match arg_2 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "and-another") - (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" "thing2", System.StringComparison.OrdinalIgnoreCase) - then - value |> (fun x -> System.Uri x) |> arg_1.Add - () |> Ok - else - Error None - - /// Returns false if we didn't set a value. - let setFlagValue (key : string) : bool = - if - System.String.Equals (key, sprintf "--%s" "and-another", System.StringComparison.OrdinalIgnoreCase) - then - match arg_2 with - | Some x -> - sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "and-another") - |> ArgParser_errors.Add - - true - | None -> - arg_2 <- true |> Some - true - else - false + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () - let rec go (state : ParseState_ParentRecordChildPos) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_ParentRecordChildPos) (args : string list) = match args with | [] -> match state with | ParseState_ParentRecordChildPos.AwaitingKey -> () | ParseState_ParentRecordChildPos.AwaitingValue key -> - if setFlagValue key then + if inProgress.SetFlagValue_ errors_ 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 -> System.Uri x)) + |> errors_.Add + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_ParentRecordChildPos.AwaitingKey -> if arg.StartsWith ("--", System.StringComparison.Ordinal) then if arg = "--help" then - helpText () |> failwithf "Help text requested.\n%s" + "TODO" |> failwithf "Help text requested.\n%s" else let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_ParentRecordChildPos.AwaitingValue arg) + go (argNum_ + 1) (ParseState_ParentRecordChildPos.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match processKeyValue key value with - | Ok () -> go ParseState_ParentRecordChildPos.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) 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 + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_ParentRecordChildPos.AwaitingKey args | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ParentRecordChildPos.AwaitingKey args + sprintf "%s (at arg %s)" msg arg |> errors_.Add + go (argNum_ + 1) ParseState_ParentRecordChildPos.AwaitingKey args else - arg |> (fun x -> System.Uri x) |> arg_1.Add - go ParseState_ParentRecordChildPos.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ParentRecordChildPos.AwaitingKey args | ParseState_ParentRecordChildPos.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_ParentRecordChildPos.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_ParentRecordChildPos.AwaitingKey args | Error exc -> - if setFlagValue key then - go ParseState_ParentRecordChildPos.AwaitingKey (arg :: args) + if inProgress.SetFlagValue_ errors_ key then + go argNum_ ParseState_ParentRecordChildPos.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_ParentRecordChildPos.AwaitingKey args - let arg_1 = arg_1 |> Seq.toList - - let arg_2 = - match arg_2 with - | None -> - sprintf "Required argument '%s' received no value" (sprintf "--%s" "and-another") - |> ArgParser_errors.Add - - Unchecked.defaultof<_> - | Some x -> x - - let arg_0 = - match arg_0 with - | None -> - sprintf "Required argument '%s' received no value" (sprintf "--%s" "thing1") - |> ArgParser_errors.Add + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ParentRecordChildPos.AwaitingKey (arg :: args) - Unchecked.defaultof<_> - | Some x -> x + go 0 ParseState_ParentRecordChildPos.AwaitingKey args - if 0 = ArgParser_errors.Count then - { - AndAnother = arg_2 - Child = - { - Thing1 = arg_0 - Thing2 = arg_1 - } - } + if 0 = errors_.Count then + () else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith + else + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : ParentRecordChildPos = ParentRecordChildPos.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -2219,7 +4817,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type ParentRecordSelfPos [] module ParentRecordSelfPosArgParse = - type private ParseState_ParentRecordSelfPos = + type internal ParseState_ParentRecordSelfPos = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -2229,168 +4827,100 @@ module ParentRecordSelfPosArgParse = type ParentRecordSelfPos with static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ParentRecordSelfPos = - let ArgParser_errors = ResizeArray () - - let helpText () = - [ - (sprintf "%s int32%s%s" (sprintf "--%s" "thing1") "" "") - (sprintf "%s string%s%s" (sprintf "--%s" "thing2") "" "") - (sprintf "%s bool%s%s" (sprintf "--%s" "and-another") " (positional args) (can be repeated)" "") - ] - |> String.concat "\n" - - let arg_2 : bool ResizeArray = ResizeArray () - let mutable arg_0 : int option = None - let mutable arg_1 : 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" "thing2", System.StringComparison.OrdinalIgnoreCase) then - match arg_1 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "thing2") - (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" "thing1", System.StringComparison.OrdinalIgnoreCase) - then - match arg_0 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "thing1") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add - - Ok () - | None -> - try - arg_0 <- value |> (fun x -> System.Int32.Parse x) |> Some - Ok () - with _ as exc -> - exc.Message |> Some |> Error - else if - System.String.Equals (key, sprintf "--%s" "and-another", System.StringComparison.OrdinalIgnoreCase) - then - value |> (fun x -> System.Boolean.Parse x) |> arg_2.Add - () |> Ok - else - Error None + let inProgress = + ArgParseHelpers_ConsumePlugin.ParentRecordSelfPos_InProgress._Empty () - /// Returns false if we didn't set a value. - let setFlagValue (key : string) : bool = false + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () - let rec go (state : ParseState_ParentRecordSelfPos) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_ParentRecordSelfPos) (args : string list) = match args with | [] -> match state with | ParseState_ParentRecordSelfPos.AwaitingKey -> () | ParseState_ParentRecordSelfPos.AwaitingValue key -> - if setFlagValue key then + if inProgress.SetFlagValue_ errors_ 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_2.AddRange (rest |> Seq.map (fun x -> System.Boolean.Parse x)) + |> errors_.Add + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_ParentRecordSelfPos.AwaitingKey -> if arg.StartsWith ("--", System.StringComparison.Ordinal) then if arg = "--help" then - helpText () |> failwithf "Help text requested.\n%s" + "TODO" |> failwithf "Help text requested.\n%s" else let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_ParentRecordSelfPos.AwaitingValue arg) + go (argNum_ + 1) (ParseState_ParentRecordSelfPos.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match processKeyValue key value with - | Ok () -> go ParseState_ParentRecordSelfPos.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) 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 + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_ParentRecordSelfPos.AwaitingKey args | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ParentRecordSelfPos.AwaitingKey args + sprintf "%s (at arg %s)" msg arg |> errors_.Add + go (argNum_ + 1) ParseState_ParentRecordSelfPos.AwaitingKey args else - arg |> (fun x -> System.Boolean.Parse x) |> arg_2.Add - go ParseState_ParentRecordSelfPos.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ParentRecordSelfPos.AwaitingKey args | ParseState_ParentRecordSelfPos.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_ParentRecordSelfPos.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_ParentRecordSelfPos.AwaitingKey args | Error exc -> - if setFlagValue key then - go ParseState_ParentRecordSelfPos.AwaitingKey (arg :: args) + if inProgress.SetFlagValue_ errors_ key then + go argNum_ ParseState_ParentRecordSelfPos.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_ParentRecordSelfPos.AwaitingKey args - let arg_2 = arg_2 |> Seq.toList - - let arg_0 = - match arg_0 with - | None -> - sprintf "Required argument '%s' received no value" (sprintf "--%s" "thing1") - |> 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" "thing2") - |> ArgParser_errors.Add + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ParentRecordSelfPos.AwaitingKey (arg :: args) - Unchecked.defaultof<_> - | Some x -> x + go 0 ParseState_ParentRecordSelfPos.AwaitingKey args - if 0 = ArgParser_errors.Count then - { - AndAnother = arg_2 - Child = - { - Thing1 = arg_0 - Thing2 = arg_1 - } - } + if 0 = errors_.Count then + () else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith + else + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : ParentRecordSelfPos = ParentRecordSelfPos.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -2398,7 +4928,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type ChoicePositionals [] module ChoicePositionalsArgParse = - type private ParseState_ChoicePositionals = + type internal ParseState_ChoicePositionals = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -2408,103 +4938,100 @@ module ChoicePositionalsArgParse = type ChoicePositionals with static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ChoicePositionals = - let ArgParser_errors = ResizeArray () - - let helpText () = - [ - (sprintf "%s string%s%s" (sprintf "--%s" "args") " (positional args) (can be repeated)" "") - ] - |> String.concat "\n" - - let arg_0 : Choice ResizeArray = ResizeArray () - - /// 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" "args", System.StringComparison.OrdinalIgnoreCase) then - value |> (fun x -> x) |> Choice1Of2 |> arg_0.Add - () |> Ok - else - Error None + let inProgress = + ArgParseHelpers_ConsumePlugin.ChoicePositionals_InProgress._Empty () - /// Returns false if we didn't set a value. - let setFlagValue (key : string) : bool = false + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () - let rec go (state : ParseState_ChoicePositionals) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_ChoicePositionals) (args : string list) = match args with | [] -> match state with | ParseState_ChoicePositionals.AwaitingKey -> () | ParseState_ChoicePositionals.AwaitingValue key -> - if setFlagValue key then + if inProgress.SetFlagValue_ errors_ 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_0.AddRange (rest |> Seq.map (fun x -> x) |> Seq.map Choice2Of2) + |> errors_.Add + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_ChoicePositionals.AwaitingKey -> if arg.StartsWith ("--", System.StringComparison.Ordinal) then if arg = "--help" then - helpText () |> failwithf "Help text requested.\n%s" + "TODO" |> failwithf "Help text requested.\n%s" else let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_ChoicePositionals.AwaitingValue arg) + go (argNum_ + 1) (ParseState_ChoicePositionals.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match processKeyValue key value with - | Ok () -> go ParseState_ChoicePositionals.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) 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 + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_ChoicePositionals.AwaitingKey args | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ChoicePositionals.AwaitingKey args + sprintf "%s (at arg %s)" msg arg |> errors_.Add + go (argNum_ + 1) ParseState_ChoicePositionals.AwaitingKey args else - arg |> (fun x -> x) |> Choice1Of2 |> arg_0.Add - go ParseState_ChoicePositionals.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ChoicePositionals.AwaitingKey args | ParseState_ChoicePositionals.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_ChoicePositionals.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_ChoicePositionals.AwaitingKey args | Error exc -> - if setFlagValue key then - go ParseState_ChoicePositionals.AwaitingKey (arg :: args) + if inProgress.SetFlagValue_ errors_ key then + go argNum_ ParseState_ChoicePositionals.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_ChoicePositionals.AwaitingKey args - let arg_0 = arg_0 |> Seq.toList - - if 0 = ArgParser_errors.Count then - { - Args = arg_0 - } + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ChoicePositionals.AwaitingKey (arg :: args) + + go 0 ParseState_ChoicePositionals.AwaitingKey args + + if 0 = errors_.Count then + () else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith + else + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : ChoicePositionals = ChoicePositionals.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -2512,7 +5039,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type ContainsBoolEnvVar [] module ContainsBoolEnvVarArgParse = - type private ParseState_ContainsBoolEnvVar = + type internal ParseState_ContainsBoolEnvVar = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -2522,166 +5049,100 @@ module ContainsBoolEnvVarArgParse = type ContainsBoolEnvVar with static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ContainsBoolEnvVar = - let ArgParser_errors = ResizeArray () - - let helpText () = - [ - (sprintf - "%s bool%s%s" - (sprintf "--%s" "bool-var") - ("CONSUMEPLUGIN_THINGS" |> sprintf " (default value populated from env var %s)") - "") - ] - |> String.concat "\n" - - let parser_LeftoverArgs : string ResizeArray = ResizeArray () - let mutable arg_0 : 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(). - /// 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" "bool-var", System.StringComparison.OrdinalIgnoreCase) then - match arg_0 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "bool-var") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add + let inProgress = + ArgParseHelpers_ConsumePlugin.ContainsBoolEnvVar_InProgress._Empty () - Ok () - | None -> - try - arg_0 <- value |> (fun x -> System.Boolean.Parse 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" "bool-var", System.StringComparison.OrdinalIgnoreCase) then - match arg_0 with - | Some x -> - sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "bool-var") - |> ArgParser_errors.Add - - true - | None -> - arg_0 <- true |> Some - true - else - false + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () - let rec go (state : ParseState_ContainsBoolEnvVar) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_ContainsBoolEnvVar) (args : string list) = match args with | [] -> match state with | ParseState_ContainsBoolEnvVar.AwaitingKey -> () | ParseState_ContainsBoolEnvVar.AwaitingValue key -> - if setFlagValue key then + if inProgress.SetFlagValue_ errors_ 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)) + |> errors_.Add + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_ContainsBoolEnvVar.AwaitingKey -> if arg.StartsWith ("--", System.StringComparison.Ordinal) then if arg = "--help" then - helpText () |> failwithf "Help text requested.\n%s" + "TODO" |> failwithf "Help text requested.\n%s" else let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_ContainsBoolEnvVar.AwaitingValue arg) + go (argNum_ + 1) (ParseState_ContainsBoolEnvVar.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match processKeyValue key value with - | Ok () -> go ParseState_ContainsBoolEnvVar.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) 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 + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_ContainsBoolEnvVar.AwaitingKey args | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ContainsBoolEnvVar.AwaitingKey args + sprintf "%s (at arg %s)" msg arg |> errors_.Add + go (argNum_ + 1) ParseState_ContainsBoolEnvVar.AwaitingKey args else - arg |> (fun x -> x) |> parser_LeftoverArgs.Add - go ParseState_ContainsBoolEnvVar.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ContainsBoolEnvVar.AwaitingKey args | ParseState_ContainsBoolEnvVar.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_ContainsBoolEnvVar.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_ContainsBoolEnvVar.AwaitingKey args | Error exc -> - if setFlagValue key then - go ParseState_ContainsBoolEnvVar.AwaitingKey (arg :: args) + if inProgress.SetFlagValue_ errors_ key then + go argNum_ ParseState_ContainsBoolEnvVar.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_ContainsBoolEnvVar.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 + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ContainsBoolEnvVar.AwaitingKey (arg :: args) - Unchecked.defaultof<_> + go 0 ParseState_ContainsBoolEnvVar.AwaitingKey args - let arg_0 = - match arg_0 with - | None -> - match "CONSUMEPLUGIN_THINGS" |> getEnvironmentVariable with - | null -> - sprintf - "No value was supplied for %s, nor was environment variable %s set" - (sprintf "--%s" "bool-var") - "CONSUMEPLUGIN_THINGS" - |> ArgParser_errors.Add - - Unchecked.defaultof<_> - | x -> - if System.String.Equals (x, "1", System.StringComparison.OrdinalIgnoreCase) then - true - else if System.String.Equals (x, "0", System.StringComparison.OrdinalIgnoreCase) then - false - else - x |> (fun x -> System.Boolean.Parse x) - |> Choice2Of2 - | Some x -> Choice1Of2 x - - if 0 = ArgParser_errors.Count then - { - BoolVar = arg_0 - } + if 0 = errors_.Count then + () else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith + else + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : ContainsBoolEnvVar = ContainsBoolEnvVar.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -2689,7 +5150,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type WithFlagDu [] module WithFlagDuArgParse = - type private ParseState_WithFlagDu = + type internal ParseState_WithFlagDu = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -2699,162 +5160,98 @@ module WithFlagDuArgParse = type WithFlagDu with static member parse' (getEnvironmentVariable : string -> string) (args : string list) : WithFlagDu = - let ArgParser_errors = ResizeArray () - - let helpText () = - [ (sprintf "%s bool%s%s" (sprintf "--%s" "dry-run") "" "") ] - |> String.concat "\n" - - let parser_LeftoverArgs : string ResizeArray = ResizeArray () - let mutable arg_0 : DryRunMode 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" "dry-run", System.StringComparison.OrdinalIgnoreCase) then - match arg_0 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "dry-run") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add - - Ok () - | None -> - try - arg_0 <- - value - |> (fun x -> - if System.Boolean.Parse x = Consts.FALSE then - DryRunMode.Wet - else - DryRunMode.Dry - ) - |> Some + let inProgress = ArgParseHelpers_ConsumePlugin.WithFlagDu_InProgress._Empty () + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () - 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" "dry-run", System.StringComparison.OrdinalIgnoreCase) then - match arg_0 with - | Some x -> - sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "dry-run") - |> ArgParser_errors.Add - - true - | None -> - arg_0 <- - if true = Consts.FALSE then - DryRunMode.Wet - else - DryRunMode.Dry - |> Some - - true - else - false - - let rec go (state : ParseState_WithFlagDu) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_WithFlagDu) (args : string list) = match args with | [] -> match state with | ParseState_WithFlagDu.AwaitingKey -> () | ParseState_WithFlagDu.AwaitingValue key -> - if setFlagValue key then + if inProgress.SetFlagValue_ errors_ 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)) + |> errors_.Add + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_WithFlagDu.AwaitingKey -> if arg.StartsWith ("--", System.StringComparison.Ordinal) then if arg = "--help" then - helpText () |> failwithf "Help text requested.\n%s" + "TODO" |> failwithf "Help text requested.\n%s" else let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_WithFlagDu.AwaitingValue arg) + go (argNum_ + 1) (ParseState_WithFlagDu.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match processKeyValue key value with - | Ok () -> go ParseState_WithFlagDu.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) 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 + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_WithFlagDu.AwaitingKey args | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_WithFlagDu.AwaitingKey args + sprintf "%s (at arg %s)" msg arg |> errors_.Add + go (argNum_ + 1) ParseState_WithFlagDu.AwaitingKey args else - arg |> (fun x -> x) |> parser_LeftoverArgs.Add - go ParseState_WithFlagDu.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_WithFlagDu.AwaitingKey args | ParseState_WithFlagDu.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_WithFlagDu.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_WithFlagDu.AwaitingKey args | Error exc -> - if setFlagValue key then - go ParseState_WithFlagDu.AwaitingKey (arg :: args) + if inProgress.SetFlagValue_ errors_ key then + go argNum_ ParseState_WithFlagDu.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_WithFlagDu.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" "dry-run") - |> ArgParser_errors.Add + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_WithFlagDu.AwaitingKey (arg :: args) - Unchecked.defaultof<_> - | Some x -> x + go 0 ParseState_WithFlagDu.AwaitingKey args - if 0 = ArgParser_errors.Count then - { - DryRun = arg_0 - } + if 0 = errors_.Count then + () else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith + else + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : WithFlagDu = WithFlagDu.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -2862,7 +5259,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type ContainsFlagEnvVar [] module ContainsFlagEnvVarArgParse = - type private ParseState_ContainsFlagEnvVar = + type internal ParseState_ContainsFlagEnvVar = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -2872,193 +5269,100 @@ module ContainsFlagEnvVarArgParse = type ContainsFlagEnvVar with static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ContainsFlagEnvVar = - let ArgParser_errors = ResizeArray () - - let helpText () = - [ - (sprintf - "%s bool%s%s" - (sprintf "--%s" "dry-run") - ("CONSUMEPLUGIN_THINGS" |> sprintf " (default value populated from env var %s)") - "") - ] - |> String.concat "\n" - - let parser_LeftoverArgs : string ResizeArray = ResizeArray () - let mutable arg_0 : DryRunMode 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" "dry-run", System.StringComparison.OrdinalIgnoreCase) then - match arg_0 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "dry-run") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add - - Ok () - | None -> - try - arg_0 <- - value - |> (fun x -> - if System.Boolean.Parse x = Consts.FALSE then - DryRunMode.Wet - else - DryRunMode.Dry - ) - |> 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" "dry-run", System.StringComparison.OrdinalIgnoreCase) then - match arg_0 with - | Some x -> - sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "dry-run") - |> ArgParser_errors.Add - - true - | None -> - arg_0 <- - if true = Consts.FALSE then - DryRunMode.Wet - else - DryRunMode.Dry - |> Some + let inProgress = + ArgParseHelpers_ConsumePlugin.ContainsFlagEnvVar_InProgress._Empty () - true - else - false + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () - let rec go (state : ParseState_ContainsFlagEnvVar) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_ContainsFlagEnvVar) (args : string list) = match args with | [] -> match state with | ParseState_ContainsFlagEnvVar.AwaitingKey -> () | ParseState_ContainsFlagEnvVar.AwaitingValue key -> - if setFlagValue key then + if inProgress.SetFlagValue_ errors_ 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)) + |> errors_.Add + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_ContainsFlagEnvVar.AwaitingKey -> if arg.StartsWith ("--", System.StringComparison.Ordinal) then if arg = "--help" then - helpText () |> failwithf "Help text requested.\n%s" + "TODO" |> failwithf "Help text requested.\n%s" else let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_ContainsFlagEnvVar.AwaitingValue arg) + go (argNum_ + 1) (ParseState_ContainsFlagEnvVar.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match processKeyValue key value with - | Ok () -> go ParseState_ContainsFlagEnvVar.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) 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 + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_ContainsFlagEnvVar.AwaitingKey args | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ContainsFlagEnvVar.AwaitingKey args + sprintf "%s (at arg %s)" msg arg |> errors_.Add + go (argNum_ + 1) ParseState_ContainsFlagEnvVar.AwaitingKey args else - arg |> (fun x -> x) |> parser_LeftoverArgs.Add - go ParseState_ContainsFlagEnvVar.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ContainsFlagEnvVar.AwaitingKey args | ParseState_ContainsFlagEnvVar.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_ContainsFlagEnvVar.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_ContainsFlagEnvVar.AwaitingKey args | Error exc -> - if setFlagValue key then - go ParseState_ContainsFlagEnvVar.AwaitingKey (arg :: args) + if inProgress.SetFlagValue_ errors_ key then + go argNum_ ParseState_ContainsFlagEnvVar.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_ContainsFlagEnvVar.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<_> + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ContainsFlagEnvVar.AwaitingKey (arg :: args) - let arg_0 = - match arg_0 with - | None -> - match "CONSUMEPLUGIN_THINGS" |> getEnvironmentVariable with - | null -> - sprintf - "No value was supplied for %s, nor was environment variable %s set" - (sprintf "--%s" "dry-run") - "CONSUMEPLUGIN_THINGS" - |> ArgParser_errors.Add - - Unchecked.defaultof<_> - | x -> - if System.String.Equals (x, "1", System.StringComparison.OrdinalIgnoreCase) then - if true = Consts.FALSE then - DryRunMode.Wet - else - DryRunMode.Dry - else if System.String.Equals (x, "0", System.StringComparison.OrdinalIgnoreCase) then - if false = Consts.FALSE then - DryRunMode.Wet - else - DryRunMode.Dry - else - x - |> (fun x -> - if System.Boolean.Parse x = Consts.FALSE then - DryRunMode.Wet - else - DryRunMode.Dry - ) - |> Choice2Of2 - | Some x -> Choice1Of2 x + go 0 ParseState_ContainsFlagEnvVar.AwaitingKey args - if 0 = ArgParser_errors.Count then - { - DryRun = arg_0 - } + if 0 = errors_.Count then + () else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith + else + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : ContainsFlagEnvVar = ContainsFlagEnvVar.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -3066,7 +5370,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type ContainsFlagDefaultValue [] module ContainsFlagDefaultValueArgParse = - type private ParseState_ContainsFlagDefaultValue = + type internal ParseState_ContainsFlagDefaultValue = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -3080,168 +5384,100 @@ module ContainsFlagDefaultValueArgParse = (args : string list) : ContainsFlagDefaultValue = - let ArgParser_errors = ResizeArray () - - let helpText () = - [ - (sprintf - "%s bool%s%s" - (sprintf "--%s" "dry-run") - (match ContainsFlagDefaultValue.DefaultDryRun () with - | DryRunMode.Wet -> if Consts.FALSE = true then "true" else "false" - | DryRunMode.Dry -> if true = true then "true" else "false" - |> (fun x -> x.ToString ()) - |> sprintf " (default value: %s)") - "") - ] - |> String.concat "\n" - - let parser_LeftoverArgs : string ResizeArray = ResizeArray () - let mutable arg_0 : DryRunMode 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" "dry-run", System.StringComparison.OrdinalIgnoreCase) then - match arg_0 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "dry-run") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add - - Ok () - | None -> - try - arg_0 <- - value - |> (fun x -> - if System.Boolean.Parse x = Consts.FALSE then - DryRunMode.Wet - else - DryRunMode.Dry - ) - |> 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" "dry-run", System.StringComparison.OrdinalIgnoreCase) then - match arg_0 with - | Some x -> - sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "dry-run") - |> ArgParser_errors.Add - - true - | None -> - arg_0 <- - if true = Consts.FALSE then - DryRunMode.Wet - else - DryRunMode.Dry - |> Some + let inProgress = + ArgParseHelpers_ConsumePlugin.ContainsFlagDefaultValue_InProgress._Empty () - true - else - false + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () - let rec go (state : ParseState_ContainsFlagDefaultValue) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_ContainsFlagDefaultValue) (args : string list) = match args with | [] -> match state with | ParseState_ContainsFlagDefaultValue.AwaitingKey -> () | ParseState_ContainsFlagDefaultValue.AwaitingValue key -> - if setFlagValue key then + if inProgress.SetFlagValue_ errors_ 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)) + |> errors_.Add + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_ContainsFlagDefaultValue.AwaitingKey -> if arg.StartsWith ("--", System.StringComparison.Ordinal) then if arg = "--help" then - helpText () |> failwithf "Help text requested.\n%s" + "TODO" |> failwithf "Help text requested.\n%s" else let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_ContainsFlagDefaultValue.AwaitingValue arg) + go (argNum_ + 1) (ParseState_ContainsFlagDefaultValue.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match processKeyValue key value with - | Ok () -> go ParseState_ContainsFlagDefaultValue.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) 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 + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_ContainsFlagDefaultValue.AwaitingKey args | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ContainsFlagDefaultValue.AwaitingKey args + sprintf "%s (at arg %s)" msg arg |> errors_.Add + go (argNum_ + 1) ParseState_ContainsFlagDefaultValue.AwaitingKey args else - arg |> (fun x -> x) |> parser_LeftoverArgs.Add - go ParseState_ContainsFlagDefaultValue.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ContainsFlagDefaultValue.AwaitingKey args | ParseState_ContainsFlagDefaultValue.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_ContainsFlagDefaultValue.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_ContainsFlagDefaultValue.AwaitingKey args | Error exc -> - if setFlagValue key then - go ParseState_ContainsFlagDefaultValue.AwaitingKey (arg :: args) + if inProgress.SetFlagValue_ errors_ key then + go argNum_ ParseState_ContainsFlagDefaultValue.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_ContainsFlagDefaultValue.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<_> + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ContainsFlagDefaultValue.AwaitingKey (arg :: args) - let arg_0 = - match arg_0 with - | None -> ContainsFlagDefaultValue.DefaultDryRun () |> Choice2Of2 - | Some x -> Choice1Of2 x + go 0 ParseState_ContainsFlagDefaultValue.AwaitingKey args - if 0 = ArgParser_errors.Count then - { - DryRun = arg_0 - } + if 0 = errors_.Count then + () else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith + else + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : ContainsFlagDefaultValue = ContainsFlagDefaultValue.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -3249,7 +5485,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type ManyLongForms [] module ManyLongFormsArgParse = - type private ParseState_ManyLongForms = + type internal ParseState_ManyLongForms = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -3259,254 +5495,98 @@ module ManyLongFormsArgParse = type ManyLongForms with static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ManyLongForms = - let ArgParser_errors = ResizeArray () - - let helpText () = - [ - (sprintf "%s string%s%s" (sprintf "--%s / --%s" "do-something-else" "anotherarg") "" "") - (sprintf "%s bool%s%s" (sprintf "--%s / --%s" "turn-it-on" "dont-turn-it-off") "" "") - ] - |> String.concat "\n" - - let parser_LeftoverArgs : string ResizeArray = ResizeArray () - let mutable arg_0 : string option = None - let mutable arg_1 : 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(). - /// 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" "dont-turn-it-off", - System.StringComparison.OrdinalIgnoreCase - ) - then - match arg_1 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s / --%s" "turn-it-on" "dont-turn-it-off") - (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" "turn-it-on", System.StringComparison.OrdinalIgnoreCase) - then - match arg_1 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s / --%s" "turn-it-on" "dont-turn-it-off") - (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" "anotherarg", System.StringComparison.OrdinalIgnoreCase) - then - match arg_0 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s / --%s" "do-something-else" "anotherarg") - (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" "do-something-else", - System.StringComparison.OrdinalIgnoreCase - ) - then - match arg_0 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s / --%s" "do-something-else" "anotherarg") - (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" "dont-turn-it-off", - System.StringComparison.OrdinalIgnoreCase - ) - then - match arg_1 with - | Some x -> - sprintf - "Flag '%s' was supplied multiple times" - (sprintf "--%s / --%s" "turn-it-on" "dont-turn-it-off") - |> ArgParser_errors.Add - - true - | None -> - arg_1 <- true |> Some - true - else if - System.String.Equals (key, sprintf "--%s" "turn-it-on", System.StringComparison.OrdinalIgnoreCase) - then - match arg_1 with - | Some x -> - sprintf - "Flag '%s' was supplied multiple times" - (sprintf "--%s / --%s" "turn-it-on" "dont-turn-it-off") - |> ArgParser_errors.Add - - true - | None -> - arg_1 <- true |> Some - true - else - false + let inProgress = ArgParseHelpers_ConsumePlugin.ManyLongForms_InProgress._Empty () + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () - let rec go (state : ParseState_ManyLongForms) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_ManyLongForms) (args : string list) = match args with | [] -> match state with | ParseState_ManyLongForms.AwaitingKey -> () | ParseState_ManyLongForms.AwaitingValue key -> - if setFlagValue key then + if inProgress.SetFlagValue_ errors_ 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)) + |> errors_.Add + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_ManyLongForms.AwaitingKey -> if arg.StartsWith ("--", System.StringComparison.Ordinal) then if arg = "--help" then - helpText () |> failwithf "Help text requested.\n%s" + "TODO" |> failwithf "Help text requested.\n%s" else let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_ManyLongForms.AwaitingValue arg) + go (argNum_ + 1) (ParseState_ManyLongForms.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match processKeyValue key value with - | Ok () -> go ParseState_ManyLongForms.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) 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 + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_ManyLongForms.AwaitingKey args | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ManyLongForms.AwaitingKey args + sprintf "%s (at arg %s)" msg arg |> errors_.Add + go (argNum_ + 1) ParseState_ManyLongForms.AwaitingKey args else - arg |> (fun x -> x) |> parser_LeftoverArgs.Add - go ParseState_ManyLongForms.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ManyLongForms.AwaitingKey args | ParseState_ManyLongForms.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_ManyLongForms.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_ManyLongForms.AwaitingKey args | Error exc -> - if setFlagValue key then - go ParseState_ManyLongForms.AwaitingKey (arg :: args) + if inProgress.SetFlagValue_ errors_ key then + go argNum_ ParseState_ManyLongForms.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_ManyLongForms.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 / --%s" "do-something-else" "anotherarg") - |> 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 / --%s" "turn-it-on" "dont-turn-it-off") - |> ArgParser_errors.Add + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ManyLongForms.AwaitingKey (arg :: args) - Unchecked.defaultof<_> - | Some x -> x + go 0 ParseState_ManyLongForms.AwaitingKey args - if 0 = ArgParser_errors.Count then - { - DoTheThing = arg_0 - SomeFlag = arg_1 - } + if 0 = errors_.Count then + () else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith + else + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : ManyLongForms = ManyLongForms.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -3514,7 +5594,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type FlagsIntoPositionalArgs [] module FlagsIntoPositionalArgsArgParse = - type private ParseState_FlagsIntoPositionalArgs = + type internal ParseState_FlagsIntoPositionalArgs = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -3528,149 +5608,100 @@ module FlagsIntoPositionalArgsArgParse = (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 + let inProgress = + ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgs_InProgress._Empty () - 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 positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () - let rec go (state : ParseState_FlagsIntoPositionalArgs) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_FlagsIntoPositionalArgs) (args : string list) = match args with | [] -> match state with | ParseState_FlagsIntoPositionalArgs.AwaitingKey -> () | ParseState_FlagsIntoPositionalArgs.AwaitingValue key -> - if setFlagValue key then + if inProgress.SetFlagValue_ errors_ 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)) + |> errors_.Add + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | 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" + "TODO" |> failwithf "Help text requested.\n%s" else let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_FlagsIntoPositionalArgs.AwaitingValue arg) + go (argNum_ + 1) (ParseState_FlagsIntoPositionalArgs.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match processKeyValue key value with - | Ok () -> go ParseState_FlagsIntoPositionalArgs.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) 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 + match x with + | None -> + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgs.AwaitingKey args + | Some msg -> + sprintf "%s (at arg %s)" msg arg |> errors_.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgs.AwaitingKey args else - arg |> (fun x -> x) |> arg_1.Add - go ParseState_FlagsIntoPositionalArgs.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgs.AwaitingKey args | ParseState_FlagsIntoPositionalArgs.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_FlagsIntoPositionalArgs.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_FlagsIntoPositionalArgs.AwaitingKey args | Error exc -> - if setFlagValue key then - go ParseState_FlagsIntoPositionalArgs.AwaitingKey (arg :: args) - else if true then - key |> (fun x -> x) |> arg_1.Add - go ParseState_FlagsIntoPositionalArgs.AwaitingKey (arg :: args) + if inProgress.SetFlagValue_ errors_ key then + go argNum_ 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 + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgs.AwaitingKey (arg :: args) - Unchecked.defaultof<_> - | Some x -> x + go 0 ParseState_FlagsIntoPositionalArgs.AwaitingKey args - if 0 = ArgParser_errors.Count then - { - A = arg_0 - GrabEverything = arg_1 - } + if 0 = errors_.Count then + () else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith + else + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : FlagsIntoPositionalArgs = FlagsIntoPositionalArgs.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -3678,7 +5709,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type FlagsIntoPositionalArgsChoice [] module FlagsIntoPositionalArgsChoiceArgParse = - type private ParseState_FlagsIntoPositionalArgsChoice = + type internal ParseState_FlagsIntoPositionalArgsChoice = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -3692,149 +5723,101 @@ module FlagsIntoPositionalArgsChoiceArgParse = (args : string list) : FlagsIntoPositionalArgsChoice = - 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 : Choice 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) |> Choice1Of2 |> arg_1.Add - () |> Ok - else - Error None + let inProgress = + ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgsChoice_InProgress._Empty () - /// Returns false if we didn't set a value. - let setFlagValue (key : string) : bool = false + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () - let rec go (state : ParseState_FlagsIntoPositionalArgsChoice) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_FlagsIntoPositionalArgsChoice) (args : string list) = match args with | [] -> match state with | ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey -> () | ParseState_FlagsIntoPositionalArgsChoice.AwaitingValue key -> - if setFlagValue key then + if inProgress.SetFlagValue_ errors_ 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) |> Seq.map Choice2Of2) + |> errors_.Add + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey -> if arg.StartsWith ("--", System.StringComparison.Ordinal) then if arg = "--help" then - helpText () |> failwithf "Help text requested.\n%s" + "TODO" |> failwithf "Help text requested.\n%s" else let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_FlagsIntoPositionalArgsChoice.AwaitingValue arg) + go (argNum_ + 1) (ParseState_FlagsIntoPositionalArgsChoice.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match processKeyValue key value with - | Ok () -> go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args | Error x -> - if true then - arg |> (fun x -> x) |> Choice1Of2 |> arg_1.Add - go ParseState_FlagsIntoPositionalArgsChoice.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_FlagsIntoPositionalArgsChoice.AwaitingKey args + match x with + | None -> + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args + | Some msg -> + sprintf "%s (at arg %s)" msg arg |> errors_.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args else - arg |> (fun x -> x) |> Choice1Of2 |> arg_1.Add - go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args | ParseState_FlagsIntoPositionalArgsChoice.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args | Error exc -> - if setFlagValue key then - go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey (arg :: args) - else if true then - key |> (fun x -> x) |> Choice1Of2 |> arg_1.Add - go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey (arg :: args) + if inProgress.SetFlagValue_ errors_ key then + go argNum_ ParseState_FlagsIntoPositionalArgsChoice.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_FlagsIntoPositionalArgsChoice.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 + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey (arg :: args) - Unchecked.defaultof<_> - | Some x -> x + go 0 ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args - if 0 = ArgParser_errors.Count then - { - A = arg_0 - GrabEverything = arg_1 - } + if 0 = errors_.Count then + () else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith + else + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : FlagsIntoPositionalArgsChoice = FlagsIntoPositionalArgsChoice.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -3842,7 +5825,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type FlagsIntoPositionalArgsInt [] module FlagsIntoPositionalArgsIntArgParse = - type private ParseState_FlagsIntoPositionalArgsInt = + type internal ParseState_FlagsIntoPositionalArgsInt = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -3856,149 +5839,100 @@ module FlagsIntoPositionalArgsIntArgParse = (args : string list) : FlagsIntoPositionalArgsInt = - let ArgParser_errors = ResizeArray () - - let helpText () = - [ - (sprintf "%s string%s%s" (sprintf "--%s" "a") "" "") - (sprintf - "%s int32%s%s" - (sprintf "--%s" "grab-everything") - " (positional args) (can be repeated)" - "") - ] - |> String.concat "\n" - - let arg_1 : int 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 -> System.Int32.Parse x) |> arg_1.Add - () |> Ok - else - Error None + let inProgress = + ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgsInt_InProgress._Empty () - /// Returns false if we didn't set a value. - let setFlagValue (key : string) : bool = false + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () - let rec go (state : ParseState_FlagsIntoPositionalArgsInt) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_FlagsIntoPositionalArgsInt) (args : string list) = match args with | [] -> match state with | ParseState_FlagsIntoPositionalArgsInt.AwaitingKey -> () | ParseState_FlagsIntoPositionalArgsInt.AwaitingValue key -> - if setFlagValue key then + if inProgress.SetFlagValue_ errors_ 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 -> System.Int32.Parse x)) + |> errors_.Add + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_FlagsIntoPositionalArgsInt.AwaitingKey -> if arg.StartsWith ("--", System.StringComparison.Ordinal) then if arg = "--help" then - helpText () |> failwithf "Help text requested.\n%s" + "TODO" |> failwithf "Help text requested.\n%s" else let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_FlagsIntoPositionalArgsInt.AwaitingValue arg) + go (argNum_ + 1) (ParseState_FlagsIntoPositionalArgsInt.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match processKeyValue key value with - | Ok () -> go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args | Error x -> - if true then - arg |> (fun x -> System.Int32.Parse x) |> arg_1.Add - go ParseState_FlagsIntoPositionalArgsInt.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_FlagsIntoPositionalArgsInt.AwaitingKey args + match x with + | None -> + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args + | Some msg -> + sprintf "%s (at arg %s)" msg arg |> errors_.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args else - arg |> (fun x -> System.Int32.Parse x) |> arg_1.Add - go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args | ParseState_FlagsIntoPositionalArgsInt.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args | Error exc -> - if setFlagValue key then - go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey (arg :: args) - else if true then - key |> (fun x -> System.Int32.Parse x) |> arg_1.Add - go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey (arg :: args) + if inProgress.SetFlagValue_ errors_ key then + go argNum_ ParseState_FlagsIntoPositionalArgsInt.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_FlagsIntoPositionalArgsInt.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 + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsInt.AwaitingKey (arg :: args) - Unchecked.defaultof<_> - | Some x -> x + go 0 ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args - if 0 = ArgParser_errors.Count then - { - A = arg_0 - GrabEverything = arg_1 - } + if 0 = errors_.Count then + () else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith + else + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : FlagsIntoPositionalArgsInt = FlagsIntoPositionalArgsInt.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -4006,7 +5940,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type FlagsIntoPositionalArgsIntChoice [] module FlagsIntoPositionalArgsIntChoiceArgParse = - type private ParseState_FlagsIntoPositionalArgsIntChoice = + type internal ParseState_FlagsIntoPositionalArgsIntChoice = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -4020,149 +5954,112 @@ module FlagsIntoPositionalArgsIntChoiceArgParse = (args : string list) : FlagsIntoPositionalArgsIntChoice = - let ArgParser_errors = ResizeArray () - - let helpText () = - [ - (sprintf "%s string%s%s" (sprintf "--%s" "a") "" "") - (sprintf - "%s int32%s%s" - (sprintf "--%s" "grab-everything") - " (positional args) (can be repeated)" - "") - ] - |> String.concat "\n" - - let arg_1 : Choice 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 -> System.Int32.Parse x) |> Choice1Of2 |> arg_1.Add - () |> Ok - else - Error None + let inProgress = + ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgsIntChoice_InProgress._Empty () - /// Returns false if we didn't set a value. - let setFlagValue (key : string) : bool = false + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () - let rec go (state : ParseState_FlagsIntoPositionalArgsIntChoice) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_FlagsIntoPositionalArgsIntChoice) (args : string list) = match args with | [] -> match state with | ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey -> () | ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingValue key -> - if setFlagValue key then + if inProgress.SetFlagValue_ errors_ 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 -> System.Int32.Parse x) |> Seq.map Choice2Of2) + |> errors_.Add + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey -> if arg.StartsWith ("--", System.StringComparison.Ordinal) then if arg = "--help" then - helpText () |> failwithf "Help text requested.\n%s" + "TODO" |> failwithf "Help text requested.\n%s" else let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingValue arg) + go + (argNum_ + 1) + (ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingValue arg) + args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match processKeyValue key value with - | Ok () -> go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args | Error x -> - if true then - arg |> (fun x -> System.Int32.Parse x) |> Choice1Of2 |> arg_1.Add - go ParseState_FlagsIntoPositionalArgsIntChoice.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_FlagsIntoPositionalArgsIntChoice.AwaitingKey args + match x with + | None -> + positionals.Add (Choice1Of2 (arg, argNum_)) + + go + (argNum_ + 1) + ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey + args + | Some msg -> + sprintf "%s (at arg %s)" msg arg |> errors_.Add + + go + (argNum_ + 1) + ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey + args else - arg |> (fun x -> System.Int32.Parse x) |> Choice1Of2 |> arg_1.Add - go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args | ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args | Error exc -> - if setFlagValue key then - go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey (arg :: args) - else if true then - key |> (fun x -> System.Int32.Parse x) |> Choice1Of2 |> arg_1.Add - go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey (arg :: args) + if inProgress.SetFlagValue_ errors_ key then + go argNum_ ParseState_FlagsIntoPositionalArgsIntChoice.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_FlagsIntoPositionalArgsIntChoice.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 + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey (arg :: args) - Unchecked.defaultof<_> - | Some x -> x + go 0 ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args - if 0 = ArgParser_errors.Count then - { - A = arg_0 - GrabEverything = arg_1 - } + if 0 = errors_.Count then + () else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith + else + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : FlagsIntoPositionalArgsIntChoice = FlagsIntoPositionalArgsIntChoice.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -4170,7 +6067,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type FlagsIntoPositionalArgs' [] module FlagsIntoPositionalArgs'ArgParse = - type private ParseState_FlagsIntoPositionalArgs' = + type internal ParseState_FlagsIntoPositionalArgs' = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -4184,144 +6081,203 @@ module FlagsIntoPositionalArgs'ArgParse = (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 + let inProgress = + ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgs'_InProgress._Empty () - /// Returns false if we didn't set a value. - let setFlagValue (key : string) : bool = false + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () - let rec go (state : ParseState_FlagsIntoPositionalArgs') (args : string list) = + let rec go (argNum_ : int) (state : ParseState_FlagsIntoPositionalArgs') (args : string list) = match args with | [] -> match state with | ParseState_FlagsIntoPositionalArgs'.AwaitingKey -> () | ParseState_FlagsIntoPositionalArgs'.AwaitingValue key -> - if setFlagValue key then + if inProgress.SetFlagValue_ errors_ 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)) + |> errors_.Add + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | 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" + "TODO" |> failwithf "Help text requested.\n%s" else let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_FlagsIntoPositionalArgs'.AwaitingValue arg) + go (argNum_ + 1) (ParseState_FlagsIntoPositionalArgs'.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match processKeyValue key value with - | Ok () -> go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) 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 + match x with + | None -> + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgs'.AwaitingKey args + | Some msg -> + sprintf "%s (at arg %s)" msg arg |> errors_.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgs'.AwaitingKey args else - arg |> (fun x -> x) |> arg_1.Add - go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgs'.AwaitingKey args | ParseState_FlagsIntoPositionalArgs'.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_FlagsIntoPositionalArgs'.AwaitingKey args | Error exc -> - if setFlagValue key then - go ParseState_FlagsIntoPositionalArgs'.AwaitingKey (arg :: args) - else if false then - key |> (fun x -> x) |> arg_1.Add - go ParseState_FlagsIntoPositionalArgs'.AwaitingKey (arg :: args) + if inProgress.SetFlagValue_ errors_ key then + go argNum_ 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 + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgs'.AwaitingKey (arg :: args) - Unchecked.defaultof<_> - | Some x -> x + go 0 ParseState_FlagsIntoPositionalArgs'.AwaitingKey args - if 0 = ArgParser_errors.Count then - { - A = arg_0 - DontGrabEverything = arg_1 - } + if 0 = errors_.Count then + () else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith + else + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : FlagsIntoPositionalArgs' = FlagsIntoPositionalArgs'.parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open ArgParserHelpers +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type PassThru +[] +module PassThruArgParse = + type internal ParseState_PassThru = + /// 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 PassThru with + + static member parse' (getEnvironmentVariable : string -> string) (args : string list) : PassThru = + let inProgress = ArgParseHelpers_ConsumePlugin.PassThru_InProgress._Empty () + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (argNum_ : int) (state : ParseState_PassThru) (args : string list) = + match args with + | [] -> + match state with + | ParseState_PassThru.AwaitingKey -> () + | ParseState_PassThru.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_PassThru.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) + + if equals < 0 then + go (argNum_ + 1) (ParseState_PassThru.AwaitingValue arg) args + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_PassThru.AwaitingKey args + | Error x -> + match x with + | None -> + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_PassThru.AwaitingKey args + | Some msg -> + sprintf "%s (at arg %s)" msg arg |> errors_.Add + go (argNum_ + 1) ParseState_PassThru.AwaitingKey args + else + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_PassThru.AwaitingKey args + | ParseState_PassThru.AwaitingValue key -> + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_PassThru.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go argNum_ ParseState_PassThru.AwaitingKey (arg :: args) + else + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_PassThru.AwaitingKey (arg :: args) + + go 0 ParseState_PassThru.AwaitingKey args + + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith + else + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + static member parse (args : string list) : PassThru = + PassThru.parse' System.Environment.GetEnvironmentVariable args diff --git a/ConsumePlugin/GeneratedArgsWithUnions.fs b/ConsumePlugin/GeneratedArgsWithUnions.fs new file mode 100644 index 00000000..1a451edd --- /dev/null +++ b/ConsumePlugin/GeneratedArgsWithUnions.fs @@ -0,0 +1,686 @@ +//------------------------------------------------------------------------------ +// This code was generated by myriad. +// Changes to this file will be lost when the code is regenerated. +//------------------------------------------------------------------------------ + + + + + + +namespace ArgParserHelpers + +/// Helper types for arg parsing +module internal ArgParseHelpers_ConsumePlugin_ArgsWithUnions = + open System + open System.IO + open WoofWare.Myriad.Plugins + open ConsumePlugin.ArgsWithUnions + + /// A partially-parsed BasicNoPositionals. + type internal BasicNoPositionals_InProgress = + { + mutable Bar : string option + mutable Baz : bool option + mutable Foo : int option + mutable Rest : ResizeArray + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : int = + match this.Foo with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "foo") + Unchecked.defaultof<_> + + let arg1 : string = + match this.Bar with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "bar") + Unchecked.defaultof<_> + + let arg2 : bool = + match this.Baz with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "baz") + Unchecked.defaultof<_> + + let arg3 : int list = this.Rest |> Seq.toList + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + Foo = arg0 + Bar = arg1 + Baz = arg2 + Rest = arg3 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : BasicNoPositionals_InProgress = + { + Bar = None + Baz = None + Foo = None + Rest = ResizeArray () + } + + /// 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. + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "rest", System.StringComparison.OrdinalIgnoreCase) then + value |> (fun x -> System.Int32.Parse x) |> (fun x -> x) |> this.Rest.Add + () |> Ok + else if System.String.Equals (key, sprintf "--%s" "foo", System.StringComparison.OrdinalIgnoreCase) then + match this.Foo with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "foo") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Foo <- value |> (fun x -> System.Int32.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then + match this.Baz with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "baz") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Baz <- value |> (fun x -> System.Boolean.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if System.String.Equals (key, sprintf "--%s" "bar", System.StringComparison.OrdinalIgnoreCase) then + match this.Bar with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "bar") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Bar <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = + if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then + match this.Baz with + | Some _ -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "baz") + |> errors_.Add + + true + | None -> + this.Baz <- true |> Some + true + else + false + + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed UsernamePasswordAuth. + type internal UsernamePasswordAuth_InProgress = + { + mutable Password : string option + mutable Username : string option + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : string = + match this.Username with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "username") + Unchecked.defaultof<_> + + let arg1 : string = + match this.Password with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "password") + Unchecked.defaultof<_> + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + Username = arg0 + Password = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : UsernamePasswordAuth_InProgress = + { + Password = None + Username = 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. + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "username", System.StringComparison.OrdinalIgnoreCase) then + match this.Username with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "username") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Username <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if + System.String.Equals (key, sprintf "--%s" "password", System.StringComparison.OrdinalIgnoreCase) + then + match this.Password with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "password") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Password <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed TokenAuth. + type internal TokenAuth_InProgress = + { + mutable Token : string option + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : string = + match this.Token with + | Some result -> result + | None -> + errors.Add (sprintf "Required argument '--%s' received no value" "token") + Unchecked.defaultof<_> + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + Token = arg0 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : TokenAuth_InProgress = + { + Token = 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. + member this.ProcessKeyValueSelf_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "token", System.StringComparison.OrdinalIgnoreCase) then + match this.Token with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "token") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Token <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed AuthOptions. + type internal AuthOptions_InProgress = + { + Token : TokenAuth_InProgress + UsernamePassword : UsernamePasswordAuth_InProgress + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + failwith "TODO" + + static member _Empty () : AuthOptions_InProgress = + { + Token = TokenAuth_InProgress._Empty () + UsernamePassword = UsernamePasswordAuth_InProgress._Empty () + } + + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + + /// A partially-parsed DoTheThing. + type internal DoTheThing_InProgress = + { + mutable Auth : AuthOptions_InProgress + mutable Basics : BasicNoPositionals_InProgress + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () + + let arg0 : BasicNoPositionals = + match this.Basics.Assemble_ getEnvironmentVariable positionals with + | Ok (result, consumedPositional) -> + match consumedPositional with + | None -> () + | Some positionalConsumer -> positionalConsumers.Add positionalConsumer + + result + | Error err -> + errors.AddRange err + Unchecked.defaultof<_> + + let arg1 : AuthOptions = + match this.Auth.Assemble_ getEnvironmentVariable positionals with + | Ok (result, consumedPositional) -> + match consumedPositional with + | None -> () + | Some positionalConsumer -> positionalConsumers.Add positionalConsumer + + result + | Error err -> + errors.AddRange err + Unchecked.defaultof<_> + + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then + Ok ( + { + Basics = arg0 + Auth = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + errors |> Seq.toList |> Error + else + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + + static member _Empty () : DoTheThing_InProgress = + { + Basics = BasicNoPositionals_InProgress._Empty () + Auth = AuthOptions_InProgress._Empty () + } + + /// Passes the key-value pair to any child records, 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. + member this.ProcessKeyValueRecord_ + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + let errors : ResizeArray = ResizeArray () + + match this.Basics.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> Ok () + | Error e -> Error None + + member this.ProcessKeyValue + (argNum_ : int) + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueRecord_ argNum_ errors_ key value with + | Ok () -> Ok () + | Error errorFromRecord -> Error errorFromRecord + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" +namespace ConsumePlugin.ArgsWithUnions + +open ArgParserHelpers +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type DoTheThing +[] +module DoTheThing = + type internal ParseState_DoTheThing = + /// 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) (args : string list) : DoTheThing = + let inProgress = + ArgParseHelpers_ConsumePlugin_ArgsWithUnions.DoTheThing_InProgress._Empty () + + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (argNum_ : int) (state : ParseState_DoTheThing) (args : string list) = + match args with + | [] -> + match state with + | ParseState_DoTheThing.AwaitingKey -> () + | ParseState_DoTheThing.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_DoTheThing.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) + + if equals < 0 then + go (argNum_ + 1) (ParseState_DoTheThing.AwaitingValue arg) args + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_DoTheThing.AwaitingKey args + | Error x -> + match x with + | None -> + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_DoTheThing.AwaitingKey args + | Some msg -> + sprintf "%s (at arg %s)" msg arg |> errors_.Add + go (argNum_ + 1) ParseState_DoTheThing.AwaitingKey args + else + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_DoTheThing.AwaitingKey args + | ParseState_DoTheThing.AwaitingValue key -> + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_DoTheThing.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go argNum_ ParseState_DoTheThing.AwaitingKey (arg :: args) + else + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_DoTheThing.AwaitingKey (arg :: args) + + go 0 ParseState_DoTheThing.AwaitingKey args + + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith + else + result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + + let parse (args : string list) : DoTheThing = + parse' System.Environment.GetEnvironmentVariable args diff --git a/Playground/Domain.fs b/Playground/Domain.fs new file mode 100644 index 00000000..9a0b80de --- /dev/null +++ b/Playground/Domain.fs @@ -0,0 +1,47 @@ +namespace Playground + +open System +open WoofWare.Myriad.Plugins + +[] +type SubMode1 = + { + Info1 : int + Info2 : string + Rest : string list + } + +[] +type SubMode2 = + { + Info1 : int + Info2 : string + Rest : int list + } + +[] +type Mode1 = + { + Things : SubMode1 + Whatnot : int + } + +[] +type Mode2 = + { + Things : SubMode2 + Whatnot : DateTime + } + +[] +type Modes = + | Mode1 of Mode1 + | Mode2 of Mode2 + +[] +type Args = + { + WhatToDo : Modes + [] + OtherArgs : string list + } diff --git a/Playground/Library.fs b/Playground/Library.fs new file mode 100644 index 00000000..3951abda --- /dev/null +++ b/Playground/Library.fs @@ -0,0 +1,563 @@ +//------------------------------------------------------------------------------ +// This code was generated by myriad. +// Changes to this file will be lost when the code is regenerated. +//------------------------------------------------------------------------------ + +namespace Playground // Assuming a namespace + +open System +open System.IO +open WoofWare.Myriad.Plugins // Assuming attributes are here + +// Assume original type definitions are accessible here +// [] type SubMode1 = { Info1 : int; Info2 : string; Rest : string list } +// [] type SubMode2 = { Info1 : int; Info2 : string; Rest : int list } +// [] type Mode1 = { Things : SubMode1; Whatnot : int } +// [] type Mode2 = { Things : SubMode2; Whatnot : DateTime } +// [] type Modes = | Mode1 of Mode1 | Mode2 of Mode2 +// [] type Args = { WhatToDo : Modes; [] OtherArgs : string list } + + +/// Methods to parse arguments for the type Args +[] +module Args = + + //-------------------------------------------------------------------------- + // Internal state definitions (Non-Flattened with combined Assemble/Validate) + //-------------------------------------------------------------------------- + + /// State representing the parse progress for SubMode1 record + type private State_SubMode1 = + { + mutable Info1 : int option + mutable Info2 : string option + Rest : ResizeArray // Corresponds to --rest + } + + static member Create () = + { + Info1 = None + Info2 = None + Rest = ResizeArray () + } + + /// Check completeness and assemble the SubMode1 record from state. + member this.Assemble () : Result = + let errors = ResizeArray () + let mutable complete = true + + if this.Info1.IsNone then + complete <- false + errors.Add ("Argument '--info1' is required.") + + if this.Info2.IsNone then + complete <- false + errors.Add ("Argument '--info2' is required.") + // Rest is list, always 'complete' + + if complete then + Ok + { + Info1 = this.Info1.Value + Info2 = this.Info2.Value + Rest = this.Rest |> Seq.toList + } + else + Error (errors |> Seq.toList) + + /// State representing the parse progress for SubMode2 record + type private State_SubMode2 = + { + mutable Info1 : int option + mutable Info2 : string option + Rest : ResizeArray // Corresponds to --rest + } + + static member Create () = + { + Info1 = None + Info2 = None + Rest = ResizeArray () + } + + /// Check completeness and assemble the SubMode2 record from state. + member this.Assemble () : Result = + let errors = ResizeArray () + + if this.Info1.IsNone then + errors.Add ("Argument '--info1' is required.") + + if this.Info2.IsNone then + errors.Add ("Argument '--info2' is required.") + // Rest is list, always 'complete' + + if errors.Count = 0 then + Ok + { + Info1 = this.Info1.Value + Info2 = this.Info2.Value + Rest = this.Rest |> Seq.toList + } + else + Error (errors |> Seq.toList) + + + /// State representing the parse progress for Mode1 record (references SubMode1 state) + type private State_Mode1 = + { + ThingsState : State_SubMode1 // Holds state for the nested record + mutable Whatnot : int option + } + + static member Create () = + { + ThingsState = State_SubMode1.Create () + Whatnot = None + } + + /// Check completeness and assemble the Mode1 record from state (including nested). + member this.Assemble () : Result = + let errors = ResizeArray () + + // Check direct fields + if this.Whatnot.IsNone then + errors.Add ("Argument '--whatnot' is required for Mode1.") + + // Assemble nested state (which includes its own validation) + let thingsResult = this.ThingsState.Assemble () + let mutable thingsValue = None + + match thingsResult with + | Ok v -> thingsValue <- Some v + | Error nestedErrors -> errors.AddRange (nestedErrors |> List.map (sprintf "Things: %s")) // Add context + + if errors.Count = 0 then + Ok + { + Things = thingsValue.Value + Whatnot = this.Whatnot.Value + } + else + Error (errors |> Seq.toList) + + + /// State representing the parse progress for Mode2 record (references SubMode2 state) + type private State_Mode2 = + { + ThingsState : State_SubMode2 // Holds state for the nested record + mutable Whatnot : DateTime option + } + + static member Create () = + { + ThingsState = State_SubMode2.Create () + Whatnot = None + } + + /// Check completeness and assemble the Mode2 record from state (including nested). + member this.Assemble () : Result = + let errors = ResizeArray () + + // Check direct fields + if this.Whatnot.IsNone then + errors.Add ("Argument '--whatnot' is required for Mode2.") + + // Assemble nested state (which includes its own validation) + let thingsResult = this.ThingsState.Assemble () + let mutable thingsValue = Unchecked.defaultof<_> + + match thingsResult with + | Ok v -> thingsValue <- v + | Error nestedErrors -> errors.AddRange (nestedErrors |> List.map (sprintf "Things: %s")) // Add context + + if errors.Count = 0 then + { + Things = thingsValue + Whatnot = this.Whatnot.Value + } + |> Ok + else + Error (errors |> Seq.toList) + + + /// State for a single candidate parse path for the Modes DU (Structure unchanged) + type private CandidateParseState_Modes = + { + CaseName : string // "Mode1" or "Mode2" + mutable IsViable : bool + Errors : ResizeArray // Errors specific to this candidate's path + ConsumedArgIndices : System.Collections.Generic.HashSet // Indices consumed *by this candidate* + CaseState : obj // Holds either State_Mode1 or State_Mode2 + } + + static member CreateMode1 () = + { + CaseName = "Mode1" + IsViable = true + Errors = ResizeArray () + ConsumedArgIndices = System.Collections.Generic.HashSet () + CaseState = State_Mode1.Create () :> obj + } + + static member CreateMode2 () = + { + CaseName = "Mode2" + IsViable = true + Errors = ResizeArray () + ConsumedArgIndices = System.Collections.Generic.HashSet () + CaseState = State_Mode2.Create () :> obj + } + + //-------------------------------------------------------------------------- + // Main Parser Logic + //-------------------------------------------------------------------------- + + type private ParseState_Args = + | AwaitingArg + | AwaitingValue of keyIndex : int * key : string + + let parse' (getEnvironmentVariable : string -> string) (args : string list) : Args = + let ArgParser_errors = ResizeArray () // Global errors accumulator + + let helpText () = + // Help text generation unchanged + [ + (sprintf "%s int32%s%s" (sprintf "--%s" "info1") "" " (for Mode1/Mode2 Things)") + (sprintf "%s string%s%s" (sprintf "--%s" "info2") "" " (for Mode1/Mode2 Things)") + (sprintf "%s string%s%s" (sprintf "--%s" "rest") " (can be repeated)" " (for Mode1 Things)") + (sprintf "%s int32%s%s" (sprintf "--%s" "rest") " (can be repeated)" " (for Mode2 Things)") + (sprintf "%s int32%s%s" (sprintf "--%s" "whatnot") "" " (for Mode1)") + (sprintf "%s DateTime%s%s" (sprintf "--%s" "whatnot") "" " (for Mode2)") + (sprintf "%s string%s%s" (sprintf "--%s" "other-args") " (positional args) (can be repeated)" "") + ] + |> String.concat "\n" + + let arg_OtherArgs : string ResizeArray = ResizeArray () + + let mutable candidates_WhatToDo : CandidateParseState_Modes list = + [ + CandidateParseState_Modes.CreateMode1 () + CandidateParseState_Modes.CreateMode2 () + ] + + let consumedArgIndices_WhatToDo = System.Collections.Generic.HashSet () + + //---------------------------------------------------------------------- + // Helper functions for applying args (applyKeyValueToSubModeXState unchanged) + //---------------------------------------------------------------------- + let applyKeyValueToSubMode1State + (argIndex : int) + (keyIndex : int) + (key : string) + (value : string) + (subState : State_SubMode1) + (candidate : CandidateParseState_Modes) + : unit + = + // ... (Implementation identical to previous version) ... + if String.Equals (key, "--info1", StringComparison.OrdinalIgnoreCase) then + match subState.Info1 with + | Some _ -> + candidate.Errors.Add (sprintf "Argument '--info1' supplied multiple times (SubMode1)") + candidate.IsViable <- false + | None -> + try + subState.Info1 <- Some (Int32.Parse value) + candidate.ConsumedArgIndices.Add argIndex |> ignore + candidate.ConsumedArgIndices.Add keyIndex |> ignore + with ex -> + candidate.Errors.Add ( + sprintf "Failed to parse '%s' for --info1 (SubMode1): %s" value ex.Message + ) + + candidate.IsViable <- false + elif String.Equals (key, "--info2", StringComparison.OrdinalIgnoreCase) then + match subState.Info2 with + | Some _ -> + candidate.Errors.Add (sprintf "Argument '--info2' supplied multiple times (SubMode1)") + candidate.IsViable <- false + | None -> + subState.Info2 <- Some value + candidate.ConsumedArgIndices.Add argIndex |> ignore + candidate.ConsumedArgIndices.Add keyIndex |> ignore + elif String.Equals (key, "--rest", StringComparison.OrdinalIgnoreCase) then + subState.Rest.Add value + candidate.ConsumedArgIndices.Add argIndex |> ignore + candidate.ConsumedArgIndices.Add keyIndex |> ignore + else + () + + let applyKeyValueToSubMode2State + (argIndex : int) + (keyIndex : int) + (key : string) + (value : string) + (subState : State_SubMode2) + (candidate : CandidateParseState_Modes) + : unit + = + // ... (Implementation identical to previous version) ... + if String.Equals (key, "--info1", StringComparison.OrdinalIgnoreCase) then + match subState.Info1 with + | Some _ -> + candidate.Errors.Add (sprintf "Argument '--info1' supplied multiple times (SubMode2)") + candidate.IsViable <- false + | None -> + try + subState.Info1 <- Some (Int32.Parse value) + candidate.ConsumedArgIndices.Add argIndex |> ignore + candidate.ConsumedArgIndices.Add keyIndex |> ignore + with ex -> + candidate.Errors.Add ( + sprintf "Failed to parse '%s' for --info1 (SubMode2): %s" value ex.Message + ) + + candidate.IsViable <- false + elif String.Equals (key, "--info2", StringComparison.OrdinalIgnoreCase) then + match subState.Info2 with + | Some _ -> + candidate.Errors.Add (sprintf "Argument '--info2' supplied multiple times (SubMode2)") + candidate.IsViable <- false + | None -> + subState.Info2 <- Some value + candidate.ConsumedArgIndices.Add argIndex |> ignore + candidate.ConsumedArgIndices.Add keyIndex |> ignore + elif String.Equals (key, "--rest", StringComparison.OrdinalIgnoreCase) then + try + subState.Rest.Add (Int32.Parse value) + candidate.ConsumedArgIndices.Add argIndex |> ignore + candidate.ConsumedArgIndices.Add keyIndex |> ignore + with ex -> + candidate.Errors.Add ( + sprintf "Failed to parse '%s' as int32 for --rest (SubMode2): %s" value ex.Message + ) + + candidate.IsViable <- false + else + () + + //---------------------------------------------------------------------- + // Routing and Main Application Logic (applyKeyValueToCandidate unchanged) + //---------------------------------------------------------------------- + let applyKeyValueToCandidate + (argIndex : int, keyIndex : int, key : string, value : string) + (candidate : CandidateParseState_Modes) + : unit + = + // ... (Implementation identical to previous version, calling sub-state helpers) ... + if not candidate.IsViable then + () + else + + match candidate.CaseName with + | "Mode1" -> + let state = candidate.CaseState :?> State_Mode1 + + if String.Equals (key, "--whatnot", StringComparison.OrdinalIgnoreCase) then + match state.Whatnot with + | Some _ -> + candidate.Errors.Add ( + sprintf "Argument '--whatnot' supplied multiple times for Mode1 candidate" + ) + + candidate.IsViable <- false + | None -> + try + state.Whatnot <- Some (Int32.Parse value) + candidate.ConsumedArgIndices.Add argIndex |> ignore + candidate.ConsumedArgIndices.Add keyIndex |> ignore + with ex -> + candidate.Errors.Add ( + sprintf "Failed to parse '%s' as int32 for --whatnot (Mode1): %s" value ex.Message + ) + + candidate.IsViable <- false + elif key = "--info1" || key = "--info2" || key = "--rest" then + applyKeyValueToSubMode1State argIndex keyIndex key value state.ThingsState candidate + else + () + | "Mode2" -> + let state = candidate.CaseState :?> State_Mode2 + + if String.Equals (key, "--whatnot", StringComparison.OrdinalIgnoreCase) then + match state.Whatnot with + | Some _ -> + candidate.Errors.Add ( + sprintf "Argument '--whatnot' supplied multiple times for Mode2 candidate" + ) + + candidate.IsViable <- false + | None -> + try + state.Whatnot <- Some (DateTime.Parse value) + candidate.ConsumedArgIndices.Add argIndex |> ignore + candidate.ConsumedArgIndices.Add keyIndex |> ignore + with ex -> + candidate.Errors.Add ( + sprintf "Failed to parse '%s' as DateTime for --whatnot (Mode2): %s" value ex.Message + ) + + candidate.IsViable <- false + elif key = "--info1" || key = "--info2" || key = "--rest" then + applyKeyValueToSubMode2State argIndex keyIndex key value state.ThingsState candidate + else + () + | _ -> failwith "Internal error: Unknown case name" + + // processKeyValue, setFlagValue, and main loop `go` are identical to previous version + let processKeyValue (keyIndex : int, key : string, valueIndex : int, value : string) : bool = + let mutable handled = false + + for candidate in candidates_WhatToDo do + let initialConsumedCount = candidate.ConsumedArgIndices.Count + + if candidate.IsViable then + applyKeyValueToCandidate (valueIndex, keyIndex, key, value) candidate + + if candidate.IsViable && candidate.ConsumedArgIndices.Count > initialConsumedCount then + handled <- true + consumedArgIndices_WhatToDo.Add keyIndex |> ignore + consumedArgIndices_WhatToDo.Add valueIndex |> ignore + + handled + + let setFlagValue (keyIndex : int) (key : string) : bool = false // No flags + + let rec go (state : ParseState_Args) (args : (int * string) list) = + // ... (Implementation identical to previous version) ... + match args with + | [] -> + match state with + | ParseState_Args.AwaitingArg -> () + | ParseState_Args.AwaitingValue (i, k) -> + if not (setFlagValue i k) then + ArgParser_errors.Add (sprintf "Trailing argument '%s' (at index %d) requires a value." k i) + | (idx, arg) :: rest -> + match state with + | ParseState_Args.AwaitingArg -> + if arg = "--" then + rest + |> List.iter (fun (i, v) -> + if not (consumedArgIndices_WhatToDo.Contains i) then + arg_OtherArgs.Add v + ) + + go ParseState_Args.AwaitingArg [] + elif arg.StartsWith ("--") then + if arg = "--help" then + helpText () |> failwithf "Help text requested:\n%s" + else + let eq = arg.IndexOf ('=') + + if eq > 0 then + let k = arg.[.. eq - 1] + let v = arg.[eq + 1 ..] + + if not (processKeyValue (idx, k, idx, v)) then + if not (consumedArgIndices_WhatToDo.Contains idx) then + arg_OtherArgs.Add arg + + go ParseState_Args.AwaitingArg rest + elif setFlagValue idx arg then + consumedArgIndices_WhatToDo.Add idx |> ignore + go ParseState_Args.AwaitingArg rest + else + go (ParseState_Args.AwaitingValue (idx, arg)) rest + else + if not (consumedArgIndices_WhatToDo.Contains idx) then + arg_OtherArgs.Add arg + + go ParseState_Args.AwaitingArg rest + | ParseState_Args.AwaitingValue (keyIdx, key) -> + if processKeyValue (keyIdx, key, idx, arg) then + go ParseState_Args.AwaitingArg rest + elif setFlagValue keyIdx key then + consumedArgIndices_WhatToDo.Add keyIdx |> ignore + go ParseState_Args.AwaitingArg ((idx, arg) :: rest) // Reprocess arg + elif not (consumedArgIndices_WhatToDo.Contains keyIdx) then + arg_OtherArgs.Add key + + if not (consumedArgIndices_WhatToDo.Contains idx) then + arg_OtherArgs.Add arg + + go ParseState_Args.AwaitingArg rest + + args |> List.mapi (fun i s -> (i, s)) |> go ParseState_Args.AwaitingArg + + //---------------------------------------------------------------------- + // Final Validation and Assembly (Uses new Assemble methods) + //---------------------------------------------------------------------- + let viableWinners = candidates_WhatToDo |> List.filter (fun c -> c.IsViable) + // No longer filter based on IsComplete here; Assemble handles it. + // Still need to check for relative leftovers if that logic were implemented. + + let whatToDoResult = + match viableWinners with + | [] -> + // Add specific errors from candidates that were viable *before* Assemble check + ArgParser_errors.Add ("No valid parse found for 'WhatToDo'.") + + candidates_WhatToDo + |> List.iter (fun c -> + if c.Errors.Count <> 0 then + ArgParser_errors.Add ( + sprintf " Candidate %s parse errors: %s" c.CaseName (String.concat "; " c.Errors) + ) + // Potentially try to Assemble even non-viable ones to get completion errors? Maybe too complex. + ) + + Unchecked.defaultof<_> // Error path + + | [ winner ] -> + // Assemble the winning case, checking the Result for completion errors + match winner.CaseName with + | "Mode1" -> + match (winner.CaseState :?> State_Mode1).Assemble () with + | Ok mode1Value -> Modes.Mode1 mode1Value + | Error completionErrors -> + ArgParser_errors.Add (sprintf "Validation failed for selected candidate Mode1:") + ArgParser_errors.AddRange completionErrors + Unchecked.defaultof<_> // Error path + | "Mode2" -> + match (winner.CaseState :?> State_Mode2).Assemble () with + | Ok mode2Value -> Modes.Mode2 mode2Value + | Error completionErrors -> + ArgParser_errors.Add (sprintf "Validation failed for selected candidate Mode2:") + ArgParser_errors.AddRange completionErrors + Unchecked.defaultof<_> // Error path + | _ -> failwith "Internal error: Unknown winning case name" + + | winners -> // Ambiguous parse + ArgParser_errors.Add ("Ambiguous parse for 'WhatToDo'. Multiple modes potentially viable:") + + winners + |> List.iter (fun c -> + ArgParser_errors.Add ( + sprintf + " - %s (Initial Errors: %s)" + c.CaseName + (if c.Errors.Count = 0 then + "None" + else + String.concat "; " c.Errors) + ) + ) + + Unchecked.defaultof<_> // Error path + + // Finalize OtherArgs (unchanged) + let otherArgsResult = arg_OtherArgs |> Seq.toList + + // Assemble Final Result or Fail (unchanged) + if ArgParser_errors.Count > 0 then + ArgParser_errors + |> String.concat "\n" + |> failwithf "Errors during parse!\n%s\n\nHelp Text:\n%s" (helpText ()) + else + { + WhatToDo = whatToDoResult + OtherArgs = otherArgsResult + } + + let parse (args : string list) : Args = + parse' System.Environment.GetEnvironmentVariable args diff --git a/Playground/Playground.fsproj b/Playground/Playground.fsproj new file mode 100644 index 00000000..cddb718b --- /dev/null +++ b/Playground/Playground.fsproj @@ -0,0 +1,19 @@ + + + + net9.0 + true + Exe + + + + + + + + + + + + + diff --git a/Playground/Program.fs b/Playground/Program.fs new file mode 100644 index 00000000..81255ece --- /dev/null +++ b/Playground/Program.fs @@ -0,0 +1,10 @@ +namespace Playground + +module Program = + [] + let main argv = + [ "--whatnot=2024-01-12" ; "--info1=4" ; "--info2=hi" ] + |> Args.parse + |> printfn "%O" + + 0 diff --git a/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs b/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs index 5b2b4d0b..e6a53755 100644 --- a/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs +++ b/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs @@ -79,11 +79,8 @@ module TestArgParser = exc.Message |> shouldEqual - """Unable to process supplied arg --non-existent. Help text follows. ---foo int32 : This is a foo! ---bar string ---baz bool ---rest string (positional args) (can be repeated) : Here's where the rest of the args go""" + """Errors during parse! +Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--rest=` syntax, or place them after a trailing `--`. --non-existent""" [] let ``Can supply positional args with key`` () = @@ -318,8 +315,7 @@ Required argument '--baz' received no value""" exc.Message |> shouldEqual """Errors during parse! -Input string was not in a correct format. (at arg --invariant-exact=23:59) -Required argument '--invariant-exact' received no value""" +Input string was not in a correct format. (at arg --invariant-exact=23:59)""" let exc = Assert.Throws (fun () -> @@ -337,8 +333,7 @@ Required argument '--invariant-exact' received no value""" exc.Message |> shouldEqual """Errors during parse! -Input string was not in a correct format. (at arg --exact=11:34) -Required argument '--exact' received no value""" +Input string was not in a correct format. (at arg --exact=11:34)""" count.Value |> shouldEqual 0 @@ -444,7 +439,7 @@ Required argument '--exact' received no value""" ] |> List.map TestCaseData - [] + [] let ``Bool env vars can be populated`` (envValue : string, boolValue : bool) = let getEnvVar (s : string) = s |> shouldEqual "CONSUMEPLUGIN_THINGS" @@ -604,7 +599,10 @@ Required argument '--exact' received no value""" ) exc.Message - |> shouldEqual """Unable to process argument --do-the-thing=foo as key --do-the-thing and value foo""" + |> shouldEqual + """Errors during parse! +Required argument '--do-something-else' received no value +Required argument '--turn-it-on' received no value""" [] let ``Long-form args help text`` () = @@ -692,7 +690,9 @@ Required argument '--exact' received no value""" ) exc.Message - |> shouldEqual """Unable to process argument --b=false as key --b and value false""" + |> shouldEqual + """Errors during parse! +Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--dont-grab-everything=` syntax, or place them after a trailing `--`. --b=false --c""" let exc = Assert.Throws (fun () -> @@ -703,4 +703,6 @@ Required argument '--exact' received no value""" // 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""" + |> shouldEqual + """Errors during parse! +Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. --c=hi""" diff --git a/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgsWithUnions.fs b/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgsWithUnions.fs new file mode 100644 index 00000000..6de2abf2 --- /dev/null +++ b/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgsWithUnions.fs @@ -0,0 +1,21 @@ +namespace WoofWare.Myriad.Plugins.Test + +open FsUnitTyped +open NUnit.Framework +open ConsumePlugin.ArgsWithUnions + +[] +module TestArgsWithUnions = + + let argsWithUnionsCases = + [ + ["--token" ; "hello" ; "--foo" ; "3" ; "--bar=hi" ; "--baz"], { Auth = AuthOptions.Token { Token = "hello" } ; Basics = { Foo = 3 ; Bar = "hi" ; Baz = true ; Rest = [] } } + ] + |> List.map TestCaseData + + [] + let ``foo`` (args : string list, expected : DoTheThing) : unit = + args + |> DoTheThing.parse' (fun _ -> failwith "didn't expect env var") + |> shouldEqual expected + diff --git a/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj b/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj index c8f6a616..faff7035 100644 --- a/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj +++ b/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj @@ -13,6 +13,7 @@ + + + diff --git a/WoofWare.Myriad.Plugins/ArgParserGenerator.fs b/WoofWare.Myriad.Plugins/ArgParserGenerator.fs index fb33747d..dd075d0f 100644 --- a/WoofWare.Myriad.Plugins/ArgParserGenerator.fs +++ b/WoofWare.Myriad.Plugins/ArgParserGenerator.fs @@ -7,82 +7,6 @@ open Fantomas.FCS.Text.Range open TypeEquality open WoofWare.Whippet.Fantomas -type internal ArgParserOutputSpec = - { - ExtensionMethods : bool - } - -type internal FlagDu = - { - Name : Ident - Case1Name : Ident - Case2Name : Ident - /// Hopefully this is simply the const bool True or False, but it might e.g. be a literal - Case1Arg : SynExpr - /// Hopefully this is simply the const bool True or False, but it might e.g. be a literal - Case2Arg : SynExpr - } - - static member FromBoolean (flagDu : FlagDu) (value : SynExpr) = - SynExpr.ifThenElse - (SynExpr.equals value flagDu.Case1Arg) - (SynExpr.createLongIdent' [ flagDu.Name ; flagDu.Case2Name ]) - (SynExpr.createLongIdent' [ flagDu.Name ; flagDu.Case1Name ]) - -/// The default value of an argument which admits default values can be pulled from different sources. -/// This defines which source a particular default value comes from. -type private ArgumentDefaultSpec = - /// From parsing the environment variable with the given name (e.g. "WOOFWARE_DISABLE_FOO" or whatever). - | EnvironmentVariable of name : SynExpr - /// From calling the static member `{typeWeParseInto}.Default{name}()` - /// For example, if `type MyArgs = { Thing : Choice }`, then - /// we would use `MyArgs.DefaultThing () : int`. - /// - | FunctionCall of name : Ident - -type private Accumulation<'choice> = - | Required - | Optional - | Choice of 'choice - | List of Accumulation<'choice> - -type private ParseFunction<'acc> = - { - FieldName : Ident - TargetVariable : Ident - /// Any of the forms in this set are acceptable, but make sure they all start with a dash, or we might - /// get confused with positional args or something! I haven't thought that hard about this. - /// In the default case, this is `Const("arg-name")` for the `ArgName : blah` field; note that we have - /// omitted the initial `--` that will be required at runtime. - ArgForm : SynExpr list - /// If this is a boolean-like field (e.g. a bool or a flag DU), the help text should look a bit different: - /// we should lie to the user about the value of the cases there. - /// Similarly, if we're reading from an environment variable with the laxer parsing rules of accepting e.g. - /// "0" instead of "false", we need to know if we're reading a bool. - /// In that case, `boolCases` is Some, and contains the construction of the flag (or boolean, in which case - /// you get no data). - BoolCases : Choice option - Help : SynExpr option - /// A function string -> %TargetType%, where TargetVariable is probably a `%TargetType% option`. - /// (Depending on `Accumulation`, we'll remove the `option` at the end of the parse, asserting that the - /// argument was supplied.) - /// This is allowed to throw if it fails to parse. - Parser : SynExpr - /// If `Accumulation` is `List`, then this is the type of the list *element*; analogously for optionals - /// and choices and so on. - TargetType : SynType - Accumulation : 'acc - } - - /// A SynExpr of type `string` which we can display to the user at generated-program runtime to display all - /// the ways they can refer to this arg. - member arg.HumanReadableArgForm : SynExpr = - let formatString = List.replicate arg.ArgForm.Length "--%s" |> String.concat " / " - - (SynExpr.applyFunction (SynExpr.createIdent "sprintf") (SynExpr.CreateConst formatString), arg.ArgForm) - ||> List.fold SynExpr.applyFunction - |> SynExpr.paren - [] type private ChoicePositional = | Normal of includeFlagLike : SynExpr option @@ -114,14 +38,14 @@ type private ParseTree<'hasPositional> = /// `assemble` takes the SynExpr's (e.g. each record field contents) corresponding to each `Ident` in /// the branch (e.g. each record field name), /// and composes them into a `SynExpr` (e.g. the record-typed object). - | Branch of + | DescendRecord of fields : (Ident * ParseTree) list * assemble : (Map -> SynExpr) * Teq<'hasPositional, HasNoPositional> /// `assemble` takes the SynExpr's (e.g. each record field contents) corresponding to each `Ident` in /// the branch (e.g. each record field name), /// and composes them into a `SynExpr` (e.g. the record-typed object). - | BranchPos of + | DescendRecordPos of posField : Ident * fields : ParseTree * (Ident * ParseTree) list * @@ -184,63 +108,6 @@ module private ParseTree = go None ([], None) subs - let rec accumulatorsNonPos (tree : ParseTree) : ParseFunctionNonPositional list = - match tree with - | ParseTree.PositionalLeaf (_, teq) -> exFalso teq - | ParseTree.BranchPos (_, _, _, _, teq) -> exFalso teq - | ParseTree.NonPositionalLeaf (pf, _) -> [ pf ] - | ParseTree.Branch (trees, _, _) -> trees |> List.collect (snd >> accumulatorsNonPos) - - /// Returns the positional arg separately. - let rec accumulatorsPos - (tree : ParseTree) - : ParseFunctionNonPositional list * ParseFunctionPositional - = - match tree with - | ParseTree.PositionalLeaf (pf, _) -> [], pf - | ParseTree.NonPositionalLeaf (_, teq) -> exFalso' teq - | ParseTree.Branch (_, _, teq) -> exFalso' teq - | ParseTree.BranchPos (_, tree, trees, _, _) -> - let nonPos = trees |> List.collect (snd >> accumulatorsNonPos) - - let nonPos2, pos = accumulatorsPos tree - nonPos @ nonPos2, pos - - /// Collect all the ParseFunctions which are necessary to define variables, throwing away - /// all information relevant to composing the resulting variables into records. - /// Returns the list of non-positional parsers, and any positional parser that exists. - let accumulators<'a> (tree : ParseTree<'a>) : ParseFunctionNonPositional list * ParseFunctionPositional option = - // Sad duplication of some code here, but it was the easiest way to make it type-safe :( - match tree with - | ParseTree.PositionalLeaf (pf, _) -> [], Some pf - | ParseTree.NonPositionalLeaf (pf, _) -> [ pf ], None - | ParseTree.Branch (trees, _, _) -> trees |> List.collect (snd >> accumulatorsNonPos) |> (fun i -> i, None) - | ParseTree.BranchPos (_, tree, trees, _, _) -> - let nonPos = trees |> List.collect (snd >> accumulatorsNonPos) - - let nonPos2, pos = accumulatorsPos tree - nonPos @ nonPos2, Some pos - - |> fun (nonPos, pos) -> - let duplicateArgs = - // This is best-effort. We can't necessarily detect all SynExprs here, but usually it'll be strings. - Option.toList (pos |> Option.map _.ArgForm) @ (nonPos |> List.map _.ArgForm) - |> Seq.concat - |> Seq.choose (fun expr -> - match expr |> SynExpr.stripOptionalParen with - | SynExpr.Const (SynConst.String (s, _, _), _) -> Some s - | _ -> None - ) - |> List.ofSeq - |> List.groupBy id - |> List.choose (fun (key, v) -> if v.Length > 1 then Some key else None) - - match duplicateArgs with - | [] -> nonPos, pos - | dups -> - let dups = dups |> String.concat " " - failwith $"Duplicate args detected! %s{dups}" - /// Build the return value. let rec instantiate<'a> (tree : ParseTree<'a>) : SynExpr = match tree with diff --git a/WoofWare.Myriad.Plugins/List.fs b/WoofWare.Myriad.Plugins/List.fs index c87de053..02d62f46 100644 --- a/WoofWare.Myriad.Plugins/List.fs +++ b/WoofWare.Myriad.Plugins/List.fs @@ -21,3 +21,13 @@ module private List = | Some head :: tail -> go (head :: acc) tail go [] l + + /// Return the first error encountered, or the entire list. + let allOkOrError<'ok, 'err> (l : Result<'ok, 'err> list) : Result<'ok list, 'err> = + let rec go acc l = + match l with + | [] -> Ok (List.rev acc) + | Error e :: _ -> Error e + | Ok o :: rest -> go (o :: acc) rest + + go [] l diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs new file mode 100644 index 00000000..fb636d98 --- /dev/null +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -0,0 +1,2659 @@ +namespace WoofWare.Myriad.Plugins + +open System +open System.Collections.Generic +open System.Text +open Fantomas.FCS.Syntax +open Fantomas.FCS.Text.Range +open WoofWare.Myriad.Plugins +open WoofWare.Whippet.Fantomas + +type internal ArgParserOutputSpec = + { + ExtensionMethods : bool + } + +type internal FlagDu = + { + Name : Ident + Case1Name : Ident + Case2Name : Ident + /// Hopefully this is simply the const bool True or False, but it might e.g. be a literal + Case1Arg : SynExpr + /// Hopefully this is simply the const bool True or False, but it might e.g. be a literal + Case2Arg : SynExpr + } + + static member FromBoolean (flagDu : FlagDu) (value : SynExpr) = + SynExpr.ifThenElse + (SynExpr.equals value flagDu.Case1Arg) + (SynExpr.createLongIdent' [ flagDu.Name ; flagDu.Case2Name ]) + (SynExpr.createLongIdent' [ flagDu.Name ; flagDu.Case1Name ]) + +/// The default value of an argument which admits default values can be pulled from different sources. +/// This defines which source a particular default value comes from. +type internal ArgumentDefaultSpec = + /// From parsing the environment variable with the given name (e.g. "WOOFWARE_DISABLE_FOO" or whatever). + | EnvironmentVariable of name : SynExpr + /// From calling the static member `{typeWeParseInto}.Default{name}()` + /// For example, if `type MyArgs = { Thing : Choice }`, then + /// we would use `MyArgs.DefaultThing () : int`. + | FunctionCall of name : Ident + +type internal Accumulation<'choice> = + | Required + | Optional + | Choice of 'choice + | ChoicePositional of attrContents : SynExpr option + | List of Accumulation<'choice> + +module internal ShibaGenerator = + //let log (s : string) = System.IO.File.AppendAllText ("/tmp/myriad.log", s + "\n") + let private choice1Of2 = SynExpr.createIdent "Choice1Of2" + let private choice2Of2 = SynExpr.createIdent "Choice2Of2" + + let private defaultOf = + SynExpr.typeApp [ SynType.anon ] (SynExpr.createLongIdent [ "Unchecked" ; "defaultof" ]) + + type RecognisedType = + | Union of UnionType + | Record of RecordType + + member this.Name : Ident = + match this with + | Union unionType -> unionType.Name + | Record recordType -> recordType.Name + + let private identifyAsFlag (flagDus : FlagDu list) (ty : SynType) : FlagDu option = + match ty with + | SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) -> + flagDus + |> List.tryPick (fun du -> + let duName = du.Name.idText + let ident = List.last(ident).idText + if duName = ident then Some du else None + ) + | _ -> None + + /// Convert e.g. "Foo" into "--foo". + let argify (ident : Ident) : string = + let result = StringBuilder () + + for c in ident.idText do + if Char.IsUpper c then + result.Append('-').Append (Char.ToLowerInvariant c) |> ignore + else + result.Append c |> ignore + + result.ToString().TrimStart '-' + + /// Expects `e` to be a string; calls `e.StartsWith("--", StringComparison.Ordinal)`. + let startsWithDashes (e : SynExpr) : SynExpr = + e + |> SynExpr.callMethodArg + "StartsWith" + (SynExpr.tuple + [ + SynExpr.CreateConst "--" + SynExpr.createLongIdent [ "System" ; "StringComparison" ; "Ordinal" ] + ]) + + type LeafData<'choice> = + { + /// Call this function to turn the input into the `TypeAfterParse`. + /// For example, `--foo=3` would have TypeAfterParse of `int`, and + /// `ParseFn` would be a function `string -> int`. + ParseFn : SynExpr + /// The type of this field, as it will appear in the final user's record. + TypeAfterParse : SynType + /// Essentially, how many times this leaf is expected to appear. + Acc : Accumulation<'choice> + /// `None` if not positional. `Some None` if positional and the PositionalArgs attribute had no contents. + /// `Some Some` if the PositionalArgs attribute had an argument. + Positional : SynExpr option option + /// Any of the forms in this set are acceptable, but make sure they all start with a dash, or we might + /// get confused with positional args or something! I haven't thought that hard about this. + /// In the default case, this is `Const("arg-name")` for the `ArgName : blah` field; note that we have + /// omitted the initial `--` that will be required at runtime. + ArgForm : SynExpr list + /// Name of the field of the in-progress record storing this leaf. + TargetConstructionField : Ident + /// If this is a boolean-like field (e.g. a bool or a flag DU), the help text should look a bit different: + /// we should lie to the user about the value of the cases there. + /// Similarly, if we're reading from an environment variable with the laxer parsing rules of accepting e.g. + /// "0" instead of "false", we need to know if we're reading a bool. + /// In that case, `boolCases` is Some, and contains the construction of the flag (or boolean, in which case + /// you get no data). + BoolCases : Choice option + } + + /// A SynExpr of type `string` which we can display to the user at generated-program runtime to display all + /// the ways they can refer to this arg. + member arg.HumanReadableArgForm : SynExpr = + let formatString = List.replicate arg.ArgForm.Length "--%s" |> String.concat " / " + + (SynExpr.applyFunction (SynExpr.createIdent "sprintf") (SynExpr.CreateConst formatString), arg.ArgForm) + ||> List.fold SynExpr.applyFunction + |> SynExpr.paren + + type private ParseFunctionSpec<'choice> = + /// A leaf node, e.g. `--foo=3`. + | Leaf of LeafData<'choice> + /// An opaque node we didn't recognise: e.g. `Foo : SomeType`. + /// We're probably going to stamp out an "in-progress" type for this node. + /// (Either that, or it's just a type we don't recognise, and then compilation will fail.) + | UserDefined of isRecord : bool * typeName : Ident + /// An optional opaque node we didn't recognise: e.g. `Foo : SomeType option`. + /// We're probably going to stamp out an "in-progress" type for this node. + /// (Either that, or it's just a type we don't recognise, and then compilation will fail.) + | OptionOfUserDefined + + /// Builds a function or lambda of one string argument, which returns a `ty` (as modified by the `Accumulation`; + /// for example, maybe it returns a `ty option` or a `ty list`). + /// The resulting SynType, if you get one, is the type of the *element* being parsed; so if the Accumulation is List, the SynType + /// is the list element. + /// + /// This may fail, e.g. if we haven't yet parsed the types on which we depend. + let rec private createParseFunction<'choice> + (choice : ArgumentDefaultSpec option -> 'choice) + (flagDus : FlagDu list) + (userDefinedRecordTypesWithParser : IEnumerable) + (userDefinedUnionTypesWithParser : IEnumerable) + (fieldName : Ident) + (attrs : SynAttribute list) + (ty : SynType) + : Result, string> + = + let positional = + attrs + |> List.tryPick (fun a -> + match (List.last a.TypeName.LongIdent).idText with + | "PositionalArgsAttribute" + | "PositionalArgs" -> + match a.ArgExpr with + | SynExpr.Const (SynConst.Unit, _) -> Some None + | a -> Some (Some a) + | _ -> None + ) + + let longForms = + attrs + |> List.choose (fun attr -> + match attr.TypeName with + | SynLongIdent.SynLongIdent (ident, _, _) -> + match (List.last ident).idText with + | "ArgumentLongForm" + | "ArgumentLongFormAttribute" -> Some attr.ArgExpr + | _ -> None + ) + |> function + | [] -> List.singleton (SynExpr.CreateConst (argify fieldName)) + | l -> List.ofSeq l + + match ty with + | String -> + { + ParseFn = SynExpr.createLambda "x" (SynExpr.createIdent "x") + Acc = Accumulation.Required + TypeAfterParse = SynType.string + Positional = positional + ArgForm = longForms + TargetConstructionField = fieldName + BoolCases = None + } + |> ParseFunctionSpec.Leaf + |> Ok + | PrimitiveType pt -> + let isBoolLike = + if pt |> List.map _.idText = [ "System" ; "Boolean" ] then + Some (Choice2Of2 ()) + else + identifyAsFlag flagDus ty |> Option.map Choice1Of2 + + { + ParseFn = + SynExpr.createLambda + "x" + (SynExpr.applyFunction + (SynExpr.createLongIdent' (pt @ [ Ident.create "Parse" ])) + (SynExpr.createIdent "x")) + Acc = Accumulation.Required + TypeAfterParse = ty + Positional = positional + ArgForm = longForms + TargetConstructionField = fieldName + BoolCases = isBoolLike + } + |> ParseFunctionSpec.Leaf + |> Ok + | Uri -> + { + ParseFn = + SynExpr.createLambda + "x" + (SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Uri" ]) (SynExpr.createIdent "x")) + Acc = Accumulation.Required + TypeAfterParse = ty + Positional = positional + ArgForm = longForms + TargetConstructionField = fieldName + BoolCases = None + } + |> ParseFunctionSpec.Leaf + |> Ok + | TimeSpan -> + let parseExact = + attrs + |> List.tryPick (fun attr -> + match attr.TypeName with + | SynLongIdent.SynLongIdent (idents, _, _) -> + match idents |> List.map (fun i -> i.idText) |> List.tryLast with + | Some "ParseExactAttribute" + | Some "ParseExact" -> Some attr.ArgExpr + | _ -> None + ) + + let culture = + attrs + |> List.tryPick (fun attr -> + match attr.TypeName with + | SynLongIdent.SynLongIdent (idents, _, _) -> + match idents |> List.map (fun i -> i.idText) |> List.tryLast with + | Some "InvariantCultureAttribute" + | Some "InvariantCulture" -> Some () + | _ -> None + ) + + let parser = + match parseExact, culture with + | None, None -> + SynExpr.createIdent "x" + |> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "TimeSpan" ; "Parse" ]) + | Some format, None -> + [ + SynExpr.createIdent "x" + format + SynExpr.createLongIdent [ "System" ; "Globalization" ; "CultureInfo" ; "CurrentCulture" ] + ] + |> SynExpr.tuple + |> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "TimeSpan" ; "ParseExact" ]) + | None, Some () -> + [ + SynExpr.createIdent "x" + SynExpr.createLongIdent [ "System" ; "Globalization" ; "CultureInfo" ; "InvariantCulture" ] + ] + |> SynExpr.tuple + |> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "TimeSpan" ; "Parse" ]) + | Some format, Some () -> + [ + SynExpr.createIdent "x" + format + SynExpr.createLongIdent [ "System" ; "Globalization" ; "CultureInfo" ; "InvariantCulture" ] + ] + |> SynExpr.tuple + |> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "TimeSpan" ; "ParseExact" ]) + |> SynExpr.createLambda "x" + + { + ParseFn = parser + Acc = Accumulation.Required + TypeAfterParse = ty + Positional = positional + ArgForm = longForms + TargetConstructionField = fieldName + BoolCases = None + } + |> ParseFunctionSpec.Leaf + |> Ok + | FileInfo -> + { + ParseFn = + SynExpr.createLambda + "x" + (SynExpr.applyFunction + (SynExpr.createLongIdent [ "System" ; "IO" ; "FileInfo" ]) + (SynExpr.createIdent "x")) + Acc = Accumulation.Required + TypeAfterParse = ty + Positional = positional + ArgForm = longForms + TargetConstructionField = fieldName + BoolCases = None + } + |> ParseFunctionSpec.Leaf + |> Ok + | DirectoryInfo -> + { + ParseFn = + SynExpr.createLambda + "x" + (SynExpr.applyFunction + (SynExpr.createLongIdent [ "System" ; "IO" ; "DirectoryInfo" ]) + (SynExpr.createIdent "x")) + Acc = Accumulation.Required + TypeAfterParse = ty + Positional = positional + ArgForm = longForms + TargetConstructionField = fieldName + BoolCases = None + } + |> ParseFunctionSpec.Leaf + |> Ok + | OptionType eltTy -> + match + createParseFunction + choice + flagDus + userDefinedRecordTypesWithParser + userDefinedUnionTypesWithParser + fieldName + attrs + eltTy + with + | Error e -> Error e + | Ok parseFn -> + + match parseFn with + | ParseFunctionSpec.Leaf data -> + match data.Acc with + | Accumulation.Optional -> + failwith + $"ArgParser does not support optionals containing options at field %s{fieldName.idText}: %O{ty}" + | Accumulation.ChoicePositional _ + | Accumulation.Choice _ -> + failwith + $"ArgParser does not support optionals containing choices at field %s{fieldName.idText}: %O{ty}" + | Accumulation.List _ -> + failwith $"ArgParser does not support optional lists at field %s{fieldName.idText}: %O{ty}" + | Accumulation.Required -> + { data with + Acc = Accumulation.Optional + } + |> ParseFunctionSpec.Leaf + |> Ok + | ParseFunctionSpec.UserDefined _ -> Ok ParseFunctionSpec.OptionOfUserDefined + | ParseFunctionSpec.OptionOfUserDefined -> + failwith $"ArgParser does not support lists of options at field %s{fieldName.idText}" + | ChoiceType elts -> + match elts with + | [ elt1 ; elt2 ] -> + if not (SynType.provablyEqual elt1 elt2) then + failwith + $"ArgParser was unable to prove types %O{elt1} and %O{elt2} to be equal in a Choice. We require them to be equal." + + match + createParseFunction + choice + flagDus + userDefinedRecordTypesWithParser + userDefinedUnionTypesWithParser + fieldName + attrs + elt1 + with + | Error e -> Error e + | Ok parseFn -> + + match parseFn with + | ParseFunctionSpec.Leaf data -> + match data.Acc with + | Accumulation.Optional -> + failwith + $"ArgParser does not support choices containing options at field %s{fieldName.idText}: %O{ty}" + | Accumulation.List _ -> + failwith + $"ArgParser does not support choices containing lists at field %s{fieldName.idText}: %O{ty}" + | Accumulation.ChoicePositional _ + | Accumulation.Choice _ -> + failwith + $"ArgParser does not support choices containing choices at field %s{fieldName.idText}: %O{ty}" + | Accumulation.Required -> + + let relevantAttrs = + attrs + |> List.choose (fun attr -> + let (SynLongIdent.SynLongIdent (name, _, _)) = attr.TypeName + + match name |> List.map _.idText with + | [ "ArgumentDefaultFunction" ] + | [ "ArgumentDefaultFunctionAttribute" ] + | [ "Plugins" ; "ArgumentDefaultFunction" ] + | [ "Plugins" ; "ArgumentDefaultFunctionAttribute" ] + | [ "Myriad" ; "Plugins" ; "ArgumentDefaultFunction" ] + | [ "Myriad" ; "Plugins" ; "ArgumentDefaultFunctionAttribute" ] + | [ "WoofWare" ; "Myriad" ; "Plugins" ; "ArgumentDefaultFunction" ] + | [ "WoofWare" ; "Myriad" ; "Plugins" ; "ArgumentDefaultFunctionAttribute" ] -> + ArgumentDefaultSpec.FunctionCall (Ident.create ("Default" + fieldName.idText)) + |> Some + | [ "ArgumentDefaultEnvironmentVariable" ] + | [ "ArgumentDefaultEnvironmentVariableAttribute" ] + | [ "Plugins" ; "ArgumentDefaultEnvironmentVariable" ] + | [ "Plugins" ; "ArgumentDefaultEnvironmentVariableAttribute" ] + | [ "Myriad" ; "Plugins" ; "ArgumentDefaultEnvironmentVariable" ] + | [ "Myriad" ; "Plugins" ; "ArgumentDefaultEnvironmentVariableAttribute" ] + | [ "WoofWare" ; "Myriad" ; "Plugins" ; "ArgumentDefaultEnvironmentVariable" ] + | [ "WoofWare" ; "Myriad" ; "Plugins" ; "ArgumentDefaultEnvironmentVariableAttribute" ] -> + + ArgumentDefaultSpec.EnvironmentVariable attr.ArgExpr |> Some + | _ -> None + ) + + let relevantAttr = + match relevantAttrs with + | [] -> None + | [ x ] -> Some x + | _ -> + failwith + $"Expected Choice to be annotated with at most one ArgumentDefaultFunction or similar, but it was annotated with multiple. Field: %s{fieldName.idText}" + + match positional with + | Some positional -> + { data with + Acc = Accumulation.ChoicePositional positional + } + |> ParseFunctionSpec.Leaf + |> Ok + | None -> + { data with + Acc = Accumulation.Choice (choice relevantAttr) + } + |> ParseFunctionSpec.Leaf + |> Ok + | _ -> + failwith + $"Choices are only allowed to contain leaves; at %s{fieldName.idText}, got type %s{SynType.toHumanReadableString elt1}" + | elts -> + let elts = elts |> List.map string |> String.concat ", " + + failwith + $"ArgParser requires Choice to be of the form Choice<'a, 'a>; that is, two arguments, both the same. For field %s{fieldName.idText}, got: %s{elts}" + | ListType eltTy -> + match + createParseFunction + choice + flagDus + userDefinedRecordTypesWithParser + userDefinedUnionTypesWithParser + fieldName + attrs + eltTy + with + | Error e -> Error e + | Ok parseFn -> + + match parseFn with + | ParseFunctionSpec.Leaf data -> + { data with + Acc = Accumulation.List data.Acc + } + |> ParseFunctionSpec.Leaf + |> Ok + | _ -> + failwith + $"Lists are only allowed to contain leaves; at %s{fieldName.idText}, got type %s{SynType.toHumanReadableString eltTy}" + | ty -> + match identifyAsFlag flagDus ty with + | None -> + let recognisedRecords = userDefinedRecordTypesWithParser |> String.concat ", " + let recognisedUnions = userDefinedUnionTypesWithParser |> String.concat ", " + + let errorMessage = + $"we did not recognise the type %s{SynType.toHumanReadableString ty} as something we could build a parser for; we know about these record types:\n%s{recognisedRecords}\nand these unions:\n%s{recognisedUnions}" + + match ty with + | SynType.LongIdent (SynLongIdent.SynLongIdent (id = id)) -> + let typeName = List.last id + + if Seq.contains typeName.idText userDefinedRecordTypesWithParser then + ParseFunctionSpec.UserDefined (true, typeName) |> Ok + elif Seq.contains (List.last id).idText userDefinedUnionTypesWithParser then + ParseFunctionSpec.UserDefined (false, typeName) |> Ok + else + Error errorMessage + | _ -> Error errorMessage + | Some flagDu -> + // Parse as a bool, and then do the `if-then` dance. + let parser = + SynExpr.createIdent "x" + |> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Boolean" ; "Parse" ]) + |> FlagDu.FromBoolean flagDu + |> SynExpr.createLambda "x" + + { + ParseFn = parser + Acc = Accumulation.Required + TypeAfterParse = ty + Positional = positional + ArgForm = longForms + TargetConstructionField = fieldName + BoolCases = Some (Choice1Of2 flagDu) + } + |> ParseFunctionSpec.Leaf + |> Ok + + type internal DatalessUnion = + { + Cases : (string * SynAttribute list) list + } + + type internal ParsedRecordStructure<'choice> = + { + NameOfInProgressType : Ident + Original : RecordType + /// Map of field name to parser for that field + LeafNodes : Map> + Records : Map> + Unions : Map> + FlagDus : FlagDu list + } + + and internal ParsedUnionStructure<'choice> = + { + NameOfInProgressType : Ident + Original : UnionType + Cases : Map> + } + + /// `member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = ...` + /// The second member of the `flags` list tuple is the constant "true" with which we will interpret the + /// arity-0 `--foo`. So in the case of a boolean-typed field, this is `true`; in the case of a Flag-typed field, + /// this is `FlagType.WhicheverCaseHadTrue`. + let private setFlagValue (flags : (LeafData<'choice> * SynExpr) list) : SynBinding = + (SynExpr.CreateConst false, flags) + ||> List.fold (fun finalExpr (flag, trueCase) -> + let multipleErrorMessage = + SynExpr.createIdent "sprintf" + |> SynExpr.applyTo (SynExpr.CreateConst "Flag '%s' was supplied multiple times") + |> SynExpr.applyTo flag.HumanReadableArgForm + + let matchFlag = + [ + SynMatchClause.create + (SynPat.nameWithArgs "Some" [ SynPat.anon ]) + // This is an error, but it's one we can gracefully report at the end. + (SynExpr.sequential + [ + multipleErrorMessage + |> SynExpr.pipeThroughFunction (SynExpr.dotGet "Add" (SynExpr.createIdent "errors_")) + SynExpr.CreateConst true + ]) + + SynMatchClause.create + (SynPat.named "None") + ([ + SynExpr.assign + (SynLongIdent.create [ Ident.create "this" ; flag.TargetConstructionField ]) + (SynExpr.pipeThroughFunction (SynExpr.createIdent "Some") trueCase) + SynExpr.CreateConst true + ] + |> SynExpr.sequential) + ] + |> SynExpr.createMatch ( + SynExpr.createLongIdent' [ Ident.create "this" ; flag.TargetConstructionField ] + ) + + (finalExpr, flag.ArgForm) + ||> List.fold (fun finalExpr argForm -> + SynExpr.ifThenElse + (SynExpr.applyFunction + (SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ]) + (SynExpr.tuple + [ + SynExpr.createIdent "key" + SynExpr.applyFunction + (SynExpr.applyFunction + (SynExpr.createIdent "sprintf") + (SynExpr.CreateConst "--%s")) + argForm + SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ] + ])) + finalExpr + matchFlag + ) + ) + |> SynBinding.basic + [ Ident.create "this" ; Ident.create "SetFlagValue_" ] + [ + SynPat.annotateType (SynType.app "ResizeArray" [ SynType.string ]) (SynPat.named "errors_") + SynPat.annotateType SynType.string (SynPat.named "key") + ] + |> SynBinding.withReturnAnnotation (SynType.named "bool") + |> SynBinding.withXmlDoc (PreXmlDoc.create "Returns false if we didn't set a value.") + |> SynBinding.makeInstanceMember + + /// `member this.ProcessKeyValueRecord_ (errors_ : ResizeArray) (key : string) (value : string) : Result = ...` + /// Returns a possible error. + /// A parse failure might not be fatal (e.g. maybe the input was optionally of arity 0, and we failed to do + /// the parse because in fact the key decided not to take this argument); in that case we return Error None. + /// + /// `args` is a list of the name of the field and the structure which is that field's contents. + let private processKeyValueRecord<'choice> (args : (string * ParsedRecordStructure<'choice>) list) : SynBinding = + (SynExpr.applyFunction (SynExpr.createIdent "Error") (SynExpr.createIdent "None"), args) + ||> List.fold (fun finalBranch (fieldName, _record) -> + [ + SynMatchClause.create + (SynPat.nameWithArgs "Ok" [ SynPat.unit ]) + (SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ())) + SynMatchClause.create + (SynPat.nameWithArgs "Error" [ SynPat.named "e" ]) + (SynExpr.sequential + [ + + finalBranch + ]) + ] + |> SynExpr.createMatch ( + SynExpr.createLongIdent [ "this" ; fieldName ; "ProcessKeyValue" ] + |> SynExpr.applyTo (SynExpr.createIdent "argNum_") + |> SynExpr.applyTo (SynExpr.createIdent "errors_") + |> SynExpr.applyTo (SynExpr.createIdent "key") + |> SynExpr.applyTo (SynExpr.createIdent "value") + ) + ) + |> SynExpr.createLet + [ + SynBinding.basic + [ Ident.create "errors" ] + [] + (SynExpr.applyFunction (SynExpr.createIdent "ResizeArray") (SynExpr.CreateConst ())) + |> SynBinding.withReturnAnnotation (SynType.app "ResizeArray" [ SynType.string ]) + ] + |> SynBinding.basic + [ Ident.create "this" ; Ident.create "ProcessKeyValueRecord_" ] + [ + SynPat.annotateType SynType.int (SynPat.named "argNum_") + SynPat.annotateType (SynType.app "ResizeArray" [ SynType.string ]) (SynPat.named "errors_") + SynPat.annotateType SynType.string (SynPat.named "key") + SynPat.annotateType SynType.string (SynPat.named "value") + ] + |> SynBinding.withReturnAnnotation ( + SynType.app "Result" [ SynType.unit ; SynType.appPostfix "option" SynType.string ] + ) + |> SynBinding.withXmlDoc ( + [ + " Passes the key-value pair to any child records, 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." + ] + |> PreXmlDoc.create' + ) + |> SynBinding.makeInstanceMember + + /// `member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) : Result = ...` + /// Returns a possible error. + /// A parse failure might not be fatal (e.g. maybe the input was optionally of arity 0, and we failed to do + /// the parse because in fact the key decided not to take this argument); in that case we return Error None. + let private processKeyValueSelf<'choice> (args : LeafData<'choice> list) : SynBinding = + let args = + args + |> List.map (fun arg -> + match arg.Acc with + | Accumulation.Required + | Accumulation.Choice _ + | Accumulation.ChoicePositional _ + | Accumulation.Optional -> + let multipleErrorMessage = + SynExpr.createIdent "sprintf" + |> SynExpr.applyTo (SynExpr.CreateConst "Argument '%s' was supplied multiple times: %s and %s") + |> SynExpr.applyTo arg.HumanReadableArgForm + |> SynExpr.applyTo (SynExpr.createIdent "x" |> SynExpr.callMethod "ToString" |> SynExpr.paren) + |> SynExpr.applyTo ( + SynExpr.createIdent "value" |> SynExpr.callMethod "ToString" |> SynExpr.paren + ) + + let performAssignment = + [ + SynExpr.createIdent "value" + |> SynExpr.pipeThroughFunction arg.ParseFn + |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some") + |> SynExpr.assign ( + SynLongIdent.create [ Ident.create "this" ; arg.TargetConstructionField ] + ) + + SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ()) + ] + |> SynExpr.sequential + + [ + SynMatchClause.create + (SynPat.nameWithArgs "Some" [ SynPat.named "x" ]) + (SynExpr.sequential + [ + multipleErrorMessage + |> SynExpr.pipeThroughFunction ( + SynExpr.dotGet "Add" (SynExpr.createIdent "errors_") + ) + SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ()) + ]) + SynMatchClause.create + (SynPat.named "None") + (SynExpr.pipeThroughTryWith + SynPat.anon + (SynExpr.createLongIdent [ "exc" ; "Message" ] + |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some") + |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Error")) + performAssignment) + ] + |> SynExpr.createMatch ( + SynExpr.createLongIdent' [ Ident.create "this" ; arg.TargetConstructionField ] + ) + | Accumulation.List (Accumulation.List _) + | Accumulation.List Accumulation.Optional + | Accumulation.List (Accumulation.Choice _) -> + failwith + "WoofWare.Myriad invariant violated: expected a list to contain only a Required accumulation. Non-positional lists cannot be optional or Choice, nor can they themselves contain lists." + | Accumulation.List (Accumulation.ChoicePositional _) + // ChoicePositional gets aggregated just like any other arg into its containing list; + // it's only when freezing the in-progress structure that we annotate them with choice information. + | Accumulation.List Accumulation.Required -> + [ + SynExpr.createIdent "value" + |> SynExpr.pipeThroughFunction arg.ParseFn + // Annotate the positional with arg index info + |> SynExpr.pipeThroughFunction ( + match arg.Positional with + | None -> SynExpr.createLambda "x" (SynExpr.createIdent "x") + | Some _ -> + SynExpr.createLambda + "x" + (SynExpr.tupleNoParen [ SynExpr.createIdent "x" ; SynExpr.createIdent "argNum_" ]) + ) + |> SynExpr.pipeThroughFunction ( + SynExpr.createLongIdent' + [ Ident.create "this" ; arg.TargetConstructionField ; Ident.create "Add" ] + ) + SynExpr.CreateConst () |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Ok") + ] + |> SynExpr.sequential + |> fun expr -> arg.ArgForm, expr + ) + + // let posArg = + // SynExpr.createIdent "value" + // |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent ["positionals" ; "Add"]) + // |> List.singleton + + (SynExpr.applyFunction (SynExpr.createIdent "Error") (SynExpr.createIdent "None"), args) + ||> List.fold (fun finalBranch (argForm, arg) -> + (finalBranch, argForm) + ||> List.fold (fun finalBranch argForm -> + arg + |> SynExpr.ifThenElse + (SynExpr.applyFunction + (SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ]) + (SynExpr.tuple + [ + SynExpr.createIdent "key" + SynExpr.applyFunction + (SynExpr.applyFunction + (SynExpr.createIdent "sprintf") + (SynExpr.CreateConst "--%s")) + argForm + SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ] + ])) + finalBranch + ) + ) + |> SynBinding.basic + [ Ident.create "this" ; Ident.create "ProcessKeyValueSelf_" ] + [ + SynPat.annotateType SynType.int (SynPat.named "argNum_") + SynPat.annotateType (SynType.app "ResizeArray" [ SynType.string ]) (SynPat.named "errors_") + SynPat.annotateType SynType.string (SynPat.named "key") + SynPat.annotateType SynType.string (SynPat.named "value") + ] + |> SynBinding.withReturnAnnotation ( + SynType.app "Result" [ SynType.unit ; SynType.appPostfix "option" SynType.string ] + ) + |> SynBinding.withXmlDoc ( + [ + " 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." + ] + |> PreXmlDoc.create' + ) + |> SynBinding.makeInstanceMember + + /// `static member HelpText_ (prefix : string option) (indent : int) = ...` + let private helpTextBinding : SynMemberDefn = + SynExpr.createIdent "failwith" + |> SynExpr.applyTo (SynExpr.CreateConst "TODO") + |> SynBinding.basic + [ Ident.create "HelpText_" ] + [ + SynPat.named "prefix" |> SynPat.annotateType (SynType.option SynType.string) + SynPat.named "indent" |> SynPat.annotateType SynType.int + ] + |> SynBinding.withXmlDoc ( + PreXmlDoc.create + "Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces." + ) + |> SynBinding.withReturnAnnotation SynType.string + |> SynMemberDefn.staticMember + + /// Build the "in-progress record" which is basically "the input record, but with all fields mutable and optional". + let private inProgressRecordType (record : ParsedRecordStructure) : RecordType = + let leafFields = + record.LeafNodes + |> Map.toSeq + |> Seq.map (fun (ident, data) -> + let ty, mutability = + match data.Acc with + | Accumulation.Choice _ -> SynType.option data.TypeAfterParse, true + | Accumulation.ChoicePositional _ -> failwith "TODO" + | Accumulation.List acc -> + match data.Positional with + | Some _ -> + SynType.app' + (SynType.createLongIdent' [ "ResizeArray" ]) + [ SynType.tupleNoParen [ data.TypeAfterParse ; SynType.int ] |> Option.get ], + false + | None -> + SynType.app' (SynType.createLongIdent' [ "ResizeArray" ]) [ data.TypeAfterParse ], false + | Accumulation.Optional -> SynType.option data.TypeAfterParse, true + | Accumulation.Required -> SynType.option data.TypeAfterParse, true + + { + Attrs = [] + Type = ty + Ident = Some (Ident.create ident) + } + |> SynField.make + |> SynField.withMutability mutability + ) + |> Seq.toList + + let unionFields = + record.Unions + |> Map.toSeq + |> Seq.map (fun (ident, data) -> + { + Attrs = [] + Ident = Ident.create ident |> Some + Type = SynType.createLongIdent [ data.NameOfInProgressType ] + } + |> SynField.make + ) + |> Seq.toList + + let recordFields = + record.Records + |> Map.toSeq + |> Seq.map (fun (ident, data) -> + { + Attrs = [] + Ident = Ident.create ident |> Some + Type = SynType.createLongIdent [ data.NameOfInProgressType ] + } + |> SynField.make + ) + |> Seq.toList + + let fields = + leafFields @ unionFields @ recordFields + |> fun l -> + if l.IsEmpty then + { + Attrs = [] + Ident = Some (Ident.create "_Dummy") + Type = SynType.unit + } + |> SynField.make + |> List.singleton + else + l |> List.map (SynField.withMutability true) + + let assembleMethod = + // for each field `FieldName` in order, we've made a variable `arg%i` + // which has done the optionality check + let instantiation = + record.Original.Fields + |> List.mapi (fun i (SynField.SynField (idOpt = ident)) -> + match ident with + | None -> + failwith + $"expected field in record %s{record.Original.Name.idText} to have a name, but it did not" + | Some ident -> SynLongIdent.create [ ident ], SynExpr.createIdent $"arg%i{i}" + ) + |> SynExpr.createRecord None + |> fun record -> + SynExpr.tupleNoParen + [ + record + SynExpr.applyFunction + (SynExpr.createLongIdent [ "Seq" ; "tryExactlyOne" ]) + (SynExpr.createIdent "positionalConsumers") + ] + |> SynExpr.paren + |> SynExpr.applyFunction (SynExpr.createIdent "Ok") + + let assignVariables = + record.Original.Fields + |> List.mapi (fun i f -> (i, f)) + |> List.collect (fun (i, SynField.SynField (fieldType = ty ; idOpt = ident)) -> + match ident with + | None -> + failwith + $"expected field in record %s{record.Original.Name.idText} to have a name, but it did not" + | Some ident -> + + let valueForThisVar = + match record.Records |> Map.tryFind ident.idText with + | Some _subRecord -> + // This was a record; defer to its parser. + let subAssembleCall = + SynExpr.dotGet ident.idText (SynExpr.createIdent "this") + |> SynExpr.callMethodArg "Assemble_" (SynExpr.createIdent "getEnvironmentVariable") + |> SynExpr.applyTo (SynExpr.createIdent "positionals") + + [ + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Ok" ] + (SynArgPats.create + [ SynPat.named "result" ; SynPat.named "consumedPositional" ])) + (SynExpr.sequential + [ + SynExpr.createMatch + (SynExpr.createIdent "consumedPositional") + [ + SynMatchClause.create + (SynPat.named "None") + (SynExpr.CreateConst ()) + SynMatchClause.create + (SynPat.nameWithArgs + "Some" + [ SynPat.named "positionalConsumer" ]) + (SynExpr.callMethodArg + "Add" + (SynExpr.createIdent "positionalConsumer") + (SynExpr.createIdent "positionalConsumers")) + ] + SynExpr.createIdent "result" + ]) + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Error" ] + (SynArgPats.create [ SynPat.named "err" ])) + (SynExpr.sequential + [ + SynExpr.callMethodArg + "AddRange" + (SynExpr.createIdent "err") + (SynExpr.createIdent "errors") + defaultOf + ]) + ] + |> SynExpr.createMatch subAssembleCall + | None -> + + match record.Unions |> Map.tryFind ident.idText with + | Some _union -> + // This was a union; defer to its parser. + let subAssembleCall = + SynExpr.dotGet ident.idText (SynExpr.createIdent "this") + |> SynExpr.callMethodArg "Assemble_" (SynExpr.createIdent "getEnvironmentVariable") + |> SynExpr.applyTo (SynExpr.createIdent "positionals") + + [ + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Ok" ] + (SynArgPats.create + [ SynPat.named "result" ; SynPat.named "consumedPositional" ])) + (SynExpr.sequential + [ + SynExpr.createMatch + (SynExpr.createIdent "consumedPositional") + [ + SynMatchClause.create + (SynPat.named "None") + (SynExpr.CreateConst ()) + SynMatchClause.create + (SynPat.nameWithArgs + "Some" + [ SynPat.named "positionalConsumer" ]) + (SynExpr.callMethodArg + "Add" + (SynExpr.createIdent "positionalConsumer") + (SynExpr.createIdent "positionalConsumers")) + ] + SynExpr.createIdent "result" + ]) + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Error" ] + (SynArgPats.create [ SynPat.named "err" ])) + (SynExpr.sequential + [ + SynExpr.callMethodArg + "AddRange" + (SynExpr.createIdent "err") + (SynExpr.createIdent "errors") + defaultOf + ]) + ] + |> SynExpr.createMatch subAssembleCall + | None -> + + match record.LeafNodes |> Map.tryFind ident.idText with + | Some leaf -> + match leaf.Positional with + | Some includeFlagLike -> + let constructPositionalsList = + match leaf.Acc with + | List acc -> + match acc with + | Accumulation.List _ -> + failwith "unexpected: positional args should not be a list of lists" + | Accumulation.Required -> + // The condition that determines whether this looks like a flag that's mistakenly + // a conditional, which we should reject + let rejectFlagInPositional = + let includeFlagLike = + match includeFlagLike with + | None -> SynExpr.CreateConst false + | Some i -> i + + SynExpr.booleanAnd + (SynExpr.applyFunction + (SynExpr.createIdent "not") + (SynExpr.paren includeFlagLike)) + (startsWithDashes ( + SynExpr.paren ( + SynExpr.applyFunction + (SynExpr.createIdent "fst") + (SynExpr.createIdent "x") + ) + )) + + SynExpr.createIdent "positionals" + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createLongIdent [ "Seq" ; "map" ]) + (SynExpr.createLambda + "x" + (SynExpr.createMatch + (SynExpr.createIdent "x") + [ + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Choice1Of2" ] + (SynArgPats.createNamed [ "x" ])) + (SynExpr.ifThenElse + rejectFlagInPositional + (SynExpr.createIdent "x") + (SynExpr.sequential + [ + SynExpr.callMethodArg + "Add" + (SynExpr.applyFunction + (SynExpr.createIdent "fst") + (SynExpr.createIdent "x") + |> SynExpr.paren) + (SynExpr.createIdent + "outOfPlacePositionals") + (SynExpr.createIdent "x") + ])) + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Choice2Of2" ] + (SynArgPats.createNamed [ "x" ])) + (SynExpr.createIdent "x") + ])) + ) + |> SynExpr.pipeThroughFunction ( + let body = + SynExpr.tupleNoParen + [ + SynExpr.pipeThroughFunction + leaf.ParseFn + (SynExpr.createIdent "str") + SynExpr.createIdent "argNum_" + ] + + SynExpr.applyFunction + (SynExpr.createLongIdent [ "Seq" ; "map" ]) + (SynExpr.Lambda ( + false, + false, + SynSimplePats.create + [ + SynSimplePat.createId (Ident.create "str") + SynSimplePat.createId (Ident.create "argNum_") + ], + body, + Some ( + [ + SynPat.tuple + [ SynPat.named "str" ; SynPat.named "argNum_" ] + ], + body + ), + range0, + { + ArrowRange = Some range0 + } + ) + |> SynExpr.paren) + ) + |> SynExpr.pipeThroughFunction ( + SynExpr.createLambda + "x" + (SynExpr.createLongIdent [ "Seq" ; "append" ] + |> SynExpr.applyTo ( + SynExpr.createLongIdent' + [ Ident.create "this" ; leaf.TargetConstructionField ] + ) + |> SynExpr.applyTo (SynExpr.createIdent "x")) + ) + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createLongIdent [ "Seq" ; "sortBy" ]) + (SynExpr.createIdent "snd") + ) + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createLongIdent [ "Seq" ; "map" ]) + (SynExpr.createIdent "fst") + ) + |> SynExpr.pipeThroughFunction ( + SynExpr.createLongIdent [ "Seq" ; "toList" ] + ) + | Accumulation.Optional -> + failwith "unexpected: positional args should not be a list of options" + | Accumulation.Choice _ -> + failwith + "internal error: positional args, if Choicey, should be a ChoicePositional" + | Accumulation.ChoicePositional _attrContents -> + SynExpr.createIdent "positionals" + |> SynExpr.pipeThroughFunction ( + [ + SynExpr.applyFunction leaf.ParseFn (SynExpr.createIdent "x") + |> SynExpr.pipeThroughFunction choice1Of2 + |> SynMatchClause.create ( + SynPat.identWithArgs + [ Ident.create "Choice1Of2" ] + (SynArgPats.create + [ + SynPat.tuple + [ SynPat.named "x" ; SynPat.named "argPos" ] + ]) + ) + + SynExpr.applyFunction leaf.ParseFn (SynExpr.createIdent "x") + |> SynExpr.pipeThroughFunction choice2Of2 + |> SynMatchClause.create ( + SynPat.identWithArgs + [ Ident.create "Choice2Of2" ] + (SynArgPats.create + [ + SynPat.tuple + [ SynPat.named "x" ; SynPat.named "argPos" ] + ]) + ) + ] + |> SynExpr.createMatch (SynExpr.createIdent "x") + |> SynExpr.createLambda "x" + |> SynExpr.applyFunction (SynExpr.createLongIdent [ "List" ; "map" ]) + ) + | _ -> failwith "unexpected: positional arguments should be a list" + + [ + SynExpr.callMethodArg + "Add" + leaf.HumanReadableArgForm + (SynExpr.createIdent "positionalConsumers") + // If any of the Choice1Of2 positional args look like flags, + // and `not includeFlagLike`, then store a parse error. + [ constructPositionalsList ] |> SynExpr.sequential + ] + |> SynExpr.sequential + | None -> + + let parseFn = + match leaf.BoolCases with + | Some boolLike -> + let trueCase, falseCase = + match boolLike with + | Choice2Of2 () -> SynExpr.CreateConst true, SynExpr.CreateConst false + | Choice1Of2 flag -> + FlagDu.FromBoolean flag (SynExpr.CreateConst true), + FlagDu.FromBoolean flag (SynExpr.CreateConst false) + + // We permit environment variables to be populated with 0 and 1 as well. + SynExpr.ifThenElse + (SynExpr.applyFunction + (SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ]) + (SynExpr.tuple + [ + SynExpr.createIdent "x" + SynExpr.CreateConst "1" + SynExpr.createLongIdent + [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ] + ])) + (SynExpr.ifThenElse + (SynExpr.applyFunction + (SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ]) + (SynExpr.tuple + [ + SynExpr.createIdent "x" + SynExpr.CreateConst "0" + SynExpr.createLongIdent + [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ] + ])) + (SynExpr.createIdent "x" |> SynExpr.pipeThroughFunction leaf.ParseFn) + falseCase) + trueCase + |> SynExpr.createLambda "x" + | None -> leaf.ParseFn + + let extract = + match leaf.Acc with + | Accumulation.ChoicePositional choice -> failwith "TODO" + | Accumulation.Choice choice -> + [ + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Some" ] + (SynArgPats.create [ SynPat.named "result" ])) + (SynExpr.applyFunction choice1Of2 (SynExpr.createIdent "result")) + SynMatchClause.create + (SynPat.identWithArgs [ Ident.create "None" ] (SynArgPats.create [])) + (match choice with + | ArgumentDefaultSpec.EnvironmentVariable var -> + var + |> SynExpr.pipeThroughFunction ( + SynExpr.createIdent "getEnvironmentVariable" + ) + |> SynExpr.pipeThroughFunction parseFn + | ArgumentDefaultSpec.FunctionCall name -> + SynExpr.callMethod + name.idText + (SynExpr.createIdent' record.Original.Name) + |> SynExpr.paren + |> SynExpr.applyFunction choice2Of2) + ] + |> SynExpr.createMatch (SynExpr.dotGet ident.idText (SynExpr.createIdent "this")) + | Accumulation.List acc -> + // TODO: use the acc here too?! + SynExpr.dotGet ident.idText (SynExpr.createIdent "this") + |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Seq" ; "toList" ]) + | Accumulation.Optional -> SynExpr.dotGet ident.idText (SynExpr.createIdent "this") + | Accumulation.Required -> + // fall back to assuming it's basically primitive + [ + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Some" ] + (SynArgPats.create [ SynPat.named "result" ])) + (SynExpr.createIdent "result") + SynMatchClause.create + (SynPat.identWithArgs [ Ident.create "None" ] (SynArgPats.create [])) + (SynExpr.sequential + [ + SynExpr.callMethodArg + "Add" + (leaf.ArgForm.[0] + |> SynExpr.applyFunction ( + SynExpr.CreateConst + "Required argument '--%s' received no value" + |> SynExpr.applyFunction (SynExpr.createIdent "sprintf") + ) + |> SynExpr.paren) + (SynExpr.createIdent "errors") + defaultOf + ]) + ] + |> SynExpr.createMatch (SynExpr.dotGet ident.idText (SynExpr.createIdent "this")) + + extract + | None -> + failwith + $"somehow we never classified the field %s{ident.idText} of %s{record.Original.Name.idText}" + + valueForThisVar + |> SynBinding.basic [ Ident.create $"arg%i{i}" ] [] + |> SynBinding.withReturnAnnotation ty + |> List.singleton + ) + + [ + SynExpr.createIdent "outOfPlacePositionals" + |> SynExpr.pipeThroughFunction ( + SynExpr.createLongIdent [ "String" ; "concat" ] + |> SynExpr.applyTo (SynExpr.CreateConst " ") + ) + |> SynExpr.pipeThroughFunction ( + SynExpr.createLambda + "x" + (SynExpr.ifThenElse + (SynExpr.equals + (SynExpr.CreateConst 0) + (SynExpr.dotGet "Count" (SynExpr.createIdent "outOfPlacePositionals"))) + ((SynExpr.createIdent "sprintf") + |> SynExpr.applyTo ( + SynExpr.CreateConst + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + ) + |> SynExpr.applyTo ( + SynExpr.index (SynExpr.CreateConst 0) (SynExpr.createIdent "positionalConsumers") + ) + |> SynExpr.applyTo (SynExpr.createIdent "x")) + (SynExpr.plus + (SynExpr.CreateConst "Unmatched args which look like they are meant to be flags. ") + (SynExpr.createIdent "x"))) + ) + |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "errors" ; "Add" ]) + |> SynExpr.ifThenElse + (SynExpr.dotGet "Count" (SynExpr.createIdent "outOfPlacePositionals") + |> SynExpr.greaterThan (SynExpr.CreateConst 0)) + (SynExpr.CreateConst ()) + + instantiation + |> SynExpr.ifThenElse + (SynExpr.equals (SynExpr.dotGet "Count" (SynExpr.createIdent "errors")) (SynExpr.CreateConst 0)) + (SynExpr.createIdent "errors" + |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Seq" ; "toList" ]) + |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Error")) + ] + |> SynExpr.sequential + |> SynExpr.ifThenElse + (SynExpr.lessThanOrEqual + (SynExpr.CreateConst 1) + (SynExpr.dotGet "Count" (SynExpr.createIdent "positionalConsumers"))) + (SynExpr.createIdent "positionalConsumers" + |> SynExpr.applyFunction ( + SynExpr.applyFunction (SynExpr.createLongIdent [ "String" ; "concat" ]) (SynExpr.CreateConst ", ") + ) + |> SynExpr.plus ( + SynExpr.CreateConst + "Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + ) + |> SynExpr.paren + |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "List" ; "singleton" ]) + |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Error")) + |> SynExpr.createLet assignVariables + |> SynExpr.createLet + [ + SynBinding.basic + [ Ident.create "errors" ] + [] + (SynExpr.applyFunction + (SynExpr.typeApp [ SynType.string ] (SynExpr.createIdent "ResizeArray")) + (SynExpr.CreateConst ())) + SynBinding.basic + [ Ident.create "positionalConsumers" ] + [] + (SynExpr.applyFunction + (SynExpr.typeApp [ SynType.string ] (SynExpr.createIdent "ResizeArray")) + (SynExpr.CreateConst ())) + // TODO: we can optimise this away if we know already we're accepting all positionals, + // although we can only guess this with heuristics in the generator + SynBinding.basic + [ Ident.create "outOfPlacePositionals" ] + [] + (SynExpr.applyFunction (SynExpr.createIdent "ResizeArray") (SynExpr.CreateConst ())) + |> SynBinding.withReturnAnnotation (SynType.app "ResizeArray" [ SynType.string ]) + ] + |> SynBinding.basic + [ Ident.create "this" ; Ident.create "Assemble_" ] + [ + SynPat.annotateType + (SynType.funFromDomain SynType.string SynType.string) + (SynPat.named "getEnvironmentVariable") + SynPat.annotateType + (SynType.list ( + SynType.app + "Choice" + [ + SynType.tupleNoParen [ SynType.string ; SynType.int ] |> Option.get + SynType.tupleNoParen [ SynType.string ; SynType.int ] |> Option.get + ] + )) + (SynPat.named "positionals") + ] + |> SynBinding.withReturnAnnotation ( + SynType.app + "Result" + [ + SynType.tupleNoParen + [ + SynType.createLongIdent [ record.Original.Name ] + SynType.option SynType.string + ] + |> Option.get + SynType.list SynType.string + ] + ) + |> SynBinding.withXmlDoc ( + PreXmlDoc.create + "Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args." + ) + |> SynMemberDefn.memberImplementation + + let emptyConstructor = + [ + for KeyValue (nodeName, leaf) in record.LeafNodes do + let rhs = + match leaf.Acc with + | Accumulation.Required + | Accumulation.Optional + | Accumulation.Choice _ -> SynExpr.createIdent "None" + | Accumulation.ChoicePositional _ -> failwith "todo" + | Accumulation.List acc -> + SynExpr.applyFunction (SynExpr.createIdent "ResizeArray") (SynExpr.CreateConst ()) + + yield SynLongIdent.create [ Ident.create nodeName ], rhs + for KeyValue (nodeName, subRecord) in record.Records do + yield + SynLongIdent.create [ Ident.create nodeName ], + SynExpr.callMethod "_Empty" (SynExpr.createIdent' subRecord.NameOfInProgressType) + for KeyValue (nodeName, subUnion) in record.Unions do + yield + SynLongIdent.create [ Ident.create nodeName ], + SynExpr.callMethod "_Empty" (SynExpr.createIdent' subUnion.NameOfInProgressType) + ] + |> SynExpr.createRecord None + |> SynBinding.basic [ Ident.create "_Empty" ] [ SynPat.unit ] + |> SynBinding.withReturnAnnotation (SynType.createLongIdent [ record.NameOfInProgressType ]) + |> SynMemberDefn.staticMember + + let processKeyValueSelf = + if record.LeafNodes.IsEmpty then + None + else + record.LeafNodes + |> Map.toSeq + |> Seq.map snd + |> Seq.toList + |> processKeyValueSelf + |> SynMemberDefn.memberImplementation + |> Some + + let processKeyValueChildRecords = + if record.Records.IsEmpty then + None + else + record.Records + |> Map.toSeq + |> Seq.toList + |> processKeyValueRecord + |> SynMemberDefn.memberImplementation + |> Some + + let processKeyValue = + let afterErrorFromLeaf = + match processKeyValueChildRecords with + | None -> SynExpr.applyFunction (SynExpr.createIdent "Error") (SynExpr.createIdent "None") + | Some _ -> + [ + SynMatchClause.create + (SynPat.nameWithArgs "Ok" [ SynPat.unit ]) + (SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ())) + SynMatchClause.create + (SynPat.nameWithArgs "Error" [ SynPat.named "errorFromRecord" ]) + (SynExpr.applyFunction (SynExpr.createIdent "Error") (SynExpr.createIdent "errorFromRecord")) + ] + |> SynExpr.createMatch ( + SynExpr.createLongIdent [ "this" ; "ProcessKeyValueRecord_" ] + |> SynExpr.applyTo (SynExpr.createIdent "argNum_") + |> SynExpr.applyTo (SynExpr.createIdent "errors_") + |> SynExpr.applyTo (SynExpr.createIdent "key") + |> SynExpr.applyTo (SynExpr.createIdent "value") + ) + + let firstMatch = + match processKeyValueSelf with + | None -> afterErrorFromLeaf + | Some _ -> + [ + SynMatchClause.create + (SynPat.nameWithArgs "Ok" [ SynPat.unit ]) + (SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ())) + SynMatchClause.create + (SynPat.nameWithArgs "Error" [ SynPat.named "None" ]) + // We didn't manage to parse this arg, but we didn't actually fail to do so; + // give our sub-parsers a try. + afterErrorFromLeaf + SynMatchClause.create + (SynPat.nameWithArgs + "Error" + [ + SynPat.paren ( + SynPat.identWithArgs + [ Ident.create "Some" ] + (SynArgPats.createNamed [ "errorFromLeaf" ]) + ) + ]) + // We tried and explicitly failed to consume the argument ourselves, so just hand the error + // back out without even trying our sub-parsers. + (SynExpr.applyFunction + (SynExpr.createIdent "Error") + (SynExpr.paren ( + SynExpr.applyFunction + (SynExpr.createIdent "Some") + (SynExpr.createIdent "errorFromLeaf") + ))) + ] + |> SynExpr.createMatch ( + SynExpr.createLongIdent [ "this" ; "ProcessKeyValueSelf_" ] + |> SynExpr.applyTo (SynExpr.createIdent "argNum_") + |> SynExpr.applyTo (SynExpr.createIdent "errors_") + |> SynExpr.applyTo (SynExpr.createIdent "key") + |> SynExpr.applyTo (SynExpr.createIdent "value") + ) + + firstMatch + |> SynBinding.basic + [ Ident.create "this" ; Ident.create "ProcessKeyValue" ] + [ + SynPat.annotateType SynType.int (SynPat.named "argNum_") + SynPat.annotateType (SynType.app "ResizeArray" [ SynType.string ]) (SynPat.named "errors_") + SynPat.annotateType SynType.string (SynPat.named "key") + SynPat.annotateType SynType.string (SynPat.named "value") + ] + |> SynBinding.withReturnAnnotation (SynType.app "Result" [ SynType.unit ; SynType.option SynType.string ]) + |> SynBinding.makeInstanceMember + |> SynMemberDefn.memberImplementation + + let flags = + record.LeafNodes + |> Map.toSeq + |> Seq.choose (fun (_, pf) -> + match pf.Acc with + | Required + | Optional + | Accumulation.Choice _ -> Some pf + // We don't allow flags to be passed multiple times and accumulated into a list. + | Accumulation.List _ + | Accumulation.ChoicePositional _ -> None + ) + |> Seq.choose (fun pf -> + match pf.TypeAfterParse with + | PrimitiveType pt -> + if (pt |> List.map _.idText) = [ "System" ; "Boolean" ] then + Some (pf, SynExpr.CreateConst true) + else + None + | ty -> + match identifyAsFlag record.FlagDus ty with + | Some flag -> (pf, FlagDu.FromBoolean flag (SynExpr.CreateConst true)) |> Some + | _ -> None + ) + |> Seq.toList + + let setFlagValue = setFlagValue flags |> SynMemberDefn.memberImplementation + + { + Name = record.NameOfInProgressType + Fields = fields + Members = + [ + Some assembleMethod + Some emptyConstructor + processKeyValueSelf + processKeyValueChildRecords + Some processKeyValue + Some setFlagValue + Some helpTextBinding + ] + |> List.choose id + |> Some + XmlDoc = PreXmlDoc.create $"A partially-parsed %s{record.Original.Name.idText}." |> Some + Generics = + match record.Original.Generics with + | None -> None + | Some _ -> + failwith $"Record type %s{record.Original.Name.idText} had generics, which we don't support." + TypeAccessibility = Some (SynAccess.Internal range0) + ImplAccessibility = None + Attributes = [] + } + + /// Build the "in-progress union" which is basically "a record with one parser for each union case". + let private inProgressUnionType (union : ParsedUnionStructure) : RecordType = + let fields = + union.Cases + |> Map.toSeq + |> Seq.map (fun (caseName, structure) -> + { + Attrs = [] + Ident = Ident.create caseName |> Some + Type = SynType.createLongIdent [ structure.NameOfInProgressType ] + } + |> SynField.make + ) + |> Seq.toList + + let assembleMethod = + // Go over each case attempting to consume it. + // If exactly one case manages to do it, we win. + SynExpr.applyFunction (SynExpr.createIdent "failwith") (SynExpr.CreateConst "TODO") + |> SynBinding.basic + [ Ident.create "this" ; Ident.create "Assemble_" ] + [ + SynPat.annotateType + (SynType.funFromDomain SynType.string SynType.string) + (SynPat.named "getEnvironmentVariable") + SynPat.annotateType + (SynType.list ( + SynType.app + "Choice" + [ + SynType.tupleNoParen [ SynType.string ; SynType.int ] |> Option.get + SynType.tupleNoParen [ SynType.string ; SynType.int ] |> Option.get + ] + )) + (SynPat.named "positionals") + ] + |> SynBinding.withReturnAnnotation ( + SynType.app + "Result" + [ + SynType.tupleNoParen + [ + SynType.createLongIdent [ union.Original.Name ] + SynType.option SynType.string + ] + |> Option.get + SynType.list SynType.string + ] + ) + |> SynBinding.withXmlDoc ( + PreXmlDoc.create + "Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args." + ) + |> SynMemberDefn.memberImplementation + + let emptyConstructor = + [ + for KeyValue (nodeName, subCase) in union.Cases do + yield + SynLongIdent.create [ Ident.create nodeName ], + SynExpr.callMethod "_Empty" (SynExpr.createIdent' subCase.NameOfInProgressType) + ] + |> SynExpr.createRecord None + |> SynBinding.basic [ Ident.create "_Empty" ] [ SynPat.unit ] + |> SynBinding.withReturnAnnotation (SynType.createLongIdent [ union.NameOfInProgressType ]) + |> SynMemberDefn.staticMember + + { + Name = union.NameOfInProgressType + Fields = fields + Members = + [ Some assembleMethod ; Some emptyConstructor ; Some helpTextBinding ] + |> List.choose id + |> Some + XmlDoc = PreXmlDoc.create $"A partially-parsed %s{union.Original.Name.idText}." |> Some + Generics = + match union.Original.Generics with + | None -> None + | Some _ -> failwith $"Union type %s{union.Original.Name.idText} had generics, which we don't support." + TypeAccessibility = Some (SynAccess.Internal range0) + ImplAccessibility = None + Attributes = [] + } + + type internal AllInfo = + { + /// Map of identifier to parser + RecordParsers : IReadOnlyDictionary> + /// Map of identifier to parser + UnionParsers : IReadOnlyDictionary> + /// Map of identifier to DU information + FlagDus : Map + /// Map of identifier to DU information + DatalessUnions : Map + /// The original order the types appeared in. + OriginalOrder : Ident list + } + + /// Returns Error if we haven't yet obtained parse structures for the dependencies of this record. + let private parseRecord + (knownRecordParserTypes : IReadOnlyDictionary>) + (knownUnionParserTypes : IReadOnlyDictionary>) + (flagDus : FlagDu list) + (rt : RecordType) + : Result, string> + = + let getChoice (spec : ArgumentDefaultSpec option) : ArgumentDefaultSpec = + match spec with + | None -> + failwith + $"Non-positional Choice args must have an `[]` attribute on them, in record {rt.Name.idText}." + | Some spec -> spec + + let aggregated = + (Ok ([], [], []), rt.Fields) + ||> List.fold (fun aggr (SynField.SynField (idOpt = ident ; attributes = attrs ; fieldType = ty)) -> + match aggr with + | Error e -> Error e + | Ok (leaf, records, unions) -> + + match ident with + | None -> + failwith + $"expected all fields on record type %s{rt.Name.idText} to have a name, but at least one did not" + | Some ident -> + + let spec = + createParseFunction + getChoice + flagDus + knownRecordParserTypes.Keys + knownUnionParserTypes.Keys + ident + (SynAttributes.toAttrs attrs) + ty + + match spec with + | Error e -> Error e + | Ok spec -> + + match spec with + | Leaf data -> ((ident.idText, data) :: leaf, records, unions) |> Ok + | UserDefined (isRecord, typeName) -> + if isRecord then + match knownRecordParserTypes.TryGetValue typeName.idText with + | false, _ -> Error $"Record %s{typeName.idText} not yet parsed" + | true, v -> (leaf, (ident.idText, v) :: records, unions) |> Ok + else + match knownUnionParserTypes.TryGetValue typeName.idText with + | false, _ -> Error $"Union %s{typeName.idText} not yet parsed" + | true, v -> (leaf, records, (ident.idText, v) :: unions) |> Ok + | OptionOfUserDefined -> failwith "todo" + ) + + match aggregated with + | Error e -> Error e + | Ok (leaf, records, unions) -> + { + NameOfInProgressType = rt.Name.idText + "_InProgress" |> Ident.create + Original = rt + LeafNodes = leaf |> Map.ofList + Records = records |> Map.ofList + Unions = unions |> Map.ofList + FlagDus = flagDus + } + |> Ok + + /// Returns None if we haven't yet obtained parse structures for the dependencies of this union. + /// This function already knows that it's a parser: that is, every case has exactly one field. + /// It doesn't necessarily know that those fields can be parsed as records. + /// + /// This can fail, e.g. if we haven't yet learned all the record types on which this union depends. + let private parseUnion + (knownRecordTypes : IReadOnlyDictionary>) + (ut : UnionType) + : Result, string> + = + ut.Cases + |> List.map (fun case -> + let field = + match case.Fields with + | [ x ] -> x + | [] -> + failwith + $"Logic error: expected case %s{case.Name.idText} to have exactly one field, but it had none" + | _ -> + failwith + $"Logic error: expected case %s{case.Name.idText} to have exactly one field, but it had more than one" + + match field.Type with + | SynType.LongIdent (SynLongIdent.SynLongIdent (id = id)) -> + let desiredType = (List.last id).idText + + match knownRecordTypes.TryGetValue desiredType with + | false, _ -> Error $"Type not yet known: %s{desiredType}" + | true, v -> Ok (case.Name.idText, v) + | _ -> + failwith + "ArgParser generator requires discriminated union cases to each contain exactly one field which is a record type, to hold their data." + ) + |> List.allOkOrError + |> Result.map Map.ofList + |> Result.map (fun x -> + { + Original = ut + Cases = x + NameOfInProgressType = ut.Name.idText + "_InProgress" |> Ident.create + } + ) + + let internal parseStructureWithinNs + (unions : (UnionType * int) list) + (records : (RecordType * int) list) + : AllInfo + = + let flagDus, datalessUnions, parserUnions = + (([], [], []), unions) + ||> List.fold (fun (flagDus, datalessUnions, unions) (union, index) -> + match union.Cases |> List.tryFind (fun case -> not case.Fields.IsEmpty) with + | Some dataCarryingCase -> + match union.Cases |> List.tryFind (fun case -> case.Fields.Length <> 1) with + | Some badCase -> + failwith + $"Unions must either be dataless or every field must have exactly one member. Type %s{union.Name.idText} has case %s{dataCarryingCase.Name.idText} with data, but case %s{badCase.Name.idText} doesn't have exactly one field." + | None -> + // OK, all cases have exactly one field. + flagDus, datalessUnions, (union, index) :: unions + | None -> + + let datalessUnionBranch () = + let datalessUnion = + { + DatalessUnion.Cases = + union.Cases |> List.map (fun case -> case.Name.idText, case.Attributes) + } + + flagDus, (union.Name.idText, datalessUnion) :: datalessUnions, unions + + // dataless or flag + match union.Cases with + | [ c1 ; c2 ] -> + let c1Attr = + c1.Attributes + |> List.tryPick (fun attr -> + match attr.TypeName with + | SynLongIdent.SynLongIdent (id, _, _) -> + match id |> List.last |> _.idText with + | "ArgumentFlagAttribute" + | "ArgumentFlag" -> Some (SynExpr.stripOptionalParen attr.ArgExpr) + | _ -> None + ) + + let c2Attr = + c2.Attributes + |> List.tryPick (fun attr -> + match attr.TypeName with + | SynLongIdent.SynLongIdent (id, _, _) -> + match id |> List.last |> _.idText with + | "ArgumentFlagAttribute" + | "ArgumentFlag" -> Some (SynExpr.stripOptionalParen attr.ArgExpr) + | _ -> None + ) + + match c1Attr, c2Attr with + | Some _, None + | None, Some _ -> + failwith + "[] must be placed on both cases of a two-case discriminated union, with opposite argument values on each case." + | None, None -> + // actually a dataless union + datalessUnionBranch () + | Some c1Attr, Some c2Attr -> + + // Sanity check where possible + match c1Attr, c2Attr with + | SynExpr.Const (SynConst.Bool b1, _), SynExpr.Const (SynConst.Bool b2, _) -> + if b1 = b2 then + failwith + "[] must have opposite argument values on each case in a two-case discriminated union." + | _, _ -> () + + match c1.Fields, c2.Fields with + | [], [] -> + let flagDu = + { + Name = union.Name + Case1Name = c1.Name + Case1Arg = c1Attr + Case2Name = c2.Name + Case2Arg = c2Attr + } + + (union.Name.idText, flagDu) :: flagDus, datalessUnions, unions + | _, _ -> + failwith "[] may only be placed on discriminated union members with no data." + | _ -> datalessUnionBranch () + ) + + let allKnownUnionTypes = Dictionary () + let allKnownRecordTypes = Dictionary () + + let mutable keepLoopingReason = Some "not yet started" + + while keepLoopingReason.IsSome do + keepLoopingReason <- None + let mutable madeAChange = false + + for record, _ in records do + if not (allKnownRecordTypes.ContainsKey record.Name.idText) then + match parseRecord allKnownRecordTypes allKnownUnionTypes (flagDus |> List.map snd) record with + | Error e -> keepLoopingReason <- Some e + | Ok v -> + allKnownRecordTypes.Add (record.Name.idText, v) + madeAChange <- true + + for union, _ in parserUnions do + if not (allKnownUnionTypes.ContainsKey union.Name.idText) then + match parseUnion allKnownRecordTypes union with + | Error e -> keepLoopingReason <- Some e + | Ok v -> + allKnownUnionTypes.Add (union.Name.idText, v) + madeAChange <- true + + if not madeAChange then + let knownRecords = allKnownRecordTypes.Keys |> String.concat "," + let knownUnions = allKnownUnionTypes.Keys |> String.concat "," + + failwith + $"Cyclic dependency detected which we can't break. Known records:\n%s{knownRecords}\nKnown unions:\n%s{knownUnions}" + + let originalOrder = + parserUnions + |> Seq.map (fun (union, index) -> union.Name, index) + |> Seq.append (records |> Seq.map (fun (record, index) -> record.Name, index)) + |> Seq.sortBy snd + |> Seq.map fst + |> List.ofSeq + + { + RecordParsers = allKnownRecordTypes + UnionParsers = allKnownUnionTypes + FlagDus = Map.ofList flagDus + DatalessUnions = Map.ofList datalessUnions + OriginalOrder = originalOrder + } + + let helperModuleName (namespaceName : LongIdent) : Ident = + let ns = namespaceName |> List.map _.idText |> String.concat "_" + Ident.create $"ArgParseHelpers_%s{ns}" + + let createHelpersModule (opens : SynOpenDeclTarget list) (ns : LongIdent) (info : AllInfo) : SynModuleDecl = + let modName = helperModuleName ns + + let modInfo = + SynComponentInfo.create modName + |> SynComponentInfo.withAccessibility (SynAccess.Internal range0) + |> SynComponentInfo.withDocString (PreXmlDoc.create $"Helper types for arg parsing") + + let flagDuNames = info.FlagDus.Keys + + // We need to make sure the parsers appear in the right order, to capture dependencies. + let types = + info.OriginalOrder + |> Seq.map (fun ident -> + match info.RecordParsers.TryGetValue ident.idText with + | true, v -> inProgressRecordType v |> RecordType.ToAst + | false, _ -> + + match info.UnionParsers.TryGetValue ident.idText with + | true, v -> inProgressUnionType v |> RecordType.ToAst + | false, _ -> failwith $"didn't make a parser for ident %s{ident.idText}" + ) + |> Seq.toList + + let taggedMod = + [ + for openStatement in opens do + yield SynModuleDecl.openAny openStatement + yield SynModuleDecl.openAny (SynOpenDeclTarget.ModuleOrNamespace (SynLongIdent.create ns, range0)) + + yield types |> SynModuleDecl.createTypes + ] + |> SynModuleDecl.nestedModule modInfo + + taggedMod + + /// `let rec go (state : %ParseState%) (args : string list) : unit = ...` + let private mainLoop (parseState : Ident) (errorAcc : Ident) (leftoverArgs : Ident) : SynBinding = + /// `go (argNum + 1) (AwaitingValue arg)` + let recurseValue = + SynExpr.createIdent "go" + |> SynExpr.applyTo (SynExpr.paren (SynExpr.plus (SynExpr.createIdent "argNum_") (SynExpr.CreateConst 1))) + |> SynExpr.applyTo ( + SynExpr.paren ( + SynExpr.applyFunction + (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingValue" ]) + (SynExpr.createIdent "arg") + ) + ) + + /// `go (argNum + 1) AwaitingKey args` + let recurseKey = + (SynExpr.createIdent "go") + |> SynExpr.applyTo (SynExpr.paren (SynExpr.plus (SynExpr.createIdent "argNum_") (SynExpr.CreateConst 1))) + |> SynExpr.applyTo (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ]) + |> SynExpr.applyTo (SynExpr.createIdent "args") + + /// `positionals.Add arg ; go (argNum_ + 1) AwaitingKey args` + let fail = + [ + SynExpr.createIdent "positionals" + |> SynExpr.callMethodArg + "Add" + (SynExpr.tuple [ SynExpr.createIdent "arg" ; SynExpr.createIdent "argNum_" ] + |> SynExpr.applyFunction (SynExpr.createIdent "Choice1Of2") + |> SynExpr.paren) + + recurseKey + ] + |> SynExpr.sequential + + let processAsPositional = + SynExpr.sequential + [ + SynExpr.tuple [ SynExpr.createIdent "arg" ; SynExpr.createIdent "argNum_" ] + |> SynExpr.pipeThroughFunction choice1Of2 + |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' [ leftoverArgs ; Ident.create "Add" ]) + + recurseKey + ] + + let notMatched = + 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") + + handleFailure + + let argStartsWithDashes = startsWithDashes (SynExpr.createIdent "arg") + + let processKey = + SynExpr.ifThenElse + argStartsWithDashes + processAsPositional + (SynExpr.ifThenElse + (SynExpr.equals (SynExpr.createIdent "arg") (SynExpr.CreateConst "--help")) + (SynExpr.createLet + [ + SynBinding.basic + [ Ident.create "equals" ] + [] + (SynExpr.callMethodArg "IndexOf" (SynExpr.CreateConst '=') (SynExpr.createIdent "arg")) + ] + (SynExpr.ifThenElse + (SynExpr.lessThan (SynExpr.CreateConst 0) (SynExpr.createIdent "equals")) + (SynExpr.createLet + [ + SynBinding.basic + [ Ident.create "key" ] + [] + (SynExpr.arrayIndexRange + (Some (SynExpr.CreateConst 0)) + (Some (SynExpr.minusN (SynLongIdent.createS "equals") 1)) + (SynExpr.createIdent "arg")) + SynBinding.basic + [ Ident.create "value" ] + [] + (SynExpr.arrayIndexRange + (Some (SynExpr.plus (SynExpr.createIdent "equals") (SynExpr.CreateConst 1))) + None + (SynExpr.createIdent "arg")) + ] + (SynExpr.createMatch + (SynExpr.callMethodArg + "ProcessKeyValue" + (SynExpr.createIdent "argNum_") + (SynExpr.createIdent "inProgress") + |> SynExpr.applyTo (SynExpr.createIdent "errors_") + |> SynExpr.applyTo (SynExpr.createIdent "key") + |> SynExpr.applyTo (SynExpr.createIdent "value")) + [ + SynMatchClause.create (SynPat.nameWithArgs "Ok" [ SynPat.unit ]) recurseKey + + SynMatchClause.create + (SynPat.nameWithArgs "Error" [ SynPat.named "x" ]) + notMatched + ])) + (SynExpr.createIdent "args" |> SynExpr.applyFunction recurseValue))) + ( //SynExpr.createIdent "helpText" + //|> SynExpr.applyTo (SynExpr.CreateConst ()) + SynExpr.CreateConst "TODO" + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createIdent "failwithf") + (SynExpr.CreateConst @"Help text requested.\n%s") + ))) + + let processValue = + // During failure, we've received an optional exception message that happened when we tried to parse + // 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`. + // TODO: unused?! + let fail = + [ + SynExpr.createIdent "failwithf" + |> SynExpr.applyTo ( + SynExpr.CreateConst @"Unable to process supplied arg %s. Help text follows.\n%s" + ) + |> SynExpr.applyTo (SynExpr.createIdent "key") + |> SynExpr.applyTo ( + SynExpr.applyFunction (SynExpr.createIdent "helpText") (SynExpr.CreateConst ()) + |> SynExpr.paren + ) + |> SynMatchClause.create (SynPat.named "None") + + SynExpr.createIdent "msg" + |> SynExpr.pipeThroughFunction (SynExpr.dotGet "Add" (SynExpr.createIdent' errorAcc)) + |> SynMatchClause.create (SynPat.nameWithArgs "Some" [ SynPat.named "msg" ]) + ] + |> SynExpr.createMatch (SynExpr.createIdent "exc") + + let onFailure = + [ + SynExpr.tuple [ SynExpr.createIdent "key" ; SynExpr.createIdent "argNum_" ] + |> SynExpr.pipeThroughFunction choice1Of2 + |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' [ leftoverArgs ; Ident.create "Add" ]) + + SynExpr.createIdent "go" + |> SynExpr.applyTo ( + SynExpr.paren (SynExpr.plus (SynExpr.createIdent "argNum_") (SynExpr.CreateConst 1)) + ) + |> SynExpr.applyTo (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ]) + |> SynExpr.applyTo (SynExpr.listCons (SynExpr.createIdent "arg") (SynExpr.createIdent "args")) + ] + |> SynExpr.sequential + + [ + SynMatchClause.create + (SynPat.nameWithArgs "Ok" [ SynPat.unit ]) + (SynExpr.applyFunction + (SynExpr.applyFunction + (SynExpr.createIdent "go" |> SynExpr.applyTo (SynExpr.createIdent "argNum_")) + (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ])) + (SynExpr.createIdent "args")) + SynMatchClause.create + (SynPat.nameWithArgs "Error" [ SynPat.named "exc" ]) + (SynExpr.ifThenElse + (SynExpr.applyFunction + (SynExpr.callMethodArg + "SetFlagValue_" + (SynExpr.createIdent "errors_") + (SynExpr.createIdent "inProgress")) + (SynExpr.createIdent "key")) + onFailure + (SynExpr.createIdent "go" + |> SynExpr.applyTo (SynExpr.createIdent "argNum_") + |> SynExpr.applyTo (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ]) + |> SynExpr.applyTo (SynExpr.listCons (SynExpr.createIdent "arg") (SynExpr.createIdent "args")))) + ] + |> SynExpr.createMatch ( + SynExpr.applyFunction + (SynExpr.callMethodArg + "ProcessKeyValue" + (SynExpr.createIdent "argNum_") + (SynExpr.createIdent "inProgress")) + (SynExpr.createIdent "errors_") + |> SynExpr.applyTo (SynExpr.createIdent "key") + |> SynExpr.applyTo (SynExpr.createIdent "arg") + ) + + let argBody = + [ + SynMatchClause.create + (SynPat.identWithArgs [ parseState ; Ident.create "AwaitingKey" ] (SynArgPats.create [])) + processKey + SynMatchClause.create + (SynPat.identWithArgs + [ parseState ; Ident.create "AwaitingValue" ] + (SynArgPats.createNamed [ "key" ])) + processValue + ] + |> SynExpr.createMatch (SynExpr.createIdent "state") + + let body = + let trailingArgMessage = + SynExpr.createIdent "sprintf" + |> SynExpr.applyTo ( + SynExpr.CreateConst + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + ) + |> SynExpr.applyTo (SynExpr.createIdent "key") + + [ + SynMatchClause.create + SynPat.emptyList + (SynExpr.createMatch + (SynExpr.createIdent "state") + [ + SynMatchClause.create + (SynPat.identWithArgs [ parseState ; Ident.create "AwaitingKey" ] (SynArgPats.create [])) + (SynExpr.CreateConst ()) + SynMatchClause.create + (SynPat.identWithArgs + [ parseState ; Ident.create "AwaitingValue" ] + (SynArgPats.createNamed [ "key" ])) + (SynExpr.ifThenElse + (SynExpr.applyFunction + (SynExpr.callMethodArg + "SetFlagValue_" + (SynExpr.createIdent "errors_") + (SynExpr.createIdent "inProgress")) + (SynExpr.createIdent "key")) + (trailingArgMessage + |> SynExpr.pipeThroughFunction ( + SynExpr.dotGet "Add" (SynExpr.createIdent' errorAcc) + )) + (SynExpr.CreateConst ())) + ]) + SynMatchClause.create + (SynPat.listCons (SynPat.createConst (SynConst.Create "--")) (SynPat.named "rest")) + (SynExpr.callMethodArg + "AddRange" + (SynExpr.paren ( + SynExpr.createIdent "rest" + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createLongIdent [ "Seq" ; "map" ]) + (SynExpr.createLambda + "x" + (SynExpr.tuple + [ + SynExpr.createIdent "x" + SynExpr.plus (SynExpr.createIdent "argNum_") (SynExpr.CreateConst 1) + ])) + ) + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction (SynExpr.createLongIdent [ "Seq" ; "map" ]) choice2Of2 + ) + )) + (SynExpr.createIdent' leftoverArgs)) + SynMatchClause.create (SynPat.listCons (SynPat.named "arg") (SynPat.named "args")) argBody + ] + |> SynExpr.createMatch (SynExpr.createIdent "args") + + let args = + [ + SynPat.named "argNum_" |> SynPat.annotateType SynType.int + SynPat.named "state" + |> SynPat.annotateType (SynType.createLongIdent [ parseState ]) + SynPat.named "args" + |> SynPat.annotateType (SynType.appPostfix "list" SynType.string) + ] + + SynBinding.basic [ Ident.create "go" ] args body + |> SynBinding.withRecursion true + + // The type for which we're generating args may refer to any of the supplied records/unions. + let createModule + (opens : SynOpenDeclTarget list) + (ns : LongIdent) + ((taggedType : LongIdent, spec : ArgParserOutputSpec)) + (helperModName : LongIdent) + (structures : AllInfo) + : SynModuleOrNamespace + = + let taggedType = + match structures.RecordParsers.TryGetValue (List.last(taggedType).idText) with + | false, _ -> failwith "[] currently only supports being placed on records." + | true, v -> v.Original + + let taggedTypeInfo = structures.RecordParsers.[taggedType.Name.idText] + + let modAttrs, modName = + if spec.ExtensionMethods then + [ SynAttribute.autoOpen ], Ident.create (taggedType.Name.idText + "ArgParse") + else + [ SynAttribute.requireQualifiedAccess ; SynAttribute.compilationRepresentation ], taggedType.Name + + let modInfo = + SynComponentInfo.create modName + |> SynComponentInfo.withDocString ( + PreXmlDoc.create $"Methods to parse arguments for the type %s{taggedType.Name.idText}" + ) + |> SynComponentInfo.addAttributes modAttrs + + let parseStateIdent = Ident.create $"ParseState_%s{taggedType.Name.idText}" + + let parseStateType = + [ + SynUnionCase.create + { + Attributes = [] + Fields = [] + Name = Ident.create "AwaitingKey" + XmlDoc = Some (PreXmlDoc.create "Ready to consume a key or positional arg") + Access = None + } + SynUnionCase.create + { + Attributes = [] + Fields = + [ + { + Attrs = [] + Ident = Some (Ident.create "key") + Type = SynType.string + } + ] + Name = Ident.create "AwaitingValue" + XmlDoc = Some (PreXmlDoc.create "Waiting to receive a value for the key we've already consumed") + Access = None + } + ] + |> SynTypeDefnRepr.union + |> SynTypeDefn.create ( + SynComponentInfo.create parseStateIdent + |> SynComponentInfo.setAccessibility (Some (SynAccess.Internal range0)) + ) + |> List.singleton + |> SynModuleDecl.createTypes + + let taggedMod = + let argsParam = + SynPat.named "args" + |> SynPat.annotateType (SynType.appPostfix "list" SynType.string) + + let raiseErrors (errorIdent : Ident) = + SynExpr.createIdent' errorIdent + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createLongIdent [ "String" ; "concat" ]) + (SynExpr.createLongIdent [ "System" ; "Environment" ; "NewLine" ]) + ) + |> SynExpr.pipeThroughFunction ( + SynExpr.createLambda + "x" + (SynExpr.plus (SynExpr.CreateConst "Errors during parse!\\n") (SynExpr.createIdent "x")) + ) + |> SynExpr.pipeThroughFunction (SynExpr.createIdent "failwith") + + // If we reach the end of the parse and there were positionals which were not consumed, + // we call this, which represents a parse failure. + // In scope are `positionals` (a ResizeArray of Choice<(string * int), (string * int)>) + // and `result`, an otherwise successful parsed output. + let printUnmatchedArgs = + SynExpr.createIdent "positionals" + // Map the Choice<_, _> to just the string argument + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createLongIdent [ "Seq" ; "map" ]) + (SynExpr.createLambda + "choiceValue" + (SynExpr.createMatch + (SynExpr.createIdent "choiceValue") + [ + // Case for args before '--' + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Choice1Of2" ] + (SynArgPats.create [ SynPat.tuple [ SynPat.named "arg" ; SynPat.anon ] ])) + (SynExpr.createIdent "arg") + // Case for args after '--' + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Choice2Of2" ] + (SynArgPats.create [ SynPat.tuple [ SynPat.named "arg" ; SynPat.anon ] ])) + (SynExpr.createIdent "arg") + ])) + ) + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction (SynExpr.createLongIdent [ "String" ; "concat" ]) (SynExpr.CreateConst " ") + ) + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createIdent "sprintf") + (SynExpr.CreateConst "Parse error: The following arguments were not consumed: %s") + ) + |> SynExpr.pipeThroughFunction (SynExpr.createIdent "failwith") + + let parsePrime = + [ + SynExpr.applyFunction + (SynExpr.applyFunction (SynExpr.createIdent "go") (SynExpr.CreateConst 0)) + (SynExpr.createLongIdent' [ parseStateIdent ; Ident.create "AwaitingKey" ]) + |> SynExpr.applyTo (SynExpr.createIdent "args") + + SynExpr.ifThenElse + (SynExpr.dotGet "Count" (SynExpr.createIdent "errors_") + |> SynExpr.equals (SynExpr.CreateConst 0)) + (raiseErrors (Ident.create "errors_")) + (SynExpr.CreateConst ()) + + [ + SynMatchClause.create + (SynPat.nameWithArgs + "Ok" + [ SynPat.tuple [ SynPat.named "result" ; SynPat.named "posConsumer" ] ]) + (SynExpr.ifThenElse + (SynExpr.booleanAnd + (SynExpr.dotGet "Count" (SynExpr.createIdent "positionals") + |> SynExpr.greaterThan (SynExpr.CreateConst 0)) + (SynExpr.dotGet "IsNone" (SynExpr.createIdent "posConsumer"))) + (SynExpr.createIdent "result") + printUnmatchedArgs) + SynMatchClause.create + (SynPat.nameWithArgs "Error" [ SynPat.named "e" ]) + (raiseErrors (Ident.create "e")) + ] + |> SynExpr.createMatch ( + SynExpr.callMethodArg + "Assemble_" + (SynExpr.createIdent "getEnvironmentVariable") + (SynExpr.createIdent "inProgress") + |> SynExpr.applyTo ( + SynExpr.createIdent "positionals" + |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Seq" ; "toList" ]) + |> SynExpr.paren + ) + ) + ] + |> SynExpr.sequential + |> SynExpr.createLet + [ + SynBinding.basic + [ Ident.create "errors_" ] + [] + (SynExpr.applyFunction (SynExpr.createIdent "ResizeArray") (SynExpr.CreateConst ())) + mainLoop parseStateIdent (Ident.create "errors_") (Ident.create "positionals") + ] + |> SynExpr.createLet + [ + SynBinding.basic + [ Ident.create "inProgress" ] + [] + (SynExpr.applyFunction + (SynExpr.createLongIdent' ( + helperModName @ [ taggedTypeInfo.NameOfInProgressType ; Ident.create "_Empty" ] + )) + (SynExpr.CreateConst ())) + + SynBinding.basic + [ Ident.create "positionals" ] + [] + (SynExpr.applyFunction (SynExpr.createIdent "ResizeArray") (SynExpr.CreateConst ())) + |> SynBinding.withReturnAnnotation ( + SynType.app + "ResizeArray" + [ + SynType.app + "Choice" + [ + SynType.tupleNoParen [ SynType.string ; SynType.int ] |> Option.get + SynType.tupleNoParen [ SynType.string ; SynType.int ] |> Option.get + ] + ] + ) + ] + |> SynBinding.basic + [ Ident.create "parse'" ] + [ + SynPat.named "getEnvironmentVariable" + |> SynPat.annotateType (SynType.funFromDomain SynType.string SynType.string) + argsParam + ] + |> SynBinding.withReturnAnnotation (SynType.createLongIdent [ taggedType.Name ]) + + let parsePrimeCall = + if spec.ExtensionMethods then + // need to fully qualify + [ taggedType.Name ; Ident.create "parse'" ] + else + [ Ident.create "parse'" ] + + let parse = + SynExpr.createLongIdent' parsePrimeCall + |> SynExpr.applyTo (SynExpr.createLongIdent [ "System" ; "Environment" ; "GetEnvironmentVariable" ]) + |> SynExpr.applyTo (SynExpr.createIdent "args") + |> SynBinding.basic [ Ident.create "parse" ] [ argsParam ] + |> SynBinding.withReturnAnnotation (SynType.createLongIdent [ taggedType.Name ]) + + [ + yield parseStateType + + if spec.ExtensionMethods then + let bindingPrime = parsePrime |> SynMemberDefn.staticMember + + let binding = parse |> SynMemberDefn.staticMember + + let componentInfo = + SynComponentInfo.create taggedType.Name + |> SynComponentInfo.withDocString (PreXmlDoc.create "Extension methods for argument parsing") + + let containingType = + SynTypeDefnRepr.augmentation () + |> SynTypeDefn.create componentInfo + |> SynTypeDefn.withMemberDefns [ bindingPrime ; binding ] + + yield SynModuleDecl.createTypes [ containingType ] + else + yield SynModuleDecl.createLet parsePrime + + yield SynModuleDecl.createLet parse + ] + |> SynModuleDecl.nestedModule modInfo + + [ + for openStatement in opens do + yield SynModuleDecl.openAny openStatement + yield taggedMod + ] + |> SynModuleOrNamespace.createNamespace ns + +open Myriad.Core + +/// Myriad generator that provides a catamorphism for an algebraic data type. +[] +type ShibaGenerator () = + + interface IMyriadGenerator with + member _.ValidInputExtensions = [ ".fs" ] + + member _.Generate (context : GeneratorContext) = + // try + // System.IO.File.Delete "/tmp/myriad.log" + // with + // | _ -> () + + let ast, _ = + Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head + + let types = Ast.getTypes ast |> List.map (fun (ns, types) -> ns, types) + + let opens = AstHelper.extractOpens ast + + let namespaceAndTypes = + types + |> List.map (fun (ns, types) -> + let unions, records, _others, _ = + (([], [], [], 0), types) + ||> List.fold (fun + (unions, records, others, index) + (SynTypeDefn.SynTypeDefn (sci, repr, smd, _, _, _) as ty) -> + match repr with + | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (access, cases, _), _) -> + (UnionType.OfUnion sci smd access cases, index) :: unions, records, others, index + 1 + | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (access, fields, _), _) -> + unions, + (RecordType.OfRecord sci smd access fields, index) :: records, + others, + index + 1 + | _ -> unions, records, ty :: others, index + 1 + ) + + let typeWithAttr = + types + |> List.choose (fun ty -> + match SynTypeDefn.getAttribute typeof.Name ty with + | None -> None + | Some attr -> + let arg = + match SynExpr.stripOptionalParen attr.ArgExpr with + | SynExpr.Const (SynConst.Bool value, _) -> value + | SynExpr.Const (SynConst.Unit, _) -> ArgParserAttribute.DefaultIsExtensionMethod + | arg -> + failwith + $"Unrecognised argument %+A{arg} to [<%s{nameof ArgParserAttribute}>]. Literals are not supported. Use `true` or `false` (or unit) only." + + let spec = + { + ExtensionMethods = arg + } + + let (SynTypeDefn (SynComponentInfo (longId = ident), _, _, _, _, _)) = ty + Some (ident, spec) + ) + + ns, typeWithAttr, unions, records + ) + + let allUnionsAndRecordsByNs = + (Map.empty, namespaceAndTypes) + ||> List.fold (fun types (ns, _, unions, records) -> + let nsKey = ns |> List.map _.idText |> String.concat "." + + types + |> Map.change + nsKey + (fun v -> + match v with + | None -> Some (unions, records) + | Some (u, r) -> Some (unions @ u, records @ r) + ) + ) + + let allStructuresWithinNs = + allUnionsAndRecordsByNs + |> Map.map (fun _ (us, rs) -> ShibaGenerator.parseStructureWithinNs us rs) + + let helperModNamespaceName = Ident.create "ArgParserHelpers" + + let helpersMod = + allStructuresWithinNs + |> Map.toSeq + |> Seq.map (fun (ns, info) -> + ShibaGenerator.createHelpersModule opens (ns.Split '.' |> Seq.map Ident.create |> List.ofSeq) info + ) + |> Seq.toList + |> fun l -> [ yield! l ] + |> SynModuleOrNamespace.createNamespace [ helperModNamespaceName ] + + let modules = + namespaceAndTypes + |> List.collect (fun (ns, taggedTypes, _, _) -> + let opens = + SynOpenDeclTarget.ModuleOrNamespace (SynLongIdent.create [ helperModNamespaceName ], range0) + :: opens + + taggedTypes + |> List.map (fun taggedType -> + ShibaGenerator.createModule + opens + ns + taggedType + [ ShibaGenerator.helperModuleName ns ] + allStructuresWithinNs.[ns |> List.map _.idText |> String.concat "."] + ) + ) + + Output.Ast (helpersMod :: modules) diff --git a/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj b/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj index 08db020f..468a892e 100644 --- a/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj +++ b/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj @@ -40,7 +40,8 @@ - + + diff --git a/WoofWare.Myriad.sln b/WoofWare.Myriad.sln index 61d3d2ba..14f8b813 100644 --- a/WoofWare.Myriad.sln +++ b/WoofWare.Myriad.sln @@ -10,6 +10,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WoofWare.Myriad.Plugins.Att EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WoofWare.Myriad.Plugins.Attributes.Test", "WoofWare.Myriad.Plugins.Attributes\Test\WoofWare.Myriad.Plugins.Attributes.Test.fsproj", "{26DC0C94-85F2-45B4-8FA1-1B27201F7AFB}" EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Playground", "Playground\Playground.fsproj", "{6DF8C756-DE59-4AFF-A4BB-2D05C74192A4}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -36,5 +38,9 @@ Global {26DC0C94-85F2-45B4-8FA1-1B27201F7AFB}.Debug|Any CPU.Build.0 = Debug|Any CPU {26DC0C94-85F2-45B4-8FA1-1B27201F7AFB}.Release|Any CPU.ActiveCfg = Release|Any CPU {26DC0C94-85F2-45B4-8FA1-1B27201F7AFB}.Release|Any CPU.Build.0 = Release|Any CPU + {6DF8C756-DE59-4AFF-A4BB-2D05C74192A4}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {6DF8C756-DE59-4AFF-A4BB-2D05C74192A4}.Debug|Any CPU.Build.0 = Debug|Any CPU + {6DF8C756-DE59-4AFF-A4BB-2D05C74192A4}.Release|Any CPU.ActiveCfg = Release|Any CPU + {6DF8C756-DE59-4AFF-A4BB-2D05C74192A4}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection EndGlobal