From 4befdb93e58b4459da762ca921be0c3d64ea8b65 Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Sun, 13 Apr 2025 18:43:23 +0100 Subject: [PATCH] WIP: define the helper types --- ConsumePlugin/ConsumePlugin.fsproj | 4 + ConsumePlugin/GeneratedArgs.fs | 4943 +++-------------- Playground/Domain.fs | 1 - Playground/Library.fs | 737 ++- Playground/Program.fs | 7 +- WoofWare.Myriad.Plugins/ShibaGenerator.fs | 629 +++ .../WoofWare.Myriad.Plugins.fsproj | 3 +- 7 files changed, 1764 insertions(+), 4560 deletions(-) create mode 100644 WoofWare.Myriad.Plugins/ShibaGenerator.fs diff --git a/ConsumePlugin/ConsumePlugin.fsproj b/ConsumePlugin/ConsumePlugin.fsproj index 7d053e9..4192730 100644 --- a/ConsumePlugin/ConsumePlugin.fsproj +++ b/ConsumePlugin/ConsumePlugin.fsproj @@ -12,6 +12,7 @@ + Args.fs + diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index 7a0752f..f852cda 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -8,4159 +8,224 @@ -namespace ConsumePlugin +namespace ArgParserHelpers + +/// Helper types for arg parsing +module private ArgParseHelpers_ConsumePlugin = + open System + open System.IO + open WoofWare.Myriad.Plugins + open ConsumePlugin + + /// A partially-parsed BasicNoPositionals. + type private BasicNoPositionals_InProgress = + { + Foo : System.Int32 option + Bar : System.String option + Baz : System.Boolean option + Rest : string list + } + + member this.Assemble (positionals : string list) : BasicNoPositionals = "TODO: now construct the object" + + /// A partially-parsed Basic. + type private Basic_InProgress = + { + Foo : System.Int32 option + Bar : System.String option + Baz : System.Boolean option + } + + member this.Assemble (positionals : string list) : Basic = "TODO: now construct the object" + + /// A partially-parsed BasicWithIntPositionals. + type private BasicWithIntPositionals_InProgress = + { + Foo : System.Int32 option + Bar : System.String option + Baz : System.Boolean option + } + + member this.Assemble (positionals : string list) : BasicWithIntPositionals = "TODO: now construct the object" + + /// A partially-parsed LoadsOfTypes. + type private LoadsOfTypes_InProgress = + { + Foo : System.Int32 option + Bar : System.String option + Baz : System.Boolean option + SomeFile : FileInfo option + SomeDirectory : DirectoryInfo option + SomeList : string list + OptionalThingWithNoDefault : int option + OptionalThing : bool option + AnotherOptionalThing : int option + YetAnotherOptionalThing : string option + } + + member this.Assemble (positionals : string list) : LoadsOfTypes = "TODO: now construct the object" + + /// A partially-parsed LoadsOfTypesNoPositionals. + type private LoadsOfTypesNoPositionals_InProgress = + { + Foo : System.Int32 option + Bar : System.String option + Baz : System.Boolean option + SomeFile : FileInfo option + SomeDirectory : DirectoryInfo option + SomeList : string list + OptionalThingWithNoDefault : int option + OptionalThing : bool option + AnotherOptionalThing : int option + YetAnotherOptionalThing : string option + } + + member this.Assemble (positionals : string list) : LoadsOfTypesNoPositionals = "TODO: now construct the object" + + /// A partially-parsed DatesAndTimes. + type private DatesAndTimes_InProgress = + { + Plain : TimeSpan option + Invariant : TimeSpan option + Exact : TimeSpan option + InvariantExact : TimeSpan option + } + + member this.Assemble (positionals : string list) : DatesAndTimes = "TODO: now construct the object" + + /// A partially-parsed ChildRecord. + type private ChildRecord_InProgress = + { + Thing1 : System.Int32 option + Thing2 : System.String option + } + + member this.Assemble (positionals : string list) : ChildRecord = "TODO: now construct the object" + + /// A partially-parsed ParentRecord. + type private ParentRecord_InProgress = + { + Child : ChildRecord_InProgress + AndAnother : System.Boolean option + } + + member this.Assemble (positionals : string list) : ParentRecord = "TODO: now construct the object" + + /// A partially-parsed ChildRecordWithPositional. + type private ChildRecordWithPositional_InProgress = + { + Thing1 : System.Int32 option + } + + member this.Assemble (positionals : string list) : ChildRecordWithPositional = "TODO: now construct the object" + + /// A partially-parsed ParentRecordChildPos. + type private ParentRecordChildPos_InProgress = + { + Child : ChildRecordWithPositional_InProgress + AndAnother : System.Boolean option + } + + member this.Assemble (positionals : string list) : ParentRecordChildPos = "TODO: now construct the object" + + /// A partially-parsed ParentRecordSelfPos. + type private ParentRecordSelfPos_InProgress = + { + Child : ChildRecord_InProgress + } + + member this.Assemble (positionals : string list) : ParentRecordSelfPos = "TODO: now construct the object" + + /// A partially-parsed ChoicePositionals. + type private ChoicePositionals_InProgress = + { + _Dummy : unit + } + + member this.Assemble (positionals : string list) : ChoicePositionals = "TODO: now construct the object" + + /// A partially-parsed ContainsBoolEnvVar. + type private ContainsBoolEnvVar_InProgress = + { + BoolVar : bool option + } + + member this.Assemble (positionals : string list) : ContainsBoolEnvVar = "TODO: now construct the object" + + /// A partially-parsed WithFlagDu. + type private WithFlagDu_InProgress = + { + DryRun : DryRunMode option + } + + member this.Assemble (positionals : string list) : WithFlagDu = "TODO: now construct the object" + + /// A partially-parsed ContainsFlagEnvVar. + type private ContainsFlagEnvVar_InProgress = + { + DryRun : DryRunMode option + } + + member this.Assemble (positionals : string list) : ContainsFlagEnvVar = "TODO: now construct the object" + + /// A partially-parsed ContainsFlagDefaultValue. + type private ContainsFlagDefaultValue_InProgress = + { + DryRun : DryRunMode option + } + + member this.Assemble (positionals : string list) : ContainsFlagDefaultValue = "TODO: now construct the object" + + /// A partially-parsed ManyLongForms. + type private ManyLongForms_InProgress = + { + DoTheThing : System.String option + SomeFlag : System.Boolean option + } + + member this.Assemble (positionals : string list) : ManyLongForms = "TODO: now construct the object" + + /// A partially-parsed FlagsIntoPositionalArgs. + type private FlagsIntoPositionalArgs_InProgress = + { + A : System.String option + } + + member this.Assemble (positionals : string list) : FlagsIntoPositionalArgs = "TODO: now construct the object" + + /// A partially-parsed FlagsIntoPositionalArgsChoice. + type private FlagsIntoPositionalArgsChoice_InProgress = + { + A : System.String option + } + + member this.Assemble (positionals : string list) : FlagsIntoPositionalArgsChoice = + "TODO: now construct the object" + + /// A partially-parsed FlagsIntoPositionalArgsInt. + type private FlagsIntoPositionalArgsInt_InProgress = + { + A : System.String option + } -open System -open System.IO -open WoofWare.Myriad.Plugins + member this.Assemble (positionals : string list) : FlagsIntoPositionalArgsInt = "TODO: now construct the object" + + /// A partially-parsed FlagsIntoPositionalArgsIntChoice. + type private FlagsIntoPositionalArgsIntChoice_InProgress = + { + A : System.String option + } -/// 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 + member this.Assemble (positionals : string list) : FlagsIntoPositionalArgsIntChoice = + "TODO: now construct the object" + + /// A partially-parsed FlagsIntoPositionalArgs'. + type private FlagsIntoPositionalArgs'_InProgress = + { + A : System.String option + } - 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 () - - /// 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" "rest", System.StringComparison.OrdinalIgnoreCase) then - value |> (fun x -> System.Int32.Parse x) |> arg_3.Add - () |> Ok - 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 - - 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 - - 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 - - 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" "baz", System.StringComparison.OrdinalIgnoreCase) then - match arg_2 with - | Some x -> - sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "baz") - |> ArgParser_errors.Add - - true - | None -> - arg_2 <- 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 - - 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 = arg_3 |> Seq.toList - - 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 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 - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "baz") - (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" "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 - - 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 - - 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" "rest", System.StringComparison.OrdinalIgnoreCase) then - value |> (fun x -> x) |> arg_3.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" "baz", System.StringComparison.OrdinalIgnoreCase) then - match arg_2 with - | Some x -> - sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "baz") - |> ArgParser_errors.Add - - true - | None -> - arg_2 <- 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) - - if equals < 0 then - args |> go (ParseState_Basic.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] - - 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" - - let parse (args : string list) : Basic = - parse' System.Environment.GetEnvironmentVariable args -namespace ConsumePlugin - -open System -open System.IO -open WoofWare.Myriad.Plugins - -/// 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 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 - - /// 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 - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "baz") - (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" "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 - - 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 - - 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" "rest", System.StringComparison.OrdinalIgnoreCase) then - value |> (fun x -> System.Int32.Parse x) |> arg_3.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" "baz", System.StringComparison.OrdinalIgnoreCase) then - match arg_2 with - | Some x -> - sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "baz") - |> ArgParser_errors.Add - - true - | None -> - arg_2 <- 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) - - if equals < 0 then - args |> go (ParseState_BasicWithIntPositionals.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] - - 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 parse (args : string list) : BasicWithIntPositionals = - parse' System.Environment.GetEnvironmentVariable args -namespace ConsumePlugin - -open System -open System.IO -open WoofWare.Myriad.Plugins - -/// 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 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 - - /// 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" "yet-another-optional-thing", - System.StringComparison.OrdinalIgnoreCase - ) - then - match arg_10 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 - - Ok () - | None -> - try - arg_10 <- 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 arg_9 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "another-optional-thing") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add - - Ok () - | None -> - try - arg_9 <- value |> (fun x -> System.Int32.Parse x) |> Some - Ok () - with _ as exc -> - exc.Message |> Some |> Error - else if - System.String.Equals (key, sprintf "--%s" "optional-thing", System.StringComparison.OrdinalIgnoreCase) - then - match arg_8 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "optional-thing") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add - - Ok () - | None -> - try - arg_8 <- value |> (fun x -> System.Boolean.Parse x) |> Some - Ok () - with _ as exc -> - exc.Message |> Some |> Error - else if - System.String.Equals ( - key, - sprintf "--%s" "optional-thing-with-no-default", - System.StringComparison.OrdinalIgnoreCase - ) - then - match arg_6 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 - - Ok () - | None -> - try - arg_6 <- 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) - then - match arg_4 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "some-directory") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add - - Ok () - | None -> - try - arg_4 <- value |> (fun x -> System.IO.DirectoryInfo 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 - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "some-file") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add - - 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 - - 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 - - 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 - - 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" "positionals", System.StringComparison.OrdinalIgnoreCase) - then - value |> (fun x -> System.Int32.Parse x) |> arg_7.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" "optional-thing", System.StringComparison.OrdinalIgnoreCase) - then - match arg_8 with - | Some x -> - sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "optional-thing") - |> ArgParser_errors.Add - - true - | None -> - arg_8 <- 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 - - true - | None -> - arg_2 <- 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) - - if equals < 0 then - args |> go (ParseState_LoadsOfTypes.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] - - 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 - - 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 parse (args : string list) : LoadsOfTypes = - parse' System.Environment.GetEnvironmentVariable args -namespace ConsumePlugin - -open System -open System.IO -open WoofWare.Myriad.Plugins - -/// 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 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 - - /// 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" "yet-another-optional-thing", - System.StringComparison.OrdinalIgnoreCase - ) - then - match arg_9 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 - - Ok () - | None -> - try - arg_9 <- 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 arg_8 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "another-optional-thing") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add - - Ok () - | None -> - try - arg_8 <- value |> (fun x -> System.Int32.Parse x) |> Some - Ok () - with _ as exc -> - exc.Message |> Some |> Error - else if - System.String.Equals (key, sprintf "--%s" "optional-thing", System.StringComparison.OrdinalIgnoreCase) - then - match arg_7 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "optional-thing") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add - - Ok () - | None -> - try - arg_7 <- value |> (fun x -> System.Boolean.Parse x) |> Some - Ok () - with _ as exc -> - exc.Message |> Some |> Error - else if - System.String.Equals ( - key, - sprintf "--%s" "optional-thing-with-no-default", - System.StringComparison.OrdinalIgnoreCase - ) - then - match arg_6 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 - - Ok () - | None -> - try - arg_6 <- 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) - then - match arg_4 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "some-directory") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add - - Ok () - | None -> - try - arg_4 <- value |> (fun x -> System.IO.DirectoryInfo 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 - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "some-file") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add - - 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 - - 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 - - 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 - - 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" "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 - - 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 - - true - | None -> - arg_2 <- true |> Some - true - else - false - - let rec go (state : ParseState_LoadsOfTypesNoPositionals) (args : string list) = - match args with - | [] -> - match state with - | ParseState_LoadsOfTypesNoPositionals.AwaitingKey -> () - | ParseState_LoadsOfTypesNoPositionals.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_LoadsOfTypesNoPositionals.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_LoadsOfTypesNoPositionals.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] - - match processKeyValue key value with - | Ok () -> go ParseState_LoadsOfTypesNoPositionals.AwaitingKey args - | Error x -> - match x with - | None -> - failwithf "Unable to process argument %s as key %s and value %s" arg key value - | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_LoadsOfTypesNoPositionals.AwaitingKey args - else - arg |> (fun x -> x) |> parser_LeftoverArgs.Add - go ParseState_LoadsOfTypesNoPositionals.AwaitingKey args - | ParseState_LoadsOfTypesNoPositionals.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_LoadsOfTypesNoPositionals.AwaitingKey args - | Error exc -> - if setFlagValue key then - go 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 - - Unchecked.defaultof<_> - | x -> x |> (fun x -> x) - |> Choice2Of2 - | Some x -> Choice1Of2 x - - 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 - } - else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" - - let parse (args : string list) : LoadsOfTypesNoPositionals = - parse' System.Environment.GetEnvironmentVariable args -namespace ConsumePlugin - -open System -open System.IO -open WoofWare.Myriad.Plugins - -/// Methods to parse arguments for the type DatesAndTimes -[] -module DatesAndTimesArgParse = - type private ParseState_DatesAndTimes = - /// 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 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 - - 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) = - match args with - | [] -> - match state with - | ParseState_DatesAndTimes.AwaitingKey -> () - | ParseState_DatesAndTimes.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_DatesAndTimes.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_DatesAndTimes.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] - - match processKeyValue key value with - | Ok () -> go ParseState_DatesAndTimes.AwaitingKey args - | Error x -> - match x with - | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value - | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_DatesAndTimes.AwaitingKey args - else - arg |> (fun x -> x) |> parser_LeftoverArgs.Add - go ParseState_DatesAndTimes.AwaitingKey args - | ParseState_DatesAndTimes.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_DatesAndTimes.AwaitingKey args - | Error exc -> - if setFlagValue key then - go 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 - - let arg_3 = - match arg_3 with - | None -> - sprintf "Required argument '%s' received no value" (sprintf "--%s" "invariant-exact") - |> ArgParser_errors.Add - - Unchecked.defaultof<_> - | Some x -> x - - if 0 = ArgParser_errors.Count then - { - Exact = arg_2 - Invariant = arg_1 - InvariantExact = arg_3 - Plain = arg_0 - } - else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" - - static member parse (args : string list) : DatesAndTimes = - DatesAndTimes.parse' System.Environment.GetEnvironmentVariable args -namespace ConsumePlugin - -open System -open System.IO -open WoofWare.Myriad.Plugins - -/// Methods to parse arguments for the type ParentRecord -[] -module ParentRecordArgParse = - type private ParseState_ParentRecord = - /// 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 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 rec go (state : ParseState_ParentRecord) (args : string list) = - match args with - | [] -> - match state with - | ParseState_ParentRecord.AwaitingKey -> () - | ParseState_ParentRecord.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_ParentRecord.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_ParentRecord.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] - - match processKeyValue key value with - | Ok () -> go ParseState_ParentRecord.AwaitingKey args - | Error x -> - match x with - | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value - | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ParentRecord.AwaitingKey args - else - arg |> (fun x -> x) |> parser_LeftoverArgs.Add - go ParseState_ParentRecord.AwaitingKey args - | ParseState_ParentRecord.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_ParentRecord.AwaitingKey args - | Error exc -> - if setFlagValue key then - go 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 - - Unchecked.defaultof<_> - | Some x -> x - - if 0 = ArgParser_errors.Count then - { - AndAnother = arg_2 - Child = - { - Thing1 = arg_0 - Thing2 = arg_1 - } - } - else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" - - static member parse (args : string list) : ParentRecord = - ParentRecord.parse' System.Environment.GetEnvironmentVariable args -namespace ConsumePlugin - -open System -open System.IO -open WoofWare.Myriad.Plugins - -/// Methods to parse arguments for the type ParentRecordChildPos -[] -module ParentRecordChildPosArgParse = - type private ParseState_ParentRecordChildPos = - /// 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 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 - - 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 rec go (state : ParseState_ParentRecordChildPos) (args : string list) = - match args with - | [] -> - match state with - | ParseState_ParentRecordChildPos.AwaitingKey -> () - | ParseState_ParentRecordChildPos.AwaitingValue key -> - if setFlagValue key then - () - else - sprintf - "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." - key - |> ArgParser_errors.Add - | "--" :: rest -> arg_1.AddRange (rest |> Seq.map (fun x -> System.Uri x)) - | 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" - else - let equals = arg.IndexOf (char 61) - - if equals < 0 then - args |> go (ParseState_ParentRecordChildPos.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] - - match processKeyValue key value with - | Ok () -> go ParseState_ParentRecordChildPos.AwaitingKey args - | Error x -> - match x with - | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value - | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ParentRecordChildPos.AwaitingKey args - else - arg |> (fun x -> System.Uri x) |> arg_1.Add - go ParseState_ParentRecordChildPos.AwaitingKey args - | ParseState_ParentRecordChildPos.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_ParentRecordChildPos.AwaitingKey args - | Error exc -> - if setFlagValue key then - go 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 - - Unchecked.defaultof<_> - | Some x -> x - - if 0 = ArgParser_errors.Count then - { - AndAnother = arg_2 - Child = - { - Thing1 = arg_0 - Thing2 = arg_1 - } - } - else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" - - static member parse (args : string list) : ParentRecordChildPos = - ParentRecordChildPos.parse' System.Environment.GetEnvironmentVariable args -namespace ConsumePlugin - -open System -open System.IO -open WoofWare.Myriad.Plugins - -/// Methods to parse arguments for the type ParentRecordSelfPos -[] -module ParentRecordSelfPosArgParse = - type private ParseState_ParentRecordSelfPos = - /// 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 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 - - /// Returns false if we didn't set a value. - let setFlagValue (key : string) : bool = false - - let rec go (state : ParseState_ParentRecordSelfPos) (args : string list) = - match args with - | [] -> - match state with - | ParseState_ParentRecordSelfPos.AwaitingKey -> () - | ParseState_ParentRecordSelfPos.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_2.AddRange (rest |> Seq.map (fun x -> System.Boolean.Parse x)) - | 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" - else - let equals = arg.IndexOf (char 61) - - if equals < 0 then - args |> go (ParseState_ParentRecordSelfPos.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] - - match processKeyValue key value with - | Ok () -> go ParseState_ParentRecordSelfPos.AwaitingKey args - | Error x -> - match x with - | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value - | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ParentRecordSelfPos.AwaitingKey args - else - arg |> (fun x -> System.Boolean.Parse x) |> arg_2.Add - go ParseState_ParentRecordSelfPos.AwaitingKey args - | ParseState_ParentRecordSelfPos.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_ParentRecordSelfPos.AwaitingKey args - | Error exc -> - if setFlagValue key then - go 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 - - Unchecked.defaultof<_> - | Some x -> x - - if 0 = ArgParser_errors.Count then - { - AndAnother = arg_2 - Child = - { - Thing1 = arg_0 - Thing2 = arg_1 - } - } - else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" - - static member parse (args : string list) : ParentRecordSelfPos = - ParentRecordSelfPos.parse' System.Environment.GetEnvironmentVariable args -namespace ConsumePlugin - -open System -open System.IO -open WoofWare.Myriad.Plugins - -/// Methods to parse arguments for the type ChoicePositionals -[] -module ChoicePositionalsArgParse = - type private ParseState_ChoicePositionals = - /// 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 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 - - /// Returns false if we didn't set a value. - let setFlagValue (key : string) : bool = false - - let rec go (state : ParseState_ChoicePositionals) (args : string list) = - match args with - | [] -> - match state with - | ParseState_ChoicePositionals.AwaitingKey -> () - | ParseState_ChoicePositionals.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_0.AddRange (rest |> Seq.map (fun x -> x) |> 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" - else - let equals = arg.IndexOf (char 61) - - if equals < 0 then - args |> go (ParseState_ChoicePositionals.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] - - match processKeyValue key value with - | Ok () -> go ParseState_ChoicePositionals.AwaitingKey args - | Error x -> - match x with - | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value - | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ChoicePositionals.AwaitingKey args - else - arg |> (fun x -> x) |> Choice1Of2 |> arg_0.Add - go ParseState_ChoicePositionals.AwaitingKey args - | ParseState_ChoicePositionals.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_ChoicePositionals.AwaitingKey args - | Error exc -> - if setFlagValue key then - go 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 - } - else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" - - static member parse (args : string list) : ChoicePositionals = - ChoicePositionals.parse' System.Environment.GetEnvironmentVariable args -namespace ConsumePlugin - -open System -open System.IO -open WoofWare.Myriad.Plugins - -/// Methods to parse arguments for the type ContainsBoolEnvVar -[] -module ContainsBoolEnvVarArgParse = - type private ParseState_ContainsBoolEnvVar = - /// 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 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 - - 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 rec go (state : ParseState_ContainsBoolEnvVar) (args : string list) = - match args with - | [] -> - match state with - | ParseState_ContainsBoolEnvVar.AwaitingKey -> () - | ParseState_ContainsBoolEnvVar.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_ContainsBoolEnvVar.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_ContainsBoolEnvVar.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] - - match processKeyValue key value with - | Ok () -> go ParseState_ContainsBoolEnvVar.AwaitingKey args - | Error x -> - match x with - | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value - | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ContainsBoolEnvVar.AwaitingKey args - else - arg |> (fun x -> x) |> parser_LeftoverArgs.Add - go ParseState_ContainsBoolEnvVar.AwaitingKey args - | ParseState_ContainsBoolEnvVar.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_ContainsBoolEnvVar.AwaitingKey args - | Error exc -> - if setFlagValue key then - go 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 - - Unchecked.defaultof<_> - - 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 - } - else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" - - static member parse (args : string list) : ContainsBoolEnvVar = - ContainsBoolEnvVar.parse' System.Environment.GetEnvironmentVariable args -namespace ConsumePlugin - -open System -open System.IO -open WoofWare.Myriad.Plugins - -/// Methods to parse arguments for the type WithFlagDu -[] -module WithFlagDuArgParse = - type private ParseState_WithFlagDu = - /// 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 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 - - 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) = - match args with - | [] -> - match state with - | ParseState_WithFlagDu.AwaitingKey -> () - | ParseState_WithFlagDu.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_WithFlagDu.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_WithFlagDu.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] - - match processKeyValue key value with - | Ok () -> go ParseState_WithFlagDu.AwaitingKey args - | Error x -> - match x with - | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value - | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_WithFlagDu.AwaitingKey args - else - arg |> (fun x -> x) |> parser_LeftoverArgs.Add - go ParseState_WithFlagDu.AwaitingKey args - | ParseState_WithFlagDu.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_WithFlagDu.AwaitingKey args - | Error exc -> - if setFlagValue key then - go 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 - - Unchecked.defaultof<_> - | Some x -> x - - if 0 = ArgParser_errors.Count then - { - DryRun = arg_0 - } - else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" - - static member parse (args : string list) : WithFlagDu = - WithFlagDu.parse' System.Environment.GetEnvironmentVariable args -namespace ConsumePlugin - -open System -open System.IO -open WoofWare.Myriad.Plugins - -/// Methods to parse arguments for the type ContainsFlagEnvVar -[] -module ContainsFlagEnvVarArgParse = - type private ParseState_ContainsFlagEnvVar = - /// 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 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 - - true - else - false - - let rec go (state : ParseState_ContainsFlagEnvVar) (args : string list) = - match args with - | [] -> - match state with - | ParseState_ContainsFlagEnvVar.AwaitingKey -> () - | ParseState_ContainsFlagEnvVar.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_ContainsFlagEnvVar.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_ContainsFlagEnvVar.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] - - match processKeyValue key value with - | Ok () -> go ParseState_ContainsFlagEnvVar.AwaitingKey args - | Error x -> - match x with - | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value - | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ContainsFlagEnvVar.AwaitingKey args - else - arg |> (fun x -> x) |> parser_LeftoverArgs.Add - go ParseState_ContainsFlagEnvVar.AwaitingKey args - | ParseState_ContainsFlagEnvVar.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_ContainsFlagEnvVar.AwaitingKey args - | Error exc -> - if setFlagValue key then - go 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<_> - - 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 - - if 0 = ArgParser_errors.Count then - { - DryRun = arg_0 - } - else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" - - static member parse (args : string list) : ContainsFlagEnvVar = - ContainsFlagEnvVar.parse' System.Environment.GetEnvironmentVariable args -namespace ConsumePlugin - -open System -open System.IO -open WoofWare.Myriad.Plugins - -/// Methods to parse arguments for the type ContainsFlagDefaultValue -[] -module ContainsFlagDefaultValueArgParse = - type private ParseState_ContainsFlagDefaultValue = - /// 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 ContainsFlagDefaultValue with - - static member parse' - (getEnvironmentVariable : string -> string) - (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 - - true - else - false - - let rec go (state : ParseState_ContainsFlagDefaultValue) (args : string list) = - match args with - | [] -> - match state with - | ParseState_ContainsFlagDefaultValue.AwaitingKey -> () - | ParseState_ContainsFlagDefaultValue.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_ContainsFlagDefaultValue.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_ContainsFlagDefaultValue.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] - - match processKeyValue key value with - | Ok () -> go ParseState_ContainsFlagDefaultValue.AwaitingKey args - | Error x -> - match x with - | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value - | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ContainsFlagDefaultValue.AwaitingKey args - else - arg |> (fun x -> x) |> parser_LeftoverArgs.Add - go ParseState_ContainsFlagDefaultValue.AwaitingKey args - | ParseState_ContainsFlagDefaultValue.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_ContainsFlagDefaultValue.AwaitingKey args - | Error exc -> - if setFlagValue key then - go 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<_> - - let arg_0 = - match arg_0 with - | None -> ContainsFlagDefaultValue.DefaultDryRun () |> Choice2Of2 - | Some x -> Choice1Of2 x - - if 0 = ArgParser_errors.Count then - { - DryRun = arg_0 - } - else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" - - static member parse (args : string list) : ContainsFlagDefaultValue = - ContainsFlagDefaultValue.parse' System.Environment.GetEnvironmentVariable args -namespace ConsumePlugin - -open System -open System.IO -open WoofWare.Myriad.Plugins - -/// Methods to parse arguments for the type ManyLongForms -[] -module ManyLongFormsArgParse = - type private ParseState_ManyLongForms = - /// 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 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 rec go (state : ParseState_ManyLongForms) (args : string list) = - match args with - | [] -> - match state with - | ParseState_ManyLongForms.AwaitingKey -> () - | ParseState_ManyLongForms.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_ManyLongForms.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_ManyLongForms.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] - - match processKeyValue key value with - | Ok () -> go ParseState_ManyLongForms.AwaitingKey args - | Error x -> - match x with - | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value - | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_ManyLongForms.AwaitingKey args - else - arg |> (fun x -> x) |> parser_LeftoverArgs.Add - go ParseState_ManyLongForms.AwaitingKey args - | ParseState_ManyLongForms.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_ManyLongForms.AwaitingKey args - | Error exc -> - if setFlagValue key then - go 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 - - Unchecked.defaultof<_> - | Some x -> x - - if 0 = ArgParser_errors.Count then - { - DoTheThing = arg_0 - SomeFlag = arg_1 - } - else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" - - static member parse (args : string list) : ManyLongForms = - ManyLongForms.parse' System.Environment.GetEnvironmentVariable args -namespace ConsumePlugin - -open System -open System.IO -open WoofWare.Myriad.Plugins - -/// Methods to parse arguments for the type FlagsIntoPositionalArgs -[] -module FlagsIntoPositionalArgsArgParse = - type private ParseState_FlagsIntoPositionalArgs = - /// Ready to consume a key or positional arg - | AwaitingKey - /// Waiting to receive a value for the key we've already consumed - | AwaitingValue of key : string - - /// Extension methods for argument parsing - type FlagsIntoPositionalArgs with - - static member parse' - (getEnvironmentVariable : string -> string) - (args : string list) - : FlagsIntoPositionalArgs - = - let ArgParser_errors = ResizeArray () - - let helpText () = - [ - (sprintf "%s string%s%s" (sprintf "--%s" "a") "" "") - (sprintf - "%s string%s%s" - (sprintf "--%s" "grab-everything") - " (positional args) (can be repeated)" - "") - ] - |> String.concat "\n" - - let arg_1 : string ResizeArray = ResizeArray () - let mutable arg_0 : string option = None - - /// Processes the key-value pair, returning Error if no key was matched. - /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). - /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - let processKeyValue (key : string) (value : string) : Result = - if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then - match arg_0 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "a") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add - - Ok () - | None -> - try - arg_0 <- value |> (fun x -> x) |> Some - Ok () - with _ as exc -> - exc.Message |> Some |> Error - else if - System.String.Equals ( - key, - sprintf "--%s" "grab-everything", - System.StringComparison.OrdinalIgnoreCase - ) - then - value |> (fun x -> x) |> arg_1.Add - () |> Ok - else - Error None - - /// Returns false if we didn't set a value. - let setFlagValue (key : string) : bool = false - - let rec go (state : ParseState_FlagsIntoPositionalArgs) (args : string list) = - match args with - | [] -> - match state with - | ParseState_FlagsIntoPositionalArgs.AwaitingKey -> () - | ParseState_FlagsIntoPositionalArgs.AwaitingValue key -> - if setFlagValue key then - () - else - sprintf - "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." - key - |> ArgParser_errors.Add - | "--" :: rest -> arg_1.AddRange (rest |> Seq.map (fun x -> x)) - | arg :: args -> - match state with - | ParseState_FlagsIntoPositionalArgs.AwaitingKey -> - if arg.StartsWith ("--", System.StringComparison.Ordinal) then - if arg = "--help" then - helpText () |> failwithf "Help text requested.\n%s" - else - let equals = arg.IndexOf (char 61) - - if equals < 0 then - args |> go (ParseState_FlagsIntoPositionalArgs.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] - - match processKeyValue key value with - | Ok () -> go ParseState_FlagsIntoPositionalArgs.AwaitingKey args - | Error x -> - if true then - arg |> (fun x -> x) |> arg_1.Add - go ParseState_FlagsIntoPositionalArgs.AwaitingKey args - else - match x with - | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value - | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_FlagsIntoPositionalArgs.AwaitingKey args - else - arg |> (fun x -> x) |> arg_1.Add - go ParseState_FlagsIntoPositionalArgs.AwaitingKey args - | ParseState_FlagsIntoPositionalArgs.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_FlagsIntoPositionalArgs.AwaitingKey args - | Error exc -> - if setFlagValue key then - go ParseState_FlagsIntoPositionalArgs.AwaitingKey (arg :: args) - else if true then - key |> (fun x -> x) |> arg_1.Add - go ParseState_FlagsIntoPositionalArgs.AwaitingKey (arg :: args) - else - match exc with - | None -> - failwithf - "Unable to process supplied arg %s. Help text follows.\n%s" - key - (helpText ()) - | Some msg -> msg |> ArgParser_errors.Add - - go ParseState_FlagsIntoPositionalArgs.AwaitingKey args - let arg_1 = arg_1 |> Seq.toList - - let arg_0 = - match arg_0 with - | None -> - sprintf "Required argument '%s' received no value" (sprintf "--%s" "a") - |> ArgParser_errors.Add - - Unchecked.defaultof<_> - | Some x -> x - - if 0 = ArgParser_errors.Count then - { - A = arg_0 - GrabEverything = arg_1 - } - else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" - - static member parse (args : string list) : FlagsIntoPositionalArgs = - FlagsIntoPositionalArgs.parse' System.Environment.GetEnvironmentVariable args -namespace ConsumePlugin - -open System -open System.IO -open WoofWare.Myriad.Plugins - -/// Methods to parse arguments for the type FlagsIntoPositionalArgsChoice -[] -module FlagsIntoPositionalArgsChoiceArgParse = - type private ParseState_FlagsIntoPositionalArgsChoice = - /// 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 FlagsIntoPositionalArgsChoice with - - static member parse' - (getEnvironmentVariable : string -> string) - (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 - - /// Returns false if we didn't set a value. - let setFlagValue (key : string) : bool = false - - let rec go (state : ParseState_FlagsIntoPositionalArgsChoice) (args : string list) = - match args with - | [] -> - match state with - | ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey -> () - | ParseState_FlagsIntoPositionalArgsChoice.AwaitingValue key -> - if setFlagValue key then - () - else - sprintf - "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." - key - |> ArgParser_errors.Add - | "--" :: rest -> arg_1.AddRange (rest |> Seq.map (fun x -> x) |> 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" - else - let equals = arg.IndexOf (char 61) - - if equals < 0 then - args |> go (ParseState_FlagsIntoPositionalArgsChoice.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] - - match processKeyValue key value with - | Ok () -> go 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 - else - arg |> (fun x -> x) |> Choice1Of2 |> arg_1.Add - go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args - | ParseState_FlagsIntoPositionalArgsChoice.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go 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) - 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 - - Unchecked.defaultof<_> - | Some x -> x - - if 0 = ArgParser_errors.Count then - { - A = arg_0 - GrabEverything = arg_1 - } - else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" - - static member parse (args : string list) : FlagsIntoPositionalArgsChoice = - FlagsIntoPositionalArgsChoice.parse' System.Environment.GetEnvironmentVariable args -namespace ConsumePlugin - -open System -open System.IO -open WoofWare.Myriad.Plugins - -/// Methods to parse arguments for the type FlagsIntoPositionalArgsInt -[] -module FlagsIntoPositionalArgsIntArgParse = - type private ParseState_FlagsIntoPositionalArgsInt = - /// 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 FlagsIntoPositionalArgsInt with - - static member parse' - (getEnvironmentVariable : string -> string) - (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 - - /// Returns false if we didn't set a value. - let setFlagValue (key : string) : bool = false - - let rec go (state : ParseState_FlagsIntoPositionalArgsInt) (args : string list) = - match args with - | [] -> - match state with - | ParseState_FlagsIntoPositionalArgsInt.AwaitingKey -> () - | ParseState_FlagsIntoPositionalArgsInt.AwaitingValue key -> - if setFlagValue key then - () - else - sprintf - "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." - key - |> ArgParser_errors.Add - | "--" :: rest -> arg_1.AddRange (rest |> Seq.map (fun x -> System.Int32.Parse x)) - | 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" - else - let equals = arg.IndexOf (char 61) - - if equals < 0 then - args |> go (ParseState_FlagsIntoPositionalArgsInt.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] - - match processKeyValue key value with - | Ok () -> go 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 - else - arg |> (fun x -> System.Int32.Parse x) |> arg_1.Add - go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args - | ParseState_FlagsIntoPositionalArgsInt.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go 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) - 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 - - Unchecked.defaultof<_> - | Some x -> x - - if 0 = ArgParser_errors.Count then - { - A = arg_0 - GrabEverything = arg_1 - } - else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" - - static member parse (args : string list) : FlagsIntoPositionalArgsInt = - FlagsIntoPositionalArgsInt.parse' System.Environment.GetEnvironmentVariable args -namespace ConsumePlugin - -open System -open System.IO -open WoofWare.Myriad.Plugins - -/// Methods to parse arguments for the type FlagsIntoPositionalArgsIntChoice -[] -module FlagsIntoPositionalArgsIntChoiceArgParse = - type private ParseState_FlagsIntoPositionalArgsIntChoice = - /// 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 FlagsIntoPositionalArgsIntChoice with - - static member parse' - (getEnvironmentVariable : string -> string) - (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 - - /// Returns false if we didn't set a value. - let setFlagValue (key : string) : bool = false - - let rec go (state : ParseState_FlagsIntoPositionalArgsIntChoice) (args : string list) = - match args with - | [] -> - match state with - | ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey -> () - | ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingValue key -> - if setFlagValue key then - () - else - sprintf - "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." - key - |> ArgParser_errors.Add - | "--" :: rest -> arg_1.AddRange (rest |> Seq.map (fun x -> System.Int32.Parse x) |> 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" - else - let equals = arg.IndexOf (char 61) - - if equals < 0 then - args |> go (ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] - - match processKeyValue key value with - | Ok () -> go 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 - else - arg |> (fun x -> System.Int32.Parse x) |> Choice1Of2 |> arg_1.Add - go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args - | ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go 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) - 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 - - Unchecked.defaultof<_> - | Some x -> x - - if 0 = ArgParser_errors.Count then - { - A = arg_0 - GrabEverything = arg_1 - } - else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" - - static member parse (args : string list) : FlagsIntoPositionalArgsIntChoice = - FlagsIntoPositionalArgsIntChoice.parse' System.Environment.GetEnvironmentVariable args + member this.Assemble (positionals : string list) : FlagsIntoPositionalArgs' = "TODO: now construct the object" namespace ConsumePlugin open System @@ -4184,144 +249,446 @@ 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 - - /// Returns false if we didn't set a value. - let setFlagValue (key : string) : bool = false - - let rec go (state : ParseState_FlagsIntoPositionalArgs') (args : string list) = - match args with - | [] -> - match state with - | ParseState_FlagsIntoPositionalArgs'.AwaitingKey -> () - | ParseState_FlagsIntoPositionalArgs'.AwaitingValue key -> - if setFlagValue key then - () - else - sprintf - "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." - key - |> ArgParser_errors.Add - | "--" :: rest -> arg_1.AddRange (rest |> Seq.map (fun x -> x)) - | arg :: args -> - match state with - | ParseState_FlagsIntoPositionalArgs'.AwaitingKey -> - if arg.StartsWith ("--", System.StringComparison.Ordinal) then - if arg = "--help" then - helpText () |> failwithf "Help text requested.\n%s" - else - let equals = arg.IndexOf (char 61) - - if equals < 0 then - args |> go (ParseState_FlagsIntoPositionalArgs'.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] - - match processKeyValue key value with - | Ok () -> go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args - | Error x -> - if false then - arg |> (fun x -> x) |> arg_1.Add - go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args - else - match x with - | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value - | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args - else - arg |> (fun x -> x) |> arg_1.Add - go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args - | ParseState_FlagsIntoPositionalArgs'.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args - | Error exc -> - if setFlagValue key then - go ParseState_FlagsIntoPositionalArgs'.AwaitingKey (arg :: args) - else if false then - key |> (fun x -> x) |> arg_1.Add - go ParseState_FlagsIntoPositionalArgs'.AwaitingKey (arg :: args) - else - match exc with - | None -> - failwithf - "Unable to process supplied arg %s. Help text follows.\n%s" - key - (helpText ()) - | Some msg -> msg |> ArgParser_errors.Add - - go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args - let arg_1 = arg_1 |> Seq.toList - - let arg_0 = - match arg_0 with - | None -> - sprintf "Required argument '%s' received no value" (sprintf "--%s" "a") - |> ArgParser_errors.Add - - Unchecked.defaultof<_> - | Some x -> x - - if 0 = ArgParser_errors.Count then - { - A = arg_0 - DontGrabEverything = arg_1 - } - else - ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s" + failwith "todo" static member parse (args : string list) : FlagsIntoPositionalArgs' = FlagsIntoPositionalArgs'.parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type FlagsIntoPositionalArgsIntChoice +[] +module FlagsIntoPositionalArgsIntChoiceArgParse = + type private ParseState_FlagsIntoPositionalArgsIntChoice = + /// 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 FlagsIntoPositionalArgsIntChoice with + + static member parse' + (getEnvironmentVariable : string -> string) + (args : string list) + : FlagsIntoPositionalArgsIntChoice + = + failwith "todo" + + static member parse (args : string list) : FlagsIntoPositionalArgsIntChoice = + FlagsIntoPositionalArgsIntChoice.parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type FlagsIntoPositionalArgsInt +[] +module FlagsIntoPositionalArgsIntArgParse = + type private ParseState_FlagsIntoPositionalArgsInt = + /// 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 FlagsIntoPositionalArgsInt with + + static member parse' + (getEnvironmentVariable : string -> string) + (args : string list) + : FlagsIntoPositionalArgsInt + = + failwith "todo" + + static member parse (args : string list) : FlagsIntoPositionalArgsInt = + FlagsIntoPositionalArgsInt.parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type FlagsIntoPositionalArgsChoice +[] +module FlagsIntoPositionalArgsChoiceArgParse = + type private ParseState_FlagsIntoPositionalArgsChoice = + /// 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 FlagsIntoPositionalArgsChoice with + + static member parse' + (getEnvironmentVariable : string -> string) + (args : string list) + : FlagsIntoPositionalArgsChoice + = + failwith "todo" + + static member parse (args : string list) : FlagsIntoPositionalArgsChoice = + FlagsIntoPositionalArgsChoice.parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type FlagsIntoPositionalArgs +[] +module FlagsIntoPositionalArgsArgParse = + type private ParseState_FlagsIntoPositionalArgs = + /// Ready to consume a key or positional arg + | AwaitingKey + /// Waiting to receive a value for the key we've already consumed + | AwaitingValue of key : string + + /// Extension methods for argument parsing + type FlagsIntoPositionalArgs with + + static member parse' + (getEnvironmentVariable : string -> string) + (args : string list) + : FlagsIntoPositionalArgs + = + failwith "todo" + + static member parse (args : string list) : FlagsIntoPositionalArgs = + FlagsIntoPositionalArgs.parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type ManyLongForms +[] +module ManyLongFormsArgParse = + type private ParseState_ManyLongForms = + /// 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 ManyLongForms with + + static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ManyLongForms = + failwith "todo" + + static member parse (args : string list) : ManyLongForms = + ManyLongForms.parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type ContainsFlagDefaultValue +[] +module ContainsFlagDefaultValueArgParse = + type private ParseState_ContainsFlagDefaultValue = + /// 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 ContainsFlagDefaultValue with + + static member parse' + (getEnvironmentVariable : string -> string) + (args : string list) + : ContainsFlagDefaultValue + = + failwith "todo" + + static member parse (args : string list) : ContainsFlagDefaultValue = + ContainsFlagDefaultValue.parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type ContainsFlagEnvVar +[] +module ContainsFlagEnvVarArgParse = + type private ParseState_ContainsFlagEnvVar = + /// 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 ContainsFlagEnvVar with + + static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ContainsFlagEnvVar = + failwith "todo" + + static member parse (args : string list) : ContainsFlagEnvVar = + ContainsFlagEnvVar.parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type WithFlagDu +[] +module WithFlagDuArgParse = + type private ParseState_WithFlagDu = + /// 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 WithFlagDu with + + static member parse' (getEnvironmentVariable : string -> string) (args : string list) : WithFlagDu = + failwith "todo" + + static member parse (args : string list) : WithFlagDu = + WithFlagDu.parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type ContainsBoolEnvVar +[] +module ContainsBoolEnvVarArgParse = + type private ParseState_ContainsBoolEnvVar = + /// 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 ContainsBoolEnvVar with + + static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ContainsBoolEnvVar = + failwith "todo" + + static member parse (args : string list) : ContainsBoolEnvVar = + ContainsBoolEnvVar.parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type ChoicePositionals +[] +module ChoicePositionalsArgParse = + type private ParseState_ChoicePositionals = + /// 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 ChoicePositionals with + + static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ChoicePositionals = + failwith "todo" + + static member parse (args : string list) : ChoicePositionals = + ChoicePositionals.parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type ParentRecordSelfPos +[] +module ParentRecordSelfPosArgParse = + type private ParseState_ParentRecordSelfPos = + /// 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 ParentRecordSelfPos with + + static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ParentRecordSelfPos = + failwith "todo" + + static member parse (args : string list) : ParentRecordSelfPos = + ParentRecordSelfPos.parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type ParentRecordChildPos +[] +module ParentRecordChildPosArgParse = + type private ParseState_ParentRecordChildPos = + /// 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 ParentRecordChildPos with + + static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ParentRecordChildPos = + failwith "todo" + + static member parse (args : string list) : ParentRecordChildPos = + ParentRecordChildPos.parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type ParentRecord +[] +module ParentRecordArgParse = + type private ParseState_ParentRecord = + /// 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 ParentRecord with + + static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ParentRecord = + failwith "todo" + + static member parse (args : string list) : ParentRecord = + ParentRecord.parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type DatesAndTimes +[] +module DatesAndTimesArgParse = + type private ParseState_DatesAndTimes = + /// 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 DatesAndTimes with + + static member parse' (getEnvironmentVariable : string -> string) (args : string list) : DatesAndTimes = + failwith "todo" + + static member parse (args : string list) : DatesAndTimes = + DatesAndTimes.parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// 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 parse' (getEnvironmentVariable : string -> string) (args : string list) : LoadsOfTypesNoPositionals = + failwith "todo" + + let parse (args : string list) : LoadsOfTypesNoPositionals = + parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// 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 parse' (getEnvironmentVariable : string -> string) (args : string list) : LoadsOfTypes = failwith "todo" + + let parse (args : string list) : LoadsOfTypes = + parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// 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 parse' (getEnvironmentVariable : string -> string) (args : string list) : BasicWithIntPositionals = + failwith "todo" + + let parse (args : string list) : BasicWithIntPositionals = + 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 = failwith "todo" + + let parse (args : string list) : Basic = + parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin + +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// 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 parse' (getEnvironmentVariable : string -> string) (args : string list) : BasicNoPositionals = failwith "todo" + + let parse (args : string list) : BasicNoPositionals = + parse' System.Environment.GetEnvironmentVariable args diff --git a/Playground/Domain.fs b/Playground/Domain.fs index 425d27b..9a0b80d 100644 --- a/Playground/Domain.fs +++ b/Playground/Domain.fs @@ -45,4 +45,3 @@ type Args = [] OtherArgs : string list } - diff --git a/Playground/Library.fs b/Playground/Library.fs index 7dd7900..3951abd 100644 --- a/Playground/Library.fs +++ b/Playground/Library.fs @@ -1,11 +1,12 @@ -// The following code was mostly generated by Gemini 2.5 Pro (Experimental). -// I have not reviewed it at all yet; I have simply made it compile and tightened up the types. +//------------------------------------------------------------------------------ +// This code was generated by myriad. +// Changes to this file will be lost when the code is regenerated. +//------------------------------------------------------------------------------ -namespace GeneratedParsers // Assuming a namespace +namespace Playground // Assuming a namespace open System open System.IO -open Playground open WoofWare.Myriad.Plugins // Assuming attributes are here // Assume original type definitions are accessible here @@ -18,341 +19,545 @@ open WoofWare.Myriad.Plugins // Assuming attributes are here /// Methods to parse arguments for the type Args -[] -module ArgsModule = +[] +module Args = //-------------------------------------------------------------------------- - // Internal state definitions for the multi-candidate DU parser + // Internal state definitions (Non-Flattened with combined Assemble/Validate) //-------------------------------------------------------------------------- - /// State representing the parse progress for Mode1 - type private State_Mode1 = { - mutable Things_Info1 : int option - mutable Things_Info2 : string option - Things_Rest : ResizeArray // Corresponds to --rest for Mode1 - mutable Whatnot : int option - } with - static member Create() = { - Things_Info1 = None - Things_Info2 = None - Things_Rest = ResizeArray() - Whatnot = None + /// 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 } - /// State representing the parse progress for Mode2 - type private State_Mode2 = { - mutable Things_Info1 : int option - mutable Things_Info2 : string option - Things_Rest : ResizeArray // Corresponds to --rest for Mode2 - mutable Whatnot : DateTime option - } with - static member Create() = { - Things_Info1 = None - Things_Info2 = None - Things_Rest = ResizeArray() - Whatnot = None + 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 } - type private CandidateParseStateContents = - | Mode1 of State_Mode1 - | Mode2 of State_Mode2 + static member Create () = + { + Info1 = None + Info2 = None + Rest = ResizeArray () + } - /// State for a single candidate parse path for the Modes DU - type private CandidateParseState_Modes = { - mutable IsViable : bool - Errors : ResizeArray // Errors specific to this candidate's path - ConsumedArgIndices : System.Collections.Generic.HashSet // Indices consumed *by this candidate* - CaseState : CandidateParseStateContents - CaseName : string - } with - static member CreateMode1() = { - IsViable = true - Errors = ResizeArray() - ConsumedArgIndices = System.Collections.Generic.HashSet() - CaseState = State_Mode1.Create() |> CandidateParseStateContents.Mode1 - CaseName = "Mode1" - } - static member CreateMode2() = { - IsViable = true - Errors = ResizeArray() - ConsumedArgIndices = System.Collections.Generic.HashSet() - CaseState = State_Mode2.Create() |> CandidateParseStateContents.Mode2 - CaseName = "Mode2" - } + /// 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 = - /// Ready to consume a key or positional arg | AwaitingArg - /// Waiting to receive a value for the key we've already consumed (at given index) - | AwaitingValue of keyIndex: int * key: string + | AwaitingValue of keyIndex : int * key : string - let parse' (getEnvironmentVariable: string -> string) (args: string list) : Args = - let ArgParser_errors = ResizeArray() // Global errors + let parse' (getEnvironmentVariable : string -> string) (args : string list) : Args = + let ArgParser_errors = ResizeArray () // Global errors accumulator let helpText () = - // Note: Help text generation for DUs needs careful thought. - // This version lists all possible args, but doesn't specify Mode context well. - [ (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)" "") + // 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" - // State for top-level fields - let arg_OtherArgs: string ResizeArray = ResizeArray() - let mutable candidates_WhatToDo: CandidateParseState_Modes list = - [ CandidateParseState_Modes.CreateMode1() - CandidateParseState_Modes.CreateMode2() ] - // Keep track of args consumed by *any* viable candidate for the DU - let consumedArgIndices_WhatToDo = System.Collections.Generic.HashSet() + 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 to DU candidates + // 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 + ) - /// Tries to apply a key-value pair to a single candidate. Updates candidate state. - let applyKeyValueToCandidate (argIndex: int, keyIndex: int, key: string, value: string) (candidate: CandidateParseState_Modes) : unit = - if not candidate.IsViable then () else + 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 + () - match candidate.CaseState with - | Mode1 state -> - if String.Equals(key, "--info1", StringComparison.OrdinalIgnoreCase) then - match state.Things_Info1 with - | Some _ -> candidate.Errors.Add(sprintf "Argument '--info1' supplied multiple times for Mode1 candidate"); candidate.IsViable <- false + 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.Things_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 (Mode1): %s" value ex.Message); candidate.IsViable <- false - elif String.Equals(key, "--info2", StringComparison.OrdinalIgnoreCase) then - match state.Things_Info2 with - | Some _ -> candidate.Errors.Add(sprintf "Argument '--info2' supplied multiple times for Mode1 candidate"); candidate.IsViable <- false - | None -> state.Things_Info2 <- Some value; candidate.ConsumedArgIndices.Add argIndex |> ignore; candidate.ConsumedArgIndices.Add keyIndex |> ignore - elif String.Equals(key, "--rest", StringComparison.OrdinalIgnoreCase) then - // String list for Mode1 - state.Things_Rest.Add value; candidate.ConsumedArgIndices.Add argIndex |> ignore; candidate.ConsumedArgIndices.Add keyIndex |> ignore - elif 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 - else - // Key not relevant to Mode1, ignore it for this candidate - () + 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 + ) - | Mode2 state -> - if String.Equals(key, "--info1", StringComparison.OrdinalIgnoreCase) then - match state.Things_Info1 with - | Some _ -> candidate.Errors.Add(sprintf "Argument '--info1' supplied multiple times for Mode2 candidate"); candidate.IsViable <- false + 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.Things_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 (Mode2): %s" value ex.Message); candidate.IsViable <- false - elif String.Equals(key, "--info2", StringComparison.OrdinalIgnoreCase) then - match state.Things_Info2 with - | Some _ -> candidate.Errors.Add(sprintf "Argument '--info2' supplied multiple times for Mode2 candidate"); candidate.IsViable <- false - | None -> state.Things_Info2 <- Some value; candidate.ConsumedArgIndices.Add argIndex |> ignore; candidate.ConsumedArgIndices.Add keyIndex |> ignore - elif String.Equals(key, "--rest", StringComparison.OrdinalIgnoreCase) then - // Int list for Mode2 - try state.Things_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 (Mode2): %s" value ex.Message); candidate.IsViable <- false - elif 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 - else - // Key not relevant to Mode2, ignore it for this candidate - () + 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 + ) - /// Processes a key-value pair across all candidates. Returns true if handled by *any* viable candidate. - let processKeyValue (keyIndex: int, key: string, valueIndex: int, value: string) : bool = + 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 - applyKeyValueToCandidate (valueIndex, keyIndex, key, value) candidate + + if candidate.IsViable then + applyKeyValueToCandidate (valueIndex, keyIndex, key, value) candidate + if candidate.IsViable && candidate.ConsumedArgIndices.Count > initialConsumedCount then - // Mark as handled if *any* viable candidate consumed it handled <- true - // Add consumed indices to the global set for leftover detection later consumedArgIndices_WhatToDo.Add keyIndex |> ignore consumedArgIndices_WhatToDo.Add valueIndex |> ignore + handled - /// Processes a flag across all candidates. Returns true if handled by *any* viable candidate. - /// Note: No boolean flags defined in this example, so this is trivial. - let setFlagValue (keyIndex: int, key: string) : bool = - let mutable handled = false - // Example: If --info1 were a flag for Mode1 - // for candidate in candidates_WhatToDo do - // if candidate.IsViable && candidate.CaseName = "Mode1" then - // let state = candidate.CaseState :?> State_Mode1 - // if String.Equals(key, "--info1", StringComparison.OrdinalIgnoreCase) then - // match state.Things_Info1 with // Assuming it was bool option - // | Some _ -> candidate.Errors.Add(...) ; candidate.IsViable <- false - // | None -> state.Things_Info1 <- Some true; candidate.ConsumedArgIndices.Add keyIndex |> ignore; handled <- true - // if handled then consumedArgIndices_WhatToDo.Add keyIndex |> ignore - handled // No flags in this specific schema + let setFlagValue (keyIndex : int) (key : string) : bool = false // No flags - - //---------------------------------------------------------------------- - // Main parsing loop - //---------------------------------------------------------------------- - let rec go (state: ParseState_Args) (args: (int * string) list) = + let rec go (state : ParseState_Args) (args : (int * string) list) = + // ... (Implementation identical to previous version) ... match args with - | [] -> // End of arguments + | [] -> match state with - | ParseState_Args.AwaitingArg -> () // Expected state - | ParseState_Args.AwaitingValue (keyIndex, key) -> - // Trailing key without value - if not (setFlagValue (keyIndex, key)) then - // Not a flag either, report error - ArgParser_errors.Add (sprintf "Trailing argument '%s' (at index %d) requires a value." key keyIndex) - - | (argIndex, arg) :: remainingArgs -> + | 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 - // Consume rest as positional - remainingArgs |> List.iter (fun (i, positionalArg) -> - // Check if arg was potentially consumed by DU before adding + rest + |> List.iter (fun (i, v) -> if not (consumedArgIndices_WhatToDo.Contains i) then - arg_OtherArgs.Add positionalArg + arg_OtherArgs.Add v ) - go ParseState_Args.AwaitingArg [] // Go to end state - elif arg.StartsWith("--", StringComparison.Ordinal) then + go ParseState_Args.AwaitingArg [] + elif arg.StartsWith ("--") then if arg = "--help" then - helpText () |> failwithf "Help text requested.\n%s" + helpText () |> failwithf "Help text requested:\n%s" else - let equalsPos = arg.IndexOf('=') - if equalsPos > 0 then - // --key=value format - let key = arg.[0 .. equalsPos - 1] - let value = arg.[equalsPos + 1 ..] - if not (processKeyValue (argIndex, key, argIndex, value)) then - // Key-value not handled by DU candidates, check if it belongs elsewhere (none in this example) - // If still not handled, consider it potentially positional only if not consumed by DU - if not (consumedArgIndices_WhatToDo.Contains argIndex) then - arg_OtherArgs.Add arg // Treat unhandled --key=value as positional - go ParseState_Args.AwaitingArg remainingArgs + 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 - // --key format (potential flag or key needing subsequent value) - if setFlagValue (argIndex, arg) then - consumedArgIndices_WhatToDo.Add argIndex |> ignore - go ParseState_Args.AwaitingArg remainingArgs // Flag consumed - else - go (ParseState_Args.AwaitingValue (argIndex, arg)) remainingArgs // Expect value next - - else // Positional argument - // Add positional arg *only if* it hasn't been consumed by the DU logic - if not (consumedArgIndices_WhatToDo.Contains argIndex) then + go (ParseState_Args.AwaitingValue (idx, arg)) rest + else + if not (consumedArgIndices_WhatToDo.Contains idx) then arg_OtherArgs.Add arg - go ParseState_Args.AwaitingArg remainingArgs - | ParseState_Args.AwaitingValue (keyIndex, key) -> - // We have a key, current arg is its potential value - if processKeyValue (keyIndex, key, argIndex, arg) then - go ParseState_Args.AwaitingArg remainingArgs // Key-value pair consumed - else - // Value wasn't parseable/applicable for the key via DU candidates. - // Could the key have been a flag? - if setFlagValue (keyIndex, key) then - consumedArgIndices_WhatToDo.Add keyIndex |> ignore - // Flag consumed, reprocess the current arg in AwaitingArg state - go ParseState_Args.AwaitingArg ((argIndex, arg) :: remainingArgs) - else - // Not a flag, not a valid value. Error reported by processKeyValue/apply... - // Treat *both* key and arg as positional if not consumed by DU. - if not (consumedArgIndices_WhatToDo.Contains keyIndex) then - arg_OtherArgs.Add key - if not (consumedArgIndices_WhatToDo.Contains argIndex) then - arg_OtherArgs.Add arg - go ParseState_Args.AwaitingArg remainingArgs + 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 + // Final Validation and Assembly (Uses new Assemble methods) //---------------------------------------------------------------------- - - // 1. Validate and Assemble the DU 'WhatToDo' - let viableWinners = - candidates_WhatToDo - |> List.filter (fun c -> c.IsViable) - // Further filter: ensure all required args *for the specific case* are present - // And ensure no args were left unconsumed *relative to this candidate* - |> List.filter (fun c -> - let mutable caseComplete = true - let caseErrors = ResizeArray() - - // Check required fields based on case - match c.CaseState with - | Mode1 state -> - if state.Things_Info1.IsNone then caseComplete <- false; caseErrors.Add("Argument '--info1' is required for Mode1.") - if state.Things_Info2.IsNone then caseComplete <- false; caseErrors.Add("Argument '--info2' is required for Mode1.") - // Rest is list, always 'complete' - if state.Whatnot.IsNone then caseComplete <- false; caseErrors.Add("Argument '--whatnot' is required for Mode1.") - | Mode2 state -> - if state.Things_Info1.IsNone then caseComplete <- false; caseErrors.Add("Argument '--info1' is required for Mode2.") - if state.Things_Info2.IsNone then caseComplete <- false; caseErrors.Add("Argument '--info2' is required for Mode2.") - // Rest is list, always 'complete' - if state.Whatnot.IsNone then caseComplete <- false; caseErrors.Add("Argument '--whatnot' is required for Mode2.") - - // Check for relative leftovers: Ensure all args were either consumed by this candidate or the top-level positional args - let isLeftover (i: int, _:string) = - not (c.ConsumedArgIndices.Contains i) && // Not consumed by this candidate - not (arg_OtherArgs.Contains (args.[i])) // Not consumed by top-level positional (approx check) - better check indices! - // A more accurate leftover check requires comparing consumed sets properly - let hasRelativeLeftovers = false // Simplified: Assume validation handles required fields, and global positional catches others. - - if not caseComplete then c.Errors.AddRange caseErrors - caseComplete && not hasRelativeLeftovers - ) + 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 | [] -> - ArgParser_errors.Add("No valid parse found for 'WhatToDo'.") - // Add specific errors from candidates if available + // 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 errors: %s" c.CaseName (String.concat "; " c.Errors))) + |> 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 - match winner.CaseState with - | Mode1 state -> - // We know required fields are Some(_) due to filter above - let subMode1: SubMode1 = { Info1 = state.Things_Info1.Value; Info2 = state.Things_Info2.Value; Rest = state.Things_Rest |> Seq.toList } - let mode1: Mode1 = { Things = subMode1; Whatnot = state.Whatnot.Value } - Modes.Mode1 mode1 - | Mode2 state -> - let subMode2 = { Info1 = state.Things_Info1.Value; Info2 = state.Things_Info2.Value; Rest = state.Things_Rest |> Seq.toList } - let mode2 = { Things = subMode2; Whatnot = state.Whatnot.Value } - Modes.Mode2 mode2 + + | [ 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 matched:") - winners |> List.iter (fun c -> ArgParser_errors.Add(sprintf " - %s" c.CaseName)) + 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 - // 2. Finalize OtherArgs + // Finalize OtherArgs (unchanged) let otherArgsResult = arg_OtherArgs |> Seq.toList - // 3. Assemble Final Result or Fail + // 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()) + ArgParser_errors + |> String.concat "\n" + |> failwithf "Errors during parse!\n%s\n\nHelp Text:\n%s" (helpText ()) else - { WhatToDo = whatToDoResult; OtherArgs = otherArgsResult } + { + WhatToDo = whatToDoResult + OtherArgs = otherArgsResult + } - /// Parses the command line arguments into an Args record. - let parse (args: string list) : Args = + let parse (args : string list) : Args = parse' System.Environment.GetEnvironmentVariable args diff --git a/Playground/Program.fs b/Playground/Program.fs index a96d3b5..81255ec 100644 --- a/Playground/Program.fs +++ b/Playground/Program.fs @@ -1,11 +1,10 @@ namespace Playground -open GeneratedParsers - module Program = [] let main argv = - ["--whatnot=2024-01-12";"--info1=4";"--info2=hi"] - |> ArgsModule.parse + [ "--whatnot=2024-01-12" ; "--info1=4" ; "--info2=hi" ] + |> Args.parse |> printfn "%O" + 0 diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs new file mode 100644 index 0000000..0df4735 --- /dev/null +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -0,0 +1,629 @@ +namespace WoofWare.Myriad.Plugins + +open System +open System.Text +open Fantomas.FCS.Syntax +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 + + +module internal ShibaGenerator = + open SynTypePatterns + + type RecognisedType = + | Union of UnionType + | Record of RecordType + + member this.Name : Ident = + match this with + | Union unionType -> unionType.Name + | Record recordType -> recordType.Name + + /// Some types don't have in-progress equivalents (e.g. a no-data DU, which is "basically primitive"); + /// hence the `option`. + let createInProgressRecognisedType + (flagDuNames : string list) + (allKnownTypeIdents : string list) + (ty : RecognisedType) + : RecordType option + = + let getInProgressTypeName (ty : LongIdent) : SynType = + // TODO: this is super jank + let ident = List.last ty + + if List.contains ident.idText flagDuNames then + // Flag DUs have no in-progress form as such + SynType.createLongIdent ty |> SynType.option + elif List.contains ident.idText allKnownTypeIdents then + SynType.createLongIdent [ ident.idText + "_InProgress" |> Ident.create ] + else + // TODO: this is just nonsense, probably + SynType.createLongIdent ty |> SynType.option + + let makeType (attrs : SynAttribute list) (ty : SynType) (id : Ident) : SynField option = + match ty with + | ChoiceType [ left ; right ] -> + if not (SynType.provablyEqual left right) then + failwith + $"ArgParser was unable to prove types %O{left} and %O{right} to be equal in a Choice. We require them to be equal." + + { + Attrs = [] + Ident = Some id + Type = SynType.option left + } + |> SynField.make + |> Some + | ChoiceType _ -> + failwith + $"Only `Choice`s with exactly two args are supported, and they must have the same type on each side (field name: %s{id.idText})" + | ListType contents -> + // TODO: jank conditional + if + attrs + |> List.exists (fun x -> List.last(x.TypeName.LongIdent).idText.StartsWith "PositionalArgs") + then + // Omit positional args, they are treated in the Finalise + None + else + + { + Attrs = [] + Ident = Some id + Type = + // Parser will take strings later, when finalising + SynType.list SynType.string + } + |> SynField.make + |> Some + | PrimitiveType ty -> + { + Attrs = [] + Ident = Some id + Type = SynType.option (SynType.createLongIdent ty) + } + |> SynField.make + |> Some + | OptionType ty -> + { + Attrs = [] + Ident = Some id + Type = + // an `option` is its own in-progress + SynType.option ty + } + |> SynField.make + |> Some + | SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) -> + // Assume this is in-progress + { + Attrs = [] + Ident = Some id + Type = getInProgressTypeName ident + } + |> SynField.make + |> Some + | ty -> failwith $"TODO: %O{ty}" + + match ty with + | RecognisedType.Union union -> + if union.Cases |> List.forall (fun case -> case.Fields.IsEmpty) then + None + else + + { + Name = union.Name.idText + "_InProgress" |> Ident.create + XmlDoc = PreXmlDoc.create $"A partially-parsed %s{union.Name.idText}." |> Some + Members = + SynExpr.CreateConst "TODO: now construct the object" + |> SynBinding.basic + [ Ident.create "this" ; Ident.create "Assemble" ] + [ + SynPat.annotateType (SynType.list SynType.string) (SynPat.named "positionals") + ] + |> SynBinding.withReturnAnnotation (SynType.createLongIdent [ union.Name ]) + |> SynMemberDefn.memberImplementation + |> List.singleton + |> Some + Fields = + union.Cases + |> List.mapi (fun i data -> i, data) + |> List.choose (fun (caseNum, case) -> + match case.Fields with + | [] -> + failwith + $"Union type %s{union.Name.idText} has case %s{case.Name.idText} with no data; we require all cases to have exactly one field, or else all cases to be empty." + | [ x ] -> makeType x.Attrs x.Type (Ident.create $"Case_%i{caseNum}") + | _ -> + failwith + $"Union type %s{union.Name.idText} has case %s{case.Name.idText} with multiple fields; we require all cases to have exactly one field, or else all cases to be empty. Define a record type to hold the contents." + ) + |> fun l -> + if l.IsEmpty then + [ + SynField.make + { + Attrs = [] + Ident = Some (Ident.create "_Dummy") + Type = SynType.unit + } + ] + else + l + Generics = + match union.Generics with + | None -> None + | Some _ -> failwith $"Union type %s{union.Name.idText} had generics, which we don't support." + TypeAccessibility = Some (SynAccess.Private range0) + ImplAccessibility = None + Attributes = [] + } + |> Some + | RecognisedType.Record record -> + { + Name = record.Name.idText + "_InProgress" |> Ident.create + Fields = + record.Fields + |> List.choose (fun (SynField.SynField (attrs, _, id, ty, _, _, _, _, _)) -> + match id with + | None -> + failwith $"expected field in record %s{record.Name.idText} to have a name, but it did not" + | Some id -> makeType (SynAttributes.toAttrs attrs) ty id + ) + |> fun l -> + if l.IsEmpty then + [ + SynField.make + { + Attrs = [] + Ident = Some (Ident.create "_Dummy") + Type = SynType.unit + } + ] + else + l + Members = + SynExpr.CreateConst "TODO: now construct the object" + |> SynBinding.basic + [ Ident.create "this" ; Ident.create "Assemble" ] + [ + SynPat.annotateType (SynType.list SynType.string) (SynPat.named "positionals") + ] + |> SynBinding.withReturnAnnotation (SynType.createLongIdent [ record.Name ]) + |> SynMemberDefn.memberImplementation + |> List.singleton + |> Some + XmlDoc = PreXmlDoc.create $"A partially-parsed %s{record.Name.idText}." |> Some + Generics = + match record.Generics with + | None -> None + | Some _ -> failwith $"Record type %s{record.Name.idText} had generics, which we don't support." + TypeAccessibility = Some (SynAccess.Private range0) + ImplAccessibility = None + Attributes = [] + } + |> Some + + let createHelpersModule + (opens : SynOpenDeclTarget list) + (ns : LongIdent) + (allUnionTypes : UnionType list) + (allRecordTypes : RecordType list) + : SynModuleDecl + = + let flagDus = + allUnionTypes + |> List.choose (fun ty -> + match ty.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 -> None + | 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 + | [], [] -> + { + Name = ty.Name + Case1Name = c1.Name + Case1Arg = c1Attr + Case2Name = c2.Name + Case2Arg = c2Attr + } + |> Some + | _, _ -> + failwith "[] may only be placed on discriminated union members with no data." + | _ -> None + ) + + let modName = + let ns = ns |> List.map _.idText |> String.concat "_" + Ident.create $"ArgParseHelpers_%s{ns}" + + let modInfo = + SynComponentInfo.create modName + |> SynComponentInfo.withAccessibility (SynAccess.Private range0) + |> SynComponentInfo.withDocString (PreXmlDoc.create $"Helper types for arg parsing") + + let allKnownTypeIdents = + let uts = allUnionTypes |> List.map _.Name.idText + let rts = allRecordTypes |> List.map _.Name.idText + uts @ rts + + let flagDuNames = flagDus |> List.map _.Name.idText + + let reducedRecordTypes = + allRecordTypes + |> List.choose (fun rt -> + // TODO: just split these into different functions and get rid of RecognisedType + createInProgressRecognisedType flagDuNames allKnownTypeIdents (RecognisedType.Record rt) + |> Option.map RecordType.ToAst + ) + + let reducedUnionTypes = + allUnionTypes + |> List.choose (fun ut -> + // TODO: just split these into different functions and get rid of RecognisedType + createInProgressRecognisedType flagDuNames allKnownTypeIdents (RecognisedType.Union ut) + |> Option.map RecordType.ToAst + ) + + let taggedMod = + [ + for openStatement in opens do + yield SynModuleDecl.openAny openStatement + yield SynModuleDecl.openAny (SynOpenDeclTarget.ModuleOrNamespace (SynLongIdent.create ns, range0)) + + yield (reducedRecordTypes @ reducedUnionTypes) |> SynModuleDecl.createTypes + ] + |> SynModuleDecl.nestedModule modInfo + + taggedMod + + // 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 : SynTypeDefn, spec : ArgParserOutputSpec)) + (allUnionTypes : UnionType list) + (allRecordTypes : RecordType list) + : SynModuleOrNamespace + = + let taggedType = + match taggedType with + | SynTypeDefn.SynTypeDefn (sci, + SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (access, fields, _), _), + smd, + _, + _, + _) -> RecordType.OfRecord sci smd access fields + | _ -> failwith "[] currently only supports being placed on records." + + 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.Private range0)) + ) + |> List.singleton + |> SynModuleDecl.createTypes + + let taggedMod = + let argsParam = + SynPat.named "args" + |> SynPat.annotateType (SynType.appPostfix "list" SynType.string) + + let parsePrime = + SynExpr.CreateConst "todo" + |> SynExpr.applyFunction (SynExpr.createIdent "failwith") + |> 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 ArgParserGenerator () = + + interface IMyriadGenerator with + member _.ValidInputExtensions = [ ".fs" ] + + member _.Generate (context : GeneratorContext) = + let ast, _ = + Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head + + let types = + // Bug in WoofWare.Whippet, probably: we return types in the wrong order + Ast.getTypes ast |> List.map (fun (ns, types) -> ns, List.rev types) + + let opens = AstHelper.extractOpens ast + + let namespaceAndTypes = + types + |> List.collect (fun (ns, types) -> + 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 + } + + Some (ty, spec) + ) + + typeWithAttr + |> List.map (fun taggedType -> + let unions, records, others = + (([], [], []), types) + ||> List.fold (fun + (unions, records, others) + (SynTypeDefn.SynTypeDefn (sci, repr, smd, _, _, _) as ty) -> + match repr with + | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (access, cases, _), _) -> + UnionType.OfUnion sci smd access cases :: unions, records, others + | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (access, fields, _), _) -> + unions, RecordType.OfRecord sci smd access fields :: records, others + | _ -> unions, records, ty :: others + ) + + if not others.IsEmpty then + failwith + $"Error: all types recursively defined together with an ArgParserGenerator type must be discriminated unions or records. %+A{others}" + + (ns, taggedType, unions, records) + ) + ) + + let unionsAndRecordsByNs = + (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 helpersMod = + unionsAndRecordsByNs + |> Map.toSeq + |> Seq.map (fun (ns, (unions, records)) -> + let unions = unions |> List.distinctBy (fun u -> u.Name.idText) + let records = records |> List.distinctBy (fun r -> r.Name.idText) + + ShibaGenerator.createHelpersModule + opens + (ns.Split '.' |> Seq.map Ident.create |> List.ofSeq) + unions + records + ) + |> Seq.toList + |> fun l -> [ yield! l ] + |> SynModuleOrNamespace.createNamespace [ Ident.create "ArgParserHelpers" ] + + let modules = + namespaceAndTypes + |> List.map (fun (ns, taggedType, unions, records) -> + ShibaGenerator.createModule opens ns taggedType unions records + ) + + Output.Ast (helpersMod :: modules) diff --git a/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj b/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj index 06978b6..8aaf294 100644 --- a/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj +++ b/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj @@ -40,7 +40,8 @@ - + +